From e999dd401ab32f4389072b32e571015538d1cf77 Mon Sep 17 00:00:00 2001 From: David Minton Date: Mon, 7 Nov 2022 15:39:00 -0500 Subject: [PATCH 001/569] Switched default behavior of simulation class to *not* read an old binary file --- python/swiftest/swiftest/simulation_class.py | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/python/swiftest/swiftest/simulation_class.py b/python/swiftest/swiftest/simulation_class.py index d1fa28ede..3e16e51ad 100644 --- a/python/swiftest/swiftest/simulation_class.py +++ b/python/swiftest/swiftest/simulation_class.py @@ -23,7 +23,7 @@ class Simulation: """ This is a class that defines the basic Swift/Swifter/Swiftest simulation object """ - def __init__(self, codename="Swiftest", param_file="param.in", readbin=True, verbose=True): + def __init__(self, codename="Swiftest", param_file="param.in", readbin=False, verbose=True): self.ds = xr.Dataset() self.param = { '! VERSION': f"Swiftest parameter input", From a9f58877e886533ab924fe403a58df4c073d6704 Mon Sep 17 00:00:00 2001 From: David Minton Date: Mon, 7 Nov 2022 16:35:45 -0500 Subject: [PATCH 002/569] Removed the longdouble conversion from constant numbers as it can screw with xarray --- python/swiftest/swiftest/constants.py | 21 ++++++++++++--------- 1 file changed, 12 insertions(+), 9 deletions(-) diff --git a/python/swiftest/swiftest/constants.py b/python/swiftest/swiftest/constants.py index 5bd5bc7a4..fe3253c86 100644 --- a/python/swiftest/swiftest/constants.py +++ b/python/swiftest/swiftest/constants.py @@ -13,15 +13,18 @@ import astropy.constants as const # Constants in SI units -GC = np.longdouble(const.G.value) -AU2M = np.longdouble(const.au.value) -GMSunSI = np.longdouble(const.GM_sun.value) -MSun = np.longdouble(const.M_sun.value) -RSun = np.longdouble(const.R_sun.value) +GC = const.G.value +AU2M = const.au.value +GMSun = const.GM_sun.value +MSun = const.M_sun.value +RSun = const.R_sun.value +MEarth = const.M_earth.value +REarth = const.R_earth.value +GMEarth = const.GM_earth.value JD2S = 86400 -YR2S = np.longdouble(365.25 * JD2S) -einsteinC = np.longdouble(299792458.0) +YR2S = 365.25 * JD2S +einsteinC = 299792458.0 # Solar oblatenes values: From Mecheri et al. (2004), using Corbard (b) 2002 values (Table II) -J2Sun = np.longdouble(2.198e-7) -J4Sun = np.longdouble(-4.805e-9) +J2Sun = 2.198e-7 +J4Sun = -4.805e-9 From 772c5cc20020d1619d824d640199acbd144b6c60 Mon Sep 17 00:00:00 2001 From: David Minton Date: Mon, 7 Nov 2022 16:36:05 -0500 Subject: [PATCH 003/569] Added unit conversion method for easier setting of units --- python/swiftest/swiftest/init_cond.py | 2 +- python/swiftest/swiftest/simulation_class.py | 126 +++++++++++++++++++ 2 files changed, 127 insertions(+), 1 deletion(-) diff --git a/python/swiftest/swiftest/init_cond.py b/python/swiftest/swiftest/init_cond.py index 78ef51be9..287e5ecae 100644 --- a/python/swiftest/swiftest/init_cond.py +++ b/python/swiftest/swiftest/init_cond.py @@ -120,7 +120,7 @@ def solar_system_horizons(plname, idval, param, ephemerides_start_date, ds): THIRDLONG = np.longdouble(1.0) / np.longdouble(3.0) # Central body value vectors - GMcb = np.array([swiftest.GMSunSI * param['TU2S'] ** 2 / param['DU2M'] ** 3]) + GMcb = np.array([swiftest.GMSun * param['TU2S'] ** 2 / param['DU2M'] ** 3]) Rcb = np.array([swiftest.RSun / param['DU2M']]) J2RP2 = np.array([swiftest.J2Sun * (swiftest.RSun / param['DU2M']) ** 2]) J4RP4 = np.array([swiftest.J4Sun * (swiftest.RSun / param['DU2M']) ** 4]) diff --git a/python/swiftest/swiftest/simulation_class.py b/python/swiftest/swiftest/simulation_class.py index 3e16e51ad..cd556b555 100644 --- a/python/swiftest/swiftest/simulation_class.py +++ b/python/swiftest/swiftest/simulation_class.py @@ -68,6 +68,7 @@ def __init__(self, codename="Swiftest", param_file="param.in", readbin=False, ve } self.codename = codename self.verbose = verbose + self.set_unit_system() if param_file != "" : dir_path = os.path.dirname(os.path.realpath(param_file)) self.read_param(param_file, codename=codename, verbose=self.verbose) @@ -79,6 +80,131 @@ def __init__(self, codename="Swiftest", param_file="param.in", readbin=False, ve else: print(f"BIN_OUT file {self.param['BIN_OUT']} not found.") return + + + def set_unit_system(self,MU="Msun",DU="AU",TU="YR",MU2KG=None,DU2M=None,TU2S=None): + """ + Setter for setting the unit conversion between one of the standard sets. + + The units can be set one of two ways: + 1) The user can supply string values to the arguments MU, DU, and TU to select between common systems + 2) The user can supply float values to the arguments MU2KG, DU2M, and TU2S to manually set the conversion + factor between the desired unit and the SI unit (kg-m-s). + + The two sets of arguments are mutually exclusive. Any values passed to MU2KG, DU2M, or TU2S will override any + specified in MU, DU, or TU, respectively. The default system is Msun-AU-YR. MU, DU, and TU are case-insenstive + + Parameters + ---------- + MU : str, default "Msun" + The mass unit system to use. Case-insensitive valid options are: + "Msun" : Solar mass + "Mearth" : Earth mass + "kg" : kilograms + "g" : grams + + DU : str, default "AU" + The distance unit system to use. Case-insensitive valid options are: + "AU" : Astronomical Unit + "Rearth" : Earth radius + "m" : meter + "cm" : centimeter + + TU : str, default "YR" + The time unit system to use. Case-insensitive valid options are: + "YR" : Year + "DAY" : Julian day + "d" : Julian day + "JD" : Julian day + "s" : second + + MU2KG : float, default `None` + The conversion factor to multiply by the mass unit that would convert it to kilogram. Setting this overrides MU + + DU2M : float, default `None` + The conversion factor to multiply by the distance unit that would convert it to meter. Setting this overrides DU + + TU2S : float, default `None` + The conversion factor to multiply by the time unit that would convert it to seconds. Setting this overrides TU + + Returns + ---------- + Sets the values of MU2KG, DU2M, and TU2S in the param dictionary to the appropriate units. Also computes the gravitational constant, GU + """ + + if MU2KG is not None: + self.param['MU2KG'] = MU2KG + self.MU_name = None + else: + if MU.upper() == "MSUN": + self.param['MU2KG'] = constants.MSun + self.MU_name = "MSun" + elif MU.upper() == "MEARTH": + self.param['MU2KG'] = constants.MEarth + self.MU_name = "MEarth" + elif MU.upper() == "KG": + self.param['MU2KG'] = 1.0 + self.MU_name = "kg" + elif MU.upper() == "G": + self.param['MU2KG'] = 1000.0 + self.MU_name = "g" + else: + print(f"{MU} not a recognized unit system. Using MSun as a default.") + self.param['MU2KG'] = constants.MSun + self.MU_name = "MSun" + + if DU2M is not None: + self.param['DU2M'] = DU2M + self.DU_name = None + else: + if DU.upper() == "AU": + self.param['DU2M'] = constants.AU2M + self.DU_name = "AU" + elif DU.upper() == "REARTH": + self.param['DU2M'] = constants.REarth + self.DU_name = "REarth" + elif DU.upper() == "M": + self.param['DU2M'] = 1.0 + self.DU_name = "m" + elif DU.upper() == "CM": + self.param['DU2M'] = 100.0 + self.DU_name = "cm" + else: + print(f"{DU} not a recognized unit system. Using AU as a default.") + self.param['DU2M'] = constants.AU2M + self.DU_name = "AU" + + if TU2S is not None: + self.param['TU2S'] = TU2S + self.TU_name = None + else: + if TU.upper() == "YR": + self.param['TU2S'] = constants.YR2S + self.TU_name = "y" + elif TU.upper() == "DAY" or TU.upper() == "D" or TU.upper() == "JD": + self.param['TU2S'] = constants.JD2S + self.TU_name = "Day" + elif TU.upper() == "S": + self.param['TU2S'] = 1.0 + self.TU_name = "s" + else: + print(f"{TU} not a recognized unit system. Using YR as a default.") + self.param['TU2S'] = constants.YR2S + self.TU_name = "y" + + self.VU_name = f"{self.DU_name}/{self.TU_name}" + self.GC = constants.GC * self.param['TU2S']**2 * self.param['MU2KG'] / self.param['DU2M']**3 + + if self.verbose: + if self.MU_name is None or self.DU_name is None or self.TU_name is None: + print(f"Custom units set.") + print(f"MU2KG: {self.param['MU2KG']}") + print(f"DU2M : {self.param['DU2M']}") + print(f"TU2S : {self.param['TU2S']}") + else: + print(f"Units set to {self.MU_name}-{self.DU_name}-{self.TU_name}") + + return def add(self, plname, date=date.today().isoformat(), idval=None): """ From d4be7bd6cb554a9d6c465e12373aa1074af5ec60 Mon Sep 17 00:00:00 2001 From: David Minton Date: Mon, 7 Nov 2022 16:44:06 -0500 Subject: [PATCH 004/569] Removed inconsistent defaults from the param dictionary --- python/swiftest/swiftest/simulation_class.py | 3 --- 1 file changed, 3 deletions(-) diff --git a/python/swiftest/swiftest/simulation_class.py b/python/swiftest/swiftest/simulation_class.py index cd556b555..cd64d3bc6 100644 --- a/python/swiftest/swiftest/simulation_class.py +++ b/python/swiftest/swiftest/simulation_class.py @@ -49,9 +49,6 @@ def __init__(self, codename="Swiftest", param_file="param.in", readbin=False, ve 'CHK_QMIN_COORD': "HELIO", 'CHK_QMIN_RANGE': "-1.0 -1.0", 'ENC_OUT': "", - 'MU2KG': constants.MSun, - 'TU2S': constants.JD2S, - 'DU2M': constants.AU2M, 'EXTRA_FORCE': "NO", 'DISCARD_OUT': "", 'PARTICLE_OUT' : "", From 00a4834a01ab7b2fa21c566cecdc6ccb6bf7466b Mon Sep 17 00:00:00 2001 From: David Minton Date: Mon, 7 Nov 2022 16:57:08 -0500 Subject: [PATCH 005/569] Improved handling of cases where simulation directory is different than the Python working directory --- python/swiftest/swiftest/simulation_class.py | 31 +++++++++++++------- 1 file changed, 20 insertions(+), 11 deletions(-) diff --git a/python/swiftest/swiftest/simulation_class.py b/python/swiftest/swiftest/simulation_class.py index cd64d3bc6..5ad945d69 100644 --- a/python/swiftest/swiftest/simulation_class.py +++ b/python/swiftest/swiftest/simulation_class.py @@ -1,4 +1,5 @@ """ + self.param['BIN_OUT'] = binpath 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 @@ -66,16 +67,18 @@ def __init__(self, codename="Swiftest", param_file="param.in", readbin=False, ve self.codename = codename self.verbose = verbose self.set_unit_system() - if param_file != "" : - dir_path = os.path.dirname(os.path.realpath(param_file)) + + # If the parameter file is in a different location than the current working directory, we will need + # to use it to properly open bin files + self.sim_dir = os.path.dirname(os.path.realpath(param_file)) + if os.path.exists(param_file): self.read_param(param_file, codename=codename, verbose=self.verbose) - if readbin: - binpath = os.path.join(dir_path,self.param['BIN_OUT']) - if os.path.exists(binpath): - self.param['BIN_OUT'] = binpath - self.bin2xr() - else: - print(f"BIN_OUT file {self.param['BIN_OUT']} not found.") + if readbin: + binpath = os.path.join(self.sim_dir,self.param['BIN_OUT']) + if os.path.exists(binpath): + self.bin2xr() + else: + print(f"BIN_OUT file {binpath} not found.") return @@ -396,11 +399,17 @@ def bin2xr(self): ------- self.ds : xarray dataset """ + + # Make a temporary copy of the parameter dictionary so we can supply the absolute path of the binary file + # This is done to handle cases where the method is called from a different working directory than the simulation + # results + param_tmp = self.param.copy() + param_tmp['BIN_OUT'] = os.path.join(self.dir_path,self.param['BIN_OUT']) if self.codename == "Swiftest": - self.ds = io.swiftest2xr(self.param, verbose=self.verbose) + self.ds = io.swiftest2xr(param_tmp, verbose=self.verbose) if self.verbose: print('Swiftest simulation data stored as xarray DataSet .ds') elif self.codename == "Swifter": - self.ds = io.swifter2xr(self.param, verbose=self.verbose) + self.ds = io.swifter2xr(param_tmp, verbose=self.verbose) if self.verbose: print('Swifter simulation data stored as xarray DataSet .ds') elif self.codename == "Swift": print("Reading Swift simulation data is not implemented yet") From 615730a5e460ef83932ed95e006f59082f01dd7a Mon Sep 17 00:00:00 2001 From: David Minton Date: Mon, 7 Nov 2022 19:22:22 -0500 Subject: [PATCH 006/569] Made sure that MIN_GMFRAG was cast as a float --- python/swiftest/swiftest/io.py | 2 ++ 1 file changed, 2 insertions(+) diff --git a/python/swiftest/swiftest/io.py b/python/swiftest/swiftest/io.py index 4678b4784..044f1eff5 100644 --- a/python/swiftest/swiftest/io.py +++ b/python/swiftest/swiftest/io.py @@ -105,6 +105,8 @@ def read_swiftest_param(param_file_name, param, verbose=True): param['ENCOUNTER_CHECK'] = param['ENCOUNTER_CHECK'].upper() if 'GMTINY' in param: param['GMTINY'] = real2float(param['GMTINY']) + if 'MIN_GMFRAG' in param: + param['MIN_GMFRAG'] = real2float(param['MIN_GMFRAG']) except IOError: print(f"{param_file_name} not found.") return param From 810f48129e0e6ede6e5c511430ba4305fde8e937 Mon Sep 17 00:00:00 2001 From: David Minton Date: Mon, 7 Nov 2022 19:22:49 -0500 Subject: [PATCH 007/569] Added new method that converts the units inside the param dictionary if the unit system changes --- python/swiftest/swiftest/simulation_class.py | 115 ++++++++++++++++--- 1 file changed, 98 insertions(+), 17 deletions(-) diff --git a/python/swiftest/swiftest/simulation_class.py b/python/swiftest/swiftest/simulation_class.py index 5ad945d69..b38c7b34d 100644 --- a/python/swiftest/swiftest/simulation_class.py +++ b/python/swiftest/swiftest/simulation_class.py @@ -28,27 +28,20 @@ def __init__(self, codename="Swiftest", param_file="param.in", readbin=False, ve self.ds = xr.Dataset() self.param = { '! VERSION': f"Swiftest parameter input", - 'T0': "0.0", - 'TSTOP': "0.0", - 'DT': "0.0", + 'T0': 0.0, + 'TSTART' : 0.0, + 'TSTOP': 0.0, + 'DT': 0.0, 'IN_FORM': "XV", 'IN_TYPE': "NETCDF_DOUBLE", 'NC_IN' : "init_cond.nc", - 'CB_IN' : "cb.in", - 'PL_IN' : "pl.in", - 'TP_IN' : "tp.in", - 'ISTEP_OUT': "1", - 'ISTEP_DUMP': "1", + 'ISTEP_OUT': 1, + 'ISTEP_DUMP': 1, 'BIN_OUT': "bin.nc", 'OUT_TYPE': 'NETCDF_DOUBLE', 'OUT_FORM': "XVEL", 'OUT_STAT': "REPLACE", - 'CHK_RMAX': "-1.0", - 'CHK_EJECT': "-1.0", - 'CHK_RMIN': "-1.0", - 'CHK_QMIN': "-1.0", 'CHK_QMIN_COORD': "HELIO", - 'CHK_QMIN_RANGE': "-1.0 -1.0", 'ENC_OUT': "", 'EXTRA_FORCE': "NO", 'DISCARD_OUT': "", @@ -66,6 +59,7 @@ def __init__(self, codename="Swiftest", param_file="param.in", readbin=False, ve } self.codename = codename self.verbose = verbose + self.set_simulation_range(rmin=constants.RSun, rmax=1000.0) self.set_unit_system() # If the parameter file is in a different location than the current working directory, we will need @@ -132,6 +126,11 @@ def set_unit_system(self,MU="Msun",DU="AU",TU="YR",MU2KG=None,DU2M=None,TU2S=Non Sets the values of MU2KG, DU2M, and TU2S in the param dictionary to the appropriate units. Also computes the gravitational constant, GU """ + # Save the previously set values of the unit conversion factors so we can update parameters as needed + MU2KG_old = self.param.pop('MU2KG',None) + DU2M_old = self.param.pop('DU2M',None) + TU2S_old = self.param.pop('TU2S',None) + if MU2KG is not None: self.param['MU2KG'] = MU2KG self.MU_name = None @@ -178,13 +177,13 @@ def set_unit_system(self,MU="Msun",DU="AU",TU="YR",MU2KG=None,DU2M=None,TU2S=Non self.param['TU2S'] = TU2S self.TU_name = None else: - if TU.upper() == "YR": + if TU.upper() == "YR" or TU.upper() == "Y" or TU.upper() == "YEAR" or TU.upper() == "YEARS": self.param['TU2S'] = constants.YR2S self.TU_name = "y" - elif TU.upper() == "DAY" or TU.upper() == "D" or TU.upper() == "JD": + elif TU.upper() == "DAY" or TU.upper() == "D" or TU.upper() == "JD" or TU.upper() == "DAYS": self.param['TU2S'] = constants.JD2S self.TU_name = "Day" - elif TU.upper() == "S": + elif TU.upper() == "S" or TU.upper() == "SECONDS" or TU.upper() == "SEC": self.param['TU2S'] = 1.0 self.TU_name = "s" else: @@ -195,6 +194,8 @@ def set_unit_system(self,MU="Msun",DU="AU",TU="YR",MU2KG=None,DU2M=None,TU2S=Non self.VU_name = f"{self.DU_name}/{self.TU_name}" self.GC = constants.GC * self.param['TU2S']**2 * self.param['MU2KG'] / self.param['DU2M']**3 + self.update_param_units(MU2KG_old, DU2M_old, TU2S_old) + if self.verbose: if self.MU_name is None or self.DU_name is None or self.TU_name is None: print(f"Custom units set.") @@ -205,7 +206,87 @@ def set_unit_system(self,MU="Msun",DU="AU",TU="YR",MU2KG=None,DU2M=None,TU2S=Non print(f"Units set to {self.MU_name}-{self.DU_name}-{self.TU_name}") return - + + def update_param_units(self,MU2KG_old,DU2M_old,TU2S_old): + """ + Updates the values of parameters that have units when the units have changed. + + Parameters + ---------- + MU2KG_old : Old value of the mass unit conversion factor + DU2M_old : Old value of the distance unit conversion factor + TU2S_old : Old value of the time unit conversion factor + + Returns + ------- + Updates the set of param dictionary values for the new unit system + + """ + + mass_keys = ['GMTINY', 'MIN_GMFRAG'] + distance_keys = ['CHK_QMIN','CHK_RMIN','CHK_RMAX', 'CHK_EJECT'] + time_keys = ['T0','TSTOP','DT'] + + if MU2KG_old is not None: + for k in mass_keys: + if k in self.param: + print(f"param['{k}']: {self.param[k]}") + self.param[k] *= self.param['MU2KG'] / MU2KG_old + + if DU2M_old is not None: + for k in distance_keys: + if k in self.param: + self.param[k] *= self.param['DU2M'] / DU2M_old + + CHK_QMIN_RANGE = self.param.pop('CHK_QMIN_RANGE', None) + if CHK_QMIN_RANGE is not None: + CHK_QMIN_RANGE = CHK_QMIN_RANGE.split(" ") + for i, v in enumerate(CHK_QMIN_RANGE): + CHK_QMIN_RANGE[i] = float(CHK_QMIN_RANGE[i]) * self.param['DU2M'] / DU2M_old + self.param['CHK_QMIN_RANGE'] = f"{CHK_QMIN_RANGE[0]} {CHK_QMIN_RANGE[1]}" + + if TU2S_old is not None: + for k in time_keys: + if k in self.param: + self.param[k] *= self.param['TU2S'] / TU2S_old + + return + + + def set_simulation_range(self,rmin=None,rmax=None): + """ + Sets the minimum and maximum distances of the simulation. + + Parameters + ---------- + rmin : float + Minimum distance of the simulation (CHK_QMIN, CHK_RMIN, CHK_QMIN_RANGE[0]) + rmax : float + Maximum distance of the simulation (CHK_RMAX, CHK_QMIN_RANGE[1]) + + Returns + ------- + Sets the appropriate param dictionary values. + + """ + CHK_QMIN_RANGE = self.param.pop('CHK_QMIN_RANGE',None) + if CHK_QMIN_RANGE is None: + CHK_QMIN_RANGE = [-1, -1] + else: + CHK_QMIN_RANGE = CHK_QMIN_RANGE.split(" ") + if rmin is not None: + self.param['CHK_QMIN'] = rmin + self.param['CHK_RMIN'] = rmin + CHK_QMIN_RANGE[0] = rmin + if rmax is not None: + self.param['CHK_RMAX'] = rmax + self.param['CHK_EJECT'] = rmax + CHK_QMIN_RANGE[1] = rmax + + self.param['CHK_QMIN_RANGE'] =f"{CHK_QMIN_RANGE[0]} {CHK_QMIN_RANGE[1]}" + + return + def add(self, plname, date=date.today().isoformat(), idval=None): """ Adds a solar system body to an existing simulation DataSet. From 585629db5e493d3505fc20aa473ec64614cbd65a Mon Sep 17 00:00:00 2001 From: David Minton Date: Tue, 8 Nov 2022 12:42:25 -0500 Subject: [PATCH 008/569] Restructured the Simulation class to accept argument-based parameters. In the new structure, the param dictionary values are set internally by what arguments are passed. This allows for arguments to be sanitized and checked for consistency and compatibility in a more robust way. --- .../Basic_Simulation/initial_conditions.py | 39 +- python/swiftest/swiftest/io.py | 3 - python/swiftest/swiftest/simulation_class.py | 529 ++++++++++++++---- 3 files changed, 433 insertions(+), 138 deletions(-) diff --git a/examples/Basic_Simulation/initial_conditions.py b/examples/Basic_Simulation/initial_conditions.py index 640330f1f..dceb33cc7 100644 --- a/examples/Basic_Simulation/initial_conditions.py +++ b/examples/Basic_Simulation/initial_conditions.py @@ -30,7 +30,7 @@ from numpy.random import default_rng # Initialize the simulation object as a variable -sim = swiftest.Simulation() +sim = swiftest.Simulation(init_cond_file_type="ASCII") # Add parameter attributes to the simulation object sim.param['T0'] = 0.0 @@ -38,40 +38,9 @@ sim.param['DT'] = 0.005 sim.param['ISTEP_OUT'] = 200 sim.param['ISTEP_DUMP'] = 200 -sim.param['OUT_FORM'] = 'XVEL' -sim.param['OUT_TYPE'] = 'NETCDF_DOUBLE' -sim.param['OUT_STAT'] = 'REPLACE' -sim.param['IN_FORM'] = 'EL' -sim.param['IN_TYPE'] = 'ASCII' -sim.param['PL_IN'] = 'pl.in' -sim.param['TP_IN'] = 'tp.in' -sim.param['CB_IN'] = 'cb.in' -sim.param['BIN_OUT'] = 'out.nc' -sim.param['CHK_QMIN'] = swiftest.RSun / swiftest.AU2M -sim.param['CHK_RMIN'] = swiftest.RSun / swiftest.AU2M -sim.param['CHK_RMAX'] = 1000.0 -sim.param['CHK_EJECT'] = 1000.0 -sim.param['CHK_QMIN_COORD'] = 'HELIO' -sim.param['CHK_QMIN_RANGE'] = f'{swiftest.RSun / swiftest.AU2M} 1000.0' -sim.param['MU2KG'] = swiftest.MSun -sim.param['TU2S'] = swiftest.YR2S -sim.param['DU2M'] = swiftest.AU2M -sim.param['EXTRA_FORCE'] = 'NO' -sim.param['BIG_DISCARD'] = 'NO' -sim.param['CHK_CLOSE'] = 'YES' -sim.param['GR'] = 'YES' -sim.param['INTERACTION_LOOPS'] = 'ADAPTIVE' -sim.param['ENCOUNTER_CHECK'] = 'ADAPTIVE' -sim.param['RHILL_PRESENT'] = 'YES' -sim.param['FRAGMENTATION'] = 'YES' -sim.param['ROTATION'] = 'YES' -sim.param['ENERGY'] = 'YES' sim.param['GMTINY'] = 1e-6 sim.param['MIN_GMFRAG'] = 1e-9 -# Set gravitational units of the system -GU = swiftest.GC / (sim.param['DU2M'] ** 3 / (sim.param['MU2KG'] * sim.param['TU2S'] ** 2)) - # Add the modern planets and the Sun using the JPL Horizons Database sim.add("Sun", idval=0, date="2022-08-08") sim.add("Mercury", idval=1, date="2022-08-08") @@ -95,9 +64,9 @@ capom_pl = default_rng().uniform(0.0, 360.0, npl) omega_pl = default_rng().uniform(0.0, 360.0, npl) capm_pl = default_rng().uniform(0.0, 360.0, npl) -GM_pl = (np.array([6e23, 8e23, 1e24, 3e24, 5e24]) / sim.param['MU2KG']) * GU -R_pl = np.full(npl, (3 * (GM_pl / GU) / (4 * np.pi * density_pl)) ** (1.0 / 3.0)) -Rh_pl = a_pl * ((GM_pl) / (3 * GU)) ** (1.0 / 3.0) +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 = np.array([0.4, 0.4, 0.4, 0.4, 0.4]) Ip2_pl = np.array([0.4, 0.4, 0.4, 0.4, 0.4]) Ip3_pl = np.array([0.4, 0.4, 0.4, 0.4, 0.4]) diff --git a/python/swiftest/swiftest/io.py b/python/swiftest/swiftest/io.py index 044f1eff5..af74e34a4 100644 --- a/python/swiftest/swiftest/io.py +++ b/python/swiftest/swiftest/io.py @@ -94,9 +94,6 @@ def read_swiftest_param(param_file_name, param, verbose=True): param['CHK_CLOSE'] = param['CHK_CLOSE'].upper() param['RHILL_PRESENT'] = param['RHILL_PRESENT'].upper() param['FRAGMENTATION'] = param['FRAGMENTATION'].upper() - if param['FRAGMENTATION'] == 'YES' and param['PARTICLE_OUT'] == '': - if param['OUT_TYPE'] == 'REAL8' or param['OUT_TYPE'] == 'REAL4': - param['PARTICLE_OUT'] = 'particle.dat' param['ROTATION'] = param['ROTATION'].upper() param['TIDES'] = param['TIDES'].upper() param['ENERGY'] = param['ENERGY'].upper() diff --git a/python/swiftest/swiftest/simulation_class.py b/python/swiftest/swiftest/simulation_class.py index b38c7b34d..38fa44d65 100644 --- a/python/swiftest/swiftest/simulation_class.py +++ b/python/swiftest/swiftest/simulation_class.py @@ -9,6 +9,7 @@ You should have received a copy of the GNU General Public License along with Swiftest. If not, see: https://www.gnu.org/licenses. """ +from __future__ import annotations from swiftest import io from swiftest import init_cond @@ -19,12 +20,166 @@ import numpy as np import os import shutil +from typing import ( + Literal, + Dict, +) + class Simulation: """ This is a class that defines the basic Swift/Swifter/Swiftest simulation object """ - def __init__(self, codename="Swiftest", param_file="param.in", readbin=False, verbose=True): + def __init__(self, + codename: Literal["Swiftest", "Swifter", "Swift"] = "Swiftest", + param_file: os.PathLike | str ="param.in", + read_param: bool = False, + init_cond_file_type: Literal["NETCDF_DOUBLE", "NETCDF_FLOAT", "ASCII"] = "NETCDF_DOUBLE", + init_cond_file_name: str | os.PathLike | Dict[str, str] | Dict[str, os.PathLike] | None = None, + init_cond_format: Literal["EL", "XV"] = "EL", + output_file_type: Literal["NETCDF_DOUBLE","NETCDF_FLOAT","REAL4","REAL8","XDR4","XDR8"] = "NETCDF_DOUBLE", + output_file_name: os.PathLike | str | None = None, + output_format: Literal["XV","XVEL"] = "XVEL", + read_old_output_file: bool = False, + MU: str = "MSUN", + DU: str = "AU", + TU: str = "Y", + MU2KG: float | None = None, + DU2M: float | None = None, + TU2S: float | None = None, + rmin: float = constants.RSun / constants.AU2M, + rmax: float = 10000.0, + close_encounter_check: bool =True, + general_relativity: bool =True, + fragmentation: bool =True, + rotation: bool = True, + compute_conservation_values: bool = False, + interaction_loops: Literal["TRIANGULAR","FLAT","ADAPTIVE"] = "TRIANGULAR", + encounter_check_loops: Literal["TRIANGULAR","SORTSWEEP","ADAPTIVE"] = "TRIANGULAR", + verbose: bool = True + ): + """ + + Parameters + ---------- + codename : {"Swiftest", "Swifter", "Swift"}, default "Swiftest" + Name of the n-body integrator that will be used. + param_file : str, path-like, or file-lke, default "param.in" + Name of the parameter input file that will be passed to the integrator. + read_param : bool, default False + If true, read in a pre-existing parameter input file given by the argument `param_file`. Otherwise, create + a new parameter file using the arguments passed to Simulation. + > *Note:* If set to true, the parameters defined in the input file will override any passed into the + > arguments of Simulation. + init_cond_file_type : {"NETCDF_DOUBLE", "NETCDF_FLOAT", "ASCII"}, default "NETCDF_DOUBLE" + The file type containing initial conditions for the simulation: + * NETCDF_DOUBLE: A single initial conditions input file in NetCDF file format of type NETCDF_DOUBLE + * NETCDF_FLOAT: A single initial conditions input file in NetCDF file format of type NETCDF_FLOAT + * ASCII : Three initial conditions files in ASCII format. The individual files define the central body, + massive body, and test particle initial conditions. + init_cond_file_name : str, path-like, or dict, optional + Name of the input initial condition file or files. Whether to pass a single file name or a dictionary + depends on the argument passed to `init_cond_file_type`: If `init_cond_file_type={"NETCDF_DOUBLE","NETCDF_FLOAT"}`, + then this will be a single file name. If `init_cond_file_type="ASCII"` then this must be a dictionary where: + ```init_cond_file_name = { + "CB" : *path to central body initial conditions file* (Swiftest only), + "PL" : *path to massive body initial conditions file*, + "TP" : *path to test particle initial conditions file* + }``` + If no file name is provided then the following default file names will be used. + * NETCDF_DOUBLE, NETCDF_FLOAT: `init_cond_file_name = "init_cond.nc"` + * ASCII: `init_cond_file_name = {"CB" : "cb.in", "PL" : "pl.in", "TP" : "tp.in"}` + init_cond_format : {"EL", "XV"}, default "EL" + Indicates whether the input initial conditions are given as orbital elements or cartesian position and + velocity vectors. + > *Note:* If `codename` is "Swift" or "Swifter", EL initial conditions are converted to XV. + output_file_type : {"NETCDF_DOUBLE", "NETCDF_FLOAT","REAL4","REAL8","XDR4","XDR8"}, default "NETCDF_DOUBLE" + The file type for the outputs of the simulation. Compatible file types depend on the `codename` argument. + * Swiftest: Only "NETCDF_DOUBLE" or "NETCDF_FLOAT" supported. + * Swifter: Only "REAL4","REAL8","XDR4" or "XDR8" supported. + * Swift: Only "REAL4" supported. + output_file_name : str or path-like, optional + Name of output file to generate. If not supplied, then one of the default file names are used, depending on + the value passed to `output_file_type`. If one of the NetCDF types are used, the default is "bin.nc". + Otherwise, the default is "bin.dat". + output_format : {"XV","XVEL"}, default "XVEL" + Specifies the format for the data saved to the output file. If "XV" then cartesian position and velocity + vectors for all bodies are stored. If "XVEL" then the orbital elements are also stored. + read_old_output_file : bool, default False + If true, read in a pre-existing binary input file given by the argument `output_file_name`. + MU : str, default "MSUN" + The mass unit system to use. Case-insensitive valid options are: + * "Msun" : Solar mass + * "Mearth" : Earth mass + * "kg" : kilograms + * "g" : grams + DU : str, optional + The distance unit system to use. Case-insensitive valid options are: + * "AU" : Astronomical Unit + * "Rearth" : Earth radius + * "m" : meter + * "cm" : centimeter + TU : str, optional + The time unit system to use. Case-insensitive valid options are: + * "YR" : Year + * "DAY" : Julian day + * "d" : Julian day + * "JD" : Julian day + * "s" : second + MU2KG: float, optional + The conversion factor to multiply by the mass unit that would convert it to kilogram. + Setting this overrides MU + DU2M : float, optional + The conversion factor to multiply by the distance unit that would convert it to meter. + Setting this overrides DU + TU2S : float, optional + The conversion factor to multiply by the time unit that would convert it to seconds. + Setting this overrides TU + rmin : float, default value is the radius of the Sun in the unit system defined by the unit input arguments. + Minimum distance of the simulation (CHK_QMIN, CHK_RMIN, CHK_QMIN_RANGE[0]) + rmax : float, default value is 10000 AU in the unit system defined by the unit input arguments. + Maximum distance of the simulation (CHK_RMAX, CHK_QMIN_RANGE[1]) + close_encounter_check : bool, default True + Check for close encounters between bodies. If set to True, then the radii of massive bodies must be included + in initial conditions. + general_relativity : bool, default True + Include the post-Newtonian correction in acceleration calculations. + fragmentation : bool, default True + If set to True, this turns on the Fraggle fragment generation code and `rotation` must also be True. + This argument only applies to Swiftest-SyMBA simulations. It will be ignored otherwise. + rotation : bool, default True + If set to True, this turns on rotation tracking and radius, rotation vector, and moments of inertia values + must be included in the initial conditions. + This argument only applies to Swiftest-SyMBA simulations. It will be ignored otherwise. + compute_conservation_values : bool, default False + Turns on the computation of energy, angular momentum, and mass conservation and reports the values + every output step of a running simulation. + interaction_loops : {"TRIANGULAR","FLAT","ADAPTIVE"}, default "TRIANGULAR" + *Swiftest Experimental feature* + Specifies which algorithm to use for the computation of body-body gravitational forces. + * "TRIANGULAR" : Upper-triangular double-loops . + * "FLAT" : Body-body interation pairs are flattened into a 1-D array. + * "ADAPTIVE" : Periodically times the TRIANGULAR and FLAT methods and determines which one to use based on + the wall time to complete the loop. *Note:* Using ADAPTIVE means that bit-identical repeatability cannot + be assured, as the choice of algorithm depends on possible external factors that can influence the wall + time calculation. The exact floating-point results of the interaction will be different between the two + algorithm types. + encounter_check_loops : {"TRIANGULAR","SORTSWEEP","ADAPTIVE"}, default "TRIANGULAR" + *Swiftest Experimental feature* + Specifies which algorithm to use for checking whether bodies are in a close encounter state or not. + * "TRIANGULAR" : Upper-triangular double-loops. + * "SORTSWEEP" : A Sort-Sweep algorithm is used to reduce the population of potential close encounter bodies. + This algorithm is still in development, and does not necessarily speed up the encounter checking. + Use with caution. + * "ADAPTIVE" : Periodically times the TRIANGULAR and SORTSWEEP methods and determines which one to use based + on the wall time to complete the loop. *Note:* Using ADAPTIVE means that bit-identical repeatability cannot + be assured, as the choice of algorithm depends on possible external factors that can influence the wall + time calculation. The exact floating-point results of the interaction will be different between the two + algorithm types. + verbose : bool, default True + If set to True, then more information is printed by Simulation methods as they are executed. Setting to + False suppresses most messages other than errors. + """ self.ds = xr.Dataset() self.param = { '! VERSION': f"Swiftest parameter input", @@ -32,42 +187,48 @@ def __init__(self, codename="Swiftest", param_file="param.in", readbin=False, ve 'TSTART' : 0.0, 'TSTOP': 0.0, 'DT': 0.0, - 'IN_FORM': "XV", - 'IN_TYPE': "NETCDF_DOUBLE", - 'NC_IN' : "init_cond.nc", 'ISTEP_OUT': 1, 'ISTEP_DUMP': 1, - 'BIN_OUT': "bin.nc", - 'OUT_TYPE': 'NETCDF_DOUBLE', - 'OUT_FORM': "XVEL", - 'OUT_STAT': "REPLACE", 'CHK_QMIN_COORD': "HELIO", - 'ENC_OUT': "", 'EXTRA_FORCE': "NO", - 'DISCARD_OUT': "", - 'PARTICLE_OUT' : "", 'BIG_DISCARD': "NO", 'CHK_CLOSE': "YES", 'RHILL_PRESENT': "YES", - 'FRAGMENTATION': "NO", - 'ROTATION': "NO", + 'FRAGMENTATION': "YES", + 'ROTATION': "YES", 'TIDES': "NO", - 'ENERGY': "NO", + 'ENERGY': "YES", 'GR': "YES", - 'INTERACTION_LOOPS': "TRIANGULAR", - 'ENCOUNTER_CHECK': "TRIANGULAR" + 'INTERACTION_LOOPS': interaction_loops, + 'ENCOUNTER_CHECK': encounter_check_loops } self.codename = codename self.verbose = verbose - self.set_simulation_range(rmin=constants.RSun, rmax=1000.0) - self.set_unit_system() + + self.set_distance_range(rmin=rmin, rmax=rmax) + + self.set_unit_system(MU=MU, DU=DU, TU=TU, + MU2KG=MU2KG, DU2M=DU2M, TU2S=TU2S, + recompute_values=True) + + self.set_init_cond_files(init_cond_file_type=init_cond_file_type, + init_cond_file_name=init_cond_file_name, + init_cond_format=init_cond_format) + + self.set_output_files(output_file_type=output_file_type, + output_file_name=output_file_name, + output_format=output_format ) # If the parameter file is in a different location than the current working directory, we will need # to use it to properly open bin files self.sim_dir = os.path.dirname(os.path.realpath(param_file)) - if os.path.exists(param_file): - self.read_param(param_file, codename=codename, verbose=self.verbose) - if readbin: + if read_param: + if os.path.exists(param_file): + self.read_param(param_file, codename=codename, verbose=self.verbose) + else: + print(f"{param_file} not found.") + + if read_old_output_file: binpath = os.path.join(self.sim_dir,self.param['BIN_OUT']) if os.path.exists(binpath): self.bin2xr() @@ -76,7 +237,163 @@ def __init__(self, codename="Swiftest", param_file="param.in", readbin=False, ve return - def set_unit_system(self,MU="Msun",DU="AU",TU="YR",MU2KG=None,DU2M=None,TU2S=None): + def set_init_cond_files(self, + init_cond_file_type: Literal["NETCDF_DOUBLE", "NETCDF_FLOAT", "ASCII"], + init_cond_file_name: str | os.PathLike | Dict[str, str] | Dict[str, os.PathLike] | None, + init_cond_format: Literal["EL", "XV"]): + """ + Sets the initial condition file parameters in the parameters dictionary. + + Parameters + ---------- + init_cond_file_type : {"NETCDF_DOUBLE", "NETCDF_FLOAT", "ASCII"} + The file type containing initial conditions for the simulation: + * NETCDF_DOUBLE: A single initial conditions input file in NetCDF file format of type NETCDF_DOUBLE + * NETCDF_FLOAT: A single initial conditions input file in NetCDF file format of type NETCDF_FLOAT + * ASCII : Three initial conditions files in ASCII format. The individual files define the central body, + massive body, and test particle initial conditions. + init_cond_file_name : str, path-like, or dict, optional + Name of the input initial condition file or files. Whether to pass a single file name or a dictionary + depends on the argument passed to `init_cond_file_type`: If `init_cond_file_type={"NETCDF_DOUBLE","NETCDF_FLOAT"}`, + then this will be a single file name. If `init_cond_file_type="ASCII"` then this must be a dictionary where: + ```init_cond_file_name = { + "CB" : *path to central body initial conditions file* (Swiftest only), + "PL" : *path to massive body initial conditions file*, + "TP" : *path to test particle initial conditions file* + }``` + If no file name is provided then the following default file names will be used. + * NETCDF_DOUBLE, NETCDF_FLOAT: `init_cond_file_name = "init_cond.nc"` + * ASCII: `init_cond_file_name = {"CB" : "cb.in", "PL" : "pl.in", "TP" : "tp.in"}` + init_cond_format : {"EL", "XV"} + Indicates whether the input initial conditions are given as orbital elements or cartesian position and + velocity vectors. + > *Note:* If `codename` is "Swift" or "Swifter", EL initial conditions are converted to XV. + + Returns + ------- + Sets the appropriate initial conditions file parameters inside the self.param dictionary. + + """ + + def ascii_file_input_error_msg(codename): + print(f"Error in set_init_cond_files: init_cond_file_name must be a dictionary of the form: ") + print('{') + if codename == "Swiftest": + print('"CB" : *path to central body initial conditions file*,') + print('"PL" : *path to massive body initial conditions file*,') + print('"TP" : *path to test particle initial conditions file*') + print('}') + return + + if self.codename == "Swiftest": + init_cond_keys = ["CB", "PL", "TP"] + else: + init_cond_keys = ["PL", "TP"] + if init_cond_file_type != "ASCII": + print(f"{init_cond_file_type} is not supported by {self.codename}. Using ASCII instead") + init_cond_file_type="ASCII" + if init_cond_format != "XV": + print(f"{init_cond_format} is not supported by {self.codename}. Using XV instead") + init_cond_format = "XV" + + self.param["IN_TYPE"] = init_cond_file_type + self.param["IN_FORM"] = init_cond_format + + if init_cond_file_type == "ASCII": + if init_cond_file_name is None: + # No file names passed, so we will just use the defaults. + for key in init_cond_keys: + self.param[f"{key}_IN"] = f"{key.lower()}.in" + elif type(init_cond_file_name) is not dict: + # Oops, accidentally passed a single string or path-like instead of the expected dictionary for ASCII + # input type. + ascii_file_input_error_msg(self.codename) + elif not all(key in init_cond_file_name for key in init_cond_keys): + # This is the case where the dictionary doesn't have all the keys we expect. Print an error message. + ascii_file_input_error_msg(self.codename) + else: + # A valid initial conditions file dictionary was passed. + for key in init_cond_keys: + self.param[f"{key}_IN"] = init_cond_file_name[key] + else: + if init_cond_file_name is None: + # No file names passed, so we will just use the default. + self.param["NC_IN"] = "init_cond.nc" + elif type(init_cond_file_name) is dict: + # Oops, accidentally passed a dictionary instead of the expected single string or path-like for NetCDF + # input type. + print(f"Only a single input file is used for NetCDF files") + else: + self.param["NC_IN"] = init_cond_file_name + + return + + def set_output_files(self, + output_file_type: Literal[ "NETCDF_DOUBLE", "NETCDF_FLOAT", "REAL4", "REAL8", "XDR4", "XDR8"], + output_file_name: os.PathLike | str | None, + output_format: Literal["XV", "XVEL"] + ): + """ + Sets the output file parameters in the parameters dictionary. + + Parameters + ---------- + output_file_type : {"NETCDF_DOUBLE", "NETCDF_FLOAT","REAL4","REAL8","XDR4","XDR8"}, default "NETCDF_DOUBLE" + The file type for the outputs of the simulation. Compatible file types depend on the `codename` argument. + * Swiftest: Only "NETCDF_DOUBLE" or "NETCDF_FLOAT" supported. + * Swifter: Only "REAL4","REAL8","XDR4" or "XDR8" supported. + * Swift: Only "REAL4" supported. + output_file_name : str or path-like, optional + Name of output file to generate. If not supplied, then one of the default file names are used, depending on + the value passed to `output_file_type`. If one of the NetCDF types are used, the default is "bin.nc". + Otherwise, the default is "bin.dat". + output_format : {"XV","XVEL"}, default "XVEL" + Specifies the format for the data saved to the output file. If "XV" then cartesian position and velocity + vectors for all bodies are stored. If "XVEL" then the orbital elements are also stored. + + Returns + ------- + Sets the appropriate initial conditions file parameters inside the self.param dictionary. + + """ + + if self.codename == "Swiftest": + if output_file_type not in ["NETCDF_DOUBLE", "NETCDF_FLOAT"]: + print(f"{output_file_type} is not compatible with Swiftest. Setting to NETCDF_DOUBLE") + output_file_type = "NETCDF_DOUBLE" + elif self.codename == "Swifter": + if output_file_type not in ["REAL4","REAL8","XDR4","XDR8"]: + print(f"{output_file_type} is not compatible with Swifter. Setting to REAL8") + output_file_type = "REAL8" + elif self.codename == "Swift": + if output_file_type not in ["REAL4"]: + print(f"{output_file_type} is not compatible with Swift. Setting to REAL4") + output_file_type = "REAL4" + + self.param['OUT_TYPE'] = output_file_type + if output_file_name is None: + if output_file_type in ["NETCDF_DOUBLE", "NETCDF_FLOAT"]: + self.param['BIN_OUT'] = "bin.nc" + else: + self.param['BIN_OUT'] = "bin.dat" + else: + self.param['BIN_OUT'] = output_file_name + + if output_format != "XV" and self.codename != "Swiftest": + print(f"{output_format} is not compatible with {self.codename}. Setting to XV") + output_format = "XV" + self.param['OUT_FORM'] = output_format + + return + + def set_unit_system(self, + MU: str | None = None, + DU: str | None = None, + TU: str | None = None, + MU2KG: float | None = None, + DU2M: float | None = None, + TU2S: float | None = None, + recompute_values: bool = False): """ Setter for setting the unit conversion between one of the standard sets. @@ -90,111 +407,121 @@ def set_unit_system(self,MU="Msun",DU="AU",TU="YR",MU2KG=None,DU2M=None,TU2S=Non Parameters ---------- - MU : str, default "Msun" + MU : str, optional The mass unit system to use. Case-insensitive valid options are: "Msun" : Solar mass "Mearth" : Earth mass "kg" : kilograms "g" : grams - - DU : str, default "AU" + DU : str, optional The distance unit system to use. Case-insensitive valid options are: "AU" : Astronomical Unit "Rearth" : Earth radius "m" : meter "cm" : centimeter - - TU : str, default "YR" + TU : str, optional The time unit system to use. Case-insensitive valid options are: "YR" : Year "DAY" : Julian day "d" : Julian day "JD" : Julian day "s" : second - - MU2KG : float, default `None` - The conversion factor to multiply by the mass unit that would convert it to kilogram. Setting this overrides MU - - DU2M : float, default `None` - The conversion factor to multiply by the distance unit that would convert it to meter. Setting this overrides DU - - TU2S : float, default `None` - The conversion factor to multiply by the time unit that would convert it to seconds. Setting this overrides TU + MU2KG : float, optional + The conversion factor to multiply by the mass unit that would convert it to kilogram. + Setting this overrides MU + DU2M : float, optional + The conversion factor to multiply by the distance unit that would convert it to meter. + Setting this overrides DU + TU2S : float, optional + The conversion factor to multiply by the time unit that would convert it to seconds. + Setting this overrides TU + recompute_values : bool, default False + Recompute all values into the new unit system. + >*Note:* This is a destructive operation, however if not executed then the values contained in the parameter + > file and input/output data files computed previously may not be consistent with the new unit conversion + > factors. Returns ---------- - Sets the values of MU2KG, DU2M, and TU2S in the param dictionary to the appropriate units. Also computes the gravitational constant, GU + Sets the values of MU2KG, DU2M, and TU2S in the param dictionary to the appropriate units. Also computes the + gravitational constant, self.GU and recomput """ - # Save the previously set values of the unit conversion factors so we can update parameters as needed - MU2KG_old = self.param.pop('MU2KG',None) - DU2M_old = self.param.pop('DU2M',None) - TU2S_old = self.param.pop('TU2S',None) + MU2KG_old = None + DU2M_old = None + TU2S_old = None - if MU2KG is not None: - self.param['MU2KG'] = MU2KG - self.MU_name = None - else: - if MU.upper() == "MSUN": - self.param['MU2KG'] = constants.MSun - self.MU_name = "MSun" - elif MU.upper() == "MEARTH": - self.param['MU2KG'] = constants.MEarth - self.MU_name = "MEarth" - elif MU.upper() == "KG": - self.param['MU2KG'] = 1.0 - self.MU_name = "kg" - elif MU.upper() == "G": - self.param['MU2KG'] = 1000.0 - self.MU_name = "g" + if MU2KG is not None or MU is not None: + MU2KG_old = self.param.pop('MU2KG',None) + if MU2KG is not None: + self.param['MU2KG'] = MU2KG + self.MU_name = None else: - print(f"{MU} not a recognized unit system. Using MSun as a default.") - self.param['MU2KG'] = constants.MSun - self.MU_name = "MSun" - - if DU2M is not None: - self.param['DU2M'] = DU2M - self.DU_name = None - else: - if DU.upper() == "AU": - self.param['DU2M'] = constants.AU2M - self.DU_name = "AU" - elif DU.upper() == "REARTH": - self.param['DU2M'] = constants.REarth - self.DU_name = "REarth" - elif DU.upper() == "M": - self.param['DU2M'] = 1.0 - self.DU_name = "m" - elif DU.upper() == "CM": - self.param['DU2M'] = 100.0 - self.DU_name = "cm" + if MU.upper() == "MSUN": + self.param['MU2KG'] = constants.MSun + self.MU_name = "MSun" + elif MU.upper() == "MEARTH": + self.param['MU2KG'] = constants.MEarth + self.MU_name = "MEarth" + elif MU.upper() == "KG": + self.param['MU2KG'] = 1.0 + self.MU_name = "kg" + elif MU.upper() == "G": + self.param['MU2KG'] = 1000.0 + self.MU_name = "g" + else: + print(f"{MU} not a recognized unit system. Using MSun as a default.") + self.param['MU2KG'] = constants.MSun + self.MU_name = "MSun" + + if DU2M is not None or DU is not None: + DU2M_old = self.param.pop('DU2M',None) + if DU2M is not None: + self.param['DU2M'] = DU2M + self.DU_name = None else: - print(f"{DU} not a recognized unit system. Using AU as a default.") - self.param['DU2M'] = constants.AU2M - self.DU_name = "AU" - - if TU2S is not None: - self.param['TU2S'] = TU2S - self.TU_name = None - else: - if TU.upper() == "YR" or TU.upper() == "Y" or TU.upper() == "YEAR" or TU.upper() == "YEARS": - self.param['TU2S'] = constants.YR2S - self.TU_name = "y" - elif TU.upper() == "DAY" or TU.upper() == "D" or TU.upper() == "JD" or TU.upper() == "DAYS": - self.param['TU2S'] = constants.JD2S - self.TU_name = "Day" - elif TU.upper() == "S" or TU.upper() == "SECONDS" or TU.upper() == "SEC": - self.param['TU2S'] = 1.0 - self.TU_name = "s" + if DU.upper() == "AU": + self.param['DU2M'] = constants.AU2M + self.DU_name = "AU" + elif DU.upper() == "REARTH": + self.param['DU2M'] = constants.REarth + self.DU_name = "REarth" + elif DU.upper() == "M": + self.param['DU2M'] = 1.0 + self.DU_name = "m" + elif DU.upper() == "CM": + self.param['DU2M'] = 100.0 + self.DU_name = "cm" + else: + print(f"{DU} not a recognized unit system. Using AU as a default.") + self.param['DU2M'] = constants.AU2M + self.DU_name = "AU" + + if TU2S is not None or TU is not None: + TU2S_old = self.param.pop('TU2S',None) + if TU2S is not None: + self.param['TU2S'] = TU2S + self.TU_name = None else: - print(f"{TU} not a recognized unit system. Using YR as a default.") - self.param['TU2S'] = constants.YR2S - self.TU_name = "y" + if TU.upper() == "YR" or TU.upper() == "Y" or TU.upper() == "YEAR" or TU.upper() == "YEARS": + self.param['TU2S'] = constants.YR2S + self.TU_name = "y" + elif TU.upper() == "DAY" or TU.upper() == "D" or TU.upper() == "JD" or TU.upper() == "DAYS": + self.param['TU2S'] = constants.JD2S + self.TU_name = "Day" + elif TU.upper() == "S" or TU.upper() == "SECONDS" or TU.upper() == "SEC": + self.param['TU2S'] = 1.0 + self.TU_name = "s" + else: + print(f"{TU} not a recognized unit system. Using YR as a default.") + self.param['TU2S'] = constants.YR2S + self.TU_name = "y" self.VU_name = f"{self.DU_name}/{self.TU_name}" - self.GC = constants.GC * self.param['TU2S']**2 * self.param['MU2KG'] / self.param['DU2M']**3 + self.GU = constants.GC * self.param['TU2S']**2 * self.param['MU2KG'] / self.param['DU2M']**3 - self.update_param_units(MU2KG_old, DU2M_old, TU2S_old) + if recompute_values: + self.update_param_units(MU2KG_old, DU2M_old, TU2S_old) if self.verbose: if self.MU_name is None or self.DU_name is None or self.TU_name is None: @@ -253,7 +580,7 @@ def update_param_units(self,MU2KG_old,DU2M_old,TU2S_old): return - def set_simulation_range(self,rmin=None,rmax=None): + def set_distance_range(self,rmin=None,rmax=None): """ Sets the minimum and maximum distances of the simulation. @@ -287,6 +614,8 @@ def set_simulation_range(self,rmin=None,rmax=None): return + + def add(self, plname, date=date.today().isoformat(), idval=None): """ Adds a solar system body to an existing simulation DataSet. From ccb405feb287cb0fe1dbd09668003d4c7486c7bc Mon Sep 17 00:00:00 2001 From: David Minton Date: Tue, 8 Nov 2022 14:58:59 -0500 Subject: [PATCH 009/569] Updated parameter "YES" and "NO" values to boolean on the Python side. Wrote a feature setter and getter that sets the boolean values of the simulation parameters --- python/swiftest/swiftest/io.py | 179 ++++++++++++------ python/swiftest/swiftest/simulation_class.py | 180 +++++++++++++++++-- 2 files changed, 289 insertions(+), 70 deletions(-) diff --git a/python/swiftest/swiftest/io.py b/python/swiftest/swiftest/io.py index af74e34a4..b12d32cd3 100644 --- a/python/swiftest/swiftest/io.py +++ b/python/swiftest/swiftest/io.py @@ -17,8 +17,72 @@ import tempfile import re -newfeaturelist = ("FRAGMENTATION", "ROTATION", "TIDES", "ENERGY", "GR", "YARKOVSKY", "YORP", "IN_FORM") +newfeaturelist = ("FRAGMENTATION", "ROTATION", "TIDES", "ENERGY", "GR", "YARKOVSKY", "YORP", "IN_FORM", "SEED", "INTERACTION_LOOPS", "ENCOUNTER_CHECK") string_varnames = ["name", "particle_type", "status", "origin_type"] +bool_param = ["CHK_CLOSE", "EXTRA_FORCE", "RHILL_PRESENT", "BIG_DISCARD", "FRAGMENTATION", "ROTATION", "TIDES", "ENERGY", "GR", "YARKOVSKY", "YORP"] + +def bool2yesno(boolval): + """ + Converts a boolean into a string of either "YES" or "NO". + + Parameters + ---------- + boolval : bool + Input value + + Returns + ------- + {"YES","NO"} + + """ + if boolval: + return "YES" + else: + return "NO" + +def bool2tf(boolval): + """ + Converts a boolean into a string of either "T" or "F". + + Parameters + ---------- + boolval : bool + Input value + + Returns + ------- + {"T","F"} + + """ + if boolval: + return "T" + else: + return "F" + +def str2bool(input_str): + """ + Converts a string into an equivalent boolean. + + Parameters + ---------- + input_str : {"YES", "Y", "T", "TRUE", ".TRUE.", "NO", "N", "F", "FALSE", ".FALSE."} + Input string. Input is case-insensitive. + + Returns + ------- + {True, False} + + """ + valid_true = ["YES", "Y", "T", "TRUE", ".TRUE."] + valid_false = ["NO", "N", "F", "FALSE", ".FALSE."] + if input_str.upper() in valid_true: + return True + elif input_str.lower() in valid_false: + return False + else: + raise ValueError(f"{input_str} cannot is not recognized as boolean") + + def real2float(realstr): """ @@ -27,7 +91,7 @@ def real2float(realstr): Parameters ---------- - realstr : string + realstr : str Fortran-generated ASCII string of a real value. Returns @@ -89,21 +153,15 @@ def read_swiftest_param(param_file_name, param, verbose=True): param['DU2M'] = real2float(param['DU2M']) param['MU2KG'] = real2float(param['MU2KG']) param['TU2S'] = real2float(param['TU2S']) - param['EXTRA_FORCE'] = param['EXTRA_FORCE'].upper() - param['BIG_DISCARD'] = param['BIG_DISCARD'].upper() - param['CHK_CLOSE'] = param['CHK_CLOSE'].upper() - param['RHILL_PRESENT'] = param['RHILL_PRESENT'].upper() - param['FRAGMENTATION'] = param['FRAGMENTATION'].upper() - param['ROTATION'] = param['ROTATION'].upper() - param['TIDES'] = param['TIDES'].upper() - param['ENERGY'] = param['ENERGY'].upper() - param['GR'] = param['GR'].upper() param['INTERACTION_LOOPS'] = param['INTERACTION_LOOPS'].upper() param['ENCOUNTER_CHECK'] = param['ENCOUNTER_CHECK'].upper() if 'GMTINY' in param: param['GMTINY'] = real2float(param['GMTINY']) if 'MIN_GMFRAG' in param: param['MIN_GMFRAG'] = real2float(param['MIN_GMFRAG']) + for b in bool_param: + if b in param: + param[b] = str2bool(param[b]) except IOError: print(f"{param_file_name} not found.") return param @@ -139,7 +197,7 @@ def read_swifter_param(param_file_name, verbose=True): 'OUT_STAT': "NEW", 'J2': "0.0", 'J4': "0.0", - 'CHK_CLOSE': 'NO', + 'CHK_CLOSE': False, 'CHK_RMIN': "-1.0", 'CHK_RMAX': "-1.0", 'CHK_EJECT': "-1.0", @@ -147,9 +205,9 @@ def read_swifter_param(param_file_name, verbose=True): 'CHK_QMIN_COORD': "HELIO", 'CHK_QMIN_RANGE': "", 'ENC_OUT': "", - 'EXTRA_FORCE': 'NO', - 'BIG_DISCARD': 'NO', - 'RHILL_PRESENT': 'NO', + 'EXTRA_FORCE': False, + 'BIG_DISCARD': False, + 'RHILL_PRESENT': False, 'C': "-1.0", } @@ -179,10 +237,9 @@ def read_swifter_param(param_file_name, verbose=True): param['CHK_RMAX'] = real2float(param['CHK_RMAX']) param['CHK_EJECT'] = real2float(param['CHK_EJECT']) param['CHK_QMIN'] = real2float(param['CHK_QMIN']) - param['EXTRA_FORCE'] = param['EXTRA_FORCE'].upper() - param['BIG_DISCARD'] = param['BIG_DISCARD'].upper() - param['CHK_CLOSE'] = param['CHK_CLOSE'].upper() - param['RHILL_PRESENT'] = param['RHILL_PRESENT'].upper() + for b in bool_param: + if b in param: + param[b] = str2bool(param[b]) if param['C'] != '-1.0': param['C'] = real2float(param['C']) else: @@ -349,10 +406,18 @@ def write_labeled_param(param, param_file_name): # Print the list of key/value pairs in the preferred order for key in keylist: val = ptmp.pop(key, None) - if val is not None: print(f"{key:<16} {val}", file=outfile) + if val is not None: + if type(val) is bool: + print(f"{key:<16} {bool2yesno(val)}", file=outfile) + else: + print(f"{key:<16} {val}", file=outfile) # Print the remaining key/value pairs in whatever order for key, val in ptmp.items(): - if val != "": print(f"{key:<16} {val}", file=outfile) + if val != "": + if type(val) is bool: + print(f"{key:<16} {bool2yesno(val)}", file=outfile) + else: + print(f"{key:<16} {val}", file=outfile) outfile.close() return @@ -483,12 +548,12 @@ def make_swiftest_labels(param): tlab.append('capm') plab = tlab.copy() plab.append('Gmass') - if param['CHK_CLOSE'] == 'YES': + if param['CHK_CLOSE']: plab.append('radius') - if param['RHILL_PRESENT'] == 'YES': + if param['RHILL_PRESENT']: plab.append('rhill') clab = ['Gmass', 'radius', 'j2rp2', 'j4rp4'] - if param['ROTATION'] == 'YES': + if param['ROTATION']: clab.append('Ip1') clab.append('Ip2') clab.append('Ip3') @@ -501,7 +566,7 @@ def make_swiftest_labels(param): plab.append('rotx') plab.append('roty') plab.append('rotz') - if param['TIDES'] == 'YES': + if param['TIDES']: clab.append('k2') clab.append('Q') plab.append('k2') @@ -588,14 +653,14 @@ def swiftest_stream(f, param): Rcb = f.read_reals(np.float64) J2cb = f.read_reals(np.float64) J4cb = f.read_reals(np.float64) - if param['ROTATION'] == 'YES': + if param['ROTATION']: Ipcbx = f.read_reals(np.float64) Ipcby = f.read_reals(np.float64) Ipcbz = f.read_reals(np.float64) rotcbx = f.read_reals(np.float64) rotcby = f.read_reals(np.float64) rotcbz = f.read_reals(np.float64) - if param['TIDES'] == 'YES': + if param['TIDES']: k2cb = f.read_reals(np.float64) Qcb = f.read_reals(np.float64) if npl[0] > 0: @@ -619,17 +684,17 @@ def swiftest_stream(f, param): p11 = f.read_reals(np.float64) p12 = f.read_reals(np.float64) GMpl = f.read_reals(np.float64) - if param['RHILL_PRESENT'] == 'YES': + if param['RHILL_PRESENT']: rhill = f.read_reals(np.float64) Rpl = f.read_reals(np.float64) - if param['ROTATION'] == 'YES': + if param['ROTATION']: Ipplx = f.read_reals(np.float64) Ipply = f.read_reals(np.float64) Ipplz = f.read_reals(np.float64) rotplx = f.read_reals(np.float64) rotply = f.read_reals(np.float64) rotplz = f.read_reals(np.float64) - if param['TIDES'] == 'YES': + if param['TIDES']: k2pl = f.read_reals(np.float64) Qpl = f.read_reals(np.float64) if ntp[0] > 0: @@ -679,14 +744,14 @@ def swiftest_stream(f, param): tpid = np.empty(0) tpnames = np.empty(0) cvec = np.array([Mcb, Rcb, J2cb, J4cb]) - if param['RHILL_PRESENT'] == 'YES': + if param['RHILL_PRESENT']: if npl > 0: pvec = np.vstack([pvec, rhill]) - if param['ROTATION'] == 'YES': + if param['ROTATION']: cvec = np.vstack([cvec, Ipcbx, Ipcby, Ipcbz, rotcbx, rotcby, rotcbz]) if npl > 0: pvec = np.vstack([pvec, Ipplx, Ipply, Ipplz, rotplx, rotply, rotplz]) - if param['TIDES'] == 'YES': + if param['TIDES']: cvec = np.vstack([cvec, k2cb, Qcb]) if npl > 0: pvec = np.vstack([pvec, k2pl, Qpl]) @@ -1018,14 +1083,14 @@ def swiftest_xr2infile(ds, param, in_type="NETCDF_DOUBLE", infile_name=None,fram tp = frame.where(np.isnan(frame['Gmass']), drop=True).drop_vars(['Gmass', 'radius', 'j2rp2', 'j4rp4'],errors="ignore") GMSun = np.double(cb['Gmass']) - if param['CHK_CLOSE'] == 'YES': + if param['CHK_CLOSE']: RSun = np.double(cb['radius']) else: RSun = param['CHK_RMIN'] J2 = np.double(cb['j2rp2']) J4 = np.double(cb['j4rp4']) cbname = cb['name'].values[0] - if param['ROTATION'] == 'YES': + if param['ROTATION']: Ip1cb = np.double(cb['Ip1']) Ip2cb = np.double(cb['Ip2']) Ip3cb = np.double(cb['Ip3']) @@ -1042,7 +1107,7 @@ def swiftest_xr2infile(ds, param, in_type="NETCDF_DOUBLE", infile_name=None,fram print(RSun, file=cbfile) print(J2, file=cbfile) print(J4, file=cbfile) - if param['ROTATION'] == 'YES': + if param['ROTATION']: print(Ip1cb, Ip2cb, Ip3cb, file=cbfile) print(rotxcb, rotycb, rotzcb, file=cbfile) cbfile.close() @@ -1051,11 +1116,11 @@ def swiftest_xr2infile(ds, param, in_type="NETCDF_DOUBLE", infile_name=None,fram print(pl.id.count().values, file=plfile) for i in pl.id: pli = pl.sel(id=i) - if param['RHILL_PRESENT'] == 'YES': + if param['RHILL_PRESENT']: print(pli['name'].values[0], pli['Gmass'].values[0], pli['rhill'].values[0], file=plfile) else: print(pli['name'].values[0], pli['Gmass'].values[0], file=plfile) - if param['CHK_CLOSE'] == 'YES': + if param['CHK_CLOSE']: print(pli['radius'].values[0], file=plfile) if param['IN_FORM'] == 'XV': print(pli['xhx'].values[0], pli['xhy'].values[0], pli['xhz'].values[0], file=plfile) @@ -1065,7 +1130,7 @@ def swiftest_xr2infile(ds, param, in_type="NETCDF_DOUBLE", infile_name=None,fram print(pli['capom'].values[0], pli['omega'].values[0], pli['capm'].values[0], file=plfile) else: print(f"{param['IN_FORM']} is not a valid input format type.") - if param['ROTATION'] == 'YES': + if param['ROTATION']: print(pli['Ip1'].values[0], pli['Ip2'].values[0], pli['Ip3'].values[0], file=plfile) print(pli['rotx'].values[0], pli['roty'].values[0], pli['rotz'].values[0], file=plfile) plfile.close() @@ -1114,7 +1179,7 @@ def swifter_xr2infile(ds, param, framenum=-1): tp = frame.where(np.isnan(frame['Gmass']), drop=True).drop_vars(['Gmass', 'radius', 'j2rp2', 'j4rp4']) GMSun = np.double(cb['Gmass']) - if param['CHK_CLOSE'] == 'YES': + if param['CHK_CLOSE']: RSun = np.double(cb['radius']) else: RSun = param['CHK_RMIN'] @@ -1130,11 +1195,11 @@ def swifter_xr2infile(ds, param, framenum=-1): print('0.0 0.0 0.0', file=plfile) for i in pl.id: pli = pl.sel(id=i) - if param['RHILL_PRESENT'] == "YES": + if param['RHILL_PRESENT']: print(i.values, pli['Gmass'].values, pli['rhill'].values, file=plfile) else: print(i.values, pli['Gmass'].values, file=plfile) - if param['CHK_CLOSE'] == "YES": + if param['CHK_CLOSE']: print(pli['radius'].values, file=plfile) print(pli['xhx'].values, pli['xhy'].values, pli['xhz'].values, file=plfile) print(pli['vhx'].values, pli['vhy'].values, pli['vhz'].values, file=plfile) @@ -1181,10 +1246,10 @@ def swift2swifter(swift_param, plname="", tpname="", conversion_questions={}): intxt = input("Is this a SyMBA input file with RHILL values in pl.in? (y/N)> ") if intxt.upper() == 'Y': isSyMBA = True - swifter_param['RHILL_PRESENT'] = 'YES' + swifter_param['RHILL_PRESENT'] = True else: isSyMBA = False - swifter_param['RHILL_PRESENT'] = 'NO' + swifter_param['RHILL_PRESENT'] = False isDouble = conversion_questions.get('DOUBLE', None) if not isDouble: @@ -1212,9 +1277,9 @@ def swift2swifter(swift_param, plname="", tpname="", conversion_questions={}): swifter_param['OUT_FORM'] = 'XV' if swift_param['LCLOSE'] == "T": - swifter_param['CHK_CLOSE'] = "YES" + swifter_param['CHK_CLOSE'] = True else: - swifter_param['CHK_CLOSE'] = "NO" + swifter_param['CHK_CLOSE'] = False swifter_param['CHK_RMIN'] = swift_param['RMIN'] swifter_param['CHK_RMAX'] = swift_param['RMAX'] @@ -1253,17 +1318,17 @@ def swift2swifter(swift_param, plname="", tpname="", conversion_questions={}): if not intxt: intxt = input("EXTRA_FORCE: Use additional user-specified force routines? (y/N)> ") if intxt.upper() == 'Y': - swifter_param['EXTRA_FORCE'] = 'YES' + swifter_param['EXTRA_FORCE'] = True else: - swifter_param['EXTRA_FORCE'] = 'NO' + swifter_param['EXTRA_FORCE'] = False intxt = conversion_questions.get('BIG_DISCARD', None) if not intxt: intxt = input("BIG_DISCARD: include data for all bodies > GMTINY for each discard record? (y/N)> ") if intxt.upper() == 'Y': - swifter_param['BIG_DISCARD'] = 'YES' + swifter_param['BIG_DISCARD'] = True else: - swifter_param['BIG_DISCARD'] = 'NO' + swifter_param['BIG_DISCARD'] = False # Convert the PL file if plname == '': @@ -1309,11 +1374,11 @@ def swift2swifter(swift_param, plname="", tpname="", conversion_questions={}): else: if swift_param['LCLOSE'] == "T": plrad = real2float(i_list[1]) - if swifter_param['RHILL_PRESENT'] == 'YES': + if swifter_param['RHILL_PRESENT']: print(n + 1, GMpl, rhill, file=plnew) else: print(n + 1, GMpl, file=plnew) - if swifter_param['CHK_CLOSE'] == 'YES': + if swifter_param['CHK_CLOSE']: print(plrad, file=plnew) line = plold.readline() i_list = [i for i in re.split(' +|\t',line) if i.strip()] @@ -1433,12 +1498,12 @@ def swifter2swiftest(swifter_param, plname="", tpname="", cbname="", conversion_ i_list = [i for i in re.split(' +|\t',line) if i.strip()] idnum = int(i_list[0]) GMpl = real2float(i_list[1]) - if swifter_param['RHILL_PRESENT'] == 'YES': + if swifter_param['RHILL_PRESENT']: rhill = real2float(i_list[2]) print(idnum, GMpl, rhill, file=plnew) else: print(idnum, GMpl, file=plnew) - if swifter_param['CHK_CLOSE'] == 'YES': + if swifter_param['CHK_CLOSE']: line = plold.readline() i_list = [i for i in re.split(' +|\t',line) if i.strip()] plrad = real2float(i_list[0]) @@ -1608,7 +1673,7 @@ def swifter2swiftest(swifter_param, plname="", tpname="", cbname="", conversion_ # Remove the unneeded parameters if 'C' in swiftest_param: - swiftest_param['GR'] = 'YES' + swiftest_param['GR'] = True swiftest_param.pop('C', None) swiftest_param.pop('J2', None) swiftest_param.pop('J4', None) @@ -1697,7 +1762,7 @@ def swiftest2swifter_param(swiftest_param, J2=0.0, J4=0.0): TU2S = swifter_param.pop("TU2S", 1.0) GR = swifter_param.pop("GR", None) if GR is not None: - if GR == 'YES': + if GR: swifter_param['C'] = swiftest.einsteinC * np.longdouble(TU2S) / np.longdouble(DU2M) for key in newfeaturelist: tmp = swifter_param.pop(key, None) @@ -1769,7 +1834,7 @@ def swifter2swift_param(swifter_param, J2=0.0, J4=0.0): swift_param['BINARY_OUTPUTFILE'] = swifter_param['BIN_OUT'] swift_param['STATUS_FLAG_FOR_OPEN_STATEMENTS'] = swifter_param['OUT_STAT'] - if swifter_param['CHK_CLOSE'] == "YES": + if swifter_param['CHK_CLOSE']: swift_param['LCLOSE'] = "T" else: swift_param['LCLOSE'] = "F" diff --git a/python/swiftest/swiftest/simulation_class.py b/python/swiftest/swiftest/simulation_class.py index 38fa44d65..f95e8b426 100644 --- a/python/swiftest/swiftest/simulation_class.py +++ b/python/swiftest/swiftest/simulation_class.py @@ -23,6 +23,7 @@ from typing import ( Literal, Dict, + List ) @@ -49,11 +50,14 @@ def __init__(self, TU2S: float | None = None, rmin: float = constants.RSun / constants.AU2M, rmax: float = 10000.0, - close_encounter_check: bool =True, - general_relativity: bool =True, - fragmentation: bool =True, + close_encounter_check: bool = True, + general_relativity: bool = True, + fragmentation: bool = True, rotation: bool = True, compute_conservation_values: bool = False, + extra_force: bool = False, + big_discard: bool = False, + rhill_present: bool = False, interaction_loops: Literal["TRIANGULAR","FLAT","ADAPTIVE"] = "TRIANGULAR", encounter_check_loops: Literal["TRIANGULAR","SORTSWEEP","ADAPTIVE"] = "TRIANGULAR", verbose: bool = True @@ -154,6 +158,12 @@ def __init__(self, compute_conservation_values : bool, default False Turns on the computation of energy, angular momentum, and mass conservation and reports the values every output step of a running simulation. + extra_force: bool, default False + Turns on user-defined force function. + big_discard: bool, default False + Includes big bodies when performing a discard (Swifter only) + rhill_present: bool, default False + Include the Hill's radius with the input files. interaction_loops : {"TRIANGULAR","FLAT","ADAPTIVE"}, default "TRIANGULAR" *Swiftest Experimental feature* Specifies which algorithm to use for the computation of body-body gravitational forces. @@ -190,15 +200,6 @@ def __init__(self, 'ISTEP_OUT': 1, 'ISTEP_DUMP': 1, 'CHK_QMIN_COORD': "HELIO", - 'EXTRA_FORCE': "NO", - 'BIG_DISCARD': "NO", - 'CHK_CLOSE': "YES", - 'RHILL_PRESENT': "YES", - 'FRAGMENTATION': "YES", - 'ROTATION': "YES", - 'TIDES': "NO", - 'ENERGY': "YES", - 'GR': "YES", 'INTERACTION_LOOPS': interaction_loops, 'ENCOUNTER_CHECK': encounter_check_loops } @@ -217,7 +218,17 @@ def __init__(self, self.set_output_files(output_file_type=output_file_type, output_file_name=output_file_name, - output_format=output_format ) + output_format=output_format) + + self.set_features(close_encounter_check=close_encounter_check, + general_relativity=general_relativity, + fragmentation=fragmentation, + rotation=rotation, + compute_conservation_values=compute_conservation_values, + extra_force=extra_force, + big_discard=big_discard, + rhill_present=rhill_present, + verbose = False) # If the parameter file is in a different location than the current working directory, we will need # to use it to properly open bin files @@ -236,6 +247,149 @@ def __init__(self, print(f"BIN_OUT file {binpath} not found.") return + def set_features(self, + close_encounter_check: bool | None = None, + general_relativity: bool | None = None, + fragmentation: bool | None = None, + rotation: bool | None = None, + compute_conservation_values: bool | None=None, + extra_force: bool | None = None, + big_discard: bool | None = None, + rhill_present: bool | None = None, + tides: bool | None = None, + verbose: bool | None = None, + ): + """ + Turns on or off various features of a simulation. + + Parameters + ---------- + close_encounter_check : bool, optional + Check for close encounters between bodies. If set to True, then the radii of massive bodies must be included + in initial conditions. + general_relativity : bool, optional + Include the post-Newtonian correction in acceleration calculations. + fragmentation : bool, optional + If set to True, this turns on the Fraggle fragment generation code and `rotation` must also be True. + This argument only applies to Swiftest-SyMBA simulations. It will be ignored otherwise. + rotation : bool, optional + If set to True, this turns on rotation tracking and radius, rotation vector, and moments of inertia values + must be included in the initial conditions. + This argument only applies to Swiftest-SyMBA simulations. It will be ignored otherwise. + compute_conservation_values : bool, optional + Turns on the computation of energy, angular momentum, and mass conservation and reports the values + every output step of a running simulation. + extra_force: bool, optional + Turns on user-defined force function. + big_discard: bool, optional + Includes big bodies when performing a discard (Swifter only) + rhill_present: bool, optional + Include the Hill's radius with the input files. + tides: bool, optional + Turns on tidal model (IN DEVELOPMENT - IGNORED) + Yarkovsky: bool, optional + Turns on Yarkovsky model (IN DEVELOPMENT - IGNORED) + YORP: bool, optional + Turns on YORP model (IN DEVELOPMENT - IGNORED) + verbose: bool, optional + If passed, it will override the Simulation object's verbose flag + + Returns + ------- + Sets the appropriate parameters in the self.param dictionary + + """ + + update_list = [] + if close_encounter_check is not None: + self.param["CHK_CLOSE"] = close_encounter_check + update_list.append("close_encounter_check") + + if general_relativity is not None: + self.param["GR"] = general_relativity + update_list.append("general_relativity") + + if fragmentation is not None: + self.param['FRAGMENTATION'] = fragmentation + update_list.append("fragmentation") + + if rotation is not None: + self.param['ROTATION'] = rotation + update_list.append("rotation") + + if compute_conservation_values is not None: + self.param["ENERGY"] = compute_conservation_values + update_list.append("compute_conservation_values") + + if extra_force is not None: + self.param["EXTRA_FORCE"] = extra_force + update_list.append("extra_force") + + if big_discard is not None: + if self.codename != "Swifter": + self.param["BIG_DISCARD"] = False + else: + self.param["BIG_DISCARD"] = big_discard + update_list.append("big_discard") + + if rhill_present is not None: + self.param["RHILL_PRESENT"] = rhill_present + update_list.append("rhill_present") + + if verbose is None: + verbose = self.verbose + if verbose: + if len(update_list) > 0: + feature_dict = self.get_features(update_list) + return + + + def get_features(self,feature: str | List[str] | None = None): + """ + + Returns a subset of the parameter dictionary containing the current value of the feature boolean values. + If the verbose option is set in the Simulation object, then it will also print the values. + + Parameters + ---------- + feature : str | List[str], optional + A single string or list of strings containing the names of the features to extract. Default is all of: + ["close_encounter_check", "general_relativity", "fragmentation", "rotation", "compute_conservation_values"] + + Returns + ------- + feature_dict : dict + A dictionary containing the requested features. + + """ + + valid_features = {"close_encounter_check": "CHK_CLOSE", + "general_relativity": "GR", + "fragmentation": "FRAGMENTATION", + "rotation": "ROTATION", + "compute_conservation_values": "ENERGY", + "extra_force": "EXTRA_FORCE", + "big_discard": "BIG_DISCARD", + "rhill_present": "RHILL_PRESENT" + } + + if feature is None: + feature_list = valid_features.keys() + elif type(feature) is str: + feature_list = [feature] + else: + # Only allow features to be checked if they are valid. Otherwise ignore. + feature_list = [feat for feat in feature if feat in set(valid_features.keys())] + + # Extract the feature dictionary + feature_dict = {valid_features[feat]:self.param[valid_features[feat]] for feat in feature_list} + + if self.verbose: + print("Simulation feature parameters:") + for key,val in feature_dict.items(): + print(f"{key:<16} {val}") + + return feature_dict def set_init_cond_files(self, init_cond_file_type: Literal["NETCDF_DOUBLE", "NETCDF_FLOAT", "ASCII"], From 2ac1e39d5a4fd012f381c50fecd27387f4369c2f Mon Sep 17 00:00:00 2001 From: David Minton Date: Tue, 8 Nov 2022 15:00:25 -0500 Subject: [PATCH 010/569] Changed from "_features" to "_feature" before it gets too late to change it --- python/swiftest/swiftest/simulation_class.py | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/python/swiftest/swiftest/simulation_class.py b/python/swiftest/swiftest/simulation_class.py index f95e8b426..622e36fe2 100644 --- a/python/swiftest/swiftest/simulation_class.py +++ b/python/swiftest/swiftest/simulation_class.py @@ -220,7 +220,7 @@ def __init__(self, output_file_name=output_file_name, output_format=output_format) - self.set_features(close_encounter_check=close_encounter_check, + self.set_feature(close_encounter_check=close_encounter_check, general_relativity=general_relativity, fragmentation=fragmentation, rotation=rotation, @@ -247,7 +247,7 @@ def __init__(self, print(f"BIN_OUT file {binpath} not found.") return - def set_features(self, + def set_feature(self, close_encounter_check: bool | None = None, general_relativity: bool | None = None, fragmentation: bool | None = None, @@ -340,11 +340,11 @@ def set_features(self, verbose = self.verbose if verbose: if len(update_list) > 0: - feature_dict = self.get_features(update_list) + feature_dict = self.get_feature(update_list) return - def get_features(self,feature: str | List[str] | None = None): + def get_feature(self,feature: str | List[str] | None = None): """ Returns a subset of the parameter dictionary containing the current value of the feature boolean values. From a784afc04e82a7fc32c53cdd42fde3424f84dfcc Mon Sep 17 00:00:00 2001 From: David Minton Date: Tue, 8 Nov 2022 17:56:20 -0500 Subject: [PATCH 011/569] Added simulation time setter and getter methods --- .../Basic_Simulation/initial_conditions.py | 7 +- python/swiftest/swiftest/io.py | 37 ++- python/swiftest/swiftest/simulation_class.py | 236 ++++++++++++++++-- 3 files changed, 252 insertions(+), 28 deletions(-) diff --git a/examples/Basic_Simulation/initial_conditions.py b/examples/Basic_Simulation/initial_conditions.py index dceb33cc7..2b3693b0c 100644 --- a/examples/Basic_Simulation/initial_conditions.py +++ b/examples/Basic_Simulation/initial_conditions.py @@ -32,12 +32,9 @@ # Initialize the simulation object as a variable sim = swiftest.Simulation(init_cond_file_type="ASCII") +sim.set_simulation_time(tstart=0.0, tstop=10.0, dt=0.005, tstep_out=1.0,verbose=True) + # Add parameter attributes to the simulation object -sim.param['T0'] = 0.0 -sim.param['TSTOP'] = 10 -sim.param['DT'] = 0.005 -sim.param['ISTEP_OUT'] = 200 -sim.param['ISTEP_DUMP'] = 200 sim.param['GMTINY'] = 1e-6 sim.param['MIN_GMFRAG'] = 1e-9 diff --git a/python/swiftest/swiftest/io.py b/python/swiftest/swiftest/io.py index b12d32cd3..28303f8f8 100644 --- a/python/swiftest/swiftest/io.py +++ b/python/swiftest/swiftest/io.py @@ -17,9 +17,38 @@ import tempfile import re -newfeaturelist = ("FRAGMENTATION", "ROTATION", "TIDES", "ENERGY", "GR", "YARKOVSKY", "YORP", "IN_FORM", "SEED", "INTERACTION_LOOPS", "ENCOUNTER_CHECK") +# This defines features that are new in Swiftest and not in Swifter (for conversion between param.in files) +newfeaturelist = ("RESTART", + "FRAGMENTATION", + "ROTATION", + "TIDES", + "ENERGY", + "GR", + "YARKOVSKY", + "YORP", + "IN_FORM", + "SEED", + "INTERACTION_LOOPS", + "ENCOUNTER_CHECK", + "TSTART") + +# This list defines features that are booleans, so must be converted to/from string when writing/reading from file +bool_param = ["RESTART", + "CHK_CLOSE", + "EXTRA_FORCE", + "RHILL_PRESENT", + "BIG_DISCARD", + "FRAGMENTATION", + "ROTATION", + "TIDES", + "ENERGY", + "GR", + "YARKOVSKY", + "YORP"] + +# 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"] -bool_param = ["CHK_CLOSE", "EXTRA_FORCE", "RHILL_PRESENT", "BIG_DISCARD", "FRAGMENTATION", "ROTATION", "TIDES", "ENERGY", "GR", "YARKOVSKY", "YORP"] def bool2yesno(boolval): """ @@ -144,6 +173,7 @@ def read_swiftest_param(param_file_name, param, verbose=True): param['IN_TYPE'] = param['IN_TYPE'].upper() param['IN_FORM'] = param['IN_FORM'].upper() param['T0'] = real2float(param['T0']) + param['TSTART'] = real2float(param['TSTART']) param['TSTOP'] = real2float(param['TSTOP']) param['DT'] = real2float(param['DT']) param['CHK_RMIN'] = real2float(param['CHK_RMIN']) @@ -401,7 +431,8 @@ def write_labeled_param(param, param_file_name): 'CHK_QMIN_RANGE', 'MU2KG', 'TU2S', - 'DU2M' ] + 'DU2M', + 'RESTART'] ptmp = param.copy() # Print the list of key/value pairs in the preferred order for key in keylist: diff --git a/python/swiftest/swiftest/simulation_class.py b/python/swiftest/swiftest/simulation_class.py index 622e36fe2..bda2d521d 100644 --- a/python/swiftest/swiftest/simulation_class.py +++ b/python/swiftest/swiftest/simulation_class.py @@ -58,6 +58,7 @@ def __init__(self, extra_force: bool = False, big_discard: bool = False, rhill_present: bool = False, + restart: bool = False, interaction_loops: Literal["TRIANGULAR","FLAT","ADAPTIVE"] = "TRIANGULAR", encounter_check_loops: Literal["TRIANGULAR","SORTSWEEP","ADAPTIVE"] = "TRIANGULAR", verbose: bool = True @@ -164,6 +165,10 @@ def __init__(self, Includes big bodies when performing a discard (Swifter only) rhill_present: bool, default False Include the Hill's radius with the input files. + restart : bool, default False + If true, will restart an old run. The file given by `output_file_name` must exist before the run can + execute. If false, will start a new run. If the file given by `output_file_name` exists, it will be replaced + when the run is executed. interaction_loops : {"TRIANGULAR","FLAT","ADAPTIVE"}, default "TRIANGULAR" *Swiftest Experimental feature* Specifies which algorithm to use for the computation of body-body gravitational forces. @@ -205,6 +210,7 @@ def __init__(self, } self.codename = codename self.verbose = verbose + self.restart = restart self.set_distance_range(rmin=rmin, rmax=rmax) @@ -221,14 +227,15 @@ def __init__(self, output_format=output_format) self.set_feature(close_encounter_check=close_encounter_check, - general_relativity=general_relativity, - fragmentation=fragmentation, - rotation=rotation, - compute_conservation_values=compute_conservation_values, - extra_force=extra_force, - big_discard=big_discard, - rhill_present=rhill_present, - verbose = False) + general_relativity=general_relativity, + fragmentation=fragmentation, + rotation=rotation, + compute_conservation_values=compute_conservation_values, + extra_force=extra_force, + big_discard=big_discard, + rhill_present=rhill_present, + restart=restart, + verbose = False) # If the parameter file is in a different location than the current working directory, we will need # to use it to properly open bin files @@ -247,18 +254,198 @@ def __init__(self, print(f"BIN_OUT file {binpath} not found.") return + def set_simulation_time(self, + t0: float | None = None, + tstart: float | None = None, + tstop: float | None = None, + dt: float | None = None, + istep_out : int | None = None, + tstep_out : float | None = None, + istep_dump : int | None = None, + verbose : bool | None = None, + ): + """ + + Parameters + ---------- + t0 : float, optional + The reference time for the start of the simulation. Defaults is 0.0 + tstart : float, optional + The start time for a restarted simulation. For a new simulation, tstart will be set to t0 automatically. + tstop : float, optional + The stopping time for a simulation. `tstop` must be greater than `tstart`. + dt : float, optional + The step size of the simulation. `dt` must be less than or equal to `tstop-dstart`. + istep_out : int, optional + The number of time steps between outputs to file. *Note*: only `istep_out` or `toutput` can be set. + tstep_out : float, optional + The approximate time between when outputs are written to file. Passing this computes + `istep_out = floor(tstep_out/dt)`. *Note*: only `istep_out` or `toutput` can be set. + istep_dump : int, optional + The anumber of time steps between outputs to dump file. If not set, this will be set to the value of + `istep_out` (or the equivalent value determined by `tstep_out`) + verbose: bool, optional + If passed, it will override the Simulation object's verbose flag + + Returns + ------- + Sets the appropriate parameter variables in the parameter dictionary. + + """ + + update_list = [] + + + if t0 is None: + t0 = self.param.pop("T0", None) + if t0 is None: + t0 = 0.0 + else: + update_list.append("t0") + + if tstart is None: + tstart = self.param.pop("TSTART", None) + if tstart is None: + tstart = t0 + else: + update_list.append("tstart") + + self.param['T0'] = t0 + self.param['TSTART'] = tstart + + if tstop is None: + tstop = self.param.pop("TSTOP", None) + if tstop is None: + print("Error! tstop is not set!") + return + else: + update_list.append("tstop") + + if tstop <= tstart: + print("Error! tstop must be greater than tstart.") + return + + self.param['TSTOP'] = tstop + + if dt is None: + dt = self.param.pop("DT", None) + if dt is None: + print("Error! dt is not set!") + return + else: + update_list.append("dt") + + if dt > (tstop - tstart): + print("Error! dt must be smaller than tstop-tstart") + print(f"Setting dt = {tstop-tstart} instead of {dt}") + dt = tstop - tstart + + self.param['DT'] = dt + + if istep_out is None and tstep_out is None: + istep_out = self.param.pop("ISTEP_OUT", None) + if istep_out is None: + print("Error! istep_out is not set") + return + + if istep_out is not None and tstep_out is not None: + print("Error! istep_out and tstep_out cannot both be set") + return + + if tstep_out is not None: + istep_out = int(np.floor(tstep_out / dt)) + + self.param['ISTEP_OUT'] = istep_out + + if istep_dump is None: + istep_dump = istep_out + + self.param['ISTEP_DUMP'] = istep_dump + + update_list.extend(["istep_out", "tstep_out", "istep_dump"]) + + if verbose is None: + verbose = self.verbose + if verbose: + if len(update_list) > 0: + time_dict = self.get_simulation_time(update_list) + + return + + def get_simulation_time(self, param_key: str | List[str] | None = None): + """ + + Returns a subset of the parameter dictionary containing the current simulation time parameters. + If the verbose option is set in the Simulation object, then it will also print the values. + + Parameters + ---------- + param_key : str | List[str], optional + A single string or list of strings containing the names of the simulation time parameters to extract. + Default is all of: + ["t0", "tstart", "tstop", "dt", "istep_out", "tstep_out", "istep_dump"] + + Returns + ------- + time_dict : dict + A dictionary containing the requested parameters + + """ + + valid_var = {"t0": "T0", + "tstart": "TSTART", + "tstop": "TSTOP", + "dt": "DT", + "istep_out": "ISTEP_OUT", + "istep_dump": "ISTEP_DUMP", + } + + units = {"T0" : self.TU_name, + "TSTART" : self.TU_name, + "TSTOP" : self.TU_name, + "DT" : self.TU_name, + "TSTEP_OUT" : self.TU_name, + "ISTEP_OUT" : "", + "ISTEP_DUMP" : ""} + + if "tstep_out" in param_key: + istep_out = self.param['ISTEP_OUT'] + dt = self.param['DT'] + tstep_out = istep_out * dt + else: + tstep_out = None + + if param_key is None: + param_list = valid_var.keys() + elif type(param_key) is str: + param_list = [param_key] + else: + param_list = [k for k in param_key if k in set(valid_var.keys())] + + time_dict = {valid_var[k]: self.param[valid_var[k]] for k in param_list} + + if self.verbose: + print("Simulation feature parameters:") + for key, val in time_dict.items(): + print(f"{key:<16} {val} {units[key]}") + if tstep_out is not None: + print(f"{'TSTEP_OUT':<16} {tstep_out} {units['TSTEP_OUT']}") + + return time_dict + def set_feature(self, - close_encounter_check: bool | None = None, - general_relativity: bool | None = None, - fragmentation: bool | None = None, - rotation: bool | None = None, - compute_conservation_values: bool | None=None, - extra_force: bool | None = None, - big_discard: bool | None = None, - rhill_present: bool | None = None, - tides: bool | None = None, - verbose: bool | None = None, - ): + close_encounter_check: bool | None = None, + general_relativity: bool | None = None, + fragmentation: bool | None = None, + rotation: bool | None = None, + compute_conservation_values: bool | None=None, + extra_force: bool | None = None, + big_discard: bool | None = None, + rhill_present: bool | None = None, + restart: bool | None = None, + tides: bool | None = None, + verbose: bool | None = None, + ): """ Turns on or off various features of a simulation. @@ -291,6 +478,10 @@ def set_feature(self, Turns on Yarkovsky model (IN DEVELOPMENT - IGNORED) YORP: bool, optional Turns on YORP model (IN DEVELOPMENT - IGNORED) + restart : bool, default False + If true, will restart an old run. The file given by `output_file_name` must exist before the run can + execute. If false, will start a new run. If the file given by `output_file_name` exists, it will be replaced + when the run is executed. verbose: bool, optional If passed, it will override the Simulation object's verbose flag @@ -336,6 +527,10 @@ def set_feature(self, self.param["RHILL_PRESENT"] = rhill_present update_list.append("rhill_present") + if restart is not None: + self.param["RESTART"] = restart + update_list.append("restart") + if verbose is None: verbose = self.verbose if verbose: @@ -370,7 +565,8 @@ def get_feature(self,feature: str | List[str] | None = None): "compute_conservation_values": "ENERGY", "extra_force": "EXTRA_FORCE", "big_discard": "BIG_DISCARD", - "rhill_present": "RHILL_PRESENT" + "rhill_present": "RHILL_PRESENT", + "restart" : "RESTART" } if feature is None: From b6d3018bbe03236bfbac8a3751a37e0e3e79f974 Mon Sep 17 00:00:00 2001 From: David Minton Date: Tue, 8 Nov 2022 17:57:49 -0500 Subject: [PATCH 012/569] Removed unnecessary verbose flag --- examples/Basic_Simulation/initial_conditions.py | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/examples/Basic_Simulation/initial_conditions.py b/examples/Basic_Simulation/initial_conditions.py index 2b3693b0c..c9d0823af 100644 --- a/examples/Basic_Simulation/initial_conditions.py +++ b/examples/Basic_Simulation/initial_conditions.py @@ -32,7 +32,7 @@ # Initialize the simulation object as a variable sim = swiftest.Simulation(init_cond_file_type="ASCII") -sim.set_simulation_time(tstart=0.0, tstop=10.0, dt=0.005, tstep_out=1.0,verbose=True) +sim.set_simulation_time(tstart=0.0, tstop=10.0, dt=0.005, tstep_out=1.0) # Add parameter attributes to the simulation object sim.param['GMTINY'] = 1e-6 From 6aa38058d294cb64352696778d60dbe8cf1a3934 Mon Sep 17 00:00:00 2001 From: David Minton Date: Tue, 8 Nov 2022 17:59:24 -0500 Subject: [PATCH 013/569] Set tides parameter to be False so at least it's in the param list --- python/swiftest/swiftest/simulation_class.py | 2 ++ 1 file changed, 2 insertions(+) diff --git a/python/swiftest/swiftest/simulation_class.py b/python/swiftest/swiftest/simulation_class.py index bda2d521d..d01da849a 100644 --- a/python/swiftest/swiftest/simulation_class.py +++ b/python/swiftest/swiftest/simulation_class.py @@ -531,6 +531,8 @@ def set_feature(self, self.param["RESTART"] = restart update_list.append("restart") + self.param["TIDES"] = False + if verbose is None: verbose = self.verbose if verbose: From 163f321560a28724c206d5e8bd95050652b06d55 Mon Sep 17 00:00:00 2001 From: David Minton Date: Tue, 8 Nov 2022 19:41:20 -0500 Subject: [PATCH 014/569] Switched to using boolean True instead of YES in the initial conditions generator --- python/swiftest/swiftest/init_cond.py | 22 +++++++++++----------- 1 file changed, 11 insertions(+), 11 deletions(-) diff --git a/python/swiftest/swiftest/init_cond.py b/python/swiftest/swiftest/init_cond.py index 287e5ecae..0166e78a8 100644 --- a/python/swiftest/swiftest/init_cond.py +++ b/python/swiftest/swiftest/init_cond.py @@ -146,7 +146,7 @@ def solar_system_horizons(plname, idval, param, ephemerides_start_date, ds): Rpl = Rcb J2 = J2RP2 J4 = J4RP4 - if param['ROTATION'] == 'YES': + if param['ROTATION']: Ip1 = [Ipsun[0]] Ip2 = [Ipsun[1]] Ip3 = [Ipsun[2]] @@ -202,19 +202,19 @@ def solar_system_horizons(plname, idval, param, ephemerides_start_date, ds): if ispl: GMpl = [] GMpl.append(GMcb[0] / MSun_over_Mpl[plname]) - if param['CHK_CLOSE'] == 'YES': + if param['CHK_CLOSE']: Rpl = [] Rpl.append(planetradius[plname] * DCONV) else: Rpl = None # Generate planet value vectors - if (param['RHILL_PRESENT'] == 'YES'): + if (param['RHILL_PRESENT']): rhill = [] rhill.append(pldata[plname].elements()['a'][0] * DCONV * (3 * MSun_over_Mpl[plname]) ** (-THIRDLONG)) else: rhill = None - if (param['ROTATION'] == 'YES'): + if (param['ROTATION']): Ip1 = [] Ip2 = [] Ip3 = [] @@ -304,7 +304,7 @@ def vec2xr(param, idvals, namevals, v1, v2, v3, v4, v5, v6, GMpl=None, Rpl=None, else: iscb = False - if param['ROTATION'] == 'YES': + if param['ROTATION']: if Ip1 is None: Ip1 = np.full_like(v1, 0.4) if Ip2 is None: @@ -325,10 +325,10 @@ def vec2xr(param, idvals, namevals, v1, v2, v3, v4, v5, v6, GMpl=None, Rpl=None, else: ispl = False - if ispl and param['CHK_CLOSE'] == 'YES' and Rpl is None: + 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'] == 'YES': + if ispl and rhill is None and param['RHILL_PRESENT']: print("rhill is required.") return None @@ -342,7 +342,7 @@ def vec2xr(param, idvals, namevals, v1, v2, v3, v4, v5, v6, GMpl=None, Rpl=None, if iscb: label_float = clab.copy() vec_float = np.vstack([GMpl,Rpl,J2,J4]) - if param['ROTATION'] == 'YES': + if param['ROTATION']: vec_float = np.vstack([vec_float, Ip1, Ip2, Ip3, rotx, roty, rotz]) particle_type = "Central Body" else: @@ -350,11 +350,11 @@ def vec2xr(param, idvals, namevals, v1, v2, v3, v4, v5, v6, GMpl=None, Rpl=None, if ispl: label_float = plab.copy() vec_float = np.vstack([vec_float, GMpl]) - if param['CHK_CLOSE'] == 'YES': + if param['CHK_CLOSE']: vec_float = np.vstack([vec_float, Rpl]) - if param['RHILL_PRESENT'] == 'YES': + if param['RHILL_PRESENT']: vec_float = np.vstack([vec_float, rhill]) - if param['ROTATION'] == 'YES': + if param['ROTATION']: vec_float = np.vstack([vec_float, Ip1, Ip2, Ip3, rotx, roty, rotz]) particle_type = np.repeat("Massive Body",idvals.size) else: From c47953ac36eb1f85b10cb91a0964408eec5594b3 Mon Sep 17 00:00:00 2001 From: David Minton Date: Tue, 8 Nov 2022 20:53:58 -0500 Subject: [PATCH 015/569] Added setter and getter methods for initial conditions files --- python/swiftest/swiftest/simulation_class.py | 292 +++++++++++++++---- 1 file changed, 230 insertions(+), 62 deletions(-) diff --git a/python/swiftest/swiftest/simulation_class.py b/python/swiftest/swiftest/simulation_class.py index d01da849a..1dba3a49d 100644 --- a/python/swiftest/swiftest/simulation_class.py +++ b/python/swiftest/swiftest/simulation_class.py @@ -224,7 +224,8 @@ def __init__(self, self.set_output_files(output_file_type=output_file_type, output_file_name=output_file_name, - output_format=output_format) + output_format=output_format, + verbose = False) self.set_feature(close_encounter_check=close_encounter_check, general_relativity=general_relativity, @@ -372,7 +373,7 @@ def set_simulation_time(self, return - def get_simulation_time(self, param_key: str | List[str] | None = None): + def get_simulation_time(self, arg_list: str | List[str] | None = None): """ Returns a subset of the parameter dictionary containing the current simulation time parameters. @@ -380,7 +381,7 @@ def get_simulation_time(self, param_key: str | List[str] | None = None): Parameters ---------- - param_key : str | List[str], optional + arg_list : str | List[str], optional A single string or list of strings containing the names of the simulation time parameters to extract. Default is all of: ["t0", "tstart", "tstop", "dt", "istep_out", "tstep_out", "istep_dump"] @@ -400,36 +401,37 @@ def get_simulation_time(self, param_key: str | List[str] | None = None): "istep_dump": "ISTEP_DUMP", } - units = {"T0" : self.TU_name, - "TSTART" : self.TU_name, - "TSTOP" : self.TU_name, - "DT" : self.TU_name, - "TSTEP_OUT" : self.TU_name, - "ISTEP_OUT" : "", - "ISTEP_DUMP" : ""} + units = {"t0" : self.TU_name, + "tstart" : self.TU_name, + "tstop" : self.TU_name, + "dt" : self.TU_name, + "tstep_out" : self.TU_name, + "istep_out" : "", + "istep_dump" : ""} - if "tstep_out" in param_key: + if arg_list is not None and "tstep_out" in arg_list: istep_out = self.param['ISTEP_OUT'] dt = self.param['DT'] tstep_out = istep_out * dt else: tstep_out = None - if param_key is None: - param_list = valid_var.keys() - elif type(param_key) is str: - param_list = [param_key] + if arg_list is None: + arg_list = valid_var.keys() + elif type(arg_list) is str: + arg_list = [arg_list] else: - param_list = [k for k in param_key if k in set(valid_var.keys())] + arg_list = [k for k in arg_list if k in set(valid_var.keys())] - time_dict = {valid_var[k]: self.param[valid_var[k]] for k in param_list} + time_dict = {valid_var[k]: self.param[valid_var[k]] for k in arg_list} if self.verbose: - print("Simulation feature parameters:") - for key, val in time_dict.items(): - print(f"{key:<16} {val} {units[key]}") + print("\nSimulation time parameters:") + for arg in arg_list: + key = valid_var[arg] + print(f"{arg:<32} {time_dict[key]} {units[arg]}") if tstep_out is not None: - print(f"{'TSTEP_OUT':<16} {tstep_out} {units['TSTEP_OUT']}") + print(f"{'tstep_out':<32} {tstep_out} {units['tstep_out']}") return time_dict @@ -541,7 +543,7 @@ def set_feature(self, return - def get_feature(self,feature: str | List[str] | None = None): + def get_feature(self, arg_list: str | List[str] | None = None): """ Returns a subset of the parameter dictionary containing the current value of the feature boolean values. @@ -549,7 +551,7 @@ def get_feature(self,feature: str | List[str] | None = None): Parameters ---------- - feature : str | List[str], optional + arg_list: str | List[str], optional A single string or list of strings containing the names of the features to extract. Default is all of: ["close_encounter_check", "general_relativity", "fragmentation", "rotation", "compute_conservation_values"] @@ -560,45 +562,48 @@ def get_feature(self,feature: str | List[str] | None = None): """ - valid_features = {"close_encounter_check": "CHK_CLOSE", - "general_relativity": "GR", - "fragmentation": "FRAGMENTATION", - "rotation": "ROTATION", - "compute_conservation_values": "ENERGY", - "extra_force": "EXTRA_FORCE", - "big_discard": "BIG_DISCARD", - "rhill_present": "RHILL_PRESENT", - "restart" : "RESTART" - } - - if feature is None: - feature_list = valid_features.keys() - elif type(feature) is str: - feature_list = [feature] + valid_var = {"close_encounter_check": "CHK_CLOSE", + "general_relativity": "GR", + "fragmentation": "FRAGMENTATION", + "rotation": "ROTATION", + "compute_conservation_values": "ENERGY", + "extra_force": "EXTRA_FORCE", + "big_discard": "BIG_DISCARD", + "rhill_present": "RHILL_PRESENT", + "restart" : "RESTART" + } + + if arg_list is None: + arg_list = valid_var.keys() + elif type(arg_list) is str: + arg_list = [arg_list] else: - # Only allow features to be checked if they are valid. Otherwise ignore. - feature_list = [feat for feat in feature if feat in set(valid_features.keys())] + # Only allow arg_lists to be checked if they are valid. Otherwise ignore. + arg_list = [k for k in arg_list if k in set(valid_var.keys())] - # Extract the feature dictionary - feature_dict = {valid_features[feat]:self.param[valid_features[feat]] for feat in feature_list} + # Extract the arg_list dictionary + feature_dict = {valid_var[feat]:self.param[valid_var[feat]] for feat in arg_list} if self.verbose: - print("Simulation feature parameters:") - for key,val in feature_dict.items(): - print(f"{key:<16} {val}") + print("\nSimulation feature parameters:") + for arg in arg_list: + key = valid_var[arg] + print(f"{arg:<32} {feature_dict[key]}") return feature_dict def set_init_cond_files(self, - init_cond_file_type: Literal["NETCDF_DOUBLE", "NETCDF_FLOAT", "ASCII"], - init_cond_file_name: str | os.PathLike | Dict[str, str] | Dict[str, os.PathLike] | None, - init_cond_format: Literal["EL", "XV"]): + init_cond_file_type: Literal["NETCDF_DOUBLE", "NETCDF_FLOAT", "ASCII"] | None = None, + init_cond_file_name: str | os.PathLike | Dict[str, str] | Dict[str, os.PathLike] | None = None, + init_cond_format: Literal["EL", "XV"] | None = None, + verbose: bool | None = None + ): """ Sets the initial condition file parameters in the parameters dictionary. Parameters ---------- - init_cond_file_type : {"NETCDF_DOUBLE", "NETCDF_FLOAT", "ASCII"} + init_cond_file_type : {"NETCDF_DOUBLE", "NETCDF_FLOAT", "ASCII"}, optional The file type containing initial conditions for the simulation: * NETCDF_DOUBLE: A single initial conditions input file in NetCDF file format of type NETCDF_DOUBLE * NETCDF_FLOAT: A single initial conditions input file in NetCDF file format of type NETCDF_FLOAT @@ -620,6 +625,8 @@ def set_init_cond_files(self, Indicates whether the input initial conditions are given as orbital elements or cartesian position and velocity vectors. > *Note:* If `codename` is "Swift" or "Swifter", EL initial conditions are converted to XV. + verbose: bool, optional + If passed, it will override the Simulation object's verbose flag Returns ------- @@ -627,6 +634,12 @@ def set_init_cond_files(self, """ + update_list = ["init_cond_file_name"] + if init_cond_file_type is not None: + update_list.append("init_cond_file_type") + if init_cond_format is not None: + update_list.append("init_cond_format") + def ascii_file_input_error_msg(codename): print(f"Error in set_init_cond_files: init_cond_file_name must be a dictionary of the form: ") print('{') @@ -678,19 +691,94 @@ def ascii_file_input_error_msg(codename): else: self.param["NC_IN"] = init_cond_file_name + + if verbose is None: + verbose = self.verbose + if verbose: + if len(update_list) > 0: + init_cond_file_dict = self.get_init_cond_files(update_list) + return + + def get_init_cond_files(self, arg_list: str | List[str] | None = None): + """ + + Returns a subset of the parameter dictionary containing the current initial condition file parameters + If the verbose option is set in the Simulation object, then it will also print the values. + + Parameters + ---------- + arg_list : str | List[str], optional + A single string or list of strings containing the names of the simulation time parameters to extract. + Default is all of: + ["init_cond_file_type", "init_cond_file_name", "init_cond_format"] + + Returns + ------- + init_cond_file_dict : dict + A dictionary containing the requested parameters + + """ + + valid_var = {"init_cond_file_type": "IN_TYPE", + "init_cond_format": "IN_FORM", + "init_cond_file_name" : "NC_IN", + "init_cond_file_name (cb)" : "CB_IN", + "init_cond_file_name (pl)" : "PL_IN", + "init_cond_file_name (tp)" : "TP_IN", + } + + + if arg_list is None: + arg_list = list(valid_var.keys()) + elif type(arg_list) is str: + arg_list = [arg_list] + else: + arg_list = [k for k in arg_list if k in set(valid_var.keys())] + + if "init_cond_file_name" in arg_list: + if self.param["IN_TYPE"] == "ASCII": + arg_list.remove("init_cond_file_name") + if "init_cond_file_name (cb)" not in arg_list: + arg_list.append("init_cond_file_name (cb)") + if "init_cond_file_name (pl)" not in arg_list: + arg_list.append("init_cond_file_name (pl)") + if "init_cond_file_name (tp)" not in arg_list: + arg_list.append("init_cond_file_name (tp)") + else: + if "init_cond_file_name (cb)" in arg_list: + arg_list.remove("init_cond_file_name (cb)") + if "init_cond_file_name (pl)" in arg_list: + arg_list.remove("init_cond_file_name (pl)") + if "init_cond_file_name (tp)" in arg_list: + arg_list.remove("init_cond_file_name (tp)") + + init_cond_file_dict = {valid_var[k]: self.param[valid_var[k]] for k in arg_list} + + if self.verbose: + print("\nInitial condition file parameters:") + for arg in arg_list: + key = valid_var[arg] + print(f"{arg:<32} {init_cond_file_dict[key]}") + + return init_cond_file_dict + + + + def set_output_files(self, - output_file_type: Literal[ "NETCDF_DOUBLE", "NETCDF_FLOAT", "REAL4", "REAL8", "XDR4", "XDR8"], - output_file_name: os.PathLike | str | None, - output_format: Literal["XV", "XVEL"] + output_file_type: Literal[ "NETCDF_DOUBLE", "NETCDF_FLOAT", "REAL4", "REAL8", "XDR4", "XDR8"] | None = None, + output_file_name: os.PathLike | str | None = None, + output_format: Literal["XV", "XVEL"] | None = None, + verbose: bool | None = None ): """ Sets the output file parameters in the parameters dictionary. Parameters ---------- - output_file_type : {"NETCDF_DOUBLE", "NETCDF_FLOAT","REAL4","REAL8","XDR4","XDR8"}, default "NETCDF_DOUBLE" + output_file_type : {"NETCDF_DOUBLE", "NETCDF_FLOAT","REAL4","REAL8","XDR4","XDR8"}, optional The file type for the outputs of the simulation. Compatible file types depend on the `codename` argument. * Swiftest: Only "NETCDF_DOUBLE" or "NETCDF_FLOAT" supported. * Swifter: Only "REAL4","REAL8","XDR4" or "XDR8" supported. @@ -699,25 +787,46 @@ def set_output_files(self, Name of output file to generate. If not supplied, then one of the default file names are used, depending on the value passed to `output_file_type`. If one of the NetCDF types are used, the default is "bin.nc". Otherwise, the default is "bin.dat". - output_format : {"XV","XVEL"}, default "XVEL" + output_format : {"XV","XVEL"}, optional Specifies the format for the data saved to the output file. If "XV" then cartesian position and velocity vectors for all bodies are stored. If "XVEL" then the orbital elements are also stored. + verbose: bool, optional + If passed, it will override the Simulation object's verbose flag Returns ------- Sets the appropriate initial conditions file parameters inside the self.param dictionary. """ + update_list = [] + if output_file_type is not None: + update_list.append("output_file_type") + if output_file_name is not None: + update_list.append("output_file_name") + if output_format is not None: + update_list.append("output_format") if self.codename == "Swiftest": - if output_file_type not in ["NETCDF_DOUBLE", "NETCDF_FLOAT"]: + if output_file_type is None: + output_file_type = self.param.pop("OUT_TYPE", None) + if output_file_type is None: + output_file_type = "NETCDF_DOUBLE" + elif output_file_type not in ["NETCDF_DOUBLE", "NETCDF_FLOAT"]: print(f"{output_file_type} is not compatible with Swiftest. Setting to NETCDF_DOUBLE") output_file_type = "NETCDF_DOUBLE" elif self.codename == "Swifter": - if output_file_type not in ["REAL4","REAL8","XDR4","XDR8"]: + if output_file_type is None: + output_file_type = self.param.pop("OUT_TYPE", None) + if output_file_type is None: + output_file_type = "REAL8" + elif output_file_type not in ["REAL4","REAL8","XDR4","XDR8"]: print(f"{output_file_type} is not compatible with Swifter. Setting to REAL8") output_file_type = "REAL8" elif self.codename == "Swift": + if output_file_type is None: + output_file_type = self.param.pop("OUT_TYPE", None) + if output_file_type is None: + output_file_type = "REAL4" if output_file_type not in ["REAL4"]: print(f"{output_file_type} is not compatible with Swift. Setting to REAL4") output_file_type = "REAL4" @@ -734,10 +843,65 @@ def set_output_files(self, if output_format != "XV" and self.codename != "Swiftest": print(f"{output_format} is not compatible with {self.codename}. Setting to XV") output_format = "XV" - self.param['OUT_FORM'] = output_format + self.param["OUT_FORM"] = output_format + + if self.restart: + self.param["OUT_STAT"] = "APPEND" + else: + self.param["OUT_STAT"] = "REPLACE" + + if verbose is None: + verbose = self.verbose + if verbose: + if len(update_list) > 0: + output_file_dict = self.get_output_files(update_list) return + + def get_output_files(self, arg_list: str | List[str] | None = None): + """ + + Returns a subset of the parameter dictionary containing the current output file parameters + If the verbose option is set in the Simulation object, then it will also print the values. + + Parameters + ---------- + arg_list : str | List[str], optional + A single string or list of strings containing the names of the simulation time parameters to extract. + Default is all of: + ["output_file_type", "output_file_name", "output_format"] + + Returns + ------- + output_file_dict : dict + A dictionary containing the requested parameters + + """ + + valid_var = {"output_file_type": "OUT_TYPE", + "output_file_name": "BIN_OUT", + "output_format": "OUT_FORM", + } + + if arg_list is None: + arg_list = valid_var.keys() + elif type(arg_list) is str: + arg_list = [arg_list] + else: + arg_list = [k for k in arg_list if k in set(valid_var.keys())] + + output_file_dict = {valid_var[k]: self.param[valid_var[k]] for k in arg_list} + + if self.verbose: + print("\nOutput file parameters:") + for arg in arg_list: + key = valid_var[arg] + print(f"{arg:<32} {output_file_dict[key]}") + + return output_file_dict + + def set_unit_system(self, MU: str | None = None, DU: str | None = None, @@ -1238,7 +1402,7 @@ def save(self, param_file, framenum=-1, codename="Swiftest"): """ if codename == "Swiftest": - io.swiftest_xr2infile(ds=self.ds, param=self.param, in_type=self.param['IN_TYPE'], framenum=framenum,infile_name=self.param['NC_IN']) + io.swiftest_xr2infile(ds=self.ds, param=self.param, in_type=self.param['IN_TYPE'], framenum=framenum) self.write_param(param_file) elif codename == "Swifter": if self.codename == "Swiftest": @@ -1280,25 +1444,29 @@ def initial_conditions_from_bin(self, framenum=-1, new_param=None, new_param_fil if codename != "Swiftest": self.save(new_param_file, framenum, codename) return + if new_param is None: new_param = self.param.copy() if codename == "Swiftest": if restart: new_param['T0'] = self.ds.time.values[framenum] - if self.param['OUT_TYPE'] == 'NETCDF_DOUBLE' or self.param['OUT_TYPE'] == 'REAL8': + if self.param['OUT_TYPE'] == 'NETCDF_DOUBLE': new_param['IN_TYPE'] = 'NETCDF_DOUBLE' - elif self.param['OUT_TYPE'] == 'NETCDF_FLOAT' or self.param['OUT_TYPE'] == 'REAL4': + elif self.param['OUT_TYPE'] == 'NETCDF_FLOAT': new_param['IN_TYPE'] = 'NETCDF_FLOAT' else: print(f"{self.param['OUT_TYPE']} is an invalid OUT_TYPE file") return + if self.param['BIN_OUT'] != new_param['BIN_OUT'] and restart: - print(f"Restart run with new output file. Copying {self.param['BIN_OUT']} to {new_param['BIN_OUT']}") - shutil.copy2(self.param['BIN_OUT'],new_param['BIN_OUT']) + print(f"Restart run with new output file. Copying {self.param['BIN_OUT']} to {new_param['BIN_OUT']}") + shutil.copy2(self.param['BIN_OUT'],new_param['BIN_OUT']) + new_param['IN_FORM'] = 'XV' if restart: new_param['OUT_STAT'] = 'APPEND' + new_param['FIRSTKICK'] = 'T' new_param['NC_IN'] = new_initial_conditions_file new_param.pop('PL_IN', None) From b4c6604c0b6405bc4ba40b1c3224439843a841ac Mon Sep 17 00:00:00 2001 From: David Minton Date: Wed, 9 Nov 2022 08:35:38 -0500 Subject: [PATCH 016/569] Improved the unit system setter and added a unit system getter. Added kwargs to all the setters so I can write a main set_parameters setter that can take any possible parameter as an argument. --- python/swiftest/swiftest/simulation_class.py | 166 +++++++++++++++++-- 1 file changed, 149 insertions(+), 17 deletions(-) diff --git a/python/swiftest/swiftest/simulation_class.py b/python/swiftest/swiftest/simulation_class.py index 1dba3a49d..f538136ed 100644 --- a/python/swiftest/swiftest/simulation_class.py +++ b/python/swiftest/swiftest/simulation_class.py @@ -23,7 +23,8 @@ from typing import ( Literal, Dict, - List + List, + Any ) @@ -48,6 +49,9 @@ def __init__(self, MU2KG: float | None = None, DU2M: float | None = None, TU2S: float | None = None, + MU_name: str | None = None, + DU_name: str | None = None, + TU_name: str | None = None, rmin: float = constants.RSun / constants.AU2M, rmax: float = 10000.0, close_encounter_check: bool = True, @@ -140,6 +144,15 @@ def __init__(self, TU2S : float, optional The conversion factor to multiply by the time unit that would convert it to seconds. Setting this overrides TU + MU_name : str, optional + The name of the mass unit. When setting one of the standard units via `MU` a name will be + automatically set for the unit, so this argument will override the automatic name. + DU_name : str, optional + The name of the distance unit. When setting one of the standard units via `DU` a name will be + automatically set for the unit, so this argument will override the automatic name. + TU_name : str, optional + The name of the time unit. When setting one of the standard units via `TU` a name will be + automatically set for the unit, so this argument will override the automatic name. rmin : float, default value is the radius of the Sun in the unit system defined by the unit input arguments. Minimum distance of the simulation (CHK_QMIN, CHK_RMIN, CHK_QMIN_RANGE[0]) rmax : float, default value is 10000 AU in the unit system defined by the unit input arguments. @@ -212,15 +225,18 @@ def __init__(self, self.verbose = verbose self.restart = restart - self.set_distance_range(rmin=rmin, rmax=rmax) + self.set_distance_range(rmin=rmin, rmax=rmax, verbose = False) self.set_unit_system(MU=MU, DU=DU, TU=TU, MU2KG=MU2KG, DU2M=DU2M, TU2S=TU2S, - recompute_values=True) + MU_name=MU_name, DU_name=DU_name, TU_name=TU_name, + recompute_values=True, + verbose = False) self.set_init_cond_files(init_cond_file_type=init_cond_file_type, init_cond_file_name=init_cond_file_name, - init_cond_format=init_cond_format) + init_cond_format=init_cond_format, + verbose = False) self.set_output_files(output_file_type=output_file_type, output_file_name=output_file_name, @@ -264,6 +280,7 @@ def set_simulation_time(self, tstep_out : float | None = None, istep_dump : int | None = None, verbose : bool | None = None, + **kwargs: Any ): """ @@ -287,6 +304,9 @@ def set_simulation_time(self, `istep_out` (or the equivalent value determined by `tstep_out`) verbose: bool, optional If passed, it will override the Simulation object's verbose flag + **kwargs + A dictionary of additional keyword argument. This allows this method to be called by the more general + set_parameters method, which takes all possible Simulation parameters as arguments, so these are ignored. Returns ------- @@ -447,6 +467,7 @@ def set_feature(self, restart: bool | None = None, tides: bool | None = None, verbose: bool | None = None, + **kwargs: Any ): """ Turns on or off various features of a simulation. @@ -486,6 +507,9 @@ def set_feature(self, when the run is executed. verbose: bool, optional If passed, it will override the Simulation object's verbose flag + **kwargs + A dictionary of additional keyword argument. This allows this method to be called by the more general + set_parameters method, which takes all possible Simulation parameters as arguments, so these are ignored. Returns ------- @@ -596,7 +620,8 @@ def set_init_cond_files(self, init_cond_file_type: Literal["NETCDF_DOUBLE", "NETCDF_FLOAT", "ASCII"] | None = None, init_cond_file_name: str | os.PathLike | Dict[str, str] | Dict[str, os.PathLike] | None = None, init_cond_format: Literal["EL", "XV"] | None = None, - verbose: bool | None = None + verbose: bool | None = None, + **kwargs: Any ): """ Sets the initial condition file parameters in the parameters dictionary. @@ -627,6 +652,9 @@ def set_init_cond_files(self, > *Note:* If `codename` is "Swift" or "Swifter", EL initial conditions are converted to XV. verbose: bool, optional If passed, it will override the Simulation object's verbose flag + **kwargs + A dictionary of additional keyword argument. This allows this method to be called by the more general + set_parameters method, which takes all possible Simulation parameters as arguments, so these are ignored. Returns ------- @@ -771,7 +799,8 @@ def set_output_files(self, output_file_type: Literal[ "NETCDF_DOUBLE", "NETCDF_FLOAT", "REAL4", "REAL8", "XDR4", "XDR8"] | None = None, output_file_name: os.PathLike | str | None = None, output_format: Literal["XV", "XVEL"] | None = None, - verbose: bool | None = None + verbose: bool | None = None, + **kwargs: Any ): """ Sets the output file parameters in the parameters dictionary. @@ -792,6 +821,9 @@ def set_output_files(self, vectors for all bodies are stored. If "XVEL" then the orbital elements are also stored. verbose: bool, optional If passed, it will override the Simulation object's verbose flag + **kwargs + A dictionary of additional keyword argument. This allows this method to be called by the more general + set_parameters method, which takes all possible Simulation parameters as arguments, so these are ignored. Returns ------- @@ -909,7 +941,12 @@ def set_unit_system(self, MU2KG: float | None = None, DU2M: float | None = None, TU2S: float | None = None, - recompute_values: bool = False): + MU_name: str | None = None, + DU_name: str | None = None, + TU_name: str | None = None, + recompute_values: bool = True, + verbose: bool | None = None, + **kwargs: Any): """ Setter for setting the unit conversion between one of the standard sets. @@ -951,11 +988,25 @@ def set_unit_system(self, TU2S : float, optional The conversion factor to multiply by the time unit that would convert it to seconds. Setting this overrides TU - recompute_values : bool, default False + MU_name : str, optional + The name of the mass unit. When setting one of the standard units via `MU` a name will be + automatically set for the unit, so this argument will override the automatic name. + DU_name : str, optional + The name of the distance unit. When setting one of the standard units via `DU` a name will be + automatically set for the unit, so this argument will override the automatic name. + TU_name : str, optional + The name of the time unit. When setting one of the standard units via `TU` a name will be + automatically set for the unit, so this argument will override the automatic name. + recompute_values : bool, default True Recompute all values into the new unit system. >*Note:* This is a destructive operation, however if not executed then the values contained in the parameter > file and input/output data files computed previously may not be consistent with the new unit conversion > factors. + verbose: bool, optional + If passed, it will override the Simulation object's verbose flag + **kwargs + A dictionary of additional keyword argument. This allows this method to be called by the more general + set_parameters method, which takes all possible Simulation parameters as arguments, so these are ignored. Returns ---------- @@ -967,6 +1018,14 @@ def set_unit_system(self, DU2M_old = None TU2S_old = None + update_list = [] + if MU is not None or MU2KG is not None: + update_list.append("MU") + if DU is not None or DU2M is not None: + update_list.append("DU") + if TU is not None or TU2S is not None: + update_list.append("TU") + if MU2KG is not None or MU is not None: MU2KG_old = self.param.pop('MU2KG',None) if MU2KG is not None: @@ -1033,23 +1092,90 @@ def set_unit_system(self, self.param['TU2S'] = constants.YR2S self.TU_name = "y" + + if MU_name is not None: + self.MU_name = MU_name + if DU_name is not None: + self.DU_name = DU_name + if TU_name is not None: + self.TU_name = TU_name + self.VU_name = f"{self.DU_name}/{self.TU_name}" self.GU = constants.GC * self.param['TU2S']**2 * self.param['MU2KG'] / self.param['DU2M']**3 if recompute_values: self.update_param_units(MU2KG_old, DU2M_old, TU2S_old) - if self.verbose: - if self.MU_name is None or self.DU_name is None or self.TU_name is None: - print(f"Custom units set.") - print(f"MU2KG: {self.param['MU2KG']}") - print(f"DU2M : {self.param['DU2M']}") - print(f"TU2S : {self.param['TU2S']}") - else: - print(f"Units set to {self.MU_name}-{self.DU_name}-{self.TU_name}") + if verbose is None: + verbose = self.verbose + + if verbose: + unit_dict = self.get_unit_system(update_list) return + def get_unit_system(self, arg_list: str | List[str] | None = None): + """ + + Returns a subset of the parameter dictionary containing the current simulation unit system. + If the verbose option is set in the Simulation object, then it will also print the values. + + Parameters + ---------- + arg_list : str | List[str], optional + A single string or list of strings containing the names of the simulation unit system + Default is all of: + ["MU", "DU", "TU"] + + Returns + ------- + time_dict : dict + A dictionary containing the requested parameters + + """ + + valid_var = { + "MU": "MU2KG", + "DU": "DU2M", + "TU": "TU2S", + } + + if self.MU_name is None: + MU_name = "mass unit" + else: + MU_name = self.MU_name + if self.DU_name is None: + DU_name = "distance unit" + else: + DU_name = self.DU_name + if self.TU_name is None: + TU_name = "time unit" + else: + TU_name = self.TU_name + + units = { + "MU" : f"kg / {MU_name}", + "DU" : f"m / {DU_name}", + "TU" : f"s / {TU_name}" + } + + + if arg_list is None: + arg_list = valid_var.keys() + elif type(arg_list) is str: + arg_list = [arg_list] + else: + arg_list = [k for k in arg_list if k in set(valid_var.keys())] + + unit_dict = {valid_var[k]: self.param[valid_var[k]] for k in arg_list} + + if self.verbose: + for arg in arg_list: + key = valid_var[arg] + print(f"{arg:<32} {unit_dict[key]} {units[arg]}") + + return unit_dict + def update_param_units(self,MU2KG_old,DU2M_old,TU2S_old): """ Updates the values of parameters that have units when the units have changed. @@ -1096,7 +1222,10 @@ def update_param_units(self,MU2KG_old,DU2M_old,TU2S_old): return - def set_distance_range(self,rmin=None,rmax=None): + def set_distance_range(self, + rmin: float | None = None, + rmax: float | None = None, + **kwargs: Any): """ Sets the minimum and maximum distances of the simulation. @@ -1106,6 +1235,9 @@ def set_distance_range(self,rmin=None,rmax=None): Minimum distance of the simulation (CHK_QMIN, CHK_RMIN, CHK_QMIN_RANGE[0]) rmax : float Maximum distance of the simulation (CHK_RMAX, CHK_QMIN_RANGE[1]) + **kwargs + A dictionary of additional keyword argument. This allows this method to be called by the more general + set_parameters method, which takes all possible Simulation parameters as arguments, so these are ignored. Returns ------- From 99c76197ab89e463bbbfabc5c38cd1347837fb71 Mon Sep 17 00:00:00 2001 From: David Minton Date: Wed, 9 Nov 2022 10:57:11 -0500 Subject: [PATCH 017/569] Improved the getters and setters for the initial conditions files --- python/swiftest/swiftest/simulation_class.py | 236 +++++++++++++------ 1 file changed, 161 insertions(+), 75 deletions(-) diff --git a/python/swiftest/swiftest/simulation_class.py b/python/swiftest/swiftest/simulation_class.py index f538136ed..1c2cb3fca 100644 --- a/python/swiftest/swiftest/simulation_class.py +++ b/python/swiftest/swiftest/simulation_class.py @@ -211,12 +211,6 @@ def __init__(self, self.ds = xr.Dataset() self.param = { '! VERSION': f"Swiftest parameter input", - 'T0': 0.0, - 'TSTART' : 0.0, - 'TSTOP': 0.0, - 'DT': 0.0, - 'ISTEP_OUT': 1, - 'ISTEP_DUMP': 1, 'CHK_QMIN_COORD': "HELIO", 'INTERACTION_LOOPS': interaction_loops, 'ENCOUNTER_CHECK': encounter_check_loops @@ -436,18 +430,10 @@ def get_simulation_time(self, arg_list: str | List[str] | None = None): else: tstep_out = None - if arg_list is None: - arg_list = valid_var.keys() - elif type(arg_list) is str: - arg_list = [arg_list] - else: - arg_list = [k for k in arg_list if k in set(valid_var.keys())] - - time_dict = {valid_var[k]: self.param[valid_var[k]] for k in arg_list} + valid_arg, time_dict = self._get_valid_arg_list(arg_list, valid_var) if self.verbose: - print("\nSimulation time parameters:") - for arg in arg_list: + for arg in valid_arg: key = valid_var[arg] print(f"{arg:<32} {time_dict[key]} {units[arg]}") if tstep_out is not None: @@ -597,20 +583,10 @@ def get_feature(self, arg_list: str | List[str] | None = None): "restart" : "RESTART" } - if arg_list is None: - arg_list = valid_var.keys() - elif type(arg_list) is str: - arg_list = [arg_list] - else: - # Only allow arg_lists to be checked if they are valid. Otherwise ignore. - arg_list = [k for k in arg_list if k in set(valid_var.keys())] - - # Extract the arg_list dictionary - feature_dict = {valid_var[feat]:self.param[valid_var[feat]] for feat in arg_list} + valid_arg, feature_dict = self._get_valid_arg_list(arg_list, valid_var) if self.verbose: - print("\nSimulation feature parameters:") - for arg in arg_list: + for arg in valid_arg: key = valid_var[arg] print(f"{arg:<32} {feature_dict[key]}") @@ -662,7 +638,9 @@ def set_init_cond_files(self, """ - update_list = ["init_cond_file_name"] + update_list = [] + if init_cond_file_name is not None: + update_list.append("init_cond_file_name") if init_cond_file_type is not None: update_list.append("init_cond_file_type") if init_cond_format is not None: @@ -678,6 +656,18 @@ def ascii_file_input_error_msg(codename): print('}') return + if init_cond_format is None: + if "IN_FORM" in self.param: + init_cond_format = self.param['IN_FORM'] + else: + init_cond_format = "EL" + + if init_cond_file_type is None: + if "IN_TYPE" in self.param: + init_cond_file_type = self.param['IN_TYPE'] + else: + init_cond_file_type = "NETCDF_DOUBLE" + if self.codename == "Swiftest": init_cond_keys = ["CB", "PL", "TP"] else: @@ -689,8 +679,18 @@ def ascii_file_input_error_msg(codename): print(f"{init_cond_format} is not supported by {self.codename}. Using XV instead") init_cond_format = "XV" - self.param["IN_TYPE"] = init_cond_file_type - self.param["IN_FORM"] = init_cond_format + + valid_formats={"EL", "XV"} + if init_cond_format not in valid_formats: + print(f"{init_cond_format} is not a valid input format") + else: + self.param['IN_FORM'] = init_cond_format + + valid_types = {"NETCDF_DOUBLE", "NETCDF_FLOAT", "ASCII"} + if init_cond_file_type not in valid_types: + print(f"{init_cond_file_type} is not a valid input type") + else: + self.param['IN_TYPE'] = init_cond_file_type if init_cond_file_type == "ASCII": if init_cond_file_name is None: @@ -752,41 +752,48 @@ def get_init_cond_files(self, arg_list: str | List[str] | None = None): valid_var = {"init_cond_file_type": "IN_TYPE", "init_cond_format": "IN_FORM", "init_cond_file_name" : "NC_IN", - "init_cond_file_name (cb)" : "CB_IN", - "init_cond_file_name (pl)" : "PL_IN", - "init_cond_file_name (tp)" : "TP_IN", + "init_cond_file_name['CB']" : "CB_IN", + "init_cond_file_name['PL']" : "PL_IN", + "init_cond_file_name['TP']" : "TP_IN", } + three_file_args = ["init_cond_file_name['CB']", + "init_cond_file_name['PL']", + "init_cond_file_name['TP']"] + if self.codename == "Swifter": + three_file_args.remove("init_cond_file_name['CB']") + + # We have to figure out which initial conditions file model we are using (1 vs. 3 files) if arg_list is None: - arg_list = list(valid_var.keys()) + valid_arg = None + else: + valid_arg = arg_list.copy() + + if valid_arg is None: + valid_arg = list(valid_var.keys()) elif type(arg_list) is str: - arg_list = [arg_list] + valid_arg = [arg_list] else: - arg_list = [k for k in arg_list if k in set(valid_var.keys())] + # Only allow arg_lists to be checked if they are valid. Otherwise ignore. + valid_arg = [k for k in arg_list if k in list(valid_var.keys())] - if "init_cond_file_name" in arg_list: + # Figure out which input file model we need to use + if "init_cond_file_name" in valid_arg: if self.param["IN_TYPE"] == "ASCII": - arg_list.remove("init_cond_file_name") - if "init_cond_file_name (cb)" not in arg_list: - arg_list.append("init_cond_file_name (cb)") - if "init_cond_file_name (pl)" not in arg_list: - arg_list.append("init_cond_file_name (pl)") - if "init_cond_file_name (tp)" not in arg_list: - arg_list.append("init_cond_file_name (tp)") + valid_arg.remove("init_cond_file_name") + for key in three_file_args: + if key not in valid_arg: + valid_arg.append(key) else: - if "init_cond_file_name (cb)" in arg_list: - arg_list.remove("init_cond_file_name (cb)") - if "init_cond_file_name (pl)" in arg_list: - arg_list.remove("init_cond_file_name (pl)") - if "init_cond_file_name (tp)" in arg_list: - arg_list.remove("init_cond_file_name (tp)") + for key in three_file_args: + if key in valid_arg: + valid_arg.remove(key) - init_cond_file_dict = {valid_var[k]: self.param[valid_var[k]] for k in arg_list} + valid_arg, init_cond_file_dict = self._get_valid_arg_list(valid_arg, valid_var) if self.verbose: - print("\nInitial condition file parameters:") - for arg in arg_list: + for arg in valid_arg: key = valid_var[arg] print(f"{arg:<32} {init_cond_file_dict[key]}") @@ -794,7 +801,6 @@ def get_init_cond_files(self, arg_list: str | List[str] | None = None): - def set_output_files(self, output_file_type: Literal[ "NETCDF_DOUBLE", "NETCDF_FLOAT", "REAL4", "REAL8", "XDR4", "XDR8"] | None = None, output_file_name: os.PathLike | str | None = None, @@ -916,18 +922,10 @@ def get_output_files(self, arg_list: str | List[str] | None = None): "output_format": "OUT_FORM", } - if arg_list is None: - arg_list = valid_var.keys() - elif type(arg_list) is str: - arg_list = [arg_list] - else: - arg_list = [k for k in arg_list if k in set(valid_var.keys())] - - output_file_dict = {valid_var[k]: self.param[valid_var[k]] for k in arg_list} + valid_arg, output_file_dict = self._get_valid_arg_list(arg_list, valid_var) if self.verbose: - print("\nOutput file parameters:") - for arg in arg_list: + for arg in valid_arg: key = valid_var[arg] print(f"{arg:<32} {output_file_dict[key]}") @@ -1159,18 +1157,10 @@ def get_unit_system(self, arg_list: str | List[str] | None = None): "TU" : f"s / {TU_name}" } - - if arg_list is None: - arg_list = valid_var.keys() - elif type(arg_list) is str: - arg_list = [arg_list] - else: - arg_list = [k for k in arg_list if k in set(valid_var.keys())] - - unit_dict = {valid_var[k]: self.param[valid_var[k]] for k in arg_list} + valid_arg, unit_dict = self._get_valid_arg_list(arg_list, valid_var) if self.verbose: - for arg in arg_list: + for arg in valid_arg: key = valid_var[arg] print(f"{arg:<32} {unit_dict[key]} {units[arg]}") @@ -1262,6 +1252,102 @@ def set_distance_range(self, return + def _get_valid_arg_list(self, arg_list: str | List[str] | None = None, valid_var: Dict | None = None): + """ + Internal function for getters that extracts subset of arguments that is contained in the dictionary of valid + argument/parameter variable pairs. + + Parameters + ---------- + arg_list : str | List[str], optional + A single string or list of strings containing the Simulation argument. If none are supplied, + then it will create the arg_list out of all keys in the valid_var dictionary. + valid_var : valid_var: Dict + A dictionary where the key is the argument name and the value is the equivalent key in the Simulation + parameter dictionary (i.e. the left-hand column of a param.in file) + + Returns + ------- + valid_arg : [str] + The list of valid arguments that match the keys in valid_var + param : dict + A dictionary that is the subset of the Simulation parameter dictionary corresponding to the arguments listed + in arg_list. + + """ + + + if arg_list is None: + valid_arg = None + else: + valid_arg = arg_list.copy() + + if valid_arg is None: + valid_arg = list(valid_var.keys()) + elif type(arg_list) is str: + valid_arg = [arg_list] + else: + # Only allow arg_lists to be checked if they are valid. Otherwise ignore. + valid_arg = [k for k in arg_list if k in list(valid_var.keys())] + + # Extract the arg_list dictionary + param = {valid_var[feat]:self.param[valid_var[feat]] for feat in valid_arg} + + return valid_arg, param + + def get_distance_range(self, arg_list: str | List[str] | None = None): + """ + + Returns a subset of the parameter dictionary containing the current values of the distance range parameters. + If the verbose option is set in the Simulation object, then it will also print the values. + + Parameters + ---------- + arg_list: str | List[str], optional + A single string or list of strings containing the names of the features to extract. Default is all of: + ["rmin", "rmax"] + + Returns + ------- + range_dict : dict + A dictionary containing the requested parameters. + + """ + + valid_var = {"rmin": "CHK_RMIN", + "rmax": "CHK_RMAX", + "qmin": "CHK_QMIN", + "qminR" : "CHK_QMIN_RANGE" + } + + units = {"rmin" : self.DU_name, + "rmax" : self.DU_name, + "qmin" : self.DU_name, + "qminR" : self.DU_name, + } + + if "rmin" in arg_list: + arg_list.append("qmin") + if "rmax" in arg_list or "rmin" in arg_list: + arg_list.append("qminR") + + valid_arg, range_dict = self._get_valid_arg_list(arg_list, valid_var) + + if self.verbose: + if "rmin" in valid_arg: + key = valid_arg["rmin"] + print(f"{'rmin':<32} {range_dict[key]} {units['rmin']}") + key = valid_arg["qmin"] + print(f"{'':<32} {range_dict[key]} {units['qmin']}") + if "rmax" in valid_arg: + key = valid_arg["rmax"] + print(f"{'rmax':<32} {range_dict[key]} {units['rmax']}") + if "rmax" in valid_arg or "rmin" in valid_arg: + key = valid_arg["qminR"] + print(f"{'':<32} {range_dict[key]} {units['qminR']}") + + + return range_dict def add(self, plname, date=date.today().isoformat(), idval=None): From 41c61b1aad2a1171c29db59818ab085a7089ff3c Mon Sep 17 00:00:00 2001 From: David Minton Date: Wed, 9 Nov 2022 11:06:01 -0500 Subject: [PATCH 018/569] Prints the tstep_out value whenever istep_out is given as an argument to get_simulation_time --- python/swiftest/swiftest/simulation_class.py | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/python/swiftest/swiftest/simulation_class.py b/python/swiftest/swiftest/simulation_class.py index 1c2cb3fca..c2c557be2 100644 --- a/python/swiftest/swiftest/simulation_class.py +++ b/python/swiftest/swiftest/simulation_class.py @@ -423,7 +423,7 @@ def get_simulation_time(self, arg_list: str | List[str] | None = None): "istep_out" : "", "istep_dump" : ""} - if arg_list is not None and "tstep_out" in arg_list: + if arg_list is None or "tstep_out" in arg_list or "istep_out" in arg_list: istep_out = self.param['ISTEP_OUT'] dt = self.param['DT'] tstep_out = istep_out * dt From bd9bfad2a3b7026e609105a74faa56326da6aa14 Mon Sep 17 00:00:00 2001 From: David Minton Date: Wed, 9 Nov 2022 11:16:03 -0500 Subject: [PATCH 019/569] Fixed unit conversion bug and added simulation time parameters to Simulation class argument list --- python/swiftest/swiftest/simulation_class.py | 24 ++++++++++++++++---- 1 file changed, 20 insertions(+), 4 deletions(-) diff --git a/python/swiftest/swiftest/simulation_class.py b/python/swiftest/swiftest/simulation_class.py index c2c557be2..174d5e782 100644 --- a/python/swiftest/swiftest/simulation_class.py +++ b/python/swiftest/swiftest/simulation_class.py @@ -1,5 +1,4 @@ """ - self.param['BIN_OUT'] = binpath 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 @@ -36,6 +35,13 @@ def __init__(self, codename: Literal["Swiftest", "Swifter", "Swift"] = "Swiftest", param_file: os.PathLike | str ="param.in", read_param: bool = False, + t0: float = 0.0, + tstart: float = 0.0, + tstop: float = 1.0, + dt: float = 0.002, + istep_out: int = 50, + tstep_out: float | None = None, + istep_dump: int = 50, init_cond_file_type: Literal["NETCDF_DOUBLE", "NETCDF_FLOAT", "ASCII"] = "NETCDF_DOUBLE", init_cond_file_name: str | os.PathLike | Dict[str, str] | Dict[str, os.PathLike] | None = None, init_cond_format: Literal["EL", "XV"] = "EL", @@ -248,6 +254,16 @@ def __init__(self, restart=restart, verbose = False) + self.set_simulation_time(t0=t0, + tstart=tstart, + tstop=tstop, + dt=dt, + tstep_out=tstep_out, + istep_out=istep_out, + istep_dump=istep_dump, + verbose = False + ) + # If the parameter file is in a different location than the current working directory, we will need # to use it to properly open bin files self.sim_dir = os.path.dirname(os.path.realpath(param_file)) @@ -1190,12 +1206,12 @@ def update_param_units(self,MU2KG_old,DU2M_old,TU2S_old): for k in mass_keys: if k in self.param: print(f"param['{k}']: {self.param[k]}") - self.param[k] *= self.param['MU2KG'] / MU2KG_old + self.param[k] *= MU2KG_old / self.param['MU2KG'] if DU2M_old is not None: for k in distance_keys: if k in self.param: - self.param[k] *= self.param['DU2M'] / DU2M_old + self.param[k] *= DU2M_old / self.param['DU2M'] CHK_QMIN_RANGE = self.param.pop('CHK_QMIN_RANGE', None) if CHK_QMIN_RANGE is not None: @@ -1207,7 +1223,7 @@ def update_param_units(self,MU2KG_old,DU2M_old,TU2S_old): if TU2S_old is not None: for k in time_keys: if k in self.param: - self.param[k] *= self.param['TU2S'] / TU2S_old + self.param[k] *= TU2S_old / self.param['TU2S'] return From 50f626187326682f9925eb4dc22654514a9376ff Mon Sep 17 00:00:00 2001 From: David Minton Date: Wed, 9 Nov 2022 11:46:41 -0500 Subject: [PATCH 020/569] Improved the handling of unset parameters and removed the arbitrary default values for tstop, dt, istep_out, and istep_dump. --- python/swiftest/swiftest/simulation_class.py | 89 ++++++++++++-------- 1 file changed, 53 insertions(+), 36 deletions(-) diff --git a/python/swiftest/swiftest/simulation_class.py b/python/swiftest/swiftest/simulation_class.py index 174d5e782..917165bd1 100644 --- a/python/swiftest/swiftest/simulation_class.py +++ b/python/swiftest/swiftest/simulation_class.py @@ -26,7 +26,6 @@ Any ) - class Simulation: """ This is a class that defines the basic Swift/Swifter/Swiftest simulation object @@ -37,11 +36,11 @@ def __init__(self, read_param: bool = False, t0: float = 0.0, tstart: float = 0.0, - tstop: float = 1.0, - dt: float = 0.002, - istep_out: int = 50, + tstop: float | None = None, + dt: float | None = None, + istep_out: int | None = None, tstep_out: float | None = None, - istep_dump: int = 50, + istep_dump: int | None = None, init_cond_file_type: Literal["NETCDF_DOUBLE", "NETCDF_FLOAT", "ASCII"] = "NETCDF_DOUBLE", init_cond_file_name: str | os.PathLike | Dict[str, str] | Dict[str, os.PathLike] | None = None, init_cond_format: Literal["EL", "XV"] = "EL", @@ -86,6 +85,22 @@ def __init__(self, a new parameter file using the arguments passed to Simulation. > *Note:* If set to true, the parameters defined in the input file will override any passed into the > arguments of Simulation. + t0 : float, default 0.0 + The reference time for the start of the simulation. Defaults is 0.0 + tstart : float, default 0.0 + The start time for a restarted simulation. For a new simulation, tstart will be set to t0 automatically. + tstop : float, optional + The stopping time for a simulation. `tstop` must be greater than `tstart`. + dt : float, optional + The step size of the simulation. `dt` must be less than or equal to `tstop-dstart`. + istep_out : int, optional + The number of time steps between outputs to file. *Note*: only `istep_out` or `toutput` can be set. + tstep_out : float, optional + The approximate time between when outputs are written to file. Passing this computes + `istep_out = floor(tstep_out/dt)`. *Note*: only `istep_out` or `toutput` can be set. + istep_dump : int, optional + The anumber of time steps between outputs to dump file. If not set, this will be set to the value of + `istep_out` (or the equivalent value determined by `tstep_out`) init_cond_file_type : {"NETCDF_DOUBLE", "NETCDF_FLOAT", "ASCII"}, default "NETCDF_DOUBLE" The file type containing initial conditions for the simulation: * NETCDF_DOUBLE: A single initial conditions input file in NetCDF file format of type NETCDF_DOUBLE @@ -346,54 +361,54 @@ def set_simulation_time(self, if tstop is None: tstop = self.param.pop("TSTOP", None) - if tstop is None: - print("Error! tstop is not set!") - return else: update_list.append("tstop") - if tstop <= tstart: - print("Error! tstop must be greater than tstart.") - return + if tstop is not None: + if tstop <= tstart: + print("Error! tstop must be greater than tstart.") + return - self.param['TSTOP'] = tstop + if tstop is not None: + self.param['TSTOP'] = tstop if dt is None: dt = self.param.pop("DT", None) - if dt is None: - print("Error! dt is not set!") - return else: update_list.append("dt") - if dt > (tstop - tstart): - print("Error! dt must be smaller than tstop-tstart") - print(f"Setting dt = {tstop-tstart} instead of {dt}") - dt = tstop - tstart + if dt is not None and tstop is not None: + if dt > (tstop - tstart): + print("Error! dt must be smaller than tstop-tstart") + print(f"Setting dt = {tstop-tstart} instead of {dt}") + dt = tstop - tstart - self.param['DT'] = dt + if dt is not None: + self.param['DT'] = dt if istep_out is None and tstep_out is None: istep_out = self.param.pop("ISTEP_OUT", None) - if istep_out is None: - print("Error! istep_out is not set") - return if istep_out is not None and tstep_out is not None: print("Error! istep_out and tstep_out cannot both be set") return - if tstep_out is not None: + if tstep_out is not None and dt is not None: istep_out = int(np.floor(tstep_out / dt)) - self.param['ISTEP_OUT'] = istep_out + if istep_out is not None: + self.param['ISTEP_OUT'] = istep_out + update_list.append("istep_out") if istep_dump is None: - istep_dump = istep_out + istep_dump = self.param.pop("ISTEP_DUMP",None) + if istep_dump is None: + istep_dump = istep_out - self.param['ISTEP_DUMP'] = istep_dump + if istep_dump is not None: + self.param['ISTEP_DUMP'] = istep_dump + update_list.append("istep_dump") - update_list.extend(["istep_out", "tstep_out", "istep_dump"]) if verbose is None: verbose = self.verbose @@ -439,19 +454,22 @@ def get_simulation_time(self, arg_list: str | List[str] | None = None): "istep_out" : "", "istep_dump" : ""} + tstep_out = None if arg_list is None or "tstep_out" in arg_list or "istep_out" in arg_list: - istep_out = self.param['ISTEP_OUT'] - dt = self.param['DT'] - tstep_out = istep_out * dt - else: - tstep_out = None + if "ISTEP_OUT" in self.param and "DT" in self.param: + istep_out = self.param['ISTEP_OUT'] + dt = self.param['DT'] + tstep_out = istep_out * dt valid_arg, time_dict = self._get_valid_arg_list(arg_list, valid_var) if self.verbose: for arg in valid_arg: key = valid_var[arg] - print(f"{arg:<32} {time_dict[key]} {units[arg]}") + if key in time_dict: + print(f"{arg:<32} {time_dict[key]} {units[arg]}") + else: + print(f"{arg:<32} NOT SET") if tstep_out is not None: print(f"{'tstep_out':<32} {tstep_out} {units['tstep_out']}") @@ -1292,7 +1310,6 @@ def _get_valid_arg_list(self, arg_list: str | List[str] | None = None, valid_var """ - if arg_list is None: valid_arg = None else: @@ -1307,7 +1324,7 @@ def _get_valid_arg_list(self, arg_list: str | List[str] | None = None, valid_var valid_arg = [k for k in arg_list if k in list(valid_var.keys())] # Extract the arg_list dictionary - param = {valid_var[feat]:self.param[valid_var[feat]] for feat in valid_arg} + param = {valid_var[arg]:self.param[valid_var[arg]] for arg in valid_arg if valid_var[arg] in self.param} return valid_arg, param From 99f8c8b7a627062c4b86ddfebbb141ef3fbe2e47 Mon Sep 17 00:00:00 2001 From: David Minton Date: Wed, 9 Nov 2022 11:52:09 -0500 Subject: [PATCH 021/569] Improved display of units in get_unit_system --- python/swiftest/swiftest/simulation_class.py | 11 ++++++++--- 1 file changed, 8 insertions(+), 3 deletions(-) diff --git a/python/swiftest/swiftest/simulation_class.py b/python/swiftest/swiftest/simulation_class.py index 917165bd1..21e090747 100644 --- a/python/swiftest/swiftest/simulation_class.py +++ b/python/swiftest/swiftest/simulation_class.py @@ -1115,7 +1115,7 @@ def set_unit_system(self, self.TU_name = "y" elif TU.upper() == "DAY" or TU.upper() == "D" or TU.upper() == "JD" or TU.upper() == "DAYS": self.param['TU2S'] = constants.JD2S - self.TU_name = "Day" + self.TU_name = "d" elif TU.upper() == "S" or TU.upper() == "SECONDS" or TU.upper() == "SEC": self.param['TU2S'] = 1.0 self.TU_name = "s" @@ -1185,7 +1185,12 @@ def get_unit_system(self, arg_list: str | List[str] | None = None): else: TU_name = self.TU_name - units = { + units1 = { + "MU" : MU_name, + "DU" : DU_name, + "TU" : TU_name + } + units2 = { "MU" : f"kg / {MU_name}", "DU" : f"m / {DU_name}", "TU" : f"s / {TU_name}" @@ -1196,7 +1201,7 @@ def get_unit_system(self, arg_list: str | List[str] | None = None): if self.verbose: for arg in valid_arg: key = valid_var[arg] - print(f"{arg:<32} {unit_dict[key]} {units[arg]}") + print(f"{arg}: {units1[arg]:<28} {unit_dict[key]} {units2[arg]}") return unit_dict From 82cbe5357990818a4d26f934bbed767212c04c86 Mon Sep 17 00:00:00 2001 From: Carlisle Wishard Date: Wed, 9 Nov 2022 12:54:53 -0500 Subject: [PATCH 022/569] reordered calls to nf90_inq_varid in netcdf.f90 --- src/netcdf/netcdf.f90 | 5 +---- 1 file changed, 1 insertion(+), 4 deletions(-) diff --git a/src/netcdf/netcdf.f90 b/src/netcdf/netcdf.f90 index 0cd27f737..0c444669a 100644 --- a/src/netcdf/netcdf.f90 +++ b/src/netcdf/netcdf.f90 @@ -366,12 +366,10 @@ module subroutine netcdf_open(self, param, readonly) call check( nf90_inq_varid(self%ncid, TIME_DIMNAME, self%time_varid), "netcdf_open nf90_inq_varid time_varid" ) call check( nf90_inq_varid(self%ncid, ID_DIMNAME, self%id_varid), "netcdf_open nf90_inq_varid id_varid" ) - call check( nf90_inq_varid(self%ncid, NPL_VARNAME, self%npl_varid), "netcdf_open nf90_inq_varid npl_varid" ) - call check( nf90_inq_varid(self%ncid, NTP_VARNAME, self%ntp_varid), "netcdf_open nf90_inq_varid ntp_varid" ) - if (param%integrator == SYMBA) call check( nf90_inq_varid(self%ncid, NPLM_VARNAME, self%nplm_varid), "netcdf_open nf90_inq_varid nplm_varid" ) call check( nf90_inq_varid(self%ncid, NAME_VARNAME, self%name_varid), "netcdf_open nf90_inq_varid name_varid" ) call check( nf90_inq_varid(self%ncid, PTYPE_VARNAME, self%ptype_varid), "netcdf_open nf90_inq_varid ptype_varid" ) call check( nf90_inq_varid(self%ncid, STATUS_VARNAME, self%status_varid), "netcdf_open nf90_inq_varid status_varid" ) + 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" ) @@ -409,7 +407,6 @@ module subroutine netcdf_open(self, param, readonly) call check( nf90_inq_varid(self%ncid, OMEGA_VARNAME, self%omega_varid), "netcdf_open nf90_inq_varid omega_varid" ) call check( nf90_inq_varid(self%ncid, CAPM_VARNAME, self%capm_varid), "netcdf_open nf90_inq_varid capm_varid" ) end if - call check( nf90_inq_varid(self%ncid, GMASS_VARNAME, self%Gmass_varid), "netcdf_open nf90_inq_varid Gmass_varid" ) if (param%lrhill_present) call check( nf90_inq_varid(self%ncid, RHILL_VARNAME, self%rhill_varid), "netcdf_open nf90_inq_varid rhill_varid" ) From 516ae33973372d55b760c21edb4ea1020155b6ec Mon Sep 17 00:00:00 2001 From: Carlisle Wishard Date: Wed, 9 Nov 2022 12:55:29 -0500 Subject: [PATCH 023/569] commented out readonly bits so that new variables can be added --- src/netcdf/netcdf.f90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/netcdf/netcdf.f90 b/src/netcdf/netcdf.f90 index 0c444669a..9f2e9fba0 100644 --- a/src/netcdf/netcdf.f90 +++ b/src/netcdf/netcdf.f90 @@ -353,9 +353,9 @@ module subroutine netcdf_open(self, param, readonly) character(len=NF90_MAX_NAME) :: str_dim_name mode = NF90_WRITE - if (present(readonly)) then - if (readonly) mode = NF90_NOWRITE - end if + !if (present(readonly)) then + ! if (readonly) mode = NF90_NOWRITE + !end if call check( nf90_open(param%outfile, mode, self%ncid), "netcdf_open nf90_open" ) From 0a859905fd364825e9b7dddc2df9be6b3f4f9306 Mon Sep 17 00:00:00 2001 From: Carlisle Wishard Date: Wed, 9 Nov 2022 12:56:27 -0500 Subject: [PATCH 024/569] check if npl, ntp, or nplm exist and if not, calculate and define them --- src/netcdf/netcdf.f90 | 42 ++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 42 insertions(+) diff --git a/src/netcdf/netcdf.f90 b/src/netcdf/netcdf.f90 index 9f2e9fba0..e66498c35 100644 --- a/src/netcdf/netcdf.f90 +++ b/src/netcdf/netcdf.f90 @@ -351,6 +351,9 @@ module subroutine netcdf_open(self, param, readonly) ! Internals integer(I4B) :: mode, status character(len=NF90_MAX_NAME) :: str_dim_name + integer(I4B) :: idmax + real(DP), dimension(:), allocatable :: gmtemp + logical, dimension(:), allocatable :: tpmask, plmask, plmmask mode = NF90_WRITE !if (present(readonly)) then @@ -371,6 +374,45 @@ module subroutine netcdf_open(self, param, readonly) call check( nf90_inq_varid(self%ncid, STATUS_VARNAME, self%status_varid), "netcdf_open nf90_inq_varid status_varid" ) call check( nf90_inq_varid(self%ncid, GMASS_VARNAME, self%Gmass_varid), "netcdf_open nf90_inq_varid Gmass_varid" ) + if ((nf90_inq_varid(self%ncid, NPL_VARNAME, self%npl_varid) /= nf90_noerr) .or. & + (nf90_inq_varid(self%ncid, NTP_VARNAME, self%ntp_varid) /= nf90_noerr) .or. & + ((nf90_inq_varid(self%ncid, NPLM_VARNAME, self%nplm_varid) /= nf90_noerr) .and. (param%integrator == SYMBA))) then + call check( nf90_inquire_dimension(self%ncid, self%id_dimid, len=idmax), "netcdf_open nf90_inquire_dimension id_dimid" ) + allocate(gmtemp(idmax)) + call check( nf90_get_var(self%ncid, self%Gmass_varid, gmtemp, start=[1,1]), "netcdf_open nf90_getvar Gmass_varid" ) + allocate(tpmask(idmax)) + allocate(plmask(idmax)) + allocate(plmmask(idmax)) + plmask(:) = gmtemp(:) == gmtemp(:) + tpmask(:) = .not. plmask(:) + plmask(1) = .false. ! This is the central body + select type (param) + class is (symba_parameters) + plmmask(:) = gmtemp(:) > param%GMTINY .and. plmask(:) + end select + if ((nf90_inq_varid(self%ncid, NPL_VARNAME, self%npl_varid) /= nf90_noerr)) then + call check( nf90_redef(self%ncid), "netcdf_open nf90_redef npl_varid") + call check( nf90_def_var(self%ncid, NPL_VARNAME, NF90_INT, self%time_dimid, self%npl_varid), "netcdf_open nf90_def_var npl_varid" ) + call check( nf90_enddef(self%ncid), "netcdf_open nf90_enddef npl_varid") + call check( nf90_put_var(self%ncid, self%npl_varid, count(plmask(:)), start=[1]), "netcdf_open nf90_put_var npl_varid" ) + call check( nf90_inq_varid(self%ncid, NPL_VARNAME, self%npl_varid), "netcdf_open nf90_inq_varid npl_varid" ) + end if + if (nf90_inq_varid(self%ncid, NTP_VARNAME, self%ntp_varid) /= nf90_noerr) then + call check( nf90_redef(self%ncid), "netcdf_open nf90_redef ntp_varid") + call check( nf90_def_var(self%ncid, NTP_VARNAME, NF90_INT, self%time_dimid, self%ntp_varid), "netcdf_open nf90_def_var ntp_varid" ) + call check( nf90_enddef(self%ncid), "netcdf_open nf90_enddef ntp_varid") + call check( nf90_put_var(self%ncid, self%ntp_varid, count(tpmask(:)), start=[1]), "netcdf_open nf90_put_var ntp_varid" ) + call check( nf90_inq_varid(self%ncid, NTP_VARNAME, self%ntp_varid), "netcdf_open nf90_inq_varid ntp_varid" ) + end if + if ((nf90_inq_varid(self%ncid, NPLM_VARNAME, self%nplm_varid) /= nf90_noerr) .and. (param%integrator == SYMBA)) then + call check( nf90_redef(self%ncid), "netcdf_open nf90_redef nplm_varid") + call check( nf90_def_var(self%ncid, NPLM_VARNAME, NF90_INT, self%time_dimid, self%nplm_varid), "netcdf_open nf90_def_var nplm_varid" ) + call check( nf90_enddef(self%ncid), "netcdf_open nf90_enddef nplm_varid") + call check( nf90_put_var(self%ncid, self%nplm_varid, count(plmmask(:)), start=[1]), "netcdf_open nf90_put_var nplm_varid" ) + call check( nf90_inq_varid(self%ncid, NPLM_VARNAME, self%nplm_varid), "netcdf_open nf90_inq_varid nplm_varid" ) + end if + end if + 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" ) From 1b962e262681385d8dc4430ae8d844b3ffa1b8c7 Mon Sep 17 00:00:00 2001 From: David Minton Date: Wed, 9 Nov 2022 14:44:45 -0500 Subject: [PATCH 025/569] Fixed typos in getter methods and improved the handling of rmin and rmax reporting in the get_distance_range method --- python/swiftest/swiftest/simulation_class.py | 47 ++++++++++++-------- 1 file changed, 29 insertions(+), 18 deletions(-) diff --git a/python/swiftest/swiftest/simulation_class.py b/python/swiftest/swiftest/simulation_class.py index 21e090747..b72542aaa 100644 --- a/python/swiftest/swiftest/simulation_class.py +++ b/python/swiftest/swiftest/simulation_class.py @@ -475,6 +475,26 @@ def get_simulation_time(self, arg_list: str | List[str] | None = None): return time_dict + def set_parameters(self, **kwargs): + """ + Setter for all possible parameters. Calls each of the specialized setters using keyword arguments + Parameters + ---------- + **kwargs : [TODO: write this documentation] + + Returns + ------- + param : A dictionary of all Simulation parameters that changed + + """ + self.set_unit_system(**kwargs) + self.set_distance_range(**kwargs) + self.set_feature(**kwargs) + self.set_init_cond_files(**kwargs) + self.set_output_files(**kwargs) + self.set_simulation_time(**kwargs) + + def set_feature(self, close_encounter_check: bool | None = None, general_relativity: bool | None = None, @@ -800,16 +820,10 @@ def get_init_cond_files(self, arg_list: str | List[str] | None = None): # We have to figure out which initial conditions file model we are using (1 vs. 3 files) if arg_list is None: - valid_arg = None - else: - valid_arg = arg_list.copy() - - if valid_arg is None: valid_arg = list(valid_var.keys()) elif type(arg_list) is str: valid_arg = [arg_list] else: - # Only allow arg_lists to be checked if they are valid. Otherwise ignore. valid_arg = [k for k in arg_list if k in list(valid_var.keys())] # Figure out which input file model we need to use @@ -1364,26 +1378,23 @@ def get_distance_range(self, arg_list: str | List[str] | None = None): "qminR" : self.DU_name, } - if "rmin" in arg_list: - arg_list.append("qmin") - if "rmax" in arg_list or "rmin" in arg_list: - arg_list.append("qminR") + if type(arg_list) is str: + arg_list = [arg_list] + if arg_list is not None: + if "rmin" in arg_list: + arg_list.append("qmin") + if "rmax" in arg_list or "rmin" in arg_list: + arg_list.append("qminR") valid_arg, range_dict = self._get_valid_arg_list(arg_list, valid_var) if self.verbose: if "rmin" in valid_arg: - key = valid_arg["rmin"] + key = valid_var["rmin"] print(f"{'rmin':<32} {range_dict[key]} {units['rmin']}") - key = valid_arg["qmin"] - print(f"{'':<32} {range_dict[key]} {units['qmin']}") if "rmax" in valid_arg: - key = valid_arg["rmax"] + key = valid_var["rmax"] print(f"{'rmax':<32} {range_dict[key]} {units['rmax']}") - if "rmax" in valid_arg or "rmin" in valid_arg: - key = valid_arg["qminR"] - print(f"{'':<32} {range_dict[key]} {units['qminR']}") - return range_dict From d592f0e6a1d8f5ae30823276d9408beaf463ab79 Mon Sep 17 00:00:00 2001 From: David Minton Date: Wed, 9 Nov 2022 17:08:44 -0500 Subject: [PATCH 026/569] Made improvements to type handling by the Swiftest xarray methods --- python/swiftest/swiftest/init_cond.py | 1 + python/swiftest/swiftest/io.py | 80 ++++++++------------ python/swiftest/swiftest/simulation_class.py | 5 ++ 3 files changed, 38 insertions(+), 48 deletions(-) diff --git a/python/swiftest/swiftest/init_cond.py b/python/swiftest/swiftest/init_cond.py index 0166e78a8..bf2720a3c 100644 --- a/python/swiftest/swiftest/init_cond.py +++ b/python/swiftest/swiftest/init_cond.py @@ -417,4 +417,5 @@ def vec2xr(param, idvals, namevals, v1, v2, v3, v4, v5, v6, GMpl=None, Rpl=None, ds_float = da_float.to_dataset(dim="vec") ds_str = da_str.to_dataset(dim="vec") ds = xr.combine_by_coords([ds_float, ds_str,info_ds]) + return ds \ No newline at end of file diff --git a/python/swiftest/swiftest/io.py b/python/swiftest/swiftest/io.py index 28303f8f8..dc184b175 100644 --- a/python/swiftest/swiftest/io.py +++ b/python/swiftest/swiftest/io.py @@ -49,6 +49,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"] +int_varnames = ["id", "ntp", "npl", "nplm", "discard_body_id", "collision_id"] def bool2yesno(boolval): """ @@ -847,54 +848,14 @@ def swiftest2xr(param, verbose=True): ------- xarray dataset """ - if ((param['OUT_TYPE'] == 'REAL8') or (param['OUT_TYPE'] == 'REAL4')): - dims = ['time', 'id', 'vec'] - cb = [] - pl = [] - tp = [] - cbn = None - try: - with FortranFile(param['BIN_OUT'], 'r') as f: - for t, cbid, cbnames, cvec, clab, \ - npl, plid, plnames, pvec, plab, \ - ntp, tpid, tpnames, tvec, tlab in swiftest_stream(f, param): - # Prepare frames by adding an extra axis for the time coordinate - cbframe = np.expand_dims(cvec, axis=0) - plframe = np.expand_dims(pvec, axis=0) - tpframe = np.expand_dims(tvec, axis=0) - - - # Create xarray DataArrays out of each body type - cbxr = xr.DataArray(cbframe, dims=dims, coords={'time': t, 'id': cbid, 'vec': clab}) - cbxr = cbxr.assign_coords(name=("id", cbnames)) - plxr = xr.DataArray(plframe, dims=dims, coords={'time': t, 'id': plid, 'vec': plab}) - plxr = plxr.assign_coords(name=("id", plnames)) - tpxr = xr.DataArray(tpframe, dims=dims, coords={'time': t, 'id': tpid, 'vec': tlab}) - tpxr = tpxr.assign_coords(name=("id", tpnames)) - - cb.append(cbxr) - pl.append(plxr) - tp.append(tpxr) - - sys.stdout.write('\r' + f"Reading in time {t[0]:.3e}") - sys.stdout.flush() - except IOError: - print(f"Error encountered reading in {param['BIN_OUT']}") - - cbda = xr.concat(cb, dim='time') - plda = xr.concat(pl, dim='time') - tpda = xr.concat(tp, dim='time') - - cbds = cbda.to_dataset(dim='vec') - plds = plda.to_dataset(dim='vec') - tpds = tpda.to_dataset(dim='vec') - if verbose: print('\nCreating Dataset') - ds = xr.combine_by_coords([cbds, plds, tpds]) - elif ((param['OUT_TYPE'] == 'NETCDF_DOUBLE') or (param['OUT_TYPE'] == 'NETCDF_FLOAT')): + if ((param['OUT_TYPE'] == 'NETCDF_DOUBLE') or (param['OUT_TYPE'] == 'NETCDF_FLOAT')): if verbose: print('\nCreating Dataset from NetCDF file') ds = xr.open_dataset(param['BIN_OUT'], mask_and_scale=False) - ds = clean_string_values(ds) + if param['OUT_TYPE'] == "NETCDF_DOUBLE": + ds = fix_types(ds,ftype=np.float64) + elif param['OUT_TYPE'] == "NETCDF_FLOAT": + ds = fix_types(ds,ftype=np.float32) else: print(f"Error encountered. OUT_TYPE {param['OUT_TYPE']} not recognized.") return None @@ -931,7 +892,7 @@ def string_converter(da): """ if da.dtype == np.dtype(object): da = da.astype(' Date: Wed, 9 Nov 2022 17:57:07 -0500 Subject: [PATCH 027/569] Restructured when the param file is read in and fixed typo in bool2str --- examples/Basic_Simulation/param.in | 46 ----------------- python/swiftest/swiftest/io.py | 52 +++++++++----------- python/swiftest/swiftest/simulation_class.py | 21 ++++---- 3 files changed, 34 insertions(+), 85 deletions(-) delete mode 100644 examples/Basic_Simulation/param.in diff --git a/examples/Basic_Simulation/param.in b/examples/Basic_Simulation/param.in deleted file mode 100644 index bec3573de..000000000 --- a/examples/Basic_Simulation/param.in +++ /dev/null @@ -1,46 +0,0 @@ -!! Copyright 2022 - David Minton, Carlisle Wishard, Jennifer Pouplin, Jake Elliott, & Dana Singh -!! This file is part of Swiftest. -!! Swiftest is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License -!! as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. -!! Swiftest is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty -!! of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. -!! You should have received a copy of the GNU General Public License along with Swiftest. -!! If not, see: https://www.gnu.org/licenses. - -! VERSION Swiftest parameter input -T0 0.0 -TSTOP 10 -DT 0.005 -ISTEP_OUT 200 -ISTEP_DUMP 200 -OUT_FORM XVEL -OUT_TYPE NETCDF_DOUBLE -OUT_STAT REPLACE -IN_TYPE ASCII -PL_IN pl.in -TP_IN tp.in -CB_IN cb.in -BIN_OUT out.nc -CHK_QMIN 0.004650467260962157 -CHK_RMIN 0.004650467260962157 -CHK_RMAX 1000.0 -CHK_EJECT 1000.0 -CHK_QMIN_COORD HELIO -CHK_QMIN_RANGE 0.004650467260962157 1000.0 -MU2KG 1.988409870698051e+30 -TU2S 31557600.0 -DU2M 149597870700.0 -IN_FORM EL -EXTRA_FORCE NO -BIG_DISCARD NO -CHK_CLOSE YES -RHILL_PRESENT YES -FRAGMENTATION YES -ROTATION YES -TIDES NO -ENERGY YES -GR YES -INTERACTION_LOOPS ADAPTIVE -ENCOUNTER_CHECK ADAPTIVE -GMTINY 1e-06 -MIN_GMFRAG 1e-09 diff --git a/python/swiftest/swiftest/io.py b/python/swiftest/swiftest/io.py index dc184b175..50c84751f 100644 --- a/python/swiftest/swiftest/io.py +++ b/python/swiftest/swiftest/io.py @@ -46,6 +46,12 @@ "YARKOVSKY", "YORP"] +int_param = ["ISTEP_OUT", "ISTEP_DUMP"] +float_param = ["T0", "TSTART", "TSTOP", "DT", "CHK_RMIN", "CHK_RMAX", "CHK_EJECT", "CHK_QMIN", "DU2M", "MU2KG", + "TU2S", "MIN_GMFRAG", "GMTINY"] + +upper_str_param = ["OUT_TYPE","OUT_FORM","OUT_STAT","IN_TYPE","IN_FORM"] + # 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"] @@ -107,10 +113,10 @@ def str2bool(input_str): valid_false = ["NO", "N", "F", "FALSE", ".FALSE."] if input_str.upper() in valid_true: return True - elif input_str.lower() in valid_false: + elif input_str.upper() in valid_false: return False else: - raise ValueError(f"{input_str} cannot is not recognized as boolean") + raise ValueError(f"{input_str} is not recognized as boolean") @@ -147,7 +153,8 @@ def read_swiftest_param(param_file_name, param, verbose=True): A dictionary containing the entries in the user parameter file """ param['! VERSION'] = f"Swiftest parameter input from file {param_file_name}" - + + # Read param.in file if verbose: print(f'Reading Swiftest file {param_file_name}') try: @@ -158,38 +165,23 @@ def read_swiftest_param(param_file_name, param, verbose=True): if fields[0][0] != '!': key = fields[0].upper() param[key] = fields[1] - #for key in param: - # if (key == fields[0].upper()): param[key] = fields[1] # Special case of CHK_QMIN_RANGE requires a second input if fields[0].upper() == 'CHK_QMIN_RANGE': alo = real2float(fields[1]) ahi = real2float(fields[2]) param['CHK_QMIN_RANGE'] = f"{alo} {ahi}" - - param['ISTEP_OUT'] = int(param['ISTEP_OUT']) - param['ISTEP_DUMP'] = int(param['ISTEP_DUMP']) - param['OUT_TYPE'] = param['OUT_TYPE'].upper() - param['OUT_FORM'] = param['OUT_FORM'].upper() - param['OUT_STAT'] = param['OUT_STAT'].upper() - param['IN_TYPE'] = param['IN_TYPE'].upper() - param['IN_FORM'] = param['IN_FORM'].upper() - param['T0'] = real2float(param['T0']) - param['TSTART'] = real2float(param['TSTART']) - param['TSTOP'] = real2float(param['TSTOP']) - param['DT'] = real2float(param['DT']) - param['CHK_RMIN'] = real2float(param['CHK_RMIN']) - param['CHK_RMAX'] = real2float(param['CHK_RMAX']) - param['CHK_EJECT'] = real2float(param['CHK_EJECT']) - param['CHK_QMIN'] = real2float(param['CHK_QMIN']) - param['DU2M'] = real2float(param['DU2M']) - param['MU2KG'] = real2float(param['MU2KG']) - param['TU2S'] = real2float(param['TU2S']) - param['INTERACTION_LOOPS'] = param['INTERACTION_LOOPS'].upper() - param['ENCOUNTER_CHECK'] = param['ENCOUNTER_CHECK'].upper() - if 'GMTINY' in param: - param['GMTINY'] = real2float(param['GMTINY']) - if 'MIN_GMFRAG' in param: - param['MIN_GMFRAG'] = real2float(param['MIN_GMFRAG']) + + for uc in upper_str_param: + if uc in param: + param[uc] = param[uc].upper() + + for i in int_param: + if i in param and type(i) != int: + param[i] = int(param[i]) + + for f in float_param: + if f in param and type(f) is str: + param[f] = real2float(param[f]) for b in bool_param: if b in param: param[b] = str2bool(param[b]) diff --git a/python/swiftest/swiftest/simulation_class.py b/python/swiftest/swiftest/simulation_class.py index a7f7f7a6d..a7b8ed27c 100644 --- a/python/swiftest/swiftest/simulation_class.py +++ b/python/swiftest/swiftest/simulation_class.py @@ -240,6 +240,15 @@ def __init__(self, self.verbose = verbose self.restart = restart + # If the parameter file is in a different location than the current working directory, we will need + # to use it to properly open bin files + self.sim_dir = os.path.dirname(os.path.realpath(param_file)) + if read_param: + if os.path.exists(param_file): + self.read_param(param_file, codename=codename, verbose=self.verbose) + else: + print(f"{param_file} not found.") + self.set_distance_range(rmin=rmin, rmax=rmax, verbose = False) self.set_unit_system(MU=MU, DU=DU, TU=TU, @@ -279,14 +288,7 @@ def __init__(self, verbose = False ) - # If the parameter file is in a different location than the current working directory, we will need - # to use it to properly open bin files - self.sim_dir = os.path.dirname(os.path.realpath(param_file)) - if read_param: - if os.path.exists(param_file): - self.read_param(param_file, codename=codename, verbose=self.verbose) - else: - print(f"{param_file} not found.") + if read_old_output_file: binpath = os.path.join(self.sim_dir,self.param['BIN_OUT']) @@ -1487,7 +1489,8 @@ def read_param(self, param_file, codename="Swiftest", verbose=True): self.ds : xarray dataset """ if codename == "Swiftest": - self.param = io.read_swiftest_param(param_file, self.param, verbose=verbose) + param_old = self.param.copy() + self.param = io.read_swiftest_param(param_file, param_old, verbose=verbose) self.codename = "Swiftest" elif codename == "Swifter": self.param = io.read_swifter_param(param_file, verbose=verbose) From c7ab062afeec3b6b7e3121c731e1c49ef61e4d77 Mon Sep 17 00:00:00 2001 From: David Minton Date: Wed, 9 Nov 2022 19:42:04 -0500 Subject: [PATCH 028/569] Consolidated all the parameter setters into one --- python/swiftest/swiftest/simulation_class.py | 328 +++++++++++-------- 1 file changed, 191 insertions(+), 137 deletions(-) diff --git a/python/swiftest/swiftest/simulation_class.py b/python/swiftest/swiftest/simulation_class.py index b72542aaa..80e1527ec 100644 --- a/python/swiftest/swiftest/simulation_class.py +++ b/python/swiftest/swiftest/simulation_class.py @@ -240,45 +240,6 @@ def __init__(self, self.verbose = verbose self.restart = restart - self.set_distance_range(rmin=rmin, rmax=rmax, verbose = False) - - self.set_unit_system(MU=MU, DU=DU, TU=TU, - MU2KG=MU2KG, DU2M=DU2M, TU2S=TU2S, - MU_name=MU_name, DU_name=DU_name, TU_name=TU_name, - recompute_values=True, - verbose = False) - - self.set_init_cond_files(init_cond_file_type=init_cond_file_type, - init_cond_file_name=init_cond_file_name, - init_cond_format=init_cond_format, - verbose = False) - - self.set_output_files(output_file_type=output_file_type, - output_file_name=output_file_name, - output_format=output_format, - verbose = False) - - self.set_feature(close_encounter_check=close_encounter_check, - general_relativity=general_relativity, - fragmentation=fragmentation, - rotation=rotation, - compute_conservation_values=compute_conservation_values, - extra_force=extra_force, - big_discard=big_discard, - rhill_present=rhill_present, - restart=restart, - verbose = False) - - self.set_simulation_time(t0=t0, - tstart=tstart, - tstop=tstop, - dt=dt, - tstep_out=tstep_out, - istep_out=istep_out, - istep_dump=istep_dump, - verbose = False - ) - # If the parameter file is in a different location than the current working directory, we will need # to use it to properly open bin files self.sim_dir = os.path.dirname(os.path.realpath(param_file)) @@ -288,6 +249,37 @@ def __init__(self, else: print(f"{param_file} not found.") + self.set_parameters(t0=t0, + tstart=tstart, + tstop=tstop, + dt=dt, + tstep_out=tstep_out, + istep_out=istep_out, + istep_dump=istep_dump, + rmin=rmin, rmax=rmax, + MU=MU, DU=DU, TU=TU, + MU2KG=MU2KG, DU2M=DU2M, TU2S=TU2S, + MU_name=MU_name, DU_name=DU_name, TU_name=TU_name, + recompute_unit_values=False, + init_cond_file_type=init_cond_file_type, + init_cond_file_name=init_cond_file_name, + init_cond_format=init_cond_format, + output_file_type=output_file_type, + output_file_name=output_file_name, + output_format=output_format, + close_encounter_check=close_encounter_check, + general_relativity=general_relativity, + fragmentation=fragmentation, + rotation=rotation, + compute_conservation_values=compute_conservation_values, + extra_force=extra_force, + big_discard=big_discard, + rhill_present=rhill_present, + restart=restart, + verbose = False) + + + if read_old_output_file: binpath = os.path.join(self.sim_dir,self.param['BIN_OUT']) if os.path.exists(binpath): @@ -296,6 +288,48 @@ def __init__(self, print(f"BIN_OUT file {binpath} not found.") return + def _get_valid_arg_list(self, arg_list: str | List[str] | None = None, valid_var: Dict | None = None): + """ + Internal function for getters that extracts subset of arguments that is contained in the dictionary of valid + argument/parameter variable pairs. + + Parameters + ---------- + arg_list : str | List[str], optional + A single string or list of strings containing the Simulation argument. If none are supplied, + then it will create the arg_list out of all keys in the valid_var dictionary. + valid_var : valid_var: Dict + A dictionary where the key is the argument name and the value is the equivalent key in the Simulation + parameter dictionary (i.e. the left-hand column of a param.in file) + + Returns + ------- + valid_arg : [str] + The list of valid arguments that match the keys in valid_var + param : dict + A dictionary that is the subset of the Simulation parameter dictionary corresponding to the arguments listed + in arg_list. + + """ + + if arg_list is None: + valid_arg = None + else: + valid_arg = arg_list.copy() + + if valid_arg is None: + valid_arg = list(valid_var.keys()) + elif type(arg_list) is str: + valid_arg = [arg_list] + else: + # Only allow arg_lists to be checked if they are valid. Otherwise ignore. + valid_arg = [k for k in arg_list if k in list(valid_var.keys())] + + # Extract the arg_list dictionary + param = {valid_var[arg]: self.param[valid_var[arg]] for arg in valid_arg if valid_var[arg] in self.param} + + return valid_arg, param + def set_simulation_time(self, t0: float | None = None, tstart: float | None = None, @@ -335,7 +369,8 @@ def set_simulation_time(self, Returns ------- - Sets the appropriate parameter variables in the parameter dictionary. + time_dict : dict + A dictionary containing the requested parameters """ @@ -409,16 +444,11 @@ def set_simulation_time(self, self.param['ISTEP_DUMP'] = istep_dump update_list.append("istep_dump") + time_dict = self.get_simulation_time(update_list,verbose=verbose) - if verbose is None: - verbose = self.verbose - if verbose: - if len(update_list) > 0: - time_dict = self.get_simulation_time(update_list) - - return + return time_dict - def get_simulation_time(self, arg_list: str | List[str] | None = None): + def get_simulation_time(self, arg_list: str | List[str] | None = None, verbose: bool | None = None): """ Returns a subset of the parameter dictionary containing the current simulation time parameters. @@ -430,6 +460,8 @@ def get_simulation_time(self, arg_list: str | List[str] | None = None): A single string or list of strings containing the names of the simulation time parameters to extract. Default is all of: ["t0", "tstart", "tstop", "dt", "istep_out", "tstep_out", "istep_dump"] + verbose: bool, optional + If passed, it will override the Simulation object's verbose flag Returns ------- @@ -463,7 +495,10 @@ def get_simulation_time(self, arg_list: str | List[str] | None = None): valid_arg, time_dict = self._get_valid_arg_list(arg_list, valid_var) - if self.verbose: + if verbose is None: + verbose = self.verbose + + if verbose: for arg in valid_arg: key = valid_var[arg] if key in time_dict: @@ -506,6 +541,8 @@ def set_feature(self, rhill_present: bool | None = None, restart: bool | None = None, tides: bool | None = None, + interaction_loops: Literal["TRIANGULAR", "FLAT", "ADAPTIVE"] | None = None, + encounter_check_loops: Literal["TRIANGULAR", "SORTSWEEP", "ADAPTIVE"] | None = None, verbose: bool | None = None, **kwargs: Any ): @@ -535,6 +572,28 @@ def set_feature(self, Includes big bodies when performing a discard (Swifter only) rhill_present: bool, optional Include the Hill's radius with the input files. + interaction_loops : {"TRIANGULAR","FLAT","ADAPTIVE"}, default "TRIANGULAR" + *Swiftest Experimental feature* + Specifies which algorithm to use for the computation of body-body gravitational forces. + * "TRIANGULAR" : Upper-triangular double-loops . + * "FLAT" : Body-body interation pairs are flattened into a 1-D array. + * "ADAPTIVE" : Periodically times the TRIANGULAR and FLAT methods and determines which one to use based on + the wall time to complete the loop. *Note:* Using ADAPTIVE means that bit-identical repeatability cannot + be assured, as the choice of algorithm depends on possible external factors that can influence the wall + time calculation. The exact floating-point results of the interaction will be different between the two + algorithm types. + encounter_check_loops : {"TRIANGULAR","SORTSWEEP","ADAPTIVE"}, default "TRIANGULAR" + *Swiftest Experimental feature* + Specifies which algorithm to use for checking whether bodies are in a close encounter state or not. + * "TRIANGULAR" : Upper-triangular double-loops. + * "SORTSWEEP" : A Sort-Sweep algorithm is used to reduce the population of potential close encounter bodies. + This algorithm is still in development, and does not necessarily speed up the encounter checking. + Use with caution. + * "ADAPTIVE" : Periodically times the TRIANGULAR and SORTSWEEP methods and determines which one to use based + on the wall time to complete the loop. *Note:* Using ADAPTIVE means that bit-identical repeatability cannot + be assured, as the choice of algorithm depends on possible external factors that can influence the wall + time calculation. The exact floating-point results of the interaction will be different between the two + algorithm types. tides: bool, optional Turns on tidal model (IN DEVELOPMENT - IGNORED) Yarkovsky: bool, optional @@ -553,7 +612,8 @@ def set_feature(self, Returns ------- - Sets the appropriate parameters in the self.param dictionary + feature_dict : dict + A dictionary containing the requested features. """ @@ -597,17 +657,31 @@ def set_feature(self, self.param["RESTART"] = restart update_list.append("restart") + if interaction_loops is not None: + valid_vals = ["TRIANGULAR","FLAT","ADAPTIVE"] + if interaction_loops not in valid_vals: + print(f"{interaction_loops} is not a valid option for interaction loops.") + print(f"Must be one of {valid_vals}") + self.param["INTERACTION_LOOPS"] = interaction_loops + else: + update_list.append("interaction_loops") + + if encounter_check_loops is not None: + valid_vals = ["TRIANGULAR", "SORTSWEEP", "ADAPTIVE"] + if encounter_check_loops not in valid_vals: + print(f"{encounter_check_loops} is not a valid option for interaction loops.") + print(f"Must be one of {valid_vals}") + else: + self.param["ENCOUNTER_CHECK"] = encounter_check_loops + update_list.append("encounter_check_loops") + self.param["TIDES"] = False - if verbose is None: - verbose = self.verbose - if verbose: - if len(update_list) > 0: - feature_dict = self.get_feature(update_list) - return + feature_dict = self.get_feature(update_list, verbose) + return feature_dict - def get_feature(self, arg_list: str | List[str] | None = None): + def get_feature(self, arg_list: str | List[str] | None = None, verbose: bool | None = None): """ Returns a subset of the parameter dictionary containing the current value of the feature boolean values. @@ -618,6 +692,8 @@ def get_feature(self, arg_list: str | List[str] | None = None): arg_list: str | List[str], optional A single string or list of strings containing the names of the features to extract. Default is all of: ["close_encounter_check", "general_relativity", "fragmentation", "rotation", "compute_conservation_values"] + verbose: bool, optional + If passed, it will override the Simulation object's verbose flag Returns ------- @@ -634,12 +710,17 @@ def get_feature(self, arg_list: str | List[str] | None = None): "extra_force": "EXTRA_FORCE", "big_discard": "BIG_DISCARD", "rhill_present": "RHILL_PRESENT", - "restart" : "RESTART" + "restart" : "RESTART", + "interaction_loops" : "INTERACTION_LOOPS", + "encounter_check_loops" : "ENCOUNTER_CHECK_LOOPS" } valid_arg, feature_dict = self._get_valid_arg_list(arg_list, valid_var) - if self.verbose: + if verbose is None: + verbose = self.verbose + + if verbose: for arg in valid_arg: key = valid_var[arg] print(f"{arg:<32} {feature_dict[key]}") @@ -688,7 +769,8 @@ def set_init_cond_files(self, Returns ------- - Sets the appropriate initial conditions file parameters inside the self.param dictionary. + init_cond_file_dict : dict + A dictionary containing the requested parameters """ @@ -774,16 +856,12 @@ def ascii_file_input_error_msg(codename): self.param["NC_IN"] = init_cond_file_name - if verbose is None: - verbose = self.verbose - if verbose: - if len(update_list) > 0: - init_cond_file_dict = self.get_init_cond_files(update_list) + init_cond_file_dict = self.get_init_cond_files(update_list,verbose) - return + return init_cond_file_dict - def get_init_cond_files(self, arg_list: str | List[str] | None = None): + def get_init_cond_files(self, arg_list: str | List[str] | None = None, verbose: bool | None = None): """ Returns a subset of the parameter dictionary containing the current initial condition file parameters @@ -795,6 +873,8 @@ def get_init_cond_files(self, arg_list: str | List[str] | None = None): A single string or list of strings containing the names of the simulation time parameters to extract. Default is all of: ["init_cond_file_type", "init_cond_file_name", "init_cond_format"] + verbose: bool, optional + If passed, it will override the Simulation object's verbose flag Returns ------- @@ -840,7 +920,10 @@ def get_init_cond_files(self, arg_list: str | List[str] | None = None): valid_arg, init_cond_file_dict = self._get_valid_arg_list(valid_arg, valid_var) - if self.verbose: + if verbose is None: + verbose = self.verbose + + if verbose: for arg in valid_arg: key = valid_var[arg] print(f"{arg:<32} {init_cond_file_dict[key]}") @@ -857,7 +940,7 @@ def set_output_files(self, **kwargs: Any ): """ - Sets the output file parameters in the parameters dictionary. + Sets the output file parameters in the parameter dictionary. Parameters ---------- @@ -881,7 +964,8 @@ def set_output_files(self, Returns ------- - Sets the appropriate initial conditions file parameters inside the self.param dictionary. + output_file_dict : dict + A dictionary containing the requested parameters """ update_list = [] @@ -936,16 +1020,12 @@ def set_output_files(self, else: self.param["OUT_STAT"] = "REPLACE" - if verbose is None: - verbose = self.verbose - if verbose: - if len(update_list) > 0: - output_file_dict = self.get_output_files(update_list) + output_file_dict = self.get_output_files(update_list, verbose=verbose) - return + return output_file_dict - def get_output_files(self, arg_list: str | List[str] | None = None): + def get_output_files(self, arg_list: str | List[str] | None = None, verbose: bool | None = None): """ Returns a subset of the parameter dictionary containing the current output file parameters @@ -957,6 +1037,8 @@ def get_output_files(self, arg_list: str | List[str] | None = None): A single string or list of strings containing the names of the simulation time parameters to extract. Default is all of: ["output_file_type", "output_file_name", "output_format"] + verbose: bool, optional + If passed, it will override the Simulation object's verbose flag Returns ------- @@ -972,7 +1054,10 @@ def get_output_files(self, arg_list: str | List[str] | None = None): valid_arg, output_file_dict = self._get_valid_arg_list(arg_list, valid_var) - if self.verbose: + if verbose is None: + verbose = self.verbose + + if verbose: for arg in valid_arg: key = valid_var[arg] print(f"{arg:<32} {output_file_dict[key]}") @@ -990,7 +1075,7 @@ def set_unit_system(self, MU_name: str | None = None, DU_name: str | None = None, TU_name: str | None = None, - recompute_values: bool = True, + recompute_unit_values: bool = True, verbose: bool | None = None, **kwargs: Any): """ @@ -1043,7 +1128,7 @@ def set_unit_system(self, TU_name : str, optional The name of the time unit. When setting one of the standard units via `TU` a name will be automatically set for the unit, so this argument will override the automatic name. - recompute_values : bool, default True + recompute_unit_values : bool, default True Recompute all values into the new unit system. >*Note:* This is a destructive operation, however if not executed then the values contained in the parameter > file and input/output data files computed previously may not be consistent with the new unit conversion @@ -1056,8 +1141,8 @@ def set_unit_system(self, Returns ---------- - Sets the values of MU2KG, DU2M, and TU2S in the param dictionary to the appropriate units. Also computes the - gravitational constant, self.GU and recomput + unit_dict : dict + A dictionary containing the requested unit conversion parameters """ MU2KG_old = None @@ -1149,18 +1234,14 @@ def set_unit_system(self, self.VU_name = f"{self.DU_name}/{self.TU_name}" self.GU = constants.GC * self.param['TU2S']**2 * self.param['MU2KG'] / self.param['DU2M']**3 - if recompute_values: + if recompute_unit_values: self.update_param_units(MU2KG_old, DU2M_old, TU2S_old) - if verbose is None: - verbose = self.verbose - - if verbose: - unit_dict = self.get_unit_system(update_list) + unit_dict = self.get_unit_system(update_list, verbose) - return + return unit_dict - def get_unit_system(self, arg_list: str | List[str] | None = None): + def get_unit_system(self, arg_list: str | List[str] | None = None, verbose: bool | None = None): """ Returns a subset of the parameter dictionary containing the current simulation unit system. @@ -1175,8 +1256,8 @@ def get_unit_system(self, arg_list: str | List[str] | None = None): Returns ------- - time_dict : dict - A dictionary containing the requested parameters + unit_dict : dict + A dictionary containing the requested unit conversion parameters """ @@ -1212,7 +1293,10 @@ def get_unit_system(self, arg_list: str | List[str] | None = None): valid_arg, unit_dict = self._get_valid_arg_list(arg_list, valid_var) - if self.verbose: + if verbose is None: + verbose = self.verbose + + if verbose: for arg in valid_arg: key = valid_var[arg] print(f"{arg}: {units1[arg]:<28} {unit_dict[key]} {units2[arg]}") @@ -1268,6 +1352,7 @@ def update_param_units(self,MU2KG_old,DU2M_old,TU2S_old): def set_distance_range(self, rmin: float | None = None, rmax: float | None = None, + verbose: bool | None = None, **kwargs: Any): """ Sets the minimum and maximum distances of the simulation. @@ -1284,9 +1369,12 @@ def set_distance_range(self, Returns ------- - Sets the appropriate param dictionary values. + range_dict : dict + A dictionary containing the requested parameters. """ + + update_list = [] CHK_QMIN_RANGE = self.param.pop('CHK_QMIN_RANGE',None) if CHK_QMIN_RANGE is None: CHK_QMIN_RANGE = [-1, -1] @@ -1296,58 +1384,21 @@ def set_distance_range(self, self.param['CHK_QMIN'] = rmin self.param['CHK_RMIN'] = rmin CHK_QMIN_RANGE[0] = rmin + update_list.append("rmin") if rmax is not None: self.param['CHK_RMAX'] = rmax self.param['CHK_EJECT'] = rmax CHK_QMIN_RANGE[1] = rmax + update_list.append("rmax") self.param['CHK_QMIN_RANGE'] =f"{CHK_QMIN_RANGE[0]} {CHK_QMIN_RANGE[1]}" - return - - def _get_valid_arg_list(self, arg_list: str | List[str] | None = None, valid_var: Dict | None = None): - """ - Internal function for getters that extracts subset of arguments that is contained in the dictionary of valid - argument/parameter variable pairs. - - Parameters - ---------- - arg_list : str | List[str], optional - A single string or list of strings containing the Simulation argument. If none are supplied, - then it will create the arg_list out of all keys in the valid_var dictionary. - valid_var : valid_var: Dict - A dictionary where the key is the argument name and the value is the equivalent key in the Simulation - parameter dictionary (i.e. the left-hand column of a param.in file) - - Returns - ------- - valid_arg : [str] - The list of valid arguments that match the keys in valid_var - param : dict - A dictionary that is the subset of the Simulation parameter dictionary corresponding to the arguments listed - in arg_list. - - """ - - if arg_list is None: - valid_arg = None - else: - valid_arg = arg_list.copy() + range_dict = self.get_distance_range(update_list,verbose=verbose) - if valid_arg is None: - valid_arg = list(valid_var.keys()) - elif type(arg_list) is str: - valid_arg = [arg_list] - else: - # Only allow arg_lists to be checked if they are valid. Otherwise ignore. - valid_arg = [k for k in arg_list if k in list(valid_var.keys())] + return range_dict - # Extract the arg_list dictionary - param = {valid_var[arg]:self.param[valid_var[arg]] for arg in valid_arg if valid_var[arg] in self.param} - return valid_arg, param - - def get_distance_range(self, arg_list: str | List[str] | None = None): + def get_distance_range(self, arg_list: str | List[str] | None = None, verbose: bool | None = None): """ Returns a subset of the parameter dictionary containing the current values of the distance range parameters. @@ -1388,7 +1439,10 @@ def get_distance_range(self, arg_list: str | List[str] | None = None): valid_arg, range_dict = self._get_valid_arg_list(arg_list, valid_var) - if self.verbose: + if verbose is None: + verbose = self.verbose + + if verbose: if "rmin" in valid_arg: key = valid_var["rmin"] print(f"{'rmin':<32} {range_dict[key]} {units['rmin']}") From 69807af2579d53f7c90fa806d38230acc95c2a82 Mon Sep 17 00:00:00 2001 From: David Minton Date: Wed, 9 Nov 2022 19:52:47 -0500 Subject: [PATCH 029/569] Wrote consolidated get_parameters and set_parameters methods. --- python/swiftest/swiftest/simulation_class.py | 68 ++++++++++++++++---- 1 file changed, 54 insertions(+), 14 deletions(-) diff --git a/python/swiftest/swiftest/simulation_class.py b/python/swiftest/swiftest/simulation_class.py index 80e1527ec..b7f948d2d 100644 --- a/python/swiftest/swiftest/simulation_class.py +++ b/python/swiftest/swiftest/simulation_class.py @@ -279,7 +279,6 @@ def __init__(self, verbose = False) - if read_old_output_file: binpath = os.path.join(self.sim_dir,self.param['BIN_OUT']) if os.path.exists(binpath): @@ -448,7 +447,7 @@ def set_simulation_time(self, return time_dict - def get_simulation_time(self, arg_list: str | List[str] | None = None, verbose: bool | None = None): + def get_simulation_time(self, arg_list: str | List[str] | None = None, verbose: bool | None = None, **kwargs): """ Returns a subset of the parameter dictionary containing the current simulation time parameters. @@ -462,6 +461,10 @@ def get_simulation_time(self, arg_list: str | List[str] | None = None, verbose: ["t0", "tstart", "tstop", "dt", "istep_out", "tstep_out", "istep_dump"] verbose: bool, optional If passed, it will override the Simulation object's verbose flag + **kwargs + A dictionary of additional keyword argument. This allows this method to be called by the more general + get_parameters method, which takes all possible Simulation parameters as arguments, so these are ignored. + Returns ------- @@ -522,13 +525,33 @@ def set_parameters(self, **kwargs): param : A dictionary of all Simulation parameters that changed """ - self.set_unit_system(**kwargs) - self.set_distance_range(**kwargs) - self.set_feature(**kwargs) - self.set_init_cond_files(**kwargs) - self.set_output_files(**kwargs) - self.set_simulation_time(**kwargs) + param_dict = self.set_unit_system(**kwargs) + param_dict.update(self.set_distance_range(**kwargs)) + param_dict.update(self.set_feature(**kwargs)) + param_dict.update(self.set_init_cond_files(**kwargs)) + param_dict.update(self.set_output_files(**kwargs)) + param_dict.update(self.set_simulation_time(**kwargs)) + + def get_parameters(self, **kwargs): + """ + Setter for all possible parameters. Calls each of the specialized setters using keyword arguments + Parameters + ---------- + **kwargs : [TODO: write this documentation] + + Returns + ------- + param : A dictionary of all Simulation parameters requested + + """ + param_dict = self.get_simulation_time(**kwargs) + param_dict.update(self.get_init_cond_files(**kwargs)) + param_dict.update(self.get_output_files(**kwargs)) + param_dict.update(self.get_distance_range(**kwargs)) + param_dict.update(self.get_unit_system(**kwargs)) + param_dict.update(self.get_feature(**kwargs)) + return param_dict def set_feature(self, close_encounter_check: bool | None = None, @@ -681,7 +704,7 @@ def set_feature(self, return feature_dict - def get_feature(self, arg_list: str | List[str] | None = None, verbose: bool | None = None): + def get_feature(self, arg_list: str | List[str] | None = None, verbose: bool | None = None, **kwargs: Any): """ Returns a subset of the parameter dictionary containing the current value of the feature boolean values. @@ -694,6 +717,9 @@ def get_feature(self, arg_list: str | List[str] | None = None, verbose: bool | N ["close_encounter_check", "general_relativity", "fragmentation", "rotation", "compute_conservation_values"] verbose: bool, optional If passed, it will override the Simulation object's verbose flag + **kwargs + A dictionary of additional keyword argument. This allows this method to be called by the more general + get_parameters method, which takes all possible Simulation parameters as arguments, so these are ignored. Returns ------- @@ -712,7 +738,7 @@ def get_feature(self, arg_list: str | List[str] | None = None, verbose: bool | N "rhill_present": "RHILL_PRESENT", "restart" : "RESTART", "interaction_loops" : "INTERACTION_LOOPS", - "encounter_check_loops" : "ENCOUNTER_CHECK_LOOPS" + "encounter_check_loops" : "ENCOUNTER_CHECK" } valid_arg, feature_dict = self._get_valid_arg_list(arg_list, valid_var) @@ -861,7 +887,7 @@ def ascii_file_input_error_msg(codename): return init_cond_file_dict - def get_init_cond_files(self, arg_list: str | List[str] | None = None, verbose: bool | None = None): + def get_init_cond_files(self, arg_list: str | List[str] | None = None, verbose: bool | None = None, **kwargs): """ Returns a subset of the parameter dictionary containing the current initial condition file parameters @@ -875,6 +901,10 @@ def get_init_cond_files(self, arg_list: str | List[str] | None = None, verbose: ["init_cond_file_type", "init_cond_file_name", "init_cond_format"] verbose: bool, optional If passed, it will override the Simulation object's verbose flag + **kwargs + A dictionary of additional keyword argument. This allows this method to be called by the more general + get_parameters method, which takes all possible Simulation parameters as arguments, so these are ignored. + Returns ------- @@ -1025,7 +1055,7 @@ def set_output_files(self, return output_file_dict - def get_output_files(self, arg_list: str | List[str] | None = None, verbose: bool | None = None): + def get_output_files(self, arg_list: str | List[str] | None = None, verbose: bool | None = None, **kwargs): """ Returns a subset of the parameter dictionary containing the current output file parameters @@ -1039,6 +1069,10 @@ def get_output_files(self, arg_list: str | List[str] | None = None, verbose: boo ["output_file_type", "output_file_name", "output_format"] verbose: bool, optional If passed, it will override the Simulation object's verbose flag + **kwargs + A dictionary of additional keyword argument. This allows this method to be called by the more general + get_parameters method, which takes all possible Simulation parameters as arguments, so these are ignored. + Returns ------- @@ -1241,7 +1275,7 @@ def set_unit_system(self, return unit_dict - def get_unit_system(self, arg_list: str | List[str] | None = None, verbose: bool | None = None): + def get_unit_system(self, arg_list: str | List[str] | None = None, verbose: bool | None = None, **kwargs): """ Returns a subset of the parameter dictionary containing the current simulation unit system. @@ -1253,6 +1287,9 @@ def get_unit_system(self, arg_list: str | List[str] | None = None, verbose: bool A single string or list of strings containing the names of the simulation unit system Default is all of: ["MU", "DU", "TU"] + **kwargs + A dictionary of additional keyword argument. This allows this method to be called by the more general + get_parameters method, which takes all possible Simulation parameters as arguments, so these are ignored. Returns ------- @@ -1398,7 +1435,7 @@ def set_distance_range(self, return range_dict - def get_distance_range(self, arg_list: str | List[str] | None = None, verbose: bool | None = None): + def get_distance_range(self, arg_list: str | List[str] | None = None, verbose: bool | None = None, **kwargs: Any): """ Returns a subset of the parameter dictionary containing the current values of the distance range parameters. @@ -1409,6 +1446,9 @@ def get_distance_range(self, arg_list: str | List[str] | None = None, verbose: b arg_list: str | List[str], optional A single string or list of strings containing the names of the features to extract. Default is all of: ["rmin", "rmax"] + **kwargs + A dictionary of additional keyword argument. This allows this method to be called by the more general + get_parameters method, which takes all possible Simulation parameters as arguments, so these are ignored. Returns ------- From 1cc9745477c9dd3b0d86931cf83c5656d4cb88a9 Mon Sep 17 00:00:00 2001 From: David Minton Date: Wed, 9 Nov 2022 19:55:07 -0500 Subject: [PATCH 030/569] return dictionary from set_parameter. Renamed from parameters -> parameter in getter and setter --- python/swiftest/swiftest/simulation_class.py | 32 +++++++++++--------- 1 file changed, 17 insertions(+), 15 deletions(-) diff --git a/python/swiftest/swiftest/simulation_class.py b/python/swiftest/swiftest/simulation_class.py index b7f948d2d..7b043e8ca 100644 --- a/python/swiftest/swiftest/simulation_class.py +++ b/python/swiftest/swiftest/simulation_class.py @@ -249,7 +249,7 @@ def __init__(self, else: print(f"{param_file} not found.") - self.set_parameters(t0=t0, + self.set_parameter(t0=t0, tstart=tstart, tstop=tstop, dt=dt, @@ -364,7 +364,7 @@ def set_simulation_time(self, If passed, it will override the Simulation object's verbose flag **kwargs A dictionary of additional keyword argument. This allows this method to be called by the more general - set_parameters method, which takes all possible Simulation parameters as arguments, so these are ignored. + set_parameter method, which takes all possible Simulation parameters as arguments, so these are ignored. Returns ------- @@ -463,7 +463,7 @@ def get_simulation_time(self, arg_list: str | List[str] | None = None, verbose: If passed, it will override the Simulation object's verbose flag **kwargs A dictionary of additional keyword argument. This allows this method to be called by the more general - get_parameters method, which takes all possible Simulation parameters as arguments, so these are ignored. + get_parameter method, which takes all possible Simulation parameters as arguments, so these are ignored. Returns @@ -513,7 +513,7 @@ def get_simulation_time(self, arg_list: str | List[str] | None = None, verbose: return time_dict - def set_parameters(self, **kwargs): + def set_parameter(self, **kwargs): """ Setter for all possible parameters. Calls each of the specialized setters using keyword arguments Parameters @@ -532,7 +532,9 @@ def set_parameters(self, **kwargs): param_dict.update(self.set_output_files(**kwargs)) param_dict.update(self.set_simulation_time(**kwargs)) - def get_parameters(self, **kwargs): + return param_dict + + def get_parameter(self, **kwargs): """ Setter for all possible parameters. Calls each of the specialized setters using keyword arguments Parameters @@ -631,7 +633,7 @@ def set_feature(self, If passed, it will override the Simulation object's verbose flag **kwargs A dictionary of additional keyword argument. This allows this method to be called by the more general - set_parameters method, which takes all possible Simulation parameters as arguments, so these are ignored. + set_parameter method, which takes all possible Simulation parameters as arguments, so these are ignored. Returns ------- @@ -719,7 +721,7 @@ def get_feature(self, arg_list: str | List[str] | None = None, verbose: bool | N If passed, it will override the Simulation object's verbose flag **kwargs A dictionary of additional keyword argument. This allows this method to be called by the more general - get_parameters method, which takes all possible Simulation parameters as arguments, so these are ignored. + get_parameter method, which takes all possible Simulation parameters as arguments, so these are ignored. Returns ------- @@ -791,7 +793,7 @@ def set_init_cond_files(self, If passed, it will override the Simulation object's verbose flag **kwargs A dictionary of additional keyword argument. This allows this method to be called by the more general - set_parameters method, which takes all possible Simulation parameters as arguments, so these are ignored. + set_parameter method, which takes all possible Simulation parameters as arguments, so these are ignored. Returns ------- @@ -903,7 +905,7 @@ def get_init_cond_files(self, arg_list: str | List[str] | None = None, verbose: If passed, it will override the Simulation object's verbose flag **kwargs A dictionary of additional keyword argument. This allows this method to be called by the more general - get_parameters method, which takes all possible Simulation parameters as arguments, so these are ignored. + get_parameter method, which takes all possible Simulation parameters as arguments, so these are ignored. Returns @@ -990,7 +992,7 @@ def set_output_files(self, If passed, it will override the Simulation object's verbose flag **kwargs A dictionary of additional keyword argument. This allows this method to be called by the more general - set_parameters method, which takes all possible Simulation parameters as arguments, so these are ignored. + set_parameter method, which takes all possible Simulation parameters as arguments, so these are ignored. Returns ------- @@ -1071,7 +1073,7 @@ def get_output_files(self, arg_list: str | List[str] | None = None, verbose: boo If passed, it will override the Simulation object's verbose flag **kwargs A dictionary of additional keyword argument. This allows this method to be called by the more general - get_parameters method, which takes all possible Simulation parameters as arguments, so these are ignored. + get_parameter method, which takes all possible Simulation parameters as arguments, so these are ignored. Returns @@ -1171,7 +1173,7 @@ def set_unit_system(self, If passed, it will override the Simulation object's verbose flag **kwargs A dictionary of additional keyword argument. This allows this method to be called by the more general - set_parameters method, which takes all possible Simulation parameters as arguments, so these are ignored. + set_parameter method, which takes all possible Simulation parameters as arguments, so these are ignored. Returns ---------- @@ -1289,7 +1291,7 @@ def get_unit_system(self, arg_list: str | List[str] | None = None, verbose: bool ["MU", "DU", "TU"] **kwargs A dictionary of additional keyword argument. This allows this method to be called by the more general - get_parameters method, which takes all possible Simulation parameters as arguments, so these are ignored. + get_parameter method, which takes all possible Simulation parameters as arguments, so these are ignored. Returns ------- @@ -1402,7 +1404,7 @@ def set_distance_range(self, Maximum distance of the simulation (CHK_RMAX, CHK_QMIN_RANGE[1]) **kwargs A dictionary of additional keyword argument. This allows this method to be called by the more general - set_parameters method, which takes all possible Simulation parameters as arguments, so these are ignored. + set_parameter method, which takes all possible Simulation parameters as arguments, so these are ignored. Returns ------- @@ -1448,7 +1450,7 @@ def get_distance_range(self, arg_list: str | List[str] | None = None, verbose: b ["rmin", "rmax"] **kwargs A dictionary of additional keyword argument. This allows this method to be called by the more general - get_parameters method, which takes all possible Simulation parameters as arguments, so these are ignored. + get_parameter method, which takes all possible Simulation parameters as arguments, so these are ignored. Returns ------- From a8a2423c5372655ad4301277f333db8509a92dd8 Mon Sep 17 00:00:00 2001 From: David Minton Date: Thu, 10 Nov 2022 11:31:58 -0500 Subject: [PATCH 031/569] Started the process of restructuring the methods for adding bodies. It's partially done, so none of the methods work quite yet. I also added a new method for setting an "ephemeris_date" instance variable that is used when pulling bodies down from JPL Horizons. --- python/swiftest/swiftest/init_cond.py | 4 +- python/swiftest/swiftest/simulation_class.py | 518 ++++++++++++------- 2 files changed, 333 insertions(+), 189 deletions(-) diff --git a/python/swiftest/swiftest/init_cond.py b/python/swiftest/swiftest/init_cond.py index bf2720a3c..641fa2b68 100644 --- a/python/swiftest/swiftest/init_cond.py +++ b/python/swiftest/swiftest/init_cond.py @@ -18,7 +18,7 @@ from datetime import date import xarray as xr -def solar_system_horizons(plname, idval, param, ephemerides_start_date, ds): +def solar_system_horizons(plname, idval, param, ephemerides_start_date): """ Initializes a Swiftest dataset containing the major planets of the Solar System at a particular data from JPL/Horizons @@ -28,8 +28,6 @@ def solar_system_horizons(plname, idval, param, ephemerides_start_date, ds): Swiftest paramuration parameters. This method uses the unit conversion factors to convert from JPL's AU-day system into the system specified in the param file ephemerides_start_date : string Date to use when obtaining the ephemerides in the format YYYY-MM-DD. - ds : xarray Dataset - Dataset to append Returns ------- diff --git a/python/swiftest/swiftest/simulation_class.py b/python/swiftest/swiftest/simulation_class.py index f3c786af1..0d26ebdf0 100644 --- a/python/swiftest/swiftest/simulation_class.py +++ b/python/swiftest/swiftest/simulation_class.py @@ -14,7 +14,7 @@ from swiftest import init_cond from swiftest import tool from swiftest import constants -from datetime import date +import datetime import xarray as xr import numpy as np import os @@ -26,13 +26,15 @@ Any ) + class Simulation: """ This is a class that defines the basic Swift/Swifter/Swiftest simulation object """ + def __init__(self, codename: Literal["Swiftest", "Swifter", "Swift"] = "Swiftest", - param_file: os.PathLike | str ="param.in", + param_file: os.PathLike | str = "param.in", read_param: bool = False, t0: float = 0.0, tstart: float = 0.0, @@ -44,9 +46,10 @@ def __init__(self, init_cond_file_type: Literal["NETCDF_DOUBLE", "NETCDF_FLOAT", "ASCII"] = "NETCDF_DOUBLE", init_cond_file_name: str | os.PathLike | Dict[str, str] | Dict[str, os.PathLike] | None = None, init_cond_format: Literal["EL", "XV"] = "EL", - output_file_type: Literal["NETCDF_DOUBLE","NETCDF_FLOAT","REAL4","REAL8","XDR4","XDR8"] = "NETCDF_DOUBLE", + output_file_type: Literal[ + "NETCDF_DOUBLE", "NETCDF_FLOAT", "REAL4", "REAL8", "XDR4", "XDR8"] = "NETCDF_DOUBLE", output_file_name: os.PathLike | str | None = None, - output_format: Literal["XV","XVEL"] = "XVEL", + output_format: Literal["XV", "XVEL"] = "XVEL", read_old_output_file: bool = False, MU: str = "MSUN", DU: str = "AU", @@ -68,10 +71,11 @@ def __init__(self, big_discard: bool = False, rhill_present: bool = False, restart: bool = False, - interaction_loops: Literal["TRIANGULAR","FLAT","ADAPTIVE"] = "TRIANGULAR", - encounter_check_loops: Literal["TRIANGULAR","SORTSWEEP","ADAPTIVE"] = "TRIANGULAR", + interaction_loops: Literal["TRIANGULAR", "FLAT", "ADAPTIVE"] = "TRIANGULAR", + encounter_check_loops: Literal["TRIANGULAR", "SORTSWEEP", "ADAPTIVE"] = "TRIANGULAR", + ephemeris_date: str = "MBCL", verbose: bool = True - ): + ): """ Parameters @@ -229,6 +233,7 @@ def __init__(self, If set to True, then more information is printed by Simulation methods as they are executed. Setting to False suppresses most messages other than errors. """ + self.ds = xr.Dataset() self.param = { '! VERSION': f"Swiftest parameter input", @@ -240,6 +245,8 @@ def __init__(self, self.verbose = verbose self.restart = restart + # Width of the column in the printed name of the parameter in parameter getters + self._getter_column_width = '32' # If the parameter file is in a different location than the current working directory, we will need # to use it to properly open bin files self.sim_dir = os.path.dirname(os.path.realpath(param_file)) @@ -250,37 +257,37 @@ def __init__(self, print(f"{param_file} not found.") self.set_parameter(t0=t0, - tstart=tstart, - tstop=tstop, - dt=dt, - tstep_out=tstep_out, - istep_out=istep_out, - istep_dump=istep_dump, - rmin=rmin, rmax=rmax, - MU=MU, DU=DU, TU=TU, - MU2KG=MU2KG, DU2M=DU2M, TU2S=TU2S, - MU_name=MU_name, DU_name=DU_name, TU_name=TU_name, - recompute_unit_values=False, - init_cond_file_type=init_cond_file_type, - init_cond_file_name=init_cond_file_name, - init_cond_format=init_cond_format, - output_file_type=output_file_type, - output_file_name=output_file_name, - output_format=output_format, - close_encounter_check=close_encounter_check, - general_relativity=general_relativity, - fragmentation=fragmentation, - rotation=rotation, - compute_conservation_values=compute_conservation_values, - extra_force=extra_force, - big_discard=big_discard, - rhill_present=rhill_present, - restart=restart, - verbose = False) - + tstart=tstart, + tstop=tstop, + dt=dt, + tstep_out=tstep_out, + istep_out=istep_out, + istep_dump=istep_dump, + rmin=rmin, rmax=rmax, + MU=MU, DU=DU, TU=TU, + MU2KG=MU2KG, DU2M=DU2M, TU2S=TU2S, + MU_name=MU_name, DU_name=DU_name, TU_name=TU_name, + recompute_unit_values=False, + init_cond_file_type=init_cond_file_type, + init_cond_file_name=init_cond_file_name, + init_cond_format=init_cond_format, + output_file_type=output_file_type, + output_file_name=output_file_name, + output_format=output_format, + close_encounter_check=close_encounter_check, + general_relativity=general_relativity, + fragmentation=fragmentation, + rotation=rotation, + compute_conservation_values=compute_conservation_values, + extra_force=extra_force, + big_discard=big_discard, + rhill_present=rhill_present, + restart=restart, + ephemeris_date=ephemeris_date, + verbose=False) if read_old_output_file: - binpath = os.path.join(self.sim_dir,self.param['BIN_OUT']) + binpath = os.path.join(self.sim_dir, self.param['BIN_OUT']) if os.path.exists(binpath): self.bin2xr() else: @@ -334,10 +341,10 @@ def set_simulation_time(self, tstart: float | None = None, tstop: float | None = None, dt: float | None = None, - istep_out : int | None = None, - tstep_out : float | None = None, - istep_dump : int | None = None, - verbose : bool | None = None, + istep_out: int | None = None, + tstep_out: float | None = None, + istep_dump: int | None = None, + verbose: bool | None = None, **kwargs: Any ): """ @@ -375,7 +382,6 @@ def set_simulation_time(self, update_list = [] - if t0 is None: t0 = self.param.pop("T0", None) if t0 is None: @@ -414,7 +420,7 @@ def set_simulation_time(self, if dt is not None and tstop is not None: if dt > (tstop - tstart): print("Error! dt must be smaller than tstop-tstart") - print(f"Setting dt = {tstop-tstart} instead of {dt}") + print(f"Setting dt = {tstop - tstart} instead of {dt}") dt = tstop - tstart if dt is not None: @@ -435,7 +441,7 @@ def set_simulation_time(self, update_list.append("istep_out") if istep_dump is None: - istep_dump = self.param.pop("ISTEP_DUMP",None) + istep_dump = self.param.pop("ISTEP_DUMP", None) if istep_dump is None: istep_dump = istep_out @@ -443,7 +449,7 @@ def set_simulation_time(self, self.param['ISTEP_DUMP'] = istep_dump update_list.append("istep_dump") - time_dict = self.get_simulation_time(update_list,verbose=verbose) + time_dict = self.get_simulation_time(update_list, verbose=verbose) return time_dict @@ -481,13 +487,13 @@ def get_simulation_time(self, arg_list: str | List[str] | None = None, verbose: "istep_dump": "ISTEP_DUMP", } - units = {"t0" : self.TU_name, - "tstart" : self.TU_name, - "tstop" : self.TU_name, - "dt" : self.TU_name, - "tstep_out" : self.TU_name, - "istep_out" : "", - "istep_dump" : ""} + units = {"t0": self.TU_name, + "tstart": self.TU_name, + "tstop": self.TU_name, + "dt": self.TU_name, + "tstep_out": self.TU_name, + "istep_out": "", + "istep_dump": ""} tstep_out = None if arg_list is None or "tstep_out" in arg_list or "istep_out" in arg_list: @@ -505,11 +511,11 @@ def get_simulation_time(self, arg_list: str | List[str] | None = None, verbose: for arg in valid_arg: key = valid_var[arg] if key in time_dict: - print(f"{arg:<32} {time_dict[key]} {units[arg]}") + print(f"{arg:<{self._getter_column_width}} {time_dict[key]} {units[arg]}") else: - print(f"{arg:<32} NOT SET") + print(f"{arg:<{self._getter_column_width}} NOT SET") if tstep_out is not None: - print(f"{'tstep_out':<32} {tstep_out} {units['tstep_out']}") + print(f"{'tstep_out':<{self._getter_column_width}} {tstep_out} {units['tstep_out']}") return time_dict @@ -525,6 +531,8 @@ def set_parameter(self, **kwargs): param : A dictionary of all Simulation parameters that changed """ + + # Setters returning parameter dictionary values param_dict = self.set_unit_system(**kwargs) param_dict.update(self.set_distance_range(**kwargs)) param_dict.update(self.set_feature(**kwargs)) @@ -532,6 +540,9 @@ def set_parameter(self, **kwargs): param_dict.update(self.set_output_files(**kwargs)) param_dict.update(self.set_simulation_time(**kwargs)) + # Non-returning setters + self.set_ephemeris_date(**kwargs) + return param_dict def get_parameter(self, **kwargs): @@ -546,6 +557,8 @@ def get_parameter(self, **kwargs): param : A dictionary of all Simulation parameters requested """ + + # Getters returning parameter dictionary values param_dict = self.get_simulation_time(**kwargs) param_dict.update(self.get_init_cond_files(**kwargs)) param_dict.update(self.get_output_files(**kwargs)) @@ -553,6 +566,10 @@ def get_parameter(self, **kwargs): param_dict.update(self.get_unit_system(**kwargs)) param_dict.update(self.get_feature(**kwargs)) + # Non-returning getters + if not bool(kwargs) or "ephemeris_date" in kwargs: + self.get_ephemeris_date(**kwargs) + return param_dict def set_feature(self, @@ -560,7 +577,7 @@ def set_feature(self, general_relativity: bool | None = None, fragmentation: bool | None = None, rotation: bool | None = None, - compute_conservation_values: bool | None=None, + compute_conservation_values: bool | None = None, extra_force: bool | None = None, big_discard: bool | None = None, rhill_present: bool | None = None, @@ -570,7 +587,7 @@ def set_feature(self, encounter_check_loops: Literal["TRIANGULAR", "SORTSWEEP", "ADAPTIVE"] | None = None, verbose: bool | None = None, **kwargs: Any - ): + ): """ Turns on or off various features of a simulation. @@ -683,7 +700,7 @@ def set_feature(self, update_list.append("restart") if interaction_loops is not None: - valid_vals = ["TRIANGULAR","FLAT","ADAPTIVE"] + valid_vals = ["TRIANGULAR", "FLAT", "ADAPTIVE"] if interaction_loops not in valid_vals: print(f"{interaction_loops} is not a valid option for interaction loops.") print(f"Must be one of {valid_vals}") @@ -705,7 +722,6 @@ def set_feature(self, feature_dict = self.get_feature(update_list, verbose) return feature_dict - def get_feature(self, arg_list: str | List[str] | None = None, verbose: bool | None = None, **kwargs: Any): """ @@ -738,9 +754,9 @@ def get_feature(self, arg_list: str | List[str] | None = None, verbose: bool | N "extra_force": "EXTRA_FORCE", "big_discard": "BIG_DISCARD", "rhill_present": "RHILL_PRESENT", - "restart" : "RESTART", - "interaction_loops" : "INTERACTION_LOOPS", - "encounter_check_loops" : "ENCOUNTER_CHECK" + "restart": "RESTART", + "interaction_loops": "INTERACTION_LOOPS", + "encounter_check_loops": "ENCOUNTER_CHECK" } valid_arg, feature_dict = self._get_valid_arg_list(arg_list, valid_var) @@ -751,13 +767,14 @@ def get_feature(self, arg_list: str | List[str] | None = None, verbose: bool | N if verbose: for arg in valid_arg: key = valid_var[arg] - print(f"{arg:<32} {feature_dict[key]}") + print(f"{arg:<{self._getter_column_width}} {feature_dict[key]}") return feature_dict def set_init_cond_files(self, init_cond_file_type: Literal["NETCDF_DOUBLE", "NETCDF_FLOAT", "ASCII"] | None = None, - init_cond_file_name: str | os.PathLike | Dict[str, str] | Dict[str, os.PathLike] | None = None, + init_cond_file_name: str | os.PathLike | Dict[str, str] | Dict[ + str, os.PathLike] | None = None, init_cond_format: Literal["EL", "XV"] | None = None, verbose: bool | None = None, **kwargs: Any @@ -838,13 +855,12 @@ def ascii_file_input_error_msg(codename): init_cond_keys = ["PL", "TP"] if init_cond_file_type != "ASCII": print(f"{init_cond_file_type} is not supported by {self.codename}. Using ASCII instead") - init_cond_file_type="ASCII" + init_cond_file_type = "ASCII" if init_cond_format != "XV": print(f"{init_cond_format} is not supported by {self.codename}. Using XV instead") init_cond_format = "XV" - - valid_formats={"EL", "XV"} + valid_formats = {"EL", "XV"} if init_cond_format not in valid_formats: print(f"{init_cond_format} is not a valid input format") else: @@ -883,12 +899,10 @@ def ascii_file_input_error_msg(codename): else: self.param["NC_IN"] = init_cond_file_name - - init_cond_file_dict = self.get_init_cond_files(update_list,verbose) + init_cond_file_dict = self.get_init_cond_files(update_list, verbose) return init_cond_file_dict - def get_init_cond_files(self, arg_list: str | List[str] | None = None, verbose: bool | None = None, **kwargs): """ @@ -917,10 +931,10 @@ def get_init_cond_files(self, arg_list: str | List[str] | None = None, verbose: valid_var = {"init_cond_file_type": "IN_TYPE", "init_cond_format": "IN_FORM", - "init_cond_file_name" : "NC_IN", - "init_cond_file_name['CB']" : "CB_IN", - "init_cond_file_name['PL']" : "PL_IN", - "init_cond_file_name['TP']" : "TP_IN", + "init_cond_file_name": "NC_IN", + "init_cond_file_name['CB']": "CB_IN", + "init_cond_file_name['PL']": "PL_IN", + "init_cond_file_name['TP']": "TP_IN", } three_file_args = ["init_cond_file_name['CB']", @@ -958,14 +972,13 @@ def get_init_cond_files(self, arg_list: str | List[str] | None = None, verbose: if verbose: for arg in valid_arg: key = valid_var[arg] - print(f"{arg:<32} {init_cond_file_dict[key]}") + print(f"{arg:<{self._getter_column_width}} {init_cond_file_dict[key]}") return init_cond_file_dict - - def set_output_files(self, - output_file_type: Literal[ "NETCDF_DOUBLE", "NETCDF_FLOAT", "REAL4", "REAL8", "XDR4", "XDR8"] | None = None, + output_file_type: Literal[ + "NETCDF_DOUBLE", "NETCDF_FLOAT", "REAL4", "REAL8", "XDR4", "XDR8"] | None = None, output_file_name: os.PathLike | str | None = None, output_format: Literal["XV", "XVEL"] | None = None, verbose: bool | None = None, @@ -1021,7 +1034,7 @@ def set_output_files(self, output_file_type = self.param.pop("OUT_TYPE", None) if output_file_type is None: output_file_type = "REAL8" - elif output_file_type not in ["REAL4","REAL8","XDR4","XDR8"]: + elif output_file_type not in ["REAL4", "REAL8", "XDR4", "XDR8"]: print(f"{output_file_type} is not compatible with Swifter. Setting to REAL8") output_file_type = "REAL8" elif self.codename == "Swift": @@ -1056,7 +1069,6 @@ def set_output_files(self, return output_file_dict - def get_output_files(self, arg_list: str | List[str] | None = None, verbose: bool | None = None, **kwargs): """ @@ -1096,11 +1108,10 @@ def get_output_files(self, arg_list: str | List[str] | None = None, verbose: boo if verbose: for arg in valid_arg: key = valid_var[arg] - print(f"{arg:<32} {output_file_dict[key]}") + print(f"{arg:<{self._getter_column_width}} {output_file_dict[key]}") return output_file_dict - def set_unit_system(self, MU: str | None = None, DU: str | None = None, @@ -1194,7 +1205,7 @@ def set_unit_system(self, update_list.append("TU") if MU2KG is not None or MU is not None: - MU2KG_old = self.param.pop('MU2KG',None) + MU2KG_old = self.param.pop('MU2KG', None) if MU2KG is not None: self.param['MU2KG'] = MU2KG self.MU_name = None @@ -1217,7 +1228,7 @@ def set_unit_system(self, self.MU_name = "MSun" if DU2M is not None or DU is not None: - DU2M_old = self.param.pop('DU2M',None) + DU2M_old = self.param.pop('DU2M', None) if DU2M is not None: self.param['DU2M'] = DU2M self.DU_name = None @@ -1240,7 +1251,7 @@ def set_unit_system(self, self.DU_name = "AU" if TU2S is not None or TU is not None: - TU2S_old = self.param.pop('TU2S',None) + TU2S_old = self.param.pop('TU2S', None) if TU2S is not None: self.param['TU2S'] = TU2S self.TU_name = None @@ -1259,7 +1270,6 @@ def set_unit_system(self, self.param['TU2S'] = constants.YR2S self.TU_name = "y" - if MU_name is not None: self.MU_name = MU_name if DU_name is not None: @@ -1268,7 +1278,7 @@ def set_unit_system(self, self.TU_name = TU_name self.VU_name = f"{self.DU_name}/{self.TU_name}" - self.GU = constants.GC * self.param['TU2S']**2 * self.param['MU2KG'] / self.param['DU2M']**3 + self.GU = constants.GC * self.param['TU2S'] ** 2 * self.param['MU2KG'] / self.param['DU2M'] ** 3 if recompute_unit_values: self.update_param_units(MU2KG_old, DU2M_old, TU2S_old) @@ -1301,10 +1311,10 @@ def get_unit_system(self, arg_list: str | List[str] | None = None, verbose: bool """ valid_var = { - "MU": "MU2KG", - "DU": "DU2M", - "TU": "TU2S", - } + "MU": "MU2KG", + "DU": "DU2M", + "TU": "TU2S", + } if self.MU_name is None: MU_name = "mass unit" @@ -1320,15 +1330,15 @@ def get_unit_system(self, arg_list: str | List[str] | None = None, verbose: bool TU_name = self.TU_name units1 = { - "MU" : MU_name, - "DU" : DU_name, - "TU" : TU_name - } + "MU": MU_name, + "DU": DU_name, + "TU": TU_name + } units2 = { - "MU" : f"kg / {MU_name}", - "DU" : f"m / {DU_name}", - "TU" : f"s / {TU_name}" - } + "MU": f"kg / {MU_name}", + "DU": f"m / {DU_name}", + "TU": f"s / {TU_name}" + } valid_arg, unit_dict = self._get_valid_arg_list(arg_list, valid_var) @@ -1338,11 +1348,12 @@ def get_unit_system(self, arg_list: str | List[str] | None = None, verbose: bool if verbose: for arg in valid_arg: key = valid_var[arg] - print(f"{arg}: {units1[arg]:<28} {unit_dict[key]} {units2[arg]}") + col_width = str(int(self._getter_column_width) - 4) + print(f"{arg}: {units1[arg]:<{col_width}} {unit_dict[key]} {units2[arg]}") return unit_dict - def update_param_units(self,MU2KG_old,DU2M_old,TU2S_old): + def update_param_units(self, MU2KG_old, DU2M_old, TU2S_old): """ Updates the values of parameters that have units when the units have changed. @@ -1359,8 +1370,8 @@ def update_param_units(self,MU2KG_old,DU2M_old,TU2S_old): """ mass_keys = ['GMTINY', 'MIN_GMFRAG'] - distance_keys = ['CHK_QMIN','CHK_RMIN','CHK_RMAX', 'CHK_EJECT'] - time_keys = ['T0','TSTOP','DT'] + distance_keys = ['CHK_QMIN', 'CHK_RMIN', 'CHK_RMAX', 'CHK_EJECT'] + time_keys = ['T0', 'TSTOP', 'DT'] if MU2KG_old is not None: for k in mass_keys: @@ -1383,11 +1394,10 @@ def update_param_units(self,MU2KG_old,DU2M_old,TU2S_old): if TU2S_old is not None: for k in time_keys: if k in self.param: - self.param[k] *= TU2S_old / self.param['TU2S'] + self.param[k] *= TU2S_old / self.param['TU2S'] return - def set_distance_range(self, rmin: float | None = None, rmax: float | None = None, @@ -1414,7 +1424,7 @@ def set_distance_range(self, """ update_list = [] - CHK_QMIN_RANGE = self.param.pop('CHK_QMIN_RANGE',None) + CHK_QMIN_RANGE = self.param.pop('CHK_QMIN_RANGE', None) if CHK_QMIN_RANGE is None: CHK_QMIN_RANGE = [-1, -1] else: @@ -1430,13 +1440,12 @@ def set_distance_range(self, CHK_QMIN_RANGE[1] = rmax update_list.append("rmax") - self.param['CHK_QMIN_RANGE'] =f"{CHK_QMIN_RANGE[0]} {CHK_QMIN_RANGE[1]}" + self.param['CHK_QMIN_RANGE'] = f"{CHK_QMIN_RANGE[0]} {CHK_QMIN_RANGE[1]}" - range_dict = self.get_distance_range(update_list,verbose=verbose) + range_dict = self.get_distance_range(update_list, verbose=verbose) return range_dict - def get_distance_range(self, arg_list: str | List[str] | None = None, verbose: bool | None = None, **kwargs: Any): """ @@ -1448,6 +1457,8 @@ def get_distance_range(self, arg_list: str | List[str] | None = None, verbose: b arg_list: str | List[str], optional A single string or list of strings containing the names of the features to extract. Default is all of: ["rmin", "rmax"] + verbose: bool, optional + If passed, it will override the Simulation object's verbose flag **kwargs A dictionary of additional keyword argument. This allows this method to be called by the more general get_parameter method, which takes all possible Simulation parameters as arguments, so these are ignored. @@ -1462,13 +1473,13 @@ def get_distance_range(self, arg_list: str | List[str] | None = None, verbose: b valid_var = {"rmin": "CHK_RMIN", "rmax": "CHK_RMAX", "qmin": "CHK_QMIN", - "qminR" : "CHK_QMIN_RANGE" + "qminR": "CHK_QMIN_RANGE" } - units = {"rmin" : self.DU_name, - "rmax" : self.DU_name, - "qmin" : self.DU_name, - "qminR" : self.DU_name, + units = {"rmin": self.DU_name, + "rmax": self.DU_name, + "qmin": self.DU_name, + "qminR": self.DU_name, } if type(arg_list) is str: @@ -1487,66 +1498,203 @@ def get_distance_range(self, arg_list: str | List[str] | None = None, verbose: b if verbose: if "rmin" in valid_arg: key = valid_var["rmin"] - print(f"{'rmin':<32} {range_dict[key]} {units['rmin']}") + print(f"{'rmin':<{self._getter_column_width}} {range_dict[key]} {units['rmin']}") if "rmax" in valid_arg: key = valid_var["rmax"] - print(f"{'rmax':<32} {range_dict[key]} {units['rmax']}") + print(f"{'rmax':<{self._getter_column_width}} {range_dict[key]} {units['rmax']}") return range_dict - - def add(self, plname, date=date.today().isoformat(), idval=None): + def add_solar_system_body(self, + name: str | List[str] | None = None, + id: int | List[int] | None = None, + date: str | None = None, + origin_type: str = "initial_conditions", + source: str = "HORIZONS"): """ - Adds a solar system body to an existing simulation DataSet. + Adds a solar system body to an existing simulation Dataset from the JPL Horizons ephemeris service. Parameters ---------- - plname : string - Name of planet to add (e.g. "Mercury", "Venus", "Earth", "Mars", "Jupiter", "Saturn", "Uranus", "Neptune" - date : string - Date to use when obtaining the ephemerides in the format YYYY-MM-DD. Defaults to "today" + name : str | List[str], optional + Add solar system body by name. + Currently bodies from the following list will result in fully-massive bodies (they include mass, radius, + and rotation parameters). "Sun" (added as a central body), "Mercury", "Venus", "Earth", "Mars", + "Jupiter", "Saturn", "Uranus", "Neptune", "Pluto" + + Bodies not on this list will be added as test particles, but additional properties can be added later if + desired. + id : int | List[int], optional + Add solar system body by id number. + date : str, optional + ISO-formatted date sto use when obtaining the ephemerides in the format YYYY-MM-DD. Defaults to value + set by `set_ephemeris_date`. + origin_type : str, default "initial_conditions" + The string that will be added to the `origin_type` variable for all bodies added to the list + source : str, default "Horizons" + The source of the ephemerides. + >*Note.* Currently only the JPL Horizons ephemeris is implemented, so this is ignored. Returns ------- - self.ds : xarray dataset + ds : Xarray dataset with body or bodies added. """ - #self.ds = init_cond.solar_system_horizons(plname, idval, self.param, date, self.ds) - self.addp(*init_cond.solar_system_horizons(plname, idval, self.param, date, self.ds)) + + if self.ephemeris_date is None: + self.set_ephemeris_date() + + if date is None: + date = self.ephemeris_date + try: + datetime.datetime.fromisoformat(date) + except: + print(f"{date} is not a valid date format. Must be 'YYYY-MM-DD'. Setting to {self.ephemeris_date}") + date = self.ephemeris_date + + if source.upper() != "HORIZONS": + print("Currently only the JPL Horizons ephemeris service is supported") + + if id is not None and name is not None: + print("Warning! Requesting both id and name could lead to duplicate bodies.") + dsnew = [] + if name is not None: + if type(name) is str: + name = [name] + + if origin_type is None: + origin_type = ['initial_conditions'] * len(name) + + for n in name: + dsnew.append(self.addp(*init_cond.solar_system_horizons(n, self.param, date))) + + + if id is not None: + if type(id) is str: + id = [id] + + if origin_type is None: + origin_type = ['initial_conditions'] * len(id) + + for i in id: + dsnew.append(self.addp(*init_cond.solar_system_horizons(i, self.param, date))) + + return - - - def addp(self, idvals, namevals, v1, v2, v3, v4, v5, v6, GMpl=None, Rpl=None, rhill=None, Ip1=None, Ip2=None, Ip3=None, rotx=None, roty=None, rotz=None, J2=None,J4=None,t=None): + + + def set_ephemeris_date(self, + ephemeris_date: str | None = None, + verbose: bool | None = None, + **kwargs: Any): + """ + + Parameters + ---------- + ephemeris_date : str, optional + Date to use when obtaining the ephemerides. + Valid options are "today", "MBCL", or date in the format YYYY-MM-DD. + verbose: bool, optional + If passed, it will override the Simulation object's verbose flag + **kwargs + A dictionary of additional keyword argument. This allows this method to be called by the more general + set_parameter method, which takes all possible Simulation parameters as arguments, so these are ignored. + + Returns + ------- + Sets the `ephemeris_date` instance variable. + + """ + + if ephemeris_date is None: + return + + + # The default value is Prof. Minton's Brimley/Cocoon line crossing date (aka MBCL) + minton_bday = datetime.date.fromisoformat('1976-08-05') + brimley_cocoon_line = datetime.timedelta(days=18530) + minton_bcl = (minton_bday + brimley_cocoon_line).isoformat() + + if ephemeris_date is None or ephemeris_date.upper() == "MBCL": + ephemeris_date = minton_bcl + elif ephemeris_date.upper() == "TODAY": + ephemeris_date = datetime.date.today().isoformat() + else: + try: + datetime.datetime.fromisoformat(ephemeris_date) + except: + valid_date_args = ['"MBCL"', '"TODAY"', '"YYYY-MM-DD"'] + print(f"{ephemeris_date} is not a valid format. Valid options include:", ', '.join(valid_date_args)) + print("Using MBCL for date.") + ephemeris_date = minton_bcl + + self.ephemeris_date = ephemeris_date + + ephemeris_date = self.get_ephemeris_date(verbose=verbose) + + return ephemeris_date + + def get_ephemeris_date(self, verbose: bool | None = None, **kwargs: Any): + """ + + Prints the current value of the ephemeris date + + Parameters + ---------- + verbose: bool, optional + If passed, it will override the Simulation object's verbose flag + **kwargs + A dictionary of additional keyword argument. This allows this method to be called by the more general + get_parameter method, which takes all possible Simulation parameters as arguments, so these are ignored. + + Returns + ------- + ephemeris_date: str + The ISO-formatted date string for the ephemeris computation + + """ + if self.ephemeris_date is None: + print(f"ephemeris_date is not set") + return + + if verbose is None: + verbose = self.verbose + if verbose: + print(f"{'ephemeris_date':<{self._getter_column_width}} {self.ephemeris_date}") + + return self.ephemeris_date + + def add_body(self, namevals, v1, v2, v3, v4, v5, v6, GMpl=None, Rpl=None, rhill=None, Ip1=None, Ip2=None, + Ip3=None, rotx=None, roty=None, rotz=None, J2=None, J4=None, t=None): """ Adds a body (test particle or massive body) to the internal DataSet given a set up 6 vectors (orbital elements or cartesian state vectors, depending on the value of self.param). Input all angles in degress Parameters ---------- - idvals : integer - Array of body index values. - v1 : float - xh for param['IN_FORM'] == "XV"; a for param['IN_FORM'] == "EL" - v2 : float - yh for param['IN_FORM'] == "XV"; e for param['IN_FORM'] == "EL" - v3 : float - zh for param['IN_FORM'] == "XV"; inc for param['IN_FORM'] == "EL" - v4 : float - vhxh for param['IN_FORM'] == "XV"; capom for param['IN_FORM'] == "EL" - v5 : float - vhyh for param['IN_FORM'] == "XV"; omega for param['IN_FORM'] == "EL" - v6 : float - vhzh for param['IN_FORM'] == "XV"; capm for param['IN_FORM'] == "EL" - Gmass : float - Optional: Array of G*mass values if these are massive bodies - radius : float - Optional: Array radius values if these are massive bodies - rhill : float - Optional: Array rhill values if these are massive bodies - Ip1,y,z : float - Optional: Principal axes moments of inertia - rotx,y,z: float - Optional: Rotation rate vector components - t : float - Optional: Time at start of simulation + v1 : float + xh for param['IN_FORM'] == "XV"; a for param['IN_FORM'] == "EL" + v2 : float + yh for param['IN_FORM'] == "XV"; e for param['IN_FORM'] == "EL" + v3 : float + zh for param['IN_FORM'] == "XV"; inc for param['IN_FORM'] == "EL" + v4 : float + vhxh for param['IN_FORM'] == "XV"; capom for param['IN_FORM'] == "EL" + v5 : float + vhyh for param['IN_FORM'] == "XV"; omega for param['IN_FORM'] == "EL" + v6 : float + vhzh for param['IN_FORM'] == "XV"; capm for param['IN_FORM'] == "EL" + Gmass : float + Optional: Array of G*mass values if these are massive bodies + radius : float + Optional: Array radius values if these are massive bodies + rhill : float + Optional: Array rhill values if these are massive bodies + Ip1,y,z : float + Optional: Principal axes moments of inertia + rotx,y,z: float + Optional: Rotation rate vector components + t : float + Optional: Time at start of simulation + Returns ------- self.ds : xarray dataset @@ -1554,20 +1702,20 @@ def addp(self, idvals, namevals, v1, v2, v3, v4, v5, v6, GMpl=None, Rpl=None, rh if t is None: t = self.param['T0'] - dsnew = init_cond.vec2xr(self.param, idvals, namevals, v1, v2, v3, v4, v5, v6, GMpl, Rpl, rhill, Ip1, Ip2, Ip3, rotx, roty, rotz, J2, J4, t) + dsnew = init_cond.vec2xr(self.param, idvals, namevals, v1, v2, v3, v4, v5, v6, GMpl, Rpl, rhill, Ip1, Ip2, Ip3, + rotx, roty, rotz, J2, J4, t) if dsnew is not None: self.ds = xr.combine_by_coords([self.ds, dsnew]) self.ds['ntp'] = self.ds['id'].where(np.isnan(self.ds['Gmass'])).count(dim="id") self.ds['npl'] = self.ds['id'].where(np.invert(np.isnan(self.ds['Gmass']))).count(dim="id") - 1 if self.param['OUT_TYPE'] == "NETCDF_DOUBLE": - self.ds = io.fix_types(self.ds,ftype=np.float64) + self.ds = io.fix_types(self.ds, ftype=np.float64) elif self.param['OUT_TYPE'] == "NETCDF_FLOAT": - self.ds = io.fix_types(self.ds,ftype=np.float32) + self.ds = io.fix_types(self.ds, ftype=np.float32) return - - + def read_param(self, param_file, codename="Swiftest", verbose=True): """ Reads in a param.in file and determines whether it is a Swift/Swifter/Swiftest parameter file. @@ -1596,8 +1744,7 @@ def read_param(self, param_file, codename="Swiftest", verbose=True): print(f'{codename} is not a recognized code name. Valid options are "Swiftest", "Swifter", or "Swift".') self.codename = "Unknown" return - - + def write_param(self, param_file, param=None): """ Writes to a param.in file and determines whether the output format needs to be converted between Swift/Swifter/Swiftest. @@ -1618,18 +1765,19 @@ def write_param(self, param_file, param=None): if param['IN_TYPE'] == "ASCII": param.pop("NC_IN", None) else: - param.pop("CB_IN",None) - param.pop("PL_IN",None) - param.pop("TP_IN",None) + param.pop("CB_IN", None) + param.pop("PL_IN", None) + param.pop("TP_IN", None) io.write_labeled_param(param, param_file) elif codename == "Swift": io.write_swift_param(param, param_file) else: - print('Cannot process unknown code type. Call the read_param method with a valid code name. Valid options are "Swiftest", "Swifter", or "Swift".') + print( + 'Cannot process unknown code type. Call the read_param method with a valid code name. Valid options are "Swiftest", "Swifter", or "Swift".') return - - - def convert(self, param_file, newcodename="Swiftest", plname="pl.swiftest.in", tpname="tp.swiftest.in", cbname="cb.swiftest.in", conversion_questions={}): + + def convert(self, param_file, newcodename="Swiftest", plname="pl.swiftest.in", tpname="tp.swiftest.in", + cbname="cb.swiftest.in", conversion_questions={}): """ Converts simulation input files from one format to another (Swift, Swifter, or Swiftest). @@ -1675,14 +1823,13 @@ def convert(self, param_file, newcodename="Swiftest", plname="pl.swiftest.in", t goodconversion = False else: goodconversion = False - + if goodconversion: self.write_param(param_file) else: print(f"Conversion from {self.codename} to {newcodename} is not supported.") return oldparam - - + def bin2xr(self): """ Converts simulation output files from a flat binary file to a xarray dataset. @@ -1699,7 +1846,7 @@ 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.dir_path,self.param['BIN_OUT']) + param_tmp['BIN_OUT'] = os.path.join(self.dir_path, self.param['BIN_OUT']) if self.codename == "Swiftest": self.ds = io.swiftest2xr(param_tmp, verbose=self.verbose) if self.verbose: print('Swiftest simulation data stored as xarray DataSet .ds') @@ -1709,10 +1856,10 @@ def bin2xr(self): elif self.codename == "Swift": print("Reading Swift simulation data is not implemented yet") else: - print('Cannot process unknown code type. Call the read_param method with a valid code name. Valid options are "Swiftest", "Swifter", or "Swift".') + print( + 'Cannot process unknown code type. Call the read_param method with a valid code name. Valid options are "Swiftest", "Swifter", or "Swift".') return - - + def follow(self, codestyle="Swifter"): """ An implementation of the Swift tool_follow algorithm. Under development. Currently only for Swift simulations. @@ -1731,10 +1878,10 @@ def follow(self, codestyle="Swifter"): if codestyle == "Swift": try: with open('follow.in', 'r') as f: - line = f.readline() # Parameter file (ignored because bin2xr already takes care of it - line = f.readline() # PL file (ignored) - line = f.readline() # TP file (ignored) - line = f.readline() # ifol + line = f.readline() # Parameter file (ignored because bin2xr already takes care of it + line = f.readline() # PL file (ignored) + line = f.readline() # TP file (ignored) + line = f.readline() # ifol i_list = [i for i in line.split(" ") if i.strip()] ifol = int(i_list[0]) line = f.readline() # nskp @@ -1747,11 +1894,10 @@ def follow(self, codestyle="Swifter"): fol = tool.follow_swift(self.ds, ifol=ifol, nskp=nskp) else: fol = None - + if self.verbose: print('follow.out written') return fol - - + def save(self, param_file, framenum=-1, codename="Swiftest"): """ Saves an xarray dataset to a set of input files. @@ -1785,7 +1931,8 @@ def save(self, param_file, framenum=-1, codename="Swiftest"): return - def initial_conditions_from_bin(self, framenum=-1, new_param=None, new_param_file="param.new.in", new_initial_conditions_file="bin_in.nc", restart=False, codename="Swiftest"): + def initial_conditions_from_bin(self, framenum=-1, new_param=None, new_param_file="param.new.in", + new_initial_conditions_file="bin_in.nc", restart=False, codename="Swiftest"): """ Generates a set of input files from a old output file. @@ -1809,7 +1956,6 @@ def initial_conditions_from_bin(self, framenum=-1, new_param=None, new_param_fil frame : NetCDF dataset """ - if codename != "Swiftest": self.save(new_param_file, framenum, codename) return @@ -1830,7 +1976,7 @@ def initial_conditions_from_bin(self, framenum=-1, new_param=None, new_param_fil if self.param['BIN_OUT'] != new_param['BIN_OUT'] and restart: print(f"Restart run with new output file. Copying {self.param['BIN_OUT']} to {new_param['BIN_OUT']}") - shutil.copy2(self.param['BIN_OUT'],new_param['BIN_OUT']) + shutil.copy2(self.param['BIN_OUT'], new_param['BIN_OUT']) new_param['IN_FORM'] = 'XV' if restart: @@ -1842,7 +1988,7 @@ def initial_conditions_from_bin(self, framenum=-1, new_param=None, new_param_fil new_param.pop('TP_IN', None) new_param.pop('CB_IN', None) print(f"Extracting data from dataset at time frame number {framenum} and saving it to {new_param['NC_IN']}") - frame = io.swiftest_xr2infile(self.ds, self.param, infile_name=new_param['NC_IN'],framenum=framenum) + frame = io.swiftest_xr2infile(self.ds, self.param, infile_name=new_param['NC_IN'], framenum=framenum) print(f"Saving parameter configuration file to {new_param_file}") self.write_param(new_param_file, param=new_param) From f67fda439cc82797b0d2a105a360482b181b3acf Mon Sep 17 00:00:00 2001 From: Carlisle Wishard Date: Thu, 10 Nov 2022 13:58:07 -0500 Subject: [PATCH 032/569] restructured netcdf_open required variables section --- src/netcdf/netcdf.f90 | 65 ++++--------------------------------------- 1 file changed, 5 insertions(+), 60 deletions(-) diff --git a/src/netcdf/netcdf.f90 b/src/netcdf/netcdf.f90 index e66498c35..f7a0bb0c9 100644 --- a/src/netcdf/netcdf.f90 +++ b/src/netcdf/netcdf.f90 @@ -367,51 +367,16 @@ module subroutine netcdf_open(self, param, readonly) call check( nf90_inquire_dimension(self%ncid, max(self%time_dimid,self%id_dimid)+1, name=str_dim_name), "netcdf_open nf90_inquire_dimension str_dim_name" ) call check( nf90_inq_dimid(self%ncid, str_dim_name, self%str_dimid), "netcdf_open nf90_inq_dimid str_dimid" ) + ! 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, STATUS_VARNAME, self%status_varid), "netcdf_open nf90_inq_varid status_varid" ) call check( nf90_inq_varid(self%ncid, GMASS_VARNAME, self%Gmass_varid), "netcdf_open nf90_inq_varid Gmass_varid" ) - - if ((nf90_inq_varid(self%ncid, NPL_VARNAME, self%npl_varid) /= nf90_noerr) .or. & - (nf90_inq_varid(self%ncid, NTP_VARNAME, self%ntp_varid) /= nf90_noerr) .or. & - ((nf90_inq_varid(self%ncid, NPLM_VARNAME, self%nplm_varid) /= nf90_noerr) .and. (param%integrator == SYMBA))) then - call check( nf90_inquire_dimension(self%ncid, self%id_dimid, len=idmax), "netcdf_open nf90_inquire_dimension id_dimid" ) - allocate(gmtemp(idmax)) - call check( nf90_get_var(self%ncid, self%Gmass_varid, gmtemp, start=[1,1]), "netcdf_open nf90_getvar Gmass_varid" ) - allocate(tpmask(idmax)) - allocate(plmask(idmax)) - allocate(plmmask(idmax)) - plmask(:) = gmtemp(:) == gmtemp(:) - tpmask(:) = .not. plmask(:) - plmask(1) = .false. ! This is the central body - select type (param) - class is (symba_parameters) - plmmask(:) = gmtemp(:) > param%GMTINY .and. plmask(:) - end select - if ((nf90_inq_varid(self%ncid, NPL_VARNAME, self%npl_varid) /= nf90_noerr)) then - call check( nf90_redef(self%ncid), "netcdf_open nf90_redef npl_varid") - call check( nf90_def_var(self%ncid, NPL_VARNAME, NF90_INT, self%time_dimid, self%npl_varid), "netcdf_open nf90_def_var npl_varid" ) - call check( nf90_enddef(self%ncid), "netcdf_open nf90_enddef npl_varid") - call check( nf90_put_var(self%ncid, self%npl_varid, count(plmask(:)), start=[1]), "netcdf_open nf90_put_var npl_varid" ) - call check( nf90_inq_varid(self%ncid, NPL_VARNAME, self%npl_varid), "netcdf_open nf90_inq_varid npl_varid" ) - end if - if (nf90_inq_varid(self%ncid, NTP_VARNAME, self%ntp_varid) /= nf90_noerr) then - call check( nf90_redef(self%ncid), "netcdf_open nf90_redef ntp_varid") - call check( nf90_def_var(self%ncid, NTP_VARNAME, NF90_INT, self%time_dimid, self%ntp_varid), "netcdf_open nf90_def_var ntp_varid" ) - call check( nf90_enddef(self%ncid), "netcdf_open nf90_enddef ntp_varid") - call check( nf90_put_var(self%ncid, self%ntp_varid, count(tpmask(:)), start=[1]), "netcdf_open nf90_put_var ntp_varid" ) - call check( nf90_inq_varid(self%ncid, NTP_VARNAME, self%ntp_varid), "netcdf_open nf90_inq_varid ntp_varid" ) - end if - if ((nf90_inq_varid(self%ncid, NPLM_VARNAME, self%nplm_varid) /= nf90_noerr) .and. (param%integrator == SYMBA)) then - call check( nf90_redef(self%ncid), "netcdf_open nf90_redef nplm_varid") - call check( nf90_def_var(self%ncid, NPLM_VARNAME, NF90_INT, self%time_dimid, self%nplm_varid), "netcdf_open nf90_def_var nplm_varid" ) - call check( nf90_enddef(self%ncid), "netcdf_open nf90_enddef nplm_varid") - call check( nf90_put_var(self%ncid, self%nplm_varid, count(plmmask(:)), start=[1]), "netcdf_open nf90_put_var nplm_varid" ) - call check( nf90_inq_varid(self%ncid, NPLM_VARNAME, self%nplm_varid), "netcdf_open nf90_inq_varid nplm_varid" ) - end if - end if + call check( nf90_inq_varid(self%ncid, J2RP2_VARNAME, self%j2rp2_varid), "netcdf_open nf90_inq_varid j2rp2_varid" ) + call check( nf90_inq_varid(self%ncid, J4RP4_VARNAME, self%j4rp4_varid), "netcdf_open nf90_inq_varid j4rp4_varid" ) 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" ) @@ -450,29 +415,9 @@ module subroutine netcdf_open(self, param, readonly) call check( nf90_inq_varid(self%ncid, CAPM_VARNAME, self%capm_varid), "netcdf_open nf90_inq_varid capm_varid" ) end if - if (param%lrhill_present) call check( nf90_inq_varid(self%ncid, RHILL_VARNAME, self%rhill_varid), "netcdf_open nf90_inq_varid rhill_varid" ) - if (param%lclose) then call check( nf90_inq_varid(self%ncid, RADIUS_VARNAME, self%radius_varid), "netcdf_open nf90_inq_varid radius_varid" ) - call check( nf90_inq_varid(self%ncid, ORIGIN_TYPE_VARNAME, self%origin_type_varid), "netcdf_open nf90_inq_varid origin_type_varid" ) - call check( nf90_inq_varid(self%ncid, ORIGIN_TIME_VARNAME, self%origin_time_varid), "netcdf_open nf90_inq_varid origin_time_varid" ) - call check( nf90_inq_varid(self%ncid, ORIGIN_XHX_VARNAME, self%origin_xhx_varid), "netcdf_open nf90_inq_varid origin_xhx_varid" ) - call check( nf90_inq_varid(self%ncid, ORIGIN_XHY_VARNAME, self%origin_xhy_varid), "netcdf_open nf90_inq_varid origin_xhy_varid" ) - call check( nf90_inq_varid(self%ncid, ORIGIN_XHZ_VARNAME, self%origin_xhz_varid), "netcdf_open nf90_inq_varid origin_xhz_varid" ) - call check( nf90_inq_varid(self%ncid, ORIGIN_VHX_VARNAME, self%origin_vhx_varid), "netcdf_open nf90_inq_varid origin_vhx_varid" ) - call check( nf90_inq_varid(self%ncid, ORIGIN_VHY_VARNAME, self%origin_vhy_varid), "netcdf_open nf90_inq_varid origin_vhy_varid" ) - call check( nf90_inq_varid(self%ncid, ORIGIN_VHZ_VARNAME, self%origin_vhz_varid), "netcdf_open nf90_inq_varid origin_vhz_varid" ) - - call check( nf90_inq_varid(self%ncid, COLLISION_ID_VARNAME, self%collision_id_varid), "netcdf_open nf90_inq_varid collision_id_varid" ) - call check( nf90_inq_varid(self%ncid, DISCARD_TIME_VARNAME, self%discard_time_varid), "netcdf_open nf90_inq_varid discard_time_varid" ) - call check( nf90_inq_varid(self%ncid, DISCARD_XHX_VARNAME, self%discard_xhx_varid), "netcdf_open nf90_inq_varid discard_xhx_varid" ) - call check( nf90_inq_varid(self%ncid, DISCARD_XHY_VARNAME, self%discard_xhy_varid), "netcdf_open nf90_inq_varid discard_xhy_varid" ) - call check( nf90_inq_varid(self%ncid, DISCARD_XHZ_VARNAME, self%discard_xhz_varid), "netcdf_open nf90_inq_varid discard_xhz_varid" ) - call check( nf90_inq_varid(self%ncid, DISCARD_VHX_VARNAME, self%discard_vhx_varid), "netcdf_open nf90_inq_varid discard_vhx_varid" ) - call check( nf90_inq_varid(self%ncid, DISCARD_VHY_VARNAME, self%discard_vhy_varid), "netcdf_open nf90_inq_varid discard_vhy_varid" ) - call check( nf90_inq_varid(self%ncid, DISCARD_VHZ_VARNAME, self%discard_vhz_varid), "netcdf_open nf90_inq_varid discard_vhz_varid" ) - call check( nf90_inq_varid(self%ncid, DISCARD_BODY_ID_VARNAME, self%discard_body_id_varid), "netcdf_open nf90_inq_varid discard_body_id_varid" ) - end if + 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" ) From 71d127b51542b3a7548c8a1d4e9b988c09e759d4 Mon Sep 17 00:00:00 2001 From: Carlisle Wishard Date: Thu, 10 Nov 2022 13:59:02 -0500 Subject: [PATCH 033/569] restructured optional variables in netcdf_open --- src/netcdf/netcdf.f90 | 28 +++++++++++++++------------- 1 file changed, 15 insertions(+), 13 deletions(-) diff --git a/src/netcdf/netcdf.f90 b/src/netcdf/netcdf.f90 index f7a0bb0c9..013feae8c 100644 --- a/src/netcdf/netcdf.f90 +++ b/src/netcdf/netcdf.f90 @@ -433,17 +433,17 @@ module subroutine netcdf_open(self, param, readonly) ! call check( nf90_inq_varid(self%ncid, Q_VARNAME, self%Q_varid), "netcdf_open nf90_inq_varid Q_varid" ) ! end if - if (param%lenergy) then - call check( nf90_inq_varid(self%ncid, KE_ORB_VARNAME, self%KE_orb_varid), "netcdf_open nf90_inq_varid KE_orb_varid" ) - call check( nf90_inq_varid(self%ncid, KE_SPIN_VARNAME, self%KE_spin_varid), "netcdf_open nf90_inq_varid KE_spin_varid" ) - call check( nf90_inq_varid(self%ncid, PE_VARNAME, self%PE_varid), "netcdf_open nf90_inq_varid PE_varid" ) - call check( nf90_inq_varid(self%ncid, L_ORBX_VARNAME, self%L_orbx_varid), "netcdf_open nf90_inq_varid L_orbx_varid" ) - call check( nf90_inq_varid(self%ncid, L_ORBY_VARNAME, self%L_orby_varid), "netcdf_open nf90_inq_varid L_orby_varid" ) - call check( nf90_inq_varid(self%ncid, L_ORBZ_VARNAME, self%L_orbz_varid), "netcdf_open nf90_inq_varid L_orbz_varid" ) - call check( nf90_inq_varid(self%ncid, L_SPINX_VARNAME, self%L_spinx_varid), "netcdf_open nf90_inq_varid L_spinx_varid" ) - call check( nf90_inq_varid(self%ncid, L_SPINY_VARNAME, self%L_spiny_varid), "netcdf_open nf90_inq_varid L_spiny_varid" ) - call check( nf90_inq_varid(self%ncid, L_SPINZ_VARNAME, self%L_spinz_varid), "netcdf_open nf90_inq_varid L_spinz_varid" ) - call check( nf90_inq_varid(self%ncid, L_ESCAPEX_VARNAME, self%L_escapex_varid), "netcdf_open nf90_inq_varid L_escapex_varid" ) + ! Optional Variables + + status = nf90_inq_varid(self%ncid, NPL_VARNAME, self%npl_varid) + if (status /= nf90_noerr) write(*,*) "Warning! NPL variable not set in input file. Calculating." + + status = nf90_inq_varid(self%ncid, NTP_VARNAME, self%ntp_varid) + if (status /= nf90_noerr) write(*,*) "Warning! NTP variable not set in input file. Calculating." + + if (param%integrator == SYMBA) then + status = nf90_inq_varid(self%ncid, NPLM_VARNAME, self%nplm_varid) + if (status /= nf90_noerr) write(*,*) "Warning! NPLM variable not set in input file. Calculating." call check( nf90_inq_varid(self%ncid, L_ESCAPEY_VARNAME, self%L_escapey_varid), "netcdf_open nf90_inq_varid L_escapey_varid" ) call check( nf90_inq_varid(self%ncid, L_ESCAPEZ_VARNAME, self%L_escapez_varid), "netcdf_open nf90_inq_varid L_escapez_varid" ) call check( nf90_inq_varid(self%ncid, ECOLLISIONS_VARNAME, self%Ecollisions_varid), "netcdf_open nf90_inq_varid Ecollisions_varid" ) @@ -451,8 +451,10 @@ module subroutine netcdf_open(self, param, readonly) call check( nf90_inq_varid(self%ncid, GMESCAPE_VARNAME, self%GMescape_varid), "netcdf_open nf90_inq_varid GMescape_varid" ) end if - call check( nf90_inq_varid(self%ncid, J2RP2_VARNAME, self%j2rp2_varid), "netcdf_open nf90_inq_varid j2rp2_varid" ) - call check( nf90_inq_varid(self%ncid, J4RP4_VARNAME, self%j4rp4_varid), "netcdf_open nf90_inq_varid j4rp4_varid" ) + 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 return From d36c9a2b69df8c040469b3cf6c8b7439d7feadef Mon Sep 17 00:00:00 2001 From: Carlisle Wishard Date: Thu, 10 Nov 2022 14:00:12 -0500 Subject: [PATCH 034/569] variables that the user doesn't need no longer kill the run --- src/netcdf/netcdf.f90 | 44 ++++++++++++++++++++++++++++++++++++++----- 1 file changed, 39 insertions(+), 5 deletions(-) diff --git a/src/netcdf/netcdf.f90 b/src/netcdf/netcdf.f90 index 013feae8c..c2d0d6ee2 100644 --- a/src/netcdf/netcdf.f90 +++ b/src/netcdf/netcdf.f90 @@ -444,11 +444,6 @@ module subroutine netcdf_open(self, param, readonly) if (param%integrator == SYMBA) then status = nf90_inq_varid(self%ncid, NPLM_VARNAME, self%nplm_varid) if (status /= nf90_noerr) write(*,*) "Warning! NPLM variable not set in input file. Calculating." - call check( nf90_inq_varid(self%ncid, L_ESCAPEY_VARNAME, self%L_escapey_varid), "netcdf_open nf90_inq_varid L_escapey_varid" ) - call check( nf90_inq_varid(self%ncid, L_ESCAPEZ_VARNAME, self%L_escapez_varid), "netcdf_open nf90_inq_varid L_escapez_varid" ) - call check( nf90_inq_varid(self%ncid, ECOLLISIONS_VARNAME, self%Ecollisions_varid), "netcdf_open nf90_inq_varid Ecollisions_varid" ) - call check( nf90_inq_varid(self%ncid, EUNTRACKED_VARNAME, self%Euntracked_varid), "netcdf_open nf90_inq_varid Euntracked_varid" ) - call check( nf90_inq_varid(self%ncid, GMESCAPE_VARNAME, self%GMescape_varid), "netcdf_open nf90_inq_varid GMescape_varid" ) end if if (param%lrhill_present) then @@ -456,6 +451,45 @@ module subroutine netcdf_open(self, param, readonly) if (status /= nf90_noerr) write(*,*) "Warning! RHILL variable not set in input file. Calculating." end if + ! Variables The User Doesn't Need to Know About + + 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(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 return end subroutine netcdf_open From 58ac545b3ed97185d64c1364c2b7b853612fce82 Mon Sep 17 00:00:00 2001 From: Carlisle Wishard Date: Thu, 10 Nov 2022 14:00:35 -0500 Subject: [PATCH 035/569] deleted unused variables --- src/netcdf/netcdf.f90 | 3 --- 1 file changed, 3 deletions(-) diff --git a/src/netcdf/netcdf.f90 b/src/netcdf/netcdf.f90 index c2d0d6ee2..0a9e7cfd8 100644 --- a/src/netcdf/netcdf.f90 +++ b/src/netcdf/netcdf.f90 @@ -351,9 +351,6 @@ module subroutine netcdf_open(self, param, readonly) ! Internals integer(I4B) :: mode, status character(len=NF90_MAX_NAME) :: str_dim_name - integer(I4B) :: idmax - real(DP), dimension(:), allocatable :: gmtemp - logical, dimension(:), allocatable :: tpmask, plmask, plmmask mode = NF90_WRITE !if (present(readonly)) then From 3ca0ffd274585242cafb3aff937cf2e689043d39 Mon Sep 17 00:00:00 2001 From: Carlisle Wishard Date: Thu, 10 Nov 2022 14:00:58 -0500 Subject: [PATCH 036/569] added NF90_NOWRITE check back in --- src/netcdf/netcdf.f90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/netcdf/netcdf.f90 b/src/netcdf/netcdf.f90 index 0a9e7cfd8..c36408a72 100644 --- a/src/netcdf/netcdf.f90 +++ b/src/netcdf/netcdf.f90 @@ -353,9 +353,9 @@ module subroutine netcdf_open(self, param, readonly) character(len=NF90_MAX_NAME) :: str_dim_name mode = NF90_WRITE - !if (present(readonly)) then - ! if (readonly) mode = NF90_NOWRITE - !end if + if (present(readonly)) then + if (readonly) mode = NF90_NOWRITE + end if call check( nf90_open(param%outfile, mode, self%ncid), "netcdf_open nf90_open" ) From 9f6337c062eebe12fc5ad93a917dbd9bd8775b94 Mon Sep 17 00:00:00 2001 From: Carlisle Wishard Date: Thu, 10 Nov 2022 14:05:29 -0500 Subject: [PATCH 037/569] for variables that have built-in defaults, only get variable from netcdf if provided --- src/netcdf/netcdf.f90 | 45 ++++++++++++++++++++++++++++--------------- 1 file changed, 30 insertions(+), 15 deletions(-) diff --git a/src/netcdf/netcdf.f90 b/src/netcdf/netcdf.f90 index c36408a72..60e17fa0c 100644 --- a/src/netcdf/netcdf.f90 +++ b/src/netcdf/netcdf.f90 @@ -767,21 +767,36 @@ module subroutine netcdf_read_hdr_system(self, iu, param) end select if (param%lenergy) then - call check( nf90_get_var(iu%ncid, iu%KE_orb_varid, self%ke_orbit, start=[tslot]), "netcdf_read_hdr_system nf90_getvar KE_orb_varid" ) - call check( nf90_get_var(iu%ncid, iu%KE_spin_varid, self%ke_spin, start=[tslot]), "netcdf_read_hdr_system nf90_getvar KE_spin_varid" ) - call check( nf90_get_var(iu%ncid, iu%PE_varid, self%pe, start=[tslot]), "netcdf_read_hdr_system nf90_getvar PE_varid" ) - call check( nf90_get_var(iu%ncid, iu%L_orbx_varid, self%Lorbit(1), start=[tslot]), "netcdf_read_hdr_system nf90_getvar L_orbx_varid" ) - call check( nf90_get_var(iu%ncid, iu%L_orby_varid, self%Lorbit(2), start=[tslot]), "netcdf_read_hdr_system nf90_getvar L_orby_varid" ) - call check( nf90_get_var(iu%ncid, iu%L_orbz_varid, self%Lorbit(3), start=[tslot]), "netcdf_read_hdr_system nf90_getvar L_orbz_varid" ) - call check( nf90_get_var(iu%ncid, iu%L_spinx_varid, self%Lspin(1), start=[tslot]), "netcdf_read_hdr_system nf90_getvar L_spinx_varid" ) - call check( nf90_get_var(iu%ncid, iu%L_spiny_varid, self%Lspin(2), start=[tslot]), "netcdf_read_hdr_system nf90_getvar L_spiny_varid" ) - call check( nf90_get_var(iu%ncid, iu%L_spinz_varid, self%Lspin(3), start=[tslot]), "netcdf_read_hdr_system nf90_getvar L_spinz_varid" ) - call check( nf90_get_var(iu%ncid, iu%L_escapex_varid, self%Lescape(1), start=[tslot]), "netcdf_read_hdr_system nf90_getvar L_escapex_varid" ) - call check( nf90_get_var(iu%ncid, iu%L_escapey_varid, self%Lescape(2), start=[tslot]), "netcdf_read_hdr_system nf90_getvar L_escapey_varid" ) - call check( nf90_get_var(iu%ncid, iu%L_escapez_varid, self%Lescape(3), start=[tslot]), "netcdf_read_hdr_system nf90_getvar L_escapez_varid" ) - call check( nf90_get_var(iu%ncid, iu%Ecollisions_varid, self%Ecollisions, start=[tslot]), "netcdf_read_hdr_system nf90_getvar Ecollisions_varid" ) - call check( nf90_get_var(iu%ncid, iu%Euntracked_varid, self%Euntracked, start=[tslot]), "netcdf_read_hdr_system nf90_getvar Euntracked_varid" ) - call check( nf90_get_var(iu%ncid, iu%GMescape_varid, self%GMescape, start=[tslot]), "netcdf_read_hdr_system nf90_getvar GMescape_varid" ) + 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" ) end if return From ecdbcf42498b8eb34a60741890334c700cf3cf48 Mon Sep 17 00:00:00 2001 From: Carlisle Wishard Date: Thu, 10 Nov 2022 14:08:26 -0500 Subject: [PATCH 038/569] only get npl, nplm, ntp if provided in netcdf, otherwise calculate --- src/netcdf/netcdf.f90 | 44 +++++++++++++++++++++++++++++++++++++------ 1 file changed, 38 insertions(+), 6 deletions(-) diff --git a/src/netcdf/netcdf.f90 b/src/netcdf/netcdf.f90 index 60e17fa0c..e31ed0f4f 100644 --- a/src/netcdf/netcdf.f90 +++ b/src/netcdf/netcdf.f90 @@ -757,15 +757,47 @@ module subroutine netcdf_read_hdr_system(self, iu, param) integer(I4B) :: tslot 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, param%t, start=[tslot]), "netcdf_read_hdr_system nf90_getvar time_varid" ) - call check( nf90_get_var(iu%ncid, iu%npl_varid, self%pl%nbody, start=[tslot]), "netcdf_read_hdr_system nf90_getvar npl_varid" ) - call check( nf90_get_var(iu%ncid, iu%ntp_varid, self%tp%nbody, start=[tslot]), "netcdf_read_hdr_system nf90_getvar ntp_varid" ) - select type(pl => self%pl) - class is (symba_pl) - call check( nf90_get_var(iu%ncid, iu%nplm_varid, pl%nplm, start=[tslot]), "netcdf_read_hdr_system nf90_getvar nplm_varid" ) + call check( nf90_get_var(iu%ncid, iu%Gmass_varid, gmtemp, start=[1,1]), "netcdf_read_frame_system nf90_getvar Gmass_varid" ) + allocate(gmtemp(idmax)) + allocate(tpmask(idmax)) + allocate(plmask(idmax)) + allocate(plmmask(idmax)) + plmask(:) = gmtemp(:) == gmtemp(:) + tpmask(:) = .not. plmask(:) + plmask(1) = .false. ! This is the central body + select type (param) + class is (symba_parameters) + plmmask(:) = gmtemp(:) > param%GMTINY .and. plmask(:) end select + status = nf90_inq_varid(iu%ncid, NPL_VARNAME, iu%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" ) + else + self%pl%nbody = count(plmask(:)) + end if + + status = nf90_inq_varid(iu%ncid, NTP_VARNAME, iu%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" ) + else + self%tp%nbody = count(tpmask(:)) + end if + + if (param%integrator == SYMBA) then + status = nf90_inq_varid(iu%ncid, NPLM_VARNAME, iu%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" ) + else + pl%nplm = count(plmmask(:)) + end if + end select + 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" ) From 4ed41f19a566708f4b3cf0d496e3dfe3e89becf5 Mon Sep 17 00:00:00 2001 From: Carlisle Wishard Date: Thu, 10 Nov 2022 14:08:47 -0500 Subject: [PATCH 039/569] add new internal variables --- src/netcdf/netcdf.f90 | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/src/netcdf/netcdf.f90 b/src/netcdf/netcdf.f90 index e31ed0f4f..ceb8d6f7b 100644 --- a/src/netcdf/netcdf.f90 +++ b/src/netcdf/netcdf.f90 @@ -754,7 +754,10 @@ module subroutine netcdf_read_hdr_system(self, iu, param) class(netcdf_parameters), intent(inout) :: iu !! Parameters used to for writing a NetCDF dataset to file class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters ! Internals - integer(I4B) :: tslot + integer(I4B) :: tslot, status, idmax + real(DP), dimension(:), allocatable :: gmtemp + 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" ) From 27f6c00cc737b80c0d20558ac1ca44b3f0cc9e69 Mon Sep 17 00:00:00 2001 From: Carlisle Wishard Date: Thu, 10 Nov 2022 15:39:55 -0500 Subject: [PATCH 040/569] check if all optional variables exist, if they do then get them from the netcdf, if they don't set them equal to the default or some reasonable value --- src/netcdf/netcdf.f90 | 138 ++++++++++++++++++++++++++++++++++++------ 1 file changed, 118 insertions(+), 20 deletions(-) diff --git a/src/netcdf/netcdf.f90 b/src/netcdf/netcdf.f90 index ceb8d6f7b..788f58beb 100644 --- a/src/netcdf/netcdf.f90 +++ b/src/netcdf/netcdf.f90 @@ -850,12 +850,12 @@ module subroutine netcdf_read_particle_info_system(self, iu, param, plmask, tpma logical, dimension(:), intent(in) :: plmask !! Logical array indicating which index values belong to massive bodies logical, dimension(:), intent(in) :: tpmask !! Logical array indicating which index values belong to test particles ! Internals - integer(I4B) :: i, idmax - real(DP), dimension(:), allocatable :: rtemp + integer(I4B) :: i, idmax, status + real(DP), dimension(:), allocatable :: rtemp real(DP), dimension(:,:), allocatable :: rtemp_arr - integer(I4B), dimension(:), allocatable :: itemp + integer(I4B), dimension(:), allocatable :: itemp character(len=NAMELEN), dimension(:), allocatable :: ctemp - integer(I4B), dimension(:), allocatable :: plind, tpind + integer(I4B), dimension(:), allocatable :: plind, tpind ! This string of spaces of length NAMELEN is used to clear out any old data left behind inside the string variables idmax = size(plmask) @@ -918,7 +918,14 @@ module subroutine netcdf_read_particle_info_system(self, iu, param, plmask, tpma end do if (param%lclose) then - call check( nf90_get_var(iu%ncid, iu%origin_type_varid, ctemp, count=[NAMELEN, idmax]), "netcdf_read_particle_info_system nf90_getvar origin_type_varid" ) + + status = nf90_inq_varid(iu%ncid, ORIGIN_TYPE_VARNAME, iu%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" ) + else + ctemp = "Initial Conditions" + end if + call cb%info%set_value(origin_type=ctemp(1)) do i = 1, npl call pl%info(i)%set_value(origin_type=ctemp(plind(i))) @@ -927,7 +934,13 @@ 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 - call check( nf90_get_var(iu%ncid, iu%origin_time_varid, rtemp), "netcdf_read_particle_info_system nf90_getvar origin_time_varid" ) + status = nf90_inq_varid(iu%ncid, ORIGIN_TIME_VARNAME, iu%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" ) + else + rtemp = 0.0_DP + end if + call cb%info%set_value(origin_time=rtemp(1)) do i = 1, npl call pl%info(i)%set_value(origin_time=rtemp(plind(i))) @@ -936,9 +949,28 @@ 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 - call check( nf90_get_var(iu%ncid, iu%origin_xhx_varid, rtemp_arr(1,:)), "netcdf_read_particle_info_system nf90_getvar origin_xhx_varid" ) - call check( nf90_get_var(iu%ncid, iu%origin_xhy_varid, rtemp_arr(2,:)), "netcdf_read_particle_info_system nf90_getvar origin_xhy_varid" ) - call check( nf90_get_var(iu%ncid, iu%origin_xhz_varid, rtemp_arr(3,:)), "netcdf_read_particle_info_system nf90_getvar origin_xhz_varid" ) + + status = nf90_inq_varid(iu%ncid, ORIGIN_XHX_VARNAME, iu%origin_xhx_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" ) + else + call check( nf90_get_var(iu%ncid, iu%xhx_varid, rtemp_arr(1,:)), "netcdf_read_particle_info_system nf90_getvar xhx_varid" ) + 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 + call check( nf90_get_var(iu%ncid, iu%xhy_varid, rtemp_arr(2,:)), "netcdf_read_particle_info_system nf90_getvar xhy_varid" ) + 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 + call check( nf90_get_var(iu%ncid, iu%xhz_varid, rtemp_arr(3,:)), "netcdf_read_particle_info_system nf90_getvar xhz_varid" ) + end if + do i = 1, npl call pl%info(i)%set_value(origin_xh=rtemp_arr(:,plind(i))) end do @@ -946,9 +978,27 @@ module subroutine netcdf_read_particle_info_system(self, iu, param, plmask, tpma call tp%info(i)%set_value(origin_xh=rtemp_arr(:,tpind(i))) end do - call check( nf90_get_var(iu%ncid, iu%origin_vhx_varid, rtemp_arr(1,:)), "netcdf_read_particle_info_system nf90_getvar origin_vhx_varid" ) - call check( nf90_get_var(iu%ncid, iu%origin_vhy_varid, rtemp_arr(2,:)), "netcdf_read_particle_info_system nf90_getvar origin_vhy_varid" ) - call check( nf90_get_var(iu%ncid, iu%origin_vhz_varid, rtemp_arr(3,:)), "netcdf_read_particle_info_system nf90_getvar origin_vhz_varid" ) + status = nf90_inq_varid(iu%ncid, ORIGIN_VHX_VARNAME, iu%origin_vhx_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" ) + else + call check( nf90_get_var(iu%ncid, iu%vhx_varid, rtemp_arr(1,:)), "netcdf_read_particle_info_system nf90_getvar vhx_varid" ) + 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 + call check( nf90_get_var(iu%ncid, iu%vhy_varid, rtemp_arr(2,:)), "netcdf_read_particle_info_system nf90_getvar vhy_varid" ) + 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 + call check( nf90_get_var(iu%ncid, iu%vhz_varid, rtemp_arr(3,:)), "netcdf_read_particle_info_system nf90_getvar vhz_varid" ) + end if + do i = 1, npl call pl%info(i)%set_value(origin_vh=rtemp_arr(:,plind(i))) end do @@ -956,7 +1006,13 @@ module subroutine netcdf_read_particle_info_system(self, iu, param, plmask, tpma call tp%info(i)%set_value(origin_vh=rtemp_arr(:,tpind(i))) end do - call check( nf90_get_var(iu%ncid, iu%collision_id_varid, itemp), "netcdf_read_particle_info_system nf90_getvar collision_id_varid" ) + status = nf90_inq_varid(iu%ncid, COLLISION_ID_VARNAME, iu%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" ) + else + itemp = 0.0_DP + end if + do i = 1, npl call pl%info(i)%set_value(collision_id=itemp(plind(i))) end do @@ -964,7 +1020,13 @@ 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 - call check( nf90_get_var(iu%ncid, iu%discard_time_varid, rtemp), "netcdf_read_particle_info_system nf90_getvar discard_time_varid" ) + status = nf90_inq_varid(iu%ncid, DISCARD_TIME_VARNAME, iu%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" ) + else + rtemp = 0.0_DP + end if + call cb%info%set_value(discard_time=rtemp(1)) do i = 1, npl call pl%info(i)%set_value(discard_time=rtemp(plind(i))) @@ -973,9 +1035,27 @@ 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 - call check( nf90_get_var(iu%ncid, iu%discard_xhx_varid, rtemp_arr(1,:)), "netcdf_read_particle_info_system nf90_getvar discard_xhx_varid" ) - call check( nf90_get_var(iu%ncid, iu%discard_xhy_varid, rtemp_arr(2,:)), "netcdf_read_particle_info_system nf90_getvar discard_xhy_varid" ) - call check( nf90_get_var(iu%ncid, iu%discard_xhz_varid, rtemp_arr(3,:)), "netcdf_read_particle_info_system nf90_getvar discard_xhz_varid" ) + 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) + 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" ) + else + rtemp_arr(3,:) = 0.0_DP + end if + do i = 1, npl call pl%info(i)%set_value(discard_xh=rtemp_arr(:,plind(i))) end do @@ -983,9 +1063,27 @@ module subroutine netcdf_read_particle_info_system(self, iu, param, plmask, tpma call tp%info(i)%set_value(discard_xh=rtemp_arr(:,tpind(i))) end do - call check( nf90_get_var(iu%ncid, iu%discard_vhx_varid, rtemp_arr(1,:)), "netcdf_read_particle_info_system nf90_getvar discard_vhx_varid" ) - call check( nf90_get_var(iu%ncid, iu%discard_vhy_varid, rtemp_arr(2,:)), "netcdf_read_particle_info_system nf90_getvar discard_vhy_varid" ) - call check( nf90_get_var(iu%ncid, iu%discard_vhz_varid, rtemp_arr(3,:)), "netcdf_read_particle_info_system nf90_getvar discard_vhz_varid" ) + status = nf90_inq_varid(iu%ncid, DISCARD_VHX_VARNAME, iu%discard_vhx_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" ) + 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 + end if + do i = 1, npl call pl%info(i)%set_value(discard_vh=rtemp_arr(:,plind(i))) end do From d07c603f832e78237b2680cc865560502f0032d5 Mon Sep 17 00:00:00 2001 From: David Minton Date: Thu, 10 Nov 2022 18:10:06 -0500 Subject: [PATCH 041/569] Made improvements to the solar system and body add methods. Still not quite finished, but getting close. --- python/swiftest/swiftest/init_cond.py | 222 ++++++-------- python/swiftest/swiftest/simulation_class.py | 294 +++++++++++++------ 2 files changed, 306 insertions(+), 210 deletions(-) diff --git a/python/swiftest/swiftest/init_cond.py b/python/swiftest/swiftest/init_cond.py index 641fa2b68..c90f1d59b 100644 --- a/python/swiftest/swiftest/init_cond.py +++ b/python/swiftest/swiftest/init_cond.py @@ -8,17 +8,26 @@ You should have received a copy of the GNU General Public License along with Swiftest. If not, see: https://www.gnu.org/licenses. """ +from __future__ import annotations import swiftest import numpy as np +import numpy.typing as npt from astroquery.jplhorizons import Horizons import astropy.units as u from astropy.coordinates import SkyCoord import datetime -from datetime import date import xarray as xr - -def solar_system_horizons(plname, idval, param, ephemerides_start_date): +from typing import ( + Literal, + Dict, + List, + Any +) +def solar_system_horizons(plname: str, + param: Dict, + ephemerides_start_date: str, + idval: int | None = None): """ Initializes a Swiftest dataset containing the major planets of the Solar System at a particular data from JPL/Horizons @@ -118,10 +127,10 @@ def solar_system_horizons(plname, idval, param, ephemerides_start_date): THIRDLONG = np.longdouble(1.0) / np.longdouble(3.0) # Central body value vectors - GMcb = np.array([swiftest.GMSun * param['TU2S'] ** 2 / param['DU2M'] ** 3]) - Rcb = np.array([swiftest.RSun / param['DU2M']]) - J2RP2 = np.array([swiftest.J2Sun * (swiftest.RSun / param['DU2M']) ** 2]) - J4RP4 = np.array([swiftest.J4Sun * (swiftest.RSun / param['DU2M']) ** 4]) + GMcb = swiftest.GMSun * param['TU2S'] ** 2 / param['DU2M'] ** 3 + Rcb = swiftest.RSun / param['DU2M'] + J2RP2 = swiftest.J2Sun * (swiftest.RSun / param['DU2M']) ** 2 + J4RP4 = swiftest.J4Sun * (swiftest.RSun / param['DU2M']) ** 4 solarpole = SkyCoord(ra=286.13 * u.degree, dec=63.87 * u.degree) solarrot = planetrot['Sun'] * param['TU2S'] @@ -145,12 +154,12 @@ def solar_system_horizons(plname, idval, param, ephemerides_start_date): J2 = J2RP2 J4 = J4RP4 if param['ROTATION']: - Ip1 = [Ipsun[0]] - Ip2 = [Ipsun[1]] - Ip3 = [Ipsun[2]] - rotx = [rotcb.x] - roty = [rotcb.y] - rotz = [rotcb.z] + Ip1 = Ipsun[0] + Ip2 = Ipsun[1] + Ip3 = Ipsun[2] + rotx = rotcb.x.value + roty = rotcb.y.value + rotz = rotcb.z.value else: Ip1 = None Ip2 = None @@ -168,12 +177,6 @@ def solar_system_horizons(plname, idval, param, ephemerides_start_date): ephemerides_end_date = tend.isoformat() ephemerides_step = '1d' - v1 = [] - v2 = [] - v3 = [] - v4 = [] - v5 = [] - v6 = [] J2 = None J4 = None @@ -183,42 +186,33 @@ def solar_system_horizons(plname, idval, param, ephemerides_start_date): 'step': ephemerides_step}) if param['IN_FORM'] == 'XV': - v1.append(pldata[plname].vectors()['x'][0] * DCONV) - v2.append(pldata[plname].vectors()['y'][0] * DCONV) - v3.append(pldata[plname].vectors()['z'][0] * DCONV) - v4.append(pldata[plname].vectors()['vx'][0] * VCONV) - v5.append(pldata[plname].vectors()['vy'][0] * VCONV) - v6.append(pldata[plname].vectors()['vz'][0] * VCONV) + v1 = pldata[plname].vectors()['x'][0] * DCONV + v2 = pldata[plname].vectors()['y'][0] * DCONV + v3 = pldata[plname].vectors()['z'][0] * DCONV + v4 = pldata[plname].vectors()['vx'][0] * VCONV + v5 = pldata[plname].vectors()['vy'][0] * VCONV + v6 = pldata[plname].vectors()['vz'][0] * VCONV elif param['IN_FORM'] == 'EL': - v1.append(pldata[plname].elements()['a'][0] * DCONV) - v2.append(pldata[plname].elements()['e'][0]) - v3.append(pldata[plname].elements()['incl'][0]) - v4.append(pldata[plname].elements()['Omega'][0]) - v5.append(pldata[plname].elements()['w'][0]) - v6.append(pldata[plname].elements()['M'][0]) + v1 = pldata[plname].elements()['a'][0] * DCONV + v2 = pldata[plname].elements()['e'][0] + v3 = pldata[plname].elements()['incl'][0] + v4 = pldata[plname].elements()['Omega'][0] + v5 = pldata[plname].elements()['w'][0] + v6 = pldata[plname].elements()['M'][0] if ispl: - GMpl = [] - GMpl.append(GMcb[0] / MSun_over_Mpl[plname]) + GMpl = GMcb / MSun_over_Mpl[plname] if param['CHK_CLOSE']: - Rpl = [] - Rpl.append(planetradius[plname] * DCONV) + Rpl = planetradius[plname] * DCONV else: Rpl = None # Generate planet value vectors if (param['RHILL_PRESENT']): - rhill = [] - rhill.append(pldata[plname].elements()['a'][0] * DCONV * (3 * MSun_over_Mpl[plname]) ** (-THIRDLONG)) + rhill = pldata[plname].elements()['a'][0] * DCONV * (3 * MSun_over_Mpl[plname]) ** (-THIRDLONG) else: rhill = None if (param['ROTATION']): - Ip1 = [] - Ip2 = [] - Ip3 = [] - rotx = [] - roty = [] - rotz = [] RA = pldata[plname].ephemerides()['NPole_RA'][0] DEC = pldata[plname].ephemerides()['NPole_DEC'][0] @@ -226,12 +220,12 @@ def solar_system_horizons(plname, idval, param, ephemerides_start_date): rotrate = planetrot[plname] * param['TU2S'] rot = rotpole.cartesian * rotrate Ip = np.array([0.0, 0.0, planetIpz[plname]]) - Ip1.append(Ip[0]) - Ip2.append(Ip[1]) - Ip3.append(Ip[2]) - rotx.append(rot.x) - roty.append(rot.y) - rotz.append(rot.z) + Ip1 = Ip[0] + Ip2 = Ip[1] + Ip3 = Ip[2] + rotx = rot.x.value + roty = rot.y.value + rotz = rot.z.value else: Ip1 = None Ip2 = None @@ -243,13 +237,33 @@ def solar_system_horizons(plname, idval, param, ephemerides_start_date): GMpl = None if idval is None: - plid = np.array([planetid[plname]], dtype=int) + plid = planetid[plname] else: - plid = np.array([idval], dtype=int) + plid = idval - return plid,[plname],v1,v2,v3,v4,v5,v6,GMpl,Rpl,rhill,Ip1,Ip2,Ip3,rotx,roty,rotz,J2,J4 + return plname,v1,v2,v3,v4,v5,v6,idval,GMpl,Rpl,rhill,Ip1,Ip2,Ip3,rotx,roty,rotz,J2,J4 -def vec2xr(param, idvals, namevals, v1, v2, v3, v4, v5, v6, GMpl=None, Rpl=None, rhill=None, Ip1=None, Ip2=None, Ip3=None, rotx=None, roty=None, rotz=None, J2=None, J4=None,t=0.0): +def vec2xr(param: Dict, + namevals: npt.NDArray[np.str_], + v1: npt.NDArray[np.float_], + v2: npt.NDArray[np.float_], + v3: npt.NDArray[np.float_], + v4: npt.NDArray[np.float_], + v5: npt.NDArray[np.float_], + v6: npt.NDArray[np.float_], + idvals: npt.NDArray[np.int_], + GMpl: npt.NDArray[np.float_] | None=None, + Rpl: npt.NDArray[np.float_] | None=None, + rhill: npt.NDArray[np.float_] | None=None, + Ip1: npt.NDArray[np.float_] | None=None, + Ip2: npt.NDArray[np.float_] | None=None, + Ip3: npt.NDArray[np.float_] | None=None, + rotx: npt.NDArray[np.float_] | None=None, + roty: npt.NDArray[np.float_] | None=None, + rotz: npt.NDArray[np.float_] | None=None, + J2: npt.NDArray[np.float_] | None=None, + J4: npt.NDArray[np.float_] | None=None, + t: float=0.0): """ Converts and stores the variables of all bodies in an xarray dataset. @@ -297,11 +311,6 @@ def vec2xr(param, idvals, namevals, v1, v2, v3, v4, v5, v6, GMpl=None, Rpl=None, ------- ds : xarray dataset """ - if v1 is None: # This is the central body - iscb = True - else: - iscb = False - if param['ROTATION']: if Ip1 is None: Ip1 = np.full_like(v1, 0.4) @@ -318,11 +327,18 @@ def vec2xr(param, idvals, namevals, v1, v2, v3, v4, v5, v6, GMpl=None, Rpl=None, dims = ['time', 'id', 'vec'] infodims = ['id', 'vec'] - if not iscb and GMpl is not None: + + # The central body is always given id 0 + icb = idvals == 0 + iscb = any(icb) + + if GMpl is not None: ispl = True + ipl = ~np.isnan(GMpl) + itp = np.isnan(GMpl) else: ispl = False - + if ispl and param['CHK_CLOSE'] and Rpl is None: print("Massive bodies need a radius value.") return None @@ -337,83 +353,33 @@ def vec2xr(param, idvals, namevals, v1, v2, v3, v4, v5, v6, GMpl=None, Rpl=None, param['OUT_FORM'] = old_out_form vec_str = np.vstack([namevals]) label_str = ["name"] + particle_type = np.empty_like(namevals) if iscb: label_float = clab.copy() - vec_float = np.vstack([GMpl,Rpl,J2,J4]) + vec_float = np.vstack([GMpl[icb],Rpl[icb],J2[icb],J4[icb]]) + if param['ROTATION']: + vec_float = np.vstack([vec_float, Ip1[icb], Ip2[icb], Ip3[icb], rotx[icb], roty[icb], rotz[icb]]) + particle_type[icb] = "Central Body" + # vec_float = np.vstack([v1, v2, v3, v4, v5, v6]) + if ispl: + label_float = plab.copy() + vec_float = np.vstack([vec_float, GMpl]) + if param['CHK_CLOSE']: + vec_float = np.vstack([vec_float, Rpl]) + if param['RHILL_PRESENT']: + vec_float = np.vstack([vec_float, rhill]) if param['ROTATION']: vec_float = np.vstack([vec_float, Ip1, Ip2, Ip3, rotx, roty, rotz]) - particle_type = "Central Body" + particle_type[ipl] = np.repeat("Massive Body",idvals.size) else: - vec_float = np.vstack([v1, v2, v3, v4, v5, v6]) - if ispl: - label_float = plab.copy() - vec_float = np.vstack([vec_float, GMpl]) - if param['CHK_CLOSE']: - vec_float = np.vstack([vec_float, Rpl]) - if param['RHILL_PRESENT']: - vec_float = np.vstack([vec_float, rhill]) - if param['ROTATION']: - vec_float = np.vstack([vec_float, Ip1, Ip2, Ip3, rotx, roty, rotz]) - particle_type = np.repeat("Massive Body",idvals.size) - else: - label_float = tlab.copy() - particle_type = np.repeat("Test Particle",idvals.size) - origin_type = np.repeat("User Added Body",idvals.size) - origin_time = np.full_like(v1,t) - collision_id = np.full_like(idvals,0) - origin_xhx = v1 - origin_xhy = v2 - origin_xhz = v3 - origin_vhx = v4 - origin_vhy = v5 - origin_vhz = v6 - discard_time = np.full_like(v1,-1.0) - status = np.repeat("ACTIVE",idvals.size) - discard_xhx = np.zeros_like(v1) - discard_xhy = np.zeros_like(v1) - discard_xhz = np.zeros_like(v1) - discard_vhx = np.zeros_like(v1) - discard_vhy = np.zeros_like(v1) - discard_vhz = np.zeros_like(v1) - discard_body_id = np.full_like(idvals,-1) - info_vec_float = np.vstack([ - origin_time, - origin_xhx, - origin_xhy, - origin_xhz, - origin_vhx, - origin_vhy, - origin_vhz, - discard_time, - discard_xhx, - discard_xhy, - discard_xhz, - discard_vhx, - discard_vhy, - discard_vhz]) - info_vec_int = np.vstack([collision_id, discard_body_id]) - info_vec_str = np.vstack([particle_type, origin_type, status]) - frame_float = info_vec_float.T - frame_int = info_vec_int.T - frame_str = info_vec_str.T - if param['IN_TYPE'] == 'NETCDF_FLOAT': - ftype=np.float32 - elif param['IN_TYPE'] == 'NETCDF_DOUBLE' or param['IN_TYPE'] == 'ASCII': - ftype=np.float64 - da_float = xr.DataArray(frame_float, dims=infodims, coords={'id': idvals, 'vec': infolab_float}).astype(ftype) - da_int = xr.DataArray(frame_int, dims=infodims, coords={'id': idvals, 'vec': infolab_int}) - da_str = xr.DataArray(frame_str, dims=infodims, coords={'id': idvals, 'vec': infolab_str}) - ds_float = da_float.to_dataset(dim="vec") - ds_int = da_int.to_dataset(dim="vec") - ds_str = da_str.to_dataset(dim="vec") - info_ds = xr.combine_by_coords([ds_float, ds_int, ds_str]) - + label_float = tlab.copy() + particle_type[itp] = np.repeat("Test Particle",idvals.size) frame_float = np.expand_dims(vec_float.T, axis=0) frame_str = vec_str.T - da_float = xr.DataArray(frame_float, dims=dims, coords={'time': [t], 'id': idvals, 'vec': label_float}).astype(ftype) + da_float = xr.DataArray(frame_float, dims=dims, coords={'time': [t], 'id': idvals, 'vec': label_float}) da_str= xr.DataArray(frame_str, dims=infodims, coords={'id': idvals, 'vec': label_str}) ds_float = da_float.to_dataset(dim="vec") ds_str = da_str.to_dataset(dim="vec") - ds = xr.combine_by_coords([ds_float, ds_str,info_ds]) + ds = xr.combine_by_coords([ds_float, ds_str]) return ds \ No newline at end of file diff --git a/python/swiftest/swiftest/simulation_class.py b/python/swiftest/swiftest/simulation_class.py index 0d26ebdf0..01c3b8414 100644 --- a/python/swiftest/swiftest/simulation_class.py +++ b/python/swiftest/swiftest/simulation_class.py @@ -14,10 +14,11 @@ from swiftest import init_cond from swiftest import tool from swiftest import constants +import os import datetime import xarray as xr import numpy as np -import os +import numpy.typing as npt import shutil from typing import ( Literal, @@ -1506,39 +1507,58 @@ def get_distance_range(self, arg_list: str | List[str] | None = None, verbose: b return range_dict def add_solar_system_body(self, - name: str | List[str] | None = None, - id: int | List[int] | None = None, + name: str | List[str], + ephemeris_id: int | List[int] | None = None, date: str | None = None, - origin_type: str = "initial_conditions", source: str = "HORIZONS"): """ Adds a solar system body to an existing simulation Dataset from the JPL Horizons ephemeris service. - + + The following are name/ephemeris_id pairs that are currently known to Swiftest, and therefore have + physical properties that can be used to make massive bodies. + + Sun : 0 + Mercury : 1 + Venus : 2 + Earth : 3 + Mars : 4 + Jupiter : 5 + Saturn : 6 + Uranus : 7 + Neptune : 8 + Pluto : 9 + Parameters ---------- - name : str | List[str], optional - Add solar system body by name. - Currently bodies from the following list will result in fully-massive bodies (they include mass, radius, - and rotation parameters). "Sun" (added as a central body), "Mercury", "Venus", "Earth", "Mars", - "Jupiter", "Saturn", "Uranus", "Neptune", "Pluto" - - Bodies not on this list will be added as test particles, but additional properties can be added later if - desired. - id : int | List[int], optional - Add solar system body by id number. - date : str, optional - ISO-formatted date sto use when obtaining the ephemerides in the format YYYY-MM-DD. Defaults to value - set by `set_ephemeris_date`. - origin_type : str, default "initial_conditions" - The string that will be added to the `origin_type` variable for all bodies added to the list - source : str, default "Horizons" - The source of the ephemerides. - >*Note.* Currently only the JPL Horizons ephemeris is implemented, so this is ignored. + name : str | List[str] + Add solar system body by name. + Bodies not on this list will be added as test particles, but additional properties can be added later if + desired. + ephemeris_id : int | List[int], optional but must be the same length as `name` if passed. + Use id if the body you wish to add is recognized by Swiftest. In that case, the id is passed to the + ephemeris service and the name is used. The body specified by `id` supercedes that given by `name`. + date : str, optional + ISO-formatted date sto use when obtaining the ephemerides in the format YYYY-MM-DD. Defaults to value + set by `set_ephemeris_date`. + source : str, default "Horizons" + The source of the ephemerides. + >*Note.* Currently only the JPL Horizons ephemeris is implemented, so this is ignored. Returns ------- ds : Xarray dataset with body or bodies added. """ + if type(name) is str: + name = [name] + if ephemeris_id is not None: + if type(ephemeris_id) is int: + ephemeris_id = [ephemeris_id] + if len(ephemeris_id) != len(name): + print(f"Error! The length of ephemeris_id ({len(ephemeris_id)}) does not match the length of name ({len(name)})") + return None + else: + ephemeris_id = [None] * len(name) + if self.ephemeris_date is None: self.set_ephemeris_date() @@ -1553,32 +1573,59 @@ def add_solar_system_body(self, if source.upper() != "HORIZONS": print("Currently only the JPL Horizons ephemeris service is supported") - if id is not None and name is not None: - print("Warning! Requesting both id and name could lead to duplicate bodies.") - dsnew = [] - if name is not None: - if type(name) is str: - name = [name] - - if origin_type is None: - origin_type = ['initial_conditions'] * len(name) - - for n in name: - dsnew.append(self.addp(*init_cond.solar_system_horizons(n, self.param, date))) - - - if id is not None: - if type(id) is str: - id = [id] - - if origin_type is None: - origin_type = ['initial_conditions'] * len(id) - - for i in id: - dsnew.append(self.addp(*init_cond.solar_system_horizons(i, self.param, date))) - - - return + body_list = [] + for i,n in enumerate(name): + body_list.append(init_cond.solar_system_horizons(n, self.param, date, idval=ephemeris_id[i])) + + #Convert the list receieved from the solar_system_horizons output and turn it into arguments to vec2xr + name,v1,v2,v3,v4,v5,v6,ephemeris_id,GMpl,Rpl,rhill,Ip1,Ip2,Ip3,rotx,roty,rotz,J2,J4 = tuple(np.squeeze(np.hsplit(np.array(body_list),19))) + + 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) + ephemeris_id = ephemeris_id.astype(int) + GMpl = GMpl.astype(np.float64) + Rpl = Rpl.astype(np.float64) + rhill = rhill.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) + J2 = J2.astype(np.float64) + J4 = J4.astype(np.float64) + + if all(np.isnan(GMpl)): + GMpl = None + if all(np.isnan(Rpl)): + Rpl = 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 + + + dsnew = init_cond.vec2xr(self.param,name,v1,v2,v3,v4,v5,v6,ephemeris_id,GMpl,Rpl,rhill,Ip1,Ip2,Ip3,rotx,roty,rotz,J2,J4) + + return body_list def set_ephemeris_date(self, @@ -1662,48 +1709,131 @@ def get_ephemeris_date(self, verbose: bool | None = None, **kwargs: Any): return self.ephemeris_date - def add_body(self, namevals, v1, v2, v3, v4, v5, v6, GMpl=None, Rpl=None, rhill=None, Ip1=None, Ip2=None, - Ip3=None, rotx=None, roty=None, rotz=None, J2=None, J4=None, t=None): + def add_body(self, + name: str | List[str] | npt.NDArray[np.str_], + v1: float | List[float] | npt.NDArray[np.float_], + v2: float | List[float] | npt.NDArray[np.float_], + v3: float | List[float] | npt.NDArray[np.float_], + v4: float | List[float] | npt.NDArray[np.float_], + v5: float | List[float] | npt.NDArray[np.float_], + v6: float | List[float] | npt.NDArray[np.float_], + idvals: int | list[int] | npt.NDArray[np.int_] | None=None, + GMpl: float | List[float] | npt.NDArray[np.float_] | None=None, + Rpl: 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, + 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, + J2: float | List[float] | npt.NDArray[np.float_] | None=None, + J4: float | List[float] | npt.NDArray[np.float_] | None=None): """ Adds a body (test particle or massive body) to the internal DataSet given a set up 6 vectors (orbital elements - or cartesian state vectors, depending on the value of self.param). Input all angles in degress + or cartesian state vectors, depending on the value of self.param). Input all angles in degress. + + This method will update self.ds with the new body or bodies added to the existing Dataset. Parameters ---------- - v1 : float - xh for param['IN_FORM'] == "XV"; a for param['IN_FORM'] == "EL" - v2 : float - yh for param['IN_FORM'] == "XV"; e for param['IN_FORM'] == "EL" - v3 : float - zh for param['IN_FORM'] == "XV"; inc for param['IN_FORM'] == "EL" - v4 : float - vhxh for param['IN_FORM'] == "XV"; capom for param['IN_FORM'] == "EL" - v5 : float - vhyh for param['IN_FORM'] == "XV"; omega for param['IN_FORM'] == "EL" - v6 : float - vhzh for param['IN_FORM'] == "XV"; capm for param['IN_FORM'] == "EL" - Gmass : float - Optional: Array of G*mass values if these are massive bodies - radius : float - Optional: Array radius values if these are massive bodies - rhill : float - Optional: Array rhill values if these are massive bodies - Ip1,y,z : float - Optional: Principal axes moments of inertia - rotx,y,z: float - Optional: Rotation rate vector components - t : float - Optional: Time at start of simulation + name : str or array-like of str + Name or names of + v1 : float or array-like of float + xhx for param['IN_FORM'] == "XV"; a for param['IN_FORM'] == "EL" + v2 : float or array-like of float + xhy for param['IN_FORM'] == "XV"; e for param['IN_FORM'] == "EL" + v3 : float or array-like of float + xhz for param['IN_FORM'] == "XV"; inc for param['IN_FORM'] == "EL" + v4 : float or array-like of float + vhx for param['IN_FORM'] == "XV"; capom for param['IN_FORM'] == "EL" + v5 : float or array-like of float + vhy for param['IN_FORM'] == "XV"; omega for param['IN_FORM'] == "EL" + v6 : float or array-like of float + vhz for param['IN_FORM'] == "XV"; capm for param['IN_FORM'] == "EL" + idvals : int or array-like of int, optional + Unique id values. If not passed, this will be computed based on the pre-existing Dataset ids. + Gmass : float or array-like of float, optional + G*mass values if these are massive bodies + radius : float or array-like of float, optional + Radius values if these are massive bodies + rhill : float, optional + Hill's radius values if these are massive bodies + Ip1,y,z : float, optional + Principal axes moments of inertia these are massive bodies with rotation enabled + rotx,y,z: float, optional + Rotation rate vector components if these are massive bodies with rotation enabled Returns ------- - self.ds : xarray dataset + ds : Xarray Dataset + Dasaset containing the body or bodies that were added + """ - if t is None: - t = self.param['T0'] - dsnew = init_cond.vec2xr(self.param, idvals, namevals, v1, v2, v3, v4, v5, v6, GMpl, Rpl, rhill, Ip1, Ip2, Ip3, - rotx, roty, rotz, J2, J4, t) + #convert all inputs to numpy arrays + def input_to_array(val,t,n=None): + if t == "f": + t = np.float64 + elif t == "i": + t = np.int64 + elif t == "s": + t = np.str + if val is None: + return None + elif np.isscalar(val): + val = np.array([val],dtype=t) + elif type(val) is list: + val = np.array(val,dtype=t) + + if n is None: + return val, len(val) + else: + if n != len(val): + raise ValueError(f"Error! Mismatched array lengths in add_body. Got {len(val)} when expecting {n}") + return val + + + name,nbodies = input_to_array(name,"s") + v1 = input_to_array(v1,"f",nbodies) + v2 = input_to_array(v2,"f",nbodies) + v3 = input_to_array(v3,"f",nbodies) + v4 = input_to_array(v4,"f",nbodies) + v5 = input_to_array(v5,"f",nbodies) + v6 = input_to_array(v6,"f",nbodies) + idvals = input_to_array(idvals,"i",nbodies) + GMpl = input_to_array(GMpl,"f",nbodies) + rhill = input_to_array(rhill,"f",nbodies) + Rpl = input_to_array(Rpl,"f",nbodies) + Ip1 = input_to_array(Ip1,"f",nbodies) + Ip2 = input_to_array(Ip2,"f",nbodies) + Ip3 = input_to_array(Ip3,"f",nbodies) + rotx = input_to_array(rotx,"f",nbodies) + roty = input_to_array(roty,"f",nbodies) + rotz = input_to_array(rotz,"f",nbodies) + J2 = input_to_array(J2,"f",nbodies) + J4 = input_to_array(J4,"f",nbodies) + + if len(self.ds) == 0: + maxid = -1 + else: + maxid = self.ds.id.max().values[()] + + if idvals is None: + idvals = np.arange(start=maxid+1,stop=maxid+1+nbodies,dtype=int) + + if len(self.ds) > 0: + dup_id = np.in1d(idvals,self.ds.id) + if any(dup_id): + raise ValueError(f"Duplicate ids detected: ", *idvals[dup_id]) + + t = self.param['TSTART'] + + dsnew = init_cond.vec2xr(self.param, idvals, name, v1, v2, v3, v4, v5, v6, + GMpl=GMpl, Rpl=Rpl, rhill=rhill, + Ip1=Ip1, Ip2=Ip2, Ip3=Ip3, + rotx=rotx, roty=roty, rotz=rotz, + J2=J2, J4=J4, t=t) if dsnew is not None: self.ds = xr.combine_by_coords([self.ds, dsnew]) self.ds['ntp'] = self.ds['id'].where(np.isnan(self.ds['Gmass'])).count(dim="id") @@ -1714,7 +1844,7 @@ def add_body(self, namevals, v1, v2, v3, v4, v5, v6, GMpl=None, Rpl=None, rhill= elif self.param['OUT_TYPE'] == "NETCDF_FLOAT": self.ds = io.fix_types(self.ds, ftype=np.float32) - return + return dsnew def read_param(self, param_file, codename="Swiftest", verbose=True): """ From 3c4c2b638ea3cc606695145644a67d30a9337a2b Mon Sep 17 00:00:00 2001 From: David Minton Date: Thu, 10 Nov 2022 19:56:39 -0500 Subject: [PATCH 042/569] Finished add_solar_system_body method --- python/swiftest/swiftest/init_cond.py | 65 ++++++++++++-------- python/swiftest/swiftest/simulation_class.py | 4 +- 2 files changed, 42 insertions(+), 27 deletions(-) diff --git a/python/swiftest/swiftest/init_cond.py b/python/swiftest/swiftest/init_cond.py index c90f1d59b..a5bf89c2b 100644 --- a/python/swiftest/swiftest/init_cond.py +++ b/python/swiftest/swiftest/init_cond.py @@ -329,15 +329,21 @@ def vec2xr(param: Dict, infodims = ['id', 'vec'] # The central body is always given id 0 - icb = idvals == 0 - iscb = any(icb) if GMpl is not None: - ispl = True - ipl = ~np.isnan(GMpl) - itp = np.isnan(GMpl) + 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 ispl and param['CHK_CLOSE'] and Rpl is None: print("Massive bodies need a radius value.") @@ -351,35 +357,42 @@ def vec2xr(param: Dict, param['OUT_FORM'] = param['IN_FORM'] clab, plab, tlab, infolab_float, infolab_int, infolab_str = swiftest.io.make_swiftest_labels(param) param['OUT_FORM'] = old_out_form - vec_str = np.vstack([namevals]) - label_str = ["name"] particle_type = np.empty_like(namevals) + vec = np.vstack([v1,v2,v3,v4,v5,v6]) + if iscb: - label_float = clab.copy() - vec_float = np.vstack([GMpl[icb],Rpl[icb],J2[icb],J4[icb]]) + lab_cb = clab.copy() + vec_cb = np.vstack([GMpl[icb],Rpl[icb],J2[icb],J4[icb]]) if param['ROTATION']: - vec_float = np.vstack([vec_float, Ip1[icb], Ip2[icb], Ip3[icb], rotx[icb], roty[icb], rotz[icb]]) + vec_cb = np.vstack([vec_cb, Ip1[icb], Ip2[icb], Ip3[icb], rotx[icb], roty[icb], rotz[icb]]) particle_type[icb] = "Central Body" - # vec_float = np.vstack([v1, v2, v3, v4, v5, v6]) + 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 = xr.Dataset() if ispl: - label_float = plab.copy() - vec_float = np.vstack([vec_float, GMpl]) + lab_pl = plab.copy() + vec_pl = np.vstack([vec[:,ipl], GMpl[ipl]]) if param['CHK_CLOSE']: - vec_float = np.vstack([vec_float, Rpl]) + vec_pl = np.vstack([vec_pl, Rpl[ipl]]) if param['RHILL_PRESENT']: - vec_float = np.vstack([vec_float, rhill]) + vec_pl = np.vstack([vec_pl, rhill[ipl]]) if param['ROTATION']: - vec_float = np.vstack([vec_float, Ip1, Ip2, Ip3, rotx, roty, rotz]) - particle_type[ipl] = np.repeat("Massive Body",idvals.size) + 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: - label_float = tlab.copy() - particle_type[itp] = np.repeat("Test Particle",idvals.size) - frame_float = np.expand_dims(vec_float.T, axis=0) - frame_str = vec_str.T - da_float = xr.DataArray(frame_float, dims=dims, coords={'time': [t], 'id': idvals, 'vec': label_float}) - da_str= xr.DataArray(frame_str, dims=infodims, coords={'id': idvals, 'vec': label_str}) - ds_float = da_float.to_dataset(dim="vec") - ds_str = da_str.to_dataset(dim="vec") - ds = xr.combine_by_coords([ds_float, ds_str]) + ds_pl = xr.Dataset() + 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 = xr.Dataset() + + ds_info = xr.DataArray(np.vstack([namevals,particle_type]).T, dims=infodims, coords={'id': idvals, 'vec' : ["name", "particle_type"]}).to_dataset(dim='vec') + ds = xr.combine_by_coords([ds_cb, ds_pl, ds_tp, ds_info]) return ds \ No newline at end of file diff --git a/python/swiftest/swiftest/simulation_class.py b/python/swiftest/swiftest/simulation_class.py index 01c3b8414..9ecbc1e51 100644 --- a/python/swiftest/swiftest/simulation_class.py +++ b/python/swiftest/swiftest/simulation_class.py @@ -1625,7 +1625,9 @@ def add_solar_system_body(self, dsnew = init_cond.vec2xr(self.param,name,v1,v2,v3,v4,v5,v6,ephemeris_id,GMpl,Rpl,rhill,Ip1,Ip2,Ip3,rotx,roty,rotz,J2,J4) - return body_list + self.ds = xr.combine_by_coords([self.ds,dsnew]) + + return dsnew def set_ephemeris_date(self, From d166719e3b44a2a05fcbe96e8f23088395439512 Mon Sep 17 00:00:00 2001 From: David Minton Date: Thu, 10 Nov 2022 20:33:35 -0500 Subject: [PATCH 043/569] Finished the new add_body and add_solar_system_body methods --- python/swiftest/swiftest/init_cond.py | 13 +++-- python/swiftest/swiftest/simulation_class.py | 52 +++++++++++++++++--- 2 files changed, 53 insertions(+), 12 deletions(-) diff --git a/python/swiftest/swiftest/init_cond.py b/python/swiftest/swiftest/init_cond.py index a5bf89c2b..ea28bcb8c 100644 --- a/python/swiftest/swiftest/init_cond.py +++ b/python/swiftest/swiftest/init_cond.py @@ -369,7 +369,7 @@ def vec2xr(param: Dict, 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 = xr.Dataset() + ds_cb = None if ispl: lab_pl = plab.copy() vec_pl = np.vstack([vec[:,ipl], GMpl[ipl]]) @@ -383,16 +383,21 @@ def vec2xr(param: Dict, 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 = xr.Dataset() + 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 = xr.Dataset() + ds_tp = None ds_info = xr.DataArray(np.vstack([namevals,particle_type]).T, dims=infodims, coords={'id': idvals, 'vec' : ["name", "particle_type"]}).to_dataset(dim='vec') - ds = xr.combine_by_coords([ds_cb, ds_pl, ds_tp, ds_info]) + 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]) return ds \ No newline at end of file diff --git a/python/swiftest/swiftest/simulation_class.py b/python/swiftest/swiftest/simulation_class.py index 9ecbc1e51..8e1ac24e0 100644 --- a/python/swiftest/swiftest/simulation_class.py +++ b/python/swiftest/swiftest/simulation_class.py @@ -1622,10 +1622,15 @@ def add_solar_system_body(self, 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,Rpl,rhill,Ip1,Ip2,Ip3,rotx,roty,rotz,J2,J4) + dsnew = init_cond.vec2xr(self.param,name,v1,v2,v3,v4,v5,v6,ephemeris_id, + GMpl=GMpl, Rpl=Rpl, rhill=rhill, + Ip1=Ip1, Ip2=Ip2, Ip3=Ip3, + rotx=rotx, roty=roty, rotz=rotz, + J2=J2, J4=J4, t=t) - self.ds = xr.combine_by_coords([self.ds,dsnew]) + dsnew = self._combine_and_fix_dsnew(dsnew) return dsnew @@ -1831,19 +1836,50 @@ def input_to_array(val,t,n=None): t = self.param['TSTART'] - dsnew = init_cond.vec2xr(self.param, idvals, name, v1, v2, v3, v4, v5, v6, + dsnew = init_cond.vec2xr(self.param, name, v1, v2, v3, v4, v5, v6, idvals, GMpl=GMpl, Rpl=Rpl, rhill=rhill, Ip1=Ip1, Ip2=Ip2, Ip3=Ip3, rotx=rotx, roty=roty, rotz=rotz, - J2=J2, J4=J4, t=t) - if dsnew is not None: - self.ds = xr.combine_by_coords([self.ds, dsnew]) - self.ds['ntp'] = self.ds['id'].where(np.isnan(self.ds['Gmass'])).count(dim="id") - self.ds['npl'] = self.ds['id'].where(np.invert(np.isnan(self.ds['Gmass']))).count(dim="id") - 1 + J2=J2, J4=J4,t=t) + + dsnew = self._combine_and_fix_dsnew(dsnew) + + return dsnew + + def _combine_and_fix_dsnew(self,dsnew): + """ + Combines the new Dataset with the old one. Also computes the values of ntp and npl and sets the proper types. + Parameters + ---------- + dsnew : xarray Dataset + Dataset with new bodies + + Returns + ------- + dsnew : xarray Dataset + Updated Dataset with ntp, npl values and types fixed. + + """ + + self.ds = xr.combine_by_coords([self.ds, dsnew]) + + def get_nvals(ds): + if "Gmass" in dsnew: + ds['ntp'] = ds['id'].where(np.isnan(ds['Gmass'])).count(dim="id") + ds['npl'] = ds['id'].where(np.invert(np.isnan(ds['Gmass']))).count(dim="id") - 1 + else: + ds['ntp'] = ds['id'].count(dim="id") + ds['npl'] = xr.full_like(ds['ntp'],0) + return ds + + dsnew = get_nvals(dsnew) + self.ds = get_nvals(self.ds) if self.param['OUT_TYPE'] == "NETCDF_DOUBLE": + dsnew = io.fix_types(dsnew, ftype=np.float64) self.ds = io.fix_types(self.ds, ftype=np.float64) elif self.param['OUT_TYPE'] == "NETCDF_FLOAT": + dsnew = io.fix_types(dsnew, ftype=np.float32) self.ds = io.fix_types(self.ds, ftype=np.float32) return dsnew From 4bd9b6a30f099249a5ae37f0753090bf65d114f0 Mon Sep 17 00:00:00 2001 From: David Minton Date: Thu, 10 Nov 2022 20:37:38 -0500 Subject: [PATCH 044/569] Fixed typo that gave wrong npl and ntp values --- python/swiftest/swiftest/simulation_class.py | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/python/swiftest/swiftest/simulation_class.py b/python/swiftest/swiftest/simulation_class.py index 8e1ac24e0..d98a4ec1b 100644 --- a/python/swiftest/swiftest/simulation_class.py +++ b/python/swiftest/swiftest/simulation_class.py @@ -1864,9 +1864,9 @@ def _combine_and_fix_dsnew(self,dsnew): self.ds = xr.combine_by_coords([self.ds, dsnew]) def get_nvals(ds): - if "Gmass" in dsnew: + if "Gmass" in ds: ds['ntp'] = ds['id'].where(np.isnan(ds['Gmass'])).count(dim="id") - ds['npl'] = ds['id'].where(np.invert(np.isnan(ds['Gmass']))).count(dim="id") - 1 + ds['npl'] = ds['id'].where(~(np.isnan(ds['Gmass']))).count(dim="id") - 1 else: ds['ntp'] = ds['id'].count(dim="id") ds['npl'] = xr.full_like(ds['ntp'],0) From ff6da0f6188a8222e774060ebdd814a6a15ba531 Mon Sep 17 00:00:00 2001 From: David Minton Date: Thu, 10 Nov 2022 20:38:49 -0500 Subject: [PATCH 045/569] Updated example for the Basic Simulation --- examples/Basic_Simulation/cb.in | 9 - .../Basic_Simulation/initial_conditions.py | 34 ++-- examples/Basic_Simulation/param.in | 37 ++++ examples/Basic_Simulation/pl.in | 163 +++++++++--------- examples/Basic_Simulation/tp.in | 49 +++--- 5 files changed, 148 insertions(+), 144 deletions(-) create mode 100644 examples/Basic_Simulation/param.in diff --git a/examples/Basic_Simulation/cb.in b/examples/Basic_Simulation/cb.in index 29c8a7fca..b2cb85c35 100644 --- a/examples/Basic_Simulation/cb.in +++ b/examples/Basic_Simulation/cb.in @@ -1,12 +1,3 @@ -!! Copyright 2022 - David Minton, Carlisle Wishard, Jennifer Pouplin, Jake Elliott, & Dana Singh -!! This file is part of Swiftest. -!! Swiftest is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License -!! as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. -!! Swiftest is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty -!! of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. -!! You should have received a copy of the GNU General Public License along with Swiftest. -!! If not, see: https://www.gnu.org/licenses. - Sun 39.476926408897626 0.004650467260962157 diff --git a/examples/Basic_Simulation/initial_conditions.py b/examples/Basic_Simulation/initial_conditions.py index c9d0823af..f12bf6e07 100644 --- a/examples/Basic_Simulation/initial_conditions.py +++ b/examples/Basic_Simulation/initial_conditions.py @@ -30,31 +30,20 @@ from numpy.random import default_rng # Initialize the simulation object as a variable -sim = swiftest.Simulation(init_cond_file_type="ASCII") - +sim = swiftest.Simulation() sim.set_simulation_time(tstart=0.0, tstop=10.0, dt=0.005, tstep_out=1.0) - # Add parameter attributes to the simulation object sim.param['GMTINY'] = 1e-6 sim.param['MIN_GMFRAG'] = 1e-9 # Add the modern planets and the Sun using the JPL Horizons Database -sim.add("Sun", idval=0, date="2022-08-08") -sim.add("Mercury", idval=1, date="2022-08-08") -sim.add("Venus", idval=2, date="2022-08-08") -sim.add("Earth", idval=3, date="2022-08-08") -sim.add("Mars", idval=4, date="2022-08-08") -sim.add("Jupiter", idval=5, date="2022-08-08") -sim.add("Saturn", idval=6, date="2022-08-08") -sim.add("Uranus", idval=7, date="2022-08-08") -sim.add("Neptune", idval=8, date="2022-08-08") +sim.add_solar_system_body(["Sun","Mercury","Venus","Earth","Mars","Jupiter","Saturn","Uranus","Neptune","Pluto"]) # Add 5 user-defined massive bodies npl = 5 density_pl = 3000.0 / (sim.param['MU2KG'] / sim.param['DU2M'] ** 3) -id_pl = np.array([9, 10, 11, 12, 13]) -name_pl = np.array(["MassiveBody_01", "MassiveBody_02", "MassiveBody_03", "MassiveBody_04", "MassiveBody_05"]) +name_pl = ["MassiveBody_01", "MassiveBody_02", "MassiveBody_03", "MassiveBody_04", "MassiveBody_05"] a_pl = default_rng().uniform(0.3, 1.5, npl) e_pl = default_rng().uniform(0.0, 0.3, npl) inc_pl = default_rng().uniform(0.0, 90, npl) @@ -64,19 +53,18 @@ 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 = np.array([0.4, 0.4, 0.4, 0.4, 0.4]) -Ip2_pl = np.array([0.4, 0.4, 0.4, 0.4, 0.4]) -Ip3_pl = np.array([0.4, 0.4, 0.4, 0.4, 0.4]) -rotx_pl = np.array([0.0, 0.0, 0.0, 0.0, 0.0]) -roty_pl = np.array([0.0, 0.0, 0.0, 0.0, 0.0]) -rotz_pl = np.array([0.0, 0.0, 0.0, 0.0, 0.0]) +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] -sim.addp(id_pl, name_pl, a_pl, e_pl, inc_pl, capom_pl, omega_pl, capm_pl, GMpl=GM_pl, Rpl=R_pl, rhill=Rh_pl, Ip1=Ip1_pl, Ip2=Ip2_pl, Ip3=Ip3_pl, rotx=rotx_pl, roty=roty_pl, rotz=rotz_pl) +sim.add_body(name_pl, a_pl, e_pl, inc_pl, capom_pl, omega_pl, capm_pl, GMpl=GM_pl, Rpl=R_pl, rhill=Rh_pl, Ip1=Ip1_pl, Ip2=Ip2_pl, Ip3=Ip3_pl, rotx=rotx_pl, roty=roty_pl, rotz=rotz_pl) # Add 10 user-defined test particles ntp = 10 -id_tp = np.array([14, 15, 16, 17, 18, 19, 20, 21, 22, 23]) name_tp = np.array(["TestParticle_01", "TestParticle_02", "TestParticle_03", "TestParticle_04", "TestParticle_05", "TestParticle_06", "TestParticle_07", "TestParticle_08", "TestParticle_09", "TestParticle_10"]) a_tp = default_rng().uniform(0.3, 1.5, ntp) e_tp = default_rng().uniform(0.0, 0.3, ntp) @@ -85,7 +73,7 @@ omega_tp = default_rng().uniform(0.0, 360.0, ntp) capm_tp = default_rng().uniform(0.0, 360.0, ntp) -sim.addp(id_tp, name_tp, a_tp, e_tp, inc_tp, capom_tp, omega_tp, capm_tp) +sim.add_body(name_tp, a_tp, e_tp, inc_tp, capom_tp, omega_tp, capm_tp) # Save everything to a set of initial conditions files sim.save('param.in') diff --git a/examples/Basic_Simulation/param.in b/examples/Basic_Simulation/param.in new file mode 100644 index 000000000..47498726c --- /dev/null +++ b/examples/Basic_Simulation/param.in @@ -0,0 +1,37 @@ +! VERSION Swiftest parameter input +T0 0.0 +TSTOP 10.0 +DT 0.005 +ISTEP_OUT 200 +ISTEP_DUMP 200 +OUT_FORM XVEL +OUT_TYPE NETCDF_DOUBLE +OUT_STAT REPLACE +IN_TYPE NETCDF_DOUBLE +BIN_OUT bin.nc +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 +RESTART NO +INTERACTION_LOOPS TRIANGULAR +ENCOUNTER_CHECK TRIANGULAR +CHK_CLOSE YES +GR YES +FRAGMENTATION YES +ROTATION YES +ENERGY NO +EXTRA_FORCE NO +BIG_DISCARD NO +RHILL_PRESENT NO +TIDES NO +IN_FORM EL +NC_IN init_cond.nc +TSTART 0.0 +GMTINY 1e-06 +MIN_GMFRAG 1e-09 diff --git a/examples/Basic_Simulation/pl.in b/examples/Basic_Simulation/pl.in index 3f18aca0e..215b91f1d 100644 --- a/examples/Basic_Simulation/pl.in +++ b/examples/Basic_Simulation/pl.in @@ -1,88 +1,85 @@ -!! Copyright 2022 - David Minton, Carlisle Wishard, Jennifer Pouplin, Jake Elliott, & Dana Singh -!! This file is part of Swiftest. -!! Swiftest is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License -!! as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. -!! Swiftest is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty -!! of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. -!! You should have received a copy of the GNU General Public License along with Swiftest. -!! If not, see: https://www.gnu.org/licenses. - -13 -Mercury 6.553709809565314146e-06 0.0014751262621647182575 -1.6306381826061645943e-05 -0.38709864823618972407 0.20562513690973019398 7.0036250456070128223 -48.30204974520415817 29.18823342267911869 114.9720047697775982 -0.0 0.0 0.34599999999999997424 -3.5734889863322150192 -18.38008501876561206 34.361513668512199956 -Venus 9.6633133995815381836e-05 0.006759085242739840662 -4.0453784346544178454e-05 -0.72332603580811538624 0.0067486079191121668003 3.394406261149808035 -76.61738837179606776 54.777760273590551776 315.37095689555837907 -0.0 0.0 0.4000000000000000222 -0.17650282045605921225 -3.6612475825356215592 8.702866268072763821 -Earth 0.000120026935827952456416 0.010044668314295209318 -4.25875607065040958e-05 -0.9999943732711822353 0.016707309394717231171 0.0028984767436730000077 -174.05498211951208987 289.04709044403989537 213.07530468023790604 -0.0 0.0 0.33069999999999999396 -5.002093202481912218 0.055213529850334066125 2301.2110537292529557 -Mars 1.2739802010675941808e-05 0.007246950762048707243 -2.265740805092889601e-05 -1.5237812078483019551 0.0935087708803710449 1.8479353068000929916 -49.489305419773351957 286.70300191753761965 24.878418068365981242 -0.0 0.0 0.3644000000000000017 -997.9357048213454125 -909.4072592492943007 1783.4501726537997323 -Jupiter 0.03769225108898567778 0.3552222491747608486 -0.00046732617030490929307 -5.2028063728088866924 0.048395118271449058533 1.3035670146561249005 -100.516498130230701236 273.44233262595901124 346.26538105843917492 -0.0 0.0 0.27560000000000001164 --80.96619889339111482 -2388.0060524649362916 5008.7314931237953832 -Saturn 0.01128589982009127331 0.43757948578866074266 -0.00038925687730393611812 -9.580020069168169172 0.053193613750490406633 2.4864365613724639381 -113.597044717589099605 335.10179422401358806 237.66485199561481068 -0.0 0.0 0.22000000000000000111 -441.93538182505989814 378.5284220382117538 5135.9110455622733884 -Uranus 0.001723658947826773068 0.4705353566089944894 -0.00016953449859497231466 -19.272143108769419939 0.043779687288749750962 0.7707536154556786645 -74.077748995180698444 93.42271392662131291 242.37685081109759722 -0.0 0.0 0.23000000000000000999 --677.3000258209181323 -3008.109907190578637 -836.301326618569835 -Neptune 0.0020336100526728302882 0.78184929587893868845 -0.000164587904124493665 -30.305539399096510067 0.014544938874222059638 1.7686697746048700708 -131.73604731224671127 249.9779420269553043 332.54824537252648042 -0.0 0.0 0.23000000000000000999 -1231.1804455066093229 -2178.0887091151860042 2329.6411363603121418 -MassiveBody_01 1.1912109366578087428e-05 0.0016092923734511708263 -2.425055692051244981e-05 -0.3460404950890429432 0.2093906512182220625 0.11109012870384793459 -114.31328763688792094 347.82259114762894114 96.0534391561842682 -0.4000000000000000222 0.4000000000000000222 0.4000000000000000222 +14 +Mercury 6.553709809565314e-06 +1.6306381826061646e-05 +0.3870985843095394 0.2056234010897001 7.003302508001384 +48.29611837378607 29.20442403952454 338.3394874682879 +0.0 0.0 0.346 +3.573018077015318 -18.380317085416586 34.36143850429876 +Venus 9.663313399581537e-05 +4.0453784346544176e-05 +0.7233297579736101 0.006717605698865438 3.394439273342282 +76.60235891771119 54.96037946082961 200.4789339550648 +0.0 0.0 0.4 +0.17650282045605922 -3.6612475825356214 8.702866268072764 +Earth 0.00012002693582795245 +4.25875607065041e-05 +0.9999904874543223 0.01671400376545858 0.003637862608863003 +175.025172600231 287.9619628812575 114.3482934042427 +0.0 0.0 0.3307 +6.157239621449141 0.057224133705898524 2301.2082528350797 +Mars 1.2739802010675942e-05 +2.2657408050928896e-05 +1.523711925589535 0.09344151133508208 1.847441673557901 +49.4728572124747 286.7379771285891 209.3396773477138 +0.0 0.0 0.3644 +997.9224351226384 -909.5549030011778 1783.3823046046184 +Jupiter 0.037692251088985676 +0.0004673261703049093 +5.2027278008516 0.04824497711637968 1.303631134570075 +100.5192588433081 273.5898402882514 129.5536700659942 +0.0 0.0 0.2756 +-80.9864396731672 -2388.0246092955053 5008.722318533006 +Saturn 0.011285899820091273 +0.00038925687730393614 +9.532011952667288 0.05486329870433341 2.487906363280301 +113.6305781676206 339.5467356402391 290.8995806568904 +0.0 0.0 0.22 +441.95954822014636 378.52638822638795 5135.909115928892 +Uranus 0.001723658947826773 +0.00016953449859497232 +19.24498838290236 0.04796174942301296 0.7730102596086205 +74.0125809801658 93.59554912280227 262.8658637277515 +0.0 0.0 0.23 +-677.3000258209181 -3008.1099071905787 -836.3013266185699 +Neptune 0.0020336100526728304 +0.00016458790412449367 +30.03895991152209 0.008955570138096731 1.771119354296142 +131.8221159748827 284.4748429674216 308.4513720536233 +0.0 0.0 0.23 +1232.224106980634 -2177.3040821077648 2329.8227878119233 +Pluto 2.924216771029454e-07 +7.943294877391593e-06 +39.36791814672583 0.2487178537481577 17.1705505990969 +110.3314332962701 113.0826635900664 55.11416408345664 +0.0 0.0 0.4 +-243.59404988903637 261.28663002814227 -38.57352022187049 +MassiveBody_01 1.1912109366578089e-05 +2.425055692051245e-05 +0.7452368716298337 0.0633011418780484 0.11151363780595558 +203.01823417718037 284.9353898127118 266.79344592519305 +0.4 0.4 0.4 0.0 0.0 0.0 -MassiveBody_02 1.5882812488770779849e-05 0.0016802531895603555184 -2.6691191565570073646e-05 -0.32826188156947710972 0.27866488696288682636 77.21223337306255985 -251.99014895640269174 53.772702227560969845 165.6085387284213084 -0.4000000000000000222 0.4000000000000000222 0.4000000000000000222 +MassiveBody_02 1.5882812488770783e-05 +2.6691191565570074e-05 +0.7671203280602826 0.10149029388964753 53.46706656938751 +61.74738152068808 68.20565593722856 271.3352706902475 +0.4 0.4 0.4 0.0 0.0 0.0 -MassiveBody_03 1.9853515610963475658e-05 0.004324919007577881884 -2.8752214513575297366e-05 -0.7843689028022314824 0.06176128116947356833 78.74144231136708072 -286.63765100951468412 347.55933571120488068 266.36960496595537506 -0.4000000000000000222 0.4000000000000000222 0.4000000000000000222 +MassiveBody_03 1.985351561096348e-05 +2.8752214513575297e-05 +1.4698824276418418 0.13621250684495437 23.635498327264845 +38.071905339231236 283.134612455057 250.67457601578352 +0.4 0.4 0.4 0.0 0.0 0.0 -MassiveBody_04 5.9560546832890430362e-05 0.0056765613035874530265 -4.146786902759040254e-05 -0.7138176832994267418 0.28016098557400787028 22.725690778108500467 -203.41845532080247949 219.74297850728484605 14.730732982803269593 -0.4000000000000000222 0.4000000000000000222 0.4000000000000000222 +MassiveBody_04 5.9560546832890444e-05 +4.14678690275904e-05 +0.9741731590760117 0.1519713326893784 20.51335588582416 +350.53780805624825 304.05941264938997 142.62713592644738 +0.4 0.4 0.4 0.0 0.0 0.0 -MassiveBody_05 9.9267578054817388455e-05 0.010382929139161686458 -4.916559523190238318e-05 -1.101215402063684401 0.076651567404004070094 52.41961577462824806 -142.90070862650665617 293.70542448390904156 318.5666754758643151 -0.4000000000000000222 0.4000000000000000222 0.4000000000000000222 +MassiveBody_05 9.926757805481742e-05 +4.916559523190238e-05 +0.6633500122731075 0.13550930562584215 10.680323453316653 +328.45970148163457 49.93948991697533 316.2109831817007 +0.4 0.4 0.4 0.0 0.0 0.0 diff --git a/examples/Basic_Simulation/tp.in b/examples/Basic_Simulation/tp.in index 162f8c0af..9e3c6b9bc 100644 --- a/examples/Basic_Simulation/tp.in +++ b/examples/Basic_Simulation/tp.in @@ -1,40 +1,31 @@ -!! Copyright 2022 - David Minton, Carlisle Wishard, Jennifer Pouplin, Jake Elliott, & Dana Singh -!! This file is part of Swiftest. -!! Swiftest is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License -!! as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. -!! Swiftest is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty -!! of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. -!! You should have received a copy of the GNU General Public License along with Swiftest. -!! If not, see: https://www.gnu.org/licenses. - 10 TestParticle_01 -1.0288790290699558749 0.088535376967516773994 39.679062610233010844 -51.107327480220099858 20.90477961082723013 183.92936958121950397 +0.5697767200549144 0.11834332057809717 80.87229166892182 +222.5373287698991 111.76944690551065 270.3754252090885 TestParticle_02 -0.54831541717225318333 0.20048853000030755767 32.784952066779297297 -66.59436607119042151 196.2609764918545352 76.40623742948525887 +1.0092273242276735 0.05399051523964523 82.35601343884242 +117.598050656921 116.26893959032198 208.13367102381633 TestParticle_03 -0.9815578696795972391 0.25717438840188583393 38.959194313128776344 -158.31201212846775661 93.86793546512863884 126.96040079919036714 +0.7590606700221183 0.027936243833100036 88.12926503625694 +188.5414923780248 169.44578516513008 282.4333664924941 TestParticle_04 -0.70510786000431613374 0.068740260615181125736 39.981235917453354034 -26.668314027440779057 12.507089902982141183 53.606668142734086757 +0.9972940668463142 0.2569338531459909 22.75744046640894 +199.388648818177 152.8772634782716 307.54746324357103 TestParticle_05 -1.336737159289705712 0.25044351028750111432 74.189544264066626056 -313.1647935522670423 152.39951433565357775 322.52271715518395467 +0.341620427452812 0.052524493325270837 18.839916665085173 +327.2732232808312 334.4396604858765 359.4553699087638 TestParticle_06 -0.64018428687513928566 0.1478972702874425671 73.39555666508663023 -74.03379498826825511 124.22185942531125136 106.36095293685497154 +1.1670239341669624 0.07778574626824612 22.716135789279228 +196.30730270195494 154.1907148406917 159.6860762761786 TestParticle_07 -1.2738161048947760356 0.17129911220230967239 78.723790909435408025 -111.971184037421835455 315.6294407604535195 108.74538288631850946 +1.0954005977667731 0.10128096358705894 9.878980088486013 +101.85525076444998 124.8686145955563 254.7757898831765 TestParticle_08 -0.5196197141250760154 0.26607581023277782073 79.221465395061358095 -240.07768052067768849 177.4793327047061382 189.85775920180086018 +0.39125485873865873 0.17327367123519463 22.276414655828646 +105.99598258123197 235.2803528505754 348.706620365582 TestParticle_09 -0.7160151851892424535 0.29584187625470087513 58.1214116614385361 -24.22606869850931588 338.4678256522021229 136.32070882113120547 +0.48720268138208256 0.29707768397862033 39.717820434869466 +307.9106242922398 221.91704762104942 333.56626647648994 TestParticle_10 -1.0782431797945351004 0.11096856177737297877 54.729767236739554903 -280.85362091874827684 116.780853088052467115 286.99855363222661708 +0.6458552755486036 0.07522818043309405 45.225887389492826 +74.40348173261458 92.77221707157337 260.30279498657796 From 0be34922757a59eb9d0f20166bac6b00097acf27 Mon Sep 17 00:00:00 2001 From: David Minton Date: Thu, 10 Nov 2022 20:41:02 -0500 Subject: [PATCH 046/569] switched the test particle names in the Basic_Simulation example to be a list rather than a numpy array just to make it cleaner (it accepts either) --- examples/Basic_Simulation/initial_conditions.py | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/examples/Basic_Simulation/initial_conditions.py b/examples/Basic_Simulation/initial_conditions.py index f12bf6e07..1edc13879 100644 --- a/examples/Basic_Simulation/initial_conditions.py +++ b/examples/Basic_Simulation/initial_conditions.py @@ -65,7 +65,7 @@ # Add 10 user-defined test particles ntp = 10 -name_tp = np.array(["TestParticle_01", "TestParticle_02", "TestParticle_03", "TestParticle_04", "TestParticle_05", "TestParticle_06", "TestParticle_07", "TestParticle_08", "TestParticle_09", "TestParticle_10"]) +name_tp = ["TestParticle_01", "TestParticle_02", "TestParticle_03", "TestParticle_04", "TestParticle_05", "TestParticle_06", "TestParticle_07", "TestParticle_08", "TestParticle_09", "TestParticle_10"] a_tp = default_rng().uniform(0.3, 1.5, ntp) e_tp = default_rng().uniform(0.0, 0.3, ntp) inc_tp = default_rng().uniform(0.0, 90, ntp) From 9b31c06a6fb456aa4df0b687589ef03475508caf Mon Sep 17 00:00:00 2001 From: David Minton Date: Fri, 11 Nov 2022 06:00:43 -0500 Subject: [PATCH 047/569] Moved the CHK_QMIN_HELIO parameter setting into the distance_range setters and getters. Removed the loop style parameters out of the initiation of the param dictionary --- python/swiftest/swiftest/simulation_class.py | 21 +++++++++++++++++--- 1 file changed, 18 insertions(+), 3 deletions(-) diff --git a/python/swiftest/swiftest/simulation_class.py b/python/swiftest/swiftest/simulation_class.py index d98a4ec1b..3f2aaeab6 100644 --- a/python/swiftest/swiftest/simulation_class.py +++ b/python/swiftest/swiftest/simulation_class.py @@ -63,6 +63,7 @@ def __init__(self, TU_name: str | None = None, rmin: float = constants.RSun / constants.AU2M, rmax: float = 10000.0, + qmin_coord: Literal["HELIO","BARY"] = "HELIO", close_encounter_check: bool = True, general_relativity: bool = True, fragmentation: bool = True, @@ -183,6 +184,8 @@ def __init__(self, Minimum distance of the simulation (CHK_QMIN, CHK_RMIN, CHK_QMIN_RANGE[0]) rmax : float, default value is 10000 AU in the unit system defined by the unit input arguments. Maximum distance of the simulation (CHK_RMAX, CHK_QMIN_RANGE[1]) + qmin_coord : str, {"HELIO", "BARY"}, default "HELIO" + coordinate frame to use for CHK_QMIN close_encounter_check : bool, default True Check for close encounters between bodies. If set to True, then the radii of massive bodies must be included in initial conditions. @@ -238,9 +241,6 @@ def __init__(self, self.ds = xr.Dataset() self.param = { '! VERSION': f"Swiftest parameter input", - 'CHK_QMIN_COORD': "HELIO", - 'INTERACTION_LOOPS': interaction_loops, - 'ENCOUNTER_CHECK': encounter_check_loops } self.codename = codename self.verbose = verbose @@ -1402,6 +1402,7 @@ def update_param_units(self, MU2KG_old, DU2M_old, TU2S_old): def set_distance_range(self, rmin: float | None = None, rmax: float | None = None, + qmin_coord: Literal["HELIO","BARY"] | None = None, verbose: bool | None = None, **kwargs: Any): """ @@ -1413,6 +1414,8 @@ def set_distance_range(self, Minimum distance of the simulation (CHK_QMIN, CHK_RMIN, CHK_QMIN_RANGE[0]) rmax : float Maximum distance of the simulation (CHK_RMAX, CHK_QMIN_RANGE[1]) + qmin_coord : str, {"HELIO", "BARY"} + coordinate frame to use for CHK_QMIN **kwargs A dictionary of additional keyword argument. This allows this method to be called by the more general set_parameter method, which takes all possible Simulation parameters as arguments, so these are ignored. @@ -1440,6 +1443,14 @@ def set_distance_range(self, self.param['CHK_EJECT'] = rmax CHK_QMIN_RANGE[1] = rmax update_list.append("rmax") + if qmin_coord is not None: + valid_qmin_coord = ["HELIO","BARY"] + if qmin_coord.upper() not in valid_qmin_coord: + print(f"qmin_coord = {qmin_coord} is not a valid option. Must be one of",','.join(valid_qmin_coord)) + self.param['CHK_QMIN_COORD'] = valid_qmin_coord[0] + else: + self.param['CHK_QMIN_COORD'] = qmin_coord.upper() + update_list.append("qmin_coord") self.param['CHK_QMIN_RANGE'] = f"{CHK_QMIN_RANGE[0]} {CHK_QMIN_RANGE[1]}" @@ -1473,6 +1484,7 @@ def get_distance_range(self, arg_list: str | List[str] | None = None, verbose: b valid_var = {"rmin": "CHK_RMIN", "rmax": "CHK_RMAX", + "qmin_coord": "CHK_QMIN_COORD", "qmin": "CHK_QMIN", "qminR": "CHK_QMIN_RANGE" } @@ -1503,6 +1515,9 @@ def get_distance_range(self, arg_list: str | List[str] | None = None, verbose: b if "rmax" in valid_arg: key = valid_var["rmax"] print(f"{'rmax':<{self._getter_column_width}} {range_dict[key]} {units['rmax']}") + if "qmin_coord" in valid_arg: + key = valid_var["qmin_coord"] + print(f"{'qmin_coord':<{self._getter_column_width}} {range_dict[key]}") return range_dict From f36cb5ae393439aa88b8bf72a7b16e9d1171f1a8 Mon Sep 17 00:00:00 2001 From: David Minton Date: Fri, 11 Nov 2022 07:08:44 -0500 Subject: [PATCH 048/569] Fixed a bunch of bugs in the setters and getters. --- python/swiftest/swiftest/simulation_class.py | 192 +++++++++++++++++-- 1 file changed, 173 insertions(+), 19 deletions(-) diff --git a/python/swiftest/swiftest/simulation_class.py b/python/swiftest/swiftest/simulation_class.py index 3f2aaeab6..1b6509976 100644 --- a/python/swiftest/swiftest/simulation_class.py +++ b/python/swiftest/swiftest/simulation_class.py @@ -35,6 +35,7 @@ class Simulation: def __init__(self, codename: Literal["Swiftest", "Swifter", "Swift"] = "Swiftest", + integrator: Literal["symba","rmvs","whm","helio"] = "symba", param_file: os.PathLike | str = "param.in", read_param: bool = False, t0: float = 0.0, @@ -63,6 +64,10 @@ def __init__(self, TU_name: str | None = None, rmin: float = constants.RSun / constants.AU2M, rmax: float = 10000.0, + gmtiny: float | None = None, + mtiny: float | None = None, + min_fragment_mass: float | None = None, + min_fragment_gmass: float | None = None, qmin_coord: Literal["HELIO","BARY"] = "HELIO", close_encounter_check: bool = True, general_relativity: bool = True, @@ -83,7 +88,9 @@ def __init__(self, Parameters ---------- codename : {"Swiftest", "Swifter", "Swift"}, default "Swiftest" - Name of the n-body integrator that will be used. + Name of the n-body code that will be used. + integrator : {"symba","rmvs","whm","helio"}, default "symba" + Name of the n-body integrator that will be used when executing a run. param_file : str, path-like, or file-lke, default "param.in" Name of the parameter input file that will be passed to the integrator. read_param : bool, default False @@ -92,7 +99,7 @@ def __init__(self, > *Note:* If set to true, the parameters defined in the input file will override any passed into the > arguments of Simulation. t0 : float, default 0.0 - The reference time for the start of the simulation. Defaults is 0.0 + The reference time for the start of the simulation. Defaults is 0.0. tstart : float, default 0.0 The start time for a restarted simulation. For a new simulation, tstart will be set to t0 automatically. tstop : float, optional @@ -106,11 +113,11 @@ def __init__(self, `istep_out = floor(tstep_out/dt)`. *Note*: only `istep_out` or `toutput` can be set. istep_dump : int, optional The anumber of time steps between outputs to dump file. If not set, this will be set to the value of - `istep_out` (or the equivalent value determined by `tstep_out`) + `istep_out` (or the equivalent value determined by `tstep_out`). init_cond_file_type : {"NETCDF_DOUBLE", "NETCDF_FLOAT", "ASCII"}, default "NETCDF_DOUBLE" The file type containing initial conditions for the simulation: - * NETCDF_DOUBLE: A single initial conditions input file in NetCDF file format of type NETCDF_DOUBLE - * NETCDF_FLOAT: A single initial conditions input file in NetCDF file format of type NETCDF_FLOAT + * NETCDF_DOUBLE: A single initial conditions input file in NetCDF file format of type NETCDF_DOUBLE. + * NETCDF_FLOAT: A single initial conditions input file in NetCDF file format of type NETCDF_FLOAT. * ASCII : Three initial conditions files in ASCII format. The individual files define the central body, massive body, and test particle initial conditions. init_cond_file_name : str, path-like, or dict, optional @@ -237,11 +244,8 @@ def __init__(self, If set to True, then more information is printed by Simulation methods as they are executed. Setting to False suppresses most messages other than errors. """ - + self.param = {} self.ds = xr.Dataset() - self.param = { - '! VERSION': f"Swiftest parameter input", - } self.codename = codename self.verbose = verbose self.restart = restart @@ -257,7 +261,9 @@ def __init__(self, else: print(f"{param_file} not found.") - self.set_parameter(t0=t0, + self.set_parameter(codename=codename, + integrator=integrator, + t0=t0, tstart=tstart, tstop=tstop, dt=dt, @@ -265,6 +271,7 @@ def __init__(self, istep_out=istep_out, istep_dump=istep_dump, rmin=rmin, rmax=rmax, + qmin_coord=qmin_coord, MU=MU, DU=DU, TU=TU, MU2KG=MU2KG, DU2M=DU2M, TU2S=TU2S, MU_name=MU_name, DU_name=DU_name, TU_name=TU_name, @@ -284,6 +291,8 @@ def __init__(self, big_discard=big_discard, rhill_present=rhill_present, restart=restart, + interaction_loops=interaction_loops, + encounter_check_loops=encounter_check_loops, ephemeris_date=ephemeris_date, verbose=False) @@ -543,6 +552,7 @@ def set_parameter(self, **kwargs): # Non-returning setters self.set_ephemeris_date(**kwargs) + self.set_integrator(**kwargs) return param_dict @@ -559,6 +569,8 @@ def get_parameter(self, **kwargs): """ + self.get_integrator(**kwargs) + # Getters returning parameter dictionary values param_dict = self.get_simulation_time(**kwargs) param_dict.update(self.get_init_cond_files(**kwargs)) @@ -567,12 +579,109 @@ def get_parameter(self, **kwargs): param_dict.update(self.get_unit_system(**kwargs)) param_dict.update(self.get_feature(**kwargs)) - # Non-returning getters - if not bool(kwargs) or "ephemeris_date" in kwargs: - self.get_ephemeris_date(**kwargs) + self.get_ephemeris_date(**kwargs) return param_dict + def set_integrator(self, + codename: Literal["swiftest", "swifter", "swift"] | None = None, + integrator: Literal["symba","rmvs","whm","helio"] | None = None, + verbose: bool | None = None, + **kwargs: Any + ): + """ + + Parameters + ---------- + codename : {"swiftest", "swifter", "swift"}, optional + integrator : {"symba","rmvs","whm","helio"}, optional + Name of the n-body integrator that will be used when executing a run. + verbose: bool, optional + If passed, it will override the Simulation object's verbose flag + **kwargs + A dictionary of additional keyword argument. This allows this method to be called by the more general + set_parameter method, which takes all possible Simulation parameters as arguments, so these are ignored. + + Returns + ------- + None + + """ + + if integrator is None and codename is None: + return + + if codename is not None: + valid_codename = ["swiftest", "swifter", "swift"] + if codename.lower() not in valid_codename: + print(f"{codename} is not a valid codename. Valid options are ",",".join(valid_codename)) + try: + self.codename + except: + self.codename = valid_codename[0] + else: + self.codename = codename.lower() + + self.param['! VERSION'] = f"{self.codename.title()} parameter input" + + if integrator is not None: + valid_integrator = ["symba","rmvs","whm","helio"] + if integrator.lower() not in valid_integrator: + print(f"{integrator} is not a valid integrator. Valid options are ",",".join(valid_integrator)) + try: + self.integrator + except: + self.integrator = valid_integrator[0] + else: + self.integrator = integrator.lower() + + self.get_integrator("integrator", verbose) + + return + + def get_integrator(self,arg_list: str | List[str] | None = None, verbose: bool | None = None, **kwargs: Any): + """ + + Returns a subset of the parameter dictionary containing the current values of the distance range parameters. + If the verbose option is set in the Simulation object, then it will also print the values. + + Parameters + ---------- + arg_list: str | List[str], optional + A single string or list of strings containing the names of the features to extract. Default is all of: + ["integrator"] + verbose: bool, optional + If passed, it will override the Simulation object's verbose flag + **kwargs + A dictionary of additional keyword argument. This allows this method to be called by the more general + get_parameter method, which takes all possible Simulation parameters as arguments, so these are ignored. + + Returns + ------- + integrator: str, + The integrator name. + """ + + try: + self.integrator + except: + print(f"integrator is not set") + return + + try: + self.codename + except: + print(f"codename is not set") + return + + valid_arg = {"integrator": self.integrator, + "codename": self.codename} + + if not bool(kwargs) and arg_list is None: + arg_list = list(valid_arg.keys()) + ephemeris_date = self._get_instance_var(arg_list, valid_arg, verbose, **kwargs) + return + def set_feature(self, close_encounter_check: bool | None = None, general_relativity: bool | None = None, @@ -705,8 +814,10 @@ def set_feature(self, if interaction_loops not in valid_vals: print(f"{interaction_loops} is not a valid option for interaction loops.") print(f"Must be one of {valid_vals}") - self.param["INTERACTION_LOOPS"] = interaction_loops + if "INTERACTION_LOOPS" not in self.param: + self.param["INTERACTION_LOOPS"] = valid_vals[0] else: + self.param["INTERACTION_LOOPS"] = interaction_loops update_list.append("interaction_loops") if encounter_check_loops is not None: @@ -714,6 +825,8 @@ def set_feature(self, if encounter_check_loops not in valid_vals: print(f"{encounter_check_loops} is not a valid option for interaction loops.") print(f"Must be one of {valid_vals}") + if "ENCOUNTER_CHECK" not in self.param: + self.param["ENCOUNTER_CHECK"] = valid_vals[0] else: self.param["ENCOUNTER_CHECK"] = encounter_check_loops update_list.append("encounter_check_loops") @@ -1701,13 +1814,16 @@ def set_ephemeris_date(self, return ephemeris_date - def get_ephemeris_date(self, verbose: bool | None = None, **kwargs: Any): + def get_ephemeris_date(self, arg_list: str | List[str] | None = None, verbose: bool | None = None, **kwargs: Any): """ Prints the current value of the ephemeris date Parameters ---------- + arg_list: str | List[str], optional + A single string or list of strings containing the names of the features to extract. Default is all of: + ["integrator"] verbose: bool, optional If passed, it will override the Simulation object's verbose flag **kwargs @@ -1720,16 +1836,54 @@ def get_ephemeris_date(self, verbose: bool | None = None, **kwargs: Any): The ISO-formatted date string for the ephemeris computation """ - if self.ephemeris_date is None: + + try: + self.ephemeris_date + except: print(f"ephemeris_date is not set") return + valid_arg = {"ephemeris_date": self.ephemeris_date} + + ephemeris_date = self._get_instance_var(arg_list, valid_arg,verbose, **kwargs) + + return ephemeris_date + + def _get_instance_var(self, arg_list: str | List[str], valid_arg: Dict, verbose: bool | None = None, **kwargs: Any): + """ + + Prints the current value of an instance variable. + + Parameters + ---------- + arg_list: str | List[str] + A single string or list of strings containing the names of the the instance variable to get. + valid_arg: dict + A dictionary where the key is the parameter argument and the value is the equivalent instance variable value. + verbose: bool, optional + If passed, it will override the Simulation object's verbose flag + **kwargs + A dictionary of additional keyword argument. This allows this method to be called by the more general + get_parameter method, which takes all possible Simulation parameters as arguments, so these are ignored. + + Returns + ------- + Tuple of instance variable values given by the arg_list + + """ + + arg_vals = [] if verbose is None: verbose = self.verbose if verbose: - print(f"{'ephemeris_date':<{self._getter_column_width}} {self.ephemeris_date}") - - return self.ephemeris_date + if arg_list is None: + arg_list = list(valid_arg.keys()) + for arg in arg_list: + if arg in valid_arg: + print(f"{arg:<{self._getter_column_width}} {valid_arg[arg]}") + arg_vals.append(valid_arg[arg]) + + return tuple(arg_vals) def add_body(self, name: str | List[str] | npt.NDArray[np.str_], From e8e3dafcc36725d2bb35c7eac7b85fb2d96ee7d2 Mon Sep 17 00:00:00 2001 From: David Minton Date: Fri, 11 Nov 2022 08:35:51 -0500 Subject: [PATCH 049/569] Improvements to API handling of integrators and codes. --- python/swiftest/swiftest/simulation_class.py | 66 +++++++++++++------- 1 file changed, 44 insertions(+), 22 deletions(-) diff --git a/python/swiftest/swiftest/simulation_class.py b/python/swiftest/swiftest/simulation_class.py index 1b6509976..a731603ce 100644 --- a/python/swiftest/swiftest/simulation_class.py +++ b/python/swiftest/swiftest/simulation_class.py @@ -246,7 +246,6 @@ def __init__(self, """ self.param = {} self.ds = xr.Dataset() - self.codename = codename self.verbose = verbose self.restart = restart @@ -257,7 +256,7 @@ def __init__(self, self.sim_dir = os.path.dirname(os.path.realpath(param_file)) if read_param: if os.path.exists(param_file): - self.read_param(param_file, codename=codename, verbose=self.verbose) + self.read_param(param_file, codename=codename.title(), verbose=self.verbose) else: print(f"{param_file} not found.") @@ -543,7 +542,9 @@ def set_parameter(self, **kwargs): """ # Setters returning parameter dictionary values - param_dict = self.set_unit_system(**kwargs) + param_dict = {} + param_dict.update(self.set_integrator(**kwargs)) + param_dict.update(self.set_unit_system(**kwargs)) param_dict.update(self.set_distance_range(**kwargs)) param_dict.update(self.set_feature(**kwargs)) param_dict.update(self.set_init_cond_files(**kwargs)) @@ -552,7 +553,6 @@ def set_parameter(self, **kwargs): # Non-returning setters self.set_ephemeris_date(**kwargs) - self.set_integrator(**kwargs) return param_dict @@ -569,10 +569,11 @@ def get_parameter(self, **kwargs): """ - self.get_integrator(**kwargs) # Getters returning parameter dictionary values - param_dict = self.get_simulation_time(**kwargs) + param_dict = {} + param_dict.update(self.get_integrator(**kwargs)) + param_dict.update(self.get_simulation_time(**kwargs)) param_dict.update(self.get_init_cond_files(**kwargs)) param_dict.update(self.get_output_files(**kwargs)) param_dict.update(self.get_distance_range(**kwargs)) @@ -611,18 +612,21 @@ def set_integrator(self, if integrator is None and codename is None: return + update_list = [] + if codename is not None: - valid_codename = ["swiftest", "swifter", "swift"] - if codename.lower() not in valid_codename: + valid_codename = ["Swiftest", "Swifter", "Swift"] + if codename.title() not in valid_codename: print(f"{codename} is not a valid codename. Valid options are ",",".join(valid_codename)) try: self.codename except: self.codename = valid_codename[0] else: - self.codename = codename.lower() + self.codename = codename.title() - self.param['! VERSION'] = f"{self.codename.title()} parameter input" + self.param['! VERSION'] = f"{self.codename} parameter input" + update_list.append("codename") if integrator is not None: valid_integrator = ["symba","rmvs","whm","helio"] @@ -634,10 +638,11 @@ def set_integrator(self, self.integrator = valid_integrator[0] else: self.integrator = integrator.lower() + update_list.append("integrator") - self.get_integrator("integrator", verbose) + integrator_dict = self.get_integrator(update_list, verbose) - return + return integrator_dict def get_integrator(self,arg_list: str | List[str] | None = None, verbose: bool | None = None, **kwargs: Any): """ @@ -658,29 +663,45 @@ def get_integrator(self,arg_list: str | List[str] | None = None, verbose: bool | Returns ------- - integrator: str, - The integrator name. + integrator_dict : dict + The subset of the dictionary containing the code name if codename is selected """ + valid_var = {"codename": "! VERSION"} + + valid_instance_vars = {"integrator": self.integrator, + "codename": self.codename} + try: self.integrator except: print(f"integrator is not set") - return + return {} try: self.codename except: print(f"codename is not set") - return + return {} - valid_arg = {"integrator": self.integrator, - "codename": self.codename} if not bool(kwargs) and arg_list is None: - arg_list = list(valid_arg.keys()) - ephemeris_date = self._get_instance_var(arg_list, valid_arg, verbose, **kwargs) - return + arg_list = list(valid_instance_vars.keys()) + integrator = self._get_instance_var(arg_list, valid_instance_vars, verbose, **kwargs) + + valid_arg, integrator_dict = self._get_valid_arg_list(arg_list, valid_var) + + if verbose is None: + verbose = self.verbose + + if verbose: + for arg in arg_list: + if arg in valid_arg: + key = valid_var[arg] + print(f"{arg:<{self._getter_column_width}} {integrator_dict[key]}") + elif arg in valid_instance_vars: + print(f"{arg:<{self._getter_column_width}} {valid_instance_vars[arg]}") + return integrator_dict def set_feature(self, close_encounter_check: bool | None = None, @@ -963,7 +984,7 @@ def ascii_file_input_error_msg(codename): else: init_cond_file_type = "NETCDF_DOUBLE" - if self.codename == "Swiftest": + if self.codename.title() == "Swiftest": init_cond_keys = ["CB", "PL", "TP"] else: init_cond_keys = ["PL", "TP"] @@ -1057,6 +1078,7 @@ def get_init_cond_files(self, arg_list: str | List[str] | None = None, verbose: if self.codename == "Swifter": three_file_args.remove("init_cond_file_name['CB']") + valid_var.pop("init_cond_file_name['CB']",None) # We have to figure out which initial conditions file model we are using (1 vs. 3 files) if arg_list is None: From eee8bc6c1fbdacd226411cd0c4e82317919201ff Mon Sep 17 00:00:00 2001 From: David Minton Date: Fri, 11 Nov 2022 09:56:18 -0500 Subject: [PATCH 050/569] Started the process of adding the executable to the Simulation class so that simulations can actually be run from inside Python --- python/swiftest/swiftest/simulation_class.py | 27 ++++++++++++-------- 1 file changed, 16 insertions(+), 11 deletions(-) diff --git a/python/swiftest/swiftest/simulation_class.py b/python/swiftest/swiftest/simulation_class.py index a731603ce..ff8806c6b 100644 --- a/python/swiftest/swiftest/simulation_class.py +++ b/python/swiftest/swiftest/simulation_class.py @@ -14,6 +14,7 @@ from swiftest import init_cond from swiftest import tool from swiftest import constants +from swiftest import __file__ as _pyfile import os import datetime import xarray as xr @@ -605,9 +606,11 @@ def set_integrator(self, Returns ------- - None + integrator_dict: dict + A dictionary containing the subset of the parameter dictonary that was updated by this setter """ + # TODO: Improve how it finds the executable binary if integrator is None and codename is None: return @@ -627,6 +630,13 @@ def set_integrator(self, self.param['! VERSION'] = f"{self.codename} parameter input" update_list.append("codename") + if self.codename == "Swiftest": + self.binary_path = os.path.realpath(os.path.join(os.path.dirname(os.path.realpath(_pyfile)),os.pardir,os.pardir,os.pardir,"build")) + self.driver_executable = os.path.join(self.binary_path,"swiftest_driver") + else: + self.binary_path = "NOT SET" + self.driver_executable = "NOT SET" + update_list.append("driver_executable") if integrator is not None: valid_integrator = ["symba","rmvs","whm","helio"] @@ -670,7 +680,8 @@ def get_integrator(self,arg_list: str | List[str] | None = None, verbose: bool | valid_var = {"codename": "! VERSION"} valid_instance_vars = {"integrator": self.integrator, - "codename": self.codename} + "codename": self.codename, + "driver_executable": self.driver_executable} try: self.integrator @@ -684,23 +695,17 @@ def get_integrator(self,arg_list: str | List[str] | None = None, verbose: bool | print(f"codename is not set") return {} + if verbose is None: + verbose = self.verbose if not bool(kwargs) and arg_list is None: arg_list = list(valid_instance_vars.keys()) + integrator = self._get_instance_var(arg_list, valid_instance_vars, verbose, **kwargs) valid_arg, integrator_dict = self._get_valid_arg_list(arg_list, valid_var) - if verbose is None: - verbose = self.verbose - if verbose: - for arg in arg_list: - if arg in valid_arg: - key = valid_var[arg] - print(f"{arg:<{self._getter_column_width}} {integrator_dict[key]}") - elif arg in valid_instance_vars: - print(f"{arg:<{self._getter_column_width}} {valid_instance_vars[arg]}") return integrator_dict def set_feature(self, From cd0d93f3b52ec2dd515a096697be55749bd321eb Mon Sep 17 00:00:00 2001 From: David Minton Date: Fri, 11 Nov 2022 16:10:06 -0500 Subject: [PATCH 051/569] Updated test Notebook --- examples/Basic_Simulation/test_io.ipynb | 143 ++++++++++++++++++++++++ 1 file changed, 143 insertions(+) create mode 100644 examples/Basic_Simulation/test_io.ipynb diff --git a/examples/Basic_Simulation/test_io.ipynb b/examples/Basic_Simulation/test_io.ipynb new file mode 100644 index 000000000..ce92a8229 --- /dev/null +++ b/examples/Basic_Simulation/test_io.ipynb @@ -0,0 +1,143 @@ +{ + "cells": [ + { + "cell_type": "code", + "execution_count": 1, + "id": "86c845ce-1801-46ca-8a8a-1cabb266e6a6", + "metadata": {}, + "outputs": [], + "source": [ + "import swiftest\n", + "import xarray as xr\n", + "import numpy as np\n", + "import os" + ] + }, + { + "cell_type": "code", + "execution_count": 2, + "id": "d716c371-8eb4-4fc1-82af-8b5c444c831e", + "metadata": {}, + "outputs": [], + "source": [ + "sim = swiftest.Simulation()" + ] + }, + { + "cell_type": "code", + "execution_count": 3, + "id": "83cebbc1-387b-4ef5-b96e-76856b6672e5", + "metadata": {}, + "outputs": [ + { + "name": "stdout", + "output_type": "stream", + "text": [ + "integrator symba\n", + "codename Swiftest\n", + "driver_executable /Users/daminton/git/swiftest/build/swiftest_driver\n", + "t0 0.0 y\n", + "tstart 0.0 y\n", + "tstop NOT SET\n", + "dt NOT SET\n", + "istep_out NOT SET\n", + "istep_dump NOT SET\n", + "init_cond_file_type NETCDF_DOUBLE\n", + "init_cond_format EL\n", + "init_cond_file_name init_cond.nc\n", + "output_file_type NETCDF_DOUBLE\n", + "output_file_name bin.nc\n", + "output_format XVEL\n", + "rmin 0.004650467260962157 AU\n", + "rmax 10000.0 AU\n", + "qmin_coord HELIO\n", + "MU: MSun 1.988409870698051e+30 kg / MSun\n", + "DU: AU 149597870700.0 m / AU\n", + "TU: y 31557600.0 s / y\n", + "close_encounter_check True\n", + "general_relativity True\n", + "fragmentation True\n", + "rotation True\n", + "compute_conservation_values False\n", + "extra_force False\n", + "big_discard False\n", + "rhill_present False\n", + "restart False\n", + "interaction_loops TRIANGULAR\n", + "encounter_check_loops TRIANGULAR\n", + "ephemeris_date 2027-04-30\n" + ] + }, + { + "data": { + "text/plain": [ + "{'! VERSION': 'Swiftest parameter input',\n", + " 'T0': 0.0,\n", + " 'TSTART': 0.0,\n", + " 'IN_TYPE': 'NETCDF_DOUBLE',\n", + " 'IN_FORM': 'EL',\n", + " 'NC_IN': 'init_cond.nc',\n", + " 'OUT_TYPE': 'NETCDF_DOUBLE',\n", + " 'BIN_OUT': 'bin.nc',\n", + " 'OUT_FORM': 'XVEL',\n", + " 'CHK_RMIN': 0.004650467260962157,\n", + " 'CHK_RMAX': 10000.0,\n", + " 'CHK_QMIN_COORD': 'HELIO',\n", + " 'CHK_QMIN': 0.004650467260962157,\n", + " 'CHK_QMIN_RANGE': '0.004650467260962157 10000.0',\n", + " 'MU2KG': 1.988409870698051e+30,\n", + " 'DU2M': 149597870700.0,\n", + " 'TU2S': 31557600.0,\n", + " 'CHK_CLOSE': True,\n", + " 'GR': True,\n", + " 'FRAGMENTATION': True,\n", + " 'ROTATION': True,\n", + " 'ENERGY': False,\n", + " 'EXTRA_FORCE': False,\n", + " 'BIG_DISCARD': False,\n", + " 'RHILL_PRESENT': False,\n", + " 'RESTART': False,\n", + " 'INTERACTION_LOOPS': 'TRIANGULAR',\n", + " 'ENCOUNTER_CHECK': 'TRIANGULAR'}" + ] + }, + "execution_count": 3, + "metadata": {}, + "output_type": "execute_result" + } + ], + "source": [ + "sim.get_parameter()" + ] + }, + { + "cell_type": "code", + "execution_count": null, + "id": "ec7452d6-4c9b-4df3-acc0-b11c32264b91", + "metadata": {}, + "outputs": [], + "source": [] + } + ], + "metadata": { + "kernelspec": { + "display_name": "Python 3 (ipykernel)", + "language": "python", + "name": "python3" + }, + "language_info": { + "codemirror_mode": { + "name": "ipython", + "version": 3 + }, + "file_extension": ".py", + "mimetype": "text/x-python", + "name": "python", + "nbconvert_exporter": "python", + "pygments_lexer": "ipython3", + "version": "3.9.13" + } + }, + "nbformat": 4, + "nbformat_minor": 5 +} From f5abde23052bb3fb49d0f50a47c5fb90459be715 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Fri, 11 Nov 2022 17:37:33 -0500 Subject: [PATCH 052/569] Added minimum fragment mass to feature setter and getter when enabling fragmentation --- .../Basic_Simulation/initial_conditions.py | 5 +- python/swiftest/swiftest/simulation_class.py | 59 ++++++++++++++++--- 2 files changed, 54 insertions(+), 10 deletions(-) diff --git a/examples/Basic_Simulation/initial_conditions.py b/examples/Basic_Simulation/initial_conditions.py index 1edc13879..b7c6a323c 100644 --- a/examples/Basic_Simulation/initial_conditions.py +++ b/examples/Basic_Simulation/initial_conditions.py @@ -30,11 +30,10 @@ from numpy.random import default_rng # Initialize the simulation object as a variable -sim = swiftest.Simulation() -sim.set_simulation_time(tstart=0.0, tstop=10.0, dt=0.005, tstep_out=1.0) +sim = swiftest.Simulation(tstart=0.0, tstop=10.0, dt=0.005, tstep_out=1.0, fragmentation=True, minimum_fragment_gmass = 1e-9) +sim.get_parameter() # Add parameter attributes to the simulation object sim.param['GMTINY'] = 1e-6 -sim.param['MIN_GMFRAG'] = 1e-9 # 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"]) diff --git a/python/swiftest/swiftest/simulation_class.py b/python/swiftest/swiftest/simulation_class.py index ff8806c6b..a359f8caa 100644 --- a/python/swiftest/swiftest/simulation_class.py +++ b/python/swiftest/swiftest/simulation_class.py @@ -67,12 +67,12 @@ def __init__(self, rmax: float = 10000.0, gmtiny: float | None = None, mtiny: float | None = None, - min_fragment_mass: float | None = None, - min_fragment_gmass: float | None = None, qmin_coord: Literal["HELIO","BARY"] = "HELIO", close_encounter_check: bool = True, general_relativity: bool = True, - fragmentation: bool = True, + fragmentation: bool = False, + minimum_fragment_mass: float | None = None, + minimum_fragment_gmass: float | None = None, rotation: bool = True, compute_conservation_values: bool = False, extra_force: bool = False, @@ -202,6 +202,12 @@ def __init__(self, fragmentation : bool, default True If set to True, this turns on the Fraggle fragment generation code and `rotation` must also be True. This argument only applies to Swiftest-SyMBA simulations. It will be ignored otherwise. + minimum_fragment_gmass : float, optional + If fragmentation is turned on, this sets the mimimum G*mass of a collisional fragment that can be generated. + *Note.* Only set one of minimum_fragment_gmass or minimum_fragment_mass + minimum_fragment_mass : float, optional + If fragmentation is turned on, this sets the mimimum mass of a collisional fragment that can be generated. + *Note.* Only set one of minimum_fragment_gmass or minimum_fragment_mass rotation : bool, default True If set to True, this turns on rotation tracking and radius, rotation vector, and moments of inertia values must be included in the initial conditions. @@ -285,6 +291,8 @@ def __init__(self, close_encounter_check=close_encounter_check, general_relativity=general_relativity, fragmentation=fragmentation, + minimum_fragment_gmass=minimum_fragment_gmass, + minimum_fragment_mass=minimum_fragment_mass, rotation=rotation, compute_conservation_values=compute_conservation_values, extra_force=extra_force, @@ -712,6 +720,8 @@ def set_feature(self, close_encounter_check: bool | None = None, general_relativity: bool | None = None, fragmentation: bool | None = None, + minimum_fragment_gmass: float | None = None, + minimum_fragment_mass: float | None = None, rotation: bool | None = None, compute_conservation_values: bool | None = None, extra_force: bool | None = None, @@ -737,6 +747,12 @@ def set_feature(self, fragmentation : bool, optional If set to True, this turns on the Fraggle fragment generation code and `rotation` must also be True. This argument only applies to Swiftest-SyMBA simulations. It will be ignored otherwise. + minimum_fragment_gmass : float, optional + If fragmentation is turned on, this sets the mimimum G*mass of a collisional fragment that can be generated. + *Note.* Only set one of minimum_fragment_gmass or minimum_fragment_mass + minimum_fragment_mass : float, optional + If fragmentation is turned on, this sets the mimimum mass of a collisional fragment that can be generated. + *Note.* Only set one of minimum_fragment_gmass or minimum_fragment_mass rotation : bool, optional If set to True, this turns on rotation tracking and radius, rotation vector, and moments of inertia values must be included in the initial conditions. @@ -805,8 +821,27 @@ def set_feature(self, update_list.append("general_relativity") if fragmentation is not None: - self.param['FRAGMENTATION'] = fragmentation - update_list.append("fragmentation") + if self.codename != "Swiftest" and self.integrator != "symba" and fragmentation: + print("Fragmentation is only available on Swiftest SyMBA.") + self.param['FRAGMENTATION'] = False + else: + self.param['FRAGMENTATION'] = fragmentation + update_list.append("fragmentation") + if fragmentation: + if "MIN_GMFRAG" not in self.param and minimum_fragment_mass is None and minimum_fragment_gmass is None: + print("Minimum fragment mass is not set. Set it using minimum_fragment_gmass or minimum_fragment_mass") + else: + update_list.append("minimum_fragment_gmass") + update_list.append("minimum_fragment_mass") + if minimum_fragment_gmass is not None and minimum_fragment_mass is not None: + print("Warning! Only set either minimum_fragment_mass or minimum_fragment_gmass, but not both!") + + if minimum_fragment_gmass is not None: + self.param["MIN_GMFRAG"] = minimum_fragment_gmass + update_list.append("minimum_fragment_gmass") + elif minimum_fragment_mass is not None: + self.param["MIN_GMFRAG"] = minimum_fragment_mass * self.GU + update_list.append("minimum_fragment_gmass") if rotation is not None: self.param['ROTATION'] = rotation @@ -896,7 +931,8 @@ def get_feature(self, arg_list: str | List[str] | None = None, verbose: bool | N "rhill_present": "RHILL_PRESENT", "restart": "RESTART", "interaction_loops": "INTERACTION_LOOPS", - "encounter_check_loops": "ENCOUNTER_CHECK" + "encounter_check_loops": "ENCOUNTER_CHECK", + "minimum_fragment_gmass" : "MIN_GMFRAG" } valid_arg, feature_dict = self._get_valid_arg_list(arg_list, valid_var) @@ -907,7 +943,16 @@ def get_feature(self, arg_list: str | List[str] | None = None, verbose: bool | N if verbose: for arg in valid_arg: key = valid_var[arg] - print(f"{arg:<{self._getter_column_width}} {feature_dict[key]}") + if key in feature_dict: + if arg == "minimum_fragment_gmass": + if self.param['FRAGMENTATION']: + print(f"{arg:<{self._getter_column_width}} {feature_dict[key]} {self.DU_name}^3 / {self.TU_name}^2 ") + print(f"{'minimum_fragment_mass':<{self._getter_column_width}} {feature_dict[key] / self.GU} {self.MU_name}") + else: + print(f"{arg:<{self._getter_column_width}} {feature_dict[key]}") + else: + print(f"{arg:<{self._getter_column_width}} NOT SET") + return feature_dict From c6e5f4537ec8b322b9ff1c9de9dccebfb8c32455 Mon Sep 17 00:00:00 2001 From: David Minton Date: Fri, 11 Nov 2022 19:38:31 -0500 Subject: [PATCH 053/569] Added gmtiny and mtiny as parameter options. changed the initial conditions generator to use mass instead of G*mass values. --- .../Basic_Simulation/initial_conditions.py | 4 +- python/swiftest/swiftest/simulation_class.py | 51 +++++++++++++++++-- 2 files changed, 48 insertions(+), 7 deletions(-) diff --git a/examples/Basic_Simulation/initial_conditions.py b/examples/Basic_Simulation/initial_conditions.py index b7c6a323c..91471fd7f 100644 --- a/examples/Basic_Simulation/initial_conditions.py +++ b/examples/Basic_Simulation/initial_conditions.py @@ -30,10 +30,8 @@ from numpy.random import default_rng # Initialize the simulation object as a variable -sim = swiftest.Simulation(tstart=0.0, tstop=10.0, dt=0.005, tstep_out=1.0, fragmentation=True, minimum_fragment_gmass = 1e-9) +sim = swiftest.Simulation(tstart=0.0, tstop=10.0, dt=0.005, tstep_out=1.0, fragmentation=True, minimum_fragment_mass = 2.5e-11, mtiny=2.5e-8) sim.get_parameter() -# Add parameter attributes to the simulation object -sim.param['GMTINY'] = 1e-6 # 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"]) diff --git a/python/swiftest/swiftest/simulation_class.py b/python/swiftest/swiftest/simulation_class.py index a359f8caa..c194729f8 100644 --- a/python/swiftest/swiftest/simulation_class.py +++ b/python/swiftest/swiftest/simulation_class.py @@ -65,9 +65,9 @@ def __init__(self, TU_name: str | None = None, rmin: float = constants.RSun / constants.AU2M, rmax: float = 10000.0, + qmin_coord: Literal["HELIO","BARY"] = "HELIO", gmtiny: float | None = None, mtiny: float | None = None, - qmin_coord: Literal["HELIO","BARY"] = "HELIO", close_encounter_check: bool = True, general_relativity: bool = True, fragmentation: bool = False, @@ -194,6 +194,12 @@ def __init__(self, Maximum distance of the simulation (CHK_RMAX, CHK_QMIN_RANGE[1]) qmin_coord : str, {"HELIO", "BARY"}, default "HELIO" coordinate frame to use for CHK_QMIN + mtiny : float, optional + The minimum mass of fully interacting bodies. Bodies below this mass interact with the larger bodies, + but not each other (SyMBA only). *Note.* Only mtiny or gmtiny is accepted, not both. + gmtiny : float, optional + The minimum G*mass of fully interacting bodies. Bodies below this mass interact with the larger bodies, + but not each other (SyMBA only). *Note.* Only mtiny or gmtiny is accepted, not both. close_encounter_check : bool, default True Check for close encounters between bodies. If set to True, then the radii of massive bodies must be included in initial conditions. @@ -278,6 +284,8 @@ def __init__(self, istep_dump=istep_dump, rmin=rmin, rmax=rmax, qmin_coord=qmin_coord, + gmtiny=gmtiny, + mtiny=mtiny, MU=MU, DU=DU, TU=TU, MU2KG=MU2KG, DU2M=DU2M, TU2S=TU2S, MU_name=MU_name, DU_name=DU_name, TU_name=TU_name, @@ -552,8 +560,8 @@ def set_parameter(self, **kwargs): # Setters returning parameter dictionary values param_dict = {} - param_dict.update(self.set_integrator(**kwargs)) param_dict.update(self.set_unit_system(**kwargs)) + param_dict.update(self.set_integrator(**kwargs)) param_dict.update(self.set_distance_range(**kwargs)) param_dict.update(self.set_feature(**kwargs)) param_dict.update(self.set_init_cond_files(**kwargs)) @@ -596,6 +604,8 @@ def get_parameter(self, **kwargs): def set_integrator(self, codename: Literal["swiftest", "swifter", "swift"] | None = None, integrator: Literal["symba","rmvs","whm","helio"] | None = None, + mtiny: float | None = None, + gmtiny: float | None = None, verbose: bool | None = None, **kwargs: Any ): @@ -606,6 +616,12 @@ def set_integrator(self, codename : {"swiftest", "swifter", "swift"}, optional integrator : {"symba","rmvs","whm","helio"}, optional Name of the n-body integrator that will be used when executing a run. + mtiny : float, optional + The minimum mass of fully interacting bodies. Bodies below this mass interact with the larger bodies, + but not each other (SyMBA only). *Note.* Only mtiny or gmtiny is accepted, not both. + gmtiny : float, optional + The minimum G*mass of fully interacting bodies. Bodies below this mass interact with the larger bodies, + but not each other (SyMBA only). *Note.* Only mtiny or gmtiny is accepted, not both. verbose: bool, optional If passed, it will override the Simulation object's verbose flag **kwargs @@ -658,6 +674,18 @@ def set_integrator(self, self.integrator = integrator.lower() update_list.append("integrator") + if mtiny is not None or gmtiny is not None: + if self.integrator != "symba": + print("mtiny and gmtiny are only used by SyMBA.") + if mtiny is not None and gmtiny is not None: + print("Only set mtiny or gmtiny, not both!") + elif gmtiny is not None: + self.param['GMTINY'] = gmtiny + update_list.append("gmtiny") + elif mtiny is not None: + self.param['GMTINY'] = self.GU * mtiny + update_list.append("gmtiny") + integrator_dict = self.get_integrator(update_list, verbose) return integrator_dict @@ -685,7 +713,8 @@ def get_integrator(self,arg_list: str | List[str] | None = None, verbose: bool | The subset of the dictionary containing the code name if codename is selected """ - valid_var = {"codename": "! VERSION"} + valid_var = {"codename": "! VERSION", + "gmtiny" : "GMTINY"} valid_instance_vars = {"integrator": self.integrator, "codename": self.codename, @@ -708,11 +737,25 @@ def get_integrator(self,arg_list: str | List[str] | None = None, verbose: bool | if not bool(kwargs) and arg_list is None: arg_list = list(valid_instance_vars.keys()) - + arg_list.append(*[a for a in valid_var.keys() if a not in valid_instance_vars]) + integrator = self._get_instance_var(arg_list, valid_instance_vars, verbose, **kwargs) valid_arg, integrator_dict = self._get_valid_arg_list(arg_list, valid_var) + if verbose: + for arg in valid_arg: + key = valid_var[arg] + if key in integrator_dict: + if arg == "gmtiny": + if self.integrator == "symba": + print(f"{arg:<{self._getter_column_width}} {integrator_dict[key]} {self.DU_name}^3 / {self.TU_name}^2 ") + print(f"{'mtiny':<{self._getter_column_width}} {integrator_dict[key] / self.GU} {self.MU_name}") + else: + print(f"{arg:<{self._getter_column_width}} {integrator_dict[key]}") + else: + print(f"{arg:<{self._getter_column_width}} NOT SET") + return integrator_dict From dc508d4706c3e97c3fdcd27d1e4d2ed49ba84137 Mon Sep 17 00:00:00 2001 From: Carlisle Wishard Date: Mon, 14 Nov 2022 10:28:08 -0500 Subject: [PATCH 054/569] moved j2rp2 and j4rp4 from required to variables that the user doesn't need to know about in netcdf_open --- src/netcdf/netcdf.f90 | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/src/netcdf/netcdf.f90 b/src/netcdf/netcdf.f90 index 788f58beb..156d0caac 100644 --- a/src/netcdf/netcdf.f90 +++ b/src/netcdf/netcdf.f90 @@ -372,8 +372,6 @@ module subroutine netcdf_open(self, param, readonly) call check( nf90_inq_varid(self%ncid, PTYPE_VARNAME, self%ptype_varid), "netcdf_open nf90_inq_varid ptype_varid" ) call check( nf90_inq_varid(self%ncid, STATUS_VARNAME, self%status_varid), "netcdf_open nf90_inq_varid status_varid" ) call check( nf90_inq_varid(self%ncid, GMASS_VARNAME, self%Gmass_varid), "netcdf_open nf90_inq_varid Gmass_varid" ) - call check( nf90_inq_varid(self%ncid, J2RP2_VARNAME, self%j2rp2_varid), "netcdf_open nf90_inq_varid j2rp2_varid" ) - call check( nf90_inq_varid(self%ncid, J4RP4_VARNAME, self%j4rp4_varid), "netcdf_open nf90_inq_varid j4rp4_varid" ) 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" ) @@ -450,6 +448,9 @@ module subroutine netcdf_open(self, param, readonly) ! Variables The User Doesn't Need to Know About + status = nf90_inq_varid(self%ncid, J2RP2_VARNAME, self%j2rp2_varid) + status = nf90_inq_varid(self%ncid, J4RP4_VARNAME, self%j4rp4_varid) + 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) From d8209242d5cbb85a01faa2b6f6d5a37ddafa847e Mon Sep 17 00:00:00 2001 From: Carlisle Wishard Date: Mon, 14 Nov 2022 10:28:50 -0500 Subject: [PATCH 055/569] if j2rp2 or j4rp4 are not found, set them to 0. if they are found, get the value --- src/netcdf/netcdf.f90 | 17 ++++++++++++++--- 1 file changed, 14 insertions(+), 3 deletions(-) diff --git a/src/netcdf/netcdf.f90 b/src/netcdf/netcdf.f90 index 156d0caac..c4cd12042 100644 --- a/src/netcdf/netcdf.f90 +++ b/src/netcdf/netcdf.f90 @@ -505,7 +505,7 @@ module function netcdf_read_frame_system(self, iu, param) result(ierr) ! 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 + integer(I4B) :: tslot, idmax, npl_check, ntp_check, nplm_check, t_max, str_max, status real(DP), dimension(:), allocatable :: rtemp integer(I4B), dimension(:), allocatable :: itemp logical, dimension(:), allocatable :: validmask, tpmask, plmask @@ -717,8 +717,19 @@ module function netcdf_read_frame_system(self, iu, param) result(ierr) ! if (npl > 0) pl%Q(:) = pack(rtemp, plmask) ! end if - call check( nf90_get_var(iu%ncid, iu%j2rp2_varid, cb%j2rp2, start=[tslot]), "netcdf_read_frame_system nf90_getvar j2rp2_varid" ) - call check( nf90_get_var(iu%ncid, iu%j4rp4_varid, cb%j4rp4, start=[tslot]), "netcdf_read_frame_system nf90_getvar j4rp4_varid" ) + status = nf90_inq_varid(iu%ncid, J2RP2_VARNAME, iu%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" ) + else + cb%j2rp2 = 0.0_DP + end if + + status = nf90_inq_varid(iu%ncid, J4RP4_VARNAME, iu%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" ) + else + cb%j4rp4 = 0.0_DP + end if call self%read_particle_info(iu, param, plmask, tpmask) From 5c44911d57527510f7842eb831cb168ca216b96c Mon Sep 17 00:00:00 2001 From: David Minton Date: Mon, 14 Nov 2022 16:07:49 -0500 Subject: [PATCH 056/569] Fixed bugs in set_parameter and get_parameter that prevented it from being called before a bunch of parameters got set. Added "param_file" as an instance variable and began writing the run method. --- python/swiftest/swiftest/simulation_class.py | 101 +++++++++++++++---- 1 file changed, 80 insertions(+), 21 deletions(-) diff --git a/python/swiftest/swiftest/simulation_class.py b/python/swiftest/swiftest/simulation_class.py index c194729f8..5f3f01aa4 100644 --- a/python/swiftest/swiftest/simulation_class.py +++ b/python/swiftest/swiftest/simulation_class.py @@ -21,6 +21,7 @@ import numpy as np import numpy.typing as npt import shutil +import subprocess from typing import ( Literal, Dict, @@ -38,7 +39,7 @@ def __init__(self, codename: Literal["Swiftest", "Swifter", "Swift"] = "Swiftest", integrator: Literal["symba","rmvs","whm","helio"] = "symba", param_file: os.PathLike | str = "param.in", - read_param: bool = False, + read_param: bool = True, t0: float = 0.0, tstart: float = 0.0, tstop: float | None = None, @@ -266,12 +267,12 @@ def __init__(self, self._getter_column_width = '32' # If the parameter file is in a different location than the current working directory, we will need # to use it to properly open bin files - self.sim_dir = os.path.dirname(os.path.realpath(param_file)) + self.set_parameter(param_file=param_file) if read_param: - if os.path.exists(param_file): - self.read_param(param_file, codename=codename.title(), verbose=self.verbose) + if os.path.exists(self.param_file): + self.read_param(self.param_file, codename=codename.title(), verbose=self.verbose) else: - print(f"{param_file} not found.") + print(f"{self.param_file} not found.") self.set_parameter(codename=codename, integrator=integrator, @@ -320,6 +321,34 @@ def __init__(self, print(f"BIN_OUT file {binpath} not found.") return + def run(self,**kwargs): + """ + Runs a Swiftest integration. Uses the parameters set by the `param` dictionary unless overridden by keyword + arguments. Accepts any keyword arguments that can be passed to `set_parameter`. + + Parameters + ---------- + kwargs : Any valid keyword arguments accepted by `set_parameter`. + + Returns + ------- + None + + """ + + self.set_parameter(**kwargs) + if self.codename != "Swiftest": + print(f"Running an integration is not yet supported for {self.codename}") + return + + + term_output = subprocess.run([self.driver_executable, self.integrator, self.param_file], capture_output=True) + + # print(parameters['ncount'], ' Calling FORTRAN routine') + # with subprocess.Popen([parameters['workingdir']+'CTEM'], stdout=subprocess.PIPE, bufsize=1,universal_newlines=True) as p: + # for line in p.stdout: + # print(line, end='') + def _get_valid_arg_list(self, arg_list: str | List[str] | None = None, valid_var: Dict | None = None): """ Internal function for getters that extracts subset of arguments that is contained in the dictionary of valid @@ -433,7 +462,7 @@ def set_simulation_time(self, if tstop is not None: if tstop <= tstart: print("Error! tstop must be greater than tstart.") - return + return {} if tstop is not None: self.param['TSTOP'] = tstop @@ -457,7 +486,7 @@ def set_simulation_time(self, if istep_out is not None and tstep_out is not None: print("Error! istep_out and tstep_out cannot both be set") - return + return {} if tstep_out is not None and dt is not None: istep_out = int(np.floor(tstep_out / dt)) @@ -586,7 +615,6 @@ def get_parameter(self, **kwargs): """ - # Getters returning parameter dictionary values param_dict = {} param_dict.update(self.get_integrator(**kwargs)) @@ -604,6 +632,7 @@ def get_parameter(self, **kwargs): def set_integrator(self, codename: Literal["swiftest", "swifter", "swift"] | None = None, integrator: Literal["symba","rmvs","whm","helio"] | None = None, + param_file: PathLike | str | None = None, mtiny: float | None = None, gmtiny: float | None = None, verbose: bool | None = None, @@ -616,6 +645,8 @@ def set_integrator(self, codename : {"swiftest", "swifter", "swift"}, optional integrator : {"symba","rmvs","whm","helio"}, optional Name of the n-body integrator that will be used when executing a run. + param_file: PathLike | str | None = None, + Name of the input parameter file to use to read in parameter values. mtiny : float, optional The minimum mass of fully interacting bodies. Bodies below this mass interact with the larger bodies, but not each other (SyMBA only). *Note.* Only mtiny or gmtiny is accepted, not both. @@ -636,11 +667,16 @@ def set_integrator(self, """ # TODO: Improve how it finds the executable binary - if integrator is None and codename is None: - return - update_list = [] + # Set defaults + if "codename" not in dir(self): + self.codename = "Swiftest" + if "integerator" not in dir(self): + self.integrator = "symba" + if "driver_executable" not in dir(self): + self.driver_executable = None + if codename is not None: valid_codename = ["Swiftest", "Swifter", "Swift"] if codename.title() not in valid_codename: @@ -674,6 +710,10 @@ def set_integrator(self, self.integrator = integrator.lower() update_list.append("integrator") + if param_file is not None: + self.param_file = os.path.realpath(param_file) + self.sim_dir = os.path.dirname(self.param_file) + if mtiny is not None or gmtiny is not None: if self.integrator != "symba": print("mtiny and gmtiny are only used by SyMBA.") @@ -716,7 +756,9 @@ def get_integrator(self,arg_list: str | List[str] | None = None, verbose: bool | valid_var = {"codename": "! VERSION", "gmtiny" : "GMTINY"} - valid_instance_vars = {"integrator": self.integrator, + valid_instance_vars = {"param_file": self.param_file, + "sim_dir" : self.sim_dir, + "integrator": self.integrator, "codename": self.codename, "driver_executable": self.driver_executable} @@ -1001,8 +1043,8 @@ def get_feature(self, arg_list: str | List[str] | None = None, verbose: bool | N def set_init_cond_files(self, init_cond_file_type: Literal["NETCDF_DOUBLE", "NETCDF_FLOAT", "ASCII"] | None = None, - init_cond_file_name: str | os.PathLike | Dict[str, str] | Dict[ - str, os.PathLike] | None = None, + init_cond_file_name: str | os.PathLike | Dict[str, str] | + Dict[ str, os.PathLike] | None = None, init_cond_format: Literal["EL", "XV"] | None = None, verbose: bool | None = None, **kwargs: Any @@ -1055,6 +1097,9 @@ def set_init_cond_files(self, if init_cond_format is not None: update_list.append("init_cond_format") + if len(update_list) == 0: + return {} + def ascii_file_input_error_msg(codename): print(f"Error in set_init_cond_files: init_cond_file_name must be a dictionary of the form: ") print('{') @@ -1063,7 +1108,7 @@ def ascii_file_input_error_msg(codename): print('"PL" : *path to massive body initial conditions file*,') print('"TP" : *path to test particle initial conditions file*') print('}') - return + return {} if init_cond_format is None: if "IN_FORM" in self.param: @@ -1249,6 +1294,8 @@ def set_output_files(self, update_list.append("output_file_name") if output_format is not None: update_list.append("output_format") + if len(update_list) == 0: + return {} if self.codename == "Swiftest": if output_file_type is None: @@ -1425,6 +1472,13 @@ def set_unit_system(self, DU2M_old = None TU2S_old = None + if "MU_name" not in dir(self): + self.MU_name = None + if "DU_name" not in dir(self): + self.DU_name = None + if "TU_name" not in dir(self): + self.TU_name = None + update_list = [] if MU is not None or MU2KG is not None: update_list.append("MU") @@ -1506,8 +1560,10 @@ def set_unit_system(self, if TU_name is not None: self.TU_name = TU_name - self.VU_name = f"{self.DU_name}/{self.TU_name}" - self.GU = constants.GC * self.param['TU2S'] ** 2 * self.param['MU2KG'] / self.param['DU2M'] ** 3 + if "DU_name" in dir(self) and "TU_name" in dir(self): + self.VU_name = f"{self.DU_name}/{self.TU_name}" + if all(key in self.param for key in ["MU2KG","DU2M","TU2S"]): + self.GU = constants.GC * self.param["TU2S"] ** 2 * self.param["MU2KG"] / self.param["DU2M"] ** 3 if recompute_unit_values: self.update_param_units(MU2KG_old, DU2M_old, TU2S_old) @@ -1539,21 +1595,23 @@ def get_unit_system(self, arg_list: str | List[str] | None = None, verbose: bool """ + + valid_var = { "MU": "MU2KG", "DU": "DU2M", "TU": "TU2S", } - if self.MU_name is None: + if "MU_name" not in dir(self) or self.MU_name is None: MU_name = "mass unit" else: MU_name = self.MU_name - if self.DU_name is None: + if "DU_name" not in dir(self) or self.DU_name is None: DU_name = "distance unit" else: DU_name = self.DU_name - if self.TU_name is None: + if "TU_name" not in dir(self) or self.TU_name is None: TU_name = "time unit" else: TU_name = self.TU_name @@ -1654,6 +1712,8 @@ def set_distance_range(self, A dictionary containing the requested parameters. """ + if rmax is None and rmin is None and qmin_coord is None: + return {} update_list = [] CHK_QMIN_RANGE = self.param.pop('CHK_QMIN_RANGE', None) @@ -1904,7 +1964,6 @@ def set_ephemeris_date(self, if ephemeris_date is None: return - # The default value is Prof. Minton's Brimley/Cocoon line crossing date (aka MBCL) minton_bday = datetime.date.fromisoformat('1976-08-05') brimley_cocoon_line = datetime.timedelta(days=18530) From 37230e0f0c5472f59c9f06d6aa5f0dae00cedeb1 Mon Sep 17 00:00:00 2001 From: David Minton Date: Mon, 14 Nov 2022 16:35:18 -0500 Subject: [PATCH 057/569] Cleaned up the methods so that the defaults make more sense and less has to be explicitly specified with each method call --- .../Basic_Simulation/initial_conditions.py | 4 +- python/swiftest/swiftest/simulation_class.py | 77 ++++++++++++++----- 2 files changed, 59 insertions(+), 22 deletions(-) diff --git a/examples/Basic_Simulation/initial_conditions.py b/examples/Basic_Simulation/initial_conditions.py index 91471fd7f..de5a8fcad 100644 --- a/examples/Basic_Simulation/initial_conditions.py +++ b/examples/Basic_Simulation/initial_conditions.py @@ -73,4 +73,6 @@ sim.add_body(name_tp, a_tp, e_tp, inc_tp, capom_tp, omega_tp, capm_tp) # Save everything to a set of initial conditions files -sim.save('param.in') +sim.run() + +print("All done!") diff --git a/python/swiftest/swiftest/simulation_class.py b/python/swiftest/swiftest/simulation_class.py index 5f3f01aa4..52f9321a2 100644 --- a/python/swiftest/swiftest/simulation_class.py +++ b/python/swiftest/swiftest/simulation_class.py @@ -328,7 +328,7 @@ def run(self,**kwargs): Parameters ---------- - kwargs : Any valid keyword arguments accepted by `set_parameter`. + **kwargs : Any valid keyword arguments accepted by `set_parameter` or `save' Returns ------- @@ -337,12 +337,14 @@ def run(self,**kwargs): """ self.set_parameter(**kwargs) + self.save(**kwargs) if self.codename != "Swiftest": print(f"Running an integration is not yet supported for {self.codename}") return + print(f"Running a simulation from tstart={self.param['TSTART']} {self.TU_name} to tstop={self.param['TSTOP']} {self.TU_name}") - term_output = subprocess.run([self.driver_executable, self.integrator, self.param_file], capture_output=True) + #term_output = subprocess.run([self.driver_executable, self.integrator, self.param_file], capture_output=True) # print(parameters['ncount'], ' Calling FORTRAN routine') # with subprocess.Popen([parameters['workingdir']+'CTEM'], stdout=subprocess.PIPE, bufsize=1,universal_newlines=True) as p: @@ -645,7 +647,7 @@ def set_integrator(self, codename : {"swiftest", "swifter", "swift"}, optional integrator : {"symba","rmvs","whm","helio"}, optional Name of the n-body integrator that will be used when executing a run. - param_file: PathLike | str | None = None, + param_file: str or path-like, optional Name of the input parameter file to use to read in parameter values. mtiny : float, optional The minimum mass of fully interacting bodies. Bodies below this mass interact with the larger bodies, @@ -2256,22 +2258,39 @@ def read_param(self, param_file, codename="Swiftest", verbose=True): self.codename = "Unknown" return - def write_param(self, param_file, param=None): + def write_param(self, + codename: Literal["Swiftest", "Swifter", "Swift"] | None = None, + param_file: str | PathLike | None = None, + param: Dict | None = None, + **kwargs: Any): """ Writes to a param.in file and determines whether the output format needs to be converted between Swift/Swifter/Swiftest. Parameters ---------- - param_file : string - File name of the input parameter file + codename : {"Swiftest", "Swifter", "Swift"}, optional + Alternative name of the n-body code that the parameter file will be formatted for. Defaults to current instance + variable self.codename + param_file : str or path-like, optional + Alternative file name of the input parameter file. Defaults to current instance variable self.param_file + param: Dict, optional + An alternative parameter dictionary to write out. Defaults to the current instance variable self.param + **kwargs + A dictionary of additional keyword argument. These are ignored. + Returns ------- - self.ds : xarray dataset + None """ + + if codename is None: + codename = self.codename + if param_file is None: + param_file = self.param_file if param is None: param = self.param + # Check to see if the parameter type matches the output type. If not, we need to convert - codename = param['! VERSION'].split()[0] if codename == "Swifter" or codename == "Swiftest": if param['IN_TYPE'] == "ASCII": param.pop("NC_IN", None) @@ -2409,32 +2428,48 @@ def follow(self, codestyle="Swifter"): if self.verbose: print('follow.out written') return fol - def save(self, param_file, framenum=-1, codename="Swiftest"): + def save(self, + codename: Literal["Swiftest", "Swifter", "Swift"] | None = None, + param_file: str | PathLike | None = None, + param: Dict | None = None, + framenum: int = -1, + **kwargs: Any): """ Saves an xarray dataset to a set of input files. Parameters ---------- - param_file : string - Name of the parameter input file - framenum : integer (default=-1) - Time frame to use to generate the initial conditions. If this argument is not passed, the default is to use the last frame in the dataset. - codename : string - Name of the desired format (Swift/Swifter/Swiftest) + codename : {"Swiftest", "Swifter", "Swift"}, optional + Alternative name of the n-body code that the parameter file will be formatted for. Defaults to current instance + variable self.codename + param_file : str or path-like, optional + Alternative file name of the input parameter file. Defaults to current instance variable self.param_file + param: Dict, optional + An alternative parameter dictionary to write out. Defaults to the current instance variable self.param + framenum : int Default=-1 + Time frame to use to generate the initial conditions. If this argument is not passed, the default is to use the last frame in the dataset. + **kwargs + A dictionary of additional keyword argument. These are ignored. Returns ------- - self.ds : xarray dataset + None """ + if codename is None: + codename = self.codename + if param_file is None: + param_file = self.param_file + if param is None: + param = self.param if codename == "Swiftest": - io.swiftest_xr2infile(ds=self.ds, param=self.param, in_type=self.param['IN_TYPE'], framenum=framenum) - self.write_param(param_file) + io.swiftest_xr2infile(ds=self.ds, param=param, in_type=self.param['IN_TYPE'], framenum=framenum) + self.write_param(param_file=param_file) elif codename == "Swifter": - if self.codename == "Swiftest": - swifter_param = io.swiftest2swifter_param(self.param) + if codename == "Swiftest": + swifter_param = io.swiftest2swifter_param(param) else: - swifter_param = self.param + swifter_param = param io.swifter_xr2infile(self.ds, swifter_param, framenum) self.write_param(param_file, param=swifter_param) else: From 18dd938319e35055488228169ea672d2a73e2b78 Mon Sep 17 00:00:00 2001 From: David Minton Date: Mon, 14 Nov 2022 16:48:34 -0500 Subject: [PATCH 058/569] Cleaned up more methods to make ready to run a simulationj --- examples/Basic_Simulation/param.in | 20 ++++++++++---------- python/swiftest/swiftest/io.py | 13 +++++++++---- python/swiftest/swiftest/simulation_class.py | 9 ++++++--- 3 files changed, 25 insertions(+), 17 deletions(-) diff --git a/examples/Basic_Simulation/param.in b/examples/Basic_Simulation/param.in index 47498726c..03fbfc38f 100644 --- a/examples/Basic_Simulation/param.in +++ b/examples/Basic_Simulation/param.in @@ -1,14 +1,17 @@ ! VERSION Swiftest parameter input T0 0.0 +TSTART 0.0 TSTOP 10.0 DT 0.005 ISTEP_OUT 200 ISTEP_DUMP 200 +NC_IN init_cond.nc +IN_TYPE NETCDF_DOUBLE +IN_FORM EL +BIN_OUT bin.nc OUT_FORM XVEL OUT_TYPE NETCDF_DOUBLE OUT_STAT REPLACE -IN_TYPE NETCDF_DOUBLE -BIN_OUT bin.nc CHK_QMIN 0.004650467260962157 CHK_RMIN 0.004650467260962157 CHK_RMAX 10000.0 @@ -18,9 +21,10 @@ CHK_QMIN_RANGE 0.004650467260962157 10000.0 MU2KG 1.988409870698051e+30 TU2S 31557600.0 DU2M 149597870700.0 +GMTINY 9.869231602224408e-07 +MIN_GMFRAG 9.869231602224408e-10 RESTART NO -INTERACTION_LOOPS TRIANGULAR -ENCOUNTER_CHECK TRIANGULAR +TIDES NO CHK_CLOSE YES GR YES FRAGMENTATION YES @@ -29,9 +33,5 @@ ENERGY NO EXTRA_FORCE NO BIG_DISCARD NO RHILL_PRESENT NO -TIDES NO -IN_FORM EL -NC_IN init_cond.nc -TSTART 0.0 -GMTINY 1e-06 -MIN_GMFRAG 1e-09 +INTERACTION_LOOPS TRIANGULAR +ENCOUNTER_CHECK TRIANGULAR diff --git a/python/swiftest/swiftest/io.py b/python/swiftest/swiftest/io.py index 50c84751f..8c93e2e7d 100644 --- a/python/swiftest/swiftest/io.py +++ b/python/swiftest/swiftest/io.py @@ -404,18 +404,21 @@ def write_labeled_param(param, param_file_name): outfile = open(param_file_name, 'w') keylist = ['! VERSION', 'T0', + 'TSTART', 'TSTOP', 'DT', 'ISTEP_OUT', 'ISTEP_DUMP', - 'OUT_FORM', - 'OUT_TYPE', - 'OUT_STAT', - 'IN_TYPE', + 'NC_IN', 'PL_IN', 'TP_IN', 'CB_IN', + 'IN_TYPE', + 'IN_FORM', 'BIN_OUT', + 'OUT_FORM', + 'OUT_TYPE', + 'OUT_STAT', 'CHK_QMIN', 'CHK_RMIN', 'CHK_RMAX', @@ -425,6 +428,8 @@ def write_labeled_param(param, param_file_name): 'MU2KG', 'TU2S', 'DU2M', + 'GMTINY', + 'MIN_GMFRAG', 'RESTART'] ptmp = param.copy() # Print the list of key/value pairs in the preferred order diff --git a/python/swiftest/swiftest/simulation_class.py b/python/swiftest/swiftest/simulation_class.py index 52f9321a2..0143c8fb9 100644 --- a/python/swiftest/swiftest/simulation_class.py +++ b/python/swiftest/swiftest/simulation_class.py @@ -342,7 +342,7 @@ def run(self,**kwargs): print(f"Running an integration is not yet supported for {self.codename}") return - print(f"Running a simulation from tstart={self.param['TSTART']} {self.TU_name} to tstop={self.param['TSTOP']} {self.TU_name}") + print(f"Running a {self.codename} {self.integrator} run from tstart={self.param['TSTART']} {self.TU_name} to tstop={self.param['TSTOP']} {self.TU_name}") #term_output = subprocess.run([self.driver_executable, self.integrator, self.param_file], capture_output=True) @@ -436,6 +436,9 @@ def set_simulation_time(self, A dictionary containing the requested parameters """ + if t0 is None and tstart is None and dt is None and istep_out is None and \ + tstep_out is None and istep_dump is None: + return {} update_list = [] @@ -2289,6 +2292,7 @@ def write_param(self, param_file = self.param_file if param is None: param = self.param + print(f"Writing parameter inputs to file {param_file}") # Check to see if the parameter type matches the output type. If not, we need to convert if codename == "Swifter" or codename == "Swiftest": @@ -2302,8 +2306,7 @@ def write_param(self, elif codename == "Swift": io.write_swift_param(param, param_file) else: - print( - 'Cannot process unknown code type. Call the read_param method with a valid code name. Valid options are "Swiftest", "Swifter", or "Swift".') + print( 'Cannot process unknown code type. Call the read_param method with a valid code name. Valid options are "Swiftest", "Swifter", or "Swift".') return def convert(self, param_file, newcodename="Swiftest", plname="pl.swiftest.in", tpname="tp.swiftest.in", From 44f3b4059ca3e194b9f684a7eda9f66f44613e76 Mon Sep 17 00:00:00 2001 From: David Minton Date: Mon, 14 Nov 2022 16:49:19 -0500 Subject: [PATCH 059/569] added subprocess call to run sim --- python/swiftest/swiftest/simulation_class.py | 7 +------ 1 file changed, 1 insertion(+), 6 deletions(-) diff --git a/python/swiftest/swiftest/simulation_class.py b/python/swiftest/swiftest/simulation_class.py index 0143c8fb9..27ef73774 100644 --- a/python/swiftest/swiftest/simulation_class.py +++ b/python/swiftest/swiftest/simulation_class.py @@ -344,12 +344,7 @@ def run(self,**kwargs): print(f"Running a {self.codename} {self.integrator} run from tstart={self.param['TSTART']} {self.TU_name} to tstop={self.param['TSTOP']} {self.TU_name}") - #term_output = subprocess.run([self.driver_executable, self.integrator, self.param_file], capture_output=True) - - # print(parameters['ncount'], ' Calling FORTRAN routine') - # with subprocess.Popen([parameters['workingdir']+'CTEM'], stdout=subprocess.PIPE, bufsize=1,universal_newlines=True) as p: - # for line in p.stdout: - # print(line, end='') + subprocess.run([self.driver_executable, self.integrator, self.param_file], capture_output=True) def _get_valid_arg_list(self, arg_list: str | List[str] | None = None, valid_var: Dict | None = None): """ From 00ded00a14d0e48c62d772e5554f5b5ce35a9ae5 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Mon, 14 Nov 2022 16:58:20 -0500 Subject: [PATCH 060/569] Rearranged the outputs in the get_integrator method to avoid duplication --- python/swiftest/swiftest/simulation_class.py | 9 ++++----- 1 file changed, 4 insertions(+), 5 deletions(-) diff --git a/python/swiftest/swiftest/simulation_class.py b/python/swiftest/swiftest/simulation_class.py index 27ef73774..558e636a4 100644 --- a/python/swiftest/swiftest/simulation_class.py +++ b/python/swiftest/swiftest/simulation_class.py @@ -756,10 +756,9 @@ def get_integrator(self,arg_list: str | List[str] | None = None, verbose: bool | valid_var = {"codename": "! VERSION", "gmtiny" : "GMTINY"} - valid_instance_vars = {"param_file": self.param_file, - "sim_dir" : self.sim_dir, + valid_instance_vars = {"codename": self.codename, "integrator": self.integrator, - "codename": self.codename, + "param_file": self.param_file, "driver_executable": self.driver_executable} try: @@ -781,14 +780,14 @@ def get_integrator(self,arg_list: str | List[str] | None = None, verbose: bool | arg_list = list(valid_instance_vars.keys()) arg_list.append(*[a for a in valid_var.keys() if a not in valid_instance_vars]) - integrator = self._get_instance_var(arg_list, valid_instance_vars, verbose, **kwargs) + inst_var = self._get_instance_var(arg_list, valid_instance_vars, verbose, **kwargs) valid_arg, integrator_dict = self._get_valid_arg_list(arg_list, valid_var) if verbose: for arg in valid_arg: key = valid_var[arg] - if key in integrator_dict: + if key in integrator_dict and key not in inst_var: if arg == "gmtiny": if self.integrator == "symba": print(f"{arg:<{self._getter_column_width}} {integrator_dict[key]} {self.DU_name}^3 / {self.TU_name}^2 ") From 0477c60f35f8ef4effbc6620291e81af7e492b03 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Mon, 14 Nov 2022 17:37:47 -0500 Subject: [PATCH 061/569] Fixed executable path location --- python/swiftest/swiftest/simulation_class.py | 15 ++++++++++++--- 1 file changed, 12 insertions(+), 3 deletions(-) diff --git a/python/swiftest/swiftest/simulation_class.py b/python/swiftest/swiftest/simulation_class.py index 558e636a4..9ee1b77e0 100644 --- a/python/swiftest/swiftest/simulation_class.py +++ b/python/swiftest/swiftest/simulation_class.py @@ -338,13 +338,19 @@ def run(self,**kwargs): self.set_parameter(**kwargs) self.save(**kwargs) + if self.codename != "Swiftest": print(f"Running an integration is not yet supported for {self.codename}") return + if self.driver_executable is None: + print("Path to swiftest_driver has not been set!") + return + print(f"Running a {self.codename} {self.integrator} run from tstart={self.param['TSTART']} {self.TU_name} to tstop={self.param['TSTOP']} {self.TU_name}") - subprocess.run([self.driver_executable, self.integrator, self.param_file], capture_output=True) + term = subprocess.run([self.driver_executable, self.integrator, self.param_file], capture_output=True) + return def _get_valid_arg_list(self, arg_list: str | List[str] | None = None, valid_var: Dict | None = None): """ @@ -691,11 +697,14 @@ def set_integrator(self, self.param['! VERSION'] = f"{self.codename} parameter input" update_list.append("codename") if self.codename == "Swiftest": - self.binary_path = os.path.realpath(os.path.join(os.path.dirname(os.path.realpath(_pyfile)),os.pardir,os.pardir,os.pardir,"build")) + self.binary_path = os.path.realpath(os.path.join(os.path.dirname(os.path.realpath(_pyfile)),os.pardir,os.pardir,os.pardir,"bin")) self.driver_executable = os.path.join(self.binary_path,"swiftest_driver") + if not os.path.exists(self.driver_executable): + print(f"Cannot find the Swiftest driver in {self.binary_path}") + self.driver_executable = None else: self.binary_path = "NOT SET" - self.driver_executable = "NOT SET" + self.driver_executable = None update_list.append("driver_executable") if integrator is not None: From dcc13e0586167b9c0452ee24c09bb948e775c54b Mon Sep 17 00:00:00 2001 From: David A Minton Date: Mon, 14 Nov 2022 19:50:27 -0500 Subject: [PATCH 062/569] Fixed subprocess output. Now I'll need to figure out how to get library paths correct --- python/swiftest/swiftest/simulation_class.py | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/python/swiftest/swiftest/simulation_class.py b/python/swiftest/swiftest/simulation_class.py index 9ee1b77e0..20c16b1f4 100644 --- a/python/swiftest/swiftest/simulation_class.py +++ b/python/swiftest/swiftest/simulation_class.py @@ -349,7 +349,9 @@ def run(self,**kwargs): print(f"Running a {self.codename} {self.integrator} run from tstart={self.param['TSTART']} {self.TU_name} to tstop={self.param['TSTOP']} {self.TU_name}") - term = subprocess.run([self.driver_executable, self.integrator, self.param_file], capture_output=True) + with subprocess.Popen([self.driver_executable, self.integrator, self.param_file], stdout=subprocess.PIPE, bufsize=1,universal_newlines=True) as p: + for line in p.stdout: + print(line, end='') return def _get_valid_arg_list(self, arg_list: str | List[str] | None = None, valid_var: Dict | None = None): From a0aa03dc071640cdec2c1efbb70d7393c3724a17 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Tue, 15 Nov 2022 08:27:17 -0500 Subject: [PATCH 063/569] Removed duplicate dictionary entry --- python/swiftest/swiftest/io.py | 1 - 1 file changed, 1 deletion(-) diff --git a/python/swiftest/swiftest/io.py b/python/swiftest/swiftest/io.py index 8c93e2e7d..64c4dc4a1 100644 --- a/python/swiftest/swiftest/io.py +++ b/python/swiftest/swiftest/io.py @@ -295,7 +295,6 @@ def read_swift_param(param_file_name, startfile="swift.in", verbose=True): 'DTOUT': 0.0, 'DTDUMP': 0.0, 'L1': "F", - 'L1': "F", 'L2': "F", 'L3': "F", 'L4': "F", From c34be4917c51ac7f6e18640baea40ac5fe69c8d4 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Tue, 15 Nov 2022 08:27:42 -0500 Subject: [PATCH 064/569] Rearranged the order of variables to output in get_feature --- python/swiftest/swiftest/simulation_class.py | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/python/swiftest/swiftest/simulation_class.py b/python/swiftest/swiftest/simulation_class.py index 20c16b1f4..01ad0a866 100644 --- a/python/swiftest/swiftest/simulation_class.py +++ b/python/swiftest/swiftest/simulation_class.py @@ -1017,17 +1017,17 @@ def get_feature(self, arg_list: str | List[str] | None = None, verbose: bool | N """ valid_var = {"close_encounter_check": "CHK_CLOSE", - "general_relativity": "GR", "fragmentation": "FRAGMENTATION", + "minimum_fragment_gmass": "MIN_GMFRAG", "rotation": "ROTATION", + "general_relativity": "GR", "compute_conservation_values": "ENERGY", + "rhill_present": "RHILL_PRESENT", "extra_force": "EXTRA_FORCE", "big_discard": "BIG_DISCARD", - "rhill_present": "RHILL_PRESENT", - "restart": "RESTART", "interaction_loops": "INTERACTION_LOOPS", "encounter_check_loops": "ENCOUNTER_CHECK", - "minimum_fragment_gmass" : "MIN_GMFRAG" + "restart": "RESTART" } valid_arg, feature_dict = self._get_valid_arg_list(arg_list, valid_var) From d72ffca52907f4626740bc1f8b65dce6960b349c Mon Sep 17 00:00:00 2001 From: David Minton Date: Tue, 15 Nov 2022 12:52:59 -0500 Subject: [PATCH 065/569] Restructured arguments to be able to follow a priority order in overriding arguments from defaults (lowest) to inputs from file (higher) to arguments passed to Swiftest() (highest). --- examples/Basic_Simulation/param.in | 4 +- python/swiftest/swiftest/io.py | 3 +- python/swiftest/swiftest/simulation_class.py | 374 +++++++++++-------- 3 files changed, 224 insertions(+), 157 deletions(-) diff --git a/examples/Basic_Simulation/param.in b/examples/Basic_Simulation/param.in index 03fbfc38f..014bf1fb8 100644 --- a/examples/Basic_Simulation/param.in +++ b/examples/Basic_Simulation/param.in @@ -1,4 +1,4 @@ -! VERSION Swiftest parameter input +! VERSION Swiftest input file T0 0.0 TSTART 0.0 TSTOP 10.0 @@ -24,7 +24,6 @@ DU2M 149597870700.0 GMTINY 9.869231602224408e-07 MIN_GMFRAG 9.869231602224408e-10 RESTART NO -TIDES NO CHK_CLOSE YES GR YES FRAGMENTATION YES @@ -35,3 +34,4 @@ BIG_DISCARD NO RHILL_PRESENT NO INTERACTION_LOOPS TRIANGULAR ENCOUNTER_CHECK TRIANGULAR +TIDES NO diff --git a/python/swiftest/swiftest/io.py b/python/swiftest/swiftest/io.py index 64c4dc4a1..64024c2d9 100644 --- a/python/swiftest/swiftest/io.py +++ b/python/swiftest/swiftest/io.py @@ -152,8 +152,7 @@ def read_swiftest_param(param_file_name, param, verbose=True): param : dict A dictionary containing the entries in the user parameter file """ - param['! VERSION'] = f"Swiftest parameter input from file {param_file_name}" - + param['! VERSION'] = f"Swiftest parameter input file" # Read param.in file if verbose: print(f'Reading Swiftest file {param_file_name}') diff --git a/python/swiftest/swiftest/simulation_class.py b/python/swiftest/swiftest/simulation_class.py index 01ad0a866..c8f6ebf34 100644 --- a/python/swiftest/swiftest/simulation_class.py +++ b/python/swiftest/swiftest/simulation_class.py @@ -35,93 +35,70 @@ class Simulation: This is a class that defines the basic Swift/Swifter/Swiftest simulation object """ - def __init__(self, - codename: Literal["Swiftest", "Swifter", "Swift"] = "Swiftest", - integrator: Literal["symba","rmvs","whm","helio"] = "symba", - param_file: os.PathLike | str = "param.in", - read_param: bool = True, - t0: float = 0.0, - tstart: float = 0.0, - tstop: float | None = None, - dt: float | None = None, - istep_out: int | None = None, - tstep_out: float | None = None, - istep_dump: int | None = None, - init_cond_file_type: Literal["NETCDF_DOUBLE", "NETCDF_FLOAT", "ASCII"] = "NETCDF_DOUBLE", - init_cond_file_name: str | os.PathLike | Dict[str, str] | Dict[str, os.PathLike] | None = None, - init_cond_format: Literal["EL", "XV"] = "EL", - output_file_type: Literal[ - "NETCDF_DOUBLE", "NETCDF_FLOAT", "REAL4", "REAL8", "XDR4", "XDR8"] = "NETCDF_DOUBLE", - output_file_name: os.PathLike | str | None = None, - output_format: Literal["XV", "XVEL"] = "XVEL", - read_old_output_file: bool = False, - MU: str = "MSUN", - DU: str = "AU", - TU: str = "Y", - MU2KG: float | None = None, - DU2M: float | None = None, - TU2S: float | None = None, - MU_name: str | None = None, - DU_name: str | None = None, - TU_name: str | None = None, - rmin: float = constants.RSun / constants.AU2M, - rmax: float = 10000.0, - qmin_coord: Literal["HELIO","BARY"] = "HELIO", - gmtiny: float | None = None, - mtiny: float | None = None, - close_encounter_check: bool = True, - general_relativity: bool = True, - fragmentation: bool = False, - minimum_fragment_mass: float | None = None, - minimum_fragment_gmass: float | None = None, - rotation: bool = True, - compute_conservation_values: bool = False, - extra_force: bool = False, - big_discard: bool = False, - rhill_present: bool = False, - restart: bool = False, - interaction_loops: Literal["TRIANGULAR", "FLAT", "ADAPTIVE"] = "TRIANGULAR", - encounter_check_loops: Literal["TRIANGULAR", "SORTSWEEP", "ADAPTIVE"] = "TRIANGULAR", - ephemeris_date: str = "MBCL", - verbose: bool = True - ): + def __init__(self,read_param: bool = True, **kwargs: Any): """ Parameters ---------- + read_param : bool, default True + If true, read in a pre-existing parameter input file given by the argument `param_file` if it exists. + Otherwise, create a new parameter file using the arguments passed to Simulation or defaults + + Parameters for a given Simulation object can be set a number of different ways, including via a parameter input + file, arguments to Simulation, the general `set_parameter` method, or the specific setters for groups of + similar parameters (e.g. set_init_cond_files, set_simulation_time, etc.). Each parameter has a default value + that can be overridden by an argument to Simulation(). Some argument parameters have equivalent values that + are passed to the `swiftest_driver` Fortran program via a parameter input file. When declaring a new + Simulation object, parameters are chosen in the following way, from highest to lowest priority" + 1. Arguments to Simulation() + 2. The parameter input file given by `param_file` under the following conditions: + - `read_param` is set to True (default behavior). + - The file given by `param_file` exists. The default file is `param.in` located in the current working + directory, which can be changed by passing `param_file` as an argument. + - The argument has an equivalent parameter or set of parameters in the parameter input file. + 3. Default values (see below) + + **kwargs : See list of valid parameters and their defaults below + codename : {"Swiftest", "Swifter", "Swift"}, default "Swiftest" Name of the n-body code that will be used. + Parameter input file equivalent: None integrator : {"symba","rmvs","whm","helio"}, default "symba" Name of the n-body integrator that will be used when executing a run. + Parameter input file equivalent: None param_file : str, path-like, or file-lke, default "param.in" Name of the parameter input file that will be passed to the integrator. - read_param : bool, default False - If true, read in a pre-existing parameter input file given by the argument `param_file`. Otherwise, create - a new parameter file using the arguments passed to Simulation. - > *Note:* If set to true, the parameters defined in the input file will override any passed into the - > arguments of Simulation. + Parameter input file equivalent: None t0 : float, default 0.0 The reference time for the start of the simulation. Defaults is 0.0. + Parameter input file equivalent: `T0` tstart : float, default 0.0 The start time for a restarted simulation. For a new simulation, tstart will be set to t0 automatically. + Parameter input file equivalent: `TSTART` tstop : float, optional The stopping time for a simulation. `tstop` must be greater than `tstart`. + Parameter input file equivalent: `TSTOP` dt : float, optional The step size of the simulation. `dt` must be less than or equal to `tstop-dstart`. + Parameter input file equivalent: `DT` istep_out : int, optional The number of time steps between outputs to file. *Note*: only `istep_out` or `toutput` can be set. + Parameter input file equivalent: `ISTEP_OUT` tstep_out : float, optional The approximate time between when outputs are written to file. Passing this computes `istep_out = floor(tstep_out/dt)`. *Note*: only `istep_out` or `toutput` can be set. + Parameter input file equivalent: None istep_dump : int, optional The anumber of time steps between outputs to dump file. If not set, this will be set to the value of `istep_out` (or the equivalent value determined by `tstep_out`). + Parameter input file equivalent: `ISTEP_DUMP` init_cond_file_type : {"NETCDF_DOUBLE", "NETCDF_FLOAT", "ASCII"}, default "NETCDF_DOUBLE" The file type containing initial conditions for the simulation: * NETCDF_DOUBLE: A single initial conditions input file in NetCDF file format of type NETCDF_DOUBLE. * NETCDF_FLOAT: A single initial conditions input file in NetCDF file format of type NETCDF_FLOAT. * ASCII : Three initial conditions files in ASCII format. The individual files define the central body, massive body, and test particle initial conditions. + Parameter input file equivalent: `IN_TYPE` init_cond_file_name : str, path-like, or dict, optional Name of the input initial condition file or files. Whether to pass a single file name or a dictionary depends on the argument passed to `init_cond_file_type`: If `init_cond_file_type={"NETCDF_DOUBLE","NETCDF_FLOAT"}`, @@ -134,36 +111,44 @@ def __init__(self, If no file name is provided then the following default file names will be used. * NETCDF_DOUBLE, NETCDF_FLOAT: `init_cond_file_name = "init_cond.nc"` * ASCII: `init_cond_file_name = {"CB" : "cb.in", "PL" : "pl.in", "TP" : "tp.in"}` + Parameter input file equivalent: `NC_IN`, `CB_IN`, `PL_IN`, `TP_IN` init_cond_format : {"EL", "XV"}, default "EL" Indicates whether the input initial conditions are given as orbital elements or cartesian position and velocity vectors. > *Note:* If `codename` is "Swift" or "Swifter", EL initial conditions are converted to XV. + Parameter input file equivalent: `IN_FORM` output_file_type : {"NETCDF_DOUBLE", "NETCDF_FLOAT","REAL4","REAL8","XDR4","XDR8"}, default "NETCDF_DOUBLE" The file type for the outputs of the simulation. Compatible file types depend on the `codename` argument. * Swiftest: Only "NETCDF_DOUBLE" or "NETCDF_FLOAT" supported. * Swifter: Only "REAL4","REAL8","XDR4" or "XDR8" supported. * Swift: Only "REAL4" supported. + Parameter input file equivalent: `OUT_TYPE` output_file_name : str or path-like, optional Name of output file to generate. If not supplied, then one of the default file names are used, depending on the value passed to `output_file_type`. If one of the NetCDF types are used, the default is "bin.nc". Otherwise, the default is "bin.dat". + Parameter input file equivalent: `BIN_OUT` output_format : {"XV","XVEL"}, default "XVEL" Specifies the format for the data saved to the output file. If "XV" then cartesian position and velocity vectors for all bodies are stored. If "XVEL" then the orbital elements are also stored. + Parameter input file equivalent: `OUT_FORM` read_old_output_file : bool, default False - If true, read in a pre-existing binary input file given by the argument `output_file_name`. + If true, read in a pre-existing binary input file given by the argument `output_file_name` if it exists. + Parameter input file equivalent: None MU : str, default "MSUN" - The mass unit system to use. Case-insensitive valid options are: - * "Msun" : Solar mass - * "Mearth" : Earth mass - * "kg" : kilograms - * "g" : grams + The mass unit system to use. Case-insensitive valid options are: + * "Msun" : Solar mass + * "Mearth" : Earth mass + * "kg" : kilograms + * "g" : grams + Parameter input file equivalent: None DU : str, optional The distance unit system to use. Case-insensitive valid options are: * "AU" : Astronomical Unit * "Rearth" : Earth radius * "m" : meter * "cm" : centimeter + Parameter input file equivalent: None TU : str, optional The time unit system to use. Case-insensitive valid options are: * "YR" : Year @@ -171,69 +156,92 @@ def __init__(self, * "d" : Julian day * "JD" : Julian day * "s" : second + Parameter input file equivalent: None MU2KG: float, optional The conversion factor to multiply by the mass unit that would convert it to kilogram. Setting this overrides MU + Parameter input file equivalent: `MU2KG` DU2M : float, optional The conversion factor to multiply by the distance unit that would convert it to meter. Setting this overrides DU + Parameter input file equivalent: `DU2M` TU2S : float, optional The conversion factor to multiply by the time unit that would convert it to seconds. Setting this overrides TU + Parameter input file equivalent: `TU2S` MU_name : str, optional The name of the mass unit. When setting one of the standard units via `MU` a name will be automatically set for the unit, so this argument will override the automatic name. + Parameter input file equivalent: None DU_name : str, optional The name of the distance unit. When setting one of the standard units via `DU` a name will be automatically set for the unit, so this argument will override the automatic name. + Parameter input file equivalent: None TU_name : str, optional The name of the time unit. When setting one of the standard units via `TU` a name will be automatically set for the unit, so this argument will override the automatic name. + Parameter input file equivalent: None rmin : float, default value is the radius of the Sun in the unit system defined by the unit input arguments. - Minimum distance of the simulation (CHK_QMIN, CHK_RMIN, CHK_QMIN_RANGE[0]) + Minimum distance of the simulation + Parameter input file equivalent: `CHK_QMIN`, `CHK_RMIN`, `CHK_QMIN_RANGE[0]` rmax : float, default value is 10000 AU in the unit system defined by the unit input arguments. Maximum distance of the simulation (CHK_RMAX, CHK_QMIN_RANGE[1]) + Parameter input file equivalent: `CHK_RMAX`, `CHK_QMIN_RANGE[1]` qmin_coord : str, {"HELIO", "BARY"}, default "HELIO" - coordinate frame to use for CHK_QMIN + coordinate frame to use for checking the minimum periapsis distance + Parameter input file equivalent: `QMIN_COORD` mtiny : float, optional The minimum mass of fully interacting bodies. Bodies below this mass interact with the larger bodies, but not each other (SyMBA only). *Note.* Only mtiny or gmtiny is accepted, not both. + Parameter input file equivalent: None gmtiny : float, optional The minimum G*mass of fully interacting bodies. Bodies below this mass interact with the larger bodies, but not each other (SyMBA only). *Note.* Only mtiny or gmtiny is accepted, not both. + Parameter input file equivalent: `GMTINY` close_encounter_check : bool, default True Check for close encounters between bodies. If set to True, then the radii of massive bodies must be included in initial conditions. + Parameter input file equivalent: `CHK_CLOSE` general_relativity : bool, default True Include the post-Newtonian correction in acceleration calculations. + Parameter input file equivalent: `GR` fragmentation : bool, default True If set to True, this turns on the Fraggle fragment generation code and `rotation` must also be True. This argument only applies to Swiftest-SyMBA simulations. It will be ignored otherwise. + Parameter input file equivalent: `FRAGMENTATION` minimum_fragment_gmass : float, optional If fragmentation is turned on, this sets the mimimum G*mass of a collisional fragment that can be generated. *Note.* Only set one of minimum_fragment_gmass or minimum_fragment_mass + Parameter input file equivalent: None minimum_fragment_mass : float, optional If fragmentation is turned on, this sets the mimimum mass of a collisional fragment that can be generated. *Note.* Only set one of minimum_fragment_gmass or minimum_fragment_mass - rotation : bool, default True + Parameter input file equivalent: `MIN_GMFRAG` + rotation : bool, default False If set to True, this turns on rotation tracking and radius, rotation vector, and moments of inertia values must be included in the initial conditions. This argument only applies to Swiftest-SyMBA simulations. It will be ignored otherwise. + Parameter input file equivalent: `ROTATION` compute_conservation_values : bool, default False Turns on the computation of energy, angular momentum, and mass conservation and reports the values every output step of a running simulation. + Parameter input file equivalent: `ENERGY` extra_force: bool, default False Turns on user-defined force function. + Parameter input file equivalent: `EXTRA_FORCE` big_discard: bool, default False Includes big bodies when performing a discard (Swifter only) + Parameter input file equivalent: `BIG_DISCARD` rhill_present: bool, default False - Include the Hill's radius with the input files. + Include the Hill's radius with the input files . + Parameter input file equivalent: `RHILL_PRESENT` restart : bool, default False If true, will restart an old run. The file given by `output_file_name` must exist before the run can execute. If false, will start a new run. If the file given by `output_file_name` exists, it will be replaced when the run is executed. + Parameter input file equivalent: `OUT_STAT` interaction_loops : {"TRIANGULAR","FLAT","ADAPTIVE"}, default "TRIANGULAR" - *Swiftest Experimental feature* + > *Swiftest Experimental feature* Specifies which algorithm to use for the computation of body-body gravitational forces. * "TRIANGULAR" : Upper-triangular double-loops . * "FLAT" : Body-body interation pairs are flattened into a 1-D array. @@ -242,8 +250,9 @@ def __init__(self, be assured, as the choice of algorithm depends on possible external factors that can influence the wall time calculation. The exact floating-point results of the interaction will be different between the two algorithm types. + Parameter input file equivalent: `INTERACTION_LOOPS` encounter_check_loops : {"TRIANGULAR","SORTSWEEP","ADAPTIVE"}, default "TRIANGULAR" - *Swiftest Experimental feature* + > *Swiftest Experimental feature* Specifies which algorithm to use for checking whether bodies are in a close encounter state or not. * "TRIANGULAR" : Upper-triangular double-loops. * "SORTSWEEP" : A Sort-Sweep algorithm is used to reduce the population of potential close encounter bodies. @@ -254,65 +263,60 @@ def __init__(self, be assured, as the choice of algorithm depends on possible external factors that can influence the wall time calculation. The exact floating-point results of the interaction will be different between the two algorithm types. + Parameter input file equivalent: `ENCOUNTER_CHECK` verbose : bool, default True If set to True, then more information is printed by Simulation methods as they are executed. Setting to False suppresses most messages other than errors. + Parameter input file equivalent: None """ - self.param = {} - self.ds = xr.Dataset() - self.verbose = verbose - self.restart = restart # Width of the column in the printed name of the parameter in parameter getters self._getter_column_width = '32' - # If the parameter file is in a different location than the current working directory, we will need - # to use it to properly open bin files - self.set_parameter(param_file=param_file) + + self.param = {} + self.ds = xr.Dataset() + + # Parameters are set in reverse priority order. First the defaults, then values from a pre-existing input file, + # then using the arguments passed via **kwargs. + + #-------------------------- + # Lowest Priority: Defaults + #-------------------------- + + # Quietly set all parameters to their defaults. + self.verbose = kwargs.pop("verbose",True) + self.set_parameter(verbose=False) + + # Set the location of the parameter input file + param_file = kwargs.pop("param_file",self.param_file) + read_param = kwargs.pop("read_param",True) + self.set_parameter(verbose=False,param_file=param_file) + + #----------------------------------------------------------------- + # Higher Priority: Values from a file (if requested and it exists) + #----------------------------------------------------------------- + + # If the user asks to read in an old parameter file, override any default parameters with values from the file + # If the file doesn't exist, flag it for now so we know to create it if read_param: if os.path.exists(self.param_file): - self.read_param(self.param_file, codename=codename.title(), verbose=self.verbose) + self.read_param(self.param_file, codename=self.codename, verbose=self.verbose) + param_file_found = True else: - print(f"{self.param_file} not found.") - - self.set_parameter(codename=codename, - integrator=integrator, - t0=t0, - tstart=tstart, - tstop=tstop, - dt=dt, - tstep_out=tstep_out, - istep_out=istep_out, - istep_dump=istep_dump, - rmin=rmin, rmax=rmax, - qmin_coord=qmin_coord, - gmtiny=gmtiny, - mtiny=mtiny, - MU=MU, DU=DU, TU=TU, - MU2KG=MU2KG, DU2M=DU2M, TU2S=TU2S, - MU_name=MU_name, DU_name=DU_name, TU_name=TU_name, - recompute_unit_values=False, - init_cond_file_type=init_cond_file_type, - init_cond_file_name=init_cond_file_name, - init_cond_format=init_cond_format, - output_file_type=output_file_type, - output_file_name=output_file_name, - output_format=output_format, - close_encounter_check=close_encounter_check, - general_relativity=general_relativity, - fragmentation=fragmentation, - minimum_fragment_gmass=minimum_fragment_gmass, - minimum_fragment_mass=minimum_fragment_mass, - rotation=rotation, - compute_conservation_values=compute_conservation_values, - extra_force=extra_force, - big_discard=big_discard, - rhill_present=rhill_present, - restart=restart, - interaction_loops=interaction_loops, - encounter_check_loops=encounter_check_loops, - ephemeris_date=ephemeris_date, - verbose=False) + param_file_found = False + # ----------------------------------------------------------------- + # Highest Priority: Values from arguments passed to Simulation() + # ----------------------------------------------------------------- + self.set_parameter(verbose=False, **kwargs) + + # Let the user know that there was a problem reading an old parameter file and we're going to create a new one + if read_param and not param_file_found: + print(f"{self.param_file} not found. Creating a new file using default values for parameters not passed to Simulation().") + self.write_param() + + # Read in an old simulation file if requested + read_old_output_file = kwargs.pop("read_old_output_file",False) if read_old_output_file: binpath = os.path.join(self.sim_dir, self.param['BIN_OUT']) if os.path.exists(binpath): @@ -321,6 +325,7 @@ def __init__(self, print(f"BIN_OUT file {binpath} not found.") return + def run(self,**kwargs): """ Runs a Swiftest integration. Uses the parameters set by the `param` dictionary unless overridden by keyword @@ -328,7 +333,7 @@ def run(self,**kwargs): Parameters ---------- - **kwargs : Any valid keyword arguments accepted by `set_parameter` or `save' + **kwargs : Any valid keyword arguments accepted by `set_parameter` Returns ------- @@ -336,8 +341,11 @@ def run(self,**kwargs): """ - self.set_parameter(**kwargs) - self.save(**kwargs) + if len(kwargs) > 0: + self.set_parameter(**kwargs) + + # Write out the current parameter set before executing run + self.write_param() if self.codename != "Swiftest": print(f"Running an integration is not yet supported for {self.codename}") @@ -345,6 +353,7 @@ def run(self,**kwargs): if self.driver_executable is None: print("Path to swiftest_driver has not been set!") + print(f"Make sure swiftest_driver is compiled and the executable is in {self.binary_path}") return print(f"Running a {self.codename} {self.integrator} run from tstart={self.param['TSTART']} {self.TU_name} to tstop={self.param['TSTOP']} {self.TU_name}") @@ -439,7 +448,7 @@ def set_simulation_time(self, A dictionary containing the requested parameters """ - if t0 is None and tstart is None and dt is None and istep_out is None and \ + if t0 is None and tstart is None and tstop is None and dt is None and istep_out is None and \ tstep_out is None and istep_dump is None: return {} @@ -582,12 +591,13 @@ def get_simulation_time(self, arg_list: str | List[str] | None = None, verbose: return time_dict - def set_parameter(self, **kwargs): + def set_parameter(self, verbose: bool = True, **kwargs): """ - Setter for all possible parameters. Calls each of the specialized setters using keyword arguments + Setter for all possible parameters. This will call each of the specialized setters using keyword arguments. + If no arguments are passed, then default values will be used. Parameters ---------- - **kwargs : [TODO: write this documentation] + **kwargs : Any argument listed listed in the Simulation class definition. Returns ------- @@ -595,15 +605,76 @@ def set_parameter(self, **kwargs): """ + default_arguments = { + "codename" : "Swiftest", + "integrator": "symba", + "param_file": "param.in", + "t0": 0.0, + "tstart": 0.0, + "tstop": None, + "dt": None, + "istep_out": None, + "tstep_out": None, + "istep_dump": None, + "init_cond_file_type": "NETCDF_DOUBLE", + "init_cond_file_name": None, + "init_cond_format": "EL", + "output_file_type": "NETCDF_DOUBLE", + "output_file_name": None, + "output_format": "XVEL", + "MU": "MSUN", + "DU": "AU", + "TU": "Y", + "MU2KG": None, + "DU2M": None, + "TU2S": None, + "MU_name": None, + "DU_name": None, + "TU_name": None, + "rmin": constants.RSun / constants.AU2M, + "rmax": 10000.0, + "qmin_coord": "HELIO", + "gmtiny": None, + "mtiny": None, + "close_encounter_check": True, + "general_relativity": True, + "fragmentation": False, + "minimum_fragment_mass": None, + "minimum_fragment_gmass": None, + "rotation": False, + "compute_conservation_values": False, + "extra_force": False, + "big_discard": False, + "rhill_present": False, + "interaction_loops": "TRIANGULAR", + "encounter_check_loops": "TRIANGULAR", + "ephemeris_date": "MBCL", + "restart": False, + } + + # If no arguments (other than, possibly, verbose) are requested, use defaults + if len(kwargs) == 0: + kwargs = default_arguments + + # Add the verbose flag to the kwargs for passing down to the individual setters + kwargs["verbose"] = verbose + + param_file = kwargs.pop("param_file",None) + + if param_file is not None: + self.param_file = os.path.realpath(param_file) + self.sim_dir = os.path.dirname(self.param_file) + + # Setters returning parameter dictionary values param_dict = {} param_dict.update(self.set_unit_system(**kwargs)) param_dict.update(self.set_integrator(**kwargs)) - param_dict.update(self.set_distance_range(**kwargs)) - param_dict.update(self.set_feature(**kwargs)) + param_dict.update(self.set_simulation_time(**kwargs)) param_dict.update(self.set_init_cond_files(**kwargs)) param_dict.update(self.set_output_files(**kwargs)) - param_dict.update(self.set_simulation_time(**kwargs)) + param_dict.update(self.set_distance_range(**kwargs)) + param_dict.update(self.set_feature(**kwargs)) # Non-returning setters self.set_ephemeris_date(**kwargs) @@ -615,7 +686,7 @@ def get_parameter(self, **kwargs): Setter for all possible parameters. Calls each of the specialized setters using keyword arguments Parameters ---------- - **kwargs : [TODO: write this documentation] + **kwargs : Any of the arguments defined in Simulation. If none provided, it returns all arguments. Returns ------- @@ -640,7 +711,6 @@ def get_parameter(self, **kwargs): def set_integrator(self, codename: Literal["swiftest", "swifter", "swift"] | None = None, integrator: Literal["symba","rmvs","whm","helio"] | None = None, - param_file: PathLike | str | None = None, mtiny: float | None = None, gmtiny: float | None = None, verbose: bool | None = None, @@ -653,8 +723,6 @@ def set_integrator(self, codename : {"swiftest", "swifter", "swift"}, optional integrator : {"symba","rmvs","whm","helio"}, optional Name of the n-body integrator that will be used when executing a run. - param_file: str or path-like, optional - Name of the input parameter file to use to read in parameter values. mtiny : float, optional The minimum mass of fully interacting bodies. Bodies below this mass interact with the larger bodies, but not each other (SyMBA only). *Note.* Only mtiny or gmtiny is accepted, not both. @@ -677,14 +745,6 @@ def set_integrator(self, update_list = [] - # Set defaults - if "codename" not in dir(self): - self.codename = "Swiftest" - if "integerator" not in dir(self): - self.integrator = "symba" - if "driver_executable" not in dir(self): - self.driver_executable = None - if codename is not None: valid_codename = ["Swiftest", "Swifter", "Swift"] if codename.title() not in valid_codename: @@ -696,7 +756,7 @@ def set_integrator(self, else: self.codename = codename.title() - self.param['! VERSION'] = f"{self.codename} parameter input" + self.param['! VERSION'] = f"{self.codename} input file" update_list.append("codename") if self.codename == "Swiftest": self.binary_path = os.path.realpath(os.path.join(os.path.dirname(os.path.realpath(_pyfile)),os.pardir,os.pardir,os.pardir,"bin")) @@ -705,7 +765,7 @@ def set_integrator(self, print(f"Cannot find the Swiftest driver in {self.binary_path}") self.driver_executable = None else: - self.binary_path = "NOT SET" + self.binary_path = "NOT IMPLEMENTED FOR THIS CODE" self.driver_executable = None update_list.append("driver_executable") @@ -721,10 +781,6 @@ def set_integrator(self, self.integrator = integrator.lower() update_list.append("integrator") - if param_file is not None: - self.param_file = os.path.realpath(param_file) - self.sim_dir = os.path.dirname(self.param_file) - if mtiny is not None or gmtiny is not None: if self.integrator != "symba": print("mtiny and gmtiny are only used by SyMBA.") @@ -764,8 +820,7 @@ def get_integrator(self,arg_list: str | List[str] | None = None, verbose: bool | The subset of the dictionary containing the code name if codename is selected """ - valid_var = {"codename": "! VERSION", - "gmtiny" : "GMTINY"} + valid_var = {"gmtiny" : "GMTINY"} valid_instance_vars = {"codename": self.codename, "integrator": self.integrator, @@ -791,14 +846,15 @@ def get_integrator(self,arg_list: str | List[str] | None = None, verbose: bool | arg_list = list(valid_instance_vars.keys()) arg_list.append(*[a for a in valid_var.keys() if a not in valid_instance_vars]) - inst_var = self._get_instance_var(arg_list, valid_instance_vars, verbose, **kwargs) - valid_arg, integrator_dict = self._get_valid_arg_list(arg_list, valid_var) if verbose: + for arg in arg_list: + if arg in valid_instance_vars: + print(f"{arg:<{self._getter_column_width}} {valid_instance_vars[arg]}") for arg in valid_arg: key = valid_var[arg] - if key in integrator_dict and key not in inst_var: + if key in integrator_dict: if arg == "gmtiny": if self.integrator == "symba": print(f"{arg:<{self._getter_column_width}} {integrator_dict[key]} {self.DU_name}^3 / {self.TU_name}^2 ") @@ -927,21 +983,27 @@ def set_feature(self, print("Minimum fragment mass is not set. Set it using minimum_fragment_gmass or minimum_fragment_mass") else: update_list.append("minimum_fragment_gmass") - update_list.append("minimum_fragment_mass") + if minimum_fragment_gmass is not None and minimum_fragment_mass is not None: print("Warning! Only set either minimum_fragment_mass or minimum_fragment_gmass, but not both!") if minimum_fragment_gmass is not None: self.param["MIN_GMFRAG"] = minimum_fragment_gmass - update_list.append("minimum_fragment_gmass") + if "minmum_fragment_gmass" not in update_list: + update_list.append("minimum_fragment_gmass") elif minimum_fragment_mass is not None: self.param["MIN_GMFRAG"] = minimum_fragment_mass * self.GU - update_list.append("minimum_fragment_gmass") + if "minimum_fragment_gmass" not in update_list: + update_list.append("minimum_fragment_gmass") if rotation is not None: self.param['ROTATION'] = rotation update_list.append("rotation") + if self.param['FRAGMENTATION'] and not self.param['ROTATION']: + self.param['ROTATION'] = True + update_list.append("rotation") + if compute_conservation_values is not None: self.param["ENERGY"] = compute_conservation_values update_list.append("compute_conservation_values") @@ -1265,6 +1327,7 @@ def set_output_files(self, "NETCDF_DOUBLE", "NETCDF_FLOAT", "REAL4", "REAL8", "XDR4", "XDR8"] | None = None, output_file_name: os.PathLike | str | None = None, output_format: Literal["XV", "XVEL"] | None = None, + restart: bool | None = None, verbose: bool | None = None, **kwargs: Any ): @@ -1285,6 +1348,8 @@ def set_output_files(self, output_format : {"XV","XVEL"}, optional Specifies the format for the data saved to the output file. If "XV" then cartesian position and velocity vectors for all bodies are stored. If "XVEL" then the orbital elements are also stored. + restart: bool, optional + Indicates whether this is a restart of an old run or a new run. verbose: bool, optional If passed, it will override the Simulation object's verbose flag **kwargs @@ -1304,6 +1369,9 @@ def set_output_files(self, update_list.append("output_file_name") if output_format is not None: update_list.append("output_format") + if restart is not None: + self.restart = restart + update_list.append("restart") if len(update_list) == 0: return {} @@ -1384,6 +1452,7 @@ def get_output_files(self, arg_list: str | List[str] | None = None, verbose: boo valid_var = {"output_file_type": "OUT_TYPE", "output_file_name": "BIN_OUT", "output_format": "OUT_FORM", + "restart": "OUT_STAT" } valid_arg, output_file_dict = self._get_valid_arg_list(arg_list, valid_var) @@ -1605,8 +1674,6 @@ def get_unit_system(self, arg_list: str | List[str] | None = None, verbose: bool """ - - valid_var = { "MU": "MU2KG", "DU": "DU2M", @@ -2298,6 +2365,7 @@ def write_param(self, if param is None: param = self.param print(f"Writing parameter inputs to file {param_file}") + param['! VERSION'] = f"{codename} input file" # Check to see if the parameter type matches the output type. If not, we need to convert if codename == "Swifter" or codename == "Swiftest": From dae7ed91572679a7d0ba0c6472877bdb2edb3764 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Tue, 15 Nov 2022 12:56:57 -0500 Subject: [PATCH 066/569] Added FRAGMENTATION to the param file writer --- python/swiftest/swiftest/io.py | 1 + 1 file changed, 1 insertion(+) diff --git a/python/swiftest/swiftest/io.py b/python/swiftest/swiftest/io.py index 64c4dc4a1..ead04cc95 100644 --- a/python/swiftest/swiftest/io.py +++ b/python/swiftest/swiftest/io.py @@ -428,6 +428,7 @@ def write_labeled_param(param, param_file_name): 'TU2S', 'DU2M', 'GMTINY', + 'FRAGMENTATION' 'MIN_GMFRAG', 'RESTART'] ptmp = param.copy() From 49fdf6b8197b85ae58d45e7511a15b315b85dfea Mon Sep 17 00:00:00 2001 From: David A Minton Date: Tue, 15 Nov 2022 14:01:55 -0500 Subject: [PATCH 067/569] Changed PathLike to os.PathLike --- python/swiftest/swiftest/simulation_class.py | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/python/swiftest/swiftest/simulation_class.py b/python/swiftest/swiftest/simulation_class.py index c8f6ebf34..4c3bf6bca 100644 --- a/python/swiftest/swiftest/simulation_class.py +++ b/python/swiftest/swiftest/simulation_class.py @@ -361,6 +361,8 @@ def run(self,**kwargs): with subprocess.Popen([self.driver_executable, self.integrator, self.param_file], stdout=subprocess.PIPE, bufsize=1,universal_newlines=True) as p: for line in p.stdout: print(line, end='') + + return def _get_valid_arg_list(self, arg_list: str | List[str] | None = None, valid_var: Dict | None = None): @@ -2335,7 +2337,7 @@ def read_param(self, param_file, codename="Swiftest", verbose=True): def write_param(self, codename: Literal["Swiftest", "Swifter", "Swift"] | None = None, - param_file: str | PathLike | None = None, + param_file: str | os.PathLike | None = None, param: Dict | None = None, **kwargs: Any): """ @@ -2506,7 +2508,7 @@ def follow(self, codestyle="Swifter"): def save(self, codename: Literal["Swiftest", "Swifter", "Swift"] | None = None, - param_file: str | PathLike | None = None, + param_file: str | os.PathLike | None = None, param: Dict | None = None, framenum: int = -1, **kwargs: Any): From 24d6afe946070882d2e55d4b182ee95c16dc4d84 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Tue, 15 Nov 2022 14:52:32 -0500 Subject: [PATCH 068/569] Fixed issue where if Simulation() is called with no arguments, parameters from file could be overridden by defaults --- python/swiftest/swiftest/simulation_class.py | 37 +++++++++++++++----- 1 file changed, 28 insertions(+), 9 deletions(-) diff --git a/python/swiftest/swiftest/simulation_class.py b/python/swiftest/swiftest/simulation_class.py index 4c3bf6bca..4dbc05610 100644 --- a/python/swiftest/swiftest/simulation_class.py +++ b/python/swiftest/swiftest/simulation_class.py @@ -22,6 +22,7 @@ import numpy.typing as npt import shutil import subprocess +import shlex from typing import ( Literal, Dict, @@ -302,6 +303,9 @@ def __init__(self,read_param: bool = True, **kwargs: Any): if os.path.exists(self.param_file): self.read_param(self.param_file, codename=self.codename, verbose=self.verbose) param_file_found = True + # We will add the parameter file to the kwarg list. This will keep the set_parameter method from + # overriding everything with defaults when there are no arguments passed to Simulation() + kwargs['param_file'] = self.param_file else: param_file_found = False @@ -358,10 +362,25 @@ def run(self,**kwargs): print(f"Running a {self.codename} {self.integrator} run from tstart={self.param['TSTART']} {self.TU_name} to tstop={self.param['TSTOP']} {self.TU_name}") - with subprocess.Popen([self.driver_executable, self.integrator, self.param_file], stdout=subprocess.PIPE, bufsize=1,universal_newlines=True) as p: + # Get current environment variables + env = os.environ.copy() + + try: + cmd = f"{self.driver_executable} {self.integrator} {self.param_file}" + p = subprocess.Popen(shlex.split(cmd), + stdout=subprocess.PIPE, + stderr=subprocess.PIPE, + env=env, + universal_newlines=True) for line in p.stdout: print(line, end='') - + res = p.communicate() + if p.returncode != 0: + for line in res[1]: + print(line, end='') + raise Exception ("Failure in swiftest_driver") + except: + print(f"Error executing main swiftest_driver program") return @@ -2308,17 +2327,17 @@ def get_nvals(ds): def read_param(self, param_file, codename="Swiftest", verbose=True): """ - Reads in a param.in file and determines whether it is a Swift/Swifter/Swiftest parameter file. + Reads in an input parameter file and stores the values in the param dictionary. Parameters ---------- - param_file : string - File name of the input parameter file - codename : string - Type of parameter file, either "Swift", "Swifter", or "Swiftest" + param_file : string + File name of the input parameter file + codename : string + Type of parameter file, either "Swift", "Swifter", or "Swiftest" Returns ------- - self.ds : xarray dataset + """ if codename == "Swiftest": param_old = self.param.copy() @@ -2347,7 +2366,7 @@ def write_param(self, ---------- codename : {"Swiftest", "Swifter", "Swift"}, optional Alternative name of the n-body code that the parameter file will be formatted for. Defaults to current instance - variable self.codename + variable codename param_file : str or path-like, optional Alternative file name of the input parameter file. Defaults to current instance variable self.param_file param: Dict, optional From dad3e36be238b1903837b5b16da110e3d267bcf9 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Tue, 15 Nov 2022 17:54:24 -0500 Subject: [PATCH 069/569] Fixed some NetCDF file problems --- src/modules/swiftest_globals.f90 | 2 +- src/netcdf/netcdf.f90 | 34 ++++++++++++++++++++++++-------- 2 files changed, 27 insertions(+), 9 deletions(-) diff --git a/src/modules/swiftest_globals.f90 b/src/modules/swiftest_globals.f90 index 47b852f5a..f6644a302 100644 --- a/src/modules/swiftest_globals.f90 +++ b/src/modules/swiftest_globals.f90 @@ -149,7 +149,7 @@ module swiftest_globals character(*), parameter :: NETCDF_OUTFILE = 'bin.nc' !! Default output file name character(*), parameter :: TIME_DIMNAME = "time" !! NetCDF name of the time dimension character(*), parameter :: ID_DIMNAME = "id" !! NetCDF name of the particle id dimension - character(*), parameter :: STR_DIMNAME = "str" !! NetCDF name of the particle id dimension + character(*), parameter :: 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 diff --git a/src/netcdf/netcdf.f90 b/src/netcdf/netcdf.f90 index c4cd12042..7075d84bc 100644 --- a/src/netcdf/netcdf.f90 +++ b/src/netcdf/netcdf.f90 @@ -198,8 +198,8 @@ module subroutine netcdf_initialize_output(self, param) ! Define the NetCDF dimensions with particle name as the record dimension call check( nf90_def_dim(self%ncid, ID_DIMNAME, NF90_UNLIMITED, self%id_dimid), "netcdf_initialize_output nf90_def_dim id_dimid" ) ! 'x' dimension - call check( nf90_def_dim(self%ncid, TIME_DIMNAME, NF90_UNLIMITED, self%time_dimid), "netcdf_initialize_output nf90_def_dim time_dimid" ) ! 'y' dimension call check( nf90_def_dim(self%ncid, STR_DIMNAME, NAMELEN, self%str_dimid), "netcdf_initialize_output nf90_def_dim str_dimid" ) ! Dimension for string variables (aka character arrays) + call check( nf90_def_dim(self%ncid, TIME_DIMNAME, NF90_UNLIMITED, self%time_dimid), "netcdf_initialize_output nf90_def_dim time_dimid" ) ! 'y' dimension select case (param%out_type) case(NETCDF_FLOAT_TYPE) @@ -361,7 +361,14 @@ module subroutine netcdf_open(self, param, readonly) call check( nf90_inq_dimid(self%ncid, TIME_DIMNAME, self%time_dimid), "netcdf_open nf90_inq_dimid time_dimid" ) call check( nf90_inq_dimid(self%ncid, ID_DIMNAME, self%id_dimid), "netcdf_open nf90_inq_dimid id_dimid" ) - call check( nf90_inquire_dimension(self%ncid, max(self%time_dimid,self%id_dimid)+1, name=str_dim_name), "netcdf_open nf90_inquire_dimension str_dim_name" ) + 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 @@ -370,7 +377,6 @@ module subroutine netcdf_open(self, param, readonly) 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, STATUS_VARNAME, self%status_varid), "netcdf_open nf90_inq_varid status_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 @@ -448,6 +454,7 @@ module subroutine netcdf_open(self, param, readonly) ! Variables The User Doesn't Need to Know About + 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) @@ -562,7 +569,7 @@ module function netcdf_read_frame_system(self, iu, param) result(ierr) class is (symba_pl) select type (param) class is (symba_parameters) - nplm_check = count(rtemp(:) > param%GMTINY .and. plmask(:)) + nplm_check = count(pack(rtemp,plmask) > param%GMTINY ) if (nplm_check /= pl%nplm) then write(*,*) "Error reading in NetCDF file: The recorded value of nplm does not match the number of active fully interacting massive bodies" call util_exit(failure) @@ -774,17 +781,23 @@ module subroutine netcdf_read_hdr_system(self, iu, param) tslot = int(param%ioutput, kind=I4B) + 1 call check( nf90_inquire_dimension(iu%ncid, iu%id_dimid, len=idmax), "netcdf_read_frame_system nf90_inquire_dimension id_dimid" ) call check( nf90_get_var(iu%ncid, iu%time_varid, param%t, start=[tslot]), "netcdf_read_hdr_system nf90_getvar time_varid" ) - call check( nf90_get_var(iu%ncid, iu%Gmass_varid, gmtemp, start=[1,1]), "netcdf_read_frame_system nf90_getvar Gmass_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" ) + plmask(:) = gmtemp(:) == gmtemp(:) tpmask(:) = .not. plmask(:) plmask(1) = .false. ! This is the central body select type (param) class is (symba_parameters) - plmmask(:) = gmtemp(:) > param%GMTINY .and. plmask(:) + plmmask(:) = plmask(:) + where(plmask(:)) + plmmask(:) = gmtemp(:) > param%GMTINY + endwhere end select status = nf90_inq_varid(iu%ncid, NPL_VARNAME, iu%npl_varid) @@ -920,8 +933,13 @@ module subroutine netcdf_read_particle_info_system(self, iu, param, plmask, tpma call tp%info(i)%set_value(particle_type=ctemp(tpind(i))) end do - call check( nf90_get_var(iu%ncid, iu%status_varid, ctemp, count=[NAMELEN, idmax]), "netcdf_read_particle_info_system nf90_getvar status_varid" ) - call cb%info%set_value(status=ctemp(1)) + status = nf90_inq_varid(iu%ncid, STATUS_VARNAME, iu%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 cb%info%set_value(status=ctemp(1)) + else + call cb%info%set_value(status="ACTIVE") + end if do i = 1, npl call pl%info(i)%set_value(status=ctemp(plind(i))) end do From fa59dad8b886c2f15f83a8279a961a491517e60c Mon Sep 17 00:00:00 2001 From: David A Minton Date: Tue, 15 Nov 2022 18:11:40 -0500 Subject: [PATCH 070/569] Fixed problems when using EL input --- src/netcdf/netcdf.f90 | 35 ++++++++++++++++++++++++++++------- src/orbel/orbel.f90 | 1 - 2 files changed, 28 insertions(+), 8 deletions(-) diff --git a/src/netcdf/netcdf.f90 b/src/netcdf/netcdf.f90 index 7075d84bc..2cca37386 100644 --- a/src/netcdf/netcdf.f90 +++ b/src/netcdf/netcdf.f90 @@ -619,28 +619,39 @@ module function netcdf_read_frame_system(self, iu, param) result(ierr) end if if ((param%in_form == EL) .or. (param%in_form == XVEL)) then - call check( nf90_get_var(iu%ncid, iu%a_varid, rtemp, start=[1, tslot]), "netcdf_read_frame_system nf90_getvar a_varid" ) + if (.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" ) + 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" ) + 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" ) + 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" ) + 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" ) + if (.not.allocated(pl%capm)) allocate(pl%capm(npl)) + if (.not.allocated(tp%capm)) allocate(tp%capm(ntp)) if (npl > 0) pl%capm(:) = pack(rtemp, plmask) if (ntp > 0) tp%capm(:) = pack(rtemp, tpmask) @@ -740,6 +751,10 @@ module function netcdf_read_frame_system(self, iu, param) result(ierr) call self%read_particle_info(iu, 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 call pl%set_mu(cb) @@ -984,21 +999,24 @@ module subroutine netcdf_read_particle_info_system(self, iu, param, plmask, tpma 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" ) else - call check( nf90_get_var(iu%ncid, iu%xhx_varid, rtemp_arr(1,:)), "netcdf_read_particle_info_system nf90_getvar xhx_varid" ) + ! [TODO]: This doesn't work when the input mode is EL. This needs to get filled in later after xv2el has been called + ! call check( nf90_get_var(iu%ncid, iu%xhx_varid, rtemp_arr(1,:)), "netcdf_read_particle_info_system nf90_getvar xhx_varid" ) 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 - call check( nf90_get_var(iu%ncid, iu%xhy_varid, rtemp_arr(2,:)), "netcdf_read_particle_info_system nf90_getvar xhy_varid" ) + ! [TODO]: This doesn't work when the input mode is EL. This needs to get filled in later after xv2el has been called + ! call check( nf90_get_var(iu%ncid, iu%xhy_varid, rtemp_arr(2,:)), "netcdf_read_particle_info_system nf90_getvar xhy_varid" ) 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 - call check( nf90_get_var(iu%ncid, iu%xhz_varid, rtemp_arr(3,:)), "netcdf_read_particle_info_system nf90_getvar xhz_varid" ) + ! [TODO]: This doesn't work when the input mode is EL. This needs to get filled in later after xv2el has been called + ! call check( nf90_get_var(iu%ncid, iu%xhz_varid, rtemp_arr(3,:)), "netcdf_read_particle_info_system nf90_getvar xhz_varid" ) end if do i = 1, npl @@ -1012,21 +1030,24 @@ module subroutine netcdf_read_particle_info_system(self, iu, param, plmask, tpma 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" ) else - call check( nf90_get_var(iu%ncid, iu%vhx_varid, rtemp_arr(1,:)), "netcdf_read_particle_info_system nf90_getvar vhx_varid" ) + ! [TODO]: This doesn't work when the input mode is EL. This needs to get filled in later after xv2el has been called + ! call check( nf90_get_var(iu%ncid, iu%vhx_varid, rtemp_arr(1,:)), "netcdf_read_particle_info_system nf90_getvar vhx_varid" ) 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 - call check( nf90_get_var(iu%ncid, iu%vhy_varid, rtemp_arr(2,:)), "netcdf_read_particle_info_system nf90_getvar vhy_varid" ) + ! [TODO]: This doesn't work when the input mode is EL. This needs to get filled in later after xv2el has been called + ! call check( nf90_get_var(iu%ncid, iu%vhy_varid, rtemp_arr(2,:)), "netcdf_read_particle_info_system nf90_getvar vhy_varid" ) 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 - call check( nf90_get_var(iu%ncid, iu%vhz_varid, rtemp_arr(3,:)), "netcdf_read_particle_info_system nf90_getvar vhz_varid" ) + ! [TODO]: This doesn't work when the input mode is EL. This needs to get filled in later after xv2el has been called + ! call check( nf90_get_var(iu%ncid, iu%vhz_varid, rtemp_arr(3,:)), "netcdf_read_particle_info_system nf90_getvar vhz_varid" ) end if do i = 1, npl diff --git a/src/orbel/orbel.f90 b/src/orbel/orbel.f90 index 9dc68c397..5e7c4a989 100644 --- a/src/orbel/orbel.f90 +++ b/src/orbel/orbel.f90 @@ -30,7 +30,6 @@ module subroutine orbel_el2xv_vec(self, cb) 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)) end do - deallocate(self%a, self%e, self%inc, self%capom, self%omega, self%capm) return end subroutine orbel_el2xv_vec From 928f3f1a37d3e03ca9d3c046b7b73dae23871e65 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Tue, 15 Nov 2022 18:15:08 -0500 Subject: [PATCH 071/569] Updated initial conditions script and a script that runs from input file --- examples/Basic_Simulation/initial_conditions.py | 2 -- examples/Basic_Simulation/run_from_file.py | 3 +++ 2 files changed, 3 insertions(+), 2 deletions(-) create mode 100644 examples/Basic_Simulation/run_from_file.py diff --git a/examples/Basic_Simulation/initial_conditions.py b/examples/Basic_Simulation/initial_conditions.py index de5a8fcad..95fdb608e 100644 --- a/examples/Basic_Simulation/initial_conditions.py +++ b/examples/Basic_Simulation/initial_conditions.py @@ -74,5 +74,3 @@ # Save everything to a set of initial conditions files sim.run() - -print("All done!") diff --git a/examples/Basic_Simulation/run_from_file.py b/examples/Basic_Simulation/run_from_file.py new file mode 100644 index 000000000..cede6e2ea --- /dev/null +++ b/examples/Basic_Simulation/run_from_file.py @@ -0,0 +1,3 @@ +import swiftest +sim = swiftest.Simulation() +sim.run() \ No newline at end of file From fdfd6d64060bb5dc4e3bac58d7fffc20487eb200 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Wed, 16 Nov 2022 15:04:32 -0500 Subject: [PATCH 072/569] Wrapped the call to swiftest_driver in a shell script that is generated at runtime. Not elegant, but works (so far) --- python/swiftest/swiftest/simulation_class.py | 14 +++++++++++++- 1 file changed, 13 insertions(+), 1 deletion(-) diff --git a/python/swiftest/swiftest/simulation_class.py b/python/swiftest/swiftest/simulation_class.py index 4dbc05610..f067f842c 100644 --- a/python/swiftest/swiftest/simulation_class.py +++ b/python/swiftest/swiftest/simulation_class.py @@ -364,9 +364,17 @@ def run(self,**kwargs): # Get current environment variables env = os.environ.copy() + driver_script = os.path.join(self.binary_path,"swiftest_driver.sh") + shell = os.path.basename(env['SHELL']) + with open(driver_script,'w') as f: + f.write(f"#{env['SHELL']} -l {os.linesep}") + f.write(f"source ~/.{shell}rc {os.linesep}") + f.write(f"cd {self.sim_dir} {os.linesep}") + f.write(f"pwd {os.linesep}") + f.write(f"{self.driver_executable} {self.integrator} {self.param_file}") try: - cmd = f"{self.driver_executable} {self.integrator} {self.param_file}" + cmd = f"{env['SHELL']} -l {driver_script}" p = subprocess.Popen(shlex.split(cmd), stdout=subprocess.PIPE, stderr=subprocess.PIPE, @@ -374,6 +382,8 @@ def run(self,**kwargs): universal_newlines=True) for line in p.stdout: print(line, end='') + for line in p.stderr: + print(line, end='') res = p.communicate() if p.returncode != 0: for line in res[1]: @@ -2032,6 +2042,7 @@ def add_solar_system_body(self, J2=J2, J4=J4, t=t) dsnew = self._combine_and_fix_dsnew(dsnew) + self.save() return dsnew @@ -2284,6 +2295,7 @@ def input_to_array(val,t,n=None): J2=J2, J4=J4,t=t) dsnew = self._combine_and_fix_dsnew(dsnew) + self.save() return dsnew From 0b3db9f76d47886dccff3e6080af3c5b537e3414 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Wed, 16 Nov 2022 15:06:04 -0500 Subject: [PATCH 073/569] Streamlined output by not reporting the contents of param.in on startup, as we can do that on the python side now. Also added a better error message for when a NetCDF file can't be found --- src/io/io.f90 | 2 +- src/netcdf/netcdf.f90 | 4 +++- 2 files changed, 4 insertions(+), 2 deletions(-) diff --git a/src/io/io.f90 b/src/io/io.f90 index aa797ddbe..6dfa6499e 100644 --- a/src/io/io.f90 +++ b/src/io/io.f90 @@ -929,7 +929,7 @@ module subroutine io_param_reader(self, unit, iotype, v_list, iostat, iomsg) iostat = 0 ! Print the contents of the parameter file to standard output - call param%writer(unit = OUTPUT_UNIT, iotype = "none", v_list = [0], iostat = iostat, iomsg = iomsg) + ! call param%writer(unit = OUTPUT_UNIT, iotype = "none", v_list = [0], iostat = iostat, iomsg = iomsg) end associate diff --git a/src/netcdf/netcdf.f90 b/src/netcdf/netcdf.f90 index 2cca37386..4c037a291 100644 --- a/src/netcdf/netcdf.f90 +++ b/src/netcdf/netcdf.f90 @@ -351,13 +351,15 @@ module subroutine netcdf_open(self, param, readonly) ! Internals integer(I4B) :: mode, status character(len=NF90_MAX_NAME) :: str_dim_name + character(len=STRMAX) :: errmsg mode = NF90_WRITE if (present(readonly)) then if (readonly) mode = NF90_NOWRITE end if - call check( nf90_open(param%outfile, mode, self%ncid), "netcdf_open nf90_open" ) + write(errmsg,*) "netcdf_open nf90_open ",trim(adjustl(param%outfile)) + call check( nf90_open(param%outfile, mode, self%ncid), errmsg) 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" ) From ec048b682f1f7497bc90d2abd2ef9206de057ccc Mon Sep 17 00:00:00 2001 From: David A Minton Date: Wed, 16 Nov 2022 15:28:13 -0500 Subject: [PATCH 074/569] Added TSTART and RESTART as valid input variables (they don't do anything yet) --- src/io/io.f90 | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/src/io/io.f90 b/src/io/io.f90 index 6dfa6499e..86cf55728 100644 --- a/src/io/io.f90 +++ b/src/io/io.f90 @@ -566,6 +566,7 @@ module subroutine io_param_reader(self, unit, iotype, v_list, iostat, iomsg) character(len=*), intent(inout) :: iomsg !! Message to pass if iostat /= 0 ! Internals logical :: t0_set = .false. !! Is the initial time set in the input file? + logical :: tstart_set = .false. !! Is the final time set in the input file? logical :: tstop_set = .false. !! Is the final time set in the input file? logical :: dt_set = .false. !! Is the step size set in the input file? integer(I4B) :: ilength, ifirst, ilast, i !! Variables used to parse input file @@ -593,6 +594,9 @@ module subroutine io_param_reader(self, unit, iotype, v_list, iostat, iomsg) case ("T0") read(param_value, *, err = 667, iomsg = iomsg) param%t0 t0_set = .true. + case ("TSTART") + read(param_value, *, err = 667, iomsg = iomsg) param%t0 + tstart_set = .true. case ("TSTOP") read(param_value, *, err = 667, iomsg = iomsg) param%tstop tstop_set = .true. @@ -743,6 +747,12 @@ module subroutine io_param_reader(self, unit, iotype, v_list, iostat, iomsg) read(param_value, *, err = 667, iomsg = iomsg) param%maxid_collision case ("PARTICLE_OUT") param%particle_out = param_value + case ("RESTART") + if (param_value == "NO" .or. param_value == 'F') then + param%lrestart = .false. + else if (param_value == "YES" .or. param_value == 'T') then + param%lrestart = .true. + end if case ("NPLMAX", "NTPMAX", "GMTINY", "MIN_GMFRAG", "FRAGMENTATION", "SEED", "YARKOVSKY", "YORP") ! Ignore SyMBA-specific, not-yet-implemented, or obsolete input parameters case default write(*,*) "Ignoring unknown parameter -> ",param_name From 87f4ca7a1964ac54db23581f9f0d07a96f57178f Mon Sep 17 00:00:00 2001 From: David A Minton Date: Wed, 16 Nov 2022 16:39:29 -0500 Subject: [PATCH 075/569] Checks if 'name' variable is unique, and if so, uses that as the dimension coordinate instead of id --- python/swiftest/swiftest/io.py | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/python/swiftest/swiftest/io.py b/python/swiftest/swiftest/io.py index 2ec86f108..64d3f0c6e 100644 --- a/python/swiftest/swiftest/io.py +++ b/python/swiftest/swiftest/io.py @@ -852,6 +852,10 @@ def swiftest2xr(param, verbose=True): ds = fix_types(ds,ftype=np.float64) elif param['OUT_TYPE'] == "NETCDF_FLOAT": ds = fix_types(ds,ftype=np.float32) + # Check if the name variable contains unique values. If so, make name the dimension instead of id + if len(np.unique(ds['name'])) == len(ds['name']): + ds = ds.swap_dims({"id" : "name"}) + sim.ds.reset_coords("id") else: print(f"Error encountered. OUT_TYPE {param['OUT_TYPE']} not recognized.") return None From 5fa3a4c6c6373f35287cce8136a2c0412a5e1669 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Wed, 16 Nov 2022 16:40:06 -0500 Subject: [PATCH 076/569] Fixed issue where too many of the time variables were being reported out when one changed. --- python/swiftest/swiftest/simulation_class.py | 159 ++++++++++--------- 1 file changed, 81 insertions(+), 78 deletions(-) diff --git a/python/swiftest/swiftest/simulation_class.py b/python/swiftest/swiftest/simulation_class.py index f067f842c..5df0c3edb 100644 --- a/python/swiftest/swiftest/simulation_class.py +++ b/python/swiftest/swiftest/simulation_class.py @@ -23,6 +23,7 @@ import shutil import subprocess import shlex +import warnings from typing import ( Literal, Dict, @@ -316,7 +317,7 @@ def __init__(self,read_param: bool = True, **kwargs: Any): # Let the user know that there was a problem reading an old parameter file and we're going to create a new one if read_param and not param_file_found: - print(f"{self.param_file} not found. Creating a new file using default values for parameters not passed to Simulation().") + warnings.warn(f"{self.param_file} not found. Creating a new file using default values for parameters not passed to Simulation().") self.write_param() # Read in an old simulation file if requested @@ -326,7 +327,7 @@ def __init__(self,read_param: bool = True, **kwargs: Any): if os.path.exists(binpath): self.bin2xr() else: - print(f"BIN_OUT file {binpath} not found.") + warnings.warn(f"BIN_OUT file {binpath} not found.") return @@ -352,12 +353,12 @@ def run(self,**kwargs): self.write_param() if self.codename != "Swiftest": - print(f"Running an integration is not yet supported for {self.codename}") + warnings.warn(f"Running an integration is not yet supported for {self.codename}") return if self.driver_executable is None: - print("Path to swiftest_driver has not been set!") - print(f"Make sure swiftest_driver is compiled and the executable is in {self.binary_path}") + warnings.warn("Path to swiftest_driver has not been set!") + warnings.warn(f"Make sure swiftest_driver is compiled and the executable is in {self.binary_path}") return print(f"Running a {self.codename} {self.integrator} run from tstart={self.param['TSTART']} {self.TU_name} to tstop={self.param['TSTOP']} {self.TU_name}") @@ -370,27 +371,28 @@ def run(self,**kwargs): f.write(f"#{env['SHELL']} -l {os.linesep}") f.write(f"source ~/.{shell}rc {os.linesep}") f.write(f"cd {self.sim_dir} {os.linesep}") - f.write(f"pwd {os.linesep}") f.write(f"{self.driver_executable} {self.integrator} {self.param_file}") try: cmd = f"{env['SHELL']} -l {driver_script}" - p = subprocess.Popen(shlex.split(cmd), + with subprocess.Popen(shlex.split(cmd), stdout=subprocess.PIPE, stderr=subprocess.PIPE, env=env, - universal_newlines=True) - for line in p.stdout: - print(line, end='') - for line in p.stderr: - print(line, end='') - res = p.communicate() - if p.returncode != 0: - for line in res[1]: - print(line, end='') - raise Exception ("Failure in swiftest_driver") + universal_newlines=True) as p: + for line in p.stdout: + print(line, end='') + res = p.communicate() + if p.returncode != 0: + for line in res[1]: + print(line, end='') + raise Exception ("Failure in swiftest_driver") except: - print(f"Error executing main swiftest_driver program") + warnings.warn(f"Error executing main swiftest_driver program") + return + + # Read in new data + self.bin2xr() return @@ -509,7 +511,7 @@ def set_simulation_time(self, if tstop is not None: if tstop <= tstart: - print("Error! tstop must be greater than tstart.") + warnings.warn("tstop must be greater than tstart.") return {} if tstop is not None: @@ -522,8 +524,8 @@ def set_simulation_time(self, if dt is not None and tstop is not None: if dt > (tstop - tstart): - print("Error! dt must be smaller than tstop-tstart") - print(f"Setting dt = {tstop - tstart} instead of {dt}") + warnings.warn("dt must be smaller than tstop-tstart") + warnings.warn(f"Setting dt = {tstop - tstart} instead of {dt}") dt = tstop - tstart if dt is not None: @@ -531,26 +533,27 @@ def set_simulation_time(self, if istep_out is None and tstep_out is None: istep_out = self.param.pop("ISTEP_OUT", None) - - if istep_out is not None and tstep_out is not None: - print("Error! istep_out and tstep_out cannot both be set") + elif istep_out is not None and tstep_out is not None: + warnings.warn("istep_out and tstep_out cannot both be set") return {} + else: + update_list.append("istep_out") if tstep_out is not None and dt is not None: istep_out = int(np.floor(tstep_out / dt)) if istep_out is not None: self.param['ISTEP_OUT'] = istep_out - update_list.append("istep_out") if istep_dump is None: istep_dump = self.param.pop("ISTEP_DUMP", None) if istep_dump is None: istep_dump = istep_out + else: + update_list.append("istep_dump") if istep_dump is not None: self.param['ISTEP_DUMP'] = istep_dump - update_list.append("istep_dump") time_dict = self.get_simulation_time(update_list, verbose=verbose) @@ -779,7 +782,7 @@ def set_integrator(self, if codename is not None: valid_codename = ["Swiftest", "Swifter", "Swift"] if codename.title() not in valid_codename: - print(f"{codename} is not a valid codename. Valid options are ",",".join(valid_codename)) + warnings.warn(f"{codename} is not a valid codename. Valid options are ",",".join(valid_codename)) try: self.codename except: @@ -793,7 +796,7 @@ def set_integrator(self, self.binary_path = os.path.realpath(os.path.join(os.path.dirname(os.path.realpath(_pyfile)),os.pardir,os.pardir,os.pardir,"bin")) self.driver_executable = os.path.join(self.binary_path,"swiftest_driver") if not os.path.exists(self.driver_executable): - print(f"Cannot find the Swiftest driver in {self.binary_path}") + warnings.warn(f"Cannot find the Swiftest driver in {self.binary_path}") self.driver_executable = None else: self.binary_path = "NOT IMPLEMENTED FOR THIS CODE" @@ -803,7 +806,7 @@ def set_integrator(self, if integrator is not None: valid_integrator = ["symba","rmvs","whm","helio"] if integrator.lower() not in valid_integrator: - print(f"{integrator} is not a valid integrator. Valid options are ",",".join(valid_integrator)) + warnings.warn(f"{integrator} is not a valid integrator. Valid options are ",",".join(valid_integrator)) try: self.integrator except: @@ -814,9 +817,9 @@ def set_integrator(self, if mtiny is not None or gmtiny is not None: if self.integrator != "symba": - print("mtiny and gmtiny are only used by SyMBA.") + warnings.warn("mtiny and gmtiny are only used by SyMBA.") if mtiny is not None and gmtiny is not None: - print("Only set mtiny or gmtiny, not both!") + warnings.warn("Only set mtiny or gmtiny, not both!") elif gmtiny is not None: self.param['GMTINY'] = gmtiny update_list.append("gmtiny") @@ -861,13 +864,13 @@ def get_integrator(self,arg_list: str | List[str] | None = None, verbose: bool | try: self.integrator except: - print(f"integrator is not set") + warnings.warn(f"integrator is not set") return {} try: self.codename except: - print(f"codename is not set") + warnings.warn(f"codename is not set") return {} if verbose is None: @@ -1004,19 +1007,19 @@ def set_feature(self, if fragmentation is not None: if self.codename != "Swiftest" and self.integrator != "symba" and fragmentation: - print("Fragmentation is only available on Swiftest SyMBA.") + warnings.warn("Fragmentation is only available on Swiftest SyMBA.") self.param['FRAGMENTATION'] = False else: self.param['FRAGMENTATION'] = fragmentation update_list.append("fragmentation") if fragmentation: if "MIN_GMFRAG" not in self.param and minimum_fragment_mass is None and minimum_fragment_gmass is None: - print("Minimum fragment mass is not set. Set it using minimum_fragment_gmass or minimum_fragment_mass") + warnings.warn("Minimum fragment mass is not set. Set it using minimum_fragment_gmass or minimum_fragment_mass") else: update_list.append("minimum_fragment_gmass") if minimum_fragment_gmass is not None and minimum_fragment_mass is not None: - print("Warning! Only set either minimum_fragment_mass or minimum_fragment_gmass, but not both!") + warnings.warn("Only set either minimum_fragment_mass or minimum_fragment_gmass, but not both!") if minimum_fragment_gmass is not None: self.param["MIN_GMFRAG"] = minimum_fragment_gmass @@ -1061,8 +1064,8 @@ def set_feature(self, if interaction_loops is not None: valid_vals = ["TRIANGULAR", "FLAT", "ADAPTIVE"] if interaction_loops not in valid_vals: - print(f"{interaction_loops} is not a valid option for interaction loops.") - print(f"Must be one of {valid_vals}") + warnings.warn(f"{interaction_loops} is not a valid option for interaction loops.") + warnings.warn(f"Must be one of {valid_vals}") if "INTERACTION_LOOPS" not in self.param: self.param["INTERACTION_LOOPS"] = valid_vals[0] else: @@ -1072,8 +1075,8 @@ def set_feature(self, if encounter_check_loops is not None: valid_vals = ["TRIANGULAR", "SORTSWEEP", "ADAPTIVE"] if encounter_check_loops not in valid_vals: - print(f"{encounter_check_loops} is not a valid option for interaction loops.") - print(f"Must be one of {valid_vals}") + warnings.warn(f"{encounter_check_loops} is not a valid option for interaction loops.") + warnings.warn(f"Must be one of {valid_vals}") if "ENCOUNTER_CHECK" not in self.param: self.param["ENCOUNTER_CHECK"] = valid_vals[0] else: @@ -1204,13 +1207,13 @@ def set_init_cond_files(self, return {} def ascii_file_input_error_msg(codename): - print(f"Error in set_init_cond_files: init_cond_file_name must be a dictionary of the form: ") - print('{') + warnings.warn(f"in set_init_cond_files: init_cond_file_name must be a dictionary of the form: ") + warnings.warn('{') if codename == "Swiftest": - print('"CB" : *path to central body initial conditions file*,') - print('"PL" : *path to massive body initial conditions file*,') - print('"TP" : *path to test particle initial conditions file*') - print('}') + warnings.warn('"CB" : *path to central body initial conditions file*,') + warnings.warn('"PL" : *path to massive body initial conditions file*,') + warnings.warn('"TP" : *path to test particle initial conditions file*') + warnings.warn('}') return {} if init_cond_format is None: @@ -1230,21 +1233,21 @@ def ascii_file_input_error_msg(codename): else: init_cond_keys = ["PL", "TP"] if init_cond_file_type != "ASCII": - print(f"{init_cond_file_type} is not supported by {self.codename}. Using ASCII instead") + warnings.warn(f"{init_cond_file_type} is not supported by {self.codename}. Using ASCII instead") init_cond_file_type = "ASCII" if init_cond_format != "XV": - print(f"{init_cond_format} is not supported by {self.codename}. Using XV instead") + warnings.warn(f"{init_cond_format} is not supported by {self.codename}. Using XV instead") init_cond_format = "XV" valid_formats = {"EL", "XV"} if init_cond_format not in valid_formats: - print(f"{init_cond_format} is not a valid input format") + warnings.warn(f"{init_cond_format} is not a valid input format") else: self.param['IN_FORM'] = init_cond_format valid_types = {"NETCDF_DOUBLE", "NETCDF_FLOAT", "ASCII"} if init_cond_file_type not in valid_types: - print(f"{init_cond_file_type} is not a valid input type") + warnings.warn(f"{init_cond_file_type} is not a valid input type") else: self.param['IN_TYPE'] = init_cond_file_type @@ -1271,7 +1274,7 @@ def ascii_file_input_error_msg(codename): elif type(init_cond_file_name) is dict: # Oops, accidentally passed a dictionary instead of the expected single string or path-like for NetCDF # input type. - print(f"Only a single input file is used for NetCDF files") + warnings.warn(f"Only a single input file is used for NetCDF files") else: self.param["NC_IN"] = init_cond_file_name @@ -1412,7 +1415,7 @@ def set_output_files(self, if output_file_type is None: output_file_type = "NETCDF_DOUBLE" elif output_file_type not in ["NETCDF_DOUBLE", "NETCDF_FLOAT"]: - print(f"{output_file_type} is not compatible with Swiftest. Setting to NETCDF_DOUBLE") + warnings.warn(f"{output_file_type} is not compatible with Swiftest. Setting to NETCDF_DOUBLE") output_file_type = "NETCDF_DOUBLE" elif self.codename == "Swifter": if output_file_type is None: @@ -1420,7 +1423,7 @@ def set_output_files(self, if output_file_type is None: output_file_type = "REAL8" elif output_file_type not in ["REAL4", "REAL8", "XDR4", "XDR8"]: - print(f"{output_file_type} is not compatible with Swifter. Setting to REAL8") + warnings.warn(f"{output_file_type} is not compatible with Swifter. Setting to REAL8") output_file_type = "REAL8" elif self.codename == "Swift": if output_file_type is None: @@ -1428,7 +1431,7 @@ def set_output_files(self, if output_file_type is None: output_file_type = "REAL4" if output_file_type not in ["REAL4"]: - print(f"{output_file_type} is not compatible with Swift. Setting to REAL4") + warnings.warn(f"{output_file_type} is not compatible with Swift. Setting to REAL4") output_file_type = "REAL4" self.param['OUT_TYPE'] = output_file_type @@ -1441,7 +1444,7 @@ def set_output_files(self, self.param['BIN_OUT'] = output_file_name if output_format != "XV" and self.codename != "Swiftest": - print(f"{output_format} is not compatible with {self.codename}. Setting to XV") + warnings.warn(f"{output_format} is not compatible with {self.codename}. Setting to XV") output_format = "XV" self.param["OUT_FORM"] = output_format @@ -1616,7 +1619,7 @@ def set_unit_system(self, self.param['MU2KG'] = 1000.0 self.MU_name = "g" else: - print(f"{MU} not a recognized unit system. Using MSun as a default.") + warnings.warn(f"{MU} not a recognized unit system. Using MSun as a default.") self.param['MU2KG'] = constants.MSun self.MU_name = "MSun" @@ -1639,7 +1642,7 @@ def set_unit_system(self, self.param['DU2M'] = 100.0 self.DU_name = "cm" else: - print(f"{DU} not a recognized unit system. Using AU as a default.") + warnings.warn(f"{DU} not a recognized unit system. Using AU as a default.") self.param['DU2M'] = constants.AU2M self.DU_name = "AU" @@ -1659,7 +1662,7 @@ def set_unit_system(self, self.param['TU2S'] = 1.0 self.TU_name = "s" else: - print(f"{TU} not a recognized unit system. Using YR as a default.") + warnings.warn(f"{TU} not a recognized unit system. Using YR as a default.") self.param['TU2S'] = constants.YR2S self.TU_name = "y" @@ -1842,7 +1845,7 @@ def set_distance_range(self, if qmin_coord is not None: valid_qmin_coord = ["HELIO","BARY"] if qmin_coord.upper() not in valid_qmin_coord: - print(f"qmin_coord = {qmin_coord} is not a valid option. Must be one of",','.join(valid_qmin_coord)) + warnings.warn(f"qmin_coord = {qmin_coord} is not a valid option. Must be one of",','.join(valid_qmin_coord)) self.param['CHK_QMIN_COORD'] = valid_qmin_coord[0] else: self.param['CHK_QMIN_COORD'] = qmin_coord.upper() @@ -1965,7 +1968,7 @@ def add_solar_system_body(self, if type(ephemeris_id) is int: ephemeris_id = [ephemeris_id] if len(ephemeris_id) != len(name): - print(f"Error! The length of ephemeris_id ({len(ephemeris_id)}) does not match the length of name ({len(name)})") + warnings.warn(f"The length of ephemeris_id ({len(ephemeris_id)}) does not match the length of name ({len(name)})") return None else: ephemeris_id = [None] * len(name) @@ -1978,11 +1981,11 @@ def add_solar_system_body(self, try: datetime.datetime.fromisoformat(date) except: - print(f"{date} is not a valid date format. Must be 'YYYY-MM-DD'. Setting to {self.ephemeris_date}") + warnings.warn(f"{date} is not a valid date format. Must be 'YYYY-MM-DD'. Setting to {self.ephemeris_date}") date = self.ephemeris_date if source.upper() != "HORIZONS": - print("Currently only the JPL Horizons ephemeris service is supported") + warnings.warn("Currently only the JPL Horizons ephemeris service is supported") body_list = [] for i,n in enumerate(name): @@ -2087,8 +2090,8 @@ def set_ephemeris_date(self, datetime.datetime.fromisoformat(ephemeris_date) except: valid_date_args = ['"MBCL"', '"TODAY"', '"YYYY-MM-DD"'] - print(f"{ephemeris_date} is not a valid format. Valid options include:", ', '.join(valid_date_args)) - print("Using MBCL for date.") + warnings.warn(f"{ephemeris_date} is not a valid format. Valid options include:", ', '.join(valid_date_args)) + warnings.warn("Using MBCL for date.") ephemeris_date = minton_bcl self.ephemeris_date = ephemeris_date @@ -2123,7 +2126,7 @@ def get_ephemeris_date(self, arg_list: str | List[str] | None = None, verbose: b try: self.ephemeris_date except: - print(f"ephemeris_date is not set") + warnings.warn(f"ephemeris_date is not set") return valid_arg = {"ephemeris_date": self.ephemeris_date} @@ -2362,7 +2365,7 @@ def read_param(self, param_file, codename="Swiftest", verbose=True): self.param = io.read_swift_param(param_file, verbose=verbose) self.codename = "Swift" else: - print(f'{codename} is not a recognized code name. Valid options are "Swiftest", "Swifter", or "Swift".') + warnings.warn(f'{codename} is not a recognized code name. Valid options are "Swiftest", "Swifter", or "Swift".') self.codename = "Unknown" return @@ -2412,7 +2415,7 @@ def write_param(self, elif codename == "Swift": io.write_swift_param(param, param_file) else: - print( 'Cannot process unknown code type. Call the read_param method with a valid code name. Valid options are "Swiftest", "Swifter", or "Swift".') + warnings.warn('Cannot process unknown code type. Call the read_param method with a valid code name. Valid options are "Swiftest", "Swifter", or "Swift".') return def convert(self, param_file, newcodename="Swiftest", plname="pl.swiftest.in", tpname="tp.swiftest.in", @@ -2442,10 +2445,10 @@ def convert(self, param_file, newcodename="Swiftest", plname="pl.swiftest.in", t """ oldparam = self.param if self.codename == newcodename: - print(f"This parameter configuration is already in {newcodename} format") + warnings.warn(f"This parameter configuration is already in {newcodename} format") return oldparam if newcodename != "Swift" and newcodename != "Swifter" and newcodename != "Swiftest": - print(f'{newcodename} is an invalid code type. Valid options are "Swiftest", "Swifter", or "Swift".') + warnings.warn(f'{newcodename} is an invalid code type. Valid options are "Swiftest", "Swifter", or "Swift".') return oldparam goodconversion = True if self.codename == "Swifter": @@ -2466,7 +2469,7 @@ def convert(self, param_file, newcodename="Swiftest", plname="pl.swiftest.in", t if goodconversion: self.write_param(param_file) else: - print(f"Conversion from {self.codename} to {newcodename} is not supported.") + warnings.warn(f"Conversion from {self.codename} to {newcodename} is not supported.") return oldparam def bin2xr(self): @@ -2485,7 +2488,7 @@ 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.dir_path, self.param['BIN_OUT']) + param_tmp['BIN_OUT'] = os.path.join(self.sim_dir, self.param['BIN_OUT']) if self.codename == "Swiftest": self.ds = io.swiftest2xr(param_tmp, verbose=self.verbose) if self.verbose: print('Swiftest simulation data stored as xarray DataSet .ds') @@ -2493,10 +2496,9 @@ def bin2xr(self): self.ds = io.swifter2xr(param_tmp, verbose=self.verbose) if self.verbose: print('Swifter simulation data stored as xarray DataSet .ds') elif self.codename == "Swift": - print("Reading Swift simulation data is not implemented yet") + warnings.warn("Reading Swift simulation data is not implemented yet") else: - print( - 'Cannot process unknown code type. Call the read_param method with a valid code name. Valid options are "Swiftest", "Swifter", or "Swift".') + warnings.warn('Cannot process unknown code type. Call the read_param method with a valid code name. Valid options are "Swiftest", "Swifter", or "Swift".') return def follow(self, codestyle="Swifter"): @@ -2527,7 +2529,7 @@ def follow(self, codestyle="Swifter"): i_list = [i for i in line.split(" ") if i.strip()] nskp = int(i_list[0]) except IOError: - print('No follow.in file found') + warnings.warn('No follow.in file found') ifol = None nskp = None fol = tool.follow_swift(self.ds, ifol=ifol, nskp=nskp) @@ -2582,7 +2584,7 @@ def save(self, io.swifter_xr2infile(self.ds, swifter_param, framenum) self.write_param(param_file, param=swifter_param) else: - print(f'Saving to {codename} not supported') + warnings.warn(f'Saving to {codename} not supported') return @@ -2608,7 +2610,8 @@ def initial_conditions_from_bin(self, framenum=-1, new_param=None, new_param_fil Returns ------- - frame : NetCDF dataset + frame : NetCDF dataset + A dataset containing the extracted initial condition data. """ if codename != "Swiftest": @@ -2626,7 +2629,7 @@ def initial_conditions_from_bin(self, framenum=-1, new_param=None, new_param_fil elif self.param['OUT_TYPE'] == 'NETCDF_FLOAT': new_param['IN_TYPE'] = 'NETCDF_FLOAT' else: - print(f"{self.param['OUT_TYPE']} is an invalid OUT_TYPE file") + warnings.warn(f"{self.param['OUT_TYPE']} is an invalid OUT_TYPE file") return if self.param['BIN_OUT'] != new_param['BIN_OUT'] and restart: From 3ff22ee01a13c9a4e869051bdbd28bc979d554de Mon Sep 17 00:00:00 2001 From: David A Minton Date: Wed, 16 Nov 2022 16:41:18 -0500 Subject: [PATCH 077/569] Fixed typo --- python/swiftest/swiftest/io.py | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/python/swiftest/swiftest/io.py b/python/swiftest/swiftest/io.py index 64d3f0c6e..3092edad3 100644 --- a/python/swiftest/swiftest/io.py +++ b/python/swiftest/swiftest/io.py @@ -855,7 +855,7 @@ def swiftest2xr(param, verbose=True): # Check if the name variable contains unique values. If so, make name the dimension instead of id if len(np.unique(ds['name'])) == len(ds['name']): ds = ds.swap_dims({"id" : "name"}) - sim.ds.reset_coords("id") + ds.reset_coords("id") else: print(f"Error encountered. OUT_TYPE {param['OUT_TYPE']} not recognized.") return None From 3006a9f53cb8fb0f88c4525a2005534500b87632 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Wed, 16 Nov 2022 16:42:28 -0500 Subject: [PATCH 078/569] Forgot that xarray doesn't self update datasets --- python/swiftest/swiftest/io.py | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/python/swiftest/swiftest/io.py b/python/swiftest/swiftest/io.py index 3092edad3..2b8c47cb3 100644 --- a/python/swiftest/swiftest/io.py +++ b/python/swiftest/swiftest/io.py @@ -855,7 +855,7 @@ def swiftest2xr(param, verbose=True): # Check if the name variable contains unique values. If so, make name the dimension instead of id if len(np.unique(ds['name'])) == len(ds['name']): ds = ds.swap_dims({"id" : "name"}) - ds.reset_coords("id") + ds = ds.reset_coords("id") else: print(f"Error encountered. OUT_TYPE {param['OUT_TYPE']} not recognized.") return None From ed5d09da696f96d843f7b7f1559f025f54c3bda1 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Wed, 16 Nov 2022 16:46:56 -0500 Subject: [PATCH 079/569] Updated Basic Simulation files --- .../Basic_Simulation/initial_conditions.py | 2 +- examples/Basic_Simulation/param.in | 2 +- examples/Basic_Simulation/run_from_file.py | 2 +- .../Basic_Simulation/run_simulation.ipynb | 159 ++++++++++++++++++ examples/Basic_Simulation/test_io.ipynb | 143 ---------------- 5 files changed, 162 insertions(+), 146 deletions(-) create mode 100644 examples/Basic_Simulation/run_simulation.ipynb delete mode 100644 examples/Basic_Simulation/test_io.ipynb diff --git a/examples/Basic_Simulation/initial_conditions.py b/examples/Basic_Simulation/initial_conditions.py index 95fdb608e..c14cdd931 100644 --- a/examples/Basic_Simulation/initial_conditions.py +++ b/examples/Basic_Simulation/initial_conditions.py @@ -72,5 +72,5 @@ sim.add_body(name_tp, a_tp, e_tp, inc_tp, capom_tp, omega_tp, capm_tp) -# Save everything to a set of initial conditions files +# Run the simulation sim.run() diff --git a/examples/Basic_Simulation/param.in b/examples/Basic_Simulation/param.in index 014bf1fb8..0ee870562 100644 --- a/examples/Basic_Simulation/param.in +++ b/examples/Basic_Simulation/param.in @@ -22,7 +22,6 @@ MU2KG 1.988409870698051e+30 TU2S 31557600.0 DU2M 149597870700.0 GMTINY 9.869231602224408e-07 -MIN_GMFRAG 9.869231602224408e-10 RESTART NO CHK_CLOSE YES GR YES @@ -35,3 +34,4 @@ RHILL_PRESENT NO INTERACTION_LOOPS TRIANGULAR ENCOUNTER_CHECK TRIANGULAR TIDES NO +MIN_GMFRAG 9.869231602224408e-10 diff --git a/examples/Basic_Simulation/run_from_file.py b/examples/Basic_Simulation/run_from_file.py index cede6e2ea..9c477410a 100644 --- a/examples/Basic_Simulation/run_from_file.py +++ b/examples/Basic_Simulation/run_from_file.py @@ -1,3 +1,3 @@ import swiftest sim = swiftest.Simulation() -sim.run() \ No newline at end of file +sim.run(tstop=20.0) \ No newline at end of file diff --git a/examples/Basic_Simulation/run_simulation.ipynb b/examples/Basic_Simulation/run_simulation.ipynb new file mode 100644 index 000000000..fa47bcd56 --- /dev/null +++ b/examples/Basic_Simulation/run_simulation.ipynb @@ -0,0 +1,159 @@ +{ + "cells": [ + { + "cell_type": "code", + "execution_count": 1, + "id": "86c845ce-1801-46ca-8a8a-1cabb266e6a6", + "metadata": {}, + "outputs": [], + "source": [ + "import swiftest\n", + "import xarray as xr\n", + "import numpy as np\n", + "import os" + ] + }, + { + "cell_type": "code", + "execution_count": 2, + "id": "d716c371-8eb4-4fc1-82af-8b5c444c831e", + "metadata": {}, + "outputs": [ + { + "name": "stdout", + "output_type": "stream", + "text": [ + "Reading Swiftest file /home/daminton/git_debug/swiftest/examples/Basic_Simulation/param.in\n" + ] + } + ], + "source": [ + "sim = swiftest.Simulation()" + ] + }, + { + "cell_type": "code", + "execution_count": 3, + "id": "ec7452d6-4c9b-4df3-acc0-b11c32264b91", + "metadata": {}, + "outputs": [ + { + "name": "stdout", + "output_type": "stream", + "text": [ + "tstop 10.0 y\n", + "Writing parameter inputs to file /home/daminton/git_debug/swiftest/examples/Basic_Simulation/param.in\n", + "Running a Swiftest symba run from tstart=0.0 y to tstop=10.0 y\n", + "\u001b]2;cd /home/daminton/git_debug/swiftest/examples/Basic_Simulation\u0007\u001b]1;\u0007\u001b]2;/home/daminton/git_debug/swiftest/bin/swiftest_driver symba \u0007\u001b]1;\u0007 Parameter input file is /home/daminton/git_debug/swiftest/examples/Basic_Simulation/param.in\n", + " \n", + " Warning! NPLM variable not set in input file. Calculating.\n", + " *************** Main Loop *************** \n", + "Time = 1.00000E+00; fraction done = 0.100; Number of active plm, pl, tp = 13, 14, 10\n", + "Integration steps: Total wall time: 6.30684E-01; Interval wall time: 5.29890E-01;Interval wall time/step: 2.70141E-03\n", + "Time = 2.00000E+00; fraction done = 0.200; Number of active plm, pl, tp = 13, 14, 10\n", + "Integration steps: Total wall time: 1.66455E+00; Interval wall time: 5.27720E-01;Interval wall time/step: 2.99766E-03\n", + "Time = 3.00000E+00; fraction done = 0.300; Number of active plm, pl, tp = 13, 14, 10\n", + "Integration steps: Total wall time: 2.64051E+00; Interval wall time: 5.20805E-01;Interval wall time/step: 2.88832E-03\n", + "Time = 4.00000E+00; fraction done = 0.400; Number of active plm, pl, tp = 13, 14, 10\n", + "Integration steps: Total wall time: 3.60585E+00; Interval wall time: 5.24579E-01;Interval wall time/step: 2.82311E-03\n", + "Time = 5.00000E+00; fraction done = 0.500; Number of active plm, pl, tp = 13, 14, 10\n", + "Integration steps: Total wall time: 4.58823E+00; Interval wall time: 5.37595E-01;Interval wall time/step: 2.96439E-03\n", + "Time = 6.00000E+00; fraction done = 0.600; Number of active plm, pl, tp = 13, 14, 10\n", + "Integration steps: Total wall time: 5.55600E+00; Interval wall time: 5.27663E-01;Interval wall time/step: 2.83397E-03\n", + "Time = 7.00000E+00; fraction done = 0.700; Number of active plm, pl, tp = 13, 14, 10\n", + "Integration steps: Total wall time: 6.64194E+00; Interval wall time: 5.83431E-01;Interval wall time/step: 3.11589E-03\n", + "Time = 8.00000E+00; fraction done = 0.800; Number of active plm, pl, tp = 13, 14, 10\n", + "Integration steps: Total wall time: 7.63044E+00; Interval wall time: 5.52408E-01;Interval wall time/step: 2.95843E-03\n", + "Time = 9.00000E+00; fraction done = 0.900; Number of active plm, pl, tp = 13, 14, 10\n", + "Integration steps: Total wall time: 8.62339E+00; Interval wall time: 5.46944E-01;Interval wall time/step: 3.01578E-03\n", + "Time = 1.00000E+01; fraction done = 1.000; Number of active plm, pl, tp = 13, 14, 10\n", + "Integration steps: Total wall time: 9.67297E+00; Interval wall time: 6.00750E-01;Interval wall time/step: 3.20243E-03\n", + "\n", + "Normal termination of Swiftest (version 1.0)\n", + "------------------------------------------------\n", + "\n", + "Creating Dataset from NetCDF file\n", + "Successfully converted 11 output frames.\n", + "Swiftest simulation data stored as xarray DataSet .ds\n" + ] + } + ], + "source": [ + "sim.run(tstop=10.0)" + ] + }, + { + "cell_type": "code", + "execution_count": 9, + "id": "5b0a57a6-dbd5-4d34-8e6e-91fc8ad8789f", + "metadata": {}, + "outputs": [ + { + "data": { + "text/plain": [ + "[,\n", + " ,\n", + " ,\n", + " ,\n", + " ,\n", + " ,\n", + " ,\n", + " ,\n", + " ,\n", + " ,\n", + " ,\n", + " ,\n", + " ,\n", + " ]" + ] + }, + "execution_count": 9, + "metadata": {}, + "output_type": "execute_result" + }, + { + "data": { + "image/png": "iVBORw0KGgoAAAANSUhEUgAAAjMAAAGwCAYAAABcnuQpAAAAOXRFWHRTb2Z0d2FyZQBNYXRwbG90bGliIHZlcnNpb24zLjUuMSwgaHR0cHM6Ly9tYXRwbG90bGliLm9yZy/YYfK9AAAACXBIWXMAAA9hAAAPYQGoP6dpAACEU0lEQVR4nOzdfXyN9f/A8de12c7uN5vZDWez2TDGRiKjkHszFaEIaygJCSWiKFnubyIhG2VuSlTfiuKbkbvITS18VWyNH2uRtsy2s51z/f6YnXZsY9M456z389H16Fyfz+f6XO9zOTvX+3yuO0VVVRUhhBBCCCtlY+4AhBBCCCH+CUlmhBBCCGHVJJkRQgghhFWTZEYIIYQQVk2SGSGEEEJYNUlmhBBCCGHVJJkRQgghhFWrYe4A7jSDwcCFCxdwdXVFURRzhyOEEEKIClBVlb/++gt/f39sbG4+9lLtk5kLFy6g1WrNHYYQQgghbsO5c+eoW7fuTdtU+2TG1dUVKNoYbm5uZo5GCCGEEBWRnZ2NVqs17sdvptonM8WHltzc3CSZEUIIIaxMRU4RkROAhRBCCGHVJJkRQgghhFWTZEYIIYQQVq3anzMjhCXT6/UUFBSYOwzxL2dnZ4etra25wxDitkkyI4QZqKpKRkYGf/75p7lDEQIADw8PfH195X5cwipZTDITHx/PlClTeO6551i0aBFQ9IU/Y8YMVq5cyZUrV2jdujXLli2jSZMm5g1WiH+oOJGpXbs2Tk5OsgMRZqOqKteuXSMzMxMAPz8/M0ckROVZRDJz+PBhVq5cSbNmzUzK58yZw4IFC1izZg0NGjRg5syZdOnShdOnT1founMhLJFerzcmMl5eXuYORwgcHR0ByMzMpHbt2nLISVgds58AfPXqVQYNGsSqVauoWbOmsVxVVRYtWsTLL79Mnz59CA8PZ+3atVy7do3169ebMWIh/pnic2ScnJzMHIkQfyv+PMo5XMIamT2ZefbZZ4mOjqZz584m5ampqWRkZNC1a1djmUajoX379uzfv7/c/vLz88nOzjaZhLBEcmhJWBL5PAprZtbDTBs3buTo0aMcPny4VF1GRgYAPj4+JuU+Pj78+uuv5fYZHx/PjBkzqjZQIYQQQlgss43MnDt3jueee45169bh4OBQbrsbfy2oqnrTXxCTJ08mKyvLOJ07d67KYhZCCCGE5THbyMyRI0fIzMzknnvuMZbp9Xr27NnD0qVLOX36NFA0QlPy7PrMzMxSozUlaTQaNBrNnQtcCCGEEBbFbMlMp06dSElJMSl78sknadSoEZMmTSI4OBhfX1927NhB8+bNAdDpdOzevZvZs2ebI+S7TlVVoGhSVcP1/xeXGa6/NlxvazBthwrX64teG0r0WXLESwFFQUEpen3DfFG7vyeT5cqsL66zMamT4/FCCCHuFLMlM66uroSHh5uUOTs74+XlZSwfN24cs2bNIjQ0lNDQUGbNmoWTkxMDBw40R8gmzv/fetLTV/2dXKjXk4brSYRKyeTi72Tj7ySkYklK9XOrJKh43ub66+LEyxZFsUFRbP+esAXFBkWpUaLu+jw2ULJtmXUlluXvdrdfZ2MSm2JTAxvFDkWpgY2N3fVl7CgsrIHBYIten4deT6ntIUmgEEJUjkXcZ6Y8L774Irm5uYwaNcp407yvvvrKIu4xU1iQTW5uurnDuAXTxODvnaRaNGhDyaRKLTF/JxWv74bSO71aC2Jj44+H+6vk5iro9RVIVm4yclZUXV5d6XnTtpRfd5ME62Z9mvZx8ytkOnToQLNmzXBwcODdd9/F3t6ekSNHMn36dAAWLFhAYmIiZ8+exdPTk5iYGObMmYOLiwsAa9asYdy4caxbt44JEyZw7tw5evbsydq1a9m8eTOvvvoqWVlZPPHEEyxatMh47xSdTsfUqVNJSkrizz//JDw8nNmzZ9OhQ4db/1sIISySRSUzycnJJvOKojB9+nTjl5sl8fV9CI+a917/Ure54dDM9VEFxebvL31FKRoRKPGF//foQ4lDMhVtV2aSUlxv849/0RePDpkmObdOgsoadeL6mBUl64yHwUovZ7psyVj0f08YUNXConYly6/XoeoxqPrrdSWW5e92xjr0qIbiuuL+Cv+uU8tZF6Z9c0NcqlqIwVBwfb7A+Bq1ZolRI+WG7VHmP0bxFrw+f+dTzqpTfiKk1+eydm0io0fHsWvXhxw6dIynn36Re+4JoVOnB9Drs5g7dyqBgVrSfj3PuOemMGHCNRYvfhNFUSgoyObatWssWjSf999/h7/+usqAAbE8/HAMHh4efPLJJlJT0xgwYAht2txD//6PAgpDh8bx66/pJCWtxd/fn48//oTu3bvz/fdHCA1tUHbcyKXLwrxUVb3+XVLy+67w7+8cgx6uf78Z1MKiowVltS81X047KrY8qgGDWoiXZztq1XrQbNtHUdXq/Zs4Ozsbd3d3srKycHNzM3c4QpCXl0dqaipBQUGlruQzTQbLSxpvnlSWbltWEslN6m623K36rLjo6Dj0ej3bt681lnXsOJAHHmjFjBnjSrXfuvUrxo+fSWrqHgCSkj5h1KhpHDv2OcHBWgDGjXudTZv+w88/J+PiUnQTuD59RhIQUIdFi6Zx9uw5WrToxalTO/Dzq23su3fvEdxzTzivvvrcTSK+cTSrqOzGpOfGkbNSo2XGMkr0U8Zr47rKqTe+LNnq9tvk5RWQnn4ed/ffsLPXXz8ca4Ni8iPq+g+M4nTa+DksLisuL/EZK1V2wzIl2t6s//KWMUn0jespbmu4vlP/+4eJ8QcJaukfNer19iV+qFD8g8XYV/GPlus/Yq73c2Nb47yxraHED56S9fq/6411NyYZhSW2g2UKDHyGkPoTq7TPyuy/LWpkRoh/u793GmBtAwEVTqiu74hsbBwID2+Eo2Ogsc7fX8uVK3k4OPizK/kb5sxeyP/+9xPZ2X9RWKgnLy+PggJHnJwdsbV1wsnJkYYNw43Jna+vH4GBWtw9vI07PB8fHy5d+hMbGw0pKT+jqir33NObkjuH/PwCPL08KLnDLuMdXv/PtL66/BzU6VQKCq7wy5l4DIYL5g5HVIKi2JU4l6/keYI1riejNVBsbAFbbIrLjecA3jjd2McNfdnU+Pu8wBLtPTxamXUbSDIjhKgSlU3EFMUWjcYZO7u/f3HZ2toDdly8eJWHH3qckSNH8sYbs/H09GTv3r0MGzYMW9taODp4YG/viZ2dPY6OAcbl7e1rYm/vhLNTsLHMzs4NGxsDLi4NsLc/hq2tLUeOHC31/CEXFxfc3HxRbxgpUEv80i9rvmSCdvP5G/oprjZJjtQb/l88EnFjfRltbtrfrdep1xdiY6PB3a0FKIGYXiFZdMi56Dz9v0eliv+vlBhxMh35uT66pJTR1mSZstuW3X/JuoosU+LiAEqerF80X7q+eETq74sOjCf+F49WGXfm1+uxKdG2ZL1StCx/Xxzw92hX8bpuqEcpkVAUX9xQRpJS4sIGIcmMEMICfffddxQWFjJ//nxsbIq+rD/44IN/3G/z5s3R6/VkZmZy//33l9lGuWHHaG0jZLfLxiYPe/sCgoJm3/RGpkJYIknphBAWp379+hQWFvLWW29x9uxZ3n//fd55551/3G+DBg0YNGgQQ4YMYcuWLaSmpnL48GFmz57NF198UQWRCyHMQZIZIYTFiYyMZMGCBcyePZvw8HCSkpKIj4+vkr4TExMZMmQIEyZMoGHDhvTu3Ztvv/0WrVZbJf0LIe4+uZpJiLvsZlczCWEu8rkUlqYy+28ZmRFCCCGEVZNkRgghhBBWTZIZIYQQQlg1SWaEEEIIYdUkmRFCCCGEVZNkRgghhBBWTZIZIYQQQlg1SWaEEEIIYdUkmRFCCCGEVZNkRghRYbGxsSiKwsiRI0vVjRo1CkVRiI2NvfuBCSH+1SSZEUJUilarZePGjeTm5hrL8vLy2LBhAwEBAbfdr6qqFBYWVkWIJvR6PQaDocr7FUJYDklmhBCV0qJFCwICAtiyZYuxbMuWLWi1Wpo3b24sU1WVOXPmEBwcjKOjIxEREWzevNlYn5ycjKIofPnll7Rs2RKNRsM333yDwWBg9uzZhISEoNFoCAgI4I033jBZ5s8//zT2c/z4cRRFIS0tDYA1a9bg4eHBZ599RuPGjY392tnZkZGRYfJeJkyYwAMPPHAHtpIQ4m6qYe4AhBBFO/7cAr1Z1u1oZ4uiKJVa5sknnyQxMZFBgwYBkJCQQFxcHMnJycY2U6dOZcuWLSxfvpzQ0FD27NnDE088gbe3N+3btze2e/HFF5k3bx7BwcF4eHgwefJkVq1axcKFC2nXrh0XL17kf//7X6Xiu3btGvHx8bz77rt4eXlRt25dgoODef/993nhhRcAKCwsZN26dbz55puV6lsIYXkkmRHCAuQW6Gn8ypdmWffJ17rhZF+5r4LBgwczefJk0tLSUBSFffv2sXHjRmMyk5OTw4IFC/j6669p06YNAMHBwezdu5cVK1aYJDOvvfYaXbp0AeCvv/5i8eLFLF26lKFDhwJQv3592rVrV6n4CgoKePvtt4mIiDCWDRs2jMTERGMy8/nnn3Pt2jX69+9fqb6FEJZHkhkhRKXVqlWL6Oho1q5di6qqREdHU6tWLWP9yZMnycvLMyYpxXQ6ncmhKICWLVsaX586dYr8/Hw6der0j+Kzt7enWbNmJmWxsbFMnTqVgwcPct9995GQkED//v1xdnb+R+sSQpifJDNCWABHO1tOvtbNbOu+HXFxcYwePRqAZcuWmdQVn3D7+eefU6dOHZM6jUZjMl8ymXB0dLzpOm1sik7zU1XVWFZQUFCqnaOjY6lDZ7Vr1yYmJobExESCg4P54osvTA6LCSGslyQzQlgARVEqfajH3Lp3745OpwOgWzfTRKz4xNv09HSTQ0q3EhoaiqOjI//9738ZPnx4qXpvb28ALl68SM2aNYGiE4Aravjw4Tz22GPUrVuX+vXr07Zt2wovK4SwXNb17SmEsBi2tracOnXK+LokV1dXJk6cyPPPP4/BYKBdu3ZkZ2ezf/9+XFxcjOfD3MjBwYFJkybx4osvYm9vT9u2bfn99985ceIEw4YNIyQkBK1Wy/Tp05k5cyY///wz8+fPr3DM3bp1w93dnZkzZ/Laa6/d/psXQlgUSWaEELfNzc2t3LrXX3+d2rVrEx8fz9mzZ/Hw8KBFixZMmTLlpn1OmzaNGjVq8Morr3DhwgX8/PyMN+mzs7Njw4YNPPPMM0RERHDvvfcyc+ZM+vXrV6F4bWxsiI2NZdasWQwZMqTib1QIYdEUteTB52ooOzsbd3d3srKybvrFK8TdkpeXR2pqKkFBQTg4OJg7nH+dESNG8Ntvv/Hpp5+aOxSLIp9LYWkqs/+WkRkhxL9CVlYWhw8fJikpiU8++cTc4QghqpAkM0KIf4WHHnqIQ4cO8fTTT5e6ZFwIYd0kmRFC/CvIZdhCVF/ybCYhhBBCWDVJZoQQQghh1cyazCxfvpxmzZrh5uaGm5sbbdq0Ydu2bcb62NhYFEUxme677z4zRiyEEEIIS2PWc2bq1q3Lm2++SUhICABr167loYce4tixYzRp0gQoustoYmKicRl7e3uzxCqEEEIIy2TWZCYmJsZk/o033mD58uUcPHjQmMxoNBp8fX3NEZ4QQgghrIDFnDOj1+vZuHEjOTk5tGnTxlienJxM7dq1adCgASNGjCAzM/Om/eTn55OdnW0yCSGEEKL6Mnsyk5KSgouLCxqNhpEjR7J161YaN24MQI8ePUhKSuLrr79m/vz5HD58mAcffJD8/Pxy+4uPj8fd3d04abXau/VWhBBCCGEGZn+cgU6nIz09nT///JOPPvqId999l927dxsTmpIuXrxIYGAgGzdupE+fPmX2l5+fb5LsZGdno9Vq5XEGwmJY623jY2JiyM3NZefOnaXqDhw4QFRUFEeOHKFFixZmiE78U9b6uRTVl1U9zsDe3t54AnDLli05fPgwixcvZsWKFaXa+vn5ERgYyM8//1xufxqNBo1Gc8fiFeLfatiwYfTp04dff/2VwMBAk7qEhAQiIyMlkRFCmIXZDzPdSFXVcg8jXb58mXPnzuHn53eXoxJC9OrVi9q1a7NmzRqT8mvXrrFp0yaGDRvG/v37eeCBB3B0dESr1TJ27FhycnKMbevVq8esWbOIi4vD1dWVgIAAVq5caaxPTk5GURT+/PNPY9nx48dRFIW0tDQAfv31V2JiYqhZsybOzs40adKEL7744k6+dSGEhTNrMjNlyhS++eYb0tLSSElJ4eWXXyY5OZlBgwZx9epVJk6cyIEDB0hLSyM5OZmYmBhq1arFI488Ys6whah6qgq6HPNMFTzSXKNGDYYMGcKaNWsoeXT6ww8/RKfTERERQbdu3ejTpw8//PADmzZtYu/evYwePdqkn/nz59OyZUuOHTvGqFGjeOaZZ/jf//5X4U317LPPkp+fz549e0hJSWH27Nm4uLhUeHkhRPVj1sNMv/32G4MHD+bixYu4u7vTrFkztm/fTpcuXcjNzSUlJYX33nuPP//8Ez8/Pzp27MimTZtwdXU1Z9hCVL2CazDL3zzrnnIB7J0r1DQuLo65c+eSnJxMx44dgaJDTH369GHVqlUMHDiQcePGARAaGsqSJUto3749y5cvN56H0bNnT0aNGgXApEmTWLhwIcnJyTRq1KhCMaSnp9O3b1+aNm0KQHBwcGXerRCiGjJrMrN69epy6xwdHfnyyy/vYjRCiFtp1KgRUVFRJCQk0LFjR86cOcM333zDV199xXPPPccvv/xCUlKSsb2qqhgMBlJTUwkLCwOgWbNmxnpFUfD19b3lLRdKGjt2LM888wxfffUVnTt3pm/fviZ9CiH+fcx+ArAQArBzKhohMde6K2HYsGGMHj2aZcuWkZiYSGBgIJ06dcJgMPD0008zduzYUssEBAT8vTo7O5M6RVEwGAwA2NgUHfkueRiroKDApP3w4cPp1q0bn3/+OV999RXx8fHMnz+fMWPGVOp9CCGqD0lmhLAEilLhQz3m1r9/f5577jnWr1/P2rVrGTFiBIqi0KJFC06cOGG8OvF2eHt7A0W3YahZsyZQdALwjbRaLSNHjmTkyJFMnjyZVatWSTIjxL+YxV3NJISwbC4uLgwYMIApU6Zw4cIFYmNjgaLzXw4cOMCzzz7L8ePH+fnnn/n0008rlWSEhISg1WqZPn06P/30E59//jnz5883aTNu3Di+/PJLUlNTOXr0KF9//bXxEJYQ4t9JkhkhRKUNGzaMK1eu0LlzZ+MhpGbNmrF7925+/vln7r//fpo3b860adMqdSsFOzs7NmzYwP/+9z8iIiKYPXs2M2fONGmj1+t59tlnCQsLo3v37jRs2JC33367St+fEMK6mP0OwHdaZe4gKMTdIHdaFZZIPpfC0lRm/y0jM0IIIYSwapLMCCGEEMKqSTIjhBBCCKsmyYwQQgghrJokM0IIIYSwapLMCCGEEMKqSTIjhBBCCKsmyYwQQgghrJokM0IIIYSwapLMCCEsUlpaGoqilPmgSSGEKEmSGSFEhcXGxqIoSqmpe/fu/7jfhx9+uGqCFEL869QwdwBCCOvSvXt3EhMTTco0Gs1t9aXX61EUpSrCEkL8i8nIjBCiUjQaDb6+viZTzZo1AViwYAFNmzbF2dkZrVbLqFGjuHr1qnHZNWvW4OHhwWeffUbjxo3RaDQ8+eSTrF27lk8++cQ40pOcnGxc5uzZs3Ts2BEnJyciIiI4cODA3X7LQggLJyMzQlgAVVXJLcw1y7odazhW2eiIjY0NS5YsoV69eqSmpjJq1ChefPFF3n77bWOba9euER8fz7vvvouXlxe+vr7k5eWRnZ1tHPHx9PTkwoULALz88svMmzeP0NBQXn75ZR5//HF++eUXatSQry8hRBH5NhDCAuQW5tJ6fWuzrPvbgd/iZOdU4fafffYZLi4uJmWTJk1i2rRpjBs3zlgWFBTE66+/zjPPPGOSzBQUFPD2228TERFhLHN0dCQ/Px9fX99S65s4cSLR0dEAzJgxgyZNmvDLL7/QqFGjCscshKjeJJkRQlRKx44dWb58uUmZp6cnALt27WLWrFmcPHmS7OxsCgsLycvLIycnB2dnZwDs7e1p1qxZhddXsq2fnx8AmZmZkswIIYwkmRHCAjjWcOTbgd+abd2V4ezsTEhISKnyX3/9lZ49ezJy5Ehef/11PD092bt3L8OGDaOgoODv9TlW7rCWnZ2d8XXxcgaDoVIxCyGqN0lmhLAAiqJU6lCPJfruu+8oLCxk/vz52NgUXVvwwQcfVGhZe3t79Hr9nQxPCFGNSTIjhKiU/Px8MjIyTMpq1KhB/fr1KSws5K233iImJoZ9+/bxzjvvVKjPevXq8eWXX3L69Gm8vLxwd3e/E6ELIaopuTRbCFEp27dvx8/Pz2Rq164dkZGRLFiwgNmzZxMeHk5SUhLx8fEV6nPEiBE0bNiQli1b4u3tzb59++7wuxBCVCeKqqqquYO4k7Kzs3F3dycrKws3NzdzhyMEeXl5pKamEhQUhIODg7nDEQKQz6WwPJXZf8vIjBBCCCGsmiQzQgghhLBqkswIIYQQwqpJMiOEEEIIqybJjBBCCCGsmiQzQgghhLBqZk1mli9fTrNmzXBzc8PNzY02bdqwbds2Y72qqkyfPh1/f38cHR3p0KEDJ06cMGPEQgghhLA0Zr0DcN26dXnzzTeNz3lZu3YtDz30EMeOHaNJkybMmTOHBQsWsGbNGho0aMDMmTPp0qULp0+fxtXV1ZyhWy1VVUtN5ZVbUtuS8Zf3viypvJiiKMbnCRW/Ll4mLy/PZPnynld0s+cYVXaZipbfbL4yz1USQoi7weJumufp6cncuXOJi4vD39+fcePGMWnSJKDoNuo+Pj7Mnj2bp59+ukL93amb5qWlpXH27FlUVcVgMJj835LLhPm5uLjQtm1b6tSpQ40a1v1EkZslOVVdVxWvzdXWGhJAuWmesDSV2X9bzDepXq/nww8/JCcnhzZt2pCamkpGRgZdu3Y1ttFoNLRv3579+/eXm8zk5+eTn59vnM/Ozr4j8Z47d449e/bckb4tTVmjC7eaqrJtcX3JeG4Wa2XK7+Qy5Y04aTQaatSogZ2dXbnJzM1+Y9ytUaWKqMiomTD1T5Kyf7r8zV7rdDry8vI4cuSI8W/PxsYGGxsb4+uK/k1b0nQ729Aaks877cZR8eKysl5D0TaztbW9K7GVxezJTEpKCm3atCEvLw8XFxe2bt1K48aN2b9/PwA+Pj4m7X18fPj111/L7S8+Pp4ZM2bc0ZgB/P39adWqlckf/Y1/8JZYduNruHXSIapW8S/gmjVrWuQv4JJJ2I3lcXFxvPfee4wYMYK3337bpG7MmDGsWLGCwYMH8+6775bbR1mvb1Z3O+3Kel3Rstvtq6IsNQEsLCwkLy+PAwcOcPXqVXOHY3FuJ6m83XbFbvbZv3G+qupuV7t27ejcuXOV9HU7zJ7MNGzYkOPHj/Pnn3/y0UcfMXToUHbv3m2sv/EfWFXVm+5gJ0+ezPjx443z2dnZaLXaKo+7fv361K9fv8r7FcLcbvbrVFEUtFotH3zwAYsXL8bR0REoStA2bdpEQEAANjY22Nvb39a6CwoKsLOzu/3gzayiSdKdSNb+6fI6nQ57e3saNmxIQUGByeHpkoetLWEqGc/dcqvEQpiX2ZMZe3t74wnALVu25PDhwyxevNh4nkxGRgZ+fn7G9pmZmaVGa0rSaDRoNJo7G7QQ/2ItWrTg7NmzbNmyhUGDBgGwZcsWtFotwcHBxnbbt29n5syZ/Pjjj9ja2tKmTRsWL15s/BGQlpZGUFAQmzZt4u233+bgwYMsX76cBx98kNGjR7N37150Oh316tVj7ty59OzZ0yzvtzKs+TBFXl4eTk5OdOnSxSJHDMtzq8SnZLsbl7tbdZXto6KjO7eav5ttzXmICSwgmbmRqqrk5+cTFBSEr68vO3bsoHnz5kDRL4fdu3cze/ZsM0cpRNVSVRU1N9cs61YcHSu9833yySdJTEw0JjMJCQnExcWRnJxsbJOTk8P48eNp2rQpOTk5vPLKKzzyyCMcP34cG5u/7woxadIk5s+fT2JiIhqNhqeeegqdTseePXtwdnbm5MmTuLi4VMl7FdWPHA4XYOZkZsqUKfTo0QOtVstff/3Fxo0bSU5OZvv27SiKwrhx45g1axahoaGEhoYya9YsnJycGDhwoDnDFqLKqbm5nG5xj1nW3fDoERQnp0otM3jwYCZPnkxaWhqKorBv3z7j32+xvn37miyzevVqateuzcmTJwkPDzeWjxs3jj59+hjn09PT6du3L02bNgUwGe0RQoiymDWZ+e233xg8eDAXL17E3d2dZs2asX37drp06QLAiy++SG5uLqNGjeLKlSu0bt2ar776Su4xI4SZ1apVi+joaNauXYuqqkRHR1OrVi2TNmfOnGHatGkcPHiQS5cuGW8NkJ6ebpLMtGzZ0mS5sWPH8swzz/DVV1/RuXNn+vbtS7Nmze78mxJCWC2zJjOrV6++ab2iKEyfPp3p06ffnYCEMBPF0ZGGR4+Ybd23Iy4ujtGjRwOwbNmyUvUxMTFotVpWrVqFv78/BoOB8PBwdDqdSTtnZ2eT+eHDh9OtWzc+//xzvvrqK+Lj45k/fz5jxoy5rTiFENWfxZ0zI8S/kaIolT7UY27du3c3JibdunUzqbt8+TKnTp1ixYoV3H///QDs3bu3wn1rtVpGjhzJyJEjmTx5MqtWrZJkRghRLklmhBC3xdbWllOnThlfl1SzZk28vLxYuXIlfn5+pKen89JLL1Wo33HjxtGjRw8aNGjAlStX+PrrrwkLC6vy+IUQ1YckM0KI21beLcZtbGzYuHEjY8eOJTw8nIYNG7JkyRI6dOhwyz71ej3PPvss58+fx83Nje7du7Nw4cIqjlwIUZ1Y3LOZqtqdejaTELdLnoEjLJF8LoWlqcz+2+amtUIIIYQQFk6SGSGEEEJYNUlmhBBCCGHVJJkRQgghhFWTZEYIIYQQVk2SGSGEEEJYNUlmhBBCCGHVJJkRQgghhFWTZEYIIYQQVk2SGSGE2aSlpaEoCsePHzd3KEIIKybJjBCiwmJjY3n44YerrD+tVsvFixcJDw8HIDk5GUVR+PPPP6tsHUKI6k8eNCmEMBtbW1t8fX2rvF9VVdHr9dSoIV9xQvwbyMiMEBZAVVUK8vVmmW73WbP16tVj0aJFJmWRkZFMnz7dOK8oCsuXL6dHjx44OjoSFBTEhx9+aKwveZgpLS2Njh07AlCzZk0URSE2Nta4febMmUNwcDCOjo5ERESwefNmYz/FIzpffvklLVu2RKPR8M0339zW+xJCWB/52SKEBSjUGVj53G6zrPupxe2x09jesf6nTZvGm2++yeLFi3n//fd5/PHHCQ8PJywszKSdVqvlo48+om/fvpw+fRo3NzccHR0BmDp1Klu2bGH58uWEhoayZ88ennjiCby9vWnfvr2xjxdffJF58+YRHByMh4fHHXtPQgjLIsmMEOKO6tevH8OHDwfg9ddfZ8eOHbz11lu8/fbbJu1sbW3x9PQEoHbt2sZkJCcnhwULFvD111/Tpk0bAIKDg9m7dy8rVqwwSWZee+01unTpchfelRDCkkgyI4QFqGFvw1OL29+64R1a951UnICUnK/M1UsnT54kLy+vVJKi0+lo3ry5SVnLli1vO04hhPWSZEYIC6Aoyh091HMn2NjYlDrfpqCgoELLKopS4fUYDAYAPv/8c+rUqWNSp9FoTOadnZ0r3K8QovqQZEYIcVu8vb25ePGicT47O5vU1NRS7Q4ePMiQIUNM5m8cUSlmb28PgF6vN5Y1btwYjUZDenq6ySElIYQoJsmMEOK2PPjgg6xZs4aYmBhq1qzJtGnTsLUtPbr04Ycf0rJlS9q1a0dSUhKHDh1i9erVZfYZGBiIoih89tln9OzZE0dHR1xdXZk4cSLPP/88BoOBdu3akZ2dzf79+3FxcWHo0KF3+q0KISycJDNCiAozGAzGe7dMnjyZs2fP0qtXL9zd3Xn99dfLHJmZMWMGGzduZNSoUfj6+pKUlETjxo3L7L9OnTrMmDGDl156iSeffJIhQ4awZs0aXn/9dWrXrk18fDxnz57Fw8ODFi1aMGXKlDv6foUQ1kFRb/cmE1YiOzsbd3d3srKycHNzM3c4QpCXl0dqaipBQUE4ODiYO5xK6d69OyEhISxdurRC7RVFYevWrVV612BxZ1jz51JUT5XZf8tN84QQt3TlyhU+//xzkpOT6dy5s7nDEUIIE3KYSQhxS3FxcRw+fJgJEybw0EMPmTscIYQwIcmMEOKWtm7delvLVfOj2EIICyGHmYQQQghh1SSZEUIIIYRVk2RGCCGEEFZNkhkhhBBCWDWzJjPx8fHce++9uLq6Urt2bR5++GFOnz5t0iY2NhZFUUym++67z0wRCyGEEMLSmDWZ2b17N88++ywHDx5kx44dFBYW0rVrV3Jyckzade/enYsXLxqnL774wkwRCyGEEMLSmPXS7O3bt5vMJyYmUrt2bY4cOcIDDzxgLNdoNPj6+t7t8IQQQghhBSzqnJmsrCwAPD09TcqTk5OpXbs2DRo0YMSIEWRmZpbbR35+PtnZ2SaTEKLqZGZm8vTTTxMQEGD8odGtWzcOHDhQoeXXrFmDh4fHnQ1SCPGvYjE3zVNVlfHjx9OuXTvCw8ON5T169KBfv34EBgaSmprKtGnTePDBBzly5AgajaZUP/Hx8cyYMeNuhi7Ev0rfvn0pKChg7dq1BAcH89tvv/Hf//6XP/74467HUlBQgJ2d3V1frxDCwqgWYtSoUWpgYKB67ty5m7a7cOGCamdnp3700Udl1ufl5alZWVnG6dy5cyqgZmVl3Ymwhai03Nxc9eTJk2pubq6xzGAwqLrcXLNMBoOhwrFfuXJFBdTk5ORy28yfP18NDw9XnZyc1Lp166rPPPOM+tdff6mqqqq7du1SAZPp1VdfVVVVVQF169atJn25u7uriYmJqqqqampqqgqomzZtUtu3b69qNBo1ISFBHTp0qPrQQw+pc+fOVX19fVVPT0911KhRqk6nq/D7EmV/LoUwp6ysrArvvy1iZGbMmDF8+umn7Nmzh7p16960rZ+fH4GBgfz8889l1ms0mjJHbISwZIX5+SwZ+qhZ1j127WbsKviUZBcXF1xcXPj444+57777yvxbs7GxYcmSJdSrV4/U1FRGjRrFiy++yNtvv01UVBSLFi3ilVdeMV656OLiUql4J02axPz580lMTESj0bB792527dqFn58fu3bt4pdffmHAgAFERkYyYsSISvUthLBOZj1nRlVVRo8ezZYtW/j6668JCgq65TKXL1/m3Llz+Pn53YUIhRAl1ahRgzVr1rB27Vo8PDxo27YtU6ZM4YcffjC2GTduHB07diQoKIgHH3yQ119/nQ8++AAAe3t73N3dURQFX19ffH19K53MjBs3jj59+hAUFIS/vz8ANWvWZOnSpTRq1IhevXoRHR3Nf//736p740IIi2bWkZlnn32W9evX88knn+Dq6kpGRgYA7u7uODo6cvXqVaZPn07fvn3x8/MjLS2NKVOmUKtWLR555BFzhi5Elaqh0TB27Wazrbsy+vbtS3R0NN988w0HDhxg+/btzJkzh3fffZfY2Fh27drFrFmzOHnyJNnZ2RQWFpKXl0dOTg7Ozs7/ON6WLVuWKmvSpAm2trbGeT8/P1JSUv7xuoQQ1sGsyczy5csB6NChg0l5YmIisbGx2NrakpKSwnvvvceff/6Jn58fHTt2ZNOmTbi6upohYiHuDEVRKnyoxxI4ODjQpUsXunTpwiuvvMLw4cN59dVX6dixIz179mTkyJG8/vrreHp6snfvXoYNG0ZBQcFN+1QUpdRTtstapqyE6MaTgBVFwWAw3MY7E0JYI7MmMzd+cd3I0dGRL7/88i5FI4S4XY0bN+bjjz/mu+++o7CwkPnz52NjU3QUu/gQUzF7e3v0en2pPry9vbl48aJx/ueff+batWt3NnAhRLVgEScACyGsw+XLl+nXrx9xcXE0a9YMV1dXvvvuO+bMmcNDDz1E/fr1KSws5K233iImJoZ9+/bxzjvvmPRRr149rl69yn//+18iIiJwcnLCycmJBx98kKVLl3LfffdhMBiYNGmSXHYthKgQi7ppnhDCsrm4uNC6dWsWLlzIAw88QHh4ONOmTWPEiBEsXbqUyMhIFixYwOzZswkPDycpKYn4+HiTPqKiohg5ciQDBgzA29ubOXPmADB//ny0Wi0PPPAAAwcOZOLEiTg5OZnjbQohrIyi3upYj5XLzs7G3d2drKws3NzczB2OEOTl5ZGamkpQUBAOVnSejKje5HMpLE1l9t8yMiOEEEIIqybJjBBCCCGsmiQzQgghhLBqkswIIYQQwqpJMiOEEEIIqybJjBBCCCGsmiQzQgghhLBqkswIIYQQwqpJMiOEEEIIqybJjBBCCCGsmiQzQogK69ChA+PGjStV/vHHH6Moyt0PSAghkGRGCHGHFRQUmDsEIUQ1J8mMEBZAVVUMOr1Zpqp+1uz06dOJjIwkISGB4OBgNBoNqqqyfft22rVrh4eHB15eXvTq1YszZ84Yl0tLS0NRFLZs2ULHjh1xcnIiIiKCAwcOlOq7pEWLFlGvXj3jfHJyMq1atcLZ2RkPDw/atm3Lr7/+WqXvUQhhWWqYOwAhBKgFBi68st8s6/Z/LQrF3rZK+/zll1/44IMP+Oijj7C1Leo7JyeH8ePH07RpU3JycnjllVd45JFHOH78ODY2f/+uevnll5k3bx6hoaG8/PLLPP744/zyyy/UqHHrr6vCwkIefvhhRowYwYYNG9DpdBw6dEgOgQlRzUkyI4Socjqdjvfffx9vb29jWd++fU3arF69mtq1a3Py5EnCw8ON5RMnTiQ6OhqAGTNm0KRJE3755RcaNWp0y/VmZ2eTlZVFr169qF+/PgBhYWFV8ZaEEBZMkhkhLIBiZ4P/a1FmW3dVCwwMNElkAM6cOcO0adM4ePAgly5dwmAwAJCenm6SzDRr1sz42s/PD4DMzMwKJTOenp7ExsbSrVs3unTpQufOnenfv7+xHyFE9STnzAhhARRFwcbe1ixTZQ7BuLm5kZWVVar8zz//xM3NzTjv7Oxcqk1MTAyXL19m1apVfPvtt3z77bdA0ShOSXZ2dibbBTAmPjY2NqXO8bnxBOPExEQOHDhAVFQUmzZtokGDBhw8eLDC71EIYX0kmRFCVFijRo347rvvSpUfPnyYhg0blrvc5cuXOXXqFFOnTqVTp06EhYVx5cqVSq/f29ubjIwMk4Tm+PHjpdo1b96cyZMns3//fsLDw1m/fn2l1yWEsB6SzAghKmzUqFGcOXOGZ599lu+//56ffvqJZcuWsXr1al544YVyl6tZsyZeXl6sXLmSX375ha+//prx48dXev0dOnTg999/Z86cOZw5c4Zly5axbds2Y31qaiqTJ0/mwIED/Prrr3z11Vf89NNPct6MENWcJDNCiAqrV68e33zzDWfOnKFr167ce++9rFmzhjVr1tCvX79yl7OxsWHjxo0cOXKE8PBwnn/+eebOnVvp9YeFhfH222+zbNkyIiIiOHToEBMnTjTWOzk58b///Y++ffvSoEEDnnrqKUaPHs3TTz99W+9XCGEdFLWqbzJhYbKzs3F3dycrK8vkmL4Q5pKXl0dqaipBQUE4ODiYOxwhAPlcCstTmf23jMwIIYQQwqpJMiOEEEIIqybJjBBCCCGsmiQzQgghhLBqkswIIYQQwqpJMiOEEEIIqybJjBBCCCGsmiQzQgghhLBqZk1m4uPjuffee3F1daV27do8/PDDnD592qSNqqpMnz4df39/HB0d6dChAydOnDBTxEIIIYSwNGZNZnbv3s2zzz7LwYMH2bFjB4WFhXTt2pWcnBxjmzlz5rBgwQKWLl3K4cOH8fX1pUuXLvz1119mjFwIIYQQlsKsycz27duJjY2lSZMmREREkJiYSHp6OkeOHAGKRmUWLVrEyy+/TJ8+fQgPD2ft2rVcu3ZNnoIrhBnExsaiKApvvvmmSfnHH3+MoihVui5FUfj444+rtE8hRPVU458sfPLkSdLT09HpdCblvXv3vq3+srKyAPD09ASKnoCbkZFB165djW00Gg3t27dn//79ZT48Lj8/n/z8fON8dnb2bcUihCibg4MDs2fP5umnn6ZmzZrmDkcIIW5vZObs2bNEREQQHh5OdHQ0Dz/8MA8//DCPPPIIjzzyyG0Foqoq48ePp127doSHhwOQkZEBgI+Pj0lbHx8fY92N4uPjcXd3N05arfa24hHiblJVFZ1OZ5apss+a7dy5M76+vsTHx5fbZv/+/TzwwAM4Ojqi1WoZO3asyeHjevXq8frrrzNw4EBcXFzw9/fnrbfeMqkHeOSRR1AUxTgfGxvLww8/bLKucePG0aFDB+N8hw4dGDt2LC+++CKenp74+voyffp0k2WysrJ46qmnqF27Nm5ubjz44IN8//33ldoOQgjLcVsjM8899xxBQUHs3LmT4OBgDh06xOXLl5kwYQLz5s27rUBGjx7NDz/8wN69e0vV3Th8rapquUPakydPZvz48cb57OxsSWiExSsoKGDWrFlmWfeUKVOwt7evcHtbW1tmzZrFwIEDGTt2LHXr1jWpT0lJoVu3brz++uusXr2a33//ndGjRzN69GgSExON7ebOncuUKVOYPn06X375Jc8//zyNGjWiS5cuHD58mNq1a5OYmEj37t2xtbWt1Htau3Yt48eP59tvv+XAgQPExsbStm1bunTpgqqqREdH4+npyRdffIG7uzsrVqygU6dO/PTTT8aRYSGE9bitkZkDBw7w2muv4e3tjY2NDTY2NrRr1474+HjGjh1b6f7GjBnDp59+yq5du0y+GH19fQFKjcJkZmaWGq0pptFocHNzM5mEEFXrkUceITIykldffbVU3dy5cxk4cCDjxo0jNDSUqKgolixZwnvvvUdeXp6xXdu2bXnppZdo0KABY8aM4dFHH2XhwoUAeHt7A+Dh4YGvr69xvqKaNWvGq6++SmhoKEOGDKFly5b897//BWDXrl2kpKTw4Ycf0rJlS0JDQ5k3bx4eHh5s3rz5djeJEMKMbmtkRq/X4+LiAkCtWrW4cOECDRs2JDAwsNSl1Tejqipjxoxh69atJCcnExQUZFIfFBSEr68vO3bsoHnz5gDodDp2797N7Nmzbyd0ISySnZ0dU6ZMMdu6b8fs2bN58MEHmTBhgkn5kSNH+OWXX0hKSjKWqaqKwWAgNTWVsLAwANq0aWOyXJs2bVi0aNFtxXKjZs2amcz7+fmRmZlpjO/q1at4eXmZtMnNzeXMmTNVsn4hxN11W8lMeHg4P/zwA8HBwbRu3Zo5c+Zgb2/PypUrCQ4OrnA/zz77LOvXr+eTTz7B1dXVOALj7u6Oo6MjiqIwbtw4Zs2aRWhoKKGhocyaNQsnJycGDhx4O6ELYZEURanUoR5L8MADD9CtWzemTJlCbGyssdxgMPD000+XOUobEBBw0z5vdUWUjY2N8Ryf4v8XX4BQ8tyfGjVqmMwrioLBYEBVVfR6PX5+fuzatQtuOF3Iw8MD1VC5c4jKVMnzkMzqeqhqoQHVoKL/S0dhfsWvTCuzZUULK7qaCrcrv6FJVfHMjc2VG17cUF+02O0ti3Lrz7e4fbeVzEydOtV4Mt/MmTPp1asX999/P15eXmzatKnC/SxfvhzA5OQ9gMTEROOX44svvkhubi6jRo3iypUrtG7dmq+++gpXV9fbCb3K5J35k7zTf/z9ZVjWd9eNX2hltCl18uWNbcr6UizVppy+bre/Eu3UCrSpaF+oZTS5ne12Q32pMEoWlFd34ypKvtFytu+t4lNvUmdcToUCRxV9RA0KLl3D1k5PKZXYD5ZqWu6yt+i0gus0XCvAkFeI7sJVAF4f/wr3do2ivl89AHT/d5XIRs1IOfoDAY6+pTv4XYcOHehV9ifvRTfs7/tF7d/1DQ3qhaA7X1RmZ2dHfuZV4zyAp4M7Kb9+b1J2/PBR7GrYUfB/RTGp+XoMOQXGeQBDbiEGu6KyZgFhZGRkoF7Kp5420DQ+HRRcuMq/UUGhDn1WPr9//AM1/rKiZMya3SwhUm4sLyow5kMVaFuUQJVRd7P2t+q7ZIclqp1b++H6gOn5c3fTbSUz3bp1M74ODg7m5MmT/PHHH9SsWbNSmWdFrqJQFIXp06eXuhrB3HTn/uLqnv8zdxjCChW6Kqh6Z9RCFRWDucOpHPX6dH30IrxhYx5/pD9vJ664Xq8ycdQ47u/dibFTnmfYwFicnJz4388/8d9vvmbR639fIHDgu2+Z9/YieneL5r97dvHRZx/z8ZoPjfWBdQP4em8ybVreh8benpoeNekQ9QAL3lnMus3raX1PKzZs2cSJ06eIbGJ6WOlmOt3fkftatKLf8IG8MXkGDeqHcvG3DLZ//SW9u/XinogWVbGlrI9yfbJRoHLnW/+tItl1RfKkf0suVe4PpzJ/5ZVbU5lV3CmGa4V3aU1l+0f3mSnp33YFgH1dV1weqHN9Tinrfzdk3bcamiyeV242W/YwalmZehl9K2UFVlbuWcl2pm+znPdZumGF2ikVGdItr+56LKa/NMpY/sb6G+pK/xuUs1wZ6y4VoqKQr9dxreASNWpqqKFx4KZu+tugnMrbHcmuwHKKYw2UfFtq+DgZy15/8w02f7YVADsfZ1r4tib5611MfWUqDz7aHVVVqR9cn/79+2Pn61y0kK3C+PHj+f5kCm8sehNXV1fmzZlH9GMPGWOZv2A+E16YSMKGtdSpU4fUM2eJfvwhpp6eypQ3XyUvL48nY59k8JDB/JjyI3Z+RX0r9rbYONsZ5wFsHGyxcaqBnX/RuX5f7NjOy1Nf5ulJo/n999/x9fXlgfsfoE54kLFNVW+723E3D0sY8vKocc0B3+fDcHC4xefSAtxyVLvMupuNvBYfvryNZf/RaPENL9Qbi0oUlLU+k/ZlrKecdatqZdvfvK2tmwZzUtTK3mTCymRnZ+Pu7k5WVpZc2SQsQl5eHqmpqQQFBVnFTuNOqFevHuPGjWPcuHHmDkVcJ59LYWkqs/+Wp2YLIYQQwqpJMiOEEEIIq1Zl58wIIURFpaWlmTsEIUQ1IiMzQgghhLBqkswIIYQQwqpJMiOEEEIIqybJjBBCCCGsmiQzQgghhLBqkswIIYQQwqpJMiOEqBLJyckoisKff/5p7lCEEP8ykswIISosNjYWRVFQFAU7OzuCg4OZOHEiOTk5t93fww8/XLVBCiH+deSmeUKISunevTuJiYkUFBTwzTffMHz4cHJychgwYIC5QxNC/EvJyIwQFkBVVfT6a2aZKvusWY1Gg6+vL1qtloEDBzJo0CA+/vjjUu2mT59OZGSkSdmiRYuoV6+esX7t2rV88sknxtGe5ORkAFJSUnjwwQdxdHTEy8uLp556iqtXr97GlhVC/BvIyIwQFsBgyCV5d1OzrLtD+xRsbZ1ue3lHR0cKCgoqvdzEiRM5deoU2dnZJCYmAuDp6cm1a9fo3r079913H4cPHyYzM5Phw4czevRo1qxZc9txCiGqL0lmhBC37dChQ6xfv55OnTpVelkXFxccHR3Jz8/H19fXWL527Vpyc3N57733cHZ2BmDp0qXExMQwe/ZsfHx8qix+IUT1IMmMEBbAxsaRDu1TzLbuyvjss89wcXGhsLCQgoICHnroId566y1OnjxZJfGcOnWKiIgIYyID0LZtWwwGA6dPn5ZkRghRiiQzQlgARVH+0aGeu6ljx44sX74cOzs7/P39sbOzAyiVzNjY2JQ6H6cih6NUVUVRlDLryisXQvy7yQnAQohKcXZ2JiQkhMDAQGMiUxZvb28yMjJMEprjx4+btLG3t0ev15uUNW7cmOPHj5tc7r1v3z5sbGxo0KBB1bwJIUS1IsmMEOKO6NChA7///jtz5szhzJkzLFu2jG3btpm0qVevHj/88AOnT5/m0qVLFBQUMGjQIBwcHBg6dCg//vgju3btYsyYMQwePFgOMQkhyiTJjBDijggLC+Ptt99m2bJlREREcOjQISZOnGjSZsSIETRs2JCWLVvi7e3Nvn37cHJy4ssvv+SPP/7g3nvv5dFHH6VTp04sXbrUTO9ECGHpFLWyN5mwMtnZ2bi7u5OVlYWbm5u5wxGCvLw8UlNTCQoKwsHBwdzhCAHI51JYnsrsv2VkRgghhBBWTZIZIYQQQlg1SWaEEEIIYdUkmRFCCCGEVZNkRgghhBBWTZIZIYQQQlg1SWaEEEIIYdUkmRFCCCGEVZNkRgghhBBWzazJzJ49e4iJicHf3x9FUfj4449N6mNjY1EUxWS67777zBOsEMJi1KtXj0WLFpk7jApJS0tDUZRSD9kUQlQdsyYzOTk5RERE3PSZK927d+fixYvG6YsvvriLEQohSir+gTFy5MhSdaNGjUJRFGJjY+94HIcPH+app56qsv6KE47iyd7enpCQEGbOnImlPfElPz+fMWPGUKtWLZydnenduzfnz583afPGG28QFRWFk5MTHh4e5glUiLuohjlX3qNHD3r06HHTNhqNBl9f37sUkRDiVrRaLRs3bmThwoU4OjoCRc/12bBhAwEBAXclBm9v7zvS786dO2nSpAn5+fns3buX4cOH4+fnx7Bhw+7I+m7HuHHj+M9//sPGjRvx8vJiwoQJ9OrViyNHjmBrawuATqejX79+tGnThtWrV5s5YiHuPIs/ZyY5OZnatWvToEEDRowYQWZm5k3b5+fnk52dbTIJYelUVSVHrzfLVNmRhxYtWhAQEMCWLVuMZVu2bEGr1dK8eXNj2fbt22nXrh0eHh54eXnRq1cvzpw5Y6zX6XSMHj0aPz8/HBwcqFevHvHx8cb66dOnExAQgEajwd/fn7FjxxrrSh5mevzxx3nsscdMYiwoKKBWrVokJiYat++cOXMIDg7G0dGRiIgINm/eXOq9eXl54evrS2BgIIMGDSIqKoqjR48a6w0GA6+99hp169ZFo9EQGRnJ9u3bTfo4dOgQzZs3x8HBgZYtW3Ls2DFjnaqqhISEMG/ePJNlfvzxR2xsbEy2T1mysrJYvXo18+fPp3PnzjRv3px169aRkpLCzp07je1mzJjB888/T9OmTW/anxDVhVlHZm6lR48e9OvXj8DAQFJTU5k2bRoPPvggR44cQaPRlLlMfHw8M2bMuMuRCvHPXDMYqL8nxSzrPvNAU5yv/6KvqCeffJLExEQGDRoEQEJCAnFxcSQnJxvb5OTkMH78eJo2bUpOTg6vvPIKjzzyCMePH8fGxoYlS5bw6aef8sEHHxAQEMC5c+c4d+4cAJs3b2bhwoVs3LiRJk2akJGRwffff19mLIMGDaJ///5cvXoVFxcXAL788ktycnLo27cvAFOnTmXLli0sX76c0NBQ9uzZwxNPPIG3tzft27cvs9/vvvuOo0ePMnToUGPZ4sWLmT9/PitWrKB58+YkJCTQu3dvTpw4QWhoKDk5OfTq1YsHH3yQdevWkZqaynPPPWdcXlEU4uLiSExMZOLEicbyhIQE7r//furXr3/T7X7kyBEKCgro2rWrsczf35/w8HD2799Pt27dbrq8ENWVRSczAwYMML4ODw+nZcuWBAYG8vnnn9OnT58yl5k8eTLjx483zmdnZ6PVau94rEL8mwwePJjJkycbzzXZt28fGzduNElmihOJYqtXr6Z27dqcPHmS8PBw0tPTCQ0NpV27diiKQmBgoLFteno6vr6+dO7cGTs7OwICAmjVqlWZsXTr1g1nZ2e2bt3K4MGDAVi/fj0xMTG4ubmRk5PDggUL+Prrr2nTpg0AwcHB7N27lxUrVpgkM1FRUdjY2KDT6SgoKOCpp55iyJAhxvp58+YxadIk40jQ7Nmz2bVrF4sWLWLZsmUkJSWh1+tJSEjAycmJJk2acP78eZ555hljH08++SSvvPIKhw4dolWrVhQUFLBu3Trmzp17y+2ekZGBvb09NWvWNCn38fEhIyPjlssLUV1ZdDJzIz8/PwIDA/n555/LbaPRaModtRHCUjnZ2HDmAfMcEnCyqfzR5lq1ahEdHc3atWtRVZXo6Ghq1apl0ubMmTNMmzaNgwcPcunSJQwGA1CUqISHhxMbG0uXLl1o2LAh3bt3p1evXsYRh379+rFo0SKCg4Pp3r07PXv2JCYmhho1Sn9l2dnZ0a9fP5KSkhg8eDA5OTl88sknrF+/HoCTJ0+Sl5dHly5dTJbT6XQmh8UANm3aRFhYGAUFBaSkpDB27Fhq1qzJm2++SXZ2NhcuXKBt27Ymy7Rt29Y4anTq1CkiIiJwcnIy1hcnUMX8/PyIjo4mISGBVq1a8dlnn5GXl0e/fv0qvP1vpKoqiqLc9vJCWDurSmYuX77MuXPn8PPzM3coQlQpRVEqfajH3OLi4hg9ejQAy5YtK1UfExODVqtl1apV+Pv7YzAYCA8PR6fTAUXn3qSmprJt2zZ27txJ//796dy5M5s3b0ar1XL69Gl27NjBzp07GTVqFHPnzmX37t3Y2dmVWtegQYNo3749mZmZ7NixAwcHB+PFBcVJ1Oeff06dOnVMlrvxh49WqyUkJASAsLAwzp49y7Rp05g+fbqxzY1JQ8lEoqLnHw0fPpzBgwezcOFCEhMTGTBggEkCVB5fX190Oh1XrlwxGZ3JzMwkKiqqQusWojoy6wnAV69e5fjx48b7L6SmpnL8+HHS09O5evUqEydO5MCBA6SlpZGcnExMTAy1atXikUceMWfYQgiKbpug0+nQ6XSlztW4fPkyp06dYurUqXTq1ImwsDCuXLlSqg83NzcGDBjAqlWr2LRpEx999BF//PEHAI6OjvTu3ZslS5aQnJzMgQMHSEkp+7yiqKgotFotmzZtIikpiX79+mFvbw9A48aN0Wg0pKenExISYjLd6hC0ra0thYWF6HQ63Nzc8Pf3Z+/evSZt9u/fT1hYmHFd33//Pbm5ucb6gwcPluq3Z8+eODs7s3z5crZt20ZcXNxN4yh2zz33YGdnx44dO4xlFy9e5Mcff5RkRvyrmXVk5rvvvqNjx47G+eJzXYYOHcry5ctJSUnhvffe488//8TPz4+OHTuyadMmXF1dzRWyEOI6W1tbTp06ZXxdUs2aNfHy8mLlypX4+fmRnp7OSy+9ZNJm4cKF+Pn5ERkZiY2NDR9++CG+vr54eHiwZs0a9Ho9rVu3xsnJiffffx9HR0eT82pKUhSFgQMH8s477/DTTz+xa9cuY52rqysTJ07k+eefx2Aw0K5dO7Kzs9m/fz8uLi4mJ/hevnyZjIwMCgsLSUlJYfHixXTs2BE3NzcAXnjhBV599VXq169PZGQkiYmJHD9+nKSkJAAGDhzIyy+/zLBhw5g6dSppaWmlrlwq3l6xsbFMnjyZkJCQUoeiyuPu7s6wYcOYMGECXl5eeHp6MnHiRJo2bUrnzp2N7dLT0/njjz9IT09Hr9cbfzCGhIQYT5IWolpRq7msrCwVULOysswdihCqqqpqbm6uevLkSTU3N9fcoVTa0KFD1Yceeqjc+oceekgdOnSoqqqqumPHDjUsLEzVaDRqs2bN1OTkZBVQt27dqqqqqq5cuVKNjIxUnZ2dVTc3N7VTp07q0aNHVVVV1a1bt6qtW7dW3dzcVGdnZ/W+++5Td+7caVxPYGCgunDhQpN1nzhxQgXUwMBA1WAwmNQZDAZ18eLFasOGDVU7OzvV29tb7datm7p7925VVVU1NTVVBYyTra2tWrduXXXEiBFqZmamsR+9Xq/OmDFDrVOnjmpnZ6dGRESo27ZtM1nXgQMH1IiICNXe3l6NjIxUP/roIxVQjx07ZtLuzJkzKqDOmTPnVpvdRG5urjp69GjV09NTdXR0VHv16qWmp6ebtBk6dKjJ+ymedu3addN+rfVzKaqnyuy/FVW1sNtbVrHs7Gzc3d3Jysoy/roSwpzy8vJITU0lKCgIBwcHc4cjzGTfvn106NCB8+fP4+PjY+5w5HMpLE5l9t9WdQKwEEJYu/z8fM6dO8e0adPo37+/RSQyQlg7i78DsBBCVCcbNmygYcOGZGVlMWfOHJO6pKQkXFxcypyaNGlipoiFsHwyMiOEEHdRbGxsuQ/j7N27N61bty6zrqxL0oUQRSSZEUIIC+Hq6ipXawpxG+QwkxBCCCGsmiQzQgghhLBqkswIIYQQwqpJMiOEEEIIqybJjBBCCCGsmiQzQgirU69ePRYtWmTuMCokLS0NRVGMz0cSQlQ9SWaEEBUWGxuLoiiMHDmyVN2oUaNQFKXce6hUpcOHD/PUU09VWX/FCUfxZG9vT0hICDNnzsTSnviSn5/PmDFjqFWrFs7OzvTu3Zvz588b69PS0hg2bBhBQUE4OjpSv359Xn31VXQ6nRmjFuLOkmRGCFEpWq2WjRs3kpubayzLy8tjw4YNBAQE3JUYvL29cXJyqvJ+d+7cycWLF/n555+ZMWMGb7zxBgkJCVW+nn9i3LhxbN26lY0bN7J3716uXr1Kr1690Ov1APzvf//DYDCwYsUKTpw4wcKFC3nnnXeYMmWKmSMX4s6RZEYIC6CqKtd0hWaZKjvy0KJFCwICAtiyZYuxbMuWLWi1Wpo3b24s2759O+3atcPDwwMvLy969erFmTNnjPU6nY7Ro0fj5+eHg4MD9erVIz4+3lg/ffp0AgIC0Gg0+Pv7M3bsWGNdycNMjz/+OI899phJjAUFBdSqVYvExETj9p0zZw7BwcE4OjoSERHB5s2bS703Ly8vfH19CQwMZNCgQURFRXH06FFjvcFg4LXXXqNu3bpoNBoiIyPZvn27SR+HDh2iefPmODg40LJlS44dO2asU1WVkJAQ5s2bZ7LMjz/+iI2Njcn2KUtWVharV69m/vz5dO7cmebNm7Nu3TpSUlLYuXMnAN27dycxMZGuXbsSHBxM7969mThxosm/lxDVjdwBWAgLkFugp/ErX5pl3Sdf64aTfeW+Cp588kkSExMZNGgQAAkJCcTFxZGcnGxsk5OTw/jx42natCk5OTm88sorPPLIIxw/fhwbGxuWLFnCp59+ygcffEBAQADnzp3j3LlzAGzevJmFCxeyceNGmjRpQkZGBt9//32ZsQwaNIj+/ftz9epVXFxcAPjyyy/Jycmhb9++AEydOpUtW7awfPlyQkND2bNnD0888QTe3t60b9++zH6/++47jh49ytChQ41lixcvZv78+axYsYLmzZuTkJBA7969OXHiBKGhoeTk5NCrVy8efPBB1q1bR2pqKs8995xxeUVRiIuLIzExkYkTJxrLExISuP/++6lfv/5Nt/uRI0coKCiga9euxjJ/f3/Cw8PZv38/3bp1K3O5rKwsPD09b9q3ENZMkhkhRKUNHjyYyZMnG8812bdvHxs3bjRJZooTiWKrV6+mdu3anDx5kvDwcNLT0wkNDaVdu3YoikJgYKCxbXp6Or6+vnTu3Bk7OzsCAgJo1apVmbF069YNZ2dntm7dyuDBgwFYv349MTExuLm5kZOTw4IFC/j6669p06YNAMHBwezdu5cVK1aYJDNRUVHY2Nig0+koKCjgqaeeYsiQIcb6efPmMWnSJONI0OzZs9m1axeLFi1i2bJlJCUlodfrSUhIwMnJiSZNmnD+/HmeeeYZYx9PPvkkr7zyCocOHaJVq1YUFBSwbt065s6de8vtnpGRgb29PTVr1jQp9/HxISMjo8xlzpw5w1tvvcX8+fNv2b8Q1kqSGSEsgKOdLSdfK/tX9d1Yd2XVqlWL6Oho1q5di6qqREdHU6tWLZM2Z86cYdq0aRw8eJBLly5hMBiAokQlPDyc2NhYunTpQsOGDenevTu9evUyjjj069ePRYsWERwcTPfu3enZsycxMTHUqFH6K8vOzo5+/fqRlJTE4MGDycnJ4ZNPPmH9+vUAnDx5kry8PLp06WKynE6nMzksBrBp0ybCwsIoKCggJSWFsWPHUrNmTd58802ys7O5cOECbdu2NVmmbdu2xlGjU6dOERERYXI+T3ECVczPz4/o6GgSEhJo1aoVn332GXl5efTr16/C2/9GqqqiKEqp8gsXLtC9e3f69evH8OHDb7t/ISydJDNCWABFUSp9qMfc4uLiGD16NADLli0rVR8TE4NWq2XVqlX4+/tjMBgIDw83XlXTokULUlNT2bZtGzt37qR///507tyZzZs3o9VqOX36NDt27GDnzp2MGjWKuXPnsnv37jKfHj1o0CDat29PZmYmO3bswMHBgR49egAYk6jPP/+cOnXqmCyn0WhM5rVaLSEhIQCEhYVx9uxZpk2bxvTp041tbkwaSiYSFT3/aPjw4QwePJiFCxeSmJjIgAEDKnRCs6+vLzqdjitXrpiMzmRmZhIVFWXS9sKFC3Ts2JE2bdqwcuXKCsUlhLWSE4CFELele/fu6HQ6dDpdqXM1Ll++zKlTp5g6dSqdOnUiLCyMK1eulOrDzc2NAQMGsGrVKjZt2sRHH33EH3/8AYCjoyO9e/dmyZIlJCcnc+DAAVJSUsqMJSoqCq1Wy6ZNm0hKSqJfv37Y29sD0LhxYzQaDenp6YSEhJhMWq32pu/R1taWwsJCdDodbm5u+Pv7s3fvXpM2+/fvJywszLiu77//3uRKr4MHD5bqt2fPnjg7O7N8+XK2bdtGXFzcTeMods8992BnZ8eOHTuMZRcvXuTHH380SWb+7//+jw4dOtCiRQsSExOxsZGvelG9WddPQSGExbC1teXUqVPG1yXVrFkTLy8vVq5ciZ+fH+np6bz00ksmbRYuXIifnx+RkZHY2Njw4Ycf4uvri4eHB2vWrEGv19O6dWucnJx4//33cXR0NDmvpiRFURg4cCDvvPMOP/30E7t27TLWubq6MnHiRJ5//nkMBgPt2rUjOzub/fv34+LiYnKC7+XLl8nIyKCwsJCUlBQWL15Mx44dcXNzA+CFF17g1VdfpX79+kRGRpKYmMjx48dJSkoCYODAgbz88ssMGzaMqVOnkpaWVurKpeLtFRsby+TJkwkJCSl1KKo87u7uDBs2jAkTJuDl5YWnpycTJ06kadOmdO7cGSgakenQoQMBAQHMmzeP33//3bi8r69vhdYjhNVRq7msrCwVULOysswdihCqqqpqbm6uevLkSTU3N9fcoVTa0KFD1Yceeqjc+oceekgdOnSoqqqqumPHDjUsLEzVaDRqs2bN1OTkZBVQt27dqqqqqq5cuVKNjIxUnZ2dVTc3N7VTp07q0aNHVVVV1a1bt6qtW7dW3dzcVGdnZ/W+++5Td+7caVxPYGCgunDhQpN1nzhxQgXUwMBA1WAwmNQZDAZ18eLFasOGDVU7OzvV29tb7datm7p7925VVVU1NTVVBYyTra2tWrduXXXEiBFqZmamsR+9Xq/OmDFDrVOnjmpnZ6dGRESo27ZtM1nXgQMH1IiICNXe3l6NjIxUP/roIxVQjx07ZtLuzJkzKqDOmTPnVpvdRG5urjp69GjV09NTdXR0VHv16qWmp6cb6xMTE03eS8npVv1a6+dSVE+V2X8rqmpht7esYtnZ2bi7u5OVlWX8dSWEOeXl5ZGamkpQUBAODg7mDkeYyb59++jQoQPnz5/Hx8fH3OHI51JYnMrsv+UwkxBC3EX5+fmcO3eOadOm0b9/f4tIZISwdnJWmBBC3EUbNmygYcOGZGVlMWfOHJO6pKQkXFxcypyaNGlipoiFsHwyMiOEEHdRbGxsuQ/j7N27N61bty6zrqxL0oUQRSSZEUIIC+Hq6oqrq6u5wxDC6shhJiGEEEJYNUlmhBBCCGHVJJkRQgghhFWTZEYIIYQQVk2SGSGEEEJYNUlmhBBWp169eixatMjcYVRIWloaiqJw/Phxc4ciRLUlyYwQosJiY2NRFIWRI0eWqhs1ahSKopR7D5WqdPjwYZ566qkq66844Sie7O3tCQkJYebMmVjaE1/y8/MZM2YMtWrVwtnZmd69e3P+/HmTNr179yYgIAAHBwf8/PwYPHgwFy5cMFPEQtx5Zk1m9uzZQ0xMDP7+/iiKwscff2xSr6oq06dPx9/fH0dHRzp06MCJEyfME6wQAgCtVsvGjRvJzc01luXl5bFhwwYCAgLuSgze3t44OTlVeb87d+7k4sWL/Pzzz8yYMYM33niDhISEKl/PPzFu3Di2bt3Kxo0b2bt3L1evXqVXr17o9Xpjm44dO/LBBx9w+vRpPvroI86cOcOjjz5qxqiFuLPMmszk5OQQERHB0qVLy6yfM2cOCxYsYOnSpRw+fBhfX1+6dOnCX3/9dZcjFeIOU1XQ5ZhnquTIQ4sWLQgICGDLli3Gsi1btqDVamnevLmxbPv27bRr1w4PDw+8vLzo1asXZ86cMdbrdDpGjx6Nn58fDg4O1KtXj/j4eGP99OnTCQgIQKPR4O/vz9ixY411JQ8zPf744zz22GMmMRYUFFCrVi0SExOvb16VOXPmEBwcjKOjIxEREWzevLnUe/Py8sLX15fAwEAGDRpEVFQUR48eNdYbDAZee+016tati0ajITIyku3bt5v0cejQIZo3b46DgwMtW7bk2LFjxjpVVQkJCWHevHkmy/z444/Y2NiYbJ+yZGVlsXr1aubPn0/nzp1p3rw569atIyUlhZ07dxrbPf/889x3330EBgYSFRXFSy+9xMGDBykoKLhp/0JYK7PeAbhHjx706NGjzDpVVVm0aBEvv/wyffr0AWDt2rX4+Piwfv16nn766TKXy8/PJz8/3zifnZ1d9YELUdUKrsEsf/Ose8oFsHeu1CJPPvkkiYmJDBo0CICEhATi4uJITk42tsnJyWH8+PE0bdqUnJwcXnnlFR555BGOHz+OjY0NS5Ys4dNPP+WDDz4gICCAc+fOce7cOQA2b97MwoUL2bhxI02aNCEjI4Pvv/++zFgGDRpE//79uXr1Ki4uLgB8+eWX5OTk0LdvXwCmTp3Kli1bWL58OaGhoezZs4cnnngCb29v2rdvX2a/3333HUePHmXo0KHGssWLFzN//nxWrFhB8+bNSUhIoHfv3pw4cYLQ0FBycnLo1asXDz74IOvWrSM1NZXnnnvOuLyiKMTFxZGYmMjEiRON5QkJCdx///3Ur1//ptv9yJEjFBQU0LVrV2OZv78/4eHh7N+/n27dupVa5o8//iApKYmoqCh5JIKotiz2nJnU1FQyMjJM/mg1Gg3t27dn//795S4XHx+Pu7u7cdJqtXcjXCH+VQYPHszevXtJS0vj119/Zd++fTzxxBMmbfr27UufPn0IDQ0lMjKS1atXk5KSwsmTJwFIT08nNDSUdu3aERgYSLt27Xj88ceNdb6+vnTu3JmAgABatWrFiBEjyoylW7duODs7s3XrVmPZ+vXriYmJwc3NjZycHBYsWEBCQgLdunUjODiY2NhYnnjiCVasWGHSV1RUFC4uLtjb23PvvffSv39/hgwZYqyfN28ekyZN4rHHHqNhw4bMnj2byMhI4yhRUlISer2ehIQEmjRpQq9evXjhhRdM1vHkk09y+vRpDh06BBSNIq1bt464uLhbbveMjAzs7e2pWbOmSbmPjw8ZGRkmZZMmTcLZ2RkvLy/S09P55JNPbtm/ENbKYp/NVPyH6ePjY1Lu4+PDr7/+Wu5ykydPZvz48cb57OxsSWiE5bNzKhohMde6K6lWrVpER0ezdu1aVFUlOjqaWrVqmbQ5c+YM06ZN4+DBg1y6dAmDwQAUJSrh4eHExsbSpUsXGjZsSPfu3enVq5fxx0u/fv1YtGgRwcHBdO/enZ49exITE0ONGqW/suzs7OjXrx9JSUkMHjyYnJwcPvnkE9avXw/AyZMnycvLo0uXLibL6XQ6k8NiAJs2bSIsLIyCggJSUlIYO3YsNWvW5M033yQ7O5sLFy7Qtm1bk2Xatm1rHDU6deoUERERJufztGnTxqS9n58f0dHRJCQk0KpVKz777DPy8vLo169fhbf/jVRVRVEUk7IXXniBYcOG8euvvzJjxgyGDBnCZ599VqqdENWBxSYzxW78wyvrj7YkjUaDRqO502EJUbUUpdKHeswtLi6O0aNHA7Bs2bJS9TExMWi1WlatWoW/vz8Gg4Hw8HB0Oh1QdO5Namoq27ZtY+fOnfTv35/OnTuzefNmtFotp0+fZseOHezcuZNRo0Yxd+5cdu/eXeahkkGDBtG+fXsyMzPZsWMHDg4OxkPYxUnU559/Tp06dUyWu/G7QqvVEhISAkBYWBhnz55l2rRpTJ8+3djmZt9JFb3yafjw4QwePJiFCxeSmJjIgAEDKnRCs6+vLzqdjitXrpiMzmRmZhIVFWXStlatWtSqVYsGDRoQFhaGVqvl4MGDpZIrIaoDi01mfH19gaIRGj8/P2N5ZmZmqdEaczj25Wcc+uT6CYQlv8BKvDb5WrteXt6XnVqJPkq3KVleRn8l6m/5XXuTBiq3WPhm1bdY8S37/gcU/sEv0X/yK7aMRRUUHGt60uzRJ7hkZ4udrW3VdF2hMP/5L/K8q3+Rfy2HzLSztGjUgLzrVzQ1bxhKZtpZ8q/lkFfDlv8dO8KpU6d4c/qrNK0fBMC3330HwJ+ZGWT+etbYZ8f7WtHxvlZ0vr8djw2N5fT3x/D08ACgTURT2kQ05fGHHyKqU2f2fLWdZuHhGAoLufrHZX7/NRWA0Dp+1PHzY/Xyt/lvcjK9uncj6+L/AVDbxQmNvT0/Hj1C43o3XG1lKOT39DQu/1/Rpc1/XLzA754exurc7CwKCwu5cOZnXF1d8fXx4cvP/kNYiX72JO+ieUQEv6enofWtzXtrj5H+0/9wdHAAYMcXn5fq+97wxjg6ODBv1hts27aNTz/YxKX0NMr9N7peXM/HGzs7Oz7asJ6HY3oBkPFbJj/++CMvvzCBS+fKHrW+fP2y7Mxzv3KpbtnnZhUUFnL1ymW2fvAeur/KOdewnL+Hm36yyvsbKrevm/RWblc3i6B0XZnNyygsM5Z/tGwFY7lh2VLvr9TsrddVej03dnKLdZahZJuGbe4nvGOXm7S+syw2mQkKCsLX15cdO3YYh4J1Oh27d+9m9uzZZo4OdLm5XL18ydxhCCtkp9OBqqIaDKi3mSyZ684nqqqiqioGvR4F2LN9G1D0tWjQ6431bi4u1KzpwXvr1+Pt5cX/XbzAG3OLruBRDQYMhXpWJCTiU9ubJmFh2NjY8Olnn1Hb2xtXJyfWb/oAvV5Pi8gIHB0c2PTRR0X3TPHxQV9YiErRiIu+sNAY28MxvVizLomzaWlsXveesc7RwYGRw4cx7fXX0RcW0Oqelvx19SrfHT2Ks7MT/fv0wVBYdJXP5Uu/c/HCBQoL9Zz66TSrEhJpe999ODk4oC8o4Jnhw5i3eAkBdevQJCyMTZs/4seTp1g6fx76ggIe7tmTWXPmMW7iCzw3ahTn/+88b69YCYChsAB9iauJ+vd5hJmz51AvMIDmzZpSWIErjZwcHHi836O8+vpM3F1d8HD34LU33ySsYQPatmpFoU7Hse+/59j3P9Cq5T24u7uTnn6OOYsXUy8ggMjwphReHxm7UaFej6FQz58ZF7n2h3y3icqpHXTzk9fvNLMmM1evXuWXX34xzqempnL8+HE8PT0JCAhg3LhxzJo1i9DQUEJDQ5k1axZOTk4MHDjQjFEXCe/QmXrNShxvL7FTKi+jNZaXbGvaoJw+lLJfltPGWGyyHpMFy4yvYtW3Wrbyv6oq0eA2/IPd/j9ZtMyRqKIyXUEBmVeyqOlXB4frv94rtdI7lsmU7vjGEo2zM/YFhXjVLRqZ8Lqh3t7RCY2TM94B9Vi/LonnJ0ygY3QvGjRowML58+nctSuuXt541Q3Ap05d3lm5kl9++QVbW1ta3nMP//nPf/AOqEedoGDmzpvLjDdno9frCQ9vwsdbthDatBkAtra2OHt44FX37/Ph4p56iiXL3yEwIIAevR82+SzOmTefwOD6LFu5kokvT8PDw4PmkZFMevFFPOtoyS4sOhTVf0issX8/X196REfz2vTpeHp7A/DilJfR29jw+uy5ZP7+O2Fhjfho84e0bNsOAE/g461bGT12DF0fepiwsEa8+WY8Ax4fiHttHzzr1DVu2GdGj2HJ8neIixuGp3/dCv8rvbV0GS9NmcLIcePJzc2lY4cOrFn7Ht516wIqPn9cYceSt5i/dBk5OTn4+vrStUsXJk+ahF+dv0dlbvy3zc/P58/cfLo9M44aNqX/Fss9hHaTz2O5I67l9nWzkeHyKio5mlxW0U3+Xm+5qjIKy15vBWO5sfCG5Up3U1act+jjVrGV+Z5uvoyXNrDUMneToprx9pbJycl07NixVPnQoUNZs2YNqqoyY8YMVqxYwZUrV2jdujXLli0jPDy8wuvIzs7G3d2drKws3NzcqjJ8IW5LXl4eqampBAUFlZHMiH+Lffv20aFDB86fP28Rh87lcyksTWX232ZNZu4GSWaEpZGdxr9bfn4+586d46mnnsLPz4+kpCRzhwTI51JYnsrsvy32PjNCCFEdbdiwgYYNG5KVlcWcOXNM6pKSknBxcSlzatKkiZkiFsLyWewJwEIIUR3FxsaW+zDO3r1707p16zLr5O69QpRPkhkhhLAQrq6uuLq6mjsMIayOHGYSQgghhFWTZEYIIYQQVk2SGSGEEEJYNUlmhBBCCGHVJJkRQgghhFWTZEYIYXXq1avHokWLzB1GhaSlpaEoCsePHzd3KEJUW5LMCCEqLDY2FkVRGDlyZKm6UaNGoShKufdQqUqHDx/mqaeeqrL+ihOO4sne3p6QkBBmzpxZ/jOJzCQ/P58xY8ZQq1YtnJ2d6d27N+fPny+3bWRkpCRTotqTZEYIUSlarZaNGzeSm5trLMvLy2PDhg0EBATclRi8vb1xcnKq8n537tzJxYsX+fnnn5kxYwZvvPEGCQkJVb6ef2LcuHFs3bqVjRs3snfvXq5evUqvXr3Q6/Wl2r744ov4+/uX0YsQ1YskM0JYAFVVuVZwzSxTZUceWrRoQUBAAFu2bDGWbdmyBa1WS/Pmfz9Jfvv27bRr1w4PDw+8vLzo1asXZ86cMdbrdDpGjx6Nn58fDg4O1KtXj/j4eGP99OnTCQgIQKPR4O/vz9ixY411JQ8zPf744zz22GMmMRYUFFCrVi0SExON23fOnDkEBwfj6OhIREQEmzdvLvXevLy88PX1JTAwkEGDBhEVFcXRo0eN9QaDgddee426deui0WiIjIxk+/btJn0cOnSI5s2b4+DgQMuWLTl27JixTlVVQkJCmDdvnskyP/74IzY2NibbpyxZWVmsXr2a+fPn07lzZ5o3b866detISUlh586dJm23bdvGV199VWpdQlRHcgdgISxAbmEurdeXfRv7O+3bgd/iZFe5UY4nn3ySxMREBg0aBEBCQgJxcXEkJycb2+Tk5DB+/HiaNm1KTk4Or7zyCo888gjHjx/HxsaGJUuW8Omnn/LBBx8QEBDAuXPnOHfuHACbN29m4cKFbNy4kSZNmpCRkcH3339fZiyDBg2if//+XL16FRcXFwC+/PJLcnJy6Nu3LwBTp05ly5YtLF++nNDQUPbs2cMTTzyBt7c37du3L7Pf7777jqNHjzJ06FBj2eLFi5k/fz4rVqygefPmJCQk0Lt3b06cOEFoaCg5OTn06tWLBx98kHXr1pGamspzzz1nXF5RFOLi4khMTGTixInG8oSEBO6//37q169/0+1+5MgRCgoK6Nq1q7HM39+f8PBw9u/fT7du3QD47bffGDFiBB9//PEdGcESwtJIMiOEqLTBgwczefJk47km+/btY+PGjSbJTHEiUWz16tXUrl2bkydPEh4eTnp6OqGhobRr1w5FUQgMDDS2TU9Px9fXl86dO2NnZ0dAQACtWrUqM5Zu3brh7OzM1q1bGTx4MADr168nJiYGNzc3cnJyWLBgAV9//TVt2rQBIDg4mL1797JixQqTZCYqKgobGxt0Oh0FBQU89dRTDBkyxFg/b948Jk2aZBwJmj17Nrt27WLRokUsW7aMpKQk9Ho9CQkJODk50aRJE86fP88zzzxj7OPJJ5/klVde4dChQ7Rq1YqCggLWrVvH3Llzb7ndMzIysLe3p2bNmiblPj4+ZGRkAEWjP7GxsYwcOZKWLVuSlpZ2y36FsHaSzAhhARxrOPLtwG/Ntu7KqlWrFtHR0axduxZVVYmOjqZWrVombc6cOcO0adM4ePAgly5dwmAwAEWJSnh4OLGxsXTp0oWGDRvSvXt3evXqZRxx6NevH4sWLSI4OJju3bvTs2dPYmJiqFGj9FeWnZ0d/fr1IykpicGDB5OTk8Mnn3zC+vXrATh58iR5eXl06dLFZDmdTmdyWAxg06ZNhIWFUVBQQEpKCmPHjqVmzZq8+eabZGdnc+HCBdq2bWuyTNu2bY2jRqdOnSIiIsJkNKQ4gSrm5+dHdHQ0CQkJtGrVis8++4y8vDz69etX4e1/I1VVURQFgLfeeovs7GwmT5582/0JYW0kmRHCAiiKUulDPeYWFxfH6NGjAVi2bFmp+piYGLRaLatWrcLf3x+DwUB4eDg6nQ4oOvcmNTWVbdu2sXPnTvr370/nzp3ZvHkzWq2W06dPs2PHDnbu3MmoUaOYO3cuu3fvLvPp0YMGDaJ9+/ZkZmayY8cOHBwc6NGjB4Axifr888+pU6eOyXIajcZkXqvVEhISAkBYWBhnz55l2rRpTJ8+3dimOGkoVjKRqOj5R8OHD2fw4MEsXLiQxMREBgwYUKHDQb6+vuh0Oq5cuWIyOpOZmUlUVBQAX3/9NQcPHiz13lq2bMmgQYNYu3ZthWIUwprICcBCiNvSvXt3dDodOp3OeK5GscuXL3Pq1CmmTp1Kp06dCAsL48qVK6X6cHNzY8CAAaxatYpNmzbx0Ucf8ccffwDg6OhI7969WbJkCcnJyRw4cICUlJQyY4mKikKr1bJp0yaSkpLo168f9vb2ADRu3BiNRkN6ejohISEmk1arvel7tLW1pbCwEJ1Oh5ubG/7+/uzdu9ekzf79+wkLCzOu6/vvvze50uvgwYOl+u3ZsyfOzs4sX76cbdu2ERcXd9M4it1zzz3Y2dmxY8cOY9nFixf58ccfjcnMkiVL+P777zl+/DjHjx/niy++AIpGnd54440KrUcIayMjM0KI22Jra8upU6eMr0uqWbMmXl5erFy5Ej8/P9LT03nppZdM2ixcuBA/Pz8iIyOxsbHhww8/xNfXFw8PD9asWYNer6d169Y4OTnx/vvv4+joaHJeTUmKojBw4EDeeecdfvrpJ3bt2mWsc3V1ZeLEiTz//PMYDAbatWtHdnY2+/fvx8XFxeQE38uXL5ORkUFhYSEpKSksXryYjh074ubmBsALL7zAq6++Sv369YmMjCQxMZHjx4+TlJQEwMCBA3n55ZcZNmwYU6dOJS0trcyriWxtbYmNjWXy5MmEhISUOhRVHnd3d4YNG8aECRPw8vLC09OTiRMn0rRpUzp37gxQ6vL44pOi69evT926dSu0HiGsjSQzQojbVryTv5GNjQ0bN25k7NixhIeH07BhQ5YsWUKHDh2MbVxcXJg9ezY///wztra23HvvvXzxxRfY2Njg4eHBm2++yfjx49Hr9TRt2pT//Oc/eHl5lRvLoEGDmDVrFoGBgaXOa3n99depXbs28fHxnD17Fg8PD1q0aMGUKVNM2hUnBLa2tvj5+dGzZ0+T0YyxY8eSnZ3NhAkTyMzMpHHjxnz66aeEhoYa39N//vMfRo4cSfPmzWncuDGzZ88udTI0wLBhw5g1a1aFR2WKLVy4kBo1atC/f39yc3Pp1KkTa9asKZVQCvFvoqiWdnvLKpadnY27uztZWVnlfvEKcTfl5eWRmppKUFAQDg4O5g5HmMm+ffvo0KED58+fx8fHx9zhyOdSWJzK7L9lZEYIIe6i/Px8zp07x7Rp0+jfv79FJDJCWDs5AVgIIe6iDRs20LBhQ7KyspgzZ45JXVJSEi4uLmVOTZo0MVPEQlg+GZkRQoi7KDY2ttyHcfbu3ZvWrcu+E3RZl6QLIYpIMiOEEBbC1dUVV1dXc4chhNWRw0xCCCGEsGqSzAghhBDCqkkyI4QQQgirJsmMEEIIIayaJDNCCCGEsGqSzAghrE69evVYtGiRucOokLS0NBRF4fjx4+YORYhqS5IZIUSFxcbGoigKI0eOLFU3atQoFEUp9x4qVenw4cM89dRTVdZfccJRPNnb2xMSEsLMmTOxtCe+5OfnM2bMGGrVqoWzszO9e/fm/PnzJm3q1atn8n4URSn1oE8hqhNJZoQQlaLVatm4cSO5ubnGsry8PDZs2FDqic13ire3N05OTlXe786dO7l48SI///wzM2bM4I033iAhIaHK1/NPjBs3jq1bt7Jx40b27t3L1atX6dWrF3q93qTda6+9xsWLF43T1KlTzRSxEHeeRd80b/r06cyYMcOkzMfHh4yMDDNF9LdfT1zm7PHfzR2GsEI29gbcggq5eiUPnb1l/eq/lYJ8Pc3CI0j7NY2ktRvp3+8xAD7cvIk6/nWpF1iPgnw92Zdz2fnfr5i7YDanTp3ExtaWVi1b8easeQQHBQOg0+mYMm0Sn/7nY/7M+hOf2j7EDh3GhHEvABA/eybr1r9H5u+ZeNb05KHejzAnfj4ATZs34pmnRzNq5GjiRgxFVVUS333v7zgLCmjQJJjXp7/BEwOHoKoqi99aSMLad/nttwxC6ofywoSXeLj3IwD8dSUPAI2tM0527jjZQUz3PrS6910O7j9Ev4cHAmAwGJg7/03WvJfApcuXaNigIdOnvU7nTl2N6z5y9DDPTRjDTz+dJqxRYyaOfxGAq3/mkXXpGs1bNSVu6HCeGz3OuMzJUydo80Arjh1KMW6fsmRlZ7F69WpWvr2a1s2Lngz+zpJVhEU04NMtn9P5wS4AqAYVOxsHnO3cjcuq+fBXfm6Z/Rb9e+STl1PAof+cxaCT37nmYl3fCH8LbOxFcHNvs63fopMZgCZNmrBz507jvKU85v7Sub84+c0Fc4chrJCDuw1N/dzJv1Zo3Gmoqgr5eeYJSOOAoigVaqovMKAvVOnfZyDvrVtL7x59AVj7/hoG9B3E/oN70RcYyLtawJ9/ZPPUk6MIa9iEa9dymL1wFgMHD+DrL/ZiY2PD2yvf4ottn7Ny6Rrq+NflwsX/4/8u/B95Vwv4zxcfs+ydpaxYkkDDBo3I/D2TE6dSyLtaAIBqKEqs8q4W8HCvR3nq2Vgu/3YFZ2cXAL7673au5eTQrWM0eVcLmDX3Nb7Y/h9mvzafoKD6HPx2P0+NjMPNyYOo+9qRn1PUr+5aoXEdx384yvffH6Pfw48Zy955dxlvvb2EuW8spGmTCDZ88D6PPdGPPV99S3BQfXKu5dDv8b60a/MAS+evJP3cr7w8bZKx7/ycQh57dBDrkt7jqdhnjds1cc0a7rs3Cj9vLbnX11WWbw8epqCggKhWDxjbebh606hBY/bt3U/bVh2M22fh4vnMmRePv19dYqIf4tmnnsPe3r7cvgsKCynI0/Pzd3+Ql2Wo0OdBiGIOznaSzNxMjRo18PX1rXD7/Px88vPzjfPZ2dl3Iiz8QzxoFRN0R/oW1UO5+YGtnhpOuTi62aOx1wBgyM3lfPcOdy22kuomH8DG0aFCbWvY21DDzoahTw5h1twZXMq6iKIoHD7yLe+/l8ShI/upYW+Ds4eGAY/3N1l2RcOVBIVoSc84S5PGTfjt0kVCQkJ4sEsHFEWhUXiose3vf2Tg6+NDj17dsLOzoyEh3N8hyliv2IDGsQbOHhp69e6J04vO/Peb7Tz+2CAAPt32ET16ROOr9SYnJ4cVq5fx+afbad3qPgCaNGvE0R8OsX7zWrp074RTVtFOvtejXbGxsUGn01FQUMCTscN4cliscb3vrF7K+HETeGJI0Xoi7pnNgcP7SEhawcJ5i9n08fuoBgOrVr6Lk5MT97SK5HJWJuPGj8HR1R5nDw3DhsUxZ8EsTv3yAy3vuZeCggI++uQD3nhtFs7umptu/+yrf2Bvb0+dANPvRF8/H/7IumRc/tlRo4mIiKSme02+O3qYV197hYu/nWfZknfK7TtfB/ZZNWjWsS7oLeNHo7AefvXdb93oDrL4ZObnn3/G398fjUZD69atmTVrFsHB5Q/DxsfHlzo0dSf4hXjgF+Jxx9cjqp+8vDxSU1NxcrXHweF6MmOnv8VSd46zmz02TjffiRarYW+LrZ0NgcF1iI6O5sOtG1FVlejoaAKD62BrZ0MNe1uc3TWcOXOGadOmcfDgQS5duoTBUPRr/9KVDJzdWzDi6WF06dKFFq2a0b17d3r16kXXrkWHawYNeZy3VyylafMwunfvTs+ePYmJiaFGjaKvLMVGwd6xxvWdt4b+/fuxeesHDH86jpycHD7/4jPWr1+Ps7uGkz/9QF5eHr0fiTZ5LzqdjubNm+PsrsHJrej9b9q0ibCwMAoKCkhJSWHs2LHU9qnFm2++SXZ2NhcvXqBjp/YmScf9D7Tj+++/x9ldw9m0X4iIjMDbr6axvsOD9wMUJTPuGuq71yM6OpoNH66jfad2bN36Bfn5eTwxdCBOt/h30DgXPWzS2cO0nY2tgr1DDWP5pCkvGOtat2uJb53aPProo8xfOA8vL68y+7bNU9E41qBRh7o4OFQsuRXCUlh0MtO6dWvee+89GjRowG+//cbMmTOJiorixIkT5f5BTp48mfHjxxvns7Oz0Wq1dytkIW6L4uhIw6NHzLbu2xEXF8fo0aMBWLZsWan6mJgYtFotq1atwt/fH4PBQHh4ODqdDoAWLVqQmprKtm3b2LlzJ/3796dz585s3rwZrVbL6dOn2bFjBzt37mTUqFHMnTuX3bt3l/n06EGDBtG+fXsyMzPZsWMHDg4O9OjRA8CYRH3++efUqVPHZDmNxjQp0Gq1hISEABAWFsbZs2eZNm0a06dP/3t73TDkpqqqsayiVz4NHz6cwYMHs3DhQhITExkwYECFTmj29fVFp9Nx5coVatb8O2HKzMwkKiqq3OXuu69oROqXX34p97tTCGtm0clM8ZcRQNOmTWnTpg3169dn7dq1JglLSRqNptQXlBCWTlEUlDtwdc6d1L17d2Ni0q1bN5O6y5cvc+rUKVasWMH99xeNTOzdu7dUH25ubgwYMIABAwbw6KOP0r17d/744w88PT1xdHSkd+/e9O7dm2effZZGjRqRkpJCixYtSvUTFRWFVqtl06ZNbNu2jX79+hnPD2ncuDEajYb09HTat29fqfdoa2tLYWEhOp0ONzc3/P392bt3Lw888ICxzf79+2nVqpVxXe+//z65ubk4Xk8SDx48WKrfnj174uzszPLly9m2bRt79uypUDz33HMPdnZ27Nixg/79iw7jXbx4kR9//JE5c+aUu9yxY8cA8PPzq9gbF8LKWHQycyNnZ2eaNm3Kzz//bO5QhPjXs7W15dSpU8bXJdWsWRMvLy9WrlyJn58f6enppe5zsnDhQvz8/IiMjMTGxoYPP/wQX19fPDw8WLNmDXq9ntatW+Pk5MT777+Po6MjgYGBZcaiKAoDBw7knXfe4aeffmLXrl3GOldXVyZOnMjzzz+PwWCgXbt2ZGdns3//flxcXBg6dKix7eXLl8nIyKCwsJCUlBQWL15Mx44dcXNzA+CFF17g1VdfpX79+kRGRpKYmMjx48dJSkoCYODAgbz88ssMGzaMqVOnkpaWxrx588rcdrGxsUyePJmQkBDatGlToW3u7u7OsGHDmDBhAl5eXnh6ejJx4kSaNm1K586dAThw4AAHDx6kY8eOuLu7c/jwYZ5//nl69+591y6dF+KuU61IXl6eWqdOHXXGjBkVXiYrK0sF1KysrDsYmRAVl5ubq548eVLNzc01dyiVNnToUPWhhx4qt/6hhx5Shw4dqqqqqu7YsUMNCwtTNRqN2qxZMzU5OVkF1K1bt6qqqqorV65UIyMjVWdnZ9XNzU3t1KmTevToUVVVVXXr1q1q69atVTc3N9XZ2Vm977771J07dxrXExgYqC5cuNBk3SdOnFABNTAwUDUYDCZ1BoNBXbx4sdqwYUPVzs5O9fb2Vrt166bu3r1bVVVVTU1NVSm6KlYFVFtbW7Vu3brqiBEj1MzMTGM/er1enTFjhlqnTh3Vzs5OjYiIULdt22ayrgMHDqgRERGqvb29GhkZqX700UcqoB47dsyk3ZkzZ1RAnTNnzq02u4nc3Fx19OjRqqenp+ro6Kj26tVLTU9PN9YfOXJEbd26teru7q46ODioDRs2VF999VU1Jyfnlv1a6+dSVE+V2X8rqmpht7csYeLEicTExBAQEEBmZiYzZ85k9+7dpKSklPsL7UbZ2dm4u7uTlZVl/HUlhDkVnwAcFBQkJ1r+i+3bt48OHTpw/vx5fHx8zB2OfC6FxanM/tuiDzOdP3+exx9/nEuXLuHt7c19993HwYMHK5zICCGEpcnPz+fcuXNMmzaN/v37W0QiI4S1s+hkZuPGjeYOQQghqtSGDRsYNmwYkZGRvP/++yZ1SUlJPP3002UuFxgYyIkTJ+5GiEJYHYtOZoQQorqJjY0t92GcvXv3pnXr1mXWlXVJuhCiiCQzQghhIVxdXXF1dTV3GEJYHXmamBBmYsHn3ot/Ifk8CmsmyYwQd1nx4YJr166ZORIh/lb8eZTDWcIayWEmIe4yW1tbPDw8yMzMBMDJyanCT60Woqqpqsq1a9fIzMzEw8Oj1A0QhbAGkswIYQbFT4IvTmiEMDcPDw/j51IIayPJjBBmoCgKfn5+1K5dm4KCAnOHI/7l7OzsZERGWDVJZoQwI1tbW9mJCCHEPyQnAAshhBDCqkkyI4QQQgirJsmMEEIIIayaJDNCCCGEsGqSzAghhBDCqkkyI4QQQgirJsmMEEIIIayaJDNCCCGEsGqSzAghhBDCqkkyI4QQQgirJsmMEEIIIayaJDNCCCGEsGqSzAghhBDCqslTs2/TH++9z6UVK8wdhhBCCGF2noMHU2vk02ZbvyQzt8mQl4f+8mVzhyGEEEKYneHaNbOuX5KZ22Tr6YlT69bmDkMIAaCYO4B/AdXcAQhLVqN2bfOu36xrt2L6P/7g2rffmjsMIYQQwuwcIyLMun5JZm7T783q8n+jeps7DCGEEMLsCiPqYc6xGUlmbtMau7/YVM/b3GEIIYQQZtfLIYelZly/JDO3KdfWnzzXBuYOQwghhDC7nBrZZl2/JDO3yeWCG057fjV3GEIIIYTZubWuC/eYb/2SzNymuvY1MMg9B4UQQgjq2Js3nZBk5jbVr3WCIfftMHcYQgghhNmF1b4faGq29Usyc5v2ff8hWzll7jCEEEIIs8u7/H/E3DvYbOu3imTm7bffZu7cuVy8eJEmTZqwaNEi7r//frPGVMcugOjfJZkRQggh6ngEmnX9iqqqFn1fx02bNjF48GDefvtt2rZty4oVK3j33Xc5efIkAQEBt1w+Ozsbd3d3srKycHNzuwsRCyGEEOKfqsz+2+KTmdatW9OiRQuWL19uLAsLC+Phhx8mPj6+VPv8/Hzy8/ON89nZ2Wi1WklmhBBCCCtSmWTGoi/H0el0HDlyhK5du5qUd+3alf3795e5THx8PO7u7sZJq9XejVCFEEIIYSYWncxcunQJvV6Pj4+PSbmPjw8ZGRllLjN58mSysrKM07lz5+5GqEIIIYQwE6s4AVhRTB+Jq6pqqbJiGo0GjUZzN8ISQgghhAWw6JGZWrVqYWtrW2oUJjMzs9RojRBCCCH+nSw6mbG3t+eee+5hxw7Tm9Pt2LGDqKgoM0UlhBBCCEti8YeZxo8fz+DBg2nZsiVt2rRh5cqVpKenM3LkSHOHJoQQQggLYPHJzIABA7h8+TKvvfYaFy9eJDw8nC+++ILAQPPeoEcIIYQQlsHi7zPzT8lN84QQQgjrU23uMyOEEEIIcSuSzAghhBDCqkkyI4QQQgirJsmMEEIIIayaJDNCCCGEsGoWf2n2P1V8sVZ2draZIxFCCCFERRXvtyty0XW1T2b++usvAHl6thBCCGGF/vrrL9zd3W/aptrfZ8ZgMHDhwgVcXV3LfTjl7crOzkar1XLu3Dm5h80dJNv57pDtfHfIdr47ZDvfHXdyO6uqyl9//YW/vz82Njc/K6baj8zY2NhQt27dO7oONzc3+WO5C2Q73x2yne8O2c53h2znu+NObedbjcgUkxOAhRBCCGHVJJkRQgghhFWTZOYf0Gg0vPrqq2g0GnOHUq3Jdr47ZDvfHbKd7w7ZzneHpWznan8CsBBCCCGqNxmZEUIIIYRVk2RGCCGEEFZNkhkhhBBCWDVJZoQQQghh1SSZuU1vv/02QUFBODg4cM899/DNN9+YO6RqJT4+nnvvvRdXV1dq167Nww8/zOnTp80dVrUXHx+PoiiMGzfO3KFUS//3f//HE088gZeXF05OTkRGRnLkyBFzh1WtFBYWMnXqVIKCgnB0dCQ4OJjXXnsNg8Fg7tCs2p49e4iJicHf3x9FUfj4449N6lVVZfr06fj7++Po6EiHDh04ceLEXYtPkpnbsGnTJsaNG8fLL7/MsWPHuP/+++nRowfp6enmDq3a2L17N88++ywHDx5kx44dFBYW0rVrV3JycswdWrV1+PBhVq5cSbNmzcwdSrV05coV2rZti52dHdu2bePkyZPMnz8fDw8Pc4dWrcyePZt33nmHpUuXcurUKebMmcPcuXN56623zB2aVcvJySEiIoKlS5eWWT9nzhwWLFjA0qVLOXz4ML6+vnTp0sX4fMQ7ThWV1qpVK3XkyJEmZY0aNVJfeuklM0VU/WVmZqqAunv3bnOHUi399ddfamhoqLpjxw61ffv26nPPPWfukKqdSZMmqe3atTN3GNVedHS0GhcXZ1LWp08f9YknnjBTRNUPoG7dutU4bzAYVF9fX/XNN980luXl5anu7u7qO++8c1dikpGZStLpdBw5coSuXbualHft2pX9+/ebKarqLysrCwBPT08zR1I9Pfvss0RHR9O5c2dzh1Jtffrpp7Rs2ZJ+/fpRu3ZtmjdvzqpVq8wdVrXTrl07/vvf//LTTz8B8P3337N371569uxp5siqr9TUVDIyMkz2ixqNhvbt29+1/WK1f9BkVbt06RJ6vR4fHx+Tch8fHzIyMswUVfWmqirjx4+nXbt2hIeHmzucamfjxo0cPXqUw4cPmzuUau3s2bMsX76c8ePHM2XKFA4dOsTYsWPRaDQMGTLE3OFVG5MmTSIrK4tGjRpha2uLXq/njTfe4PHHHzd3aNVW8b6vrP3ir7/+eldikGTmNimKYjKvqmqpMlE1Ro8ezQ8//MDevXvNHUq1c+7cOZ577jm++uorHBwczB1OtWYwGGjZsiWzZs0CoHnz5pw4cYLly5dLMlOFNm3axLp161i/fj1NmjTh+PHjjBs3Dn9/f4YOHWru8Ko1c+4XJZmppFq1amFra1tqFCYzM7NUVir+uTFjxvDpp5+yZ88e6tata+5wqp0jR46QmZnJPffcYyzT6/Xs2bOHpUuXkp+fj62trRkjrD78/Pxo3LixSVlYWBgfffSRmSKqnl544QVeeuklHnvsMQCaNm3Kr7/+Snx8vCQzd4ivry9QNELj5+dnLL+b+0U5Z6aS7O3tueeee9ixY4dJ+Y4dO4iKijJTVNWPqqqMHj2aLVu28PXXXxMUFGTukKqlTp06kZKSwvHjx41Ty5YtGTRoEMePH5dEpgq1bdu21O0FfvrpJwIDA80UUfV07do1bGxMd222trZyafYdFBQUhK+vr8l+UafTsXv37ru2X5SRmdswfvx4Bg8eTMuWLWnTpg0rV64kPT2dkSNHmju0auPZZ59l/fr1fPLJJ7i6uhpHwtzd3XF0dDRzdNWHq6trqfOQnJ2d8fLykvOTqtjzzz9PVFQUs2bNon///hw6dIiVK1eycuVKc4dWrcTExPDGG28QEBBAkyZNOHbsGAsWLCAuLs7coVm1q1ev8ssvvxjnU1NTOX78OJ6engQEBDBu3DhmzZpFaGgooaGhzJo1CycnJwYOHHh3Arwr10xVQ8uWLVMDAwNVe3t7tUWLFnLJcBUDypwSExPNHVq1J5dm3zn/+c9/1PDwcFWj0aiNGjVSV65cae6Qqp3s7Gz1ueeeUwMCAlQHBwc1ODhYffnll9X8/Hxzh2bVdu3aVeZ38tChQ1VVLbo8+9VXX1V9fX1VjUajPvDAA2pKSspdi09RVVW9O2mTEEIIIUTVk3NmhBBCCGHVJJkRQgghhFWTZEYIIYQQVk2SGSGEEEJYNUlmhBBCCGHVJJkRQgghhFWTZEYIIYQQVk2SGSGEEEJYNUlmhBAWKTk5GUVR+PPPP80dihDCwskdgIUQFqFDhw5ERkayaNEioOhBdX/88Qc+Pj4oimLe4IQQFk0eNCmEsEj29vb4+vqaOwwhhBWQw0xCCLOLjY1l9+7dLF68GEVRUBSFNWvWmBxmWrNmDR4eHnz22Wc0bNgQJycnHn30UXJycli7di316tWjZs2ajBkzBr1eb+xbp9Px4osvUqdOHZydnWndujXJycnmeaNCiDtCRmaEEGa3ePFifvrpJ8LDw3nttdcAOHHiRKl2165dY8mSJWzcuJG//vqLPn360KdPHzw8PPjiiy84e/Ysffv2pV27dgwYMACAJ598krS0NDZu3Ii/vz9bt26le/fupKSkEBoaelffpxDizpBkRghhdu7u7tjb2+Pk5GQ8tPS///2vVLuCggKWL19O/fr1AXj00Ud5//33+e2333BxcaFx48Z07NiRXbt2MWDAAM6cOcOGDRs4f/48/v7+AEycOJHt27eTmJjIrFmz7t6bFELcMZLMCCGshpOTkzGRAfDx8aFevXq4uLiYlGVmZgJw9OhRVFWlQYMGJv3k5+fj5eV1d4IWQtxxkswIIayGnZ2dybyiKGWWGQwGAAwGA7a2thw5cgRbW1uTdiUTICGEdZNkRghhEezt7U1O3K0KzZs3R6/Xk5mZyf3331+lfQshLIdczSSEsAj16tXj22+/JS0tjUuXLhlHV/6JBg0aMGjQIIYMGcKWLVtITU3l8OHDzJ49my+++KIKohZCWAJJZoQQFmHixInY2trSuHFjvL29SU9Pr5J+ExMTGTJkCBMmTKBhw4b07t2bb7/9Fq1WWyX9CyHMT+4ALIQQQgirJiMzQgghhLBqkswIIYQQwqpJMiOEEEIIqybJjBBCCCGsmiQzQgghhLBqkswIIcT/t1sHJAAAAACC/r9uR6ArBNZkBgBYkxkAYE1mAIA1mQEA1mQGAFgLiLFkSit7X7AAAAAASUVORK5CYII=\n", + "text/plain": [ + "
" + ] + }, + "metadata": {}, + "output_type": "display_data" + } + ], + "source": [ + "sim.ds.where(sim.ds['particle_type'] == 'Massive Body',drop=True)['a'].plot(hue=\"name\")" + ] + }, + { + "cell_type": "code", + "execution_count": null, + "id": "6f46b22e-dbd0-4562-a4cf-ea55247a2126", + "metadata": {}, + "outputs": [], + "source": [] + } + ], + "metadata": { + "kernelspec": { + "display_name": "Python (My debug_env Kernel)", + "language": "python", + "name": "debug_env" + }, + "language_info": { + "codemirror_mode": { + "name": "ipython", + "version": 3 + }, + "file_extension": ".py", + "mimetype": "text/x-python", + "name": "python", + "nbconvert_exporter": "python", + "pygments_lexer": "ipython3", + "version": "3.8.5" + } + }, + "nbformat": 4, + "nbformat_minor": 5 +} diff --git a/examples/Basic_Simulation/test_io.ipynb b/examples/Basic_Simulation/test_io.ipynb deleted file mode 100644 index ce92a8229..000000000 --- a/examples/Basic_Simulation/test_io.ipynb +++ /dev/null @@ -1,143 +0,0 @@ -{ - "cells": [ - { - "cell_type": "code", - "execution_count": 1, - "id": "86c845ce-1801-46ca-8a8a-1cabb266e6a6", - "metadata": {}, - "outputs": [], - "source": [ - "import swiftest\n", - "import xarray as xr\n", - "import numpy as np\n", - "import os" - ] - }, - { - "cell_type": "code", - "execution_count": 2, - "id": "d716c371-8eb4-4fc1-82af-8b5c444c831e", - "metadata": {}, - "outputs": [], - "source": [ - "sim = swiftest.Simulation()" - ] - }, - { - "cell_type": "code", - "execution_count": 3, - "id": "83cebbc1-387b-4ef5-b96e-76856b6672e5", - "metadata": {}, - "outputs": [ - { - "name": "stdout", - "output_type": "stream", - "text": [ - "integrator symba\n", - "codename Swiftest\n", - "driver_executable /Users/daminton/git/swiftest/build/swiftest_driver\n", - "t0 0.0 y\n", - "tstart 0.0 y\n", - "tstop NOT SET\n", - "dt NOT SET\n", - "istep_out NOT SET\n", - "istep_dump NOT SET\n", - "init_cond_file_type NETCDF_DOUBLE\n", - "init_cond_format EL\n", - "init_cond_file_name init_cond.nc\n", - "output_file_type NETCDF_DOUBLE\n", - "output_file_name bin.nc\n", - "output_format XVEL\n", - "rmin 0.004650467260962157 AU\n", - "rmax 10000.0 AU\n", - "qmin_coord HELIO\n", - "MU: MSun 1.988409870698051e+30 kg / MSun\n", - "DU: AU 149597870700.0 m / AU\n", - "TU: y 31557600.0 s / y\n", - "close_encounter_check True\n", - "general_relativity True\n", - "fragmentation True\n", - "rotation True\n", - "compute_conservation_values False\n", - "extra_force False\n", - "big_discard False\n", - "rhill_present False\n", - "restart False\n", - "interaction_loops TRIANGULAR\n", - "encounter_check_loops TRIANGULAR\n", - "ephemeris_date 2027-04-30\n" - ] - }, - { - "data": { - "text/plain": [ - "{'! VERSION': 'Swiftest parameter input',\n", - " 'T0': 0.0,\n", - " 'TSTART': 0.0,\n", - " 'IN_TYPE': 'NETCDF_DOUBLE',\n", - " 'IN_FORM': 'EL',\n", - " 'NC_IN': 'init_cond.nc',\n", - " 'OUT_TYPE': 'NETCDF_DOUBLE',\n", - " 'BIN_OUT': 'bin.nc',\n", - " 'OUT_FORM': 'XVEL',\n", - " 'CHK_RMIN': 0.004650467260962157,\n", - " 'CHK_RMAX': 10000.0,\n", - " 'CHK_QMIN_COORD': 'HELIO',\n", - " 'CHK_QMIN': 0.004650467260962157,\n", - " 'CHK_QMIN_RANGE': '0.004650467260962157 10000.0',\n", - " 'MU2KG': 1.988409870698051e+30,\n", - " 'DU2M': 149597870700.0,\n", - " 'TU2S': 31557600.0,\n", - " 'CHK_CLOSE': True,\n", - " 'GR': True,\n", - " 'FRAGMENTATION': True,\n", - " 'ROTATION': True,\n", - " 'ENERGY': False,\n", - " 'EXTRA_FORCE': False,\n", - " 'BIG_DISCARD': False,\n", - " 'RHILL_PRESENT': False,\n", - " 'RESTART': False,\n", - " 'INTERACTION_LOOPS': 'TRIANGULAR',\n", - " 'ENCOUNTER_CHECK': 'TRIANGULAR'}" - ] - }, - "execution_count": 3, - "metadata": {}, - "output_type": "execute_result" - } - ], - "source": [ - "sim.get_parameter()" - ] - }, - { - "cell_type": "code", - "execution_count": null, - "id": "ec7452d6-4c9b-4df3-acc0-b11c32264b91", - "metadata": {}, - "outputs": [], - "source": [] - } - ], - "metadata": { - "kernelspec": { - "display_name": "Python 3 (ipykernel)", - "language": "python", - "name": "python3" - }, - "language_info": { - "codemirror_mode": { - "name": "ipython", - "version": 3 - }, - "file_extension": ".py", - "mimetype": "text/x-python", - "name": "python", - "nbconvert_exporter": "python", - "pygments_lexer": "ipython3", - "version": "3.9.13" - } - }, - "nbformat": 4, - "nbformat_minor": 5 -} From 0aedbe63339405d15115b2aa77c301cf3101a7d9 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Wed, 16 Nov 2022 16:53:58 -0500 Subject: [PATCH 080/569] Refactored the variable ds to be data throughout the Simulation class definition. This makes it more obvious what it is and more intuitive to use (IMHO) --- .../Basic_Simulation/initial_conditions.py | 9 +--- .../Basic_Simulation/run_simulation.ipynb | 2 +- python/swiftest/swiftest/simulation_class.py | 48 +++++++++---------- 3 files changed, 26 insertions(+), 33 deletions(-) diff --git a/examples/Basic_Simulation/initial_conditions.py b/examples/Basic_Simulation/initial_conditions.py index c14cdd931..78900ce1f 100644 --- a/examples/Basic_Simulation/initial_conditions.py +++ b/examples/Basic_Simulation/initial_conditions.py @@ -15,14 +15,7 @@ Returns ------- -param.in : ASCII text file - Swiftest parameter input file. -pl.in : ASCII text file - Swiftest massive body input file. -tp.in : ASCII text file - Swiftest test particle input file. -cb.in : ASCII text file - Swiftest central body input file. +Updates sim.data with the simulation data """ import swiftest diff --git a/examples/Basic_Simulation/run_simulation.ipynb b/examples/Basic_Simulation/run_simulation.ipynb index fa47bcd56..8f2ab51b3 100644 --- a/examples/Basic_Simulation/run_simulation.ipynb +++ b/examples/Basic_Simulation/run_simulation.ipynb @@ -123,7 +123,7 @@ } ], "source": [ - "sim.ds.where(sim.ds['particle_type'] == 'Massive Body',drop=True)['a'].plot(hue=\"name\")" + "sim.data.where(sim.data['particle_type'] == 'Massive Body',drop=True)['a'].plot(hue=\"name\")" ] }, { diff --git a/python/swiftest/swiftest/simulation_class.py b/python/swiftest/swiftest/simulation_class.py index 5df0c3edb..7c17c3d32 100644 --- a/python/swiftest/swiftest/simulation_class.py +++ b/python/swiftest/swiftest/simulation_class.py @@ -81,7 +81,7 @@ def __init__(self,read_param: bool = True, **kwargs: Any): The stopping time for a simulation. `tstop` must be greater than `tstart`. Parameter input file equivalent: `TSTOP` dt : float, optional - The step size of the simulation. `dt` must be less than or equal to `tstop-dstart`. + The step size of the simulation. `dt` must be less than or equal to `tstop-tstart`. Parameter input file equivalent: `DT` istep_out : int, optional The number of time steps between outputs to file. *Note*: only `istep_out` or `toutput` can be set. @@ -276,7 +276,7 @@ def __init__(self,read_param: bool = True, **kwargs: Any): self._getter_column_width = '32' self.param = {} - self.ds = xr.Dataset() + self.data = xr.Dataset() # Parameters are set in reverse priority order. First the defaults, then values from a pre-existing input file, # then using the arguments passed via **kwargs. @@ -1959,7 +1959,7 @@ def add_solar_system_body(self, >*Note.* Currently only the JPL Horizons ephemeris is implemented, so this is ignored. Returns ------- - ds : Xarray dataset with body or bodies added. + data : Xarray dataset with body or bodies added. """ if type(name) is str: @@ -2195,7 +2195,7 @@ def add_body(self, Adds a body (test particle or massive body) to the internal DataSet given a set up 6 vectors (orbital elements or cartesian state vectors, depending on the value of self.param). Input all angles in degress. - This method will update self.ds with the new body or bodies added to the existing Dataset. + This method will update self.data with the new body or bodies added to the existing Dataset. Parameters ---------- @@ -2228,7 +2228,7 @@ def add_body(self, Returns ------- - ds : Xarray Dataset + data : Xarray Dataset Dasaset containing the body or bodies that were added """ @@ -2276,16 +2276,16 @@ def input_to_array(val,t,n=None): J2 = input_to_array(J2,"f",nbodies) J4 = input_to_array(J4,"f",nbodies) - if len(self.ds) == 0: + if len(self.data) == 0: maxid = -1 else: - maxid = self.ds.id.max().values[()] + maxid = self.data.id.max().values[()] if idvals is None: idvals = np.arange(start=maxid+1,stop=maxid+1+nbodies,dtype=int) - if len(self.ds) > 0: - dup_id = np.in1d(idvals,self.ds.id) + if len(self.data) > 0: + dup_id = np.in1d(idvals, self.data.id) if any(dup_id): raise ValueError(f"Duplicate ids detected: ", *idvals[dup_id]) @@ -2317,7 +2317,7 @@ def _combine_and_fix_dsnew(self,dsnew): """ - self.ds = xr.combine_by_coords([self.ds, dsnew]) + self.data = xr.combine_by_coords([self.data, dsnew]) def get_nvals(ds): if "Gmass" in ds: @@ -2329,14 +2329,14 @@ def get_nvals(ds): return ds dsnew = get_nvals(dsnew) - self.ds = get_nvals(self.ds) + self.data = get_nvals(self.data) if self.param['OUT_TYPE'] == "NETCDF_DOUBLE": dsnew = io.fix_types(dsnew, ftype=np.float64) - self.ds = io.fix_types(self.ds, ftype=np.float64) + self.data = io.fix_types(self.data, ftype=np.float64) elif self.param['OUT_TYPE'] == "NETCDF_FLOAT": dsnew = io.fix_types(dsnew, ftype=np.float32) - self.ds = io.fix_types(self.ds, ftype=np.float32) + self.data = io.fix_types(self.data, ftype=np.float32) return dsnew @@ -2481,7 +2481,7 @@ def bin2xr(self): Returns ------- - self.ds : xarray dataset + self.data : xarray dataset """ # Make a temporary copy of the parameter dictionary so we can supply the absolute path of the binary file @@ -2490,11 +2490,11 @@ def bin2xr(self): param_tmp = self.param.copy() param_tmp['BIN_OUT'] = os.path.join(self.sim_dir, self.param['BIN_OUT']) if self.codename == "Swiftest": - self.ds = io.swiftest2xr(param_tmp, verbose=self.verbose) - if self.verbose: print('Swiftest simulation data stored as xarray DataSet .ds') + self.data = io.swiftest2xr(param_tmp, verbose=self.verbose) + if self.verbose: print('Swiftest simulation data stored as xarray DataSet .data') elif self.codename == "Swifter": - self.ds = io.swifter2xr(param_tmp, verbose=self.verbose) - if self.verbose: print('Swifter simulation data stored as xarray DataSet .ds') + self.data = io.swifter2xr(param_tmp, verbose=self.verbose) + if self.verbose: print('Swifter simulation data stored as xarray DataSet .data') elif self.codename == "Swift": warnings.warn("Reading Swift simulation data is not implemented yet") else: @@ -2514,7 +2514,7 @@ def follow(self, codestyle="Swifter"): ------- fol : xarray dataset """ - if self.ds is None: + if self.data is None: self.bin2xr() if codestyle == "Swift": try: @@ -2532,7 +2532,7 @@ def follow(self, codestyle="Swifter"): warnings.warn('No follow.in file found') ifol = None nskp = None - fol = tool.follow_swift(self.ds, ifol=ifol, nskp=nskp) + fol = tool.follow_swift(self.data, ifol=ifol, nskp=nskp) else: fol = None @@ -2574,14 +2574,14 @@ def save(self, param = self.param if codename == "Swiftest": - io.swiftest_xr2infile(ds=self.ds, param=param, in_type=self.param['IN_TYPE'], framenum=framenum) + io.swiftest_xr2infile(ds=self.data, param=param, in_type=self.param['IN_TYPE'], framenum=framenum) self.write_param(param_file=param_file) elif codename == "Swifter": if codename == "Swiftest": swifter_param = io.swiftest2swifter_param(param) else: swifter_param = param - io.swifter_xr2infile(self.ds, swifter_param, framenum) + io.swifter_xr2infile(self.data, swifter_param, framenum) self.write_param(param_file, param=swifter_param) else: warnings.warn(f'Saving to {codename} not supported') @@ -2623,7 +2623,7 @@ def initial_conditions_from_bin(self, framenum=-1, new_param=None, new_param_fil if codename == "Swiftest": if restart: - new_param['T0'] = self.ds.time.values[framenum] + new_param['T0'] = self.data.time.values[framenum] if self.param['OUT_TYPE'] == 'NETCDF_DOUBLE': new_param['IN_TYPE'] = 'NETCDF_DOUBLE' elif self.param['OUT_TYPE'] == 'NETCDF_FLOAT': @@ -2646,7 +2646,7 @@ def initial_conditions_from_bin(self, framenum=-1, new_param=None, new_param_fil new_param.pop('TP_IN', None) new_param.pop('CB_IN', None) print(f"Extracting data from dataset at time frame number {framenum} and saving it to {new_param['NC_IN']}") - frame = io.swiftest_xr2infile(self.ds, self.param, infile_name=new_param['NC_IN'], framenum=framenum) + frame = io.swiftest_xr2infile(self.data, self.param, infile_name=new_param['NC_IN'], framenum=framenum) print(f"Saving parameter configuration file to {new_param_file}") self.write_param(new_param_file, param=new_param) From c24116bed3b87d1599ac763d271c6a894df63011 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Thu, 17 Nov 2022 10:44:29 -0500 Subject: [PATCH 081/569] Changed FOOEXE to SWIFTEST_DRIVER --- CMakeLists.txt | 2 +- src/CMakeLists.txt | 12 ++++++------ 2 files changed, 7 insertions(+), 7 deletions(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index 34b05b21e..255faac9c 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -54,7 +54,7 @@ ENDIF(FCNAME STREQUAL "pgf90") ############################################################ # Define the executable name -SET(FOOEXE swiftest_driver) +SET(SWIFTEST_DRIVER swiftest_driver) # Define some directories SET(SRC ${CMAKE_SOURCE_DIR}/src) diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index 25411a4dc..b4204732c 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -104,26 +104,26 @@ SET(FOO_src ) # Define the executable in terms of the source files -ADD_EXECUTABLE(${FOOEXE} ${FOO_src}) +ADD_EXECUTABLE(${SWIFTEST_DRIVER} ${FOO_src}) ##################################################### # Add the needed libraries and special compiler flags ##################################################### # Uncomment if you need to link to BLAS and LAPACK -TARGET_LINK_LIBRARIES(${FOOEXE} ${NETCDF_LIBRARIES} ${NETCDF_FORTRAN_LIBRARIES}) +TARGET_LINK_LIBRARIES(${SWIFTEST_DRIVER} ${NETCDF_LIBRARIES} ${NETCDF_FORTRAN_LIBRARIES}) # Uncomment if you have parallization IF(USE_OPENMP) - SET_TARGET_PROPERTIES(${FOOEXE} PROPERTIES + SET_TARGET_PROPERTIES(${SWIFTEST_DRIVER} PROPERTIES COMPILE_FLAGS "${OpenMP_Fortran_FLAGS}" LINK_FLAGS "${OpenMP_Fortran_FLAGS}") ELSEIF(USE_MPI) - SET_TARGET_PROPERTIES(${FOOEXE} PROPERTIES + SET_TARGET_PROPERTIES(${SWIFTEST_DRIVER} PROPERTIES COMPILE_FLAGS "${MPI_Fortran_COMPILE_FLAGS}" LINK_FLAGS "${MPI_Fortran_LINK_FLAGS}") INCLUDE_DIRECTORIES(${MPI_Fortran_INCLUDE_PATH}) - TARGET_LINK_LIBRARIES(${FOOEXE} ${MPI_Fortran_LIBRARIES}) + TARGET_LINK_LIBRARIES(${SWIFTEST_DRIVER} ${MPI_Fortran_LIBRARIES}) ENDIF(USE_OPENMP) @@ -137,4 +137,4 @@ IF(WIN32) ELSE() SET(CMAKE_INSTALL_PREFIX /usr/local) ENDIF(WIN32) -INSTALL(TARGETS ${FOOEXE} RUNTIME DESTINATION bin) \ No newline at end of file +INSTALL(TARGETS ${SWIFTEST_DRIVER} RUNTIME DESTINATION bin) \ No newline at end of file From e6319df7091ae9a19cba17b7f9d501fe5014601b Mon Sep 17 00:00:00 2001 From: David A Minton Date: Thu, 17 Nov 2022 11:01:40 -0500 Subject: [PATCH 082/569] Fixed parallelization flag generation so code can compile with OpenMP --- CMakeLists.txt | 3 +-- cmake/Modules/FindOpenMP_Fortran.cmake | 10 ++++------ 2 files changed, 5 insertions(+), 8 deletions(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index 255faac9c..3125fc3e2 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -30,7 +30,7 @@ ENDIF(NOT CMAKE_Fortran_COMPILER_SUPPORTS_F90) # Set some options the user may choose # Uncomment the below if you want the user to choose a parallelization library OPTION(USE_MPI "Use the MPI library for parallelization" OFF) -OPTION(USE_OPENMP "Use OpenMP for parallelization" OFF) +OPTION(USE_OPENMP "Use OpenMP for parallelization" ON) # This INCLUDE statement executes code that sets the compile flags for DEBUG, # RELEASE, and TESTING. You should review this file and make sure the flags @@ -40,7 +40,6 @@ INCLUDE(${CMAKE_MODULE_PATH}/SetFortranFlags.cmake) # taken care of here, such as the fact that the FindOpenMP routine doesn't know # about Fortran. INCLUDE(${CMAKE_MODULE_PATH}/SetParallelizationLibrary.cmake) - INCLUDE(${CMAKE_MODULE_PATH}/SetUpNetCDF.cmake) # There is an error in CMAKE with this flag for pgf90. Unset it diff --git a/cmake/Modules/FindOpenMP_Fortran.cmake b/cmake/Modules/FindOpenMP_Fortran.cmake index c8e0ca2b4..32777569e 100644 --- a/cmake/Modules/FindOpenMP_Fortran.cmake +++ b/cmake/Modules/FindOpenMP_Fortran.cmake @@ -26,14 +26,14 @@ INCLUDE (${CMAKE_ROOT}/Modules/FindPackageHandleStandardArgs.cmake) SET (OpenMP_Fortran_FLAG_CANDIDATES - #Microsoft Visual Studio - "/openmp" - #Intel windows - "/Qopenmp" #Intel "-qopenmp" + #Intel windows + "/Qopenmp" #Gnu "-fopenmp" + #Portland Group + "-mp" #Empty, if compiler automatically accepts openmp " " #Sun @@ -42,8 +42,6 @@ SET (OpenMP_Fortran_FLAG_CANDIDATES "+Oopenmp" #IBM XL C/c++ "-qsmp" - #Portland Group - "-mp" ) IF (DEFINED OpenMP_Fortran_FLAGS) From 33b77d1d6a0ee2fde1526e317d162acb9c7b4e75 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Thu, 17 Nov 2022 16:00:56 -0500 Subject: [PATCH 083/569] Fixed CMake flags so that the fast or strict math model is usedon specific source files where necessary. Added a PROFILE build type that turns on the optimization report in ifort. --- CMakeLists.txt | 4 +- README.md | 6 ++- cmake/Modules/SetCompileFlag.cmake | 4 +- cmake/Modules/SetFortranFlags.cmake | 62 +++++++++++++++++------------ src/CMakeLists.txt | 33 ++++++++++----- 5 files changed, 67 insertions(+), 42 deletions(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index 3125fc3e2..96ce5efa9 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -7,7 +7,7 @@ # You should have received a copy of the GNU General Public License along with Swiftest. # If not, see: https://www.gnu.org/licenses. -# CMake project file for FOO +# CMake project file for SWIFTEST ################################################## # Define the project and the depencies that it has @@ -63,7 +63,7 @@ SET(BIN ${CMAKE_SOURCE_DIR}/bin) # Have the .mod files placed in the lib folder SET(CMAKE_Fortran_MODULE_DIRECTORY ${LIB}) -# The source for the FOO binary and have it placed in the bin folder +# The source for the SWIFTEST binary and have it placed in the bin folder ADD_SUBDIRECTORY(${SRC} ${BIN}) # Add a distclean target to the Makefile diff --git a/README.md b/README.md index 74c1a652c..5e935af08 100644 --- a/README.md +++ b/README.md @@ -88,10 +88,14 @@ To build Swiftest with the release flags (default), type the following: ``` $ cmake .. ``` -To buid with the debug flags, type: +To build with the debug flags, type: ``` $ cmake .. -DCMAKE_BUILD_TYPE=DEBUG ``` +To build with profiling flags, type: +``` +$ cmake .. -DCMAKE_BUILD_TYPE=PROFILE +``` Finally, to build with the testing flags, type: ``` $ cmake .. -DCMAKE_BUILD_TYPE=TESTING diff --git a/cmake/Modules/SetCompileFlag.cmake b/cmake/Modules/SetCompileFlag.cmake index 1d110ae6d..4141c4773 100644 --- a/cmake/Modules/SetCompileFlag.cmake +++ b/cmake/Modules/SetCompileFlag.cmake @@ -23,12 +23,12 @@ # "-Wall" # GNU # "-warn all" # Intel # ) -# The optin "-Wall" will be checked first, and if it works, will be +# The option "-Wall" will be checked first, and if it works, will be # appended to the CMAKE_C_FLAGS variable. If it doesn't work, then # "-warn all" will be tried. If this doesn't work then checking will # terminate because REQUIRED was given. # -# The reasong that the variable must be given twice (first as the name then +# The reasoning that the variable must be given twice (first as the name then # as the value in quotes) is because of the way CMAKE handles the passing # of variables in functions; it is difficult to extract a variable's # contents and assign new values to it from within a function. diff --git a/cmake/Modules/SetFortranFlags.cmake b/cmake/Modules/SetFortranFlags.cmake index e0b21862b..7850fbdb8 100644 --- a/cmake/Modules/SetFortranFlags.cmake +++ b/cmake/Modules/SetFortranFlags.cmake @@ -21,32 +21,36 @@ STRING(TOUPPER "${CMAKE_BUILD_TYPE}" BT) IF(BT STREQUAL "RELEASE") SET(CMAKE_BUILD_TYPE RELEASE CACHE STRING - "Choose the type of build, options are DEBUG, RELEASE, or TESTING." + "Choose the type of build, options are DEBUG, RELEASE, PROFILE, or TESTING." FORCE) ELSEIF(BT STREQUAL "DEBUG") SET (CMAKE_BUILD_TYPE DEBUG CACHE STRING - "Choose the type of build, options are DEBUG, RELEASE, or TESTING." + "Choose the type of build, options are DEBUG, RELEASE, PROFILE, or TESTING." FORCE) ELSEIF(BT STREQUAL "TESTING") SET (CMAKE_BUILD_TYPE TESTING CACHE STRING - "Choose the type of build, options are DEBUG, RELEASE, or TESTING." + "Choose the type of build, options are DEBUG, RELEASE, PROFILE, or TESTING." FORCE) +ELSEIF(BT STREQUAL "PROFILE") + SET (CMAKE_BUILD_TYPE PROFILE CACHE STRING + "Choose the type of build, options are DEBUG, RELEASE, PROFILE, or TESTING." + FORCE) ELSEIF(NOT BT) SET(CMAKE_BUILD_TYPE RELEASE CACHE STRING - "Choose the type of build, options are DEBUG, RELEASE, or TESTING." + "Choose the type of build, options are DEBUG, RELEASE, PROFILE, or TESTING." FORCE) MESSAGE(STATUS "CMAKE_BUILD_TYPE not given, defaulting to RELEASE") ELSE() - MESSAGE(FATAL_ERROR "CMAKE_BUILD_TYPE not valid, choices are DEBUG, RELEASE, or TESTING") + MESSAGE(FATAL_ERROR "CMAKE_BUILD_TYPE not valid, choices are DEBUG, RELEASE, PROFILE, or TESTING") ENDIF(BT STREQUAL "RELEASE") ######################################################### # If the compiler flags have already been set, return now ######################################################### -IF(CMAKE_Fortran_FLAGS_RELEASE AND CMAKE_Fortran_FLAGS_TESTING AND CMAKE_Fortran_FLAGS_DEBUG) +IF(CMAKE_Fortran_FLAGS_RELEASE AND CMAKE_Fortran_FLAGS_TESTING AND CMAKE_Fortran_FLAGS_DEBUG AND CMAKE_Fortran_FLAGS_PROFILE) RETURN () -ENDIF(CMAKE_Fortran_FLAGS_RELEASE AND CMAKE_Fortran_FLAGS_TESTING AND CMAKE_Fortran_FLAGS_DEBUG) +ENDIF(CMAKE_Fortran_FLAGS_RELEASE AND CMAKE_Fortran_FLAGS_TESTING AND CMAKE_Fortran_FLAGS_DEBUG AND CMAKE_Fortran_FLAGS_PROFILE) ######################################################################## # Determine the appropriate flags for this compiler for each build type. @@ -81,7 +85,6 @@ SET_COMPILE_FLAG(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS}" ################### ### DEBUG FLAGS ### ################### - # NOTE: debugging symbols (-g or /debug:full) are already on by default # Disable optimizations @@ -163,7 +166,7 @@ SET_COMPILE_FLAG(CMAKE_Fortran_FLAGS_DEBUG "${CMAKE_Fortran_FLAGS_DEBUG}" # Aligns a variable to a specified boundary and offset SET_COMPILE_FLAG(CMAKE_Fortran_FLAGS_DEBUG "${CMAKE_Fortran_FLAGS_DEBUG}" - Fortran "-align all" # Intel + Fortran "-align all -align array64byte" # Intel ) # Enables changing the variable and array memory layout @@ -215,7 +218,6 @@ SET_COMPILE_FLAG(CMAKE_Fortran_FLAGS_TESTING "${CMAKE_Fortran_FLAGS_TESTING}" ##################### ### RELEASE FLAGS ### ##################### - # NOTE: agressive optimizations (-O3) are already turned on by default # Unroll loops @@ -234,19 +236,6 @@ SET_COMPILE_FLAG(CMAKE_Fortran_FLAGS_RELEASE "${CMAKE_Fortran_FLAGS_RELEASE}" "-Minline" # Portland Group ) -# Interprocedural (link-time) optimizations -SET_COMPILE_FLAG(CMAKE_Fortran_FLAGS_RELEASE "${CMAKE_Fortran_FLAGS_RELEASE}" - Fortran "-ipo" # Intel - "/Qipo" # Intel Windows - "-flto" # GNU - "-Mipa" # Portland Group - ) - -# Single-file optimizations -SET_COMPILE_FLAG(CMAKE_Fortran_FLAGS_RELEASE "${CMAKE_Fortran_FLAGS_RELEASE}" - Fortran "-ip" # Intel - "/Qip" # Intel Windows - ) # Allows for lines longer than 80 characters without truncation SET_COMPILE_FLAG(CMAKE_Fortran_FLAGS_RELEASE "${CMAKE_Fortran_FLAGS_RELEASE}" @@ -299,7 +288,28 @@ SET_COMPILE_FLAG(CMAKE_Fortran_FLAGS_RELEASE "${CMAKE_Fortran_FLAGS_RELEASE}" Fortran "-fma" # Intel ) -# Enables agressive optimixation on floating-points -SET_COMPILE_FLAG(CMAKE_Fortran_FLAGS_RELEASE "${CMAKE_Fortran_FLAGS_RELEASE}" - Fortran "-fp-model=fast" # Intel + +##################### +### MATH FLAGS ### +##################### +# Some subroutines require more strict floating point operation optimizations for repeatability +SET_COMPILE_FLAG(STRICTMATH_FLAGS "${STRICTMATH_FLAGS}" + Fortran "-fp-model=precise -prec-div -prec-sqrt -assume protect-parens" # Intel + "/fp:precise /Qprec-div /Qprec-sqrt /assume:protect-parens" # Intel Windows + ) + +# Most subroutines can use aggressive optimization of floating point operations without problems. +SET_COMPILE_FLAG(FASTMATH_FLAGS "${FASTMATH_FLAGS}" + Fortran "-fp-model=fast" + "/fp:fast" + ) + +##################### +### PROFILE FLAGS ### +##################### +# Enables the optimization reports to be generated +SET_COMPILE_FLAG(CMAKE_Fortran_FLAGS_PROFILE "${CMAKE_Fortran_FLAGS_RELEASE}" + Fortran "-pg -qopt-report=5 -traceback -p -g3" # Intel + "/Qopt-report:5 /traceback -g3" # Windows Intel + "-pg -fbacktrace" ) diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index b4204732c..d467332f8 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -12,7 +12,7 @@ ######################################## # Add the source files -SET(FOO_src +SET(FAST_MATH_FILES ${SRC}/modules/encounter_classes.f90 ${SRC}/modules/fraggle_classes.f90 ${SRC}/modules/helio_classes.f90 @@ -41,12 +41,10 @@ SET(FOO_src ${SRC}/gr/gr.f90 ${SRC}/helio/helio_drift.f90 ${SRC}/helio/helio_gr.f90 - ${SRC}/helio/helio_kick.f90 ${SRC}/helio/helio_setup.f90 ${SRC}/helio/helio_step.f90 ${SRC}/helio/helio_util.f90 ${SRC}/io/io.f90 - ${SRC}/kick/kick.f90 ${SRC}/netcdf/netcdf.f90 ${SRC}/obl/obl.f90 ${SRC}/operators/operator_cross.f90 @@ -55,7 +53,6 @@ SET(FOO_src ${SRC}/rmvs/rmvs_discard.f90 ${SRC}/rmvs/rmvs_encounter_check.f90 ${SRC}/rmvs/rmvs_io.f90 - ${SRC}/rmvs/rmvs_kick.f90 ${SRC}/rmvs/rmvs_setup.f90 ${SRC}/rmvs/rmvs_step.f90 ${SRC}/rmvs/rmvs_util.f90 @@ -66,7 +63,6 @@ SET(FOO_src ${SRC}/symba/symba_encounter_check.f90 ${SRC}/symba/symba_gr.f90 ${SRC}/symba/symba_io.f90 - ${SRC}/symba/symba_kick.f90 ${SRC}/symba/symba_setup.f90 ${SRC}/symba/symba_step.f90 ${SRC}/symba/symba_util.f90 @@ -96,24 +92,31 @@ SET(FOO_src ${SRC}/whm/whm_coord.f90 ${SRC}/whm/whm_drift.f90 ${SRC}/whm/whm_gr.f90 - ${SRC}/whm/whm_kick.f90 ${SRC}/whm/whm_setup.f90 ${SRC}/whm/whm_step.f90 ${SRC}/whm/whm_util.f90 ${SRC}/main/swiftest_driver.f90 ) +SET(STRICT_MATH_FILES + ${SRC}/kick/kick.f90 + ${SRC}/helio/helio_kick.f90 + ${SRC}/rmvs/rmvs_kick.f90 + ${SRC}/symba/symba_kick.f90 + ${SRC}/whm/whm_kick.f90 +) + +set(SWIFTEST_src ${FAST_MATH_FILES} ${STRICT_MATH_FILES}) # Define the executable in terms of the source files -ADD_EXECUTABLE(${SWIFTEST_DRIVER} ${FOO_src}) +ADD_EXECUTABLE(${SWIFTEST_DRIVER} ${SWIFTEST_src}) ##################################################### # Add the needed libraries and special compiler flags ##################################################### -# Uncomment if you need to link to BLAS and LAPACK +# # Uncomment if you need to link to BLAS and LAPACK TARGET_LINK_LIBRARIES(${SWIFTEST_DRIVER} ${NETCDF_LIBRARIES} ${NETCDF_FORTRAN_LIBRARIES}) -# Uncomment if you have parallization IF(USE_OPENMP) SET_TARGET_PROPERTIES(${SWIFTEST_DRIVER} PROPERTIES COMPILE_FLAGS "${OpenMP_Fortran_FLAGS}" @@ -127,7 +130,6 @@ ELSEIF(USE_MPI) ENDIF(USE_OPENMP) - ##################################### # Tell how to install this executable ##################################### @@ -137,4 +139,13 @@ IF(WIN32) ELSE() SET(CMAKE_INSTALL_PREFIX /usr/local) ENDIF(WIN32) -INSTALL(TARGETS ${SWIFTEST_DRIVER} RUNTIME DESTINATION bin) \ No newline at end of file +INSTALL(TARGETS ${SWIFTEST_DRIVER} RUNTIME DESTINATION bin) + + +#Set strict vs fast math flags +STRING(TOUPPER "${CMAKE_BUILD_TYPE}" BT) +IF(BT STREQUAL "RELEASE" OR BT STREQUAL "PROFILE") + SET_PROPERTY(SOURCE ${STRICT_MATH_FILES} APPEND_STRING PROPERTY COMPILE_FLAGS "${STRICTMATH_FLAGS}") + SET_PROPERTY(SOURCE ${FAST_MATH_FILES} APPEND_STRING PROPERTY COMPILE_FLAGS "${FASTMATH_FLAGS}") +ENDIF() + From 167c09a33744ee0f72a5d37b7da9672ca842ec81 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Thu, 17 Nov 2022 16:01:36 -0500 Subject: [PATCH 084/569] Removed simd call as it isn't compatible with the function anyway --- src/helio/helio_drift.f90 | 2 -- 1 file changed, 2 deletions(-) diff --git a/src/helio/helio_drift.f90 b/src/helio/helio_drift.f90 index 60c6d52a8..1076532c0 100644 --- a/src/helio/helio_drift.f90 +++ b/src/helio/helio_drift.f90 @@ -114,11 +114,9 @@ subroutine helio_drift_linear_all(xh, pt, dt, n, lmask) ! Internals integer(I4B) :: i - !$omp parallel do simd default(shared) schedule(static) do i = 1, n if (lmask(i)) call helio_drift_linear_one(xh(1,i), xh(2,i), xh(3,i), pt(1), pt(2), pt(3), dt) end do - !$omp end parallel do simd return end subroutine helio_drift_linear_all From 40d58b3a7d41ba967e452a63ba56d3399f2d9bed Mon Sep 17 00:00:00 2001 From: David A Minton Date: Thu, 17 Nov 2022 17:02:32 -0500 Subject: [PATCH 085/569] Fixed problem with the reading of the oldorigin info --- src/netcdf/netcdf.f90 | 59 ++++++++++++++++++++----------------------- 1 file changed, 28 insertions(+), 31 deletions(-) diff --git a/src/netcdf/netcdf.f90 b/src/netcdf/netcdf.f90 index 4c037a291..16333dec8 100644 --- a/src/netcdf/netcdf.f90 +++ b/src/netcdf/netcdf.f90 @@ -406,7 +406,6 @@ module subroutine netcdf_open(self, param, readonly) end if end if - end if if ((param%out_form == EL) .or. (param%out_form == XVEL)) then @@ -437,29 +436,22 @@ module subroutine netcdf_open(self, param, readonly) ! end if ! Optional Variables - - status = nf90_inq_varid(self%ncid, NPL_VARNAME, self%npl_varid) - if (status /= nf90_noerr) write(*,*) "Warning! NPL variable not set in input file. Calculating." - - status = nf90_inq_varid(self%ncid, NTP_VARNAME, self%ntp_varid) - if (status /= nf90_noerr) write(*,*) "Warning! NTP variable not set in input file. Calculating." - - if (param%integrator == SYMBA) then - status = nf90_inq_varid(self%ncid, NPLM_VARNAME, self%nplm_varid) - if (status /= nf90_noerr) write(*,*) "Warning! NPLM variable not set in input file. Calculating." - end if - 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 - ! Variables The User Doesn't Need to Know About - + ! 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) + 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(self%ncid, ORIGIN_TYPE_VARNAME, self%origin_type_varid) status = nf90_inq_varid(self%ncid, ORIGIN_TIME_VARNAME, self%origin_time_varid) @@ -985,7 +977,7 @@ module subroutine netcdf_read_particle_info_system(self, iu, param, plmask, tpma 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" ) else - rtemp = 0.0_DP + rtemp = param%t0 end if call cb%info%set_value(origin_time=rtemp(1)) @@ -996,29 +988,31 @@ 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) 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" ) - else - ! [TODO]: This doesn't work when the input mode is EL. This needs to get filled in later after xv2el has been called - ! call check( nf90_get_var(iu%ncid, iu%xhx_varid, rtemp_arr(1,:)), "netcdf_read_particle_info_system nf90_getvar xhx_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" ) + 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 - ! [TODO]: This doesn't work when the input mode is EL. This needs to get filled in later after xv2el has been called - ! call check( nf90_get_var(iu%ncid, iu%xhy_varid, rtemp_arr(2,:)), "netcdf_read_particle_info_system nf90_getvar 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 - ! [TODO]: This doesn't work when the input mode is EL. This needs to get filled in later after xv2el has been called - ! call check( nf90_get_var(iu%ncid, iu%xhz_varid, rtemp_arr(3,:)), "netcdf_read_particle_info_system nf90_getvar xhz_varid" ) + rtemp_arr(3,:) = 0._DP end if do i = 1, npl @@ -1031,25 +1025,28 @@ module subroutine netcdf_read_particle_info_system(self, iu, param, plmask, tpma status = nf90_inq_varid(iu%ncid, ORIGIN_VHX_VARNAME, iu%origin_vhx_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" ) + 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" ) else - ! [TODO]: This doesn't work when the input mode is EL. This needs to get filled in later after xv2el has been called - ! call check( nf90_get_var(iu%ncid, iu%vhx_varid, rtemp_arr(1,:)), "netcdf_read_particle_info_system nf90_getvar vhx_varid" ) + rtemp_arr(1,:) = 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 - ! [TODO]: This doesn't work when the input mode is EL. This needs to get filled in later after xv2el has been called - ! call check( nf90_get_var(iu%ncid, iu%vhy_varid, rtemp_arr(2,:)), "netcdf_read_particle_info_system nf90_getvar vhy_varid" ) + 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 - ! [TODO]: This doesn't work when the input mode is EL. This needs to get filled in later after xv2el has been called - ! call check( nf90_get_var(iu%ncid, iu%vhz_varid, rtemp_arr(3,:)), "netcdf_read_particle_info_system nf90_getvar vhz_varid" ) + rtemp_arr(3,:) = 0._DP end if do i = 1, npl From 75b910691c4302b0f46859528fefc3b6bbbf3cd6 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Thu, 17 Nov 2022 17:14:14 -0500 Subject: [PATCH 086/569] Added OMP_NUM_THREADS environment variable to the Jupyter notebook in the Basic Simulation example and cleared all its output --- .../Basic_Simulation/run_simulation.ipynb | 110 ++---------------- 1 file changed, 9 insertions(+), 101 deletions(-) diff --git a/examples/Basic_Simulation/run_simulation.ipynb b/examples/Basic_Simulation/run_simulation.ipynb index 8f2ab51b3..ea78c2690 100644 --- a/examples/Basic_Simulation/run_simulation.ipynb +++ b/examples/Basic_Simulation/run_simulation.ipynb @@ -2,7 +2,7 @@ "cells": [ { "cell_type": "code", - "execution_count": 1, + "execution_count": null, "id": "86c845ce-1801-46ca-8a8a-1cabb266e6a6", "metadata": {}, "outputs": [], @@ -10,122 +10,30 @@ "import swiftest\n", "import xarray as xr\n", "import numpy as np\n", - "import os" + "import os\n", + "%env OMP_NUM_THREADS=8" ] }, { "cell_type": "code", - "execution_count": 2, + "execution_count": null, "id": "d716c371-8eb4-4fc1-82af-8b5c444c831e", "metadata": {}, - "outputs": [ - { - "name": "stdout", - "output_type": "stream", - "text": [ - "Reading Swiftest file /home/daminton/git_debug/swiftest/examples/Basic_Simulation/param.in\n" - ] - } - ], + "outputs": [], "source": [ "sim = swiftest.Simulation()" ] }, { "cell_type": "code", - "execution_count": 3, + "execution_count": null, "id": "ec7452d6-4c9b-4df3-acc0-b11c32264b91", "metadata": {}, - "outputs": [ - { - "name": "stdout", - "output_type": "stream", - "text": [ - "tstop 10.0 y\n", - "Writing parameter inputs to file /home/daminton/git_debug/swiftest/examples/Basic_Simulation/param.in\n", - "Running a Swiftest symba run from tstart=0.0 y to tstop=10.0 y\n", - "\u001b]2;cd /home/daminton/git_debug/swiftest/examples/Basic_Simulation\u0007\u001b]1;\u0007\u001b]2;/home/daminton/git_debug/swiftest/bin/swiftest_driver symba \u0007\u001b]1;\u0007 Parameter input file is /home/daminton/git_debug/swiftest/examples/Basic_Simulation/param.in\n", - " \n", - " Warning! NPLM variable not set in input file. Calculating.\n", - " *************** Main Loop *************** \n", - "Time = 1.00000E+00; fraction done = 0.100; Number of active plm, pl, tp = 13, 14, 10\n", - "Integration steps: Total wall time: 6.30684E-01; Interval wall time: 5.29890E-01;Interval wall time/step: 2.70141E-03\n", - "Time = 2.00000E+00; fraction done = 0.200; Number of active plm, pl, tp = 13, 14, 10\n", - "Integration steps: Total wall time: 1.66455E+00; Interval wall time: 5.27720E-01;Interval wall time/step: 2.99766E-03\n", - "Time = 3.00000E+00; fraction done = 0.300; Number of active plm, pl, tp = 13, 14, 10\n", - "Integration steps: Total wall time: 2.64051E+00; Interval wall time: 5.20805E-01;Interval wall time/step: 2.88832E-03\n", - "Time = 4.00000E+00; fraction done = 0.400; Number of active plm, pl, tp = 13, 14, 10\n", - "Integration steps: Total wall time: 3.60585E+00; Interval wall time: 5.24579E-01;Interval wall time/step: 2.82311E-03\n", - "Time = 5.00000E+00; fraction done = 0.500; Number of active plm, pl, tp = 13, 14, 10\n", - "Integration steps: Total wall time: 4.58823E+00; Interval wall time: 5.37595E-01;Interval wall time/step: 2.96439E-03\n", - "Time = 6.00000E+00; fraction done = 0.600; Number of active plm, pl, tp = 13, 14, 10\n", - "Integration steps: Total wall time: 5.55600E+00; Interval wall time: 5.27663E-01;Interval wall time/step: 2.83397E-03\n", - "Time = 7.00000E+00; fraction done = 0.700; Number of active plm, pl, tp = 13, 14, 10\n", - "Integration steps: Total wall time: 6.64194E+00; Interval wall time: 5.83431E-01;Interval wall time/step: 3.11589E-03\n", - "Time = 8.00000E+00; fraction done = 0.800; Number of active plm, pl, tp = 13, 14, 10\n", - "Integration steps: Total wall time: 7.63044E+00; Interval wall time: 5.52408E-01;Interval wall time/step: 2.95843E-03\n", - "Time = 9.00000E+00; fraction done = 0.900; Number of active plm, pl, tp = 13, 14, 10\n", - "Integration steps: Total wall time: 8.62339E+00; Interval wall time: 5.46944E-01;Interval wall time/step: 3.01578E-03\n", - "Time = 1.00000E+01; fraction done = 1.000; Number of active plm, pl, tp = 13, 14, 10\n", - "Integration steps: Total wall time: 9.67297E+00; Interval wall time: 6.00750E-01;Interval wall time/step: 3.20243E-03\n", - "\n", - "Normal termination of Swiftest (version 1.0)\n", - "------------------------------------------------\n", - "\n", - "Creating Dataset from NetCDF file\n", - "Successfully converted 11 output frames.\n", - "Swiftest simulation data stored as xarray DataSet .ds\n" - ] - } - ], + "outputs": [], "source": [ "sim.run(tstop=10.0)" ] }, - { - "cell_type": "code", - "execution_count": 9, - "id": "5b0a57a6-dbd5-4d34-8e6e-91fc8ad8789f", - "metadata": {}, - "outputs": [ - { - "data": { - "text/plain": [ - "[,\n", - " ,\n", - " ,\n", - " ,\n", - " ,\n", - " ,\n", - " ,\n", - " ,\n", - " ,\n", - " ,\n", - " ,\n", - " ,\n", - " ,\n", - " ]" - ] - }, - "execution_count": 9, - "metadata": {}, - "output_type": "execute_result" - }, - { - "data": { - "image/png": "iVBORw0KGgoAAAANSUhEUgAAAjMAAAGwCAYAAABcnuQpAAAAOXRFWHRTb2Z0d2FyZQBNYXRwbG90bGliIHZlcnNpb24zLjUuMSwgaHR0cHM6Ly9tYXRwbG90bGliLm9yZy/YYfK9AAAACXBIWXMAAA9hAAAPYQGoP6dpAACEU0lEQVR4nOzdfXyN9f/A8de12c7uN5vZDWez2TDGRiKjkHszFaEIaygJCSWiKFnubyIhG2VuSlTfiuKbkbvITS18VWyNH2uRtsy2s51z/f6YnXZsY9M456z389H16Fyfz+f6XO9zOTvX+3yuO0VVVRUhhBBCCCtlY+4AhBBCCCH+CUlmhBBCCGHVJJkRQgghhFWTZEYIIYQQVk2SGSGEEEJYNUlmhBBCCGHVJJkRQgghhFWrYe4A7jSDwcCFCxdwdXVFURRzhyOEEEKIClBVlb/++gt/f39sbG4+9lLtk5kLFy6g1WrNHYYQQgghbsO5c+eoW7fuTdtU+2TG1dUVKNoYbm5uZo5GCCGEEBWRnZ2NVqs17sdvptonM8WHltzc3CSZEUIIIaxMRU4RkROAhRBCCGHVJJkRQgghhFWTZEYIIYQQVq3anzMjhCXT6/UUFBSYOwzxL2dnZ4etra25wxDitkkyI4QZqKpKRkYGf/75p7lDEQIADw8PfH195X5cwipZTDITHx/PlClTeO6551i0aBFQ9IU/Y8YMVq5cyZUrV2jdujXLli2jSZMm5g1WiH+oOJGpXbs2Tk5OsgMRZqOqKteuXSMzMxMAPz8/M0ckROVZRDJz+PBhVq5cSbNmzUzK58yZw4IFC1izZg0NGjRg5syZdOnShdOnT1founMhLJFerzcmMl5eXuYORwgcHR0ByMzMpHbt2nLISVgds58AfPXqVQYNGsSqVauoWbOmsVxVVRYtWsTLL79Mnz59CA8PZ+3atVy7do3169ebMWIh/pnic2ScnJzMHIkQfyv+PMo5XMIamT2ZefbZZ4mOjqZz584m5ampqWRkZNC1a1djmUajoX379uzfv7/c/vLz88nOzjaZhLBEcmhJWBL5PAprZtbDTBs3buTo0aMcPny4VF1GRgYAPj4+JuU+Pj78+uuv5fYZHx/PjBkzqjZQIYQQQlgss43MnDt3jueee45169bh4OBQbrsbfy2oqnrTXxCTJ08mKyvLOJ07d67KYhZCCCGE5THbyMyRI0fIzMzknnvuMZbp9Xr27NnD0qVLOX36NFA0QlPy7PrMzMxSozUlaTQaNBrNnQtcCCGEEBbFbMlMp06dSElJMSl78sknadSoEZMmTSI4OBhfX1927NhB8+bNAdDpdOzevZvZs2ebI+S7TlVVoGhSVcP1/xeXGa6/NlxvazBthwrX64teG0r0WXLESwFFQUEpen3DfFG7vyeT5cqsL66zMamT4/FCCCHuFLMlM66uroSHh5uUOTs74+XlZSwfN24cs2bNIjQ0lNDQUGbNmoWTkxMDBw40R8gmzv/fetLTV/2dXKjXk4brSYRKyeTi72Tj7ySkYklK9XOrJKh43ub66+LEyxZFsUFRbP+esAXFBkWpUaLu+jw2ULJtmXUlluXvdrdfZ2MSm2JTAxvFDkWpgY2N3fVl7CgsrIHBYIten4deT6ntIUmgEEJUjkXcZ6Y8L774Irm5uYwaNcp407yvvvrKIu4xU1iQTW5uurnDuAXTxODvnaRaNGhDyaRKLTF/JxWv74bSO71aC2Jj44+H+6vk5iro9RVIVm4yclZUXV5d6XnTtpRfd5ME62Z9mvZx8ytkOnToQLNmzXBwcODdd9/F3t6ekSNHMn36dAAWLFhAYmIiZ8+exdPTk5iYGObMmYOLiwsAa9asYdy4caxbt44JEyZw7tw5evbsydq1a9m8eTOvvvoqWVlZPPHEEyxatMh47xSdTsfUqVNJSkrizz//JDw8nNmzZ9OhQ4db/1sIISySRSUzycnJJvOKojB9+nTjl5sl8fV9CI+a917/Ure54dDM9VEFxebvL31FKRoRKPGF//foQ4lDMhVtV2aSUlxv849/0RePDpkmObdOgsoadeL6mBUl64yHwUovZ7psyVj0f08YUNXConYly6/XoeoxqPrrdSWW5e92xjr0qIbiuuL+Cv+uU8tZF6Z9c0NcqlqIwVBwfb7A+Bq1ZolRI+WG7VHmP0bxFrw+f+dTzqpTfiKk1+eydm0io0fHsWvXhxw6dIynn36Re+4JoVOnB9Drs5g7dyqBgVrSfj3PuOemMGHCNRYvfhNFUSgoyObatWssWjSf999/h7/+usqAAbE8/HAMHh4efPLJJlJT0xgwYAht2txD//6PAgpDh8bx66/pJCWtxd/fn48//oTu3bvz/fdHCA1tUHbcyKXLwrxUVb3+XVLy+67w7+8cgx6uf78Z1MKiowVltS81X047KrY8qgGDWoiXZztq1XrQbNtHUdXq/Zs4Ozsbd3d3srKycHNzM3c4QpCXl0dqaipBQUGlruQzTQbLSxpvnlSWbltWEslN6m623K36rLjo6Dj0ej3bt681lnXsOJAHHmjFjBnjSrXfuvUrxo+fSWrqHgCSkj5h1KhpHDv2OcHBWgDGjXudTZv+w88/J+PiUnQTuD59RhIQUIdFi6Zx9uw5WrToxalTO/Dzq23su3fvEdxzTzivvvrcTSK+cTSrqOzGpOfGkbNSo2XGMkr0U8Zr47rKqTe+LNnq9tvk5RWQnn4ed/ffsLPXXz8ca4Ni8iPq+g+M4nTa+DksLisuL/EZK1V2wzIl2t6s//KWMUn0jespbmu4vlP/+4eJ8QcJaukfNer19iV+qFD8g8XYV/GPlus/Yq73c2Nb47yxraHED56S9fq/6411NyYZhSW2g2UKDHyGkPoTq7TPyuy/LWpkRoh/u793GmBtAwEVTqiu74hsbBwID2+Eo2Ogsc7fX8uVK3k4OPizK/kb5sxeyP/+9xPZ2X9RWKgnLy+PggJHnJwdsbV1wsnJkYYNw43Jna+vH4GBWtw9vI07PB8fHy5d+hMbGw0pKT+jqir33NObkjuH/PwCPL08KLnDLuMdXv/PtL66/BzU6VQKCq7wy5l4DIYL5g5HVIKi2JU4l6/keYI1riejNVBsbAFbbIrLjecA3jjd2McNfdnU+Pu8wBLtPTxamXUbSDIjhKgSlU3EFMUWjcYZO7u/f3HZ2toDdly8eJWHH3qckSNH8sYbs/H09GTv3r0MGzYMW9taODp4YG/viZ2dPY6OAcbl7e1rYm/vhLNTsLHMzs4NGxsDLi4NsLc/hq2tLUeOHC31/CEXFxfc3HxRbxgpUEv80i9rvmSCdvP5G/oprjZJjtQb/l88EnFjfRltbtrfrdep1xdiY6PB3a0FKIGYXiFZdMi56Dz9v0eliv+vlBhxMh35uT66pJTR1mSZstuW3X/JuoosU+LiAEqerF80X7q+eETq74sOjCf+F49WGXfm1+uxKdG2ZL1StCx/Xxzw92hX8bpuqEcpkVAUX9xQRpJS4sIGIcmMEMICfffddxQWFjJ//nxsbIq+rD/44IN/3G/z5s3R6/VkZmZy//33l9lGuWHHaG0jZLfLxiYPe/sCgoJm3/RGpkJYIknphBAWp379+hQWFvLWW29x9uxZ3n//fd55551/3G+DBg0YNGgQQ4YMYcuWLaSmpnL48GFmz57NF198UQWRCyHMQZIZIYTFiYyMZMGCBcyePZvw8HCSkpKIj4+vkr4TExMZMmQIEyZMoGHDhvTu3Ztvv/0WrVZbJf0LIe4+uZpJiLvsZlczCWEu8rkUlqYy+28ZmRFCCCGEVZNkRgghhBBWTZIZIYQQQlg1SWaEEEIIYdUkmRFCCCGEVZNkRgghhBBWTZIZIYQQQlg1SWaEEEIIYdUkmRFCCCGEVZNkRghRYbGxsSiKwsiRI0vVjRo1CkVRiI2NvfuBCSH+1SSZEUJUilarZePGjeTm5hrL8vLy2LBhAwEBAbfdr6qqFBYWVkWIJvR6PQaDocr7FUJYDklmhBCV0qJFCwICAtiyZYuxbMuWLWi1Wpo3b24sU1WVOXPmEBwcjKOjIxEREWzevNlYn5ycjKIofPnll7Rs2RKNRsM333yDwWBg9uzZhISEoNFoCAgI4I033jBZ5s8//zT2c/z4cRRFIS0tDYA1a9bg4eHBZ599RuPGjY392tnZkZGRYfJeJkyYwAMPPHAHtpIQ4m6qYe4AhBBFO/7cAr1Z1u1oZ4uiKJVa5sknnyQxMZFBgwYBkJCQQFxcHMnJycY2U6dOZcuWLSxfvpzQ0FD27NnDE088gbe3N+3btze2e/HFF5k3bx7BwcF4eHgwefJkVq1axcKFC2nXrh0XL17kf//7X6Xiu3btGvHx8bz77rt4eXlRt25dgoODef/993nhhRcAKCwsZN26dbz55puV6lsIYXkkmRHCAuQW6Gn8ypdmWffJ17rhZF+5r4LBgwczefJk0tLSUBSFffv2sXHjRmMyk5OTw4IFC/j6669p06YNAMHBwezdu5cVK1aYJDOvvfYaXbp0AeCvv/5i8eLFLF26lKFDhwJQv3592rVrV6n4CgoKePvtt4mIiDCWDRs2jMTERGMy8/nnn3Pt2jX69+9fqb6FEJZHkhkhRKXVqlWL6Oho1q5di6qqREdHU6tWLWP9yZMnycvLMyYpxXQ6ncmhKICWLVsaX586dYr8/Hw6der0j+Kzt7enWbNmJmWxsbFMnTqVgwcPct9995GQkED//v1xdnb+R+sSQpifJDNCWABHO1tOvtbNbOu+HXFxcYwePRqAZcuWmdQVn3D7+eefU6dOHZM6jUZjMl8ymXB0dLzpOm1sik7zU1XVWFZQUFCqnaOjY6lDZ7Vr1yYmJobExESCg4P54osvTA6LCSGslyQzQlgARVEqfajH3Lp3745OpwOgWzfTRKz4xNv09HSTQ0q3EhoaiqOjI//9738ZPnx4qXpvb28ALl68SM2aNYGiE4Aravjw4Tz22GPUrVuX+vXr07Zt2wovK4SwXNb17SmEsBi2tracOnXK+LokV1dXJk6cyPPPP4/BYKBdu3ZkZ2ezf/9+XFxcjOfD3MjBwYFJkybx4osvYm9vT9u2bfn99985ceIEw4YNIyQkBK1Wy/Tp05k5cyY///wz8+fPr3DM3bp1w93dnZkzZ/Laa6/d/psXQlgUSWaEELfNzc2t3LrXX3+d2rVrEx8fz9mzZ/Hw8KBFixZMmTLlpn1OmzaNGjVq8Morr3DhwgX8/PyMN+mzs7Njw4YNPPPMM0RERHDvvfcyc+ZM+vXrV6F4bWxsiI2NZdasWQwZMqTib1QIYdEUteTB52ooOzsbd3d3srKybvrFK8TdkpeXR2pqKkFBQTg4OJg7nH+dESNG8Ntvv/Hpp5+aOxSLIp9LYWkqs/+WkRkhxL9CVlYWhw8fJikpiU8++cTc4QghqpAkM0KIf4WHHnqIQ4cO8fTTT5e6ZFwIYd0kmRFC/CvIZdhCVF/ybCYhhBBCWDVJZoQQQghh1cyazCxfvpxmzZrh5uaGm5sbbdq0Ydu2bcb62NhYFEUxme677z4zRiyEEEIIS2PWc2bq1q3Lm2++SUhICABr167loYce4tixYzRp0gQoustoYmKicRl7e3uzxCqEEEIIy2TWZCYmJsZk/o033mD58uUcPHjQmMxoNBp8fX3NEZ4QQgghrIDFnDOj1+vZuHEjOTk5tGnTxlienJxM7dq1adCgASNGjCAzM/Om/eTn55OdnW0yCSGEEKL6Mnsyk5KSgouLCxqNhpEjR7J161YaN24MQI8ePUhKSuLrr79m/vz5HD58mAcffJD8/Pxy+4uPj8fd3d04abXau/VWhBBCCGEGZn+cgU6nIz09nT///JOPPvqId999l927dxsTmpIuXrxIYGAgGzdupE+fPmX2l5+fb5LsZGdno9Vq5XEGwmJY623jY2JiyM3NZefOnaXqDhw4QFRUFEeOHKFFixZmiE78U9b6uRTVl1U9zsDe3t54AnDLli05fPgwixcvZsWKFaXa+vn5ERgYyM8//1xufxqNBo1Gc8fiFeLfatiwYfTp04dff/2VwMBAk7qEhAQiIyMlkRFCmIXZDzPdSFXVcg8jXb58mXPnzuHn53eXoxJC9OrVi9q1a7NmzRqT8mvXrrFp0yaGDRvG/v37eeCBB3B0dESr1TJ27FhycnKMbevVq8esWbOIi4vD1dWVgIAAVq5caaxPTk5GURT+/PNPY9nx48dRFIW0tDQAfv31V2JiYqhZsybOzs40adKEL7744k6+dSGEhTNrMjNlyhS++eYb0tLSSElJ4eWXXyY5OZlBgwZx9epVJk6cyIEDB0hLSyM5OZmYmBhq1arFI488Ys6whah6qgq6HPNMFTzSXKNGDYYMGcKaNWsoeXT6ww8/RKfTERERQbdu3ejTpw8//PADmzZtYu/evYwePdqkn/nz59OyZUuOHTvGqFGjeOaZZ/jf//5X4U317LPPkp+fz549e0hJSWH27Nm4uLhUeHkhRPVj1sNMv/32G4MHD+bixYu4u7vTrFkztm/fTpcuXcjNzSUlJYX33nuPP//8Ez8/Pzp27MimTZtwdXU1Z9hCVL2CazDL3zzrnnIB7J0r1DQuLo65c+eSnJxMx44dgaJDTH369GHVqlUMHDiQcePGARAaGsqSJUto3749y5cvN56H0bNnT0aNGgXApEmTWLhwIcnJyTRq1KhCMaSnp9O3b1+aNm0KQHBwcGXerRCiGjJrMrN69epy6xwdHfnyyy/vYjRCiFtp1KgRUVFRJCQk0LFjR86cOcM333zDV199xXPPPccvv/xCUlKSsb2qqhgMBlJTUwkLCwOgWbNmxnpFUfD19b3lLRdKGjt2LM888wxfffUVnTt3pm/fviZ9CiH+fcx+ArAQArBzKhohMde6K2HYsGGMHj2aZcuWkZiYSGBgIJ06dcJgMPD0008zduzYUssEBAT8vTo7O5M6RVEwGAwA2NgUHfkueRiroKDApP3w4cPp1q0bn3/+OV999RXx8fHMnz+fMWPGVOp9CCGqD0lmhLAEilLhQz3m1r9/f5577jnWr1/P2rVrGTFiBIqi0KJFC06cOGG8OvF2eHt7A0W3YahZsyZQdALwjbRaLSNHjmTkyJFMnjyZVatWSTIjxL+YxV3NJISwbC4uLgwYMIApU6Zw4cIFYmNjgaLzXw4cOMCzzz7L8ePH+fnnn/n0008rlWSEhISg1WqZPn06P/30E59//jnz5883aTNu3Di+/PJLUlNTOXr0KF9//bXxEJYQ4t9JkhkhRKUNGzaMK1eu0LlzZ+MhpGbNmrF7925+/vln7r//fpo3b860adMqdSsFOzs7NmzYwP/+9z8iIiKYPXs2M2fONGmj1+t59tlnCQsLo3v37jRs2JC33367St+fEMK6mP0OwHdaZe4gKMTdIHdaFZZIPpfC0lRm/y0jM0IIIYSwapLMCCGEEMKqSTIjhBBCCKsmyYwQQgghrJokM0IIIYSwapLMCCGEEMKqSTIjhBBCCKsmyYwQQgghrJokM0IIIYSwapLMCCEsUlpaGoqilPmgSSGEKEmSGSFEhcXGxqIoSqmpe/fu/7jfhx9+uGqCFEL869QwdwBCCOvSvXt3EhMTTco0Gs1t9aXX61EUpSrCEkL8i8nIjBCiUjQaDb6+viZTzZo1AViwYAFNmzbF2dkZrVbLqFGjuHr1qnHZNWvW4OHhwWeffUbjxo3RaDQ8+eSTrF27lk8++cQ40pOcnGxc5uzZs3Ts2BEnJyciIiI4cODA3X7LQggLJyMzQlgAVVXJLcw1y7odazhW2eiIjY0NS5YsoV69eqSmpjJq1ChefPFF3n77bWOba9euER8fz7vvvouXlxe+vr7k5eWRnZ1tHPHx9PTkwoULALz88svMmzeP0NBQXn75ZR5//HF++eUXatSQry8hRBH5NhDCAuQW5tJ6fWuzrPvbgd/iZOdU4fafffYZLi4uJmWTJk1i2rRpjBs3zlgWFBTE66+/zjPPPGOSzBQUFPD2228TERFhLHN0dCQ/Px9fX99S65s4cSLR0dEAzJgxgyZNmvDLL7/QqFGjCscshKjeJJkRQlRKx44dWb58uUmZp6cnALt27WLWrFmcPHmS7OxsCgsLycvLIycnB2dnZwDs7e1p1qxZhddXsq2fnx8AmZmZkswIIYwkmRHCAjjWcOTbgd+abd2V4ezsTEhISKnyX3/9lZ49ezJy5Ehef/11PD092bt3L8OGDaOgoODv9TlW7rCWnZ2d8XXxcgaDoVIxCyGqN0lmhLAAiqJU6lCPJfruu+8oLCxk/vz52NgUXVvwwQcfVGhZe3t79Hr9nQxPCFGNSTIjhKiU/Px8MjIyTMpq1KhB/fr1KSws5K233iImJoZ9+/bxzjvvVKjPevXq8eWXX3L69Gm8vLxwd3e/E6ELIaopuTRbCFEp27dvx8/Pz2Rq164dkZGRLFiwgNmzZxMeHk5SUhLx8fEV6nPEiBE0bNiQli1b4u3tzb59++7wuxBCVCeKqqqquYO4k7Kzs3F3dycrKws3NzdzhyMEeXl5pKamEhQUhIODg7nDEQKQz6WwPJXZf8vIjBBCCCGsmiQzQgghhLBqkswIIYQQwqpJMiOEEEIIqybJjBBCCCGsmiQzQgghhLBqZk1mli9fTrNmzXBzc8PNzY02bdqwbds2Y72qqkyfPh1/f38cHR3p0KEDJ06cMGPEQgghhLA0Zr0DcN26dXnzzTeNz3lZu3YtDz30EMeOHaNJkybMmTOHBQsWsGbNGho0aMDMmTPp0qULp0+fxtXV1ZyhWy1VVUtN5ZVbUtuS8Zf3viypvJiiKMbnCRW/Ll4mLy/PZPnynld0s+cYVXaZipbfbL4yz1USQoi7weJumufp6cncuXOJi4vD39+fcePGMWnSJKDoNuo+Pj7Mnj2bp59+ukL93amb5qWlpXH27FlUVcVgMJj835LLhPm5uLjQtm1b6tSpQ40a1v1EkZslOVVdVxWvzdXWGhJAuWmesDSV2X9bzDepXq/nww8/JCcnhzZt2pCamkpGRgZdu3Y1ttFoNLRv3579+/eXm8zk5+eTn59vnM/Ozr4j8Z47d449e/bckb4tTVmjC7eaqrJtcX3JeG4Wa2XK7+Qy5Y04aTQaatSogZ2dXbnJzM1+Y9ytUaWKqMiomTD1T5Kyf7r8zV7rdDry8vI4cuSI8W/PxsYGGxsb4+uK/k1b0nQ729Aaks877cZR8eKysl5D0TaztbW9K7GVxezJTEpKCm3atCEvLw8XFxe2bt1K48aN2b9/PwA+Pj4m7X18fPj111/L7S8+Pp4ZM2bc0ZgB/P39adWqlckf/Y1/8JZYduNruHXSIapW8S/gmjVrWuQv4JJJ2I3lcXFxvPfee4wYMYK3337bpG7MmDGsWLGCwYMH8+6775bbR1mvb1Z3O+3Kel3Rstvtq6IsNQEsLCwkLy+PAwcOcPXqVXOHY3FuJ6m83XbFbvbZv3G+qupuV7t27ejcuXOV9HU7zJ7MNGzYkOPHj/Pnn3/y0UcfMXToUHbv3m2sv/EfWFXVm+5gJ0+ezPjx443z2dnZaLXaKo+7fv361K9fv8r7FcLcbvbrVFEUtFotH3zwAYsXL8bR0REoStA2bdpEQEAANjY22Nvb39a6CwoKsLOzu/3gzayiSdKdSNb+6fI6nQ57e3saNmxIQUGByeHpkoetLWEqGc/dcqvEQpiX2ZMZe3t74wnALVu25PDhwyxevNh4nkxGRgZ+fn7G9pmZmaVGa0rSaDRoNJo7G7QQ/2ItWrTg7NmzbNmyhUGDBgGwZcsWtFotwcHBxnbbt29n5syZ/Pjjj9ja2tKmTRsWL15s/BGQlpZGUFAQmzZt4u233+bgwYMsX76cBx98kNGjR7N37150Oh316tVj7ty59OzZ0yzvtzKs+TBFXl4eTk5OdOnSxSJHDMtzq8SnZLsbl7tbdZXto6KjO7eav5ttzXmICSwgmbmRqqrk5+cTFBSEr68vO3bsoHnz5kDRL4fdu3cze/ZsM0cpRNVSVRU1N9cs61YcHSu9833yySdJTEw0JjMJCQnExcWRnJxsbJOTk8P48eNp2rQpOTk5vPLKKzzyyCMcP34cG5u/7woxadIk5s+fT2JiIhqNhqeeegqdTseePXtwdnbm5MmTuLi4VMl7FdWPHA4XYOZkZsqUKfTo0QOtVstff/3Fxo0bSU5OZvv27SiKwrhx45g1axahoaGEhoYya9YsnJycGDhwoDnDFqLKqbm5nG5xj1nW3fDoERQnp0otM3jwYCZPnkxaWhqKorBv3z7j32+xvn37miyzevVqateuzcmTJwkPDzeWjxs3jj59+hjn09PT6du3L02bNgUwGe0RQoiymDWZ+e233xg8eDAXL17E3d2dZs2asX37drp06QLAiy++SG5uLqNGjeLKlSu0bt2ar776Su4xI4SZ1apVi+joaNauXYuqqkRHR1OrVi2TNmfOnGHatGkcPHiQS5cuGW8NkJ6ebpLMtGzZ0mS5sWPH8swzz/DVV1/RuXNn+vbtS7Nmze78mxJCWC2zJjOrV6++ab2iKEyfPp3p06ffnYCEMBPF0ZGGR4+Ybd23Iy4ujtGjRwOwbNmyUvUxMTFotVpWrVqFv78/BoOB8PBwdDqdSTtnZ2eT+eHDh9OtWzc+//xzvvrqK+Lj45k/fz5jxoy5rTiFENWfxZ0zI8S/kaIolT7UY27du3c3JibdunUzqbt8+TKnTp1ixYoV3H///QDs3bu3wn1rtVpGjhzJyJEjmTx5MqtWrZJkRghRLklmhBC3xdbWllOnThlfl1SzZk28vLxYuXIlfn5+pKen89JLL1Wo33HjxtGjRw8aNGjAlStX+PrrrwkLC6vy+IUQ1YckM0KI21beLcZtbGzYuHEjY8eOJTw8nIYNG7JkyRI6dOhwyz71ej3PPvss58+fx83Nje7du7Nw4cIqjlwIUZ1Y3LOZqtqdejaTELdLnoEjLJF8LoWlqcz+2+amtUIIIYQQFk6SGSGEEEJYNUlmhBBCCGHVJJkRQgghhFWTZEYIIYQQVk2SGSGEEEJYNUlmhBBCCGHVJJkRQgghhFWTZEYIIYQQVk2SGSGE2aSlpaEoCsePHzd3KEIIKybJjBCiwmJjY3n44YerrD+tVsvFixcJDw8HIDk5GUVR+PPPP6tsHUKI6k8eNCmEMBtbW1t8fX2rvF9VVdHr9dSoIV9xQvwbyMiMEBZAVVUK8vVmmW73WbP16tVj0aJFJmWRkZFMnz7dOK8oCsuXL6dHjx44OjoSFBTEhx9+aKwveZgpLS2Njh07AlCzZk0URSE2Nta4febMmUNwcDCOjo5ERESwefNmYz/FIzpffvklLVu2RKPR8M0339zW+xJCWB/52SKEBSjUGVj53G6zrPupxe2x09jesf6nTZvGm2++yeLFi3n//fd5/PHHCQ8PJywszKSdVqvlo48+om/fvpw+fRo3NzccHR0BmDp1Klu2bGH58uWEhoayZ88ennjiCby9vWnfvr2xjxdffJF58+YRHByMh4fHHXtPQgjLIsmMEOKO6tevH8OHDwfg9ddfZ8eOHbz11lu8/fbbJu1sbW3x9PQEoHbt2sZkJCcnhwULFvD111/Tpk0bAIKDg9m7dy8rVqwwSWZee+01unTpchfelRDCkkgyI4QFqGFvw1OL29+64R1a951UnICUnK/M1UsnT54kLy+vVJKi0+lo3ry5SVnLli1vO04hhPWSZEYIC6Aoyh091HMn2NjYlDrfpqCgoELLKopS4fUYDAYAPv/8c+rUqWNSp9FoTOadnZ0r3K8QovqQZEYIcVu8vb25ePGicT47O5vU1NRS7Q4ePMiQIUNM5m8cUSlmb28PgF6vN5Y1btwYjUZDenq6ySElIYQoJsmMEOK2PPjgg6xZs4aYmBhq1qzJtGnTsLUtPbr04Ycf0rJlS9q1a0dSUhKHDh1i9erVZfYZGBiIoih89tln9OzZE0dHR1xdXZk4cSLPP/88BoOBdu3akZ2dzf79+3FxcWHo0KF3+q0KISycJDNCiAozGAzGe7dMnjyZs2fP0qtXL9zd3Xn99dfLHJmZMWMGGzduZNSoUfj6+pKUlETjxo3L7L9OnTrMmDGDl156iSeffJIhQ4awZs0aXn/9dWrXrk18fDxnz57Fw8ODFi1aMGXKlDv6foUQ1kFRb/cmE1YiOzsbd3d3srKycHNzM3c4QpCXl0dqaipBQUE4ODiYO5xK6d69OyEhISxdurRC7RVFYevWrVV612BxZ1jz51JUT5XZf8tN84QQt3TlyhU+//xzkpOT6dy5s7nDEUIIE3KYSQhxS3FxcRw+fJgJEybw0EMPmTscIYQwIcmMEOKWtm7delvLVfOj2EIICyGHmYQQQghh1SSZEUIIIYRVk2RGCCGEEFZNkhkhhBBCWDWzJjPx8fHce++9uLq6Urt2bR5++GFOnz5t0iY2NhZFUUym++67z0wRCyGEEMLSmDWZ2b17N88++ywHDx5kx44dFBYW0rVrV3Jyckzade/enYsXLxqnL774wkwRCyGEEMLSmPXS7O3bt5vMJyYmUrt2bY4cOcIDDzxgLNdoNPj6+t7t8IQQQghhBSzqnJmsrCwAPD09TcqTk5OpXbs2DRo0YMSIEWRmZpbbR35+PtnZ2SaTEKLqZGZm8vTTTxMQEGD8odGtWzcOHDhQoeXXrFmDh4fHnQ1SCPGvYjE3zVNVlfHjx9OuXTvCw8ON5T169KBfv34EBgaSmprKtGnTePDBBzly5AgajaZUP/Hx8cyYMeNuhi7Ev0rfvn0pKChg7dq1BAcH89tvv/Hf//6XP/74467HUlBQgJ2d3V1frxDCwqgWYtSoUWpgYKB67ty5m7a7cOGCamdnp3700Udl1ufl5alZWVnG6dy5cyqgZmVl3Ymwhai03Nxc9eTJk2pubq6xzGAwqLrcXLNMBoOhwrFfuXJFBdTk5ORy28yfP18NDw9XnZyc1Lp166rPPPOM+tdff6mqqqq7du1SAZPp1VdfVVVVVQF169atJn25u7uriYmJqqqqampqqgqomzZtUtu3b69qNBo1ISFBHTp0qPrQQw+pc+fOVX19fVVPT0911KhRqk6nq/D7EmV/LoUwp6ysrArvvy1iZGbMmDF8+umn7Nmzh7p16960rZ+fH4GBgfz8889l1ms0mjJHbISwZIX5+SwZ+qhZ1j127WbsKviUZBcXF1xcXPj444+57777yvxbs7GxYcmSJdSrV4/U1FRGjRrFiy++yNtvv01UVBSLFi3ilVdeMV656OLiUql4J02axPz580lMTESj0bB792527dqFn58fu3bt4pdffmHAgAFERkYyYsSISvUthLBOZj1nRlVVRo8ezZYtW/j6668JCgq65TKXL1/m3Llz+Pn53YUIhRAl1ahRgzVr1rB27Vo8PDxo27YtU6ZM4YcffjC2GTduHB07diQoKIgHH3yQ119/nQ8++AAAe3t73N3dURQFX19ffH19K53MjBs3jj59+hAUFIS/vz8ANWvWZOnSpTRq1IhevXoRHR3Nf//736p740IIi2bWkZlnn32W9evX88knn+Dq6kpGRgYA7u7uODo6cvXqVaZPn07fvn3x8/MjLS2NKVOmUKtWLR555BFzhi5Elaqh0TB27Wazrbsy+vbtS3R0NN988w0HDhxg+/btzJkzh3fffZfY2Fh27drFrFmzOHnyJNnZ2RQWFpKXl0dOTg7Ozs7/ON6WLVuWKmvSpAm2trbGeT8/P1JSUv7xuoQQ1sGsyczy5csB6NChg0l5YmIisbGx2NrakpKSwnvvvceff/6Jn58fHTt2ZNOmTbi6upohYiHuDEVRKnyoxxI4ODjQpUsXunTpwiuvvMLw4cN59dVX6dixIz179mTkyJG8/vrreHp6snfvXoYNG0ZBQcFN+1QUpdRTtstapqyE6MaTgBVFwWAw3MY7E0JYI7MmMzd+cd3I0dGRL7/88i5FI4S4XY0bN+bjjz/mu+++o7CwkPnz52NjU3QUu/gQUzF7e3v0en2pPry9vbl48aJx/ueff+batWt3NnAhRLVgEScACyGsw+XLl+nXrx9xcXE0a9YMV1dXvvvuO+bMmcNDDz1E/fr1KSws5K233iImJoZ9+/bxzjvvmPRRr149rl69yn//+18iIiJwcnLCycmJBx98kKVLl3LfffdhMBiYNGmSXHYthKgQi7ppnhDCsrm4uNC6dWsWLlzIAw88QHh4ONOmTWPEiBEsXbqUyMhIFixYwOzZswkPDycpKYn4+HiTPqKiohg5ciQDBgzA29ubOXPmADB//ny0Wi0PPPAAAwcOZOLEiTg5OZnjbQohrIyi3upYj5XLzs7G3d2drKws3NzczB2OEOTl5ZGamkpQUBAOVnSejKje5HMpLE1l9t8yMiOEEEIIqybJjBBCCCGsmiQzQgghhLBqkswIIYQQwqpJMiOEEEIIqybJjBBCCCGsmiQzQgghhLBqkswIIYQQwqpJMiOEEEIIqybJjBBCCCGsmiQzQogK69ChA+PGjStV/vHHH6Moyt0PSAghkGRGCHGHFRQUmDsEIUQ1J8mMEBZAVVUMOr1Zpqp+1uz06dOJjIwkISGB4OBgNBoNqqqyfft22rVrh4eHB15eXvTq1YszZ84Yl0tLS0NRFLZs2ULHjh1xcnIiIiKCAwcOlOq7pEWLFlGvXj3jfHJyMq1atcLZ2RkPDw/atm3Lr7/+WqXvUQhhWWqYOwAhBKgFBi68st8s6/Z/LQrF3rZK+/zll1/44IMP+Oijj7C1Leo7JyeH8ePH07RpU3JycnjllVd45JFHOH78ODY2f/+uevnll5k3bx6hoaG8/PLLPP744/zyyy/UqHHrr6vCwkIefvhhRowYwYYNG9DpdBw6dEgOgQlRzUkyI4Socjqdjvfffx9vb29jWd++fU3arF69mtq1a3Py5EnCw8ON5RMnTiQ6OhqAGTNm0KRJE3755RcaNWp0y/VmZ2eTlZVFr169qF+/PgBhYWFV8ZaEEBZMkhkhLIBiZ4P/a1FmW3dVCwwMNElkAM6cOcO0adM4ePAgly5dwmAwAJCenm6SzDRr1sz42s/PD4DMzMwKJTOenp7ExsbSrVs3unTpQufOnenfv7+xHyFE9STnzAhhARRFwcbe1ixTZQ7BuLm5kZWVVar8zz//xM3NzTjv7Oxcqk1MTAyXL19m1apVfPvtt3z77bdA0ShOSXZ2dibbBTAmPjY2NqXO8bnxBOPExEQOHDhAVFQUmzZtokGDBhw8eLDC71EIYX0kmRFCVFijRo347rvvSpUfPnyYhg0blrvc5cuXOXXqFFOnTqVTp06EhYVx5cqVSq/f29ubjIwMk4Tm+PHjpdo1b96cyZMns3//fsLDw1m/fn2l1yWEsB6SzAghKmzUqFGcOXOGZ599lu+//56ffvqJZcuWsXr1al544YVyl6tZsyZeXl6sXLmSX375ha+//prx48dXev0dOnTg999/Z86cOZw5c4Zly5axbds2Y31qaiqTJ0/mwIED/Prrr3z11Vf89NNPct6MENWcJDNCiAqrV68e33zzDWfOnKFr167ce++9rFmzhjVr1tCvX79yl7OxsWHjxo0cOXKE8PBwnn/+eebOnVvp9YeFhfH222+zbNkyIiIiOHToEBMnTjTWOzk58b///Y++ffvSoEEDnnrqKUaPHs3TTz99W+9XCGEdFLWqbzJhYbKzs3F3dycrK8vkmL4Q5pKXl0dqaipBQUE4ODiYOxwhAPlcCstTmf23jMwIIYQQwqpJMiOEEEIIqybJjBBCCCGsmiQzQgghhLBqkswIIYQQwqpJMiOEEEIIqybJjBBCCCGsmiQzQgghhLBqZk1m4uPjuffee3F1daV27do8/PDDnD592qSNqqpMnz4df39/HB0d6dChAydOnDBTxEIIIYSwNGZNZnbv3s2zzz7LwYMH2bFjB4WFhXTt2pWcnBxjmzlz5rBgwQKWLl3K4cOH8fX1pUuXLvz1119mjFwIIYQQlsKsycz27duJjY2lSZMmREREkJiYSHp6OkeOHAGKRmUWLVrEyy+/TJ8+fQgPD2ft2rVcu3ZNnoIrhBnExsaiKApvvvmmSfnHH3+MoihVui5FUfj444+rtE8hRPVU458sfPLkSdLT09HpdCblvXv3vq3+srKyAPD09ASKnoCbkZFB165djW00Gg3t27dn//79ZT48Lj8/n/z8fON8dnb2bcUihCibg4MDs2fP5umnn6ZmzZrmDkcIIW5vZObs2bNEREQQHh5OdHQ0Dz/8MA8//DCPPPIIjzzyyG0Foqoq48ePp127doSHhwOQkZEBgI+Pj0lbHx8fY92N4uPjcXd3N05arfa24hHiblJVFZ1OZ5apss+a7dy5M76+vsTHx5fbZv/+/TzwwAM4Ojqi1WoZO3asyeHjevXq8frrrzNw4EBcXFzw9/fnrbfeMqkHeOSRR1AUxTgfGxvLww8/bLKucePG0aFDB+N8hw4dGDt2LC+++CKenp74+voyffp0k2WysrJ46qmnqF27Nm5ubjz44IN8//33ldoOQgjLcVsjM8899xxBQUHs3LmT4OBgDh06xOXLl5kwYQLz5s27rUBGjx7NDz/8wN69e0vV3Th8rapquUPakydPZvz48cb57OxsSWiExSsoKGDWrFlmWfeUKVOwt7evcHtbW1tmzZrFwIEDGTt2LHXr1jWpT0lJoVu3brz++uusXr2a33//ndGjRzN69GgSExON7ebOncuUKVOYPn06X375Jc8//zyNGjWiS5cuHD58mNq1a5OYmEj37t2xtbWt1Htau3Yt48eP59tvv+XAgQPExsbStm1bunTpgqqqREdH4+npyRdffIG7uzsrVqygU6dO/PTTT8aRYSGE9bitkZkDBw7w2muv4e3tjY2NDTY2NrRr1474+HjGjh1b6f7GjBnDp59+yq5du0y+GH19fQFKjcJkZmaWGq0pptFocHNzM5mEEFXrkUceITIykldffbVU3dy5cxk4cCDjxo0jNDSUqKgolixZwnvvvUdeXp6xXdu2bXnppZdo0KABY8aM4dFHH2XhwoUAeHt7A+Dh4YGvr69xvqKaNWvGq6++SmhoKEOGDKFly5b897//BWDXrl2kpKTw4Ycf0rJlS0JDQ5k3bx4eHh5s3rz5djeJEMKMbmtkRq/X4+LiAkCtWrW4cOECDRs2JDAwsNSl1Tejqipjxoxh69atJCcnExQUZFIfFBSEr68vO3bsoHnz5gDodDp2797N7Nmzbyd0ISySnZ0dU6ZMMdu6b8fs2bN58MEHmTBhgkn5kSNH+OWXX0hKSjKWqaqKwWAgNTWVsLAwANq0aWOyXJs2bVi0aNFtxXKjZs2amcz7+fmRmZlpjO/q1at4eXmZtMnNzeXMmTNVsn4hxN11W8lMeHg4P/zwA8HBwbRu3Zo5c+Zgb2/PypUrCQ4OrnA/zz77LOvXr+eTTz7B1dXVOALj7u6Oo6MjiqIwbtw4Zs2aRWhoKKGhocyaNQsnJycGDhx4O6ELYZEURanUoR5L8MADD9CtWzemTJlCbGyssdxgMPD000+XOUobEBBw0z5vdUWUjY2N8Ryf4v8XX4BQ8tyfGjVqmMwrioLBYEBVVfR6PX5+fuzatQtuOF3Iw8MD1VC5c4jKVMnzkMzqeqhqoQHVoKL/S0dhfsWvTCuzZUULK7qaCrcrv6FJVfHMjc2VG17cUF+02O0ti3Lrz7e4fbeVzEydOtV4Mt/MmTPp1asX999/P15eXmzatKnC/SxfvhzA5OQ9gMTEROOX44svvkhubi6jRo3iypUrtG7dmq+++gpXV9fbCb3K5J35k7zTf/z9ZVjWd9eNX2hltCl18uWNbcr6UizVppy+bre/Eu3UCrSpaF+oZTS5ne12Q32pMEoWlFd34ypKvtFytu+t4lNvUmdcToUCRxV9RA0KLl3D1k5PKZXYD5ZqWu6yt+i0gus0XCvAkFeI7sJVAF4f/wr3do2ivl89AHT/d5XIRs1IOfoDAY6+pTv4XYcOHehV9ifvRTfs7/tF7d/1DQ3qhaA7X1RmZ2dHfuZV4zyAp4M7Kb9+b1J2/PBR7GrYUfB/RTGp+XoMOQXGeQBDbiEGu6KyZgFhZGRkoF7Kp5420DQ+HRRcuMq/UUGhDn1WPr9//AM1/rKiZMya3SwhUm4sLyow5kMVaFuUQJVRd7P2t+q7ZIclqp1b++H6gOn5c3fTbSUz3bp1M74ODg7m5MmT/PHHH9SsWbNSmWdFrqJQFIXp06eXuhrB3HTn/uLqnv8zdxjCChW6Kqh6Z9RCFRWDucOpHPX6dH30IrxhYx5/pD9vJ664Xq8ycdQ47u/dibFTnmfYwFicnJz4388/8d9vvmbR639fIHDgu2+Z9/YieneL5r97dvHRZx/z8ZoPjfWBdQP4em8ybVreh8benpoeNekQ9QAL3lnMus3raX1PKzZs2cSJ06eIbGJ6WOlmOt3fkftatKLf8IG8MXkGDeqHcvG3DLZ//SW9u/XinogWVbGlrI9yfbJRoHLnW/+tItl1RfKkf0suVe4PpzJ/5ZVbU5lV3CmGa4V3aU1l+0f3mSnp33YFgH1dV1weqHN9Tinrfzdk3bcamiyeV242W/YwalmZehl9K2UFVlbuWcl2pm+znPdZumGF2ikVGdItr+56LKa/NMpY/sb6G+pK/xuUs1wZ6y4VoqKQr9dxreASNWpqqKFx4KZu+tugnMrbHcmuwHKKYw2UfFtq+DgZy15/8w02f7YVADsfZ1r4tib5611MfWUqDz7aHVVVqR9cn/79+2Pn61y0kK3C+PHj+f5kCm8sehNXV1fmzZlH9GMPGWOZv2A+E16YSMKGtdSpU4fUM2eJfvwhpp6eypQ3XyUvL48nY59k8JDB/JjyI3Z+RX0r9rbYONsZ5wFsHGyxcaqBnX/RuX5f7NjOy1Nf5ulJo/n999/x9fXlgfsfoE54kLFNVW+723E3D0sY8vKocc0B3+fDcHC4xefSAtxyVLvMupuNvBYfvryNZf/RaPENL9Qbi0oUlLU+k/ZlrKecdatqZdvfvK2tmwZzUtTK3mTCymRnZ+Pu7k5WVpZc2SQsQl5eHqmpqQQFBVnFTuNOqFevHuPGjWPcuHHmDkVcJ59LYWkqs/+Wp2YLIYQQwqpJMiOEEEIIq1Zl58wIIURFpaWlmTsEIUQ1IiMzQgghhLBqkswIIYQQwqpJMiOEEEIIqybJjBBCCCGsmiQzQgghhLBqkswIIYQQwqpJMiOEqBLJyckoisKff/5p7lCEEP8ykswIISosNjYWRVFQFAU7OzuCg4OZOHEiOTk5t93fww8/XLVBCiH+deSmeUKISunevTuJiYkUFBTwzTffMHz4cHJychgwYIC5QxNC/EvJyIwQFkBVVfT6a2aZKvusWY1Gg6+vL1qtloEDBzJo0CA+/vjjUu2mT59OZGSkSdmiRYuoV6+esX7t2rV88sknxtGe5ORkAFJSUnjwwQdxdHTEy8uLp556iqtXr97GlhVC/BvIyIwQFsBgyCV5d1OzrLtD+xRsbZ1ue3lHR0cKCgoqvdzEiRM5deoU2dnZJCYmAuDp6cm1a9fo3r079913H4cPHyYzM5Phw4czevRo1qxZc9txCiGqL0lmhBC37dChQ6xfv55OnTpVelkXFxccHR3Jz8/H19fXWL527Vpyc3N57733cHZ2BmDp0qXExMQwe/ZsfHx8qix+IUT1IMmMEBbAxsaRDu1TzLbuyvjss89wcXGhsLCQgoICHnroId566y1OnjxZJfGcOnWKiIgIYyID0LZtWwwGA6dPn5ZkRghRiiQzQlgARVH+0aGeu6ljx44sX74cOzs7/P39sbOzAyiVzNjY2JQ6H6cih6NUVUVRlDLryisXQvy7yQnAQohKcXZ2JiQkhMDAQGMiUxZvb28yMjJMEprjx4+btLG3t0ev15uUNW7cmOPHj5tc7r1v3z5sbGxo0KBB1bwJIUS1IsmMEOKO6NChA7///jtz5szhzJkzLFu2jG3btpm0qVevHj/88AOnT5/m0qVLFBQUMGjQIBwcHBg6dCg//vgju3btYsyYMQwePFgOMQkhyiTJjBDijggLC+Ptt99m2bJlREREcOjQISZOnGjSZsSIETRs2JCWLVvi7e3Nvn37cHJy4ssvv+SPP/7g3nvv5dFHH6VTp04sXbrUTO9ECGHpFLWyN5mwMtnZ2bi7u5OVlYWbm5u5wxGCvLw8UlNTCQoKwsHBwdzhCAHI51JYnsrsv2VkRgghhBBWTZIZIYQQQlg1SWaEEEIIYdUkmRFCCCGEVZNkRgghhBBWTZIZIYQQQlg1SWaEEEIIYdUkmRFCCCGEVZNkRgghhBBWzazJzJ49e4iJicHf3x9FUfj4449N6mNjY1EUxWS67777zBOsEMJi1KtXj0WLFpk7jApJS0tDUZRSD9kUQlQdsyYzOTk5RERE3PSZK927d+fixYvG6YsvvriLEQohSir+gTFy5MhSdaNGjUJRFGJjY+94HIcPH+app56qsv6KE47iyd7enpCQEGbOnImlPfElPz+fMWPGUKtWLZydnenduzfnz583afPGG28QFRWFk5MTHh4e5glUiLuohjlX3qNHD3r06HHTNhqNBl9f37sUkRDiVrRaLRs3bmThwoU4OjoCRc/12bBhAwEBAXclBm9v7zvS786dO2nSpAn5+fns3buX4cOH4+fnx7Bhw+7I+m7HuHHj+M9//sPGjRvx8vJiwoQJ9OrViyNHjmBrawuATqejX79+tGnThtWrV5s5YiHuPIs/ZyY5OZnatWvToEEDRowYQWZm5k3b5+fnk52dbTIJYelUVSVHrzfLVNmRhxYtWhAQEMCWLVuMZVu2bEGr1dK8eXNj2fbt22nXrh0eHh54eXnRq1cvzpw5Y6zX6XSMHj0aPz8/HBwcqFevHvHx8cb66dOnExAQgEajwd/fn7FjxxrrSh5mevzxx3nsscdMYiwoKKBWrVokJiYat++cOXMIDg7G0dGRiIgINm/eXOq9eXl54evrS2BgIIMGDSIqKoqjR48a6w0GA6+99hp169ZFo9EQGRnJ9u3bTfo4dOgQzZs3x8HBgZYtW3Ls2DFjnaqqhISEMG/ePJNlfvzxR2xsbEy2T1mysrJYvXo18+fPp3PnzjRv3px169aRkpLCzp07je1mzJjB888/T9OmTW/anxDVhVlHZm6lR48e9OvXj8DAQFJTU5k2bRoPPvggR44cQaPRlLlMfHw8M2bMuMuRCvHPXDMYqL8nxSzrPvNAU5yv/6KvqCeffJLExEQGDRoEQEJCAnFxcSQnJxvb5OTkMH78eJo2bUpOTg6vvPIKjzzyCMePH8fGxoYlS5bw6aef8sEHHxAQEMC5c+c4d+4cAJs3b2bhwoVs3LiRJk2akJGRwffff19mLIMGDaJ///5cvXoVFxcXAL788ktycnLo27cvAFOnTmXLli0sX76c0NBQ9uzZwxNPPIG3tzft27cvs9/vvvuOo0ePMnToUGPZ4sWLmT9/PitWrKB58+YkJCTQu3dvTpw4QWhoKDk5OfTq1YsHH3yQdevWkZqaynPPPWdcXlEU4uLiSExMZOLEicbyhIQE7r//furXr3/T7X7kyBEKCgro2rWrsczf35/w8HD2799Pt27dbrq8ENWVRSczAwYMML4ODw+nZcuWBAYG8vnnn9OnT58yl5k8eTLjx483zmdnZ6PVau94rEL8mwwePJjJkycbzzXZt28fGzduNElmihOJYqtXr6Z27dqcPHmS8PBw0tPTCQ0NpV27diiKQmBgoLFteno6vr6+dO7cGTs7OwICAmjVqlWZsXTr1g1nZ2e2bt3K4MGDAVi/fj0xMTG4ubmRk5PDggUL+Prrr2nTpg0AwcHB7N27lxUrVpgkM1FRUdjY2KDT6SgoKOCpp55iyJAhxvp58+YxadIk40jQ7Nmz2bVrF4sWLWLZsmUkJSWh1+tJSEjAycmJJk2acP78eZ555hljH08++SSvvPIKhw4dolWrVhQUFLBu3Trmzp17y+2ekZGBvb09NWvWNCn38fEhIyPjlssLUV1ZdDJzIz8/PwIDA/n555/LbaPRaModtRHCUjnZ2HDmAfMcEnCyqfzR5lq1ahEdHc3atWtRVZXo6Ghq1apl0ubMmTNMmzaNgwcPcunSJQwGA1CUqISHhxMbG0uXLl1o2LAh3bt3p1evXsYRh379+rFo0SKCg4Pp3r07PXv2JCYmhho1Sn9l2dnZ0a9fP5KSkhg8eDA5OTl88sknrF+/HoCTJ0+Sl5dHly5dTJbT6XQmh8UANm3aRFhYGAUFBaSkpDB27Fhq1qzJm2++SXZ2NhcuXKBt27Ymy7Rt29Y4anTq1CkiIiJwcnIy1hcnUMX8/PyIjo4mISGBVq1a8dlnn5GXl0e/fv0qvP1vpKoqiqLc9vJCWDurSmYuX77MuXPn8PPzM3coQlQpRVEqfajH3OLi4hg9ejQAy5YtK1UfExODVqtl1apV+Pv7YzAYCA8PR6fTAUXn3qSmprJt2zZ27txJ//796dy5M5s3b0ar1XL69Gl27NjBzp07GTVqFHPnzmX37t3Y2dmVWtegQYNo3749mZmZ7NixAwcHB+PFBcVJ1Oeff06dOnVMlrvxh49WqyUkJASAsLAwzp49y7Rp05g+fbqxzY1JQ8lEoqLnHw0fPpzBgwezcOFCEhMTGTBggEkCVB5fX190Oh1XrlwxGZ3JzMwkKiqqQusWojoy6wnAV69e5fjx48b7L6SmpnL8+HHS09O5evUqEydO5MCBA6SlpZGcnExMTAy1atXikUceMWfYQgiKbpug0+nQ6XSlztW4fPkyp06dYurUqXTq1ImwsDCuXLlSqg83NzcGDBjAqlWr2LRpEx999BF//PEHAI6OjvTu3ZslS5aQnJzMgQMHSEkp+7yiqKgotFotmzZtIikpiX79+mFvbw9A48aN0Wg0pKenExISYjLd6hC0ra0thYWF6HQ63Nzc8Pf3Z+/evSZt9u/fT1hYmHFd33//Pbm5ucb6gwcPluq3Z8+eODs7s3z5crZt20ZcXNxN4yh2zz33YGdnx44dO4xlFy9e5Mcff5RkRvyrmXVk5rvvvqNjx47G+eJzXYYOHcry5ctJSUnhvffe488//8TPz4+OHTuyadMmXF1dzRWyEOI6W1tbTp06ZXxdUs2aNfHy8mLlypX4+fmRnp7OSy+9ZNJm4cKF+Pn5ERkZiY2NDR9++CG+vr54eHiwZs0a9Ho9rVu3xsnJiffffx9HR0eT82pKUhSFgQMH8s477/DTTz+xa9cuY52rqysTJ07k+eefx2Aw0K5dO7Kzs9m/fz8uLi4mJ/hevnyZjIwMCgsLSUlJYfHixXTs2BE3NzcAXnjhBV599VXq169PZGQkiYmJHD9+nKSkJAAGDhzIyy+/zLBhw5g6dSppaWmlrlwq3l6xsbFMnjyZkJCQUoeiyuPu7s6wYcOYMGECXl5eeHp6MnHiRJo2bUrnzp2N7dLT0/njjz9IT09Hr9cbfzCGhIQYT5IWolpRq7msrCwVULOysswdihCqqqpqbm6uevLkSTU3N9fcoVTa0KFD1Yceeqjc+oceekgdOnSoqqqqumPHDjUsLEzVaDRqs2bN1OTkZBVQt27dqqqqqq5cuVKNjIxUnZ2dVTc3N7VTp07q0aNHVVVV1a1bt6qtW7dW3dzcVGdnZ/W+++5Td+7caVxPYGCgunDhQpN1nzhxQgXUwMBA1WAwmNQZDAZ18eLFasOGDVU7OzvV29tb7datm7p7925VVVU1NTVVBYyTra2tWrduXXXEiBFqZmamsR+9Xq/OmDFDrVOnjmpnZ6dGRESo27ZtM1nXgQMH1IiICNXe3l6NjIxUP/roIxVQjx07ZtLuzJkzKqDOmTPnVpvdRG5urjp69GjV09NTdXR0VHv16qWmp6ebtBk6dKjJ+ymedu3addN+rfVzKaqnyuy/FVW1sNtbVrHs7Gzc3d3Jysoy/roSwpzy8vJITU0lKCgIBwcHc4cjzGTfvn106NCB8+fP4+PjY+5w5HMpLE5l9t9WdQKwEEJYu/z8fM6dO8e0adPo37+/RSQyQlg7i78DsBBCVCcbNmygYcOGZGVlMWfOHJO6pKQkXFxcypyaNGlipoiFsHwyMiOEEHdRbGxsuQ/j7N27N61bty6zrqxL0oUQRSSZEUIIC+Hq6ipXawpxG+QwkxBCCCGsmiQzQgghhLBqkswIIYQQwqpJMiOEEEIIqybJjBBCCCGsmiQzQgirU69ePRYtWmTuMCokLS0NRVGMz0cSQlQ9SWaEEBUWGxuLoiiMHDmyVN2oUaNQFKXce6hUpcOHD/PUU09VWX/FCUfxZG9vT0hICDNnzsTSnviSn5/PmDFjqFWrFs7OzvTu3Zvz588b69PS0hg2bBhBQUE4OjpSv359Xn31VXQ6nRmjFuLOkmRGCFEpWq2WjRs3kpubayzLy8tjw4YNBAQE3JUYvL29cXJyqvJ+d+7cycWLF/n555+ZMWMGb7zxBgkJCVW+nn9i3LhxbN26lY0bN7J3716uXr1Kr1690Ov1APzvf//DYDCwYsUKTpw4wcKFC3nnnXeYMmWKmSMX4s6RZEYIC6CqKtd0hWaZKjvy0KJFCwICAtiyZYuxbMuWLWi1Wpo3b24s2759O+3atcPDwwMvLy969erFmTNnjPU6nY7Ro0fj5+eHg4MD9erVIz4+3lg/ffp0AgIC0Gg0+Pv7M3bsWGNdycNMjz/+OI899phJjAUFBdSqVYvExETj9p0zZw7BwcE4OjoSERHB5s2bS703Ly8vfH19CQwMZNCgQURFRXH06FFjvcFg4LXXXqNu3bpoNBoiIyPZvn27SR+HDh2iefPmODg40LJlS44dO2asU1WVkJAQ5s2bZ7LMjz/+iI2Njcn2KUtWVharV69m/vz5dO7cmebNm7Nu3TpSUlLYuXMnAN27dycxMZGuXbsSHBxM7969mThxosm/lxDVjdwBWAgLkFugp/ErX5pl3Sdf64aTfeW+Cp588kkSExMZNGgQAAkJCcTFxZGcnGxsk5OTw/jx42natCk5OTm88sorPPLIIxw/fhwbGxuWLFnCp59+ygcffEBAQADnzp3j3LlzAGzevJmFCxeyceNGmjRpQkZGBt9//32ZsQwaNIj+/ftz9epVXFxcAPjyyy/Jycmhb9++AEydOpUtW7awfPlyQkND2bNnD0888QTe3t60b9++zH6/++47jh49ytChQ41lixcvZv78+axYsYLmzZuTkJBA7969OXHiBKGhoeTk5NCrVy8efPBB1q1bR2pqKs8995xxeUVRiIuLIzExkYkTJxrLExISuP/++6lfv/5Nt/uRI0coKCiga9euxjJ/f3/Cw8PZv38/3bp1K3O5rKwsPD09b9q3ENZMkhkhRKUNHjyYyZMnG8812bdvHxs3bjRJZooTiWKrV6+mdu3anDx5kvDwcNLT0wkNDaVdu3YoikJgYKCxbXp6Or6+vnTu3Bk7OzsCAgJo1apVmbF069YNZ2dntm7dyuDBgwFYv349MTExuLm5kZOTw4IFC/j6669p06YNAMHBwezdu5cVK1aYJDNRUVHY2Nig0+koKCjgqaeeYsiQIcb6efPmMWnSJONI0OzZs9m1axeLFi1i2bJlJCUlodfrSUhIwMnJiSZNmnD+/HmeeeYZYx9PPvkkr7zyCocOHaJVq1YUFBSwbt065s6de8vtnpGRgb29PTVr1jQp9/HxISMjo8xlzpw5w1tvvcX8+fNv2b8Q1kqSGSEsgKOdLSdfK/tX9d1Yd2XVqlWL6Oho1q5di6qqREdHU6tWLZM2Z86cYdq0aRw8eJBLly5hMBiAokQlPDyc2NhYunTpQsOGDenevTu9evUyjjj069ePRYsWERwcTPfu3enZsycxMTHUqFH6K8vOzo5+/fqRlJTE4MGDycnJ4ZNPPmH9+vUAnDx5kry8PLp06WKynE6nMzksBrBp0ybCwsIoKCggJSWFsWPHUrNmTd58802ys7O5cOECbdu2NVmmbdu2xlGjU6dOERERYXI+T3ECVczPz4/o6GgSEhJo1aoVn332GXl5efTr16/C2/9GqqqiKEqp8gsXLtC9e3f69evH8OHDb7t/ISydJDNCWABFUSp9qMfc4uLiGD16NADLli0rVR8TE4NWq2XVqlX4+/tjMBgIDw83XlXTokULUlNT2bZtGzt37qR///507tyZzZs3o9VqOX36NDt27GDnzp2MGjWKuXPnsnv37jKfHj1o0CDat29PZmYmO3bswMHBgR49egAYk6jPP/+cOnXqmCyn0WhM5rVaLSEhIQCEhYVx9uxZpk2bxvTp041tbkwaSiYSFT3/aPjw4QwePJiFCxeSmJjIgAEDKnRCs6+vLzqdjitXrpiMzmRmZhIVFWXS9sKFC3Ts2JE2bdqwcuXKCsUlhLWSE4CFELele/fu6HQ6dDpdqXM1Ll++zKlTp5g6dSqdOnUiLCyMK1eulOrDzc2NAQMGsGrVKjZt2sRHH33EH3/8AYCjoyO9e/dmyZIlJCcnc+DAAVJSUsqMJSoqCq1Wy6ZNm0hKSqJfv37Y29sD0LhxYzQaDenp6YSEhJhMWq32pu/R1taWwsJCdDodbm5u+Pv7s3fvXpM2+/fvJywszLiu77//3uRKr4MHD5bqt2fPnjg7O7N8+XK2bdtGXFzcTeMods8992BnZ8eOHTuMZRcvXuTHH380SWb+7//+jw4dOtCiRQsSExOxsZGvelG9WddPQSGExbC1teXUqVPG1yXVrFkTLy8vVq5ciZ+fH+np6bz00ksmbRYuXIifnx+RkZHY2Njw4Ycf4uvri4eHB2vWrEGv19O6dWucnJx4//33cXR0NDmvpiRFURg4cCDvvPMOP/30E7t27TLWubq6MnHiRJ5//nkMBgPt2rUjOzub/fv34+LiYnKC7+XLl8nIyKCwsJCUlBQWL15Mx44dcXNzA+CFF17g1VdfpX79+kRGRpKYmMjx48dJSkoCYODAgbz88ssMGzaMqVOnkpaWVurKpeLtFRsby+TJkwkJCSl1KKo87u7uDBs2jAkTJuDl5YWnpycTJ06kadOmdO7cGSgakenQoQMBAQHMmzeP33//3bi8r69vhdYjhNVRq7msrCwVULOysswdihCqqqpqbm6uevLkSTU3N9fcoVTa0KFD1Yceeqjc+oceekgdOnSoqqqqumPHDjUsLEzVaDRqs2bN1OTkZBVQt27dqqqqqq5cuVKNjIxUnZ2dVTc3N7VTp07q0aNHVVVV1a1bt6qtW7dW3dzcVGdnZ/W+++5Td+7caVxPYGCgunDhQpN1nzhxQgXUwMBA1WAwmNQZDAZ18eLFasOGDVU7OzvV29tb7datm7p7925VVVU1NTVVBYyTra2tWrduXXXEiBFqZmamsR+9Xq/OmDFDrVOnjmpnZ6dGRESo27ZtM1nXgQMH1IiICNXe3l6NjIxUP/roIxVQjx07ZtLuzJkzKqDOmTPnVpvdRG5urjp69GjV09NTdXR0VHv16qWmp6cb6xMTE03eS8npVv1a6+dSVE+V2X8rqmpht7esYtnZ2bi7u5OVlWX8dSWEOeXl5ZGamkpQUBAODg7mDkeYyb59++jQoQPnz5/Hx8fH3OHI51JYnMrsv+UwkxBC3EX5+fmcO3eOadOm0b9/f4tIZISwdnJWmBBC3EUbNmygYcOGZGVlMWfOHJO6pKQkXFxcypyaNGlipoiFsHwyMiOEEHdRbGxsuQ/j7N27N61bty6zrqxL0oUQRSSZEUIIC+Hq6oqrq6u5wxDC6shhJiGEEEJYNUlmhBBCCGHVJJkRQgghhFWTZEYIIYQQVk2SGSGEEEJYNUlmhBBWp169eixatMjcYVRIWloaiqJw/Phxc4ciRLUlyYwQosJiY2NRFIWRI0eWqhs1ahSKopR7D5WqdPjwYZ566qkq66844Sie7O3tCQkJYebMmVjaE1/y8/MZM2YMtWrVwtnZmd69e3P+/HmTNr179yYgIAAHBwf8/PwYPHgwFy5cMFPEQtx5Zk1m9uzZQ0xMDP7+/iiKwscff2xSr6oq06dPx9/fH0dHRzp06MCJEyfME6wQAgCtVsvGjRvJzc01luXl5bFhwwYCAgLuSgze3t44OTlVeb87d+7k4sWL/Pzzz8yYMYM33niDhISEKl/PPzFu3Di2bt3Kxo0b2bt3L1evXqVXr17o9Xpjm44dO/LBBx9w+vRpPvroI86cOcOjjz5qxqiFuLPMmszk5OQQERHB0qVLy6yfM2cOCxYsYOnSpRw+fBhfX1+6dOnCX3/9dZcjFeIOU1XQ5ZhnquTIQ4sWLQgICGDLli3Gsi1btqDVamnevLmxbPv27bRr1w4PDw+8vLzo1asXZ86cMdbrdDpGjx6Nn58fDg4O1KtXj/j4eGP99OnTCQgIQKPR4O/vz9ixY411JQ8zPf744zz22GMmMRYUFFCrVi0SExOvb16VOXPmEBwcjKOjIxEREWzevLnUe/Py8sLX15fAwEAGDRpEVFQUR48eNdYbDAZee+016tati0ajITIyku3bt5v0cejQIZo3b46DgwMtW7bk2LFjxjpVVQkJCWHevHkmy/z444/Y2NiYbJ+yZGVlsXr1aubPn0/nzp1p3rw569atIyUlhZ07dxrbPf/889x3330EBgYSFRXFSy+9xMGDBykoKLhp/0JYK7PeAbhHjx706NGjzDpVVVm0aBEvv/wyffr0AWDt2rX4+Piwfv16nn766TKXy8/PJz8/3zifnZ1d9YELUdUKrsEsf/Ose8oFsHeu1CJPPvkkiYmJDBo0CICEhATi4uJITk42tsnJyWH8+PE0bdqUnJwcXnnlFR555BGOHz+OjY0NS5Ys4dNPP+WDDz4gICCAc+fOce7cOQA2b97MwoUL2bhxI02aNCEjI4Pvv/++zFgGDRpE//79uXr1Ki4uLgB8+eWX5OTk0LdvXwCmTp3Kli1bWL58OaGhoezZs4cnnngCb29v2rdvX2a/3333HUePHmXo0KHGssWLFzN//nxWrFhB8+bNSUhIoHfv3pw4cYLQ0FBycnLo1asXDz74IOvWrSM1NZXnnnvOuLyiKMTFxZGYmMjEiRON5QkJCdx///3Ur1//ptv9yJEjFBQU0LVrV2OZv78/4eHh7N+/n27dupVa5o8//iApKYmoqCh5JIKotiz2nJnU1FQyMjJM/mg1Gg3t27dn//795S4XHx+Pu7u7cdJqtXcjXCH+VQYPHszevXtJS0vj119/Zd++fTzxxBMmbfr27UufPn0IDQ0lMjKS1atXk5KSwsmTJwFIT08nNDSUdu3aERgYSLt27Xj88ceNdb6+vnTu3JmAgABatWrFiBEjyoylW7duODs7s3XrVmPZ+vXriYmJwc3NjZycHBYsWEBCQgLdunUjODiY2NhYnnjiCVasWGHSV1RUFC4uLtjb23PvvffSv39/hgwZYqyfN28ekyZN4rHHHqNhw4bMnj2byMhI4yhRUlISer2ehIQEmjRpQq9evXjhhRdM1vHkk09y+vRpDh06BBSNIq1bt464uLhbbveMjAzs7e2pWbOmSbmPjw8ZGRkmZZMmTcLZ2RkvLy/S09P55JNPbtm/ENbKYp/NVPyH6ePjY1Lu4+PDr7/+Wu5ykydPZvz48cb57OxsSWiE5bNzKhohMde6K6lWrVpER0ezdu1aVFUlOjqaWrVqmbQ5c+YM06ZN4+DBg1y6dAmDwQAUJSrh4eHExsbSpUsXGjZsSPfu3enVq5fxx0u/fv1YtGgRwcHBdO/enZ49exITE0ONGqW/suzs7OjXrx9JSUkMHjyYnJwcPvnkE9avXw/AyZMnycvLo0uXLibL6XQ6k8NiAJs2bSIsLIyCggJSUlIYO3YsNWvW5M033yQ7O5sLFy7Qtm1bk2Xatm1rHDU6deoUERERJufztGnTxqS9n58f0dHRJCQk0KpVKz777DPy8vLo169fhbf/jVRVRVEUk7IXXniBYcOG8euvvzJjxgyGDBnCZ599VqqdENWBxSYzxW78wyvrj7YkjUaDRqO502EJUbUUpdKHeswtLi6O0aNHA7Bs2bJS9TExMWi1WlatWoW/vz8Gg4Hw8HB0Oh1QdO5Namoq27ZtY+fOnfTv35/OnTuzefNmtFotp0+fZseOHezcuZNRo0Yxd+5cdu/eXeahkkGDBtG+fXsyMzPZsWMHDg4OxkPYxUnU559/Tp06dUyWu/G7QqvVEhISAkBYWBhnz55l2rRpTJ8+3djmZt9JFb3yafjw4QwePJiFCxeSmJjIgAEDKnRCs6+vLzqdjitXrpiMzmRmZhIVFWXStlatWtSqVYsGDRoQFhaGVqvl4MGDpZIrIaoDi01mfH19gaIRGj8/P2N5ZmZmqdEaczj25Wcc+uT6CYQlv8BKvDb5WrteXt6XnVqJPkq3KVleRn8l6m/5XXuTBiq3WPhm1bdY8S37/gcU/sEv0X/yK7aMRRUUHGt60uzRJ7hkZ4udrW3VdF2hMP/5L/K8q3+Rfy2HzLSztGjUgLzrVzQ1bxhKZtpZ8q/lkFfDlv8dO8KpU6d4c/qrNK0fBMC3330HwJ+ZGWT+etbYZ8f7WtHxvlZ0vr8djw2N5fT3x/D08ACgTURT2kQ05fGHHyKqU2f2fLWdZuHhGAoLufrHZX7/NRWA0Dp+1PHzY/Xyt/lvcjK9uncj6+L/AVDbxQmNvT0/Hj1C43o3XG1lKOT39DQu/1/Rpc1/XLzA754exurc7CwKCwu5cOZnXF1d8fXx4cvP/kNYiX72JO+ieUQEv6enofWtzXtrj5H+0/9wdHAAYMcXn5fq+97wxjg6ODBv1hts27aNTz/YxKX0NMr9N7peXM/HGzs7Oz7asJ6HY3oBkPFbJj/++CMvvzCBS+fKHrW+fP2y7Mxzv3KpbtnnZhUUFnL1ymW2fvAeur/KOdewnL+Hm36yyvsbKrevm/RWblc3i6B0XZnNyygsM5Z/tGwFY7lh2VLvr9TsrddVej03dnKLdZahZJuGbe4nvGOXm7S+syw2mQkKCsLX15cdO3YYh4J1Oh27d+9m9uzZZo4OdLm5XL18ydxhCCtkp9OBqqIaDKi3mSyZ684nqqqiqioGvR4F2LN9G1D0tWjQ6431bi4u1KzpwXvr1+Pt5cX/XbzAG3OLruBRDQYMhXpWJCTiU9ubJmFh2NjY8Olnn1Hb2xtXJyfWb/oAvV5Pi8gIHB0c2PTRR0X3TPHxQV9YiErRiIu+sNAY28MxvVizLomzaWlsXveesc7RwYGRw4cx7fXX0RcW0Oqelvx19SrfHT2Ks7MT/fv0wVBYdJXP5Uu/c/HCBQoL9Zz66TSrEhJpe999ODk4oC8o4Jnhw5i3eAkBdevQJCyMTZs/4seTp1g6fx76ggIe7tmTWXPmMW7iCzw3ahTn/+88b69YCYChsAB9iauJ+vd5hJmz51AvMIDmzZpSWIErjZwcHHi836O8+vpM3F1d8HD34LU33ySsYQPatmpFoU7Hse+/59j3P9Cq5T24u7uTnn6OOYsXUy8ggMjwphReHxm7UaFej6FQz58ZF7n2h3y3icqpHXTzk9fvNLMmM1evXuWXX34xzqempnL8+HE8PT0JCAhg3LhxzJo1i9DQUEJDQ5k1axZOTk4MHDjQjFEXCe/QmXrNShxvL7FTKi+jNZaXbGvaoJw+lLJfltPGWGyyHpMFy4yvYtW3Wrbyv6oq0eA2/IPd/j9ZtMyRqKIyXUEBmVeyqOlXB4frv94rtdI7lsmU7vjGEo2zM/YFhXjVLRqZ8Lqh3t7RCY2TM94B9Vi/LonnJ0ygY3QvGjRowML58+nctSuuXt541Q3Ap05d3lm5kl9++QVbW1ta3nMP//nPf/AOqEedoGDmzpvLjDdno9frCQ9vwsdbthDatBkAtra2OHt44FX37/Ph4p56iiXL3yEwIIAevR82+SzOmTefwOD6LFu5kokvT8PDw4PmkZFMevFFPOtoyS4sOhTVf0issX8/X196REfz2vTpeHp7A/DilJfR29jw+uy5ZP7+O2Fhjfho84e0bNsOAE/g461bGT12DF0fepiwsEa8+WY8Ax4fiHttHzzr1DVu2GdGj2HJ8neIixuGp3/dCv8rvbV0GS9NmcLIcePJzc2lY4cOrFn7Ht516wIqPn9cYceSt5i/dBk5OTn4+vrStUsXJk+ahF+dv0dlbvy3zc/P58/cfLo9M44aNqX/Fss9hHaTz2O5I67l9nWzkeHyKio5mlxW0U3+Xm+5qjIKy15vBWO5sfCG5Up3U1act+jjVrGV+Z5uvoyXNrDUMneToprx9pbJycl07NixVPnQoUNZs2YNqqoyY8YMVqxYwZUrV2jdujXLli0jPDy8wuvIzs7G3d2drKws3NzcqjJ8IW5LXl4eqampBAUFlZHMiH+Lffv20aFDB86fP28Rh87lcyksTWX232ZNZu4GSWaEpZGdxr9bfn4+586d46mnnsLPz4+kpCRzhwTI51JYnsrsvy32PjNCCFEdbdiwgYYNG5KVlcWcOXNM6pKSknBxcSlzatKkiZkiFsLyWewJwEIIUR3FxsaW+zDO3r1707p16zLr5O69QpRPkhkhhLAQrq6uuLq6mjsMIayOHGYSQgghhFWTZEYIIYQQVk2SGSGEEEJYNUlmhBBCCGHVJJkRQgghhFWTZEYIYXXq1avHokWLzB1GhaSlpaEoCsePHzd3KEJUW5LMCCEqLDY2FkVRGDlyZKm6UaNGoShKufdQqUqHDx/mqaeeqrL+ihOO4sne3p6QkBBmzpxZ/jOJzCQ/P58xY8ZQq1YtnJ2d6d27N+fPny+3bWRkpCRTotqTZEYIUSlarZaNGzeSm5trLMvLy2PDhg0EBATclRi8vb1xcnKq8n537tzJxYsX+fnnn5kxYwZvvPEGCQkJVb6ef2LcuHFs3bqVjRs3snfvXq5evUqvXr3Q6/Wl2r744ov4+/uX0YsQ1YskM0JYAFVVuVZwzSxTZUceWrRoQUBAAFu2bDGWbdmyBa1WS/Pmfz9Jfvv27bRr1w4PDw+8vLzo1asXZ86cMdbrdDpGjx6Nn58fDg4O1KtXj/j4eGP99OnTCQgIQKPR4O/vz9ixY411JQ8zPf744zz22GMmMRYUFFCrVi0SExON23fOnDkEBwfj6OhIREQEmzdvLvXevLy88PX1JTAwkEGDBhEVFcXRo0eN9QaDgddee426deui0WiIjIxk+/btJn0cOnSI5s2b4+DgQMuWLTl27JixTlVVQkJCmDdvnskyP/74IzY2NibbpyxZWVmsXr2a+fPn07lzZ5o3b866detISUlh586dJm23bdvGV199VWpdQlRHcgdgISxAbmEurdeXfRv7O+3bgd/iZFe5UY4nn3ySxMREBg0aBEBCQgJxcXEkJycb2+Tk5DB+/HiaNm1KTk4Or7zyCo888gjHjx/HxsaGJUuW8Omnn/LBBx8QEBDAuXPnOHfuHACbN29m4cKFbNy4kSZNmpCRkcH3339fZiyDBg2if//+XL16FRcXFwC+/PJLcnJy6Nu3LwBTp05ly5YtLF++nNDQUPbs2cMTTzyBt7c37du3L7Pf7777jqNHjzJ06FBj2eLFi5k/fz4rVqygefPmJCQk0Lt3b06cOEFoaCg5OTn06tWLBx98kHXr1pGamspzzz1nXF5RFOLi4khMTGTixInG8oSEBO6//37q169/0+1+5MgRCgoK6Nq1q7HM39+f8PBw9u/fT7du3QD47bffGDFiBB9//PEdGcESwtJIMiOEqLTBgwczefJk47km+/btY+PGjSbJTHEiUWz16tXUrl2bkydPEh4eTnp6OqGhobRr1w5FUQgMDDS2TU9Px9fXl86dO2NnZ0dAQACtWrUqM5Zu3brh7OzM1q1bGTx4MADr168nJiYGNzc3cnJyWLBgAV9//TVt2rQBIDg4mL1797JixQqTZCYqKgobGxt0Oh0FBQU89dRTDBkyxFg/b948Jk2aZBwJmj17Nrt27WLRokUsW7aMpKQk9Ho9CQkJODk50aRJE86fP88zzzxj7OPJJ5/klVde4dChQ7Rq1YqCggLWrVvH3Llzb7ndMzIysLe3p2bNmiblPj4+ZGRkAEWjP7GxsYwcOZKWLVuSlpZ2y36FsHaSzAhhARxrOPLtwG/Ntu7KqlWrFtHR0axduxZVVYmOjqZWrVombc6cOcO0adM4ePAgly5dwmAwAEWJSnh4OLGxsXTp0oWGDRvSvXt3evXqZRxx6NevH4sWLSI4OJju3bvTs2dPYmJiqFGj9FeWnZ0d/fr1IykpicGDB5OTk8Mnn3zC+vXrATh58iR5eXl06dLFZDmdTmdyWAxg06ZNhIWFUVBQQEpKCmPHjqVmzZq8+eabZGdnc+HCBdq2bWuyTNu2bY2jRqdOnSIiIsJkNKQ4gSrm5+dHdHQ0CQkJtGrVis8++4y8vDz69etX4e1/I1VVURQFgLfeeovs7GwmT5582/0JYW0kmRHCAiiKUulDPeYWFxfH6NGjAVi2bFmp+piYGLRaLatWrcLf3x+DwUB4eDg6nQ4oOvcmNTWVbdu2sXPnTvr370/nzp3ZvHkzWq2W06dPs2PHDnbu3MmoUaOYO3cuu3fvLvPp0YMGDaJ9+/ZkZmayY8cOHBwc6NGjB4Axifr888+pU6eOyXIajcZkXqvVEhISAkBYWBhnz55l2rRpTJ8+3dimOGkoVjKRqOj5R8OHD2fw4MEsXLiQxMREBgwYUKHDQb6+vuh0Oq5cuWIyOpOZmUlUVBQAX3/9NQcPHiz13lq2bMmgQYNYu3ZthWIUwprICcBCiNvSvXt3dDodOp3OeK5GscuXL3Pq1CmmTp1Kp06dCAsL48qVK6X6cHNzY8CAAaxatYpNmzbx0Ucf8ccffwDg6OhI7969WbJkCcnJyRw4cICUlJQyY4mKikKr1bJp0yaSkpLo168f9vb2ADRu3BiNRkN6ejohISEmk1arvel7tLW1pbCwEJ1Oh5ubG/7+/uzdu9ekzf79+wkLCzOu6/vvvze50uvgwYOl+u3ZsyfOzs4sX76cbdu2ERcXd9M4it1zzz3Y2dmxY8cOY9nFixf58ccfjcnMkiVL+P777zl+/DjHjx/niy++AIpGnd54440KrUcIayMjM0KI22Jra8upU6eMr0uqWbMmXl5erFy5Ej8/P9LT03nppZdM2ixcuBA/Pz8iIyOxsbHhww8/xNfXFw8PD9asWYNer6d169Y4OTnx/vvv4+joaHJeTUmKojBw4EDeeecdfvrpJ3bt2mWsc3V1ZeLEiTz//PMYDAbatWtHdnY2+/fvx8XFxeQE38uXL5ORkUFhYSEpKSksXryYjh074ubmBsALL7zAq6++Sv369YmMjCQxMZHjx4+TlJQEwMCBA3n55ZcZNmwYU6dOJS0trcyriWxtbYmNjWXy5MmEhISUOhRVHnd3d4YNG8aECRPw8vLC09OTiRMn0rRpUzp37gxQ6vL44pOi69evT926dSu0HiGsjSQzQojbVryTv5GNjQ0bN25k7NixhIeH07BhQ5YsWUKHDh2MbVxcXJg9ezY///wztra23HvvvXzxxRfY2Njg4eHBm2++yfjx49Hr9TRt2pT//Oc/eHl5lRvLoEGDmDVrFoGBgaXOa3n99depXbs28fHxnD17Fg8PD1q0aMGUKVNM2hUnBLa2tvj5+dGzZ0+T0YyxY8eSnZ3NhAkTyMzMpHHjxnz66aeEhoYa39N//vMfRo4cSfPmzWncuDGzZ88udTI0wLBhw5g1a1aFR2WKLVy4kBo1atC/f39yc3Pp1KkTa9asKZVQCvFvoqiWdnvLKpadnY27uztZWVnlfvEKcTfl5eWRmppKUFAQDg4O5g5HmMm+ffvo0KED58+fx8fHx9zhyOdSWJzK7L9lZEYIIe6i/Px8zp07x7Rp0+jfv79FJDJCWDs5AVgIIe6iDRs20LBhQ7KyspgzZ45JXVJSEi4uLmVOTZo0MVPEQlg+GZkRQoi7KDY2ttyHcfbu3ZvWrcu+E3RZl6QLIYpIMiOEEBbC1dUVV1dXc4chhNWRw0xCCCGEsGqSzAghhBDCqkkyI4QQQgirJsmMEEIIIayaJDNCCCGEsGqSzAghrE69evVYtGiRucOokLS0NBRF4fjx4+YORYhqS5IZIUSFxcbGoigKI0eOLFU3atQoFEUp9x4qVenw4cM89dRTVdZfccJRPNnb2xMSEsLMmTOxtCe+5OfnM2bMGGrVqoWzszO9e/fm/PnzJm3q1atn8n4URSn1oE8hqhNJZoQQlaLVatm4cSO5ubnGsry8PDZs2FDqic13ire3N05OTlXe786dO7l48SI///wzM2bM4I033iAhIaHK1/NPjBs3jq1bt7Jx40b27t3L1atX6dWrF3q93qTda6+9xsWLF43T1KlTzRSxEHeeRd80b/r06cyYMcOkzMfHh4yMDDNF9LdfT1zm7PHfzR2GsEI29gbcggq5eiUPnb1l/eq/lYJ8Pc3CI0j7NY2ktRvp3+8xAD7cvIk6/nWpF1iPgnw92Zdz2fnfr5i7YDanTp3ExtaWVi1b8easeQQHBQOg0+mYMm0Sn/7nY/7M+hOf2j7EDh3GhHEvABA/eybr1r9H5u+ZeNb05KHejzAnfj4ATZs34pmnRzNq5GjiRgxFVVUS333v7zgLCmjQJJjXp7/BEwOHoKoqi99aSMLad/nttwxC6ofywoSXeLj3IwD8dSUPAI2tM0527jjZQUz3PrS6910O7j9Ev4cHAmAwGJg7/03WvJfApcuXaNigIdOnvU7nTl2N6z5y9DDPTRjDTz+dJqxRYyaOfxGAq3/mkXXpGs1bNSVu6HCeGz3OuMzJUydo80Arjh1KMW6fsmRlZ7F69WpWvr2a1s2Lngz+zpJVhEU04NMtn9P5wS4AqAYVOxsHnO3cjcuq+fBXfm6Z/Rb9e+STl1PAof+cxaCT37nmYl3fCH8LbOxFcHNvs63fopMZgCZNmrBz507jvKU85v7Sub84+c0Fc4chrJCDuw1N/dzJv1Zo3Gmoqgr5eeYJSOOAoigVaqovMKAvVOnfZyDvrVtL7x59AVj7/hoG9B3E/oN70RcYyLtawJ9/ZPPUk6MIa9iEa9dymL1wFgMHD+DrL/ZiY2PD2yvf4ottn7Ny6Rrq+NflwsX/4/8u/B95Vwv4zxcfs+ydpaxYkkDDBo3I/D2TE6dSyLtaAIBqKEqs8q4W8HCvR3nq2Vgu/3YFZ2cXAL7673au5eTQrWM0eVcLmDX3Nb7Y/h9mvzafoKD6HPx2P0+NjMPNyYOo+9qRn1PUr+5aoXEdx384yvffH6Pfw48Zy955dxlvvb2EuW8spGmTCDZ88D6PPdGPPV99S3BQfXKu5dDv8b60a/MAS+evJP3cr7w8bZKx7/ycQh57dBDrkt7jqdhnjds1cc0a7rs3Cj9vLbnX11WWbw8epqCggKhWDxjbebh606hBY/bt3U/bVh2M22fh4vnMmRePv19dYqIf4tmnnsPe3r7cvgsKCynI0/Pzd3+Ql2Wo0OdBiGIOznaSzNxMjRo18PX1rXD7/Px88vPzjfPZ2dl3Iiz8QzxoFRN0R/oW1UO5+YGtnhpOuTi62aOx1wBgyM3lfPcOdy22kuomH8DG0aFCbWvY21DDzoahTw5h1twZXMq6iKIoHD7yLe+/l8ShI/upYW+Ds4eGAY/3N1l2RcOVBIVoSc84S5PGTfjt0kVCQkJ4sEsHFEWhUXiose3vf2Tg6+NDj17dsLOzoyEh3N8hyliv2IDGsQbOHhp69e6J04vO/Peb7Tz+2CAAPt32ET16ROOr9SYnJ4cVq5fx+afbad3qPgCaNGvE0R8OsX7zWrp074RTVtFOvtejXbGxsUGn01FQUMCTscN4cliscb3vrF7K+HETeGJI0Xoi7pnNgcP7SEhawcJ5i9n08fuoBgOrVr6Lk5MT97SK5HJWJuPGj8HR1R5nDw3DhsUxZ8EsTv3yAy3vuZeCggI++uQD3nhtFs7umptu/+yrf2Bvb0+dANPvRF8/H/7IumRc/tlRo4mIiKSme02+O3qYV197hYu/nWfZknfK7TtfB/ZZNWjWsS7oLeNHo7AefvXdb93oDrL4ZObnn3/G398fjUZD69atmTVrFsHB5Q/DxsfHlzo0dSf4hXjgF+Jxx9cjqp+8vDxSU1NxcrXHweF6MmOnv8VSd46zmz02TjffiRarYW+LrZ0NgcF1iI6O5sOtG1FVlejoaAKD62BrZ0MNe1uc3TWcOXOGadOmcfDgQS5duoTBUPRr/9KVDJzdWzDi6WF06dKFFq2a0b17d3r16kXXrkWHawYNeZy3VyylafMwunfvTs+ePYmJiaFGjaKvLMVGwd6xxvWdt4b+/fuxeesHDH86jpycHD7/4jPWr1+Ps7uGkz/9QF5eHr0fiTZ5LzqdjubNm+PsrsHJrej9b9q0ibCwMAoKCkhJSWHs2LHU9qnFm2++SXZ2NhcvXqBjp/YmScf9D7Tj+++/x9ldw9m0X4iIjMDbr6axvsOD9wMUJTPuGuq71yM6OpoNH66jfad2bN36Bfn5eTwxdCBOt/h30DgXPWzS2cO0nY2tgr1DDWP5pCkvGOtat2uJb53aPProo8xfOA8vL68y+7bNU9E41qBRh7o4OFQsuRXCUlh0MtO6dWvee+89GjRowG+//cbMmTOJiorixIkT5f5BTp48mfHjxxvns7Oz0Wq1dytkIW6L4uhIw6NHzLbu2xEXF8fo0aMBWLZsWan6mJgYtFotq1atwt/fH4PBQHh4ODqdDoAWLVqQmprKtm3b2LlzJ/3796dz585s3rwZrVbL6dOn2bFjBzt37mTUqFHMnTuX3bt3l/n06EGDBtG+fXsyMzPZsWMHDg4O9OjRA8CYRH3++efUqVPHZDmNxjQp0Gq1hISEABAWFsbZs2eZNm0a06dP/3t73TDkpqqqsayiVz4NHz6cwYMHs3DhQhITExkwYECFTmj29fVFp9Nx5coVatb8O2HKzMwkKiqq3OXuu69oROqXX34p97tTCGtm0clM8ZcRQNOmTWnTpg3169dn7dq1JglLSRqNptQXlBCWTlEUlDtwdc6d1L17d2Ni0q1bN5O6y5cvc+rUKVasWMH99xeNTOzdu7dUH25ubgwYMIABAwbw6KOP0r17d/744w88PT1xdHSkd+/e9O7dm2effZZGjRqRkpJCixYtSvUTFRWFVqtl06ZNbNu2jX79+hnPD2ncuDEajYb09HTat29fqfdoa2tLYWEhOp0ONzc3/P392bt3Lw888ICxzf79+2nVqpVxXe+//z65ubk4Xk8SDx48WKrfnj174uzszPLly9m2bRt79uypUDz33HMPdnZ27Nixg/79iw7jXbx4kR9//JE5c+aUu9yxY8cA8PPzq9gbF8LKWHQycyNnZ2eaNm3Kzz//bO5QhPjXs7W15dSpU8bXJdWsWRMvLy9WrlyJn58f6enppe5zsnDhQvz8/IiMjMTGxoYPP/wQX19fPDw8WLNmDXq9ntatW+Pk5MT777+Po6MjgYGBZcaiKAoDBw7knXfe4aeffmLXrl3GOldXVyZOnMjzzz+PwWCgXbt2ZGdns3//flxcXBg6dKix7eXLl8nIyKCwsJCUlBQWL15Mx44dcXNzA+CFF17g1VdfpX79+kRGRpKYmMjx48dJSkoCYODAgbz88ssMGzaMqVOnkpaWxrx588rcdrGxsUyePJmQkBDatGlToW3u7u7OsGHDmDBhAl5eXnh6ejJx4kSaNm1K586dAThw4AAHDx6kY8eOuLu7c/jwYZ5//nl69+591y6dF+KuU61IXl6eWqdOHXXGjBkVXiYrK0sF1KysrDsYmRAVl5ubq548eVLNzc01dyiVNnToUPWhhx4qt/6hhx5Shw4dqqqqqu7YsUMNCwtTNRqN2qxZMzU5OVkF1K1bt6qqqqorV65UIyMjVWdnZ9XNzU3t1KmTevToUVVVVXXr1q1q69atVTc3N9XZ2Vm977771J07dxrXExgYqC5cuNBk3SdOnFABNTAwUDUYDCZ1BoNBXbx4sdqwYUPVzs5O9fb2Vrt166bu3r1bVVVVTU1NVSm6KlYFVFtbW7Vu3brqiBEj1MzMTGM/er1enTFjhlqnTh3Vzs5OjYiIULdt22ayrgMHDqgRERGqvb29GhkZqX700UcqoB47dsyk3ZkzZ1RAnTNnzq02u4nc3Fx19OjRqqenp+ro6Kj26tVLTU9PN9YfOXJEbd26teru7q46ODioDRs2VF999VU1Jyfnlv1a6+dSVE+V2X8rqmpht7csYeLEicTExBAQEEBmZiYzZ85k9+7dpKSklPsL7UbZ2dm4u7uTlZVl/HUlhDkVnwAcFBQkJ1r+i+3bt48OHTpw/vx5fHx8zB2OfC6FxanM/tuiDzOdP3+exx9/nEuXLuHt7c19993HwYMHK5zICCGEpcnPz+fcuXNMmzaN/v37W0QiI4S1s+hkZuPGjeYOQQghqtSGDRsYNmwYkZGRvP/++yZ1SUlJPP3002UuFxgYyIkTJ+5GiEJYHYtOZoQQorqJjY0t92GcvXv3pnXr1mXWlXVJuhCiiCQzQghhIVxdXXF1dTV3GEJYHXmamBBmYsHn3ot/Ifk8CmsmyYwQd1nx4YJr166ZORIh/lb8eZTDWcIayWEmIe4yW1tbPDw8yMzMBMDJyanCT60Woqqpqsq1a9fIzMzEw8Oj1A0QhbAGkswIYQbFT4IvTmiEMDcPDw/j51IIayPJjBBmoCgKfn5+1K5dm4KCAnOHI/7l7OzsZERGWDVJZoQwI1tbW9mJCCHEPyQnAAshhBDCqkkyI4QQQgirJsmMEEIIIayaJDNCCCGEsGqSzAghhBDCqkkyI4QQQgirJsmMEEIIIayaJDNCCCGEsGqSzAghhBDCqkkyI4QQQgirJsmMEEIIIayaJDNCCCGEsGqSzAghhBDCqslTs2/TH++9z6UVK8wdhhBCCGF2noMHU2vk02ZbvyQzt8mQl4f+8mVzhyGEEEKYneHaNbOuX5KZ22Tr6YlT69bmDkMIAaCYO4B/AdXcAQhLVqN2bfOu36xrt2L6P/7g2rffmjsMIYQQwuwcIyLMun5JZm7T783q8n+jeps7DCGEEMLsCiPqYc6xGUlmbtMau7/YVM/b3GEIIYQQZtfLIYelZly/JDO3KdfWnzzXBuYOQwghhDC7nBrZZl2/JDO3yeWCG057fjV3GEIIIYTZubWuC/eYb/2SzNymuvY1MMg9B4UQQgjq2Js3nZBk5jbVr3WCIfftMHcYQgghhNmF1b4faGq29Usyc5v2ff8hWzll7jCEEEIIs8u7/H/E3DvYbOu3imTm7bffZu7cuVy8eJEmTZqwaNEi7r//frPGVMcugOjfJZkRQggh6ngEmnX9iqqqFn1fx02bNjF48GDefvtt2rZty4oVK3j33Xc5efIkAQEBt1w+Ozsbd3d3srKycHNzuwsRCyGEEOKfqsz+2+KTmdatW9OiRQuWL19uLAsLC+Phhx8mPj6+VPv8/Hzy8/ON89nZ2Wi1WklmhBBCCCtSmWTGoi/H0el0HDlyhK5du5qUd+3alf3795e5THx8PO7u7sZJq9XejVCFEEIIYSYWncxcunQJvV6Pj4+PSbmPjw8ZGRllLjN58mSysrKM07lz5+5GqEIIIYQwE6s4AVhRTB+Jq6pqqbJiGo0GjUZzN8ISQgghhAWw6JGZWrVqYWtrW2oUJjMzs9RojRBCCCH+nSw6mbG3t+eee+5hxw7Tm9Pt2LGDqKgoM0UlhBBCCEti8YeZxo8fz+DBg2nZsiVt2rRh5cqVpKenM3LkSHOHJoQQQggLYPHJzIABA7h8+TKvvfYaFy9eJDw8nC+++ILAQPPeoEcIIYQQlsHi7zPzT8lN84QQQgjrU23uMyOEEEIIcSuSzAghhBDCqkkyI4QQQgirJsmMEEIIIayaJDNCCCGEsGoWf2n2P1V8sVZ2draZIxFCCCFERRXvtyty0XW1T2b++usvAHl6thBCCGGF/vrrL9zd3W/aptrfZ8ZgMHDhwgVcXV3LfTjl7crOzkar1XLu3Dm5h80dJNv57pDtfHfIdr47ZDvfHXdyO6uqyl9//YW/vz82Njc/K6baj8zY2NhQt27dO7oONzc3+WO5C2Q73x2yne8O2c53h2znu+NObedbjcgUkxOAhRBCCGHVJJkRQgghhFWTZOYf0Gg0vPrqq2g0GnOHUq3Jdr47ZDvfHbKd7w7ZzneHpWznan8CsBBCCCGqNxmZEUIIIYRVk2RGCCGEEFZNkhkhhBBCWDVJZoQQQghh1SSZuU1vv/02QUFBODg4cM899/DNN9+YO6RqJT4+nnvvvRdXV1dq167Nww8/zOnTp80dVrUXHx+PoiiMGzfO3KFUS//3f//HE088gZeXF05OTkRGRnLkyBFzh1WtFBYWMnXqVIKCgnB0dCQ4OJjXXnsNg8Fg7tCs2p49e4iJicHf3x9FUfj4449N6lVVZfr06fj7++Po6EiHDh04ceLEXYtPkpnbsGnTJsaNG8fLL7/MsWPHuP/+++nRowfp6enmDq3a2L17N88++ywHDx5kx44dFBYW0rVrV3JycswdWrV1+PBhVq5cSbNmzcwdSrV05coV2rZti52dHdu2bePkyZPMnz8fDw8Pc4dWrcyePZt33nmHpUuXcurUKebMmcPcuXN56623zB2aVcvJySEiIoKlS5eWWT9nzhwWLFjA0qVLOXz4ML6+vnTp0sX4fMQ7ThWV1qpVK3XkyJEmZY0aNVJfeuklM0VU/WVmZqqAunv3bnOHUi399ddfamhoqLpjxw61ffv26nPPPWfukKqdSZMmqe3atTN3GNVedHS0GhcXZ1LWp08f9YknnjBTRNUPoG7dutU4bzAYVF9fX/XNN980luXl5anu7u7qO++8c1dikpGZStLpdBw5coSuXbualHft2pX9+/ebKarqLysrCwBPT08zR1I9Pfvss0RHR9O5c2dzh1Jtffrpp7Rs2ZJ+/fpRu3ZtmjdvzqpVq8wdVrXTrl07/vvf//LTTz8B8P3337N371569uxp5siqr9TUVDIyMkz2ixqNhvbt29+1/WK1f9BkVbt06RJ6vR4fHx+Tch8fHzIyMswUVfWmqirjx4+nXbt2hIeHmzucamfjxo0cPXqUw4cPmzuUau3s2bMsX76c8ePHM2XKFA4dOsTYsWPRaDQMGTLE3OFVG5MmTSIrK4tGjRpha2uLXq/njTfe4PHHHzd3aNVW8b6vrP3ir7/+eldikGTmNimKYjKvqmqpMlE1Ro8ezQ8//MDevXvNHUq1c+7cOZ577jm++uorHBwczB1OtWYwGGjZsiWzZs0CoHnz5pw4cYLly5dLMlOFNm3axLp161i/fj1NmjTh+PHjjBs3Dn9/f4YOHWru8Ko1c+4XJZmppFq1amFra1tqFCYzM7NUVir+uTFjxvDpp5+yZ88e6tata+5wqp0jR46QmZnJPffcYyzT6/Xs2bOHpUuXkp+fj62trRkjrD78/Pxo3LixSVlYWBgfffSRmSKqnl544QVeeuklHnvsMQCaNm3Kr7/+Snx8vCQzd4ivry9QNELj5+dnLL+b+0U5Z6aS7O3tueeee9ixY4dJ+Y4dO4iKijJTVNWPqqqMHj2aLVu28PXXXxMUFGTukKqlTp06kZKSwvHjx41Ty5YtGTRoEMePH5dEpgq1bdu21O0FfvrpJwIDA80UUfV07do1bGxMd222trZyafYdFBQUhK+vr8l+UafTsXv37ru2X5SRmdswfvx4Bg8eTMuWLWnTpg0rV64kPT2dkSNHmju0auPZZ59l/fr1fPLJJ7i6uhpHwtzd3XF0dDRzdNWHq6trqfOQnJ2d8fLykvOTqtjzzz9PVFQUs2bNon///hw6dIiVK1eycuVKc4dWrcTExPDGG28QEBBAkyZNOHbsGAsWLCAuLs7coVm1q1ev8ssvvxjnU1NTOX78OJ6engQEBDBu3DhmzZpFaGgooaGhzJo1CycnJwYOHHh3Arwr10xVQ8uWLVMDAwNVe3t7tUWLFnLJcBUDypwSExPNHVq1J5dm3zn/+c9/1PDwcFWj0aiNGjVSV65cae6Qqp3s7Gz1ueeeUwMCAlQHBwc1ODhYffnll9X8/Hxzh2bVdu3aVeZ38tChQ1VVLbo8+9VXX1V9fX1VjUajPvDAA2pKSspdi09RVVW9O2mTEEIIIUTVk3NmhBBCCGHVJJkRQgghhFWTZEYIIYQQVk2SGSGEEEJYNUlmhBBCCGHVJJkRQgghhFWTZEYIIYQQVk2SGSGEEEJYNUlmhBAWKTk5GUVR+PPPP80dihDCwskdgIUQFqFDhw5ERkayaNEioOhBdX/88Qc+Pj4oimLe4IQQFk0eNCmEsEj29vb4+vqaOwwhhBWQw0xCCLOLjY1l9+7dLF68GEVRUBSFNWvWmBxmWrNmDR4eHnz22Wc0bNgQJycnHn30UXJycli7di316tWjZs2ajBkzBr1eb+xbp9Px4osvUqdOHZydnWndujXJycnmeaNCiDtCRmaEEGa3ePFifvrpJ8LDw3nttdcAOHHiRKl2165dY8mSJWzcuJG//vqLPn360KdPHzw8PPjiiy84e/Ysffv2pV27dgwYMACAJ598krS0NDZu3Ii/vz9bt26le/fupKSkEBoaelffpxDizpBkRghhdu7u7tjb2+Pk5GQ8tPS///2vVLuCggKWL19O/fr1AXj00Ud5//33+e2333BxcaFx48Z07NiRXbt2MWDAAM6cOcOGDRs4f/48/v7+AEycOJHt27eTmJjIrFmz7t6bFELcMZLMCCGshpOTkzGRAfDx8aFevXq4uLiYlGVmZgJw9OhRVFWlQYMGJv3k5+fj5eV1d4IWQtxxkswIIayGnZ2dybyiKGWWGQwGAAwGA7a2thw5cgRbW1uTdiUTICGEdZNkRghhEezt7U1O3K0KzZs3R6/Xk5mZyf3331+lfQshLIdczSSEsAj16tXj22+/JS0tjUuXLhlHV/6JBg0aMGjQIIYMGcKWLVtITU3l8OHDzJ49my+++KIKohZCWAJJZoQQFmHixInY2trSuHFjvL29SU9Pr5J+ExMTGTJkCBMmTKBhw4b07t2bb7/9Fq1WWyX9CyHMT+4ALIQQQgirJiMzQgghhLBqkswIIYQQwqpJMiOEEEIIqybJjBBCCCGsmiQzQgghhLBqkswIIcT/t1sHJAAAAACC/r9uR6ArBNZkBgBYkxkAYE1mAIA1mQEA1mQGAFgLiLFkSit7X7AAAAAASUVORK5CYII=\n", - "text/plain": [ - "
" - ] - }, - "metadata": {}, - "output_type": "display_data" - } - ], - "source": [ - "sim.data.where(sim.data['particle_type'] == 'Massive Body',drop=True)['a'].plot(hue=\"name\")" - ] - }, { "cell_type": "code", "execution_count": null, @@ -137,9 +45,9 @@ ], "metadata": { "kernelspec": { - "display_name": "Python (My debug_env Kernel)", + "display_name": "swiftest", "language": "python", - "name": "debug_env" + "name": "swiftest" }, "language_info": { "codemirror_mode": { From 168d2de5a206d4ac7576f57efa8074070d1a2606 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Thu, 17 Nov 2022 19:47:51 -0500 Subject: [PATCH 087/569] Fixed some inconsistencies with the new API and the id vs name dimensioning --- examples/helio_gr_test/init_cond.py | 48 ++++ examples/whm_gr_test/init_cond.py | 226 ++++++++++++++++++ .../whm_gr_test/swiftest_relativity.ipynb | 193 +++++++++++++++ python/swiftest/swiftest/io.py | 24 +- python/swiftest/swiftest/simulation_class.py | 77 ++++-- 5 files changed, 539 insertions(+), 29 deletions(-) create mode 100755 examples/helio_gr_test/init_cond.py create mode 100644 examples/whm_gr_test/init_cond.py create mode 100644 examples/whm_gr_test/swiftest_relativity.ipynb diff --git a/examples/helio_gr_test/init_cond.py b/examples/helio_gr_test/init_cond.py new file mode 100755 index 000000000..9e89dc358 --- /dev/null +++ b/examples/helio_gr_test/init_cond.py @@ -0,0 +1,48 @@ +#!/usr/bin/env python3 +import swiftest + +sim = swiftest.Simulation() +sim.param['PL_IN'] = "pl.swiftest.in" +sim.param['TP_IN'] = "tp.swiftest.in" +sim.param['CB_IN'] = "cb.swiftest.in" +sim.param['BIN_OUT'] = "bin.swiftest.nc" + +sim.param['MU2KG'] = swiftest.MSun +sim.param['TU2S'] = swiftest.YR2S +sim.param['DU2M'] = swiftest.AU2M +sim.param['T0'] = 0.0 +sim.param['DT'] = 0.25 * swiftest.JD2S / swiftest.YR2S +sim.param['TSTOP'] = 1000.0 +sim.param['ISTEP_OUT'] = 1461 +sim.param['ISTEP_DUMP'] = 1461 +sim.param['CHK_QMIN_COORD'] = "HELIO" +sim.param['CHK_QMIN'] = swiftest.RSun / swiftest.AU2M +sim.param['CHK_QMIN_RANGE'] = f"{swiftest.RSun / swiftest.AU2M} 1000.0" +sim.param['CHK_RMIN'] = swiftest.RSun / swiftest.AU2M +sim.param['CHK_RMAX'] = 1000.0 +sim.param['CHK_EJECT'] = 1000.0 +sim.param['OUT_STAT'] = "UNKNOWN" +sim.param['IN_FORM'] = "EL" +sim.param['OUT_FORM'] = "XVEL" +sim.param['OUT_TYPE'] = "NETCDF_DOUBLE" +sim.param['RHILL_PRESENT'] = "YES" +sim.param['GR'] = 'YES' + +bodyid = { + "Sun": 0, + "Mercury": 1, + "Venus": 2, + "Earth": 3, + "Mars": 4, + "Jupiter": 5, + "Saturn": 6, + "Uranus": 7, + "Neptune": 8, +} + +for name, id in bodyid.items(): + sim.add(name, idval=id, date="2027-04-30") + +sim.save("param.swiftest.in") + + diff --git a/examples/whm_gr_test/init_cond.py b/examples/whm_gr_test/init_cond.py new file mode 100644 index 000000000..7904eb100 --- /dev/null +++ b/examples/whm_gr_test/init_cond.py @@ -0,0 +1,226 @@ +import numpy as np +import sys +from astroquery.jplhorizons import Horizons +import astropy.constants as const + +#Values from JPL Horizons +AU2M = const.au.value +GMSunSI = const.GM_sun.value +Rsun = const.R_sun.value +GC = const.G.value +JD = 86400 +year = 365.25 * JD +c = 299792458.0 +MSun_over_Mpl = [6023600.0, + 408523.71, + 328900.56, + 3098708., + 1047.3486, + 3497.898, + 22902.98, + 19412.24, + 1.35e8] + +MU2KG = GMSunSI / GC #Conversion from mass unit to kg +DU2M = AU2M #Conversion from radius unit to centimeters +TU2S = year #Conversion from time unit to seconds +GU = GC / (DU2M**3 / (MU2KG * TU2S**2)) + +GMSun = GMSunSI / (DU2M**3 / TU2S**2) + +t_print = 10.e0 * year / TU2S #output interval to print results +deltaT = 0.25 * JD / TU2S #timestep simulation +end_sim = 1.0e3 * year / TU2S + t_print #end time + +# Solar oblatenes values: From Mecheri et al. (2004), using Corbard (b) 2002 values (Table II) +J2 = 2.198e-7 * (Rsun / DU2M)**2 +J4 = -4.805e-9 * (Rsun / DU2M)**4 + +tstart = '2021-01-28' +tend = '2021-01-29' +tstep = '1d' +planetid = { + 'mercury' : '1', + 'venus' : '2', + 'earthmoon' : '3', + 'mars' : '4', + 'jupiter' : '5', + 'saturn' : '6', + 'uranus' : '7', + 'neptune' : '8', + 'plutocharon' : '9' +} +npl = 9 + +#Planet Msun/M ratio +MSun_over_Mpl = { + 'mercury' : 6023600.0, + 'venus' : 408523.71, + 'earthmoon' : 328900.56, + 'mars' : 3098708., + 'jupiter' : 1047.3486, + 'saturn' : 3497.898, + 'uranus' : 22902.98, + 'neptune' : 19412.24, + 'plutocharon' : 1.35e8 +} + +#Planet radii in meters +Rpl = { + 'mercury' : 2439.4e3, + 'venus' : 6051.8e3, + 'earthmoon' : 6371.0084e3, # Earth only for radius + 'mars' : 3389.50e3, + 'jupiter' : 69911e3, + 'saturn' : 58232.0e3, + 'uranus' : 25362.e3, + 'neptune' : 24622.e3, + 'plutocharon' : 1188.3e3 +} + +pdata = {} +plvec = {} +Rhill = {} + +for key,val in planetid.items(): + pdata[key] = Horizons(id=val, id_type='majorbody',location='@sun', + epochs={'start': tstart, 'stop': tend, + 'step': tstep}) + plvec[key] = np.array([pdata[key].vectors()['x'][0], + pdata[key].vectors()['y'][0], + pdata[key].vectors()['z'][0], + pdata[key].vectors()['vx'][0], + pdata[key].vectors()['vy'][0], + pdata[key].vectors()['vz'][0] + ]) + Rhill[key] = pdata[key].elements()['a'][0] * (3 * MSun_over_Mpl[key])**(-1.0 / 3.0) + + +if __name__ == '__main__': + # Convert from AU-day to AU-year just because I find it easier to keep track of the sim progress + for plid in plvec: + plvec[plid][3:] *= year / JD + + # Names of all output files + swifter_input = "param.swifter.in" + swifter_pl = "pl.swifter.in" + swifter_tp = "tp.swifter.in" + swifter_bin = "bin.swifter.dat" + swifter_enc = "enc.swifter.dat" + + swiftest_input = "param.swiftest.in" + swiftest_pl = "pl.swiftest.in" + swiftest_tp = "tp.swiftest.in" + swiftest_cb = "cb.swiftest.in" + swiftest_bin = "bin.swiftest.dat" + swiftest_enc = "enc.swiftest.dat" + + # Simulation start, stop, and output cadence times + t_0 = 0 # simulation start time + end_sim = 1000.0e0 * year / TU2S # simulation end time + deltaT = 0.25 * JD / TU2S # simulation step size + t_print = 1.0 * year / TU2S #output interval to print results + + iout = int(np.ceil(t_print / deltaT)) + rmin = Rsun / DU2M + rmax = 1000.0 + + #Make Swifter files + plfile = open(swifter_pl, 'w') + print(f'{npl+1} ! Planet input file generated using init_cond.py using JPL Horizons data for the major planets (and Pluto) for epoch {tstart}' ,file=plfile) + print(f'1 {GMSun}',file=plfile) + print(f'0.0 0.0 0.0',file=plfile) + print(f'0.0 0.0 0.0',file=plfile) + for i, plid in enumerate(plvec): + print(f'{i + 2} {GMSun / MSun_over_Mpl[plid]} {Rhill[plid]}', file=plfile) + print(f'{Rpl[plid] / DU2M}', file=plfile) + print(f'{plvec[plid][0]} {plvec[plid][1]} {plvec[plid][2]}', file=plfile) + print(f'{plvec[plid][3]} {plvec[plid][4]} {plvec[plid][5]}', file=plfile) + plfile.close() + + tpfile = open(swifter_tp, 'w') + print(0,file=tpfile) + tpfile.close() + + sys.stdout = open(swifter_input, "w") + print(f'! Swifter input file generated using init_cond.py') + print(f'T0 {t_0} ') + print(f'TSTOP {end_sim}') + print(f'DT {deltaT}') + print(f'PL_IN {swifter_pl}') + print(f'TP_IN {swifter_tp}') + print(f'IN_TYPE ASCII') + print(f'ISTEP_OUT {iout:d}') + print(f'ISTEP_DUMP {iout:d}') + print(f'BIN_OUT {swifter_bin}') + print(f'OUT_TYPE REAL8') + print(f'OUT_FORM EL') + print(f'OUT_STAT NEW') + print(f'J2 {J2}') + print(f'J4 {J4}') + print(f'CHK_CLOSE yes') + print(f'CHK_RMIN {rmin}') + print(f'CHK_RMAX {rmax}') + print(f'CHK_EJECT {rmax}') + print(f'CHK_QMIN {rmin}') + print(f'CHK_QMIN_COORD HELIO') + print(f'CHK_QMIN_RANGE {rmin} {rmax}') + print(f'ENC_OUT {swifter_enc}') + print(f'EXTRA_FORCE no') + print(f'BIG_DISCARD no') + print(f'RHILL_PRESENT yes') + print(f'C {c / (DU2M / TU2S)}') + + #Now make Swiftest files + cbfile = open(swiftest_cb, 'w') + print(f'{1.0}',file=cbfile) + print(f'{rmin}',file=cbfile) + print(f'{J2}',file=cbfile) + print(f'{J4}',file=cbfile) + + plfile = open(swiftest_pl, 'w') + print(npl,file=plfile) + + for i, plid in enumerate(plvec): + print(f'{i + 2} {1.0 / MSun_over_Mpl[plid]}', file=plfile) + print(f'{Rpl[plid] / DU2M}', file=plfile) + print(f'{plvec[plid][0]} {plvec[plid][1]} {plvec[plid][2]}', file=plfile) + print(f'{plvec[plid][3]} {plvec[plid][4]} {plvec[plid][5]}', file=plfile) + plfile.close() + tpfile = open(swiftest_tp, 'w') + print(0,file=tpfile) + tpfile.close() + + sys.stdout = open(swiftest_input, "w") + print(f'! Swiftest input file generated using init_cond.py') + print(f'T0 {t_0} ') + print(f'TSTOP {end_sim}') + print(f'DT {deltaT}') + print(f'CB_IN {swiftest_cb}') + print(f'PL_IN {swiftest_pl}') + print(f'TP_IN {swiftest_tp}') + print(f'IN_TYPE ASCII') + print(f'ISTEP_OUT {iout:d}') + print(f'ISTEP_DUMP {iout:d}') + print(f'BIN_OUT {swiftest_bin}') + print(f'OUT_TYPE REAL8') + print(f'OUT_FORM EL') + print(f'OUT_STAT REPLACE') + print(f'CHK_CLOSE yes') + print(f'CHK_RMIN {rmin}') + print(f'CHK_RMAX {rmax}') + print(f'CHK_EJECT {rmax}') + print(f'CHK_QMIN {rmin}') + print(f'CHK_QMIN_COORD HELIO') + print(f'CHK_QMIN_RANGE {rmin} {rmax}') + print(f'ENC_OUT {swiftest_enc}') + print(f'EXTRA_FORCE no') + print(f'BIG_DISCARD no') + print(f'ROTATION no') + print(f'GR yes') + print(f'MU2KG {MU2KG}') + print(f'DU2M {DU2M}') + print(f'TU2S {TU2S}') + + + sys.stdout = sys.__stdout__ diff --git a/examples/whm_gr_test/swiftest_relativity.ipynb b/examples/whm_gr_test/swiftest_relativity.ipynb new file mode 100644 index 000000000..ae586907c --- /dev/null +++ b/examples/whm_gr_test/swiftest_relativity.ipynb @@ -0,0 +1,193 @@ +{ + "cells": [ + { + "cell_type": "code", + "execution_count": 1, + "metadata": {}, + "outputs": [], + "source": [ + "import numpy as np\n", + "import matplotlib.pyplot as plt\n", + "import pandas as pd\n", + "import swiftest\n", + "from astroquery.jplhorizons import Horizons" + ] + }, + { + "cell_type": "code", + "execution_count": 2, + "metadata": {}, + "outputs": [ + { + "name": "stdout", + "output_type": "stream", + "text": [ + "Reading Swifter file param.swifter.in\n", + "Reading in time 1.000e+03\n", + "Creating Dataset\n", + "Successfully converted 1001 output frames.\n", + "Swifter simulation data stored as xarray DataSet .ds\n" + ] + } + ], + "source": [ + "swiftersim = swiftest.Simulation(param_file=\"param.swifter.in\", codename=\"Swifter\")\n", + "swiftersim.bin2xr()\n", + "swifterdat = swiftersim.ds" + ] + }, + { + "cell_type": "code", + "execution_count": 3, + "metadata": {}, + "outputs": [ + { + "name": "stdout", + "output_type": "stream", + "text": [ + "Reading Swiftest file param.swiftest.in\n", + "Reading in time 1.000e+03\n", + "Creating Dataset\n", + "Successfully converted 1001 output frames.\n", + "Swiftest simulation data stored as xarray DataSet .ds\n" + ] + } + ], + "source": [ + "swiftestsim = swiftest.Simulation(param_file=\"param.swiftest.in\")\n", + "swiftestsim.bin2xr()\n", + "swiftestdat = swiftestsim.ds" + ] + }, + { + "cell_type": "code", + "execution_count": 4, + "metadata": {}, + "outputs": [], + "source": [ + "swifterdat['varpi'] = swifterdat['omega'] + swifterdat['capom']\n", + "swiftestdat['varpi'] = swiftestdat['omega'] + swiftestdat['capom']" + ] + }, + { + "cell_type": "code", + "execution_count": 5, + "metadata": {}, + "outputs": [], + "source": [ + "obj = Horizons(id='1', id_type='majorbody',location='@sun',\n", + " epochs={'start':'2021-01-28', 'stop':'3021-02-05',\n", + " 'step':'1y'})\n", + "el = obj.elements()\n", + "t = (el['datetime_jd']-el['datetime_jd'][0]) / 365.25\n", + "varpi_obs = el['w'] + el['Omega']" + ] + }, + { + "cell_type": "code", + "execution_count": 6, + "metadata": {}, + "outputs": [], + "source": [ + "varpiswiftest = swiftestdat['varpi'].sel(id=2) * 180.0 / np.pi\n", + "varpiswifter = swifterdat['varpi'].sel(id=2) * 180.0 / np.pi\n", + "tsim = swiftestdat['time']" + ] + }, + { + "cell_type": "code", + "execution_count": 7, + "metadata": {}, + "outputs": [], + "source": [ + "dvarpi_swiftest = np.diff(varpiswiftest) * 3600 * 100 \n", + "dvarpi_swifter = np.diff(varpiswifter) * 3600 * 100 \n", + "dvarpi_obs = np.diff(varpi_obs) / np.diff(t) * 3600 * 100 " + ] + }, + { + "cell_type": "code", + "execution_count": 8, + "metadata": {}, + "outputs": [ + { + "name": "stdout", + "output_type": "stream", + "text": [ + "Mean precession rate for Mercury long. peri. (arcsec/100 y)\n", + "JPL Horizons : 571.3210506300043\n", + "Swifter GR : 571.1981012667947\n", + "Swiftest GR : 1.5844780122245083\n", + "Obs - Swifter : 0.12294936320971743\n", + "Obs - Swiftest : 569.7365726177798\n", + "Swiftest - Swifter: -569.61362325457\n" + ] + }, + { + "data": { + "image/png": "iVBORw0KGgoAAAANSUhEUgAAAYIAAAEGCAYAAABo25JHAAAAOXRFWHRTb2Z0d2FyZQBNYXRwbG90bGliIHZlcnNpb24zLjMuNCwgaHR0cHM6Ly9tYXRwbG90bGliLm9yZy8QVMy6AAAACXBIWXMAAAsTAAALEwEAmpwYAAArP0lEQVR4nO3deXyV5bnv/8+VmTlzyACEeRQjRHCoioh2a1Grp93V7T6V9rSW396n7a4vh7pb3W5ObbU/W92ttW51O/xOu6mtY4/WrW1tHfqzIiCiDDEEApkISSAMCSHTdf5YixgwQBYkayV5vu/XK6+s536m616Bda3nvp/nvs3dERGR4IqLdQAiIhJbSgQiIgGnRCAiEnBKBCIiAadEICIScAmxDuBkZGZmemFhYazDEBEZVNasWVPv7llHlw/KRFBYWMjq1atjHYaIyKBiZtt7KlfTkIhIwCkRiIgEnBKBiEjAKRGIiAScEoGISMApEYiIBJwSgYhIwEXtOQIzmw481a1oEnAH8CfgIWAkUA5c5+77ohWXiMhA5e7sbqijpnI7+yvWE1/zHvmX3UJ+wfg+PU/UEoG7lwBFAGYWD1QBzwFPAze5++tm9mXgZuD2aMUlIhJrB/btprZ8M3u2vUfb7h3E793B6KZtjGrfTb7XkhHers3j2fTRuYM3ERzlIqDM3beHrxTeCJf/HngFJQIRGUIOtTSzb0899RWl7K/aSEfDVuIO7iZnzxpGdu4nk0ZGhrftdKPe0qhPyqd2xAyqcz7PiKwJjBl/GlnjZzB3ZFqfxxerRHANsDL8+kPgCuAF4PPAuJ52MLMbgBsAxo/v22woInKqOtrb2bOrksa6Khp2bCSu6l06Ww+Svncjee2VZFkLhwf5afc4mi2F8pSZ1CbPoTR9Mgmp+WTPPJdRqVlkZ+eRHcXYLdpTVZpZElANzHb3WjObAfwEyAB+C3zD3TOOd4zi4mLXWEMiEnXu7GmopXTT+yTu205HXSnJez5iZHMlaW07SeVA16YtnshBS2FnUiH7RxbC2NOIH57O2Jlnk5FbSMrwkcc+Tz8xszXuXnx0eSyuCC4F1rp7LYC7bwYuATCzacBnYhCTiAgAba2HqK/eRmPNVg7sLKN9TwUJe7eRdqCM7I4a0mhmQXjbDjeqLIe6pALq06bTObaIhFFZZBXOInfyaaQlD6fvG3L6XiwSwbV83CyEmWW7+y4ziwO+S+gOIhGRfuOdndTXVrK7agt7y9fR2bCVpH3lpB2sYHzHdnLNye22/S7S2ZkykY1pp0NaIakFM0nInEz2+KmMHzWawd5YHdVEYGbDgYuBr3UrvtbM/jH8+lng8WjGJCJDk3d2UvbhX2naXcPBqg0k7NtByp6PSG7fz6SObWSZd7XZt3oCtXHZ7EnOZ1XGhcSlT2RYViFp+VPIzp9IdsrwqLbZR1vU+wj6gvoIROSw8k2raawqpbm2lNb9DWTuXkdqWy05nbtItI6u7do8nq2JU7CEZPakzYUxBSSmjyNz4lzGTZ6DxQ3952sHUh+BiEivdR5qpn7HJnbt2klT9WasvoQR+8rIailndOdeCq3tiO3L4idTN3wSlamXEJ8xmZH5M0nLm0R23kSmx8fHqBYDmxKBiMRcc/MBqkrWsr++ggM1pdBQxujWXWQe2kFeRw3Z5l1NM82eTGX8OCqGz6RtRD6WOYXUSfPILZzF6NGjmZw0IqZ1GYyUCEQkKvY3NlC7o4R9FRtg/05aa0sYdaCckW31jPU6plr7x9sygrq4LHamTGbrmL/BsqeTmpFL5oQZZBdMYZq+2fcpJQIR6TON9bU072ugeuNfONRYQ8fuHeTs/5DMthrG+D6mWGfXtnsZQU3iBPaMnknD6CXYuAWMyBpP/sRZjErNYpQZk2JYlyBRIhCRiFRv20zzvgYaKzbQtrOEzsYKRrdUkd1eTQ67SQXywtu2kER5wkS2pJ1H5/Asksedzpj8mSRnjCMvZyxj4od+B+1goEQgIkfwzk721Newq3wDB3aVc6huKykNmxjRUkta+y7yaOjattONhrh0DiaMoTq1mO3p0/Bh6WRMXUD2hOmMTs1ihlkMayO9oUQgEkCdHR3sqtlOw47NHNq1hc6GrSTsLSftwBZGde4lnX2kd9u+2nLYk5jNjjHz2ZY9h6T08aSOm0lqVgFZOQUAg/6hqiBTIhAZojra29m5o5TdFZto3lmK795G8v7tpLZUkttRw1hrY2x42zaPp8ay2D2skNrk0+jMmklS5kTSx81gTGYeedn5Xc09MvQoEYgMYt7Zya7qbVRvfJvWvTvprN9CclMVww41UNC2lXwOkh/etsUT2RmfS2NKAbtGn4ulT2L42KmMzJ1GzrgpjE9J1rf6gFIiEBngvLOTloNNVJW8y77ydbTWlTG6fh1pbbWkeyM51kZOeNsWT6Q+LpP9CelsSl8C+cWMzJtO1vgZZOaOpzBOt13KJykRiMSYu7OvsZ62g03UV3xE45a/wr5qUvaXM7y1gcK2rQyzdqaEt2/1BHYkTKByzBlsH5YFo3NJn3EeozJyySmYQoHusZcIKRGIRElHexu1O0rZU13KnqotJNRtYPiBcsa01jKhsxKAzPC2rR5PTVwuBxIzWJvz3/CUVBLz55I5eT75hVOZkqD/utJ39K9JpA913Xq57UP2V20OTVyybyvpB3eQ21FDnrV3dbo2ezLVCQU0JudRnX05ccPTGJY9iYwJs8ifNJsJMa2JBIkSgUiEDjbtp7GmjJ1bP6Szci1JByoY1lRJ2qFqRngT6dbWdetlqydQHZ9LQ8oEqscsIj5rKsNzJpOVP5mc8dOZEoARL2XgUyIQ6YF3dtBQs4Oq0rUc3LGOlF3vMfrQTsa01pLG/q6JSzrc2EkGdQm51I0+C0seBWmFDMudQeaEWeSMm0phYiKFsa6QyHEoEUhgtbe1sWPrJurK3oN91cRXryax7QBjDlUxtmMnmdbW1WZfRQ47Ewuoy5iJjc6lM3USo7LGMb5oEdkpw8jXUAkyiCkRyJDW2LiHnVvX07j5zdCH/cE6Upu2kdNeRaK3M8lauwY2a2AM++LS2JMyjppRnwrNUpUzhbwZC8jLzidfzTgyRCkRyKC3t6GWmqrt7N+xHna+D/t2En+wgbFt28mjntTwdoc8kd2Wyt7ETDalX4wnDicpdxYZE4tITs8jO28iGbr1UgIoaonAzKYDT3UrmgTcAfyZ0IT1KUA78A/uvipacckg4M7e+ip2bV1P465K2nd9ROLebYxoriKzvYYsGhkT3rTV46mPy+BQwmh2pZ5BddpUEnNnkjVtIbnjp5IbF3fEpOQiEsVE4O4lQBGAmcUDVcBzwCPAv7r7y2Z2GfBDYFG04pKBoaOjk/rGRho2/JlDtSX47nIS91cw6mAlOR07GcOhrg/7Djd2xmWzN2ksO0adw9aM6QzPHMeYcbPInlxEXsqwmNZFZLCJVdPQRUCZu283MwdGh8vHANUxikn6WUd7Owf276Hmo7Xs31lGR80H0NFG+p73KWwrI8c6uoZKaPJkauLGUp+cR1X6WVhaIcNyppKRN4Gc8VPJH5HWNYaOiJyaWCWCa4CV4df/BLxiZvcCccA5Pe1gZjcANwCMH6+hsQaqto5OKnfuoqZ8E4l1m+ioeZ/4lt2Maqogv62cMXbwiGacTuLYmjyDtXnXkDwyncTc2aRNO5fMnDymJKoLSyQazN2je0KzJELf+me7e62Z/QR43d2fMbO/BW5w9yXHO0ZxcbGvXr06GuFKD9raO6ip2k59xWaaakrpbNhG4r7tjGmpYmxHDRm2r2vbQ57IXhtFXVI+B0ZOpDN9KsmZE0gtmMGEGfOJi4vDdDeOSFSY2Rp3Lz66PBZfuS4F1rp7bXj5euCb4de/AR6NQUxylNZDLdRWlLK7ooTm2lK8YRspB3aQ2lLF2M5axtuhriGLO9yoj8+iMTmfylEXUpU+kRFjpxKXNZXx0+eTnZBAdkxrIyLHE4tEcC0fNwtB6OrgAkJ3Dy0GSmMQUyC1t7WyfdNqDjXvY9/WNdjuMlKaKhjZWseE9u2Ms07Ghbc96EnUJoxl3/ACNo4+h7j0SYzMnUrmuBmk5U8mJyG5q31fRAaXqCYCMxsOXAx8rVvxV4F/M7MEoIVwP4D0jfb2DrZ88Ff2NdTQuXsrvqeCEXs2knGogqzOBiZbe9e2zZ5MTXwezYlpvDv2AuIzpzAqbyrZ42eSnjOOQjXhiAxJUU0E7t4MZBxV9hYwP5pxDDVtrYeo3LKexsoSDtV+BE31jNizifxDW0jwdmZY88fbejzbEwrZNWwyFaOXkJB/OgnDx5A/8yzSswuYrOGNRQJH/+sHiX2NDTRUb+VAQzVNFR8QV7eJUQe2kdNWwShvYqJ1dG17eOKSsjFn0ZkwnKRx80kfN50RuVMZNiqdKaNSY1cRERlwlAgGkKb9jdRs3cC+6o9ord9GfMNHDDtYQ/ahHWSzu+thC4A9jKYmcTxb0s6nY1gGibmzGZZeQMGshSSnDGPKsBExq4eIDC5KBFHk7uzZ3UBDxSYat66lfU8F8furGNVUTlpbHWOp65qOEEKDoNUl5LF9TDFlGTNIyphA8ugscqfNJyOngLSY1UREhhIlgj7mnZ007KqkqbGe+q3v01qzgYSD9WTv+4DU1p2kc6Br0pJONxoslfrEPKpHzmRb+lUk585idN40ssZPJyMt88gOFRGRfqBEcBK8s5Nd1dvYu6uC/TvLaCt/h8TmWka21DC6fTe51JEJTADaPY4DDKcyYRyVaUtIyphAQuZEsqacSfa4KWQlp5AV6wqJSKApERzD4blnq0tWc3B3FS27q0mo30Tewc2M6DxADo1d9823egK1cdnsS8ykZuQstucWE5cyivTJxWQXziQ1NbNrKGQRkYEm8ImgsX4nO7d+wP7qj2iv30LS3nJGN+8gp6OadJq7mnEA9tgYKobNoC5hFFty55GUmkfahDlk5E1iXKoacURkcApUIlj3h5W0lPyR5KZqhrXtIaetkjT2dX1b73CjNi6b+uQCNqXNxdMnMTx3JmnjppOelU/amHR10IrIkBOoRNDy0Z84bdf/oS4+i6aEdErTL6AzYyrDcqeTPm4mOeOnk5ecQl6sAxURiaJAJYL5X/kpCQkPaagEEZFuApUIEpOSYx2CiMiAo6/GIiIBp0QgIhJwSgQiIgGnRCAiEnBKBCIiAadEICIScEoEIiIBF7XnCMxsOvBUt6JJwB3A2cD0cFkq0OjuRdGKS0Qk6KKWCNy9BCgCMLN4oAp4zt3vP7yNmf0I2ButmEREJHZPFl8ElLn79sMFZmbA3wKLYxSTiEggxaqP4Bpg5VFl5wG17l4ag3hERAIr6onAzJKAK4DfHLXqWj6ZHLrvd4OZrTaz1XV1df0ZoohIoMTiiuBSYK271x4uMLME4GqO7Ew+grs/7O7F7l6claXJHUVE+kosEkFP3/yXAJvdvTIG8YiIBFrEicDMRoTv+omYmQ0HLgaePWpVT30GIiISBSe8a8jM4gh9UF8HnAkcApLNrA74HfBwbzt43b0Z+MTkvu6+LIKYRUSkD/XmiuBPwGTgNmCsu49z92xCd/n8FbjbzP6+H2MUEZF+1JvnCJa4e9vRhe6+G3gGeMbMEvs8MhERiYoTXhH0lAROZhsRERmYev1ksZnd2EPxXmCNu6/rs4hERCSqIrlrqBhYDuSHf24AFgGPmNktfR+aiIhEQyRjDWUA89z9AICZ/QvwNHA+sAb4Yd+HJyIi/S2SK4LxQGu35TZggrsfJHRLqYiIDEKRXBH8J/BXM3shvHw5sNLMRgAb+zwyERGJil4nAnf/X2b2O+BTgAHL3X11ePV1/RGciIj0v143DYXnC5gJjAlPJrPLzBb0V2AiIhIdkfQRPEhoWslrw8v7gZ/1eUQiIhJVkfQRLHT3eWb2HoC77wnPLSAiIoNYJFcEbeFRRx3AzLKAzn6JSkREoiaSK4KfAM8BOWZ2F/A54Lv9EpWIDGptbW1UVlbS0tIS61ACKSUlhYKCAhITezcMXCR3Df3SzNYQmnge4LPuvukkYhSRIa6yspJRo0ZRWFhI6D4TiRZ3p6GhgcrKSiZOnNirfXozH0FPYwwBXGpml7r7jyMJUkSGvpaWFiWBGDEzMjIyiGRu995cEYwK/55OaGKa34aXLwfeiChCEQkMJYHYifS9P2EicPd/DR/4VUJjDe0PL98J/CbyEEVEZCA5lbGGWoHC3u5sZtPNbF23n31m9k/hdV83sxIz22BmGrxORPrEyJEjKS8vZ9iwYRQVFTFr1iyWL19OZ2cn5eXlzJkz57j733nnndx7771HlBUWFlJfXx9RHJdddhmNjY2Rhh81kdw19L+BVWb2HKFbSK8Cnuztzu5eAhQBhG9DrQKeM7MLgSuBue5+yMyyI4hJROSEJk+ezLp162hvb2fx4sU8//zzzJs3r9/P6+64O7/73e/6/VynotdXBO5+F/AlYA/QCHzJ3X9wkue9CChz9+3A/wPc7e6HwufZdZLHFBE5roSEBM455xy2bNnSJ8f78Y9/zJw5c5gzZw73338/AOXl5cycOZN/+Id/YN68eVRUVHRdRTz00EMUFRVRVFTExIkTufDCCwFYuXIlp512GnPmzOHWW2/tOv7IkSP5zne+w+mnn85ZZ51FbW0tAL/5zW+YM2cOp59+Oueff/4p16M3dw2ZuzuAu68F1h5vm166BlgZfj0NOC/8bEILcJO7vxvBsURkAPvX/7OBjdX7+vSYs/JG8y+Xz454v+bmZv74xz+yYsWKXu9z33338Ytf/KJrubq6GoA1a9bw+OOP88477+DuLFy4kAsuuIC0tDRKSkp4/PHHefDBB4841vLly1m+fDltbW0sXryYG2+8kerqam699VbWrFlDWloal1xyCc8//zyf/exnaWpq4qyzzuKuu+7illtu4ZFHHuG73/0uK1as4JVXXiE/P79Pmpx6c0Xwp3Ab/vjuhWaWZGaLzexJ4PrenjA8LMUVfNzRnACkAWcBNwO/th66vM3sBjNbbWarI7ktSkSkrKyMoqIizj33XD7zmc9w6aWX9nrfb33rW6xbt67rJy8vD4C33nqLq666ihEjRjBy5Eiuvvpq3nzzTQAmTJjAWWeddcxjfvOb32Tx4sVcfvnlvPvuuyxatIisrCwSEhK47rrreOON0A2ZSUlJLF26FID58+dTXl4OwLnnnsuyZct45JFH6OjoOJm35Ai96SP4G+DLhOYemEioWWgYoSTyKnBfhHMWXwqsdffa8HIl8Gz4imKVmXUCmcARn/bu/jDwMEBxcXEkVx8iEkMn8829rx3uI+hLx2sEGTFixDHXPfHEE2zfvp0HHnjghMdJTEzsuhU0Pj6e9vZ2AB566CHeeecdXnrpJYqKili3bh0ZGRknUw2gF1cE7t7i7g+6+7nABELt+2e4+wR3/+pJTFx/LR83CwE8DywGMLNpQBIQWZe8iEiUnX/++Tz//PM0NzfT1NTEc889x3nnnXfcfdasWcO9997LL37xC+LiQh+/Cxcu5PXXX6e+vp6Ojg5WrlzJBRdccNzjlJWVsXDhQlasWEFmZiYVFRWnVJdI7hrC3duAmpM9mZkNBy4Gvtat+DHgMTP7kNAtqddH2N8gIvIJ7e3tJCcnH3ebkpISCgoKupbvu+8+Pv/5z/fq+PPmzWPZsmUsWBCaluUrX/kKZ5xxRlfzTU8eeOABdu/e3dVJXFxczKOPPsoPfvADLrzwQtydyy67jCuvvPK457755pspLS3F3bnooos4/fTTexXzsdhg/MwtLi721atXn3hDEYmJTZs2MXPmzJjG8P777/PVr36VVatWxTSOWOnpb2Bma9y9+OhtI3mgTERkUHjooYe49tpr+d73vhfrUAaFSKaq/B/9GYiISF9Zvnw5Gzdu5JJLLol1KINCJH0EPzKz64B2YBWw0t039E9YIiISLZE0DTUA3wN+DBwgdL//146/i4iIDHSRXBHsdffXwq//y8z+DXgH+Pe+D0tERKIlottHAczsVkIPfI0B9vd5RCIiElUnc9fQM8AWoAD4ft+GIyLSN+666y5mz57N3LlzKSoq4p133unVfnfccQd/+MMfAHjzzTeZPXs2RUVFvP32230yimhtbS1/93d/x6RJk5g/fz5nn302zz33HAB//vOfGTNmDGeccQYzZszgpptuOuXz9UYkiSDNzMa5+xZ3/3dgKUoEIjIAvf3227z44ousXbuW9evX84c//IFx48b1at8VK1awZMkSAH75y19y0003sW7dOkpKSiJOBIeHhDjM3fnsZz/L+eefz9atW1mzZg2/+tWvqKys7NrmvPPO47333uO9997jxRdf5C9/+UtE5zwZkTQNjQb+bGb1wEYgFTj10Y5ERPpYTU0NmZmZXU8WZ2ZmArBq1Sruvvtunn32WV544QWuueYa9u7dS2dnJ7NmzWLr1q0sW7aMpUuX0tjYyK9//WteeeUVXn31Vf7yl79w8OBB3nrrLW677TaWLl3K17/+dT744APa29u58847ufLKK3niiSd46aWXaGlpoampiddee60rrtdee42kpCSWL1/eVTZhwgS+/vWvf6IOhyfTqaqq6ud3K7JEcCHwIbCQ0PzFDrzUH0GJyBDy8rdh5wd9e8yxp8Gldx9z9SWXXMKKFSuYNm0aS5Ys4Qtf+AIXXHAB8+bN47333gNCzT5z5szh3Xffpb29nYULFx5xjK985Su89dZbLF26lM997nM88cQTrF69umuwuH/+539m8eLFPPbYYzQ2NrJgwYKuK4m3336b9evXk56efsQxN2zY0OsJcfbs2UNpaWmfzDdwIpFMTLPe3Tvd/W13f8Ldn3R3DQ4nIgPOyJEjWbNmDQ8//DBZWVl84Qtf4IknniAhIYEpU6awadMmVq1axY033sgbb7zBm2++ecIB44726quvcvfdd1NUVMSiRYtoaWlhx44dAFx88cWfSAI9+cd//EdOP/10zjzzzK6yN998k7lz5zJ27FiWLl3K2LFjI6v8SYj4riERkYgc55t7f4qPj2fRokUsWrSI0047jSeffJJly5Zx3nnn8fLLL5OYmMiSJUtYtmwZHR0dn5ib+ETcnWeeeYbp06cfUf7OO+8ccxjq2bNn88wzz3Qt/+xnP6O+vp7i4o+H/znvvPN48cUX+eijj/jUpz7FVVddRVFRUUSxRUpjDYnIkFNSUkJpaWnX8rp165gwYQIQGj76/vvv5+yzzyYrK4uGhgY2b97M7NnHnzdh1KhR7N//8R3zn/70p/npT3/aNZ/A4San41m8eDEtLS38/Oc/7yprbm7ucdtp06Zx2223cc8995zwuKcqkrGG/qeZpfVnMCIifeHAgQNcf/31zJo1i7lz57Jx40buvPNOIDT+f21tbVfb+9y5c5k7dy49TIx4hAsvvJCNGzdSVFTEU089xe23305bWxtz585lzpw53H777SeMy8x4/vnnef3115k4cSILFizg+uuvP+aH/fLly3njjTfYtm1bZG9AhHo9DLWZfY/QXMNrCc0h8Eqs5g3QMNQiA9tAGIY66PplGGp3/y4wFfgPYBlQambfN7PJpxauiIjEUkR9BOErgJ3hn3ZCk84/bWY/7IfYREQkCnp915CZfQO4ntB8wo8CN7t7m5nFAaXALf0TooiI9KdeJQIL9aKcDlzt7tu7r3P3TjNb2h/BiYhI/+tVInB3N7Mzjk4C3dZvOtExzGw68FS3oknAHYSGqvgqUBcu/2d3P/WRnUREpFci6SN428zOPPFmPXP3EncvcvciYD7QDDwXXn3f4XVKAiIi0RVJIrgQ+KuZlZnZejP7wMzWn+R5LwLKjnWFISJyqgbSMNSNjY08+OCDx1wf66GpI0kElxJqzlkMXE5oGOrLT/K81wAruy3/z3ByeexYD62Z2Q1mttrMVtfV1fW0iYgIMHCGoT7seIlgIAxNHUkiuP4YPxExsyTgCuA34aKfA5OBIqAG+FFP+7n7w+5e7O7FWVlZkZ5WRAKkp2Go8/LyWLVqFVdffTUAL7zwAsOGDaO1tZWWlhYmTZoEwLJly3j66ad59NFH+fWvf82KFSu49tprueOOO3jqqae6nixuamriy1/+MmeeeSZnnHEGL7zwAhAaYXTBggUUFRUxd+5cSktL+fa3v01ZWRlFRUXcfPPNR8Q6EIamjmTQuaZur1MIXRGcsJO4B5cCa929FuDwbwAzewR48SSOKSID1D2r7mHz7s19eswZ6TO4dcGtx1wfy2GoH3roIb75zW9y3XXX0draSkdHB3fffTcffvgh69at+0SsA2Fo6kieLP5Rt5+7gEVA/kmc81q6NQuZWW63dVcRmvNAROSkxXIY6rPPPpvvf//73HPPPWzfvp1hw4ZFdNxYDE19KsNQDyfUZ9BrZjYcuBj4WrfiH5pZEaGJbsqPWicig9zxvrn3p1gNQz1z5kwWLlzISy+9xKc//WkeffTRrmanngyEoakjGX30g3CH7noz2wCUAP8WycncvdndM9x9b7ey/+7up7n7XHe/wt1rIjmmiMjRYjkM9datW5k0aRLf+MY3uOKKK1i/fv0n9u1uIAxNHUln8eG7hC4HLgHy3P2BPo1GRKQPxHIY6qeeeoo5c+ZQVFTE5s2b+eIXv0hGRgbnnnsuc+bM+URn8UAYmrrXw1APJBqGWmRg0zDUsdcvw1Cb2ZNmltptOc3MHjuVQEVEJPYiaRqa6+6NhxfcfQ9wRp9HJCIiURVJIojr/tSvmaVzancdicgQNhibnYeKSN/7SD7IfwT8/2b2NKFbPf8WuCuis4lIIKSkpNDQ0EBGRsYJO2Glb7k7DQ0NpKSk9HqfSOYj+BOwmtBYQ0ZoboKNJxOoiAxtBQUFVFZWonHBYiMlJYWCgoJebx/JfATPu/t8QB/+InJciYmJTJw4MdZhSC9F0kfw11OZj0BERAamSPoILgSWm1k5oQHojNDFwtz+CExERKIjkkRwab9FISIiMRNJ09AO4Dzg+vDMYg7k9EtUIiISNZEkggeBswkNIw2wH/hZn0ckIiJRFUnT0EJ3n2dm70HoyeLwbGMiIjKIRXJF0GZm8YSahDCzLKCzX6ISEZGoiSQR/AR4Dsgxs7uAt4Af9EtUIiISNb1uGnL3X5rZGuCicNGV7t63E5GKiEjUnTARmNlvjy4K//60meHuV/R9WCIiEi29uSI4G6ggNOH8O3ycCCJiZtOBp7oVTQLucPf7w+tvAv5fIMvd60/mHCIiErneJIKxhCacvxb4O+AlYKW7b4jkRO5eAhQBhDudqwj1OWBm48Ln2BHJMUVE5NSdsLPY3Tvc/b/c/XrgLGAL8Gcz+/opnPcioCz8YBrAfcAthO9IEhGR6OntMNTJwGcIXRUUErqD6NlTOO81hJqaMLMrgCp3f/9445ab2Q3ADQDjx48/hVOLiEh3J5y83syeBOYALwO/cvcPT+mEoYfQqoHZhJ5O/hNwibvvDQ9oV3yiPgJNXi8iErljTV7fmyuC/05otNFpwDe6fWs/PPro6AhjuRRY6+61ZnYaMBE4fDVQAKw1swXuvjPC44qIyEk4YSJw90geOuuNawk3C7n7B0D24RW9vSIQEZG+09cf8sdlZsMJ3R10Kv0LIiLShyIZdO6UuXszkHGc9YXRi0ZERCDKVwQiIjLwKBGIiAScEoGISMApEYiIBJwSgYhIwCkRiIgEnBKBiEjAKRGIiAScEoGISMApEYiIBJwSgYhIwCkRiIgEnBKBiEjAKRGIiAScEoGISMApEYiIBJwSgYhIwCkRiIgEXNSmqjSz6cBT3YomAXcQmrrySqAT2AUsc/fqaMUlIhJ0UUsE7l4CFAGYWTxQBTwH7HH328Pl3yCUHJZHKy4RkaCL6uT13VwElLn79qPKRwAeg3hERAIrVongGmDl4QUzuwv4IrAXuLCnHczsBuAGgPHjx0chRBGRYDD36H4BN7MkoBqY7e61R627DUhx93853jGKi4t99erV/RiliMjQY2Zr3L346PJY3DV0KbD26CQQ9p/Af4tyPCIigRaLRHAtRzYLTe227gpgc9QjEhEJsKj2EZjZcOBi4Gvdiu8O31raCWxHdwyJiERVVBOBuzcTem6ge5magkREYkhPFouIBJwSgYhIwCkRiIgEnBKBiEjAKRGIiAScEoGISMApEYiIBJwSgYhIwCkRiIgEnBKBiEjAKRGIiAScEoGISMApEYiIBJwSgYhIwCkRiIgEnBKBiEjAKRGIiAScEoGISMBFbarK8LzET3UrmgTcAeQDlwOtQBnwJXdvjFZcIiJBF7UrAncvcfcidy8C5gPNwHPA74E57j4X+Ai4LVoxiYhI7JqGLgLK3H27u7/q7u3h8r8CBTGKSUQkkGKVCK4BVvZQ/mXg5Z52MLMbzGy1ma2uq6vr1+BERIIk6onAzJKAK4DfHFX+HaAd+GVP+7n7w+5e7O7FWVlZ/R+oiEhARK2zuJtLgbXuXnu4wMyuB5YCF7m7xyAmEZHAikUiuJZuzUJm9jfArcAF7t4cg3hERAItqk1DZjYcuBh4tlvxA8Ao4Pdmts7MHopmTCIiQRfVK4LwN/6Mo8qmROv8D73/EL/b9ju6tz453rV8+LXTbf1Ry0c77rpjtHIdb5/jr4r8eMdraTtuHH18vD5/n6JlQIQQ+yAGRAwDoNV4ILwP9194P+fkndOnx4xF01DMZA/PZmrqVMwMwwBCv42Pl8PrDMPMuvY9vL4n3bf7xLpj7Hcy+xzPyR7vZOvV18c7mfcpWk7m7zEU6W8xMGIYO2Jsnx8zUIng6qlXc/XUq2MdhojIgKKxhkREAk6JQEQk4JQIREQCTolARCTglAhERAJOiUBEJOCUCEREAk6JQEQk4GwgPLYdKTOrA7af5O6ZQH0fhjMYqM7BoDoHw6nUeYK7f2Ic/0GZCE6Fma129+JYxxFNqnMwqM7B0B91VtOQiEjAKRGIiARcEBPBw7EOIAZU52BQnYOhz+scuD4CERE5UhCvCEREpBslAhGRgAtUIjCzvzGzEjPbYmbfjnU8fcHMxpnZn8xsk5ltMLNvhsvTzez3ZlYa/p3WbZ/bwu9BiZl9OnbRnxozizez98zsxfDykK6zmaWa2dNmtjn89z47AHX+Vvjf9YdmttLMUoZanc3sMTPbZWYfdiuLuI5mNt/MPgiv+4lFMqWcuwfiB4gHyoBJQBLwPjAr1nH1Qb1ygXnh16OAj4BZwA+Bb4fLvw3cE349K1z3ZGBi+D2Jj3U9TrLuNwL/CbwYXh7SdQaeBL4Sfp0EpA7lOgP5wDZgWHj518CyoVZn4HxgHvBht7KI6wisAs4GDHgZuLS3MQTpimABsMXdt7p7K/Ar4MoYx3TK3L3G3deGX+8HNhH6D3QloQ8Owr8/G359JfArdz/k7tuALYTem0HFzAqAzwCPdisesnU2s9GEPjD+A8DdW929kSFc57AEYJiZJQDDgWqGWJ3d/Q1g91HFEdXRzHKB0e7+toeywv/XbZ8TClIiyAcqui1XhsuGDDMrBM4A3gFy3L0GQskCyA5vNlTeh/uBW4DObmVDuc6TgDrg8XBz2KNmNoIhXGd3rwLuBXYANcBed3+VIVznbiKtY3749dHlvRKkRNBTe9mQuXfWzEYCzwD/5O77jrdpD2WD6n0ws6XALndf09tdeigbVHUm9M14HvBzdz8DaCLUZHAsg77O4XbxKwk1geQBI8zs74+3Sw9lg6rOvXCsOp5S3YOUCCqBcd2WCwhdZg56ZpZIKAn80t2fDRfXhi8XCf/eFS4fCu/DucAVZlZOqIlvsZn9gqFd50qg0t3fCS8/TSgxDOU6LwG2uXudu7cBzwLnMLTrfFikdawMvz66vFeClAjeBaaa2UQzSwKuAX4b45hOWfjOgP8ANrn7j7ut+i1wffj19cAL3cqvMbNkM5sITCXUyTRouPtt7l7g7oWE/o6vufvfM7TrvBOoMLPp4aKLgI0M4ToTahI6y8yGh/+dX0SoD2wo1/mwiOoYbj7ab2Znhd+rL3bb58Ri3WMe5d75ywjdVVMGfCfW8fRRnT5F6BJwPbAu/HMZkAH8ESgN/07vts93wu9BCRHcWTAQf4BFfHzX0JCuM1AErA7/rZ8H0gJQ538FNgMfAv+b0N0yQ6rOwEpCfSBthL7Z/4+TqSNQHH6fyoAHCI8c0ZsfDTEhIhJwQWoaEhGRHigRiIgEnBKBiEjAKRGIiAScEoGISMApEUigmVmGma0L/+w0s6rw6wNm9mA/nfOfzOyLJ9jmV2Y2tT/OL3I03T4qEmZmdwIH3P3efjxHArCW0Iix7cfZ7gLg7939q/0Vi8hhuiIQ6YGZLeo2z8GdZvakmb1qZuVmdrWZ/TA89vt/hYf4ODwe/OtmtsbMXjk8RMBRFgNr3b3dzCab2dpu55xqZofHT3oTWBJOHCL9SolApHcmExr2+krgF8Cf3P004CDwmXAy+CnwOXefDzwG3NXDcc4F1gC4exmw18yKwuu+BDwRXtdJaIjh0/upPiJd9G1DpHdedvc2M/uA0CRH/xUu/wAoBKYDc4DfhyeGiic0bMDRcgmNl3PYo8CXzOxG4AscOX7+LkKjbvZ2lFWRk6JEINI7hyD0Td3M2vzjzrVOQv+PDNjg7mef4DgHgZRuy88A/wK8Bqxx94Zu61LC24v0KzUNifSNEiDLzM6G0NDgZja7h+02AVMOL7h7C/AK8HPg8aO2nQZs6J9wRT6mRCDSBzw0/enngHvM7H1Co8Ce08OmLxOacrK7XxIaQfbVwwVmlgMc9PAsVSL9SbePikSZmT0H3OLupeHlm4Ax7n57t22+Bexz9/+IUZgSIOojEIm+bxPqNC4NJ4XJhG4r7a6R0Pj7Iv1OVwQiIgGnPgIRkYBTIhARCTglAhGRgFMiEBEJOCUCEZGA+7+0PkMTQghxhAAAAABJRU5ErkJggg==\n", + "text/plain": [ + "
" + ] + }, + "metadata": { + "needs_background": "light" + }, + "output_type": "display_data" + } + ], + "source": [ + "fig, ax = plt.subplots()\n", + "\n", + "ax.plot(t, varpi_obs, label=\"JPL Horizons\")\n", + "ax.plot(tsim, varpiswifter, label=\"Swifter GR\")\n", + "ax.plot(tsim, varpiswiftest, label=\"Swiftest GR\")\n", + "ax.set_xlabel('Time (y)')\n", + "ax.set_ylabel('Mercury $\\\\varpi$ (deg)')\n", + "ax.legend()\n", + "print('Mean precession rate for Mercury long. peri. (arcsec/100 y)')\n", + "print(f'JPL Horizons : {np.mean(dvarpi_obs)}')\n", + "print(f'Swifter GR : {np.mean(dvarpi_swifter)}')\n", + "print(f'Swiftest GR : {np.mean(dvarpi_swiftest)}')\n", + "print(f'Obs - Swifter : {np.mean(dvarpi_obs - dvarpi_swifter)}')\n", + "print(f'Obs - Swiftest : {np.mean(dvarpi_obs - dvarpi_swiftest)}')\n", + "print(f'Swiftest - Swifter: {np.mean(dvarpi_swiftest - dvarpi_swifter)}')" + ] + }, + { + "cell_type": "code", + "execution_count": null, + "metadata": {}, + "outputs": [], + "source": [] + }, + { + "cell_type": "code", + "execution_count": null, + "metadata": {}, + "outputs": [], + "source": [] + } + ], + "metadata": { + "kernelspec": { + "display_name": "swiftestOOF", + "language": "python", + "name": "swiftestoof" + }, + "language_info": { + "codemirror_mode": { + "name": "ipython", + "version": 3 + }, + "file_extension": ".py", + "mimetype": "text/x-python", + "name": "python", + "nbconvert_exporter": "python", + "pygments_lexer": "ipython3", + "version": "3.7.10" + } + }, + "nbformat": 4, + "nbformat_minor": 4 +} diff --git a/python/swiftest/swiftest/io.py b/python/swiftest/swiftest/io.py index 2b8c47cb3..4fd797b76 100644 --- a/python/swiftest/swiftest/io.py +++ b/python/swiftest/swiftest/io.py @@ -1048,13 +1048,22 @@ def select_active_from_frame(ds, param, framenum=-1): frame = ds.isel(time=[framenum]) iframe = frame.isel(time=0) + if "name" in ds.dims: + count_dim = "name" + elif "id" in ds.dims: + count_dim = "id" + # Select only the active particles at this time step # Remove the inactive particles if param['OUT_FORM'] == 'XV' or param['OUT_FORM'] == 'XVEL': - iactive = iframe['id'].where((~np.isnan(iframe['Gmass'])) | (~np.isnan(iframe['xhx'])), drop=True).id + iactive = iframe[count_dim].where((~np.isnan(iframe['Gmass'])) | (~np.isnan(iframe['xhx'])), drop=True)[count_dim] else: - iactive = iframe['id'].where((~np.isnan(iframe['Gmass'])) | (~np.isnan(iframe['a'])), drop = True).id - frame = frame.sel(id=iactive.values) + iactive = iframe[count_dim].where((~np.isnan(iframe['Gmass'])) | (~np.isnan(iframe['a'])), drop = True)[count_dim] + if count_dim == "id": + frame = frame.sel(id=iactive.values) + elif count_dim == "name": + frame = frame.sel(name=iactive.values) + return frame @@ -1079,6 +1088,10 @@ def swiftest_xr2infile(ds, param, in_type="NETCDF_DOUBLE", infile_name=None,fram param_tmp['OUT_FORM'] = param['IN_FORM'] frame = select_active_from_frame(ds, param_tmp, framenum) + if "name" in frame.dims: + frame = frame.swap_dims({"name" : "id"}) + frame = frame.reset_coords("name") + if in_type == "NETCDF_DOUBLE" or in_type == "NETCDF_FLOAT": # Convert strings back to byte form and save the NetCDF file # Note: xarray will call the character array dimension string32. The Fortran code @@ -1186,8 +1199,13 @@ def swifter_xr2infile(ds, param, framenum=-1): ------- A set of input files for a Swifter run """ + frame = ds.isel(time=framenum) + if "name" in frame.dims: + frame = frame.swap_dims({"name" : "id"}) + frame = frame.reset_coords("name") + cb = frame.where(frame.id == 0, drop=True) pl = frame.where(frame.id > 0, drop=True) pl = pl.where(np.invert(np.isnan(pl['Gmass'])), drop=True).drop_vars(['j2rp2', 'j4rp4']) diff --git a/python/swiftest/swiftest/simulation_class.py b/python/swiftest/swiftest/simulation_class.py index 7c17c3d32..c6fe5e8da 100644 --- a/python/swiftest/swiftest/simulation_class.py +++ b/python/swiftest/swiftest/simulation_class.py @@ -68,6 +68,8 @@ def __init__(self,read_param: bool = True, **kwargs: Any): integrator : {"symba","rmvs","whm","helio"}, default "symba" Name of the n-body integrator that will be used when executing a run. Parameter input file equivalent: None + read_param : bool, default False + Read the parameter file given by `param_file`. param_file : str, path-like, or file-lke, default "param.in" Name of the parameter input file that will be passed to the integrator. Parameter input file equivalent: None @@ -291,7 +293,7 @@ def __init__(self,read_param: bool = True, **kwargs: Any): # Set the location of the parameter input file param_file = kwargs.pop("param_file",self.param_file) - read_param = kwargs.pop("read_param",True) + read_param = kwargs.pop("read_param",False) self.set_parameter(verbose=False,param_file=param_file) #----------------------------------------------------------------- @@ -301,9 +303,8 @@ def __init__(self,read_param: bool = True, **kwargs: Any): # If the user asks to read in an old parameter file, override any default parameters with values from the file # If the file doesn't exist, flag it for now so we know to create it if read_param: - if os.path.exists(self.param_file): - self.read_param(self.param_file, codename=self.codename, verbose=self.verbose) - param_file_found = True + #good_param is self.read_param() + if self.read_param(): # We will add the parameter file to the kwarg list. This will keep the set_parameter method from # overriding everything with defaults when there are no arguments passed to Simulation() kwargs['param_file'] = self.param_file @@ -743,7 +744,7 @@ def get_parameter(self, **kwargs): return param_dict def set_integrator(self, - codename: Literal["swiftest", "swifter", "swift"] | None = None, + codename: Literal["Swiftest", "Swifter", "Swift"] | None = None, integrator: Literal["symba","rmvs","whm","helio"] | None = None, mtiny: float | None = None, gmtiny: float | None = None, @@ -2316,58 +2317,82 @@ def _combine_and_fix_dsnew(self,dsnew): Updated Dataset with ntp, npl values and types fixed. """ + if "id" not in self.data.dims: + if len(np.unique(dsnew['name'])) == len(dsnew['name']): + dsnew = dsnew.swap_dims({"id" : "name"}) + dsnew = dsnew.reset_coords("id") + else: + warnings.warn("Non-unique names detected for bodies. The Dataset will be dimensioned by integer id instead of name.") + warnings.warn("Consider using unique names instead.") + + if self.param['OUT_TYPE'] == "NETCDF_DOUBLE": + dsnew = io.fix_types(dsnew, ftype=np.float64) + elif self.param['OUT_TYPE'] == "NETCDF_FLOAT": + dsnew = io.fix_types(dsnew, ftype=np.float32) self.data = xr.combine_by_coords([self.data, dsnew]) def get_nvals(ds): + if "name" in ds.dims: + count_dim = "name" + elif "id" in ds.dims: + count_dim = "id" if "Gmass" in ds: - ds['ntp'] = ds['id'].where(np.isnan(ds['Gmass'])).count(dim="id") - ds['npl'] = ds['id'].where(~(np.isnan(ds['Gmass']))).count(dim="id") - 1 + ds['ntp'] = ds[count_dim].where(np.isnan(ds['Gmass'])).count(dim=count_dim) + ds['npl'] = ds[count_dim].where(~(np.isnan(ds['Gmass']))).count(dim=count_dim) - 1 else: - ds['ntp'] = ds['id'].count(dim="id") + ds['ntp'] = ds[count_dim].count(dim=count_dim) ds['npl'] = xr.full_like(ds['ntp'],0) return ds dsnew = get_nvals(dsnew) self.data = get_nvals(self.data) - if self.param['OUT_TYPE'] == "NETCDF_DOUBLE": - dsnew = io.fix_types(dsnew, ftype=np.float64) - self.data = io.fix_types(self.data, ftype=np.float64) - elif self.param['OUT_TYPE'] == "NETCDF_FLOAT": - dsnew = io.fix_types(dsnew, ftype=np.float32) - self.data = io.fix_types(self.data, ftype=np.float32) - return dsnew - def read_param(self, param_file, codename="Swiftest", verbose=True): + def read_param(self, + param_file : os.PathLike | str | None = None, + codename: Literal["Swiftest", "Swifter", "Swift"] | None = None, + verbose: bool | None = None): """ Reads in an input parameter file and stores the values in the param dictionary. Parameters ---------- - param_file : string + param_file : str or path-like, default is the value of the Simulation object's internal `param_file`. File name of the input parameter file - codename : string + codename : {"Swiftest", "Swifter", "Swift"}, default is the value of the Simulation object's internal`codename` Type of parameter file, either "Swift", "Swifter", or "Swiftest" + verbose : bool, default is the value of the Simulation object's internal `verbose` + If set to True, then more information is printed by Simulation methods as they are executed. Setting to + False suppresses most messages other than errors. Returns ------- - + True if the parameter file exists and is read correctly. False otherwise. """ + if param_file is None: + param_file = self.param_file + + if coename is None: + codename = self.codename + + if verbose is None: + verbose = self.verbose + + if not os.path.exists(param_file): + return False + if codename == "Swiftest": - param_old = self.param.copy() - self.param = io.read_swiftest_param(param_file, param_old, verbose=verbose) - self.codename = "Swiftest" + self.param = io.read_swiftest_param(param_file, param, verbose=verbose) elif codename == "Swifter": self.param = io.read_swifter_param(param_file, verbose=verbose) - self.codename = "Swifter" elif codename == "Swift": self.param = io.read_swift_param(param_file, verbose=verbose) - self.codename = "Swift" else: warnings.warn(f'{codename} is not a recognized code name. Valid options are "Swiftest", "Swifter", or "Swift".') - self.codename = "Unknown" - return + return False + + return True def write_param(self, codename: Literal["Swiftest", "Swifter", "Swift"] | None = None, From be6893487d307a92c876af8e3ed2ffd85d6289a9 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Thu, 17 Nov 2022 20:26:51 -0500 Subject: [PATCH 088/569] Added the GR/no GR comparison test Notebook to the whm_gr_test example --- .../whm_gr_test/swiftest_relativity.ipynb | 997 ++++++++++++++++-- 1 file changed, 927 insertions(+), 70 deletions(-) diff --git a/examples/whm_gr_test/swiftest_relativity.ipynb b/examples/whm_gr_test/swiftest_relativity.ipynb index ae586907c..0cd73753f 100644 --- a/examples/whm_gr_test/swiftest_relativity.ipynb +++ b/examples/whm_gr_test/swiftest_relativity.ipynb @@ -6,11 +6,11 @@ "metadata": {}, "outputs": [], "source": [ - "import numpy as np\n", - "import matplotlib.pyplot as plt\n", - "import pandas as pd\n", "import swiftest\n", - "from astroquery.jplhorizons import Horizons" + "from astroquery.jplhorizons import Horizons\n", + "import datetime\n", + "import numpy as np\n", + "import matplotlib.pyplot as plt" ] }, { @@ -22,18 +22,442 @@ "name": "stdout", "output_type": "stream", "text": [ - "Reading Swifter file param.swifter.in\n", - "Reading in time 1.000e+03\n", - "Creating Dataset\n", - "Successfully converted 1001 output frames.\n", - "Swifter simulation data stored as xarray DataSet .ds\n" + "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", + "Writing initial conditions to file init_cond.nc\n", + "Writing parameter inputs to file /home/daminton/git_debug/swiftest/examples/whm_gr_test/param.gr.in\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/14)\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",
+       "    Gmass          (time, name) float64 39.48 6.554e-06 ... 0.001724 0.002034\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",
+       "    ...             ...\n",
+       "    xhz            (time, name) float64 nan -0.002529 ... -0.0407 -0.7287\n",
+       "    vhx            (time, name) float64 nan -9.241 3.454 ... -1.315 -0.08755\n",
+       "    vhy            (time, name) float64 nan 7.755 6.477 ... 1.932 0.5372 1.149\n",
+       "    vhz            (time, name) float64 nan 1.481 -0.1103 ... 0.01905 -0.02168\n",
+       "    ntp            (time) int64 0\n",
+       "    npl            (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/14)\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",
+       "    Gmass          (time, name) float64 39.48 6.554e-06 ... 0.001724 0.002034\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",
+       "    ...             ...\n",
+       "    xhz            (time, name) float64 nan -0.002529 ... -0.0407 -0.7287\n",
+       "    vhx            (time, name) float64 nan -9.241 3.454 ... -1.315 -0.08755\n",
+       "    vhy            (time, name) float64 nan 7.755 6.477 ... 1.932 0.5372 1.149\n",
+       "    vhz            (time, name) float64 nan 1.481 -0.1103 ... 0.01905 -0.02168\n",
+       "    ntp            (time) int64 0\n",
+       "    npl            (time) int64 8
" + ], + "text/plain": [ + "\n", + "Dimensions: (name: 9, time: 1)\n", + "Coordinates:\n", + " * name (name) " - ] - }, - "metadata": { - "needs_background": "light" - }, - "output_type": "display_data" - } - ], + "outputs": [], "source": [ "fig, ax = plt.subplots()\n", "\n", "ax.plot(t, varpi_obs, label=\"JPL Horizons\")\n", - "ax.plot(tsim, varpiswifter, label=\"Swifter GR\")\n", - "ax.plot(tsim, varpiswiftest, label=\"Swiftest GR\")\n", + "ax.plot(tsim, varpisim_gr, label=\"Swiftest WHM GR\")\n", + "ax.plot(tsim, varpisim_nogr, label=\"Swiftest WHM No GR\")\n", "ax.set_xlabel('Time (y)')\n", "ax.set_ylabel('Mercury $\\\\varpi$ (deg)')\n", "ax.legend()\n", "print('Mean precession rate for Mercury long. peri. (arcsec/100 y)')\n", - "print(f'JPL Horizons : {np.mean(dvarpi_obs)}')\n", - "print(f'Swifter GR : {np.mean(dvarpi_swifter)}')\n", - "print(f'Swiftest GR : {np.mean(dvarpi_swiftest)}')\n", - "print(f'Obs - Swifter : {np.mean(dvarpi_obs - dvarpi_swifter)}')\n", - "print(f'Obs - Swiftest : {np.mean(dvarpi_obs - dvarpi_swiftest)}')\n", - "print(f'Swiftest - Swifter: {np.mean(dvarpi_swiftest - dvarpi_swifter)}')" + "print(f'JPL Horizons : {np.mean(dvarpi_obs)}')\n", + "print(f'Swiftest No GR : {np.mean(dvarpi_nogr)}')\n", + "print(f'Swiftest GR : {np.mean(dvarpi_gr)}')\n", + "print(f'Obs - Swiftest GR : {np.mean(dvarpi_obs - dvarpi_gr)}')\n", + "print(f'Obs - Swiftest No GR : {np.mean(dvarpi_obs - dvarpi_nogr)}')" ] }, { @@ -171,9 +1028,9 @@ ], "metadata": { "kernelspec": { - "display_name": "swiftestOOF", + "display_name": "swiftest", "language": "python", - "name": "swiftestoof" + "name": "swiftest" }, "language_info": { "codemirror_mode": { @@ -185,7 +1042,7 @@ "name": "python", "nbconvert_exporter": "python", "pygments_lexer": "ipython3", - "version": "3.7.10" + "version": "3.8.5" } }, "nbformat": 4, From 9eb46d7652683b2732a523a412a49ba3560094ef Mon Sep 17 00:00:00 2001 From: David A Minton Date: Thu, 17 Nov 2022 22:50:00 -0500 Subject: [PATCH 089/569] Fixed problem where orbital element input files were being read in as radians instead of degrees. Converted from degrees to radians on input. --- src/netcdf/netcdf.f90 | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/src/netcdf/netcdf.f90 b/src/netcdf/netcdf.f90 index 16333dec8..aa599f94e 100644 --- a/src/netcdf/netcdf.f90 +++ b/src/netcdf/netcdf.f90 @@ -626,24 +626,28 @@ module function netcdf_read_frame_system(self, iu, param) result(ierr) 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" ) + 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" ) + 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" ) + 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" ) + rtemp = rtemp * DEG2RAD if (.not.allocated(pl%capm)) allocate(pl%capm(npl)) if (.not.allocated(tp%capm)) allocate(tp%capm(ntp)) if (npl > 0) pl%capm(:) = pack(rtemp, plmask) From ecbaa9301be95b7d27de6b617a1c476a8ff2f94b Mon Sep 17 00:00:00 2001 From: David A Minton Date: Thu, 17 Nov 2022 22:50:27 -0500 Subject: [PATCH 090/569] Updated the GR test Notebook --- .../whm_gr_test/swiftest_relativity.ipynb | 941 +----------------- 1 file changed, 34 insertions(+), 907 deletions(-) diff --git a/examples/whm_gr_test/swiftest_relativity.ipynb b/examples/whm_gr_test/swiftest_relativity.ipynb index 0cd73753f..6abb9524a 100644 --- a/examples/whm_gr_test/swiftest_relativity.ipynb +++ b/examples/whm_gr_test/swiftest_relativity.ipynb @@ -2,7 +2,7 @@ "cells": [ { "cell_type": "code", - "execution_count": 1, + "execution_count": null, "metadata": {}, "outputs": [], "source": [ @@ -15,913 +15,48 @@ }, { "cell_type": "code", - "execution_count": 2, + "execution_count": null, "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", - "Writing initial conditions to file init_cond.nc\n", - "Writing parameter inputs to file /home/daminton/git_debug/swiftest/examples/whm_gr_test/param.gr.in\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/14)\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",
-       "    Gmass          (time, name) float64 39.48 6.554e-06 ... 0.001724 0.002034\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",
-       "    ...             ...\n",
-       "    xhz            (time, name) float64 nan -0.002529 ... -0.0407 -0.7287\n",
-       "    vhx            (time, name) float64 nan -9.241 3.454 ... -1.315 -0.08755\n",
-       "    vhy            (time, name) float64 nan 7.755 6.477 ... 1.932 0.5372 1.149\n",
-       "    vhz            (time, name) float64 nan 1.481 -0.1103 ... 0.01905 -0.02168\n",
-       "    ntp            (time) int64 0\n",
-       "    npl            (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/14)\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",
-       "    Gmass          (time, name) float64 39.48 6.554e-06 ... 0.001724 0.002034\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",
-       "    ...             ...\n",
-       "    xhz            (time, name) float64 nan -0.002529 ... -0.0407 -0.7287\n",
-       "    vhx            (time, name) float64 nan -9.241 3.454 ... -1.315 -0.08755\n",
-       "    vhy            (time, name) float64 nan 7.755 6.477 ... 1.932 0.5372 1.149\n",
-       "    vhz            (time, name) float64 nan 1.481 -0.1103 ... 0.01905 -0.02168\n",
-       "    ntp            (time) int64 0\n",
-       "    npl            (time) int64 8
" - ], - "text/plain": [ - "\n", - "Dimensions: (name: 9, time: 1)\n", - "Coordinates:\n", - " * name (name) Date: Thu, 17 Nov 2022 22:55:46 -0500 Subject: [PATCH 091/569] Converted the swiftest_relativity Notebook to a Python script. --- examples/whm_gr_test/init_cond.py | 226 -------------------- examples/whm_gr_test/swiftest_relativity.py | 60 ++++++ 2 files changed, 60 insertions(+), 226 deletions(-) delete mode 100644 examples/whm_gr_test/init_cond.py create mode 100644 examples/whm_gr_test/swiftest_relativity.py diff --git a/examples/whm_gr_test/init_cond.py b/examples/whm_gr_test/init_cond.py deleted file mode 100644 index 7904eb100..000000000 --- a/examples/whm_gr_test/init_cond.py +++ /dev/null @@ -1,226 +0,0 @@ -import numpy as np -import sys -from astroquery.jplhorizons import Horizons -import astropy.constants as const - -#Values from JPL Horizons -AU2M = const.au.value -GMSunSI = const.GM_sun.value -Rsun = const.R_sun.value -GC = const.G.value -JD = 86400 -year = 365.25 * JD -c = 299792458.0 -MSun_over_Mpl = [6023600.0, - 408523.71, - 328900.56, - 3098708., - 1047.3486, - 3497.898, - 22902.98, - 19412.24, - 1.35e8] - -MU2KG = GMSunSI / GC #Conversion from mass unit to kg -DU2M = AU2M #Conversion from radius unit to centimeters -TU2S = year #Conversion from time unit to seconds -GU = GC / (DU2M**3 / (MU2KG * TU2S**2)) - -GMSun = GMSunSI / (DU2M**3 / TU2S**2) - -t_print = 10.e0 * year / TU2S #output interval to print results -deltaT = 0.25 * JD / TU2S #timestep simulation -end_sim = 1.0e3 * year / TU2S + t_print #end time - -# Solar oblatenes values: From Mecheri et al. (2004), using Corbard (b) 2002 values (Table II) -J2 = 2.198e-7 * (Rsun / DU2M)**2 -J4 = -4.805e-9 * (Rsun / DU2M)**4 - -tstart = '2021-01-28' -tend = '2021-01-29' -tstep = '1d' -planetid = { - 'mercury' : '1', - 'venus' : '2', - 'earthmoon' : '3', - 'mars' : '4', - 'jupiter' : '5', - 'saturn' : '6', - 'uranus' : '7', - 'neptune' : '8', - 'plutocharon' : '9' -} -npl = 9 - -#Planet Msun/M ratio -MSun_over_Mpl = { - 'mercury' : 6023600.0, - 'venus' : 408523.71, - 'earthmoon' : 328900.56, - 'mars' : 3098708., - 'jupiter' : 1047.3486, - 'saturn' : 3497.898, - 'uranus' : 22902.98, - 'neptune' : 19412.24, - 'plutocharon' : 1.35e8 -} - -#Planet radii in meters -Rpl = { - 'mercury' : 2439.4e3, - 'venus' : 6051.8e3, - 'earthmoon' : 6371.0084e3, # Earth only for radius - 'mars' : 3389.50e3, - 'jupiter' : 69911e3, - 'saturn' : 58232.0e3, - 'uranus' : 25362.e3, - 'neptune' : 24622.e3, - 'plutocharon' : 1188.3e3 -} - -pdata = {} -plvec = {} -Rhill = {} - -for key,val in planetid.items(): - pdata[key] = Horizons(id=val, id_type='majorbody',location='@sun', - epochs={'start': tstart, 'stop': tend, - 'step': tstep}) - plvec[key] = np.array([pdata[key].vectors()['x'][0], - pdata[key].vectors()['y'][0], - pdata[key].vectors()['z'][0], - pdata[key].vectors()['vx'][0], - pdata[key].vectors()['vy'][0], - pdata[key].vectors()['vz'][0] - ]) - Rhill[key] = pdata[key].elements()['a'][0] * (3 * MSun_over_Mpl[key])**(-1.0 / 3.0) - - -if __name__ == '__main__': - # Convert from AU-day to AU-year just because I find it easier to keep track of the sim progress - for plid in plvec: - plvec[plid][3:] *= year / JD - - # Names of all output files - swifter_input = "param.swifter.in" - swifter_pl = "pl.swifter.in" - swifter_tp = "tp.swifter.in" - swifter_bin = "bin.swifter.dat" - swifter_enc = "enc.swifter.dat" - - swiftest_input = "param.swiftest.in" - swiftest_pl = "pl.swiftest.in" - swiftest_tp = "tp.swiftest.in" - swiftest_cb = "cb.swiftest.in" - swiftest_bin = "bin.swiftest.dat" - swiftest_enc = "enc.swiftest.dat" - - # Simulation start, stop, and output cadence times - t_0 = 0 # simulation start time - end_sim = 1000.0e0 * year / TU2S # simulation end time - deltaT = 0.25 * JD / TU2S # simulation step size - t_print = 1.0 * year / TU2S #output interval to print results - - iout = int(np.ceil(t_print / deltaT)) - rmin = Rsun / DU2M - rmax = 1000.0 - - #Make Swifter files - plfile = open(swifter_pl, 'w') - print(f'{npl+1} ! Planet input file generated using init_cond.py using JPL Horizons data for the major planets (and Pluto) for epoch {tstart}' ,file=plfile) - print(f'1 {GMSun}',file=plfile) - print(f'0.0 0.0 0.0',file=plfile) - print(f'0.0 0.0 0.0',file=plfile) - for i, plid in enumerate(plvec): - print(f'{i + 2} {GMSun / MSun_over_Mpl[plid]} {Rhill[plid]}', file=plfile) - print(f'{Rpl[plid] / DU2M}', file=plfile) - print(f'{plvec[plid][0]} {plvec[plid][1]} {plvec[plid][2]}', file=plfile) - print(f'{plvec[plid][3]} {plvec[plid][4]} {plvec[plid][5]}', file=plfile) - plfile.close() - - tpfile = open(swifter_tp, 'w') - print(0,file=tpfile) - tpfile.close() - - sys.stdout = open(swifter_input, "w") - print(f'! Swifter input file generated using init_cond.py') - print(f'T0 {t_0} ') - print(f'TSTOP {end_sim}') - print(f'DT {deltaT}') - print(f'PL_IN {swifter_pl}') - print(f'TP_IN {swifter_tp}') - print(f'IN_TYPE ASCII') - print(f'ISTEP_OUT {iout:d}') - print(f'ISTEP_DUMP {iout:d}') - print(f'BIN_OUT {swifter_bin}') - print(f'OUT_TYPE REAL8') - print(f'OUT_FORM EL') - print(f'OUT_STAT NEW') - print(f'J2 {J2}') - print(f'J4 {J4}') - print(f'CHK_CLOSE yes') - print(f'CHK_RMIN {rmin}') - print(f'CHK_RMAX {rmax}') - print(f'CHK_EJECT {rmax}') - print(f'CHK_QMIN {rmin}') - print(f'CHK_QMIN_COORD HELIO') - print(f'CHK_QMIN_RANGE {rmin} {rmax}') - print(f'ENC_OUT {swifter_enc}') - print(f'EXTRA_FORCE no') - print(f'BIG_DISCARD no') - print(f'RHILL_PRESENT yes') - print(f'C {c / (DU2M / TU2S)}') - - #Now make Swiftest files - cbfile = open(swiftest_cb, 'w') - print(f'{1.0}',file=cbfile) - print(f'{rmin}',file=cbfile) - print(f'{J2}',file=cbfile) - print(f'{J4}',file=cbfile) - - plfile = open(swiftest_pl, 'w') - print(npl,file=plfile) - - for i, plid in enumerate(plvec): - print(f'{i + 2} {1.0 / MSun_over_Mpl[plid]}', file=plfile) - print(f'{Rpl[plid] / DU2M}', file=plfile) - print(f'{plvec[plid][0]} {plvec[plid][1]} {plvec[plid][2]}', file=plfile) - print(f'{plvec[plid][3]} {plvec[plid][4]} {plvec[plid][5]}', file=plfile) - plfile.close() - tpfile = open(swiftest_tp, 'w') - print(0,file=tpfile) - tpfile.close() - - sys.stdout = open(swiftest_input, "w") - print(f'! Swiftest input file generated using init_cond.py') - print(f'T0 {t_0} ') - print(f'TSTOP {end_sim}') - print(f'DT {deltaT}') - print(f'CB_IN {swiftest_cb}') - print(f'PL_IN {swiftest_pl}') - print(f'TP_IN {swiftest_tp}') - print(f'IN_TYPE ASCII') - print(f'ISTEP_OUT {iout:d}') - print(f'ISTEP_DUMP {iout:d}') - print(f'BIN_OUT {swiftest_bin}') - print(f'OUT_TYPE REAL8') - print(f'OUT_FORM EL') - print(f'OUT_STAT REPLACE') - print(f'CHK_CLOSE yes') - print(f'CHK_RMIN {rmin}') - print(f'CHK_RMAX {rmax}') - print(f'CHK_EJECT {rmax}') - print(f'CHK_QMIN {rmin}') - print(f'CHK_QMIN_COORD HELIO') - print(f'CHK_QMIN_RANGE {rmin} {rmax}') - print(f'ENC_OUT {swiftest_enc}') - print(f'EXTRA_FORCE no') - print(f'BIG_DISCARD no') - print(f'ROTATION no') - print(f'GR yes') - print(f'MU2KG {MU2KG}') - print(f'DU2M {DU2M}') - print(f'TU2S {TU2S}') - - - sys.stdout = sys.__stdout__ diff --git a/examples/whm_gr_test/swiftest_relativity.py b/examples/whm_gr_test/swiftest_relativity.py new file mode 100644 index 000000000..a4ea53c3b --- /dev/null +++ b/examples/whm_gr_test/swiftest_relativity.py @@ -0,0 +1,60 @@ +#!/usr/bin/env python +import swiftest +from astroquery.jplhorizons import Horizons +import datetime +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.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.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="whm",general_relativity=True) +sim_nogr.run(tstop=1000.0, dt=0.005, tstep_out=tstep_out, integrator="whm",general_relativity=False) + +# Get the start and end date of the simulation so we can compare with the real solar system +start_date = sim_gr.ephemeris_date +tstop_d = sim_gr.param['TSTOP'] * sim_gr.param['TU2S'] / swiftest.JD2S + +stop_date = (datetime.datetime.fromisoformat(start_date) + datetime.timedelta(days=tstop_d)).isoformat() + +#Get the ephemerides of Mercury for the same timeframe as the simulation +obj = Horizons(id='1', location='@sun', + epochs={'start':start_date, 'stop':stop_date, + 'step':'10y'}) +el = obj.elements() +t = (el['datetime_jd']-el['datetime_jd'][0]) / 365.25 +varpi_obs = el['w'] + el['Omega'] + +# 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_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) +ax.plot(tsim, varpisim_gr, label="Swiftest WHM GR",linewidth=1.5) +ax.plot(tsim, varpisim_nogr, label="Swiftest WHM No GR",linewidth=1.5) +ax.set_xlabel('Time (y)') +ax.set_ylabel('Mercury $\\varpi$ (deg)') +ax.legend() +plt.savefig("whm_gr_mercury_precession.png",dpi=300) + +print('Mean precession rate for Mercury long. peri. (arcsec/100 y)') +print(f'JPL Horizons : {np.mean(dvarpi_obs)}') +print(f'Swiftest No GR : {np.mean(dvarpi_nogr)}') +print(f'Swiftest GR : {np.mean(dvarpi_gr)}') +print(f'Obs - Swiftest GR : {np.mean(dvarpi_obs - dvarpi_gr)}') +print(f'Obs - Swiftest No GR : {np.mean(dvarpi_obs - dvarpi_nogr)}') From 848cecc10babc8b0f8d40c42a4fab4c2a551aa87 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Thu, 17 Nov 2022 23:01:19 -0500 Subject: [PATCH 092/569] Added GR test script and Notebook to helio_gr_test --- .../helio_gr_test/swiftest_relativity.ipynb | 177 ++++++++++++++++++ examples/helio_gr_test/swiftest_relativity.py | 60 ++++++ 2 files changed, 237 insertions(+) create mode 100644 examples/helio_gr_test/swiftest_relativity.ipynb create mode 100644 examples/helio_gr_test/swiftest_relativity.py diff --git a/examples/helio_gr_test/swiftest_relativity.ipynb b/examples/helio_gr_test/swiftest_relativity.ipynb new file mode 100644 index 000000000..6abb9524a --- /dev/null +++ b/examples/helio_gr_test/swiftest_relativity.ipynb @@ -0,0 +1,177 @@ +{ + "cells": [ + { + "cell_type": "code", + "execution_count": null, + "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": null, + "metadata": {}, + "outputs": [], + "source": [ + "sim_gr = swiftest.Simulation(param_file=\"param.gr.in\", output_file_name=\"bin.gr.nc\")\n", + "sim_gr.add_solar_system_body([\"Sun\",\"Mercury\",\"Venus\",\"Earth\",\"Mars\",\"Jupiter\",\"Saturn\",\"Uranus\",\"Neptune\"])" + ] + }, + { + "cell_type": "code", + "execution_count": null, + "metadata": {}, + "outputs": [], + "source": [ + "sim_nogr = swiftest.Simulation(param_file=\"param.nogr.in\", output_file_name=\"bin.nogr.nc\")\n", + "sim_nogr.add_solar_system_body([\"Sun\",\"Mercury\",\"Venus\",\"Earth\",\"Mars\",\"Jupiter\",\"Saturn\",\"Uranus\",\"Neptune\"])" + ] + }, + { + "cell_type": "code", + "execution_count": null, + "metadata": {}, + "outputs": [], + "source": [ + "%%capture\n", + "tstep_out = 10.0\n", + "sim_gr.run(tstop=1000.0, dt=0.005, tstep_out=tstep_out, integrator=\"whm\",general_relativity=True)" + ] + }, + { + "cell_type": "code", + "execution_count": null, + "metadata": {}, + "outputs": [], + "source": [ + "%%capture\n", + "sim_nogr.run(tstop=1000.0, dt=0.005, tstep_out=tstep_out, integrator=\"whm\",general_relativity=False)" + ] + }, + { + "cell_type": "code", + "execution_count": null, + "metadata": {}, + "outputs": [], + "source": [ + "# Get the start and end date of the simulation so we can compare with the real solar system\n", + "start_date = sim_gr.ephemeris_date\n", + "tstop_d = sim_gr.param['TSTOP'] * sim_gr.param['TU2S'] / swiftest.JD2S\n", + "\n", + "stop_date = (datetime.datetime.fromisoformat(start_date) + datetime.timedelta(days=tstop_d)).isoformat()" + ] + }, + { + "cell_type": "code", + "execution_count": null, + "metadata": {}, + "outputs": [], + "source": [ + "#Get the ephemerides of Mercury for the same timeframe as the simulation\n", + "obj = Horizons(id='1', location='@sun',\n", + " epochs={'start':start_date, 'stop':stop_date,\n", + " 'step':'10y'})\n", + "el = obj.elements()\n", + "t = (el['datetime_jd']-el['datetime_jd'][0]) / 365.25\n", + "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, + "metadata": {}, + "outputs": [], + "source": [ + "varpisim_gr= sim_gr.data['varpi'].sel(name=\"Mercury\")\n", + "varpisim_nogr= sim_nogr.data['varpi'].sel(name=\"Mercury\")\n", + "tsim = sim_gr.data['time']" + ] + }, + { + "cell_type": "code", + "execution_count": null, + "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_obs = np.diff(varpi_obs) / np.diff(t) * 3600 * 100" + ] + }, + { + "cell_type": "code", + "execution_count": null, + "metadata": {}, + "outputs": [], + "source": [ + "fig, ax = plt.subplots()\n", + "\n", + "ax.plot(t, varpi_obs, label=\"JPL Horizons\",linewidth=2.5)\n", + "ax.plot(tsim, varpisim_gr, label=\"Swiftest WHM GR\",linewidth=1.5)\n", + "ax.plot(tsim, varpisim_nogr, label=\"Swiftest WHM No GR\",linewidth=1.5)\n", + "ax.set_xlabel('Time (y)')\n", + "ax.set_ylabel('Mercury $\\\\varpi$ (deg)')\n", + "ax.legend()\n", + "plt.savefig(\"whm_gr_mercury_precession.png\",dpi=300)\n", + "print('Mean precession rate for Mercury long. peri. (arcsec/100 y)')\n", + "print(f'JPL Horizons : {np.mean(dvarpi_obs)}')\n", + "print(f'Swiftest No GR : {np.mean(dvarpi_nogr)}')\n", + "print(f'Swiftest GR : {np.mean(dvarpi_gr)}')\n", + "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": [] + }, + { + "cell_type": "code", + "execution_count": null, + "metadata": {}, + "outputs": [], + "source": [] + } + ], + "metadata": { + "kernelspec": { + "display_name": "swiftest", + "language": "python", + "name": "swiftest" + }, + "language_info": { + "codemirror_mode": { + "name": "ipython", + "version": 3 + }, + "file_extension": ".py", + "mimetype": "text/x-python", + "name": "python", + "nbconvert_exporter": "python", + "pygments_lexer": "ipython3", + "version": "3.8.5" + } + }, + "nbformat": 4, + "nbformat_minor": 4 +} diff --git a/examples/helio_gr_test/swiftest_relativity.py b/examples/helio_gr_test/swiftest_relativity.py new file mode 100644 index 000000000..a5f4e4371 --- /dev/null +++ b/examples/helio_gr_test/swiftest_relativity.py @@ -0,0 +1,60 @@ +#!/usr/bin/env python +import swiftest +from astroquery.jplhorizons import Horizons +import datetime +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.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.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) + +# Get the start and end date of the simulation so we can compare with the real solar system +start_date = sim_gr.ephemeris_date +tstop_d = sim_gr.param['TSTOP'] * sim_gr.param['TU2S'] / swiftest.JD2S + +stop_date = (datetime.datetime.fromisoformat(start_date) + datetime.timedelta(days=tstop_d)).isoformat() + +#Get the ephemerides of Mercury for the same timeframe as the simulation +obj = Horizons(id='1', location='@sun', + epochs={'start':start_date, 'stop':stop_date, + 'step':'10y'}) +el = obj.elements() +t = (el['datetime_jd']-el['datetime_jd'][0]) / 365.25 +varpi_obs = el['w'] + el['Omega'] + +# 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_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) +ax.plot(tsim, varpisim_gr, label="Swiftest Helio GR",linewidth=1.5) +ax.plot(tsim, varpisim_nogr, label="Swiftest Helio No GR",linewidth=1.5) +ax.set_xlabel('Time (y)') +ax.set_ylabel('Mercury $\\varpi$ (deg)') +ax.legend() +plt.savefig("helio_gr_mercury_precession.png",dpi=300) + +print('Mean precession rate for Mercury long. peri. (arcsec/100 y)') +print(f'JPL Horizons : {np.mean(dvarpi_obs)}') +print(f'Swiftest No GR : {np.mean(dvarpi_nogr)}') +print(f'Swiftest GR : {np.mean(dvarpi_gr)}') +print(f'Obs - Swiftest GR : {np.mean(dvarpi_obs - dvarpi_gr)}') +print(f'Obs - Swiftest No GR : {np.mean(dvarpi_obs - dvarpi_nogr)}') From 60cf506fce744ace346e3f1b33a9fd93121851d7 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Thu, 17 Nov 2022 23:05:59 -0500 Subject: [PATCH 093/569] Fixed typos in relativity test scripts --- .../helio_gr_test/swiftest_relativity.ipynb | 10 +- .../whm_gr_test/swiftest_relativity.ipynb | 894 +++++++++++++++++- 2 files changed, 891 insertions(+), 13 deletions(-) diff --git a/examples/helio_gr_test/swiftest_relativity.ipynb b/examples/helio_gr_test/swiftest_relativity.ipynb index 6abb9524a..6946ef658 100644 --- a/examples/helio_gr_test/swiftest_relativity.ipynb +++ b/examples/helio_gr_test/swiftest_relativity.ipynb @@ -41,7 +41,7 @@ "source": [ "%%capture\n", "tstep_out = 10.0\n", - "sim_gr.run(tstop=1000.0, dt=0.005, tstep_out=tstep_out, integrator=\"whm\",general_relativity=True)" + "sim_gr.run(tstop=1000.0, dt=0.005, tstep_out=tstep_out, integrator=\"helio\",general_relativity=True)" ] }, { @@ -51,7 +51,7 @@ "outputs": [], "source": [ "%%capture\n", - "sim_nogr.run(tstop=1000.0, dt=0.005, tstep_out=tstep_out, integrator=\"whm\",general_relativity=False)" + "sim_nogr.run(tstop=1000.0, dt=0.005, tstep_out=tstep_out, integrator=\"helio\",general_relativity=False)" ] }, { @@ -124,12 +124,12 @@ "fig, ax = plt.subplots()\n", "\n", "ax.plot(t, varpi_obs, label=\"JPL Horizons\",linewidth=2.5)\n", - "ax.plot(tsim, varpisim_gr, label=\"Swiftest WHM GR\",linewidth=1.5)\n", - "ax.plot(tsim, varpisim_nogr, label=\"Swiftest WHM No GR\",linewidth=1.5)\n", + "ax.plot(tsim, varpisim_gr, label=\"Swiftest helio GR\",linewidth=1.5)\n", + "ax.plot(tsim, varpisim_nogr, label=\"Swiftest helio No GR\",linewidth=1.5)\n", "ax.set_xlabel('Time (y)')\n", "ax.set_ylabel('Mercury $\\\\varpi$ (deg)')\n", "ax.legend()\n", - "plt.savefig(\"whm_gr_mercury_precession.png\",dpi=300)\n", + "plt.savefig(\"helio_gr_mercury_precession.png\",dpi=300)\n", "print('Mean precession rate for Mercury long. peri. (arcsec/100 y)')\n", "print(f'JPL Horizons : {np.mean(dvarpi_obs)}')\n", "print(f'Swiftest No GR : {np.mean(dvarpi_nogr)}')\n", diff --git a/examples/whm_gr_test/swiftest_relativity.ipynb b/examples/whm_gr_test/swiftest_relativity.ipynb index 6abb9524a..113e10f81 100644 --- a/examples/whm_gr_test/swiftest_relativity.ipynb +++ b/examples/whm_gr_test/swiftest_relativity.ipynb @@ -2,7 +2,7 @@ "cells": [ { "cell_type": "code", - "execution_count": null, + "execution_count": 1, "metadata": {}, "outputs": [], "source": [ @@ -15,9 +15,448 @@ }, { "cell_type": "code", - "execution_count": null, + "execution_count": 2, "metadata": {}, - "outputs": [], + "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", + "Writing initial conditions to file init_cond.nc\n", + "Writing parameter inputs to file /home/daminton/git_debug/swiftest/examples/whm_gr_test/param.gr.in\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/14)\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",
+       "    Gmass          (time, name) float64 39.48 6.554e-06 ... 0.001724 0.002034\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
" + ], + "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/14)\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",
+       "    Gmass          (time, name) float64 39.48 6.554e-06 ... 0.001724 0.002034\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
" + ], + "text/plain": [ + "\n", + "Dimensions: (name: 9, time: 1)\n", + "Coordinates:\n", + " * name (name) Date: Fri, 18 Nov 2022 10:44:23 -0500 Subject: [PATCH 094/569] Began creating a configuration file that stores configuration parameters for a particular system (startup scripts and whatnot) --- python/swiftest/swiftest/simulation_class.py | 189 +++++++++++-------- 1 file changed, 112 insertions(+), 77 deletions(-) diff --git a/python/swiftest/swiftest/simulation_class.py b/python/swiftest/swiftest/simulation_class.py index c6fe5e8da..9b82fb74b 100644 --- a/python/swiftest/swiftest/simulation_class.py +++ b/python/swiftest/swiftest/simulation_class.py @@ -15,7 +15,9 @@ from swiftest import tool from swiftest import constants from swiftest import __file__ as _pyfile +import json import os +from pathlib import Path import datetime import xarray as xr import numpy as np @@ -55,8 +57,8 @@ def __init__(self,read_param: bool = True, **kwargs: Any): 1. Arguments to Simulation() 2. The parameter input file given by `param_file` under the following conditions: - `read_param` is set to True (default behavior). - - The file given by `param_file` exists. The default file is `param.in` located in the current working - directory, which can be changed by passing `param_file` as an argument. + - The file given by `param_file` exists. The default file is `param.in` located in the `.swiftest` directory + inside the current working directory, which can be changed by passing `param_file` as an argument. - The argument has an equivalent parameter or set of parameters in the parameter input file. 3. Default values (see below) @@ -274,8 +276,27 @@ def __init__(self,read_param: bool = True, **kwargs: Any): Parameter input file equivalent: None """ - # Width of the column in the printed name of the parameter in parameter getters - self._getter_column_width = '32' + # Configuration parameters will be stored in a json file alongside the Python source scripts. + self._config_file = Path(_pyfile).parent / "swiftest_configuration.json" + config_exists = self._config_file.exists() + if config_exists: + try: + with open(self._config_file, 'r') as f: + self._swiftest_configuration = json.load(f) + except: + config_exists = False + if not config_exists: + self._swiftest_configuration = {"shell" : str(Path(os.environ['SHELL']).name), + "shell_full" : str(Path(os.environ['SHELL'])), + "getter_column_width" : '32'} + self._swiftest_configuration['startup_script'] = str(Path.home() / f".{str(self._swiftest_configuration['shell'])}rc") + config_json = json.dumps(self._swiftest_configuration, indent=4) + with open(self._config_file, 'w') as f: + f.write(config_json) + + self._getter_column_width = self._swiftest_configuration['getter_column_width'] + self._shell = Path(self._swiftest_configuration['shell']) + self._shell_full = Path(self._swiftest_configuration['shell_full']) self.param = {} self.data = xr.Dataset() @@ -318,7 +339,7 @@ def __init__(self,read_param: bool = True, **kwargs: Any): # Let the user know that there was a problem reading an old parameter file and we're going to create a new one if read_param and not param_file_found: - warnings.warn(f"{self.param_file} not found. Creating a new file using default values for parameters not passed to Simulation().") + warnings.warn(f"{self.param_file} not found. Creating a new file using default values for parameters not passed to Simulation().",stacklevel=2) self.write_param() # Read in an old simulation file if requested @@ -328,7 +349,7 @@ def __init__(self,read_param: bool = True, **kwargs: Any): if os.path.exists(binpath): self.bin2xr() else: - warnings.warn(f"BIN_OUT file {binpath} not found.") + warnings.warn(f"BIN_OUT file {binpath} not found.",stacklevel=2) return @@ -354,12 +375,13 @@ def run(self,**kwargs): self.write_param() if self.codename != "Swiftest": - warnings.warn(f"Running an integration is not yet supported for {self.codename}") + warnings.warn(f"Running an integration is not yet supported for {self.codename}",stacklevel=2) return if self.driver_executable is None: - warnings.warn("Path to swiftest_driver has not been set!") - warnings.warn(f"Make sure swiftest_driver is compiled and the executable is in {self.binary_path}") + msg = "Path to swiftest_driver has not been set!" + msg += f"\nMake sure swiftest_driver is compiled and the executable is in {str(self.binary_path)}" + warnings.warn(msg,stacklevel=2) return print(f"Running a {self.codename} {self.integrator} run from tstart={self.param['TSTART']} {self.TU_name} to tstop={self.param['TSTOP']} {self.TU_name}") @@ -367,12 +389,11 @@ def run(self,**kwargs): # Get current environment variables env = os.environ.copy() driver_script = os.path.join(self.binary_path,"swiftest_driver.sh") - shell = os.path.basename(env['SHELL']) with open(driver_script,'w') as f: - f.write(f"#{env['SHELL']} -l {os.linesep}") - f.write(f"source ~/.{shell}rc {os.linesep}") + f.write(f"#{self._shell_full} -l {os.linesep}") + f.write(f"source ~/.{self.shell}rc {os.linesep}") f.write(f"cd {self.sim_dir} {os.linesep}") - f.write(f"{self.driver_executable} {self.integrator} {self.param_file}") + f.write(f"{str(self.driver_executable)} {self.integrator} {str(self.param_file)}") try: cmd = f"{env['SHELL']} -l {driver_script}" @@ -389,7 +410,7 @@ def run(self,**kwargs): print(line, end='') raise Exception ("Failure in swiftest_driver") except: - warnings.warn(f"Error executing main swiftest_driver program") + warnings.warn(f"Error executing main swiftest_driver program",stacklevel=2) return # Read in new data @@ -512,7 +533,7 @@ def set_simulation_time(self, if tstop is not None: if tstop <= tstart: - warnings.warn("tstop must be greater than tstart.") + warnings.warn("tstop must be greater than tstart.",stacklevel=2) return {} if tstop is not None: @@ -525,8 +546,9 @@ def set_simulation_time(self, if dt is not None and tstop is not None: if dt > (tstop - tstart): - warnings.warn("dt must be smaller than tstop-tstart") - warnings.warn(f"Setting dt = {tstop - tstart} instead of {dt}") + msg = "dt must be smaller than tstop-tstart" + msg +=f"\nSetting dt = {tstop - tstart} instead of {dt}" + warnings.warn(msg,stacklevel=2) dt = tstop - tstart if dt is not None: @@ -535,7 +557,7 @@ def set_simulation_time(self, if istep_out is None and tstep_out is None: istep_out = self.param.pop("ISTEP_OUT", None) elif istep_out is not None and tstep_out is not None: - warnings.warn("istep_out and tstep_out cannot both be set") + warnings.warn("istep_out and tstep_out cannot both be set",stacklevel=2) return {} else: update_list.append("istep_out") @@ -643,7 +665,7 @@ def set_parameter(self, verbose: bool = True, **kwargs): default_arguments = { "codename" : "Swiftest", "integrator": "symba", - "param_file": "param.in", + "param_file": Path.cwd() / ".swiftest" / "param.in", "t0": 0.0, "tstart": 0.0, "tstop": None, @@ -696,9 +718,17 @@ def set_parameter(self, verbose: bool = True, **kwargs): param_file = kwargs.pop("param_file",None) + # Extract the simulation directory and create it if it doesn't exist if param_file is not None: - self.param_file = os.path.realpath(param_file) - self.sim_dir = os.path.dirname(self.param_file) + self.param_file = Path.cwd() / param_file + self.sim_dir = self.param_file.parent + if self.sim_dir.exists(): + if not self.sim_dir.is_dir(): + msg = f"Cannot create the {self.sim_dir} directory: File exists." + msg += "\nDelete the file or change the location of param_file" + warnings.warn(msg,stacklevel=2) + else: + self.sim_dir.mkdir(parents=True, exist_ok=False) # Setters returning parameter dictionary values @@ -783,7 +813,7 @@ def set_integrator(self, if codename is not None: valid_codename = ["Swiftest", "Swifter", "Swift"] if codename.title() not in valid_codename: - warnings.warn(f"{codename} is not a valid codename. Valid options are ",",".join(valid_codename)) + warnings.warn(f"{codename} is not a valid codename. Valid options are ",",".join(valid_codename),stacklevel=2) try: self.codename except: @@ -794,10 +824,10 @@ def set_integrator(self, self.param['! VERSION'] = f"{self.codename} input file" update_list.append("codename") if self.codename == "Swiftest": - self.binary_path = os.path.realpath(os.path.join(os.path.dirname(os.path.realpath(_pyfile)),os.pardir,os.pardir,os.pardir,"bin")) - self.driver_executable = os.path.join(self.binary_path,"swiftest_driver") - if not os.path.exists(self.driver_executable): - warnings.warn(f"Cannot find the Swiftest driver in {self.binary_path}") + self.binary_path = Path(_pyfile).parent.parent.parent.parent / "bin" + self.driver_executable = self.binary_path / "swiftest_driver" + if not self.driver_executable.exists(): + warnings.warn(f"Cannot find the Swiftest driver in {str(self.binary_path)}",stacklevel=2) self.driver_executable = None else: self.binary_path = "NOT IMPLEMENTED FOR THIS CODE" @@ -807,7 +837,7 @@ def set_integrator(self, if integrator is not None: valid_integrator = ["symba","rmvs","whm","helio"] if integrator.lower() not in valid_integrator: - warnings.warn(f"{integrator} is not a valid integrator. Valid options are ",",".join(valid_integrator)) + warnings.warn(f"{integrator} is not a valid integrator. Valid options are ",",".join(valid_integrator),stacklevel=2) try: self.integrator except: @@ -818,9 +848,9 @@ def set_integrator(self, if mtiny is not None or gmtiny is not None: if self.integrator != "symba": - warnings.warn("mtiny and gmtiny are only used by SyMBA.") + warnings.warn("mtiny and gmtiny are only used by SyMBA.",stacklevel=2) if mtiny is not None and gmtiny is not None: - warnings.warn("Only set mtiny or gmtiny, not both!") + warnings.warn("Only set mtiny or gmtiny, not both.",stacklevel=2) elif gmtiny is not None: self.param['GMTINY'] = gmtiny update_list.append("gmtiny") @@ -859,19 +889,19 @@ def get_integrator(self,arg_list: str | List[str] | None = None, verbose: bool | valid_instance_vars = {"codename": self.codename, "integrator": self.integrator, - "param_file": self.param_file, - "driver_executable": self.driver_executable} + "param_file": str(self.param_file), + "driver_executable": str(self.driver_executable)} try: self.integrator except: - warnings.warn(f"integrator is not set") + warnings.warn(f"integrator is not set",stacklevel=2) return {} try: self.codename except: - warnings.warn(f"codename is not set") + warnings.warn(f"codename is not set",stacklevel=2) return {} if verbose is None: @@ -1008,19 +1038,19 @@ def set_feature(self, if fragmentation is not None: if self.codename != "Swiftest" and self.integrator != "symba" and fragmentation: - warnings.warn("Fragmentation is only available on Swiftest SyMBA.") + warnings.warn("Fragmentation is only available on Swiftest SyMBA.",stacklevel=2) self.param['FRAGMENTATION'] = False else: self.param['FRAGMENTATION'] = fragmentation update_list.append("fragmentation") if fragmentation: if "MIN_GMFRAG" not in self.param and minimum_fragment_mass is None and minimum_fragment_gmass is None: - warnings.warn("Minimum fragment mass is not set. Set it using minimum_fragment_gmass or minimum_fragment_mass") + warnings.warn("Minimum fragment mass is not set. Set it using minimum_fragment_gmass or minimum_fragment_mass",stacklevel=2) else: update_list.append("minimum_fragment_gmass") if minimum_fragment_gmass is not None and minimum_fragment_mass is not None: - warnings.warn("Only set either minimum_fragment_mass or minimum_fragment_gmass, but not both!") + warnings.warn("Only set either minimum_fragment_mass or minimum_fragment_gmass, but not both!",stacklevel=2) if minimum_fragment_gmass is not None: self.param["MIN_GMFRAG"] = minimum_fragment_gmass @@ -1065,8 +1095,9 @@ def set_feature(self, if interaction_loops is not None: valid_vals = ["TRIANGULAR", "FLAT", "ADAPTIVE"] if interaction_loops not in valid_vals: - warnings.warn(f"{interaction_loops} is not a valid option for interaction loops.") - warnings.warn(f"Must be one of {valid_vals}") + msg = f"{interaction_loops} is not a valid option for interaction loops." + msg += f"\nMust be one of {valid_vals}" + warnings.warn(msg,stacklevel=2) if "INTERACTION_LOOPS" not in self.param: self.param["INTERACTION_LOOPS"] = valid_vals[0] else: @@ -1076,8 +1107,9 @@ def set_feature(self, if encounter_check_loops is not None: valid_vals = ["TRIANGULAR", "SORTSWEEP", "ADAPTIVE"] if encounter_check_loops not in valid_vals: - warnings.warn(f"{encounter_check_loops} is not a valid option for interaction loops.") - warnings.warn(f"Must be one of {valid_vals}") + msg = f"{encounter_check_loops} is not a valid option for interaction loops." + msg += f"\nMust be one of {valid_vals}" + warnings.warn(msg,stacklevel=2) if "ENCOUNTER_CHECK" not in self.param: self.param["ENCOUNTER_CHECK"] = valid_vals[0] else: @@ -1208,13 +1240,14 @@ def set_init_cond_files(self, return {} def ascii_file_input_error_msg(codename): - warnings.warn(f"in set_init_cond_files: init_cond_file_name must be a dictionary of the form: ") - warnings.warn('{') + msg = f"in set_init_cond_files: init_cond_file_name must be a dictionary of the form: " + msg += "\n {" if codename == "Swiftest": - warnings.warn('"CB" : *path to central body initial conditions file*,') - warnings.warn('"PL" : *path to massive body initial conditions file*,') - warnings.warn('"TP" : *path to test particle initial conditions file*') - warnings.warn('}') + msg += '\n"CB" : *path to central body initial conditions file*,' + msg += '\n"PL" : *path to massive body initial conditions file*,' + msg += '\n"TP" : *path to test particle initial conditions file*' + msg += '\n}' + warnings.warn(msg,stacklevel=2) return {} if init_cond_format is None: @@ -1234,21 +1267,21 @@ def ascii_file_input_error_msg(codename): else: init_cond_keys = ["PL", "TP"] if init_cond_file_type != "ASCII": - warnings.warn(f"{init_cond_file_type} is not supported by {self.codename}. Using ASCII instead") + warnings.warn(f"{init_cond_file_type} is not supported by {self.codename}. Using ASCII instead",stacklevel=2) init_cond_file_type = "ASCII" if init_cond_format != "XV": - warnings.warn(f"{init_cond_format} is not supported by {self.codename}. Using XV instead") + warnings.warn(f"{init_cond_format} is not supported by {self.codename}. Using XV instead",stacklevel=2) init_cond_format = "XV" valid_formats = {"EL", "XV"} if init_cond_format not in valid_formats: - warnings.warn(f"{init_cond_format} is not a valid input format") + warnings.warn(f"{init_cond_format} is not a valid input format",stacklevel=2) else: self.param['IN_FORM'] = init_cond_format valid_types = {"NETCDF_DOUBLE", "NETCDF_FLOAT", "ASCII"} if init_cond_file_type not in valid_types: - warnings.warn(f"{init_cond_file_type} is not a valid input type") + warnings.warn(f"{init_cond_file_type} is not a valid input type",stackevel=2) else: self.param['IN_TYPE'] = init_cond_file_type @@ -1275,7 +1308,7 @@ def ascii_file_input_error_msg(codename): elif type(init_cond_file_name) is dict: # Oops, accidentally passed a dictionary instead of the expected single string or path-like for NetCDF # input type. - warnings.warn(f"Only a single input file is used for NetCDF files") + warnings.warn(f"Only a single input file is used for NetCDF files",stacklevel=2) else: self.param["NC_IN"] = init_cond_file_name @@ -1416,7 +1449,7 @@ def set_output_files(self, if output_file_type is None: output_file_type = "NETCDF_DOUBLE" elif output_file_type not in ["NETCDF_DOUBLE", "NETCDF_FLOAT"]: - warnings.warn(f"{output_file_type} is not compatible with Swiftest. Setting to NETCDF_DOUBLE") + warnings.warn(f"{output_file_type} is not compatible with Swiftest. Setting to NETCDF_DOUBLE",stacklevel=2) output_file_type = "NETCDF_DOUBLE" elif self.codename == "Swifter": if output_file_type is None: @@ -1424,7 +1457,7 @@ def set_output_files(self, if output_file_type is None: output_file_type = "REAL8" elif output_file_type not in ["REAL4", "REAL8", "XDR4", "XDR8"]: - warnings.warn(f"{output_file_type} is not compatible with Swifter. Setting to REAL8") + warnings.warn(f"{output_file_type} is not compatible with Swifter. Setting to REAL8",stacklevel=2) output_file_type = "REAL8" elif self.codename == "Swift": if output_file_type is None: @@ -1432,7 +1465,7 @@ def set_output_files(self, if output_file_type is None: output_file_type = "REAL4" if output_file_type not in ["REAL4"]: - warnings.warn(f"{output_file_type} is not compatible with Swift. Setting to REAL4") + warnings.warn(f"{output_file_type} is not compatible with Swift. Setting to REAL4",stacklevel=2) output_file_type = "REAL4" self.param['OUT_TYPE'] = output_file_type @@ -1445,7 +1478,7 @@ def set_output_files(self, self.param['BIN_OUT'] = output_file_name if output_format != "XV" and self.codename != "Swiftest": - warnings.warn(f"{output_format} is not compatible with {self.codename}. Setting to XV") + warnings.warn(f"{output_format} is not compatible with {self.codename}. Setting to XV",stacklevel=2) output_format = "XV" self.param["OUT_FORM"] = output_format @@ -1620,7 +1653,7 @@ def set_unit_system(self, self.param['MU2KG'] = 1000.0 self.MU_name = "g" else: - warnings.warn(f"{MU} not a recognized unit system. Using MSun as a default.") + warnings.warn(f"{MU} not a recognized unit system. Using MSun as a default.",stacklevel=2) self.param['MU2KG'] = constants.MSun self.MU_name = "MSun" @@ -1643,7 +1676,7 @@ def set_unit_system(self, self.param['DU2M'] = 100.0 self.DU_name = "cm" else: - warnings.warn(f"{DU} not a recognized unit system. Using AU as a default.") + warnings.warn(f"{DU} not a recognized unit system. Using AU as a default.",stacklevel=2) self.param['DU2M'] = constants.AU2M self.DU_name = "AU" @@ -1663,7 +1696,7 @@ def set_unit_system(self, self.param['TU2S'] = 1.0 self.TU_name = "s" else: - warnings.warn(f"{TU} not a recognized unit system. Using YR as a default.") + warnings.warn(f"{TU} not a recognized unit system. Using YR as a default.",stacklevel=2) self.param['TU2S'] = constants.YR2S self.TU_name = "y" @@ -1846,7 +1879,7 @@ def set_distance_range(self, if qmin_coord is not None: valid_qmin_coord = ["HELIO","BARY"] if qmin_coord.upper() not in valid_qmin_coord: - warnings.warn(f"qmin_coord = {qmin_coord} is not a valid option. Must be one of",','.join(valid_qmin_coord)) + warnings.warn(f"qmin_coord = {qmin_coord} is not a valid option. Must be one of",','.join(valid_qmin_coord),stacklevel=2) self.param['CHK_QMIN_COORD'] = valid_qmin_coord[0] else: self.param['CHK_QMIN_COORD'] = qmin_coord.upper() @@ -1969,7 +2002,7 @@ def add_solar_system_body(self, if type(ephemeris_id) is int: ephemeris_id = [ephemeris_id] if len(ephemeris_id) != len(name): - warnings.warn(f"The length of ephemeris_id ({len(ephemeris_id)}) does not match the length of name ({len(name)})") + warnings.warn(f"The length of ephemeris_id ({len(ephemeris_id)}) does not match the length of name ({len(name)})",stacklevel=2) return None else: ephemeris_id = [None] * len(name) @@ -1982,11 +2015,11 @@ def add_solar_system_body(self, try: datetime.datetime.fromisoformat(date) except: - warnings.warn(f"{date} is not a valid date format. Must be 'YYYY-MM-DD'. Setting to {self.ephemeris_date}") + warnings.warn(f"{date} is not a valid date format. Must be 'YYYY-MM-DD'. Setting to {self.ephemeris_date}",stacklevel=2) date = self.ephemeris_date if source.upper() != "HORIZONS": - warnings.warn("Currently only the JPL Horizons ephemeris service is supported") + warnings.warn("Currently only the JPL Horizons ephemeris service is supported",stacklevel=2) body_list = [] for i,n in enumerate(name): @@ -2091,8 +2124,9 @@ def set_ephemeris_date(self, datetime.datetime.fromisoformat(ephemeris_date) except: valid_date_args = ['"MBCL"', '"TODAY"', '"YYYY-MM-DD"'] - warnings.warn(f"{ephemeris_date} is not a valid format. Valid options include:", ', '.join(valid_date_args)) - warnings.warn("Using MBCL for date.") + msg = f"{ephemeris_date} is not a valid format. Valid options include:", ', '.join(valid_date_args) + msg += "\nUsing MBCL for date." + warnings.warn(msg,stacklevel=2) ephemeris_date = minton_bcl self.ephemeris_date = ephemeris_date @@ -2127,7 +2161,7 @@ def get_ephemeris_date(self, arg_list: str | List[str] | None = None, verbose: b try: self.ephemeris_date except: - warnings.warn(f"ephemeris_date is not set") + warnings.warn(f"ephemeris_date is not set",stacklevel=2) return valid_arg = {"ephemeris_date": self.ephemeris_date} @@ -2322,8 +2356,9 @@ def _combine_and_fix_dsnew(self,dsnew): dsnew = dsnew.swap_dims({"id" : "name"}) dsnew = dsnew.reset_coords("id") else: - warnings.warn("Non-unique names detected for bodies. The Dataset will be dimensioned by integer id instead of name.") - warnings.warn("Consider using unique names instead.") + msg = "Non-unique names detected for bodies. The Dataset will be dimensioned by integer id instead of name." + msg +="\nConsider using unique names instead." + print(msg) if self.param['OUT_TYPE'] == "NETCDF_DOUBLE": dsnew = io.fix_types(dsnew, ftype=np.float64) @@ -2389,7 +2424,7 @@ def read_param(self, elif codename == "Swift": self.param = io.read_swift_param(param_file, verbose=verbose) else: - warnings.warn(f'{codename} is not a recognized code name. Valid options are "Swiftest", "Swifter", or "Swift".') + warnings.warn(f'{codename} is not a recognized code name. Valid options are "Swiftest", "Swifter", or "Swift".',stacklevel=2) return False return True @@ -2440,7 +2475,7 @@ def write_param(self, elif codename == "Swift": io.write_swift_param(param, param_file) else: - warnings.warn('Cannot process unknown code type. Call the read_param method with a valid code name. Valid options are "Swiftest", "Swifter", or "Swift".') + warnings.warn('Cannot process unknown code type. Call the read_param method with a valid code name. Valid options are "Swiftest", "Swifter", or "Swift".',stacklevel=2) return def convert(self, param_file, newcodename="Swiftest", plname="pl.swiftest.in", tpname="tp.swiftest.in", @@ -2470,10 +2505,10 @@ def convert(self, param_file, newcodename="Swiftest", plname="pl.swiftest.in", t """ oldparam = self.param if self.codename == newcodename: - warnings.warn(f"This parameter configuration is already in {newcodename} format") + warnings.warn(f"This parameter configuration is already in {newcodename} format",stacklevel=2) return oldparam if newcodename != "Swift" and newcodename != "Swifter" and newcodename != "Swiftest": - warnings.warn(f'{newcodename} is an invalid code type. Valid options are "Swiftest", "Swifter", or "Swift".') + warnings.warn(f'{newcodename} is an invalid code type. Valid options are "Swiftest", "Swifter", or "Swift".',stacklevel=2) return oldparam goodconversion = True if self.codename == "Swifter": @@ -2494,7 +2529,7 @@ def convert(self, param_file, newcodename="Swiftest", plname="pl.swiftest.in", t if goodconversion: self.write_param(param_file) else: - warnings.warn(f"Conversion from {self.codename} to {newcodename} is not supported.") + warnings.warn(f"Conversion from {self.codename} to {newcodename} is not supported.",stacklevel=2) return oldparam def bin2xr(self): @@ -2521,9 +2556,9 @@ def bin2xr(self): self.data = io.swifter2xr(param_tmp, verbose=self.verbose) if self.verbose: print('Swifter simulation data stored as xarray DataSet .data') elif self.codename == "Swift": - warnings.warn("Reading Swift simulation data is not implemented yet") + warnings.warn("Reading Swift simulation data is not implemented yet",stacklevel=2) else: - warnings.warn('Cannot process unknown code type. Call the read_param method with a valid code name. Valid options are "Swiftest", "Swifter", or "Swift".') + warnings.warn('Cannot process unknown code type. Call the read_param method with a valid code name. Valid options are "Swiftest", "Swifter", or "Swift".',stacklevel=2) return def follow(self, codestyle="Swifter"): @@ -2554,7 +2589,7 @@ def follow(self, codestyle="Swifter"): i_list = [i for i in line.split(" ") if i.strip()] nskp = int(i_list[0]) except IOError: - warnings.warn('No follow.in file found') + warnings.warn('No follow.in file found',stacklevel=2) ifol = None nskp = None fol = tool.follow_swift(self.data, ifol=ifol, nskp=nskp) @@ -2609,7 +2644,7 @@ def save(self, io.swifter_xr2infile(self.data, swifter_param, framenum) self.write_param(param_file, param=swifter_param) else: - warnings.warn(f'Saving to {codename} not supported') + warnings.warn(f'Saving to {codename} not supported',stacklevel=2) return @@ -2654,7 +2689,7 @@ def initial_conditions_from_bin(self, framenum=-1, new_param=None, new_param_fil elif self.param['OUT_TYPE'] == 'NETCDF_FLOAT': new_param['IN_TYPE'] = 'NETCDF_FLOAT' else: - warnings.warn(f"{self.param['OUT_TYPE']} is an invalid OUT_TYPE file") + warnings.warn(f"{self.param['OUT_TYPE']} is an invalid OUT_TYPE file",stacklevel=2) return if self.param['BIN_OUT'] != new_param['BIN_OUT'] and restart: From 55771ecc2ee88038eac0ab662776c264754653cb Mon Sep 17 00:00:00 2001 From: David A Minton Date: Fri, 18 Nov 2022 14:55:57 -0500 Subject: [PATCH 095/569] Fixed issue related to switching back and forth between dimensioning by name vs id. Also added a Notebook for the Basic Simulation initial conditions generator --- examples/.gitignore | 1 + .../Basic_Simulation/initial_conditions.ipynb | 155 ++++++++++++++++++ examples/Basic_Simulation/param.in | 37 ----- python/swiftest/swiftest/simulation_class.py | 8 +- 4 files changed, 162 insertions(+), 39 deletions(-) create mode 100644 examples/.gitignore create mode 100644 examples/Basic_Simulation/initial_conditions.ipynb delete mode 100644 examples/Basic_Simulation/param.in diff --git a/examples/.gitignore b/examples/.gitignore new file mode 100644 index 000000000..643407776 --- /dev/null +++ b/examples/.gitignore @@ -0,0 +1 @@ +*/param.* diff --git a/examples/Basic_Simulation/initial_conditions.ipynb b/examples/Basic_Simulation/initial_conditions.ipynb new file mode 100644 index 000000000..cef068fa0 --- /dev/null +++ b/examples/Basic_Simulation/initial_conditions.ipynb @@ -0,0 +1,155 @@ +{ + "cells": [ + { + "cell_type": "code", + "execution_count": null, + "id": "2c4f59ea-1251-49f6-af1e-5695d7e25500", + "metadata": {}, + "outputs": [], + "source": [ + "import swiftest\n", + "import numpy as np\n", + "from numpy.random import default_rng" + ] + }, + { + "cell_type": "code", + "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=10.0, dt=0.005, tstep_out=1.0, fragmentation=True, minimum_fragment_mass = 2.5e-11, mtiny=2.5e-8)\n", + "sim.get_parameter()" + ] + }, + { + "cell_type": "code", + "execution_count": null, + "id": "1c122676-bacb-447c-bc37-5ef8019be0d0", + "metadata": {}, + "outputs": [], + "source": [ + "# Add the modern planets and the Sun using the JPL Horizons Database\n", + "sim.add_solar_system_body([\"Sun\",\"Mercury\",\"Venus\",\"Earth\",\"Mars\",\"Jupiter\",\"Saturn\",\"Uranus\",\"Neptune\",\"Pluto\"])" + ] + }, + { + "cell_type": "code", + "execution_count": null, + "id": "97fe9f16-bc2e-443c-856b-7dacb1267f2d", + "metadata": {}, + "outputs": [], + "source": [ + "# Add 5 user-defined massive bodies\n", + "npl = 5\n", + "density_pl = 3000.0 / (sim.param['MU2KG'] / sim.param['DU2M'] ** 3)" + ] + }, + { + "cell_type": "code", + "execution_count": null, + "id": "566a742e-3935-484d-9c7a-87310b6aaa3a", + "metadata": {}, + "outputs": [], + "source": [ + "name_pl = [\"MassiveBody_01\", \"MassiveBody_02\", \"MassiveBody_03\", \"MassiveBody_04\", \"MassiveBody_05\"]\n", + "a_pl = default_rng().uniform(0.3, 1.5, npl)\n", + "e_pl = default_rng().uniform(0.0, 0.3, npl)\n", + "inc_pl = default_rng().uniform(0.0, 90, npl)\n", + "capom_pl = default_rng().uniform(0.0, 360.0, npl)\n", + "omega_pl = default_rng().uniform(0.0, 360.0, npl)\n", + "capm_pl = default_rng().uniform(0.0, 360.0, npl)\n", + "GM_pl = (np.array([6e23, 8e23, 1e24, 3e24, 5e24]) / sim.param['MU2KG']) * sim.GU\n", + "R_pl = np.full(npl, (3 * (GM_pl / sim.GU) / (4 * np.pi * density_pl)) ** (1.0 / 3.0))\n", + "Rh_pl = a_pl * ((GM_pl) / (3 * sim.GU)) ** (1.0 / 3.0)\n", + "Ip1_pl = [0.4, 0.4, 0.4, 0.4, 0.4]\n", + "Ip2_pl = [0.4, 0.4, 0.4, 0.4, 0.4]\n", + "Ip3_pl = [0.4, 0.4, 0.4, 0.4, 0.4]\n", + "rotx_pl = [0.0, 0.0, 0.0, 0.0, 0.0]\n", + "roty_pl = [0.0, 0.0, 0.0, 0.0, 0.0]\n", + "rotz_pl = [0.0, 0.0, 0.0, 0.0, 0.0]" + ] + }, + { + "cell_type": "code", + "execution_count": null, + "id": "d2c14121-e5b4-45bd-99a7-acde0ee77955", + "metadata": {}, + "outputs": [], + "source": [ + "sim.add_body(name_pl, a_pl, e_pl, inc_pl, capom_pl, omega_pl, capm_pl, GMpl=GM_pl, Rpl=R_pl, rhill=Rh_pl, Ip1=Ip1_pl, Ip2=Ip2_pl, Ip3=Ip3_pl, rotx=rotx_pl, roty=roty_pl, rotz=rotz_pl)" + ] + }, + { + "cell_type": "code", + "execution_count": null, + "id": "b3f979b3-5238-492f-8589-0cf5d9a3c2bc", + "metadata": {}, + "outputs": [], + "source": [ + "# Add 10 user-defined test particles\n", + "ntp = 10" + ] + }, + { + "cell_type": "code", + "execution_count": null, + "id": "5777c1bb-8c91-452a-8869-ce6f951b33a3", + "metadata": {}, + "outputs": [], + "source": [ + "name_tp = [\"TestParticle_01\", \"TestParticle_02\", \"TestParticle_03\", \"TestParticle_04\", \"TestParticle_05\", \"TestParticle_06\", \"TestParticle_07\", \"TestParticle_08\", \"TestParticle_09\", \"TestParticle_10\"]\n", + "a_tp = default_rng().uniform(0.3, 1.5, ntp)\n", + "e_tp = default_rng().uniform(0.0, 0.3, ntp)\n", + "inc_tp = default_rng().uniform(0.0, 90, ntp)\n", + "capom_tp = default_rng().uniform(0.0, 360.0, ntp)\n", + "omega_tp = default_rng().uniform(0.0, 360.0, ntp)\n", + "capm_tp = default_rng().uniform(0.0, 360.0, ntp)" + ] + }, + { + "cell_type": "code", + "execution_count": null, + "id": "8df4bcb7-46a6-402a-b10f-f37c55a0fdee", + "metadata": {}, + "outputs": [], + "source": [ + "sim.add_body(name_tp, a_tp, e_tp, inc_tp, capom_tp, omega_tp, capm_tp)" + ] + }, + { + "cell_type": "code", + "execution_count": null, + "id": "fd30638b-6868-4162-bc05-1011bb255968", + "metadata": {}, + "outputs": [], + "source": [ + "# Run the simulation\n", + "sim.run()" + ] + } + ], + "metadata": { + "kernelspec": { + "display_name": "swiftest", + "language": "python", + "name": "swiftest" + }, + "language_info": { + "codemirror_mode": { + "name": "ipython", + "version": 3 + }, + "file_extension": ".py", + "mimetype": "text/x-python", + "name": "python", + "nbconvert_exporter": "python", + "pygments_lexer": "ipython3", + "version": "3.8.5" + } + }, + "nbformat": 4, + "nbformat_minor": 5 +} diff --git a/examples/Basic_Simulation/param.in b/examples/Basic_Simulation/param.in deleted file mode 100644 index 0ee870562..000000000 --- a/examples/Basic_Simulation/param.in +++ /dev/null @@ -1,37 +0,0 @@ -! VERSION Swiftest input file -T0 0.0 -TSTART 0.0 -TSTOP 10.0 -DT 0.005 -ISTEP_OUT 200 -ISTEP_DUMP 200 -NC_IN init_cond.nc -IN_TYPE NETCDF_DOUBLE -IN_FORM EL -BIN_OUT bin.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 -GMTINY 9.869231602224408e-07 -RESTART NO -CHK_CLOSE YES -GR YES -FRAGMENTATION YES -ROTATION YES -ENERGY NO -EXTRA_FORCE NO -BIG_DISCARD NO -RHILL_PRESENT NO -INTERACTION_LOOPS TRIANGULAR -ENCOUNTER_CHECK TRIANGULAR -TIDES NO -MIN_GMFRAG 9.869231602224408e-10 diff --git a/python/swiftest/swiftest/simulation_class.py b/python/swiftest/swiftest/simulation_class.py index c6fe5e8da..c58d68db8 100644 --- a/python/swiftest/swiftest/simulation_class.py +++ b/python/swiftest/swiftest/simulation_class.py @@ -2325,12 +2325,14 @@ def _combine_and_fix_dsnew(self,dsnew): warnings.warn("Non-unique names detected for bodies. The Dataset will be dimensioned by integer id instead of name.") warnings.warn("Consider using unique names instead.") + self.data = xr.combine_by_coords([self.data, dsnew]) + if self.param['OUT_TYPE'] == "NETCDF_DOUBLE": dsnew = io.fix_types(dsnew, ftype=np.float64) + self.data = io.fix_types(self.data, ftype=np.float64) elif self.param['OUT_TYPE'] == "NETCDF_FLOAT": dsnew = io.fix_types(dsnew, ftype=np.float32) - - self.data = xr.combine_by_coords([self.data, dsnew]) + self.data = io.fix_types(self.data, ftype=np.float32) def get_nvals(ds): if "name" in ds.dims: @@ -2348,6 +2350,8 @@ def get_nvals(ds): dsnew = get_nvals(dsnew) self.data = get_nvals(self.data) + self.data = self.data.sortby("id") + return dsnew def read_param(self, From 20dd1bc7dadb5fef20ca7b963c936f215f4a0d4d Mon Sep 17 00:00:00 2001 From: David A Minton Date: Fri, 18 Nov 2022 15:40:32 -0500 Subject: [PATCH 096/569] Removed deleted file from git --- examples/helio_gr_test/init_cond.py | 48 ----------------------------- 1 file changed, 48 deletions(-) delete mode 100755 examples/helio_gr_test/init_cond.py diff --git a/examples/helio_gr_test/init_cond.py b/examples/helio_gr_test/init_cond.py deleted file mode 100755 index 9e89dc358..000000000 --- a/examples/helio_gr_test/init_cond.py +++ /dev/null @@ -1,48 +0,0 @@ -#!/usr/bin/env python3 -import swiftest - -sim = swiftest.Simulation() -sim.param['PL_IN'] = "pl.swiftest.in" -sim.param['TP_IN'] = "tp.swiftest.in" -sim.param['CB_IN'] = "cb.swiftest.in" -sim.param['BIN_OUT'] = "bin.swiftest.nc" - -sim.param['MU2KG'] = swiftest.MSun -sim.param['TU2S'] = swiftest.YR2S -sim.param['DU2M'] = swiftest.AU2M -sim.param['T0'] = 0.0 -sim.param['DT'] = 0.25 * swiftest.JD2S / swiftest.YR2S -sim.param['TSTOP'] = 1000.0 -sim.param['ISTEP_OUT'] = 1461 -sim.param['ISTEP_DUMP'] = 1461 -sim.param['CHK_QMIN_COORD'] = "HELIO" -sim.param['CHK_QMIN'] = swiftest.RSun / swiftest.AU2M -sim.param['CHK_QMIN_RANGE'] = f"{swiftest.RSun / swiftest.AU2M} 1000.0" -sim.param['CHK_RMIN'] = swiftest.RSun / swiftest.AU2M -sim.param['CHK_RMAX'] = 1000.0 -sim.param['CHK_EJECT'] = 1000.0 -sim.param['OUT_STAT'] = "UNKNOWN" -sim.param['IN_FORM'] = "EL" -sim.param['OUT_FORM'] = "XVEL" -sim.param['OUT_TYPE'] = "NETCDF_DOUBLE" -sim.param['RHILL_PRESENT'] = "YES" -sim.param['GR'] = 'YES' - -bodyid = { - "Sun": 0, - "Mercury": 1, - "Venus": 2, - "Earth": 3, - "Mars": 4, - "Jupiter": 5, - "Saturn": 6, - "Uranus": 7, - "Neptune": 8, -} - -for name, id in bodyid.items(): - sim.add(name, idval=id, date="2027-04-30") - -sim.save("param.swiftest.in") - - From 000489a1247fb5e1c14ab1477ef413e35dfa35dc Mon Sep 17 00:00:00 2001 From: David A Minton Date: Fri, 18 Nov 2022 18:42:15 -0500 Subject: [PATCH 097/569] Added progress bar! --- examples/Basic_Simulation/.swiftest/param.in | 37 + .../Basic_Simulation/initial_conditions.ipynb | 3006 ++++++++++++++++- python/swiftest/swiftest/simulation_class.py | 7 +- src/io/io.f90 | 72 + src/main/swiftest_driver.f90 | 19 +- src/modules/swiftest_classes.f90 | 27 + 6 files changed, 3142 insertions(+), 26 deletions(-) create mode 100644 examples/Basic_Simulation/.swiftest/param.in diff --git a/examples/Basic_Simulation/.swiftest/param.in b/examples/Basic_Simulation/.swiftest/param.in new file mode 100644 index 000000000..0ee870562 --- /dev/null +++ b/examples/Basic_Simulation/.swiftest/param.in @@ -0,0 +1,37 @@ +! VERSION Swiftest input file +T0 0.0 +TSTART 0.0 +TSTOP 10.0 +DT 0.005 +ISTEP_OUT 200 +ISTEP_DUMP 200 +NC_IN init_cond.nc +IN_TYPE NETCDF_DOUBLE +IN_FORM EL +BIN_OUT bin.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 +GMTINY 9.869231602224408e-07 +RESTART NO +CHK_CLOSE YES +GR YES +FRAGMENTATION YES +ROTATION YES +ENERGY NO +EXTRA_FORCE NO +BIG_DISCARD NO +RHILL_PRESENT NO +INTERACTION_LOOPS TRIANGULAR +ENCOUNTER_CHECK TRIANGULAR +TIDES NO +MIN_GMFRAG 9.869231602224408e-10 diff --git a/examples/Basic_Simulation/initial_conditions.ipynb b/examples/Basic_Simulation/initial_conditions.ipynb index cef068fa0..384c55c1d 100644 --- a/examples/Basic_Simulation/initial_conditions.ipynb +++ b/examples/Basic_Simulation/initial_conditions.ipynb @@ -2,7 +2,7 @@ "cells": [ { "cell_type": "code", - "execution_count": null, + "execution_count": 1, "id": "2c4f59ea-1251-49f6-af1e-5695d7e25500", "metadata": {}, "outputs": [], @@ -14,10 +14,100 @@ }, { "cell_type": "code", - "execution_count": null, + "execution_count": 2, "id": "6054c7ab-c748-4b39-9fee-d8b27326f497", "metadata": {}, - "outputs": [], + "outputs": [ + { + "name": "stdout", + "output_type": "stream", + "text": [ + "codename Swiftest\n", + "integrator symba\n", + "param_file /home/daminton/git_debug/swiftest/examples/Basic_Simulation/.swiftest/param.in\n", + "driver_executable /home/daminton/git_debug/swiftest/bin/swiftest_driver\n", + "gmtiny 9.869231602224408e-07 AU^3 / y^2 \n", + "mtiny 2.5e-08 MSun\n", + "t0 0.0 y\n", + "tstart 0.0 y\n", + "tstop 10.0 y\n", + "dt 0.005 y\n", + "istep_out 200 \n", + "istep_dump 200 \n", + "tstep_out 1.0 y\n", + "init_cond_file_type NETCDF_DOUBLE\n", + "init_cond_format EL\n", + "init_cond_file_name init_cond.nc\n", + "output_file_type NETCDF_DOUBLE\n", + "output_file_name bin.nc\n", + "output_format XVEL\n", + "restart REPLACE\n", + "rmin 0.004650467260962157 AU\n", + "rmax 10000.0 AU\n", + "qmin_coord HELIO\n", + "MU: MSun 1.988409870698051e+30 kg / MSun\n", + "DU: AU 149597870700.0 m / AU\n", + "TU: y 31557600.0 s / y\n", + "close_encounter_check True\n", + "fragmentation True\n", + "minimum_fragment_gmass 9.869231602224408e-10 AU^3 / y^2 \n", + "minimum_fragment_mass 2.5e-11 MSun\n", + "rotation True\n", + "general_relativity True\n", + "compute_conservation_values False\n", + "rhill_present False\n", + "extra_force False\n", + "big_discard False\n", + "interaction_loops TRIANGULAR\n", + "encounter_check_loops TRIANGULAR\n", + "restart False\n", + "ephemeris_date 2027-04-30\n" + ] + }, + { + "data": { + "text/plain": [ + "{'GMTINY': 9.869231602224408e-07,\n", + " 'T0': 0.0,\n", + " 'TSTART': 0.0,\n", + " 'TSTOP': 10.0,\n", + " 'DT': 0.005,\n", + " 'ISTEP_OUT': 200,\n", + " 'ISTEP_DUMP': 200,\n", + " 'IN_TYPE': 'NETCDF_DOUBLE',\n", + " 'IN_FORM': 'EL',\n", + " 'NC_IN': 'init_cond.nc',\n", + " 'OUT_TYPE': 'NETCDF_DOUBLE',\n", + " 'BIN_OUT': 'bin.nc',\n", + " 'OUT_FORM': 'XVEL',\n", + " 'OUT_STAT': 'REPLACE',\n", + " 'CHK_RMIN': 0.004650467260962157,\n", + " 'CHK_RMAX': 10000.0,\n", + " 'CHK_QMIN_COORD': 'HELIO',\n", + " 'CHK_QMIN': 0.004650467260962157,\n", + " 'CHK_QMIN_RANGE': '0.004650467260962157 10000.0',\n", + " 'MU2KG': 1.988409870698051e+30,\n", + " 'DU2M': 149597870700.0,\n", + " 'TU2S': 31557600.0,\n", + " 'CHK_CLOSE': True,\n", + " 'FRAGMENTATION': True,\n", + " 'MIN_GMFRAG': 9.869231602224408e-10,\n", + " 'ROTATION': True,\n", + " 'GR': True,\n", + " 'ENERGY': False,\n", + " 'RHILL_PRESENT': False,\n", + " 'EXTRA_FORCE': False,\n", + " 'BIG_DISCARD': False,\n", + " 'INTERACTION_LOOPS': 'TRIANGULAR',\n", + " 'ENCOUNTER_CHECK': 'TRIANGULAR',\n", + " 'RESTART': False}" + ] + }, + "execution_count": 2, + "metadata": {}, + "output_type": "execute_result" + } + ], "source": [ "# Initialize the simulation object as a variable\n", "sim = swiftest.Simulation(tstart=0.0, tstop=10.0, dt=0.005, tstep_out=1.0, fragmentation=True, minimum_fragment_mass = 2.5e-11, mtiny=2.5e-8)\n", @@ -26,10 +116,459 @@ }, { "cell_type": "code", - "execution_count": null, + "execution_count": 3, "id": "1c122676-bacb-447c-bc37-5ef8019be0d0", "metadata": {}, - "outputs": [], + "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", + "Writing initial conditions to file /home/daminton/git_debug/swiftest/examples/Basic_Simulation/.swiftest/init_cond.nc\n", + "Writing parameter inputs to file /home/daminton/git_debug/swiftest/examples/Basic_Simulation/.swiftest/param.in\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/20)\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",
+       "    roty           (time, name) float64 -38.76 -18.38 ... -2.177e+03 261.3\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
" + ], + "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/18)\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.311 0.4269 0.999 0.8757 0.6402\n",
+       "    e              (time, name) float64 0.2241 0.1367 0.1002 0.1051 0.07477\n",
+       "    inc            (time, name) float64 59.21 8.384 79.9 38.54 18.64\n",
+       "    capom          (time, name) float64 248.3 69.55 197.0 300.4 103.7\n",
+       "    ...             ...\n",
+       "    Ip3            (time, name) float64 0.4 0.4 0.4 0.4 0.4\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
" + ], + "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.5963 0.7501 1.242 ... 0.6646 0.4335\n",
+       "    e              (time, name) float64 0.2692 0.1215 0.144 ... 0.08782 0.1085\n",
+       "    inc            (time, name) float64 31.01 21.79 71.4 ... 49.32 11.98 82.34\n",
+       "    capom          (time, name) float64 14.83 71.52 313.1 ... 55.01 264.6 27.41\n",
+       "    omega          (time, name) float64 263.9 53.24 270.9 ... 129.9 55.52 322.0\n",
+       "    capm           (time, name) float64 203.5 276.4 200.6 ... 296.5 199.3 11.76\n",
+       "    ntp            int64 10\n",
+       "    npl            int64 0
" + ], + "text/plain": [ + "\n", + "Dimensions: (name: 10, time: 1)\n", + "Coordinates:\n", + " * name (name) 4) self%spinner = 1 + select case(self%spinner) + case(1) + self%barstr(pos:pos) = "/" + case(2) + self%barstr(pos:pos) = "-" + case(3) + self%barstr(pos:pos) = "\" + case(4) + self%barstr(pos:pos) = "|" + end select + + write(*,fmt=self%fmt) char(13),self%barstr + + + return + end subroutine io_pbar_update + + + + module subroutine io_conservation_report(self, param, lterminal) !! author: The Purdue Swiftest Team - David A. Minton, Carlisle A. Wishard, Jennifer L.L. Pouplin, and Jacob R. Elliott !! diff --git a/src/main/swiftest_driver.f90 b/src/main/swiftest_driver.f90 index 467403269..0eca02509 100644 --- a/src/main/swiftest_driver.f90 +++ b/src/main/swiftest_driver.f90 @@ -31,6 +31,7 @@ program swiftest_driver real(DP) :: old_t_final = 0.0_DP !! Output time at which writing should start, in order to prevent duplicate lines being written for restarts type(walltimer) :: integration_timer !! Object used for computing elapsed wall time real(DP) :: tfrac + type(progress_bar) :: pbar !! Object used to print out a progress bar character(*), parameter :: statusfmt = '("Time = ", ES12.5, "; fraction done = ", F6.3, ' // & '"; Number of active pl, tp = ", I5, ", ", I5)' character(*), parameter :: symbastatfmt = '("Time = ", ES12.5, "; fraction done = ", F6.3, ' // & @@ -88,6 +89,7 @@ program swiftest_driver !$ write(*,'(a,i3,/)') ' Number of threads = ', nthreads write(*, *) " *************** Main Loop *************** " if (param%lrestart .and. param%lenergy) call nbody_system%conservation_report(param, lterminal=.true.) + call pbar%reset(nloops) do iloop = 1, nloops !> Step the system forward in time call integration_timer%start() @@ -100,6 +102,7 @@ program swiftest_driver call nbody_system%discard(param) !> If the loop counter is at the output cadence value, append the data file with a single frame + call pbar%update(iloop) if (istep_out > 0) then iout = iout - 1 if (iout == 0) then @@ -108,15 +111,15 @@ program swiftest_driver tfrac = (param%t - param%t0) / (param%tstop - param%t0) - select type(pl => nbody_system%pl) - class is (symba_pl) - write(*, symbastatfmt) param%t, tfrac, pl%nplm, pl%nbody, nbody_system%tp%nbody - class default - write(*, statusfmt) param%t, tfrac, pl%nbody, nbody_system%tp%nbody - end select + ! select type(pl => nbody_system%pl) + ! class is (symba_pl) + ! write(*, symbastatfmt) param%t, tfrac, pl%nplm, pl%nbody, nbody_system%tp%nbody + ! class default + ! write(*, statusfmt) param%t, tfrac, pl%nbody, nbody_system%tp%nbody + ! end select if (param%lenergy) call nbody_system%conservation_report(param, lterminal=.true.) - call integration_timer%report(message="Integration steps:", nsubsteps=istep_out) - call integration_timer%reset() + !call integration_timer%report(message="Integration steps:", nsubsteps=istep_out) + !call integration_timer%reset() iout = istep_out end if diff --git a/src/modules/swiftest_classes.f90 b/src/modules/swiftest_classes.f90 index 6c0ac2be3..49735a424 100644 --- a/src/modules/swiftest_classes.f90 +++ b/src/modules/swiftest_classes.f90 @@ -414,6 +414,21 @@ module swiftest_classes generic :: read_particle_info => read_particle_info_bin, read_particle_info_netcdf !! Genereric method call for reading in the particle information metadata end type swiftest_nbody_system + type :: progress_bar + !! author: David A. Minton + !! + !! Implements a class for a simple progress bar that can print on the screen. + integer(I4B) :: PBARSIZE = 80 !! Number of characters acros for a whole progress bar + integer(I8B) :: nloops !! The total number of loops that the progrees bar is executing + character(len=:), allocatable :: barstr !! The string that prints out as the progress bar + integer(I4B) :: spinner !! Position of the "spinner" that indicates that progress is being made + character(len=1) :: barchar = "=" !! The progress bar character + character(len=32) :: fmt !! The format string that is used to define the progress bar itself + contains + procedure :: reset => io_pbar_reset !! Resets the progress bar to the beginning + procedure :: update => io_pbar_update !! Updates the progress bar with new values and causes the "spinner" to flip. + end type progress_bar + abstract interface subroutine abstract_accel(self, system, param, t, lbeg) @@ -582,6 +597,18 @@ pure module subroutine gr_vh2pv_body(self, param) class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters end subroutine gr_vh2pv_body + module subroutine io_pbar_reset(self, nloops) + implicit none + class(progress_bar),intent(inout) :: self + integer(I8B), intent(in) :: nloops + end subroutine io_pbar_reset + + module subroutine io_pbar_update(self,i) + implicit none + class(progress_bar), intent(inout) :: self + integer(I8B), intent(in) :: i + end subroutine io_pbar_update + module subroutine io_conservation_report(self, param, lterminal) implicit none class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nbody system object From 947ff81495e83dd1a9130b121b9c9cf689763e5f Mon Sep 17 00:00:00 2001 From: David A Minton Date: Fri, 18 Nov 2022 19:07:19 -0500 Subject: [PATCH 098/569] Tweaked the simulation example for Basic Simulation --- examples/.gitignore | 1 + examples/Basic_Simulation/.swiftest/param.in | 37 - .../Basic_Simulation/initial_conditions.ipynb | 3023 +---------------- .../Basic_Simulation/initial_conditions.py | 5 +- python/swiftest/swiftest/simulation_class.py | 2 +- 5 files changed, 34 insertions(+), 3034 deletions(-) delete mode 100644 examples/Basic_Simulation/.swiftest/param.in diff --git a/examples/.gitignore b/examples/.gitignore index 643407776..df5a1c5d1 100644 --- a/examples/.gitignore +++ b/examples/.gitignore @@ -1 +1,2 @@ */param.* +*/.swiftest* diff --git a/examples/Basic_Simulation/.swiftest/param.in b/examples/Basic_Simulation/.swiftest/param.in deleted file mode 100644 index 0ee870562..000000000 --- a/examples/Basic_Simulation/.swiftest/param.in +++ /dev/null @@ -1,37 +0,0 @@ -! VERSION Swiftest input file -T0 0.0 -TSTART 0.0 -TSTOP 10.0 -DT 0.005 -ISTEP_OUT 200 -ISTEP_DUMP 200 -NC_IN init_cond.nc -IN_TYPE NETCDF_DOUBLE -IN_FORM EL -BIN_OUT bin.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 -GMTINY 9.869231602224408e-07 -RESTART NO -CHK_CLOSE YES -GR YES -FRAGMENTATION YES -ROTATION YES -ENERGY NO -EXTRA_FORCE NO -BIG_DISCARD NO -RHILL_PRESENT NO -INTERACTION_LOOPS TRIANGULAR -ENCOUNTER_CHECK TRIANGULAR -TIDES NO -MIN_GMFRAG 9.869231602224408e-10 diff --git a/examples/Basic_Simulation/initial_conditions.ipynb b/examples/Basic_Simulation/initial_conditions.ipynb index 384c55c1d..2bcd9cfe7 100644 --- a/examples/Basic_Simulation/initial_conditions.ipynb +++ b/examples/Basic_Simulation/initial_conditions.ipynb @@ -2,573 +2,34 @@ "cells": [ { "cell_type": "code", - "execution_count": 1, + "execution_count": null, "id": "2c4f59ea-1251-49f6-af1e-5695d7e25500", "metadata": {}, "outputs": [], "source": [ "import swiftest\n", "import numpy as np\n", - "from numpy.random import default_rng" + "from numpy.random import default_rng\n", + "%env OMP_NUM_THREADS=4" ] }, { "cell_type": "code", - "execution_count": 2, + "execution_count": null, "id": "6054c7ab-c748-4b39-9fee-d8b27326f497", "metadata": {}, - "outputs": [ - { - "name": "stdout", - "output_type": "stream", - "text": [ - "codename Swiftest\n", - "integrator symba\n", - "param_file /home/daminton/git_debug/swiftest/examples/Basic_Simulation/.swiftest/param.in\n", - "driver_executable /home/daminton/git_debug/swiftest/bin/swiftest_driver\n", - "gmtiny 9.869231602224408e-07 AU^3 / y^2 \n", - "mtiny 2.5e-08 MSun\n", - "t0 0.0 y\n", - "tstart 0.0 y\n", - "tstop 10.0 y\n", - "dt 0.005 y\n", - "istep_out 200 \n", - "istep_dump 200 \n", - "tstep_out 1.0 y\n", - "init_cond_file_type NETCDF_DOUBLE\n", - "init_cond_format EL\n", - "init_cond_file_name init_cond.nc\n", - "output_file_type NETCDF_DOUBLE\n", - "output_file_name bin.nc\n", - "output_format XVEL\n", - "restart REPLACE\n", - "rmin 0.004650467260962157 AU\n", - "rmax 10000.0 AU\n", - "qmin_coord HELIO\n", - "MU: MSun 1.988409870698051e+30 kg / MSun\n", - "DU: AU 149597870700.0 m / AU\n", - "TU: y 31557600.0 s / y\n", - "close_encounter_check True\n", - "fragmentation True\n", - "minimum_fragment_gmass 9.869231602224408e-10 AU^3 / y^2 \n", - "minimum_fragment_mass 2.5e-11 MSun\n", - "rotation True\n", - "general_relativity True\n", - "compute_conservation_values False\n", - "rhill_present False\n", - "extra_force False\n", - "big_discard False\n", - "interaction_loops TRIANGULAR\n", - "encounter_check_loops TRIANGULAR\n", - "restart False\n", - "ephemeris_date 2027-04-30\n" - ] - }, - { - "data": { - "text/plain": [ - "{'GMTINY': 9.869231602224408e-07,\n", - " 'T0': 0.0,\n", - " 'TSTART': 0.0,\n", - " 'TSTOP': 10.0,\n", - " 'DT': 0.005,\n", - " 'ISTEP_OUT': 200,\n", - " 'ISTEP_DUMP': 200,\n", - " 'IN_TYPE': 'NETCDF_DOUBLE',\n", - " 'IN_FORM': 'EL',\n", - " 'NC_IN': 'init_cond.nc',\n", - " 'OUT_TYPE': 'NETCDF_DOUBLE',\n", - " 'BIN_OUT': 'bin.nc',\n", - " 'OUT_FORM': 'XVEL',\n", - " 'OUT_STAT': 'REPLACE',\n", - " 'CHK_RMIN': 0.004650467260962157,\n", - " 'CHK_RMAX': 10000.0,\n", - " 'CHK_QMIN_COORD': 'HELIO',\n", - " 'CHK_QMIN': 0.004650467260962157,\n", - " 'CHK_QMIN_RANGE': '0.004650467260962157 10000.0',\n", - " 'MU2KG': 1.988409870698051e+30,\n", - " 'DU2M': 149597870700.0,\n", - " 'TU2S': 31557600.0,\n", - " 'CHK_CLOSE': True,\n", - " 'FRAGMENTATION': True,\n", - " 'MIN_GMFRAG': 9.869231602224408e-10,\n", - " 'ROTATION': True,\n", - " 'GR': True,\n", - " 'ENERGY': False,\n", - " 'RHILL_PRESENT': False,\n", - " 'EXTRA_FORCE': False,\n", - " 'BIG_DISCARD': False,\n", - " 'INTERACTION_LOOPS': 'TRIANGULAR',\n", - " 'ENCOUNTER_CHECK': 'TRIANGULAR',\n", - " 'RESTART': False}" - ] - }, - "execution_count": 2, - "metadata": {}, - "output_type": "execute_result" - } - ], + "outputs": [], "source": [ "# Initialize the simulation object as a variable\n", - "sim = swiftest.Simulation(tstart=0.0, tstop=10.0, dt=0.005, tstep_out=1.0, fragmentation=True, minimum_fragment_mass = 2.5e-11, mtiny=2.5e-8)\n", - "sim.get_parameter()" + "sim = swiftest.Simulation(tstart=0.0, tstop=1.0e6, dt=0.005, tstep_out=1.0e3, 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", - "Writing initial conditions to file /home/daminton/git_debug/swiftest/examples/Basic_Simulation/.swiftest/init_cond.nc\n", - "Writing parameter inputs to file /home/daminton/git_debug/swiftest/examples/Basic_Simulation/.swiftest/param.in\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/20)\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",
-       "    roty           (time, name) float64 -38.76 -18.38 ... -2.177e+03 261.3\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
" - ], - "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/18)\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.311 0.4269 0.999 0.8757 0.6402\n",
-       "    e              (time, name) float64 0.2241 0.1367 0.1002 0.1051 0.07477\n",
-       "    inc            (time, name) float64 59.21 8.384 79.9 38.54 18.64\n",
-       "    capom          (time, name) float64 248.3 69.55 197.0 300.4 103.7\n",
-       "    ...             ...\n",
-       "    Ip3            (time, name) float64 0.4 0.4 0.4 0.4 0.4\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
" - ], - "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.5963 0.7501 1.242 ... 0.6646 0.4335\n",
-       "    e              (time, name) float64 0.2692 0.1215 0.144 ... 0.08782 0.1085\n",
-       "    inc            (time, name) float64 31.01 21.79 71.4 ... 49.32 11.98 82.34\n",
-       "    capom          (time, name) float64 14.83 71.52 313.1 ... 55.01 264.6 27.41\n",
-       "    omega          (time, name) float64 263.9 53.24 270.9 ... 129.9 55.52 322.0\n",
-       "    capm           (time, name) float64 203.5 276.4 200.6 ... 296.5 199.3 11.76\n",
-       "    ntp            int64 10\n",
-       "    npl            int64 0
" - ], - "text/plain": [ - "\n", - "Dimensions: (name: 10, time: 1)\n", - "Coordinates:\n", - " * name (name) Date: Sat, 19 Nov 2022 17:40:16 -0500 Subject: [PATCH 099/569] Fixed bugs that prevented reading an old param file --- python/swiftest/swiftest/constants.py | 2 +- python/swiftest/swiftest/io.py | 3 ++- python/swiftest/swiftest/simulation_class.py | 10 +++++----- 3 files changed, 8 insertions(+), 7 deletions(-) diff --git a/python/swiftest/swiftest/constants.py b/python/swiftest/swiftest/constants.py index fe3253c86..2d3f89f7c 100644 --- a/python/swiftest/swiftest/constants.py +++ b/python/swiftest/swiftest/constants.py @@ -13,7 +13,7 @@ import astropy.constants as const # Constants in SI units -GC = const.G.value +GC = const.G.value[()] AU2M = const.au.value GMSun = const.GM_sun.value MSun = const.M_sun.value diff --git a/python/swiftest/swiftest/io.py b/python/swiftest/swiftest/io.py index 4fd797b76..672d762a3 100644 --- a/python/swiftest/swiftest/io.py +++ b/python/swiftest/swiftest/io.py @@ -181,6 +181,7 @@ def read_swiftest_param(param_file_name, param, verbose=True): for f in float_param: if f in param and type(f) is str: param[f] = real2float(param[f]) + for b in bool_param: if b in param: param[b] = str2bool(param[b]) @@ -427,7 +428,7 @@ def write_labeled_param(param, param_file_name): 'TU2S', 'DU2M', 'GMTINY', - 'FRAGMENTATION' + 'FRAGMENTATION', 'MIN_GMFRAG', 'RESTART'] ptmp = param.copy() diff --git a/python/swiftest/swiftest/simulation_class.py b/python/swiftest/swiftest/simulation_class.py index 9cb330862..ffc97f510 100644 --- a/python/swiftest/swiftest/simulation_class.py +++ b/python/swiftest/swiftest/simulation_class.py @@ -57,7 +57,7 @@ def __init__(self,read_param: bool = True, **kwargs: Any): 1. Arguments to Simulation() 2. The parameter input file given by `param_file` under the following conditions: - `read_param` is set to True (default behavior). - - The file given by `param_file` exists. The default file is `param.in` located in the `.swiftest` directory + - The file given by `param_file` exists. The default file is `param.in` located in the `simdata` directory inside the current working directory, which can be changed by passing `param_file` as an argument. - The argument has an equivalent parameter or set of parameters in the parameter input file. 3. Default values (see below) @@ -314,7 +314,6 @@ def __init__(self,read_param: bool = True, **kwargs: Any): # Set the location of the parameter input file param_file = kwargs.pop("param_file",self.param_file) - read_param = kwargs.pop("read_param",False) self.set_parameter(verbose=False,param_file=param_file) #----------------------------------------------------------------- @@ -329,6 +328,7 @@ def __init__(self,read_param: bool = True, **kwargs: Any): # We will add the parameter file to the kwarg list. This will keep the set_parameter method from # overriding everything with defaults when there are no arguments passed to Simulation() kwargs['param_file'] = self.param_file + param_file_found = True else: param_file_found = False @@ -665,7 +665,7 @@ def set_parameter(self, verbose: bool = True, **kwargs): default_arguments = { "codename" : "Swiftest", "integrator": "symba", - "param_file": Path.cwd() / ".swiftest" / "param.in", + "param_file": Path.cwd() / "simdata" / "param.in", "t0": 0.0, "tstart": 0.0, "tstop": None, @@ -2412,7 +2412,7 @@ def read_param(self, if param_file is None: param_file = self.param_file - if coename is None: + if codename is None: codename = self.codename if verbose is None: @@ -2422,7 +2422,7 @@ def read_param(self, return False if codename == "Swiftest": - self.param = io.read_swiftest_param(param_file, param, verbose=verbose) + self.param = io.read_swiftest_param(param_file, self.param, verbose=verbose) elif codename == "Swifter": self.param = io.read_swifter_param(param_file, verbose=verbose) elif codename == "Swift": From 217f8466f715534ca7c3cc1f0cf13b70240b991e Mon Sep 17 00:00:00 2001 From: David A Minton Date: Sat, 19 Nov 2022 17:55:58 -0500 Subject: [PATCH 100/569] Fixed more bugs and inconsistencites with the progress bar --- .../Basic_Simulation/initial_conditions.ipynb | 1434 ++++++++++++++++- .../Basic_Simulation/initial_conditions.py | 2 +- examples/Basic_Simulation/run_from_file.py | 4 +- examples/Basic_Simulation/simdata/param.in | 37 + python/swiftest/swiftest/simulation_class.py | 21 +- src/CMakeLists.txt | 1 + src/io/io.f90 | 71 - src/io/io_progress_bar.f90 | 105 ++ src/main/swiftest_driver.f90 | 3 +- src/modules/swiftest.f90 | 1 + src/modules/swiftest_classes.f90 | 26 - 11 files changed, 1580 insertions(+), 125 deletions(-) create mode 100644 examples/Basic_Simulation/simdata/param.in create mode 100644 src/io/io_progress_bar.f90 diff --git a/examples/Basic_Simulation/initial_conditions.ipynb b/examples/Basic_Simulation/initial_conditions.ipynb index 2bcd9cfe7..055c16fa3 100644 --- a/examples/Basic_Simulation/initial_conditions.ipynb +++ b/examples/Basic_Simulation/initial_conditions.ipynb @@ -2,10 +2,18 @@ "cells": [ { "cell_type": "code", - "execution_count": null, + "execution_count": 1, "id": "2c4f59ea-1251-49f6-af1e-5695d7e25500", "metadata": {}, - "outputs": [], + "outputs": [ + { + "name": "stdout", + "output_type": "stream", + "text": [ + "env: OMP_NUM_THREADS=4\n" + ] + } + ], "source": [ "import swiftest\n", "import numpy as np\n", @@ -15,7 +23,7 @@ }, { "cell_type": "code", - "execution_count": null, + "execution_count": 2, "id": "6054c7ab-c748-4b39-9fee-d8b27326f497", "metadata": {}, "outputs": [], @@ -26,10 +34,459 @@ }, { "cell_type": "code", - "execution_count": null, + "execution_count": 3, "id": "1c122676-bacb-447c-bc37-5ef8019be0d0", "metadata": {}, - "outputs": [], + "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", + "Writing initial conditions to file /home/daminton/git_debug/swiftest/examples/Basic_Simulation/.swiftest/init_cond.nc\n", + "Writing parameter inputs to file /home/daminton/git_debug/swiftest/examples/Basic_Simulation/.swiftest/param.in\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/20)\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",
+       "    roty           (time, name) float64 -38.76 -18.38 ... -2.177e+03 261.3\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
" + ], + "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/18)\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 0.833 0.5434 0.799 0.3786 1.063\n",
+       "    e              (time, name) float64 0.2656 0.1473 0.178 0.1331 0.2989\n",
+       "    inc            (time, name) float64 82.77 64.86 84.68 52.85 16.77\n",
+       "    capom          (time, name) float64 230.6 328.9 222.6 269.3 218.2\n",
+       "    ...             ...\n",
+       "    Ip3            (time, name) float64 0.4 0.4 0.4 0.4 0.4\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
" + ], + "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 1.23 0.4818 0.8926 ... 0.8866 0.9032\n",
+       "    e              (time, name) float64 0.2545 0.02039 0.107 ... 0.1635 0.1588\n",
+       "    inc            (time, name) float64 74.72 69.71 6.346 ... 14.14 65.34 44.03\n",
+       "    capom          (time, name) float64 128.9 142.6 267.7 ... 311.2 62.34 253.7\n",
+       "    omega          (time, name) float64 95.45 208.0 74.89 ... 146.6 136.8 181.0\n",
+       "    capm           (time, name) float64 100.1 189.3 202.6 ... 327.8 270.4 188.0\n",
+       "    ntp            int64 10\n",
+       "    npl            int64 0
" + ], + "text/plain": [ + "\n", + "Dimensions: (name: 10, time: 1)\n", + "Coordinates:\n", + " * name (name) 4) self%spinner = 1 - select case(self%spinner) - case(1) - self%barstr(pos:pos) = "/" - case(2) - self%barstr(pos:pos) = "-" - case(3) - self%barstr(pos:pos) = "\" - case(4) - self%barstr(pos:pos) = "|" - end select - - write(*,fmt=self%fmt) char(13),self%barstr - - - return - end subroutine io_pbar_update - - - - module subroutine io_conservation_report(self, param, lterminal) !! author: The Purdue Swiftest Team - David A. Minton, Carlisle A. Wishard, Jennifer L.L. Pouplin, and Jacob R. Elliott !! diff --git a/src/io/io_progress_bar.f90 b/src/io/io_progress_bar.f90 new file mode 100644 index 000000000..4de94f15a --- /dev/null +++ b/src/io/io_progress_bar.f90 @@ -0,0 +1,105 @@ +module io_progress_bar + !! author: The Purdue Swiftest Team - David A. Minton, Carlisle A. Wishard, Jennifer L.L. Pouplin, and Jacob R. Elliott + !! + !! Definition of classes and methods used to determine close encounters + use swiftest_globals + use swiftest_classes + implicit none + public + + type :: progress_bar + !! author: David A. Minton + !! + !! Implements a class for a simple progress bar that can print on the screen. + integer(I4B) :: PBARSIZE = 80 !! Number of characters acros for a whole progress bar + integer(I8B) :: nloops !! The total number of loops that the progrees bar is executing + character(len=:), allocatable :: barstr !! The string that prints out as the progress bar + integer(I4B) :: spinner !! Position of the "spinner" that indicates that progress is being made + character(len=1) :: barchar = "=" !! The progress bar character + character(len=32) :: fmt !! The format string that is used to define the progress bar itself + integer(I4B) :: pos !! The current position of the progress bar + character(len=32) :: message !! The current message displayed at the end of the progress bar + contains + procedure :: reset => io_pbar_reset !! Resets the progress bar to the beginning + procedure :: update => io_pbar_update !! Updates the progress bar with new values and causes the "spinner" to flip. + end type progress_bar + +contains + + subroutine io_pbar_reset(self, nloops) + !! author: David A. Minton + !! + !! Resets the progress bar to the beginning + implicit none + ! Arguments + class(progress_bar),intent(inout) :: self + integer(I8B), intent(in) :: nloops + ! Internals + character(len=2) :: numchar,numchar2 + character(len=32) :: startfmt + character(len=self%PBARSIZE) :: empty + integer(I4B) :: k + + if (.not.allocated(self%barstr)) then + allocate(character(self%PBARSIZE) :: self%barstr) + end if + do k = 1, self%PBARSIZE + self%barstr(k:k) = " " + end do + write(numchar,'(I2)') self%PBARSIZE + self%fmt = '(A1,"[",A' // numchar // ',"]",$)' + self%nloops = nloops + self%spinner = 0 + self%pos = 0 + self%message = "" + + write(*,fmt=self%fmt) char(13),empty + + return + end subroutine io_pbar_reset + + + subroutine io_pbar_update(self,i,message) + !! author: David A. Minton + !! + !! Updates the progress bar with new values and causes the "spinner" to flip. + implicit none + ! Arguments + class(progress_bar), intent(inout) :: self !! Progres bar object + integer(I8B), intent(in) :: i !! The current loop index of the progress loop + character(len=*), intent(in), optional :: message !! An optional message to display to the right of the progress bar + ! Internals + real(DP) :: frac + integer(I4B) :: pos !! The current integer position of the progress bar + + ! Compute the current position + frac = real(i,kind=DP) / real(self%nloops,kind=DP) + pos = min(int(ceiling(frac * self%PBARSIZE),kind=I4B),self%PBARSIZE) + if (pos /= self%pos) then + self%pos = pos + + ! Fill in the bar character up to the current position + self%barstr(pos:pos) = self%barchar + end if + + self%spinner = self%spinner + 1 + if (self%spinner > 4) self%spinner = 1 + select case(self%spinner) + case(1) + self%barstr(pos+1:pos+1) = "/" + case(2) + self%barstr(pos+1:pos+1) = "-" + case(3) + self%barstr(pos+1:pos+1) = "\" + case(4) + self%barstr(pos+1:pos+1) = "|" + end select + + write(*,fmt=self%fmt) char(13),self%barstr + + + return + end subroutine io_pbar_update + + +end module io_progress_bar diff --git a/src/main/swiftest_driver.f90 b/src/main/swiftest_driver.f90 index 0eca02509..1d3535daf 100644 --- a/src/main/swiftest_driver.f90 +++ b/src/main/swiftest_driver.f90 @@ -90,6 +90,7 @@ program swiftest_driver write(*, *) " *************** Main Loop *************** " if (param%lrestart .and. param%lenergy) call nbody_system%conservation_report(param, lterminal=.true.) call pbar%reset(nloops) + call pbar%update(1) do iloop = 1, nloops !> Step the system forward in time call integration_timer%start() @@ -102,7 +103,6 @@ program swiftest_driver call nbody_system%discard(param) !> If the loop counter is at the output cadence value, append the data file with a single frame - call pbar%update(iloop) if (istep_out > 0) then iout = iout - 1 if (iout == 0) then @@ -122,6 +122,7 @@ program swiftest_driver !call integration_timer%reset() iout = istep_out + call pbar%update(iloop) end if end if diff --git a/src/modules/swiftest.f90 b/src/modules/swiftest.f90 index 6f84c66b9..edc41f134 100644 --- a/src/modules/swiftest.f90 +++ b/src/modules/swiftest.f90 @@ -23,6 +23,7 @@ module swiftest use lambda_function use walltime_classes use encounter_classes + use io_progress_bar !use advisor_annotate !$ use omp_lib implicit none diff --git a/src/modules/swiftest_classes.f90 b/src/modules/swiftest_classes.f90 index 49735a424..6bbcb537b 100644 --- a/src/modules/swiftest_classes.f90 +++ b/src/modules/swiftest_classes.f90 @@ -414,20 +414,6 @@ module swiftest_classes generic :: read_particle_info => read_particle_info_bin, read_particle_info_netcdf !! Genereric method call for reading in the particle information metadata end type swiftest_nbody_system - type :: progress_bar - !! author: David A. Minton - !! - !! Implements a class for a simple progress bar that can print on the screen. - integer(I4B) :: PBARSIZE = 80 !! Number of characters acros for a whole progress bar - integer(I8B) :: nloops !! The total number of loops that the progrees bar is executing - character(len=:), allocatable :: barstr !! The string that prints out as the progress bar - integer(I4B) :: spinner !! Position of the "spinner" that indicates that progress is being made - character(len=1) :: barchar = "=" !! The progress bar character - character(len=32) :: fmt !! The format string that is used to define the progress bar itself - contains - procedure :: reset => io_pbar_reset !! Resets the progress bar to the beginning - procedure :: update => io_pbar_update !! Updates the progress bar with new values and causes the "spinner" to flip. - end type progress_bar abstract interface @@ -597,18 +583,6 @@ pure module subroutine gr_vh2pv_body(self, param) class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters end subroutine gr_vh2pv_body - module subroutine io_pbar_reset(self, nloops) - implicit none - class(progress_bar),intent(inout) :: self - integer(I8B), intent(in) :: nloops - end subroutine io_pbar_reset - - module subroutine io_pbar_update(self,i) - implicit none - class(progress_bar), intent(inout) :: self - integer(I8B), intent(in) :: i - end subroutine io_pbar_update - module subroutine io_conservation_report(self, param, lterminal) implicit none class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nbody system object From ac4594f57827cb81b6f5ae316171effdce450a11 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Sun, 20 Nov 2022 10:57:20 -0500 Subject: [PATCH 101/569] Streamlined the progress bar --- src/io/io_progress_bar.f90 | 26 ++++++++++---------------- 1 file changed, 10 insertions(+), 16 deletions(-) diff --git a/src/io/io_progress_bar.f90 b/src/io/io_progress_bar.f90 index 4de94f15a..2f0aaf6f0 100644 --- a/src/io/io_progress_bar.f90 +++ b/src/io/io_progress_bar.f90 @@ -35,9 +35,7 @@ subroutine io_pbar_reset(self, nloops) class(progress_bar),intent(inout) :: self integer(I8B), intent(in) :: nloops ! Internals - character(len=2) :: numchar,numchar2 - character(len=32) :: startfmt - character(len=self%PBARSIZE) :: empty + character(len=2) :: numchar integer(I4B) :: k if (.not.allocated(self%barstr)) then @@ -53,7 +51,7 @@ subroutine io_pbar_reset(self, nloops) self%pos = 0 self%message = "" - write(*,fmt=self%fmt) char(13),empty + write(*,fmt=self%fmt) char(13),self%barstr return end subroutine io_pbar_reset @@ -71,29 +69,25 @@ subroutine io_pbar_update(self,i,message) ! Internals real(DP) :: frac integer(I4B) :: pos !! The current integer position of the progress bar + character(len=1), dimension(4), parameter :: spinstr = ["/","-","\","|"] + + ! Compute the current position frac = real(i,kind=DP) / real(self%nloops,kind=DP) pos = min(int(ceiling(frac * self%PBARSIZE),kind=I4B),self%PBARSIZE) + if (pos /= self%pos) then self%pos = pos - ! Fill in the bar character up to the current position self%barstr(pos:pos) = self%barchar end if + ! Compute the current value of the spinner and set the spinner character self%spinner = self%spinner + 1 - if (self%spinner > 4) self%spinner = 1 - select case(self%spinner) - case(1) - self%barstr(pos+1:pos+1) = "/" - case(2) - self%barstr(pos+1:pos+1) = "-" - case(3) - self%barstr(pos+1:pos+1) = "\" - case(4) - self%barstr(pos+1:pos+1) = "|" - end select + if (self%spinner > size(spinstr)) self%spinner = 1 + + self%barstr(pos+1:pos+1) = spinstr(self%spinner) write(*,fmt=self%fmt) char(13),self%barstr From b5e0f9bd8df3c791038d55b268a6ed83c001e82c Mon Sep 17 00:00:00 2001 From: David A Minton Date: Sun, 20 Nov 2022 15:53:59 -0500 Subject: [PATCH 102/569] More improvements to the progress bar --- .../Basic_Simulation/initial_conditions.ipynb | 19 ++++- .../Basic_Simulation/run_simulation.ipynb | 52 ++++++++++++-- python/swiftest/swiftest/simulation_class.py | 45 ++++++------ src/io/io_progress_bar.f90 | 72 ++++++++++++------- src/main/swiftest_driver.f90 | 13 ++-- 5 files changed, 141 insertions(+), 60 deletions(-) diff --git a/examples/Basic_Simulation/initial_conditions.ipynb b/examples/Basic_Simulation/initial_conditions.ipynb index 055c16fa3..2014b6e06 100644 --- a/examples/Basic_Simulation/initial_conditions.ipynb +++ b/examples/Basic_Simulation/initial_conditions.ipynb @@ -1512,7 +1512,7 @@ }, { "cell_type": "code", - "execution_count": null, + "execution_count": 11, "id": "fd30638b-6868-4162-bc05-1011bb255968", "metadata": {}, "outputs": [ @@ -1534,7 +1534,22 @@ "\n", "[====- ] MassiveBody_01 (10) perihelion distance too small at t = 41331.8700000000\n", "\n", - "[==========- ]\r" + "[=====================/ ] Mercury (1) perihelion distance too small at t = 252784.155000000\n", + "\n", + "[==================================- ] MassiveBody_03 (12) perihelion distance too small at t = 417930.725000000\n", + "\n", + "[====================================\\ ] Particle TestParticle_02 (16) too far from the central body at t = 438551.305000000\n", + "\n", + "[================================================================/ ] Particle TestParticle_01 (15) too far from the central body at t = 792096.480000000\n", + "\n", + "[================================================================================]\n", + "\n", + "Normal termination of Swiftest (version 1.0)\n", + "------------------------------------------------\n", + "\n", + "Creating Dataset from NetCDF file\n", + "Successfully converted 1001 output frames.\n", + "Swiftest simulation data stored as xarray DataSet .data\n" ] } ], diff --git a/examples/Basic_Simulation/run_simulation.ipynb b/examples/Basic_Simulation/run_simulation.ipynb index ea78c2690..97b063130 100644 --- a/examples/Basic_Simulation/run_simulation.ipynb +++ b/examples/Basic_Simulation/run_simulation.ipynb @@ -2,10 +2,18 @@ "cells": [ { "cell_type": "code", - "execution_count": null, + "execution_count": 1, "id": "86c845ce-1801-46ca-8a8a-1cabb266e6a6", "metadata": {}, - "outputs": [], + "outputs": [ + { + "name": "stdout", + "output_type": "stream", + "text": [ + "env: OMP_NUM_THREADS=8\n" + ] + } + ], "source": [ "import swiftest\n", "import xarray as xr\n", @@ -16,10 +24,18 @@ }, { "cell_type": "code", - "execution_count": null, + "execution_count": 2, "id": "d716c371-8eb4-4fc1-82af-8b5c444c831e", "metadata": {}, - "outputs": [], + "outputs": [ + { + "name": "stdout", + "output_type": "stream", + "text": [ + "Reading Swiftest file /home/daminton/git_debug/swiftest/examples/Basic_Simulation/simdata/param.in\n" + ] + } + ], "source": [ "sim = swiftest.Simulation()" ] @@ -29,9 +45,33 @@ "execution_count": null, "id": "ec7452d6-4c9b-4df3-acc0-b11c32264b91", "metadata": {}, - "outputs": [], + "outputs": [ + { + "name": "stdout", + "output_type": "stream", + "text": [ + "Writing parameter inputs to file /home/daminton/git_debug/swiftest/examples/Basic_Simulation/simdata/param.in\n", + "Running a Swiftest symba run from tstart=0.0 y to tstop=1000.0 y\n", + "\u001b]2;cd /home/daminton/git_debug/swiftest/examples/Basic_Simulation/simdata\u0007\u001b]1;\u0007\u001b]2;/home/daminton/git_debug/swiftest/bin/swiftest_driver symba \u0007\u001b]1;\u0007 Parameter input file is /home/daminton/git_debug/swiftest/examples/Basic_Simulation/simdata/param.in\n", + "\n", + " \n", + "\n", + " OpenMP parameters:\n", + "\n", + " ------------------\n", + "\n", + " Number of threads = 8\n", + "\n", + "\n", + "\n", + "\n", + "\n", + "[===/ ] Time = 3.00000E+01 of 1.00000E+03\r" + ] + } + ], "source": [ - "sim.run(tstop=10.0)" + "sim.run()" ] }, { diff --git a/python/swiftest/swiftest/simulation_class.py b/python/swiftest/swiftest/simulation_class.py index 57fe3956b..39798f62a 100644 --- a/python/swiftest/swiftest/simulation_class.py +++ b/python/swiftest/swiftest/simulation_class.py @@ -18,6 +18,7 @@ import json import os from pathlib import Path +import sys import datetime import xarray as xr import numpy as np @@ -395,28 +396,28 @@ def run(self,**kwargs): f.write(f"cd {self.sim_dir} {os.linesep}") f.write(f"{str(self.driver_executable)} {self.integrator} {str(self.param_file)} {os.linesep}") - try: - cmd = f"{env['SHELL']} -l {driver_script}" - with subprocess.Popen(shlex.split(cmd), - stdout=subprocess.PIPE, - stderr=subprocess.PIPE, - env=env, - universal_newlines=True) as p: - for line in p.stdout: - if '[' in line: - print(line.replace('\n','\r')) - elif "Normal termination" in line: - print(line.replace("Normal termination","\n\nNormal termination")) - else: - print(line) - res = p.communicate() - if p.returncode != 0: - for line in res[1]: - print(line, end='') - raise Exception ("Failure in swiftest_driver") - except: - warnings.warn(f"Error executing main swiftest_driver program",stacklevel=2) - return + cmd = f"{env['SHELL']} -l {driver_script}" + oldline = None + with subprocess.Popen(shlex.split(cmd), + stdout=subprocess.PIPE, + stderr=subprocess.PIPE, + env=env, + universal_newlines=True) as p: + for line in p.stdout: + if '[' in line: + print(line.replace('\n','\r'), end='') + elif "Normal termination" in line: + print(line.replace("Normal termination","\n\nNormal termination")) + else: + print(line) + res = p.communicate() + if p.returncode != 0: + for line in res[1]: + print(line, end='') + raise Exception ("Failure in swiftest_driver") + #except: + # warnings.warn(f"Error executing main swiftest_driver program",stacklevel=2) + # return # Read in new data self.bin2xr() diff --git a/src/io/io_progress_bar.f90 b/src/io/io_progress_bar.f90 index 2f0aaf6f0..37fc819f9 100644 --- a/src/io/io_progress_bar.f90 +++ b/src/io/io_progress_bar.f90 @@ -7,18 +7,22 @@ module io_progress_bar implicit none public + character(len=1), dimension(4), parameter, private :: spinstr = ["/","-","\","|"] !! The progress spinner sequency + character(len=1),parameter, private :: barchar = "=" !! The progress bar character + type :: progress_bar !! author: David A. Minton !! !! Implements a class for a simple progress bar that can print on the screen. integer(I4B) :: PBARSIZE = 80 !! Number of characters acros for a whole progress bar - integer(I8B) :: nloops !! The total number of loops that the progrees bar is executing + integer(I8B) :: loop_length !! The total number of loops that the progrees bar is executing + integer(I8B) :: spinner_cycle_length !! The number of loop iterations it takes to execute a full spinner cycle + integer(I8B) :: spinner_skip !! The number of loop iterations to execute before updating the spinner character(len=:), allocatable :: barstr !! The string that prints out as the progress bar - integer(I4B) :: spinner !! Position of the "spinner" that indicates that progress is being made - character(len=1) :: barchar = "=" !! The progress bar character + integer(I4B) :: bar_pos !! The current position of the progress bar + integer(I4B) :: spin_pos !! Position of the "spinner" that indicates that progress is being made character(len=32) :: fmt !! The format string that is used to define the progress bar itself - integer(I4B) :: pos !! The current position of the progress bar - character(len=32) :: message !! The current message displayed at the end of the progress bar + character(len=64) :: message !! The current message displayed at the end of the progress bar contains procedure :: reset => io_pbar_reset !! Resets the progress bar to the beginning procedure :: update => io_pbar_update !! Updates the progress bar with new values and causes the "spinner" to flip. @@ -26,14 +30,15 @@ module io_progress_bar contains - subroutine io_pbar_reset(self, nloops) + subroutine io_pbar_reset(self, loop_length, spinner_cycle_length) !! author: David A. Minton !! !! Resets the progress bar to the beginning implicit none ! Arguments - class(progress_bar),intent(inout) :: self - integer(I8B), intent(in) :: nloops + class(progress_bar),intent(inout) :: self !! The progress bar object + integer(I8B), intent(in) :: loop_length !! The length of the loop that the progress bar is attached to + integer(I8B), intent(in), optional :: spinner_cycle_length !! The number of iterations between a complete spinner cycle. If not passd, the default is to update the spinner each call ! Internals character(len=2) :: numchar integer(I4B) :: k @@ -45,13 +50,20 @@ subroutine io_pbar_reset(self, nloops) self%barstr(k:k) = " " end do write(numchar,'(I2)') self%PBARSIZE - self%fmt = '(A1,"[",A' // numchar // ',"]",$)' - self%nloops = nloops - self%spinner = 0 - self%pos = 0 + self%fmt = '(A1,"[",A' // numchar // ',"] ",A,$)' + self%loop_length = loop_length + self%bar_pos = 0 self%message = "" + if (present(spinner_cycle_length)) then + self%spinner_cycle_length = spinner_cycle_length + self%spinner_skip = self%spinner_cycle_length / size(spinstr) + else + self%spinner_cycle_length = size(spinstr) + self%spinner_skip = 1 + end if + self%spin_pos = 1 - write(*,fmt=self%fmt) char(13),self%barstr + write(*,fmt=self%fmt) char(13),self%barstr,trim(adjustl(self%message)) return end subroutine io_pbar_reset @@ -68,28 +80,36 @@ subroutine io_pbar_update(self,i,message) character(len=*), intent(in), optional :: message !! An optional message to display to the right of the progress bar ! Internals real(DP) :: frac - integer(I4B) :: pos !! The current integer position of the progress bar - character(len=1), dimension(4), parameter :: spinstr = ["/","-","\","|"] - - + integer(I4B) :: bar_pos, spin_pos !! The current integer position of the progress bar and spinner + logical :: update = .false. ! Compute the current position - frac = real(i,kind=DP) / real(self%nloops,kind=DP) - pos = min(int(ceiling(frac * self%PBARSIZE),kind=I4B),self%PBARSIZE) + frac = real(i,kind=DP) / real(self%loop_length,kind=DP) + bar_pos = min(int(ceiling(frac * self%PBARSIZE),kind=I4B),self%PBARSIZE) - if (pos /= self%pos) then - self%pos = pos + if (bar_pos /= self%bar_pos) then ! Fill in the bar character up to the current position - self%barstr(pos:pos) = self%barchar + self%barstr(bar_pos:bar_pos) = barchar + update = .true. + self%bar_pos = bar_pos end if ! Compute the current value of the spinner and set the spinner character - self%spinner = self%spinner + 1 - if (self%spinner > size(spinstr)) self%spinner = 1 + spin_pos = mod(i / self%spinner_skip, size(spinstr)) + 1 + if (spin_pos /= self%spin_pos) then + self%barstr(bar_pos+1:bar_pos+1) = spinstr(spin_pos) + self%spin_pos = spin_pos + update = .true. + end if - self%barstr(pos+1:pos+1) = spinstr(self%spinner) + if (present(message)) then + if (message /= self%message) then + update = .true. + self%message = message + end if + end if - write(*,fmt=self%fmt) char(13),self%barstr + if (update) write(*,fmt=self%fmt) char(13),self%barstr,trim(adjustl(self%message)) return diff --git a/src/main/swiftest_driver.f90 b/src/main/swiftest_driver.f90 index 1d3535daf..f93f2522a 100644 --- a/src/main/swiftest_driver.f90 +++ b/src/main/swiftest_driver.f90 @@ -36,6 +36,8 @@ program swiftest_driver '"; Number of active pl, tp = ", I5, ", ", I5)' character(*), parameter :: symbastatfmt = '("Time = ", ES12.5, "; fraction done = ", F6.3, ' // & '"; Number of active plm, pl, tp = ", I5, ", ", I5, ", ", I5)' + character(*), parameter :: pbarfmt = '("Time = ", ES12.5," of ",ES12.5)' + character(len=64) :: pbarmessage ierr = io_get_args(integrator, param_file_name) if (ierr /= 0) then @@ -87,10 +89,11 @@ program swiftest_driver !$ write(*,'(a)') ' OpenMP parameters:' !$ write(*,'(a)') ' ------------------' !$ write(*,'(a,i3,/)') ' Number of threads = ', nthreads - write(*, *) " *************** Main Loop *************** " + !write(*, *) " *************** Main Loop *************** " if (param%lrestart .and. param%lenergy) call nbody_system%conservation_report(param, lterminal=.true.) - call pbar%reset(nloops) - call pbar%update(1) + call pbar%reset(nloops, spinner_cycle_length=istep_out) + write(pbarmessage,fmt=pbarfmt) t0, tstop + call pbar%update(1,message=pbarmessage) do iloop = 1, nloops !> Step the system forward in time call integration_timer%start() @@ -101,6 +104,7 @@ program swiftest_driver !> Evaluate any discards or collisional outcomes call nbody_system%discard(param) + call pbar%update(iloop) !> If the loop counter is at the output cadence value, append the data file with a single frame if (istep_out > 0) then @@ -122,7 +126,8 @@ program swiftest_driver !call integration_timer%reset() iout = istep_out - call pbar%update(iloop) + write(pbarmessage,fmt=pbarfmt) t, tstop + call pbar%update(1,message=pbarmessage) end if end if From e51926de8d5adf151640be0ade67b0e9aa9362f9 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Sun, 20 Nov 2022 16:13:34 -0500 Subject: [PATCH 103/569] More tweaks to progress bar and defaults --- .../Basic_Simulation/run_simulation.ipynb | 16 +- examples/helio_gr_test/grsim/param.gr.in | 35 + examples/helio_gr_test/nogrsim/param.nogr.in | 35 + .../helio_gr_test/swiftest_relativity.ipynb | 896 +++++++++++++++++- src/io/io_progress_bar.f90 | 4 +- 5 files changed, 973 insertions(+), 13 deletions(-) create mode 100644 examples/helio_gr_test/grsim/param.gr.in create mode 100644 examples/helio_gr_test/nogrsim/param.nogr.in diff --git a/examples/Basic_Simulation/run_simulation.ipynb b/examples/Basic_Simulation/run_simulation.ipynb index 97b063130..f1b58cb50 100644 --- a/examples/Basic_Simulation/run_simulation.ipynb +++ b/examples/Basic_Simulation/run_simulation.ipynb @@ -42,7 +42,7 @@ }, { "cell_type": "code", - "execution_count": null, + "execution_count": 3, "id": "ec7452d6-4c9b-4df3-acc0-b11c32264b91", "metadata": {}, "outputs": [ @@ -66,7 +66,19 @@ "\n", "\n", "\n", - "[===/ ] Time = 3.00000E+01 of 1.00000E+03\r" + "[======/ ] Time = 6.50000E+01 of 1.00000E+03\r" + ] + }, + { + "ename": "KeyboardInterrupt", + "evalue": "", + "output_type": "error", + "traceback": [ + "\u001b[0;31m---------------------------------------------------------------------------\u001b[0m", + "\u001b[0;31mKeyboardInterrupt\u001b[0m Traceback (most recent call last)", + "\u001b[0;32m/tmp/ipykernel_62265/187458869.py\u001b[0m in \u001b[0;36m\u001b[0;34m\u001b[0m\n\u001b[0;32m----> 1\u001b[0;31m \u001b[0msim\u001b[0m\u001b[0;34m.\u001b[0m\u001b[0mrun\u001b[0m\u001b[0;34m(\u001b[0m\u001b[0;34m)\u001b[0m\u001b[0;34m\u001b[0m\u001b[0;34m\u001b[0m\u001b[0m\n\u001b[0m", + "\u001b[0;32m~/git_debug/swiftest/python/swiftest/swiftest/simulation_class.py\u001b[0m in \u001b[0;36mrun\u001b[0;34m(self, **kwargs)\u001b[0m\n\u001b[1;32m 404\u001b[0m \u001b[0menv\u001b[0m\u001b[0;34m=\u001b[0m\u001b[0menv\u001b[0m\u001b[0;34m,\u001b[0m\u001b[0;34m\u001b[0m\u001b[0;34m\u001b[0m\u001b[0m\n\u001b[1;32m 405\u001b[0m universal_newlines=True) as p:\n\u001b[0;32m--> 406\u001b[0;31m \u001b[0;32mfor\u001b[0m \u001b[0mline\u001b[0m \u001b[0;32min\u001b[0m \u001b[0mp\u001b[0m\u001b[0;34m.\u001b[0m\u001b[0mstdout\u001b[0m\u001b[0;34m:\u001b[0m\u001b[0;34m\u001b[0m\u001b[0;34m\u001b[0m\u001b[0m\n\u001b[0m\u001b[1;32m 407\u001b[0m \u001b[0;32mif\u001b[0m \u001b[0;34m'['\u001b[0m \u001b[0;32min\u001b[0m \u001b[0mline\u001b[0m\u001b[0;34m:\u001b[0m\u001b[0;34m\u001b[0m\u001b[0;34m\u001b[0m\u001b[0m\n\u001b[1;32m 408\u001b[0m \u001b[0mprint\u001b[0m\u001b[0;34m(\u001b[0m\u001b[0mline\u001b[0m\u001b[0;34m.\u001b[0m\u001b[0mreplace\u001b[0m\u001b[0;34m(\u001b[0m\u001b[0;34m'\\n'\u001b[0m\u001b[0;34m,\u001b[0m\u001b[0;34m'\\r'\u001b[0m\u001b[0;34m)\u001b[0m\u001b[0;34m,\u001b[0m \u001b[0mend\u001b[0m\u001b[0;34m=\u001b[0m\u001b[0;34m''\u001b[0m\u001b[0;34m)\u001b[0m\u001b[0;34m\u001b[0m\u001b[0;34m\u001b[0m\u001b[0m\n", + "\u001b[0;31mKeyboardInterrupt\u001b[0m: " ] } ], diff --git a/examples/helio_gr_test/grsim/param.gr.in b/examples/helio_gr_test/grsim/param.gr.in new file mode 100644 index 000000000..0616db203 --- /dev/null +++ b/examples/helio_gr_test/grsim/param.gr.in @@ -0,0 +1,35 @@ +! 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/nogrsim/param.nogr.in b/examples/helio_gr_test/nogrsim/param.nogr.in new file mode 100644 index 000000000..9e2ab0b22 --- /dev/null +++ b/examples/helio_gr_test/nogrsim/param.nogr.in @@ -0,0 +1,35 @@ +! 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/helio_gr_test/swiftest_relativity.ipynb b/examples/helio_gr_test/swiftest_relativity.ipynb index 6946ef658..2ede9e49c 100644 --- a/examples/helio_gr_test/swiftest_relativity.ipynb +++ b/examples/helio_gr_test/swiftest_relativity.ipynb @@ -2,7 +2,7 @@ "cells": [ { "cell_type": "code", - "execution_count": null, + "execution_count": 1, "metadata": {}, "outputs": [], "source": [ @@ -15,21 +15,901 @@ }, { "cell_type": "code", - "execution_count": null, + "execution_count": 2, "metadata": {}, - "outputs": [], + "outputs": [ + { + "name": "stdout", + "output_type": "stream", + "text": [ + "Reading Swiftest file /home/daminton/git_debug/swiftest/examples/helio_gr_test/grsim/param.gr.in\n", + "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", + "Writing initial conditions to file /home/daminton/git_debug/swiftest/examples/helio_gr_test/grsim/init_cond.nc\n", + "Writing parameter inputs to file /home/daminton/git_debug/swiftest/examples/helio_gr_test/grsim/param.gr.in\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/14)\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",
+       "    Gmass          (time, name) float64 39.48 6.554e-06 ... 0.001724 0.002034\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
" + ], + "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/14)\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",
+       "    Gmass          (time, name) float64 39.48 6.554e-06 ... 0.001724 0.002034\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
" + ], + "text/plain": [ + "\n", + "Dimensions: (name: 9, time: 1)\n", + "Coordinates:\n", + " * name (name) Date: Sun, 20 Nov 2022 16:28:52 -0500 Subject: [PATCH 104/569] Got rid of spinner, as it was too much of a hassle --- src/io/io_progress_bar.f90 | 29 ++++------------------------- src/main/swiftest_driver.f90 | 2 +- 2 files changed, 5 insertions(+), 26 deletions(-) diff --git a/src/io/io_progress_bar.f90 b/src/io/io_progress_bar.f90 index d541ca99b..9a49ff935 100644 --- a/src/io/io_progress_bar.f90 +++ b/src/io/io_progress_bar.f90 @@ -7,7 +7,6 @@ module io_progress_bar implicit none public - character(len=1), dimension(4), parameter, private :: spinstr = ["\","-","|","/"] !! The progress spinner sequency character(len=1),parameter, private :: barchar = "#" !! The progress bar character type :: progress_bar @@ -16,21 +15,18 @@ module io_progress_bar !! Implements a class for a simple progress bar that can print on the screen. integer(I4B) :: PBARSIZE = 80 !! Number of characters acros for a whole progress bar integer(I8B) :: loop_length !! The total number of loops that the progrees bar is executing - integer(I8B) :: spinner_cycle_length !! The number of loop iterations it takes to execute a full spinner cycle - integer(I8B) :: spinner_skip !! The number of loop iterations to execute before updating the spinner character(len=:), allocatable :: barstr !! The string that prints out as the progress bar integer(I4B) :: bar_pos !! The current position of the progress bar - integer(I4B) :: spin_pos !! Position of the "spinner" that indicates that progress is being made character(len=32) :: fmt !! The format string that is used to define the progress bar itself character(len=64) :: message !! The current message displayed at the end of the progress bar contains procedure :: reset => io_pbar_reset !! Resets the progress bar to the beginning - procedure :: update => io_pbar_update !! Updates the progress bar with new values and causes the "spinner" to flip. + procedure :: update => io_pbar_update !! Updates the progress bar with new values end type progress_bar contains - subroutine io_pbar_reset(self, loop_length, spinner_cycle_length) + subroutine io_pbar_reset(self, loop_length) !! author: David A. Minton !! !! Resets the progress bar to the beginning @@ -38,7 +34,6 @@ subroutine io_pbar_reset(self, loop_length, spinner_cycle_length) ! Arguments class(progress_bar),intent(inout) :: self !! The progress bar object integer(I8B), intent(in) :: loop_length !! The length of the loop that the progress bar is attached to - integer(I8B), intent(in), optional :: spinner_cycle_length !! The number of iterations between a complete spinner cycle. If not passd, the default is to update the spinner each call ! Internals character(len=2) :: numchar integer(I4B) :: k @@ -54,14 +49,6 @@ subroutine io_pbar_reset(self, loop_length, spinner_cycle_length) self%loop_length = loop_length self%bar_pos = 0 self%message = "" - if (present(spinner_cycle_length)) then - self%spinner_cycle_length = spinner_cycle_length - self%spinner_skip = self%spinner_cycle_length / size(spinstr) - else - self%spinner_cycle_length = size(spinstr) - self%spinner_skip = 1 - end if - self%spin_pos = 1 write(*,fmt=self%fmt) char(13),self%barstr,trim(adjustl(self%message)) @@ -72,7 +59,7 @@ end subroutine io_pbar_reset subroutine io_pbar_update(self,i,message) !! author: David A. Minton !! - !! Updates the progress bar with new values and causes the "spinner" to flip. + !! Updates the progress bar with new values implicit none ! Arguments class(progress_bar), intent(inout) :: self !! Progres bar object @@ -80,7 +67,7 @@ subroutine io_pbar_update(self,i,message) character(len=*), intent(in), optional :: message !! An optional message to display to the right of the progress bar ! Internals real(DP) :: frac - integer(I4B) :: bar_pos, spin_pos !! The current integer position of the progress bar and spinner + integer(I4B) :: bar_pos !! The current integer position of the progress bar logical :: update = .false. ! Compute the current position @@ -94,14 +81,6 @@ subroutine io_pbar_update(self,i,message) self%bar_pos = bar_pos end if - ! Compute the current value of the spinner and set the spinner character - spin_pos = mod(i / self%spinner_skip, size(spinstr)) + 1 - if (spin_pos /= self%spin_pos) then - self%barstr(bar_pos+1:bar_pos+1) = spinstr(spin_pos) - self%spin_pos = spin_pos - update = .true. - end if - if (present(message)) then if (message /= self%message) then update = .true. diff --git a/src/main/swiftest_driver.f90 b/src/main/swiftest_driver.f90 index f93f2522a..7b97eea43 100644 --- a/src/main/swiftest_driver.f90 +++ b/src/main/swiftest_driver.f90 @@ -91,7 +91,7 @@ program swiftest_driver !$ write(*,'(a,i3,/)') ' Number of threads = ', nthreads !write(*, *) " *************** Main Loop *************** " if (param%lrestart .and. param%lenergy) call nbody_system%conservation_report(param, lterminal=.true.) - call pbar%reset(nloops, spinner_cycle_length=istep_out) + call pbar%reset(nloops) write(pbarmessage,fmt=pbarfmt) t0, tstop call pbar%update(1,message=pbarmessage) do iloop = 1, nloops From c7b7ecb2aaeab92f0a592d6ae3d70dbbbe308039 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Sun, 20 Nov 2022 16:39:10 -0500 Subject: [PATCH 105/569] Got rid of double newlines --- .../helio_gr_test/swiftest_relativity.ipynb | 897 +----------------- python/swiftest/swiftest/simulation_class.py | 4 +- 2 files changed, 7 insertions(+), 894 deletions(-) diff --git a/examples/helio_gr_test/swiftest_relativity.ipynb b/examples/helio_gr_test/swiftest_relativity.ipynb index 2ede9e49c..4b6d13106 100644 --- a/examples/helio_gr_test/swiftest_relativity.ipynb +++ b/examples/helio_gr_test/swiftest_relativity.ipynb @@ -2,7 +2,7 @@ "cells": [ { "cell_type": "code", - "execution_count": 1, + "execution_count": null, "metadata": {}, "outputs": [], "source": [ @@ -15,449 +15,9 @@ }, { "cell_type": "code", - "execution_count": 2, + "execution_count": null, "metadata": {}, - "outputs": [ - { - "name": "stdout", - "output_type": "stream", - "text": [ - "Reading Swiftest file /home/daminton/git_debug/swiftest/examples/helio_gr_test/grsim/param.gr.in\n", - "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", - "Writing initial conditions to file /home/daminton/git_debug/swiftest/examples/helio_gr_test/grsim/init_cond.nc\n", - "Writing parameter inputs to file /home/daminton/git_debug/swiftest/examples/helio_gr_test/grsim/param.gr.in\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/14)\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",
-       "    Gmass          (time, name) float64 39.48 6.554e-06 ... 0.001724 0.002034\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
" - ], - "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/14)\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",
-       "    Gmass          (time, name) float64 39.48 6.554e-06 ... 0.001724 0.002034\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
" - ], - "text/plain": [ - "\n", - "Dimensions: (name: 9, time: 1)\n", - "Coordinates:\n", - " * name (name) Date: Mon, 21 Nov 2022 10:19:54 -0500 Subject: [PATCH 106/569] Restructured code so that you can switch between the old-style output or the new compact output with an argument. --- .../Basic_Simulation/initial_conditions.ipynb | 1451 +---------------- .../Basic_Simulation/run_simulation.ipynb | 66 +- python/swiftest/swiftest/simulation_class.py | 8 +- src/io/io.f90 | 188 ++- src/main/swiftest_driver.f90 | 77 +- src/modules/swiftest_classes.f90 | 34 +- src/modules/swiftest_globals.f90 | 15 +- src/modules/walltime_classes.f90 | 5 +- src/util/util_exit.f90 | 4 + src/walltime/walltime.f90 | 20 +- 10 files changed, 222 insertions(+), 1646 deletions(-) diff --git a/examples/Basic_Simulation/initial_conditions.ipynb b/examples/Basic_Simulation/initial_conditions.ipynb index 2014b6e06..2bcd9cfe7 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,7 +15,7 @@ }, { "cell_type": "code", - "execution_count": 2, + "execution_count": null, "id": "6054c7ab-c748-4b39-9fee-d8b27326f497", "metadata": {}, "outputs": [], @@ -34,459 +26,10 @@ }, { "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", - "Writing initial conditions to file /home/daminton/git_debug/swiftest/examples/Basic_Simulation/.swiftest/init_cond.nc\n", - "Writing parameter inputs to file /home/daminton/git_debug/swiftest/examples/Basic_Simulation/.swiftest/param.in\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/20)\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",
-       "    roty           (time, name) float64 -38.76 -18.38 ... -2.177e+03 261.3\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
" - ], - "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/18)\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 0.833 0.5434 0.799 0.3786 1.063\n",
-       "    e              (time, name) float64 0.2656 0.1473 0.178 0.1331 0.2989\n",
-       "    inc            (time, name) float64 82.77 64.86 84.68 52.85 16.77\n",
-       "    capom          (time, name) float64 230.6 328.9 222.6 269.3 218.2\n",
-       "    ...             ...\n",
-       "    Ip3            (time, name) float64 0.4 0.4 0.4 0.4 0.4\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
" - ], - "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 1.23 0.4818 0.8926 ... 0.8866 0.9032\n",
-       "    e              (time, name) float64 0.2545 0.02039 0.107 ... 0.1635 0.1588\n",
-       "    inc            (time, name) float64 74.72 69.71 6.346 ... 14.14 65.34 44.03\n",
-       "    capom          (time, name) float64 128.9 142.6 267.7 ... 311.2 62.34 253.7\n",
-       "    omega          (time, name) float64 95.45 208.0 74.89 ... 146.6 136.8 181.0\n",
-       "    capm           (time, name) float64 100.1 189.3 202.6 ... 327.8 270.4 188.0\n",
-       "    ntp            int64 10\n",
-       "    npl            int64 0
" - ], - "text/plain": [ - "\n", - "Dimensions: (name: 10, time: 1)\n", - "Coordinates:\n", - " * name (name) \u001b[0;34m\u001b[0m\n\u001b[0;32m----> 1\u001b[0;31m \u001b[0msim\u001b[0m\u001b[0;34m.\u001b[0m\u001b[0mrun\u001b[0m\u001b[0;34m(\u001b[0m\u001b[0;34m)\u001b[0m\u001b[0;34m\u001b[0m\u001b[0;34m\u001b[0m\u001b[0m\n\u001b[0m", - "\u001b[0;32m~/git_debug/swiftest/python/swiftest/swiftest/simulation_class.py\u001b[0m in \u001b[0;36mrun\u001b[0;34m(self, **kwargs)\u001b[0m\n\u001b[1;32m 404\u001b[0m \u001b[0menv\u001b[0m\u001b[0;34m=\u001b[0m\u001b[0menv\u001b[0m\u001b[0;34m,\u001b[0m\u001b[0;34m\u001b[0m\u001b[0;34m\u001b[0m\u001b[0m\n\u001b[1;32m 405\u001b[0m universal_newlines=True) as p:\n\u001b[0;32m--> 406\u001b[0;31m \u001b[0;32mfor\u001b[0m \u001b[0mline\u001b[0m \u001b[0;32min\u001b[0m \u001b[0mp\u001b[0m\u001b[0;34m.\u001b[0m\u001b[0mstdout\u001b[0m\u001b[0;34m:\u001b[0m\u001b[0;34m\u001b[0m\u001b[0;34m\u001b[0m\u001b[0m\n\u001b[0m\u001b[1;32m 407\u001b[0m \u001b[0;32mif\u001b[0m \u001b[0;34m'['\u001b[0m \u001b[0;32min\u001b[0m \u001b[0mline\u001b[0m\u001b[0;34m:\u001b[0m\u001b[0;34m\u001b[0m\u001b[0;34m\u001b[0m\u001b[0m\n\u001b[1;32m 408\u001b[0m \u001b[0mprint\u001b[0m\u001b[0;34m(\u001b[0m\u001b[0mline\u001b[0m\u001b[0;34m.\u001b[0m\u001b[0mreplace\u001b[0m\u001b[0;34m(\u001b[0m\u001b[0;34m'\\n'\u001b[0m\u001b[0;34m,\u001b[0m\u001b[0;34m'\\r'\u001b[0m\u001b[0;34m)\u001b[0m\u001b[0;34m,\u001b[0m \u001b[0mend\u001b[0m\u001b[0;34m=\u001b[0m\u001b[0;34m''\u001b[0m\u001b[0;34m)\u001b[0m\u001b[0;34m\u001b[0m\u001b[0;34m\u001b[0m\u001b[0m\n", - "\u001b[0;31mKeyboardInterrupt\u001b[0m: " - ] - } - ], + "outputs": [], "source": [ "sim.run()" ] diff --git a/python/swiftest/swiftest/simulation_class.py b/python/swiftest/swiftest/simulation_class.py index c15da7ba9..1996b1625 100644 --- a/python/swiftest/swiftest/simulation_class.py +++ b/python/swiftest/swiftest/simulation_class.py @@ -391,10 +391,10 @@ def run(self,**kwargs): env = os.environ.copy() driver_script = os.path.join(self.binary_path,"swiftest_driver.sh") with open(driver_script,'w') as f: - f.write(f"#{self._shell_full} -l {os.linesep}") - f.write(f"source ~/.{self._shell}rc {os.linesep}") - f.write(f"cd {self.sim_dir} {os.linesep}") - f.write(f"{str(self.driver_executable)} {self.integrator} {str(self.param_file)} {os.linesep}") + f.write(f"#{self._shell_full} -l\n") + f.write(f"source ~/.{self._shell}rc\n") + f.write(f"cd {self.sim_dir}\n") + f.write(f"{str(self.driver_executable)} {self.integrator} {str(self.param_file)} compact\n") cmd = f"{env['SHELL']} -l {driver_script}" oldline = None diff --git a/src/io/io.f90 b/src/io/io.f90 index 2c74a42ee..7296d00dd 100644 --- a/src/io/io.f90 +++ b/src/io/io.f90 @@ -36,17 +36,7 @@ module subroutine io_conservation_report(self, param, lterminal) "; D(Eorbit+Ecollisions)/|E0| = ", ES12.5, & "; DM/M0 = ", ES12.5)' - associate(system => self, pl => self%pl, cb => self%cb, npl => self%pl%nbody) - if (((param%out_type == REAL4_TYPE) .or. (param%out_type == REAL8_TYPE)) .and. (param%energy_out /= "")) then - if (param%lfirstenergy .and. (param%out_stat /= "OLD")) then - open(unit=EGYIU, file=param%energy_out, form="formatted", status="replace", action="write", err=667, iomsg=errmsg) - write(EGYIU,EGYHEADER, err=667, iomsg=errmsg) - else - open(unit=EGYIU, file=param%energy_out, form="formatted", status="old", action="write", & - position="append", err=667, iomsg=errmsg) - end if - end if - + associate(system => self, pl => self%pl, cb => self%cb, npl => self%pl%nbody, display_unit => param%display_unit) call pl%vb2vh(cb) call pl%xh2xb(cb) @@ -69,34 +59,22 @@ module subroutine io_conservation_report(self, param, lterminal) param%lfirstenergy = .false. end if - if (((param%out_type == REAL4_TYPE) .or. (param%out_type == REAL8_TYPE)) .and. (param%energy_out /= "")) then - write(EGYIU,EGYFMT, err = 667, iomsg = errmsg) param%t, Eorbit_now, system%Ecollisions, Ltot_now, GMtot_now - close(EGYIU, err = 667, iomsg = errmsg) - end if - if (.not.param%lfirstenergy) then Lerror = norm2(Ltot_now(:) - system%Ltot_orig(:)) / norm2(system%Ltot_orig(:)) Eorbit_error = (Eorbit_now - system%Eorbit_orig) / abs(system%Eorbit_orig) Ecoll_error = system%Ecollisions / abs(system%Eorbit_orig) Etotal_error = (Eorbit_now - system%Ecollisions - system%Eorbit_orig - system%Euntracked) / abs(system%Eorbit_orig) Merror = (GMtot_now - system%GMtot_orig) / system%GMtot_orig - if (lterminal) write(*, EGYTERMFMT) Lerror, Ecoll_error, Etotal_error, Merror + if (lterminal) write(display_unit, EGYTERMFMT) Lerror, Ecoll_error, Etotal_error, Merror if (abs(Merror) > 100 * epsilon(Merror)) then write(*,*) "Severe error! Mass not conserved! Halting!" - if ((param%out_type == REAL4_TYPE) .or. (param%out_type == REAL8_TYPE)) then - write(*,*) "Merror = ", Merror - write(*,*) "GMtot_now : ",GMtot_now - write(*,*) "GMtot_orig: ",system%GMtot_orig - write(*,*) "Difference: ",GMtot_now - system%GMtot_orig - else if ((param%out_type == NETCDF_FLOAT_TYPE) .or. (param%out_type == NETCDF_DOUBLE_TYPE)) then - ! Save the frame of data to the bin file in the slot just after the present one for diagnostics - param%ioutput = param%ioutput + 1_I8B - call pl%xv2el(cb) - call self%write_hdr(param%nciu, param) - call cb%write_frame(param%nciu, param) - call pl%write_frame(param%nciu, param) - call param%nciu%close() - end if + ! Save the frame of data to the bin file in the slot just after the present one for diagnostics + param%ioutput = param%ioutput + 1_I8B + call pl%xv2el(cb) + call self%write_hdr(param%nciu, param) + call cb%write_frame(param%nciu, param) + call pl%write_frame(param%nciu, param) + call param%nciu%close() call util_exit(FAILURE) end if end if @@ -346,7 +324,7 @@ module subroutine io_dump_system(self, param) end subroutine io_dump_system - module function io_get_args(integrator, param_file_name) result(ierr) + module subroutine io_get_args(integrator, param_file_name, display_style) !! author: David A. Minton !! !! Reads in the name of the parameter file from command line arguments. @@ -354,59 +332,70 @@ module function io_get_args(integrator, param_file_name) result(ierr) ! Arguments integer(I4B) :: integrator !! Symbolic code of the requested integrator character(len=:), allocatable :: param_file_name !! Name of the input parameters file - ! Result - integer(I4B) :: ierr !! I/O error code + character(len=:), allocatable :: display_style !! Style of the output display {"STANDARD", "COMPACT"}). Default is "STANDARD" ! Internals - character(len=STRMAX) :: arg1, arg2 - integer :: narg,ierr_arg1, ierr_arg2 + character(len=STRMAX), dimension(:), allocatable :: arg + integer(I4B), dimension(:), allocatable :: ierr + integer :: i,narg character(len=*),parameter :: linefmt = '(A)' - ierr = -1 ! Default is to fail - narg = command_argument_count() ! - if (narg == 2) then - call get_command_argument(1, arg1, status = ierr_arg1) - call get_command_argument(2, arg2, status = ierr_arg2) - if ((ierr_arg1 == 0) .and. (ierr_arg2 == 0)) then - ierr = 0 - call io_toupper(arg1) - select case(arg1) - case('BS') - integrator = BS - case('HELIO') - integrator = HELIO - case('RA15') - integrator = RA15 - case('TU4') - integrator = TU4 - case('WHM') - integrator = WHM - case('RMVS') - integrator = RMVS - case('SYMBA') - integrator = SYMBA - case('RINGMOONS') - integrator = RINGMOONS - case default - integrator = UNKNOWN_INTEGRATOR - write(*,*) trim(adjustl(arg1)) // ' is not a valid integrator.' - ierr = -1 - end select - param_file_name = trim(adjustl(arg2)) - end if - else - call get_command_argument(1, arg1, status = ierr_arg1) - if (ierr_arg1 == 0) then - if (arg1 == '-v' .or. arg1 == '--version') then - call util_version() - else if (arg1 == '-h' .or. arg1 == '--help') then - call util_exit(HELP) - end if + narg = command_argument_count() + if (narg > 0) then + allocate(arg(narg),ierr(narg)) + do i = 1,narg + call get_command_argument(i, arg(i), status = ierr(i)) + end do + if (any(ierr /= 0)) call util_exit(USAGE) + else + call util_exit(USAGE) + end if + + if (narg == 1) then + if (arg(1) == '-v' .or. arg(1) == '--version') then + call util_version() + else if (arg(1) == '-h' .or. arg(1) == '--help') then + call util_exit(HELP) + else + call util_exit(USAGE) end if + else if (narg >= 2) then + call io_toupper(arg(1)) + select case(arg(1)) + case('BS') + integrator = BS + case('HELIO') + integrator = HELIO + case('RA15') + integrator = RA15 + case('TU4') + integrator = TU4 + case('WHM') + integrator = WHM + case('RMVS') + integrator = RMVS + case('SYMBA') + integrator = SYMBA + case('RINGMOONS') + integrator = RINGMOONS + case default + integrator = UNKNOWN_INTEGRATOR + write(*,*) trim(adjustl(arg(1))) // ' is not a valid integrator.' + call util_exit(USAGE) + end select + param_file_name = trim(adjustl(arg(2))) + end if + + if (narg == 2) then + display_style = "STANDARD" + else if (narg == 3) then + call io_toupper(arg(3)) + display_style = trim(adjustl(arg(3))) + else + call util_exit(USAGE) end if - if (ierr /= 0) call util_exit(USAGE) return - end function io_get_args + end subroutine io_get_args module function io_get_old_t_final_system(self, param) result(old_t_final) @@ -555,7 +544,6 @@ module subroutine io_param_reader(self, unit, iotype, v_list, iostat, iomsg) !! !! Adapted from David E. Kaufmann's Swifter routine io_init_param.f90 !! Adapted from Martin Duncan's Swift routine io_init_param.f - use, intrinsic :: iso_fortran_env implicit none ! Arguments class(swiftest_parameters), intent(inout) :: self !! Collection of parameters @@ -940,7 +928,7 @@ module subroutine io_param_reader(self, unit, iotype, v_list, iostat, iomsg) iostat = 0 ! Print the contents of the parameter file to standard output - ! call param%writer(unit = OUTPUT_UNIT, iotype = "none", v_list = [0], iostat = iostat, iomsg = iomsg) + call param%writer(unit = param%display_unit, iotype = "none", v_list = [0], iostat = iostat, iomsg = iomsg) end associate @@ -1801,7 +1789,6 @@ module subroutine io_read_in_param(self, param_file_name) ! Read in name of parameter file write(*, *) 'Parameter input file is ', trim(adjustl(param_file_name)) - write(*, *) ' ' self%param_file_name = param_file_name !! todo: Currently this procedure does not work in user-defined derived-type input mode @@ -1913,6 +1900,41 @@ module subroutine io_read_particle_info_system(self, param) end subroutine io_read_particle_info_system + module subroutine io_set_display_param(self, display_style) + !! author: David A. Minton + !! + !! Sets the display style parameters. If display is "STANDARD" then output goes to stdout. If display is "COMPACT" + !! then it is redirected to a log file and a progress-bar is used for stdout + implicit none + ! Arguments + class(swiftest_parameters), intent(inout) :: self !! Current run configuration parameters + character(*), intent(in) :: display_style !! Style of the output display + ! Internals + character(STRMAX) :: errmsg + + select case(display_style) + case ('STANDARD') + self%display_unit = OUTPUT_UNIT !! stdout from iso_fortran_env + self%compact_display = .false. + case ('COMPACT') + open(unit=SWIFTEST_LOG_OUT, file=SWIFTEST_LOG_FILE, status='replace', err = 667, iomsg = errmsg) + self%display_unit = SWIFTEST_LOG_OUT + self%compact_display = .true. + case default + write(*,*) display_style, " is an unknown display style" + call util_exit(USAGE) + end select + + self%display_style = display_style + + return + + 667 continue + write(*,*) "Error opening swiftest log file: " // trim(adjustl(errmsg)) + call util_exit(FAILURE) + end subroutine io_set_display_param + + module subroutine io_toupper(string) !! author: David A. Minton !! @@ -1980,9 +2002,9 @@ module subroutine io_write_discard(self, param) case('APPEND') open(unit=LUN, file=param%discard_out, status='OLD', position='APPEND', form='FORMATTED', err=667, iomsg=errmsg) case('NEW', 'REPLACE', 'UNKNOWN') - open(unit=LUN, file=param%discard_out, status=param%out_stat, form='FORMATTED', err=667, iomsg=errmsg) + open(unit=LUN, file=param%discard_out, status=out_stat, form='FORMATTED', err=667, iomsg=errmsg) case default - write(*,*) 'Invalid status code for OUT_STAT: ',trim(adjustl(param%out_stat)) + write(*,*) 'Invalid status code for OUT_STAT: ',trim(adjustl(out_stat)) call util_exit(FAILURE) end select lfirst = .false. diff --git a/src/main/swiftest_driver.f90 b/src/main/swiftest_driver.f90 index 7b97eea43..ee8fda1f1 100644 --- a/src/main/swiftest_driver.f90 +++ b/src/main/swiftest_driver.f90 @@ -22,6 +22,7 @@ program swiftest_driver class(swiftest_parameters), allocatable :: param !! Run configuration parameters integer(I4B) :: integrator !! Integrator type code (see swiftest_globals for symbolic names) character(len=:),allocatable :: param_file_name !! Name of the file containing user-defined parameters + character(len=:), allocatable :: display_style !! Style of the output display {"STANDARD", "COMPACT"}). Default is "STANDARD" integer(I4B) :: ierr !! I/O error code integer(I8B) :: iloop !! Loop counter integer(I8B) :: idump !! Dump cadence counter @@ -36,14 +37,12 @@ program swiftest_driver '"; Number of active pl, tp = ", I5, ", ", I5)' character(*), parameter :: symbastatfmt = '("Time = ", ES12.5, "; fraction done = ", F6.3, ' // & '"; Number of active plm, pl, tp = ", I5, ", ", I5, ", ", I5)' - character(*), parameter :: pbarfmt = '("Time = ", ES12.5," of ",ES12.5)' + character(*), parameter :: pbarfmt = '("Time = ", G9.2," of ",G9.2)' character(len=64) :: pbarmessage - ierr = io_get_args(integrator, param_file_name) - if (ierr /= 0) then - write(*,*) 'Error reading in arguments from the command line' - call util_exit(FAILURE) - end if + + call io_get_args(integrator, param_file_name, display_style) + !> Read in the user-defined parameters file and the initial conditions of the system select case(integrator) case(symba) @@ -52,17 +51,28 @@ program swiftest_driver allocate(swiftest_parameters :: param) end select param%integrator = integrator + call param%set_display(display_style) + + !> Define the maximum number of threads + nthreads = 1 ! In the *serial* case + !$ nthreads = omp_get_max_threads() ! In the *parallel* case + !$ write(param%display_unit,'(a)') ' OpenMP parameters:' + !$ write(param%display_unit,'(a)') ' ------------------' + !$ write(param%display_unit,'(a,i3,/)') ' Number of threads = ', nthreads + !$ if (param%compact_display) write(*,'(a,i3)') ' OpenMP: Number of threads = ',nthreads call setup_construct_system(nbody_system, param) call param%read_in(param_file_name) - associate(t => param%t, & - t0 => param%t0, & - dt => param%dt, & - tstop => param%tstop, & - istep_out => param%istep_out, & - istep_dump => param%istep_dump, & - ioutput => param%ioutput) + associate(t => param%t, & + t0 => param%t0, & + dt => param%dt, & + tstop => param%tstop, & + istep_out => param%istep_out, & + istep_dump => param%istep_dump, & + ioutput => param%ioutput, & + display_unit => param%display_unit, & + compact_display => param%compact_display) call nbody_system%initialize(param) t = t0 @@ -83,17 +93,14 @@ program swiftest_driver if (istep_out > 0) call nbody_system%write_frame(param) end if - !> Define the maximum number of threads - nthreads = 1 ! In the *serial* case - !$ nthreads = omp_get_max_threads() ! In the *parallel* case - !$ write(*,'(a)') ' OpenMP parameters:' - !$ write(*,'(a)') ' ------------------' - !$ write(*,'(a,i3,/)') ' Number of threads = ', nthreads - !write(*, *) " *************** Main Loop *************** " + + write(display_unit, *) " *************** Main Loop *************** " if (param%lrestart .and. param%lenergy) call nbody_system%conservation_report(param, lterminal=.true.) - call pbar%reset(nloops) - write(pbarmessage,fmt=pbarfmt) t0, tstop - call pbar%update(1,message=pbarmessage) + if (compact_display) then + call pbar%reset(nloops) + write(pbarmessage,fmt=pbarfmt) t0, tstop + call pbar%update(1,message=pbarmessage) + end if do iloop = 1, nloops !> Step the system forward in time call integration_timer%start() @@ -104,7 +111,7 @@ program swiftest_driver !> Evaluate any discards or collisional outcomes call nbody_system%discard(param) - call pbar%update(iloop) + if (compact_display) call pbar%update(iloop) !> If the loop counter is at the output cadence value, append the data file with a single frame if (istep_out > 0) then @@ -115,19 +122,21 @@ program swiftest_driver tfrac = (param%t - param%t0) / (param%tstop - param%t0) - ! select type(pl => nbody_system%pl) - ! class is (symba_pl) - ! write(*, symbastatfmt) param%t, tfrac, pl%nplm, pl%nbody, nbody_system%tp%nbody - ! class default - ! write(*, statusfmt) param%t, tfrac, pl%nbody, nbody_system%tp%nbody - ! end select + select type(pl => nbody_system%pl) + class is (symba_pl) + write(display_unit, symbastatfmt) param%t, tfrac, pl%nplm, pl%nbody, nbody_system%tp%nbody + class default + write(display_unit, statusfmt) param%t, tfrac, pl%nbody, nbody_system%tp%nbody + end select if (param%lenergy) call nbody_system%conservation_report(param, lterminal=.true.) - !call integration_timer%report(message="Integration steps:", nsubsteps=istep_out) - !call integration_timer%reset() + call integration_timer%report(message="Integration steps:", unit=display_unit, nsubsteps=istep_out) + call integration_timer%reset() iout = istep_out - write(pbarmessage,fmt=pbarfmt) t, tstop - call pbar%update(1,message=pbarmessage) + if (compact_display) then + write(pbarmessage,fmt=pbarfmt) t, tstop + call pbar%update(1,message=pbarmessage) + end if end if end if diff --git a/src/modules/swiftest_classes.f90 b/src/modules/swiftest_classes.f90 index 6bbcb537b..e499f8332 100644 --- a/src/modules/swiftest_classes.f90 +++ b/src/modules/swiftest_classes.f90 @@ -72,6 +72,7 @@ module swiftest_classes character(NAMELEN) :: interaction_loops = "ADAPTIVE" !! Method used to compute interaction loops. Options are "TRIANGULAR", "FLAT", or "ADAPTIVE" character(NAMELEN) :: encounter_check_plpl = "ADAPTIVE" !! Method used to compute pl-pl encounter checks. Options are "TRIANGULAR", "SORTSWEEP", or "ADAPTIVE" character(NAMELEN) :: encounter_check_pltp = "ADAPTIVE" !! Method used to compute pl-tp encounter checks. Options are "TRIANGULAR", "SORTSWEEP", or "ADAPTIVE" + ! The following are used internally, and are not set by the user, but instead are determined by the input value of INTERACTION_LOOPS logical :: lflatten_interactions = .false. !! Use the flattened upper triangular matrix for pl-pl interaction loops logical :: ladaptive_interactions = .false. !! Adaptive interaction loop is turned on (choose between TRIANGULAR and FLAT based on periodic timing tests) @@ -104,6 +105,10 @@ module swiftest_classes logical :: lfirstkick = .true. !! Initiate the first kick in a symplectic step logical :: lrestart = .false. !! Indicates whether or not this is a restarted run + character(len=:), allocatable :: display_style !! Style of the output display {"STANDARD", "COMPACT"}). Default is "STANDARD" + integer(I4B) :: display_unit !! File unit number for display (either to stdout or to a log file) + logical :: compact_display = .false. !! Turns on the compact display + ! Future features not implemented or in development logical :: lgr = .false. !! Turn on GR logical :: lyarkovsky = .false. !! Turn on Yarkovsky effect @@ -111,10 +116,11 @@ module swiftest_classes type(netcdf_parameters) :: nciu !! Object containing NetCDF parameters contains - procedure :: reader => io_param_reader - procedure :: writer => io_param_writer - procedure :: dump => io_dump_param - procedure :: read_in => io_read_in_param + procedure :: reader => io_param_reader + procedure :: writer => io_param_writer + procedure :: dump => io_dump_param + procedure :: read_in => io_read_in_param + procedure :: set_display => io_set_display_param end type swiftest_parameters @@ -621,12 +627,12 @@ module subroutine io_dump_system(self, param) class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters end subroutine io_dump_system - module function io_get_args(integrator, param_file_name) result(ierr) + module subroutine io_get_args(integrator, param_file_name, display_style) implicit none integer(I4B) :: integrator !! Symbolic code of the requested integrator character(len=:), allocatable :: param_file_name !! Name of the input parameters file - integer(I4B) :: ierr !! I/O error code - end function io_get_args + character(len=:), allocatable :: display_style !! Style of the output display {"STANDARD", "COMPACT"}). Default is "STANDARD" + end subroutine io_get_args module function io_get_old_t_final_system(self, param) result(old_t_final) implicit none @@ -794,17 +800,23 @@ module subroutine io_read_particle_info_system(self, param) class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters end subroutine io_read_particle_info_system - module subroutine io_write_discard(self, param) + module subroutine io_set_display_param(self, display_style) implicit none - class(swiftest_nbody_system), intent(inout) :: self !! Swiftest system object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - end subroutine io_write_discard + class(swiftest_parameters), intent(inout) :: self !! Current run configuration parameters + character(*), intent(in) :: display_style !! Style of the output display + end subroutine io_set_display_param module subroutine io_toupper(string) implicit none character(*), intent(inout) :: string !! String to make upper case end subroutine io_toupper + module subroutine io_write_discard(self, param) + implicit none + class(swiftest_nbody_system), intent(inout) :: self !! Swiftest system object + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + end subroutine io_write_discard + module subroutine io_write_frame_body(self, iu, param) implicit none class(swiftest_body), intent(in) :: self !! Swiftest body object diff --git a/src/modules/swiftest_globals.f90 b/src/modules/swiftest_globals.f90 index f6644a302..dff9cad56 100644 --- a/src/modules/swiftest_globals.f90 +++ b/src/modules/swiftest_globals.f90 @@ -81,11 +81,6 @@ module swiftest_globals integer(I4B), parameter :: USAGE = -2 !! Symbolic name for function return/flag code for printing the usage message integer(I4B), parameter :: HELP = -3 !! Symbolic name for function return/flag code for printing the usage message - character(*), parameter :: SUCCESS_MSG = '(/, "Normal termination of Swiftest (version ", f3.1, ")")' - character(*), parameter :: FAIL_MSG = '(/, "Terminating Swiftest (version ", f3.1, ") due to error!!")' - character(*), parameter :: USAGE_MSG = '("Usage: swiftest [bs|helio|ra15|rmvs|symba|tu4|whm] ")' - character(*), parameter :: HELP_MSG = USAGE_MSG - integer(I4B), parameter :: ELLIPSE = -1 !! Symbolic names for orbit types - ellipse integer(I4B), parameter :: PARABOLA = 0 !! Symbolic names for orbit types - parabola integer(I4B), parameter :: HYPERBOLA = 1 !! Symbolic names for orbit types - hyperbola @@ -123,11 +118,13 @@ module swiftest_globals !> Standard file names integer(I4B), parameter :: NDUMPFILES = 2 - character(*), dimension(2), parameter :: DUMP_CB_FILE = ['dump_cb1.bin', 'dump_cb2.bin' ] - character(*), dimension(2), parameter :: DUMP_PL_FILE = ['dump_pl1.bin', 'dump_pl2.bin' ] - character(*), dimension(2), parameter :: DUMP_TP_FILE = ['dump_tp1.bin', 'dump_tp2.bin' ] - character(*), dimension(2), parameter :: DUMP_NC_FILE = ['dump_bin1.nc', 'dump_bin2.nc' ] + character(*), dimension(2), parameter :: DUMP_CB_FILE = ['dump_cb1.bin', 'dump_cb2.bin' ] + character(*), dimension(2), parameter :: DUMP_PL_FILE = ['dump_pl1.bin', 'dump_pl2.bin' ] + character(*), dimension(2), parameter :: DUMP_TP_FILE = ['dump_tp1.bin', 'dump_tp2.bin' ] + character(*), dimension(2), parameter :: DUMP_NC_FILE = ['dump_bin1.nc', 'dump_bin2.nc' ] character(*), dimension(2), parameter :: DUMP_PARAM_FILE = ['dump_param1.in', 'dump_param2.in'] + character(*), parameter :: SWIFTEST_LOG_FILE = "swiftest.log" !! Name of file to use to log output when using "COMPACT" display style + integer(I4B), parameter :: SWIFTEST_LOG_OUT = 33 !! File unit for log file when using "COMPACT" display style !> Default file names that can be changed by the user in the parameters file character(*), parameter :: CB_INFILE = 'cb.in' diff --git a/src/modules/walltime_classes.f90 b/src/modules/walltime_classes.f90 index 0dc3f2892..536272b44 100644 --- a/src/modules/walltime_classes.f90 +++ b/src/modules/walltime_classes.f90 @@ -29,6 +29,8 @@ module walltime_classes integer(I8B) :: count_stop_step !! Value of the clock ticker at the end of a timed step integer(I8B) :: count_pause !! Value of the clock ticker at the end of a timed step real(DP) :: wall_step !! Value of the step elapsed time + real(DP) :: wall_main !! Value of the main clock elapsed time + real(DP) :: wall_per_substep !! Value of time per substep logical :: main_is_started = .false. !! Logical flag indicating whether or not the main timer has been reset or not logical :: is_paused = .false. !! Logical flag indicating whether or not the timer is paused @@ -60,10 +62,11 @@ module walltime_classes end type interaction_timer interface - module subroutine walltime_report(self, message, nsubsteps) + module subroutine walltime_report(self, message, unit, nsubsteps) implicit none class(walltimer), intent(inout) :: self !! Walltimer object character(len=*), intent(in) :: message !! Message to prepend to the wall time terminal output + integer(I4B), intent(in) :: unit !! Output file unit for report text to be directed integer(I4B), optional, intent(in) :: nsubsteps !! Number of substeps used to compute the time per step end subroutine walltime_report diff --git a/src/util/util_exit.f90 b/src/util/util_exit.f90 index 61dacdf99..65d92206d 100644 --- a/src/util/util_exit.f90 +++ b/src/util/util_exit.f90 @@ -23,6 +23,10 @@ module subroutine util_exit(code) integer(I4B), intent(in) :: code ! Internals character(*), parameter :: BAR = '("------------------------------------------------")' + character(*), parameter :: SUCCESS_MSG = '(/, "Normal termination of Swiftest (version ", f3.1, ")")' + character(*), parameter :: FAIL_MSG = '(/, "Terminating Swiftest (version ", f3.1, ") due to error!!")' + character(*), parameter :: USAGE_MSG = '("Usage: swiftest [bs|helio|ra15|rmvs|symba|tu4|whm] [standard|compact|NONE]")' + character(*), parameter :: HELP_MSG = USAGE_MSG select case(code) case(SUCCESS) diff --git a/src/walltime/walltime.f90 b/src/walltime/walltime.f90 index 6c53e2276..104b63d95 100644 --- a/src/walltime/walltime.f90 +++ b/src/walltime/walltime.f90 @@ -38,7 +38,7 @@ module subroutine walltime_stop(self) end subroutine walltime_stop - module subroutine walltime_report(self, message, nsubsteps) + module subroutine walltime_report(self, message, unit, nsubsteps) !! author: David A. Minton !! !! Prints the elapsed time information to the terminal @@ -46,6 +46,7 @@ module subroutine walltime_report(self, message, nsubsteps) ! Arguments class(walltimer), intent(inout) :: self !! Walltimer object character(len=*), intent(in) :: message !! Message to prepend to the wall time terminal output + integer(I4B), intent(in) :: unit !! Output file unit for report text to be directed integer(I4B), optional, intent(in) :: nsubsteps !! Number of substeps used to compute the time per step ! Internals character(len=*), parameter :: nosubstepfmt = '" Total wall time: ", es12.5, "; Interval wall time: ", es12.5 ' @@ -53,9 +54,6 @@ module subroutine walltime_report(self, message, nsubsteps) 'Interval wall time/step: ", es12.5' character(len=STRMAX) :: fmt integer(I8B) :: count_delta_step, count_delta_main, count_now - real(DP) :: wall_main !! Value of total elapsed time at the end of a timed step - real(DP) :: wall_step !! Value of elapsed time since the start of a timed step - real(DP) :: wall_per_substep !! Value of time per substep if (.not.self%main_is_started) then write(*,*) "Wall timer error: The step finish time cannot be calculated because the timer is not started!" @@ -65,18 +63,17 @@ module subroutine walltime_report(self, message, nsubsteps) call system_clock(count_now) count_delta_main = count_now - self%count_start_main count_delta_step = count_now - self%count_start_step - wall_main = count_delta_main / (self%count_rate * 1.0_DP) - wall_step = count_delta_step / (self%count_rate * 1.0_DP) + self%wall_main = count_delta_main / (self%count_rate * 1.0_DP) + self%wall_step = count_delta_step / (self%count_rate * 1.0_DP) if (present(nsubsteps)) then - wall_per_substep = wall_step / nsubsteps + self%wall_per_substep = self%wall_step / nsubsteps fmt = '("' // adjustl(message) // '",' // substepfmt // ')' - write(*,trim(adjustl(fmt))) wall_main, self%wall_step, wall_per_substep + write(unit,trim(adjustl(fmt))) self%wall_main, self%wall_step, self%wall_per_substep else fmt = '("' // adjustl(message) // '",' // nosubstepfmt // ')' - write(*,trim(adjustl(fmt))) wall_main, self%wall_step + write(unit,trim(adjustl(fmt))) self%wall_main, self%wall_step end if - return end subroutine walltime_report @@ -92,6 +89,7 @@ module subroutine walltime_reset(self) self%is_paused = .false. self%wall_step = 0.0_DP + self%wall_per_substep = 0.0_DP return end subroutine walltime_reset @@ -107,6 +105,7 @@ module subroutine walltime_start_main(self) call system_clock(self%count_start_main, self%count_rate, self%count_max) self%main_is_started = .true. + self%wall_main = 0.0_DP return end subroutine walltime_start_main @@ -123,7 +122,6 @@ module subroutine walltime_start(self) ! Internals integer(I8B) :: count_resume, count_delta - if (.not.self%main_is_started) then call self%reset() call self%start_main() From 8434e68b6304f84c2e87a9be1f56783e907e5e27 Mon Sep 17 00:00:00 2001 From: David Minton Date: Mon, 21 Nov 2022 11:09:26 -0500 Subject: [PATCH 107/569] Re-enabled exception catching and started the process of adding curses so I can make a more useful output display --- python/swiftest/swiftest/simulation_class.py | 46 ++++++++++---------- 1 file changed, 24 insertions(+), 22 deletions(-) diff --git a/python/swiftest/swiftest/simulation_class.py b/python/swiftest/swiftest/simulation_class.py index 1996b1625..b2620d7b1 100644 --- a/python/swiftest/swiftest/simulation_class.py +++ b/python/swiftest/swiftest/simulation_class.py @@ -18,7 +18,7 @@ import json import os from pathlib import Path -import sys +import curses import datetime import xarray as xr import numpy as np @@ -397,27 +397,29 @@ def run(self,**kwargs): f.write(f"{str(self.driver_executable)} {self.integrator} {str(self.param_file)} compact\n") cmd = f"{env['SHELL']} -l {driver_script}" - oldline = None - with subprocess.Popen(shlex.split(cmd), - stdout=subprocess.PIPE, - stderr=subprocess.PIPE, - env=env, - universal_newlines=True) as p: - for line in p.stdout: - if '[' in line: - print(line.replace('\n','\r'), end='') - elif "Normal termination" in line: - print(line.replace("Normal termination","\n\nNormal termination"),end='') - else: - print(line, end='') - res = p.communicate() - if p.returncode != 0: - for line in res[1]: - print(line, end='') - raise Exception ("Failure in swiftest_driver") - #except: - # warnings.warn(f"Error executing main swiftest_driver program",stacklevel=2) - # return + + stdscr = curses.initscr() + try: + with subprocess.Popen(shlex.split(cmd), + stdout=subprocess.PIPE, + stderr=subprocess.PIPE, + env=env, + universal_newlines=True) as p: + for line in p.stdout: + if '[' in line: + print(line.replace('\n','\r'), end='') + elif "Normal termination" in line: + print(line.replace("Normal termination","\n\nNormal termination"),end='') + else: + print(line, end='') + res = p.communicate() + if p.returncode != 0: + for line in res[1]: + print(line, end='') + warnings.warn("Failure in swiftest_driver", stacklevel=2) + except: + warnings.warn(f"Error executing main swiftest_driver program",stacklevel=2) + return # Read in new data self.bin2xr() From 0168fabb135d5d2588c114030a4248260e81af42 Mon Sep 17 00:00:00 2001 From: David Minton Date: Mon, 21 Nov 2022 11:41:27 -0500 Subject: [PATCH 108/569] Added in the curses wrapper --- python/swiftest/swiftest/simulation_class.py | 73 +++++++++++--------- 1 file changed, 40 insertions(+), 33 deletions(-) diff --git a/python/swiftest/swiftest/simulation_class.py b/python/swiftest/swiftest/simulation_class.py index b2620d7b1..5bb086ebb 100644 --- a/python/swiftest/swiftest/simulation_class.py +++ b/python/swiftest/swiftest/simulation_class.py @@ -353,6 +353,45 @@ def __init__(self,read_param: bool = True, **kwargs: Any): warnings.warn(f"BIN_OUT file {binpath} not found.",stacklevel=2) return + def _run_swiftest_driver(self): + """ + Internal callable function that executes the swiftest_driver run + """ + + # Get current environment variables + + env = os.environ.copy() + driver_script = os.path.join(self.binary_path, "swiftest_driver.sh") + with open(driver_script, 'w') as f: + f.write(f"#{self._shell_full} -l\n") + f.write(f"source ~/.{self._shell}rc\n") + f.write(f"cd {self.sim_dir}\n") + f.write(f"{str(self.driver_executable)} {self.integrator} {str(self.param_file)} compact\n") + + cmd = f"{env['SHELL']} -l {driver_script}" + + try: + with subprocess.Popen(shlex.split(cmd), + stdout=subprocess.PIPE, + stderr=subprocess.PIPE, + env=env, + universal_newlines=True) as p: + for line in p.stdout: + if '[' in line: + print(line.replace('\n', '\r'), end='') + elif "Normal termination" in line: + print(line.replace("Normal termination", "\n\nNormal termination"), end='') + else: + print(line, end='') + res = p.communicate() + if p.returncode != 0: + for line in res[1]: + print(line, end='') + warnings.warn("Failure in swiftest_driver", stacklevel=2) + except: + warnings.warn(f"Error executing main swiftest_driver program", stacklevel=2) + + return def run(self,**kwargs): """ @@ -387,39 +426,7 @@ def run(self,**kwargs): print(f"Running a {self.codename} {self.integrator} run from tstart={self.param['TSTART']} {self.TU_name} to tstop={self.param['TSTOP']} {self.TU_name}") - # Get current environment variables - env = os.environ.copy() - driver_script = os.path.join(self.binary_path,"swiftest_driver.sh") - with open(driver_script,'w') as f: - f.write(f"#{self._shell_full} -l\n") - f.write(f"source ~/.{self._shell}rc\n") - f.write(f"cd {self.sim_dir}\n") - f.write(f"{str(self.driver_executable)} {self.integrator} {str(self.param_file)} compact\n") - - cmd = f"{env['SHELL']} -l {driver_script}" - - stdscr = curses.initscr() - try: - with subprocess.Popen(shlex.split(cmd), - stdout=subprocess.PIPE, - stderr=subprocess.PIPE, - env=env, - universal_newlines=True) as p: - for line in p.stdout: - if '[' in line: - print(line.replace('\n','\r'), end='') - elif "Normal termination" in line: - print(line.replace("Normal termination","\n\nNormal termination"),end='') - else: - print(line, end='') - res = p.communicate() - if p.returncode != 0: - for line in res[1]: - print(line, end='') - warnings.warn("Failure in swiftest_driver", stacklevel=2) - except: - warnings.warn(f"Error executing main swiftest_driver program",stacklevel=2) - return + curses.wrapper(self._run_swiftest_driver()) # Read in new data self.bin2xr() From fb1764fade0c49a2dcf40dc0ee357c91d32532c5 Mon Sep 17 00:00:00 2001 From: David Minton Date: Mon, 21 Nov 2022 12:12:10 -0500 Subject: [PATCH 109/569] Decided to go with tqdm instead of curses --- python/swiftest/swiftest/simulation_class.py | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/python/swiftest/swiftest/simulation_class.py b/python/swiftest/swiftest/simulation_class.py index 5bb086ebb..537546e3d 100644 --- a/python/swiftest/swiftest/simulation_class.py +++ b/python/swiftest/swiftest/simulation_class.py @@ -18,7 +18,6 @@ import json import os from pathlib import Path -import curses import datetime import xarray as xr import numpy as np @@ -426,7 +425,7 @@ def run(self,**kwargs): print(f"Running a {self.codename} {self.integrator} run from tstart={self.param['TSTART']} {self.TU_name} to tstop={self.param['TSTOP']} {self.TU_name}") - curses.wrapper(self._run_swiftest_driver()) + self._run_swiftest_driver() # Read in new data self.bin2xr() From 49f5433ce387c5391cee368e27b656c5eb61860a Mon Sep 17 00:00:00 2001 From: David A Minton Date: Mon, 21 Nov 2022 12:13:21 -0500 Subject: [PATCH 110/569] Restructured code so that there is a progress display option for the bare-bones progress bar, and the compact option will be text only to be read in by the Python code and interpreted by a tqdm progress bar --- src/io/io.f90 | 12 ++++++------ src/main/swiftest_driver.f90 | 14 +++++++------- src/modules/swiftest_classes.f90 | 6 +++--- src/util/util_exit.f90 | 2 +- 4 files changed, 17 insertions(+), 17 deletions(-) diff --git a/src/io/io.f90 b/src/io/io.f90 index 7296d00dd..e93cc265e 100644 --- a/src/io/io.f90 +++ b/src/io/io.f90 @@ -332,7 +332,7 @@ module subroutine io_get_args(integrator, param_file_name, display_style) ! Arguments integer(I4B) :: integrator !! Symbolic code of the requested integrator character(len=:), allocatable :: param_file_name !! Name of the input parameters file - character(len=:), allocatable :: display_style !! Style of the output display {"STANDARD", "COMPACT"}). Default is "STANDARD" + character(len=:), allocatable :: display_style !! Style of the output display {"STANDARD", "COMPACT", "PROGRESS"}). Default is "STANDARD" ! Internals character(len=STRMAX), dimension(:), allocatable :: arg integer(I4B), dimension(:), allocatable :: ierr @@ -1788,7 +1788,7 @@ 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(*, *) 'Parameter input file is ', trim(adjustl(param_file_name)) + write(self%display_unit, *) 'Parameter input file is ', trim(adjustl(param_file_name)) self%param_file_name = param_file_name !! todo: Currently this procedure does not work in user-defined derived-type input mode @@ -1799,7 +1799,7 @@ module subroutine io_read_in_param(self, param_file_name) if (ierr == 0) return 667 continue - write(*,*) "Error reading parameter file: " // trim(adjustl(errmsg)) + write(self%display_unit,*) "Error reading parameter file: " // trim(adjustl(errmsg)) call util_exit(FAILURE) end subroutine io_read_in_param @@ -1915,11 +1915,11 @@ module subroutine io_set_display_param(self, display_style) select case(display_style) case ('STANDARD') self%display_unit = OUTPUT_UNIT !! stdout from iso_fortran_env - self%compact_display = .false. - case ('COMPACT') + self%log_output = .false. + case ('COMPACT', 'PROGRESS') open(unit=SWIFTEST_LOG_OUT, file=SWIFTEST_LOG_FILE, status='replace', err = 667, iomsg = errmsg) self%display_unit = SWIFTEST_LOG_OUT - self%compact_display = .true. + self%log_output = .true. case default write(*,*) display_style, " is an unknown display style" call util_exit(USAGE) diff --git a/src/main/swiftest_driver.f90 b/src/main/swiftest_driver.f90 index ee8fda1f1..14403faa2 100644 --- a/src/main/swiftest_driver.f90 +++ b/src/main/swiftest_driver.f90 @@ -22,7 +22,7 @@ program swiftest_driver class(swiftest_parameters), allocatable :: param !! Run configuration parameters integer(I4B) :: integrator !! Integrator type code (see swiftest_globals for symbolic names) character(len=:),allocatable :: param_file_name !! Name of the file containing user-defined parameters - character(len=:), allocatable :: display_style !! Style of the output display {"STANDARD", "COMPACT"}). Default is "STANDARD" + character(len=:), allocatable :: display_style !! Style of the output display {"STANDARD", "COMPACT", "PROGRESS"}). Default is "STANDARD" integer(I4B) :: ierr !! I/O error code integer(I8B) :: iloop !! Loop counter integer(I8B) :: idump !! Dump cadence counter @@ -59,7 +59,7 @@ program swiftest_driver !$ write(param%display_unit,'(a)') ' OpenMP parameters:' !$ write(param%display_unit,'(a)') ' ------------------' !$ write(param%display_unit,'(a,i3,/)') ' Number of threads = ', nthreads - !$ if (param%compact_display) write(*,'(a,i3)') ' OpenMP: Number of threads = ',nthreads + !$ if (param%log_output) write(*,'(a,i3)') ' OpenMP: Number of threads = ',nthreads call setup_construct_system(nbody_system, param) call param%read_in(param_file_name) @@ -71,8 +71,8 @@ program swiftest_driver istep_out => param%istep_out, & istep_dump => param%istep_dump, & ioutput => param%ioutput, & - display_unit => param%display_unit, & - compact_display => param%compact_display) + display_style => param%display_style, & + display_unit => param%display_unit) call nbody_system%initialize(param) t = t0 @@ -96,7 +96,7 @@ program swiftest_driver write(display_unit, *) " *************** Main Loop *************** " if (param%lrestart .and. param%lenergy) call nbody_system%conservation_report(param, lterminal=.true.) - if (compact_display) then + if (display_style == "PROGRESS") then call pbar%reset(nloops) write(pbarmessage,fmt=pbarfmt) t0, tstop call pbar%update(1,message=pbarmessage) @@ -111,7 +111,7 @@ program swiftest_driver !> Evaluate any discards or collisional outcomes call nbody_system%discard(param) - if (compact_display) call pbar%update(iloop) + if (display_style == "PROGRESS") call pbar%update(iloop) !> If the loop counter is at the output cadence value, append the data file with a single frame if (istep_out > 0) then @@ -133,7 +133,7 @@ program swiftest_driver call integration_timer%reset() iout = istep_out - if (compact_display) then + if (display_style == "PROGRESS") then write(pbarmessage,fmt=pbarfmt) t, tstop call pbar%update(1,message=pbarmessage) end if diff --git a/src/modules/swiftest_classes.f90 b/src/modules/swiftest_classes.f90 index e499f8332..78b82d43b 100644 --- a/src/modules/swiftest_classes.f90 +++ b/src/modules/swiftest_classes.f90 @@ -105,9 +105,9 @@ module swiftest_classes logical :: lfirstkick = .true. !! Initiate the first kick in a symplectic step logical :: lrestart = .false. !! Indicates whether or not this is a restarted run - character(len=:), allocatable :: display_style !! Style of the output display {"STANDARD", "COMPACT"}). Default is "STANDARD" - integer(I4B) :: display_unit !! File unit number for display (either to stdout or to a log file) - logical :: compact_display = .false. !! Turns on the compact display + character(len=:), allocatable :: display_style !! Style of the output display {"STANDARD", "COMPACT"}). Default is "STANDARD" + integer(I4B) :: display_unit !! File unit number for display (either to stdout or to a log file) + logical :: log_output = .false. !! Logs the output to file instead of displaying it on the terminal ! Future features not implemented or in development logical :: lgr = .false. !! Turn on GR diff --git a/src/util/util_exit.f90 b/src/util/util_exit.f90 index 65d92206d..a7b77c197 100644 --- a/src/util/util_exit.f90 +++ b/src/util/util_exit.f90 @@ -25,7 +25,7 @@ module subroutine util_exit(code) character(*), parameter :: BAR = '("------------------------------------------------")' character(*), parameter :: SUCCESS_MSG = '(/, "Normal termination of Swiftest (version ", f3.1, ")")' character(*), parameter :: FAIL_MSG = '(/, "Terminating Swiftest (version ", f3.1, ") due to error!!")' - character(*), parameter :: USAGE_MSG = '("Usage: swiftest [bs|helio|ra15|rmvs|symba|tu4|whm] [standard|compact|NONE]")' + character(*), parameter :: USAGE_MSG = '("Usage: swiftest [bs|helio|ra15|rmvs|symba|tu4|whm] [standard|compact|progress|NONE]")' character(*), parameter :: HELP_MSG = USAGE_MSG select case(code) From a8fbe060fdc7de28941dfe69cf9ba7731364650c Mon Sep 17 00:00:00 2001 From: David A Minton Date: Mon, 21 Nov 2022 12:14:48 -0500 Subject: [PATCH 111/569] Went back to scientific notation for progress bar output --- src/main/swiftest_driver.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/main/swiftest_driver.f90 b/src/main/swiftest_driver.f90 index 14403faa2..4cd537632 100644 --- a/src/main/swiftest_driver.f90 +++ b/src/main/swiftest_driver.f90 @@ -37,7 +37,7 @@ program swiftest_driver '"; Number of active pl, tp = ", I5, ", ", I5)' character(*), parameter :: symbastatfmt = '("Time = ", ES12.5, "; fraction done = ", F6.3, ' // & '"; Number of active plm, pl, tp = ", I5, ", ", I5, ", ", I5)' - character(*), parameter :: pbarfmt = '("Time = ", G9.2," of ",G9.2)' + character(*), parameter :: pbarfmt = '("Time = ", ES12.5," of ",ES12.5)' character(len=64) :: pbarmessage From 6f90ed3565fdf2b55b92e895664f5e9a9840c0c2 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Mon, 21 Nov 2022 13:41:33 -0500 Subject: [PATCH 112/569] switched to progress bar mode for now --- python/swiftest/swiftest/simulation_class.py | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/python/swiftest/swiftest/simulation_class.py b/python/swiftest/swiftest/simulation_class.py index 537546e3d..113bab9a9 100644 --- a/python/swiftest/swiftest/simulation_class.py +++ b/python/swiftest/swiftest/simulation_class.py @@ -365,7 +365,7 @@ def _run_swiftest_driver(self): f.write(f"#{self._shell_full} -l\n") f.write(f"source ~/.{self._shell}rc\n") f.write(f"cd {self.sim_dir}\n") - f.write(f"{str(self.driver_executable)} {self.integrator} {str(self.param_file)} compact\n") + f.write(f"{str(self.driver_executable)} {self.integrator} {str(self.param_file)} progress\n") cmd = f"{env['SHELL']} -l {driver_script}" From adb4ea3550e9165a0b64498a8170238ad853ca76 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Mon, 21 Nov 2022 17:05:19 -0500 Subject: [PATCH 113/569] Added new 'COMPACT' output format that will eventually be parsed by the Python side --- src/io/io.f90 | 69 +++++++++++++++++++++++++++----- src/main/swiftest_driver.f90 | 17 +++++--- src/modules/swiftest_classes.f90 | 30 +++++++++++++- 3 files changed, 99 insertions(+), 17 deletions(-) diff --git a/src/io/io.f90 b/src/io/io.f90 index e93cc265e..974c6aae0 100644 --- a/src/io/io.f90 +++ b/src/io/io.f90 @@ -12,6 +12,44 @@ contains + module subroutine io_compact_output(self, param, timer) + !! author: David Minton + !! + !! Generates the terminal output displayed when display_style is set to COMPACT. This is used by the Python driver to + !! make nice-looking progress reports. + implicit none + ! Arguments + class(swiftest_nbody_system), intent(in) :: self !! Swiftest nbody system object + class(swiftest_parameters), intent(in) :: param !! Input colleciton of user-defined parameters + class(*), intent(in) :: timer !! Object used for computing elapsed wall time (must be unlimited polymorphic because the walltimer module requires swiftest_classes) + ! Internals + character(*), parameter :: COMPACTFMT = '("ILOOP",I,";T",ES23.16,";WT",ES23.16,";IWT",ES23.16,";WTPS",ES23.16,";NPL",I,";NTP",I,";"$)' + character(*), parameter :: SYMBAFMT = '(";NPLM",I,$)' + character(*), parameter :: EGYFMT = '("LTOTERR",ES24.16,";ETOTERR",ES24.16,";MTOTERR",ES24.16,";KEOERR",ES24.16,";KESERR",ES24.16,";PEERR",ES24.16' & + // '";EORBERR",ES24.16,";ECOLERR",ES24.16,";EUNTRERR",ES24.16,";LSPINERR",ES24.16,";LESCERR",ES24.16' & + // '";MESCERR",ES24.16,$)' + select type(timer) + class is (walltimer) + if (.not. timer%main_is_started) then ! This is the start of a new run + write(*,*) "START" + write(*,COMPACTFMT) 0,param%t,0.0,0.0,0.0,self%pl%nbody, self%tp%nbody + else + write(*,COMPACTFMT) param%iloop,param%t, timer%wall_main, timer%wall_step, timer%wall_per_substep,self%pl%nbody, self%tp%nbody + end if + select type(pl => self%pl) + class is (symba_pl) + write(*,SYMBAFMT) pl%nplm + end select + if (param%lenergy) then + write(*,EGYFMT) self%Ltot_error, self%Etot_error, self%Mtot_error, self%ke_orbit_error, self%ke_spin_error, self%pe_error, & + self%Eorbit_error, self%Ecoll_error, self%Euntracked_error, self%Lspin_error, self%Lescape_error, self%Mescape_error + end if + write(*,*) + end select + return + end subroutine io_compact_output + + module subroutine io_conservation_report(self, param, lterminal) !! author: The Purdue Swiftest Team - David A. Minton, Carlisle A. Wishard, Jennifer L.L. Pouplin, and Jacob R. Elliott !! @@ -24,19 +62,18 @@ module subroutine io_conservation_report(self, param, lterminal) ! Internals real(DP), dimension(NDIM) :: Ltot_now, Lorbit_now, Lspin_now real(DP) :: ke_orbit_now, ke_spin_now, pe_now, Eorbit_now - real(DP) :: Eorbit_error, Etotal_error, Ecoll_error + real(DP) :: Eorbit_error, Etot_error, Ecoll_error real(DP) :: GMtot_now real(DP) :: Lerror, Merror character(len=STRMAX) :: errmsg - character(len=*), parameter :: EGYFMT = '(ES23.16,10(",",ES23.16,:))' ! Format code for all simulation output - character(len=*), parameter :: EGYHEADER = '("t,Eorbit,Ecollisions,Lx,Ly,Lz,Mtot")' integer(I4B), parameter :: EGYIU = 72 - character(len=*), parameter :: EGYTERMFMT = '(" DL/L0 = ", ES12.5 & + character(len=*), parameter :: EGYTERMFMT = '(" DL/L0 = ", ES12.5 & "; DEcollisions/|E0| = ", ES12.5, & "; D(Eorbit+Ecollisions)/|E0| = ", ES12.5, & "; DM/M0 = ", ES12.5)' associate(system => self, pl => self%pl, cb => self%cb, npl => self%pl%nbody, display_unit => param%display_unit) + call pl%vb2vh(cb) call pl%xh2xb(cb) @@ -51,6 +88,9 @@ module subroutine io_conservation_report(self, param, lterminal) GMtot_now = system%GMtot + system%GMescape if (param%lfirstenergy) then + system%ke_orbit_orig = ke_orbit_now + system%ke_spin_orig = ke_spin_now + system%pe_orig = pe_now system%Eorbit_orig = Eorbit_now system%GMtot_orig = GMtot_now system%Lorbit_orig(:) = Lorbit_now(:) @@ -60,12 +100,21 @@ module subroutine io_conservation_report(self, param, lterminal) end if if (.not.param%lfirstenergy) then - Lerror = norm2(Ltot_now(:) - system%Ltot_orig(:)) / norm2(system%Ltot_orig(:)) - Eorbit_error = (Eorbit_now - system%Eorbit_orig) / abs(system%Eorbit_orig) - Ecoll_error = system%Ecollisions / abs(system%Eorbit_orig) - Etotal_error = (Eorbit_now - system%Ecollisions - system%Eorbit_orig - system%Euntracked) / abs(system%Eorbit_orig) - Merror = (GMtot_now - system%GMtot_orig) / system%GMtot_orig - if (lterminal) write(display_unit, EGYTERMFMT) Lerror, Ecoll_error, Etotal_error, Merror + system%ke_orbit_error = (ke_orbit_now - system%ke_orbit_orig) / abs(system%Eorbit_orig) + system%ke_spin_error = (ke_spin_now - system%ke_spin_orig) / abs(system%Eorbit_orig) + system%pe_error = (pe_now - system%pe_orig) / abs(system%Eorbit_orig) + system%Eorbit_error = (Eorbit_now - system%Eorbit_orig) / abs(system%Eorbit_orig) + system%Ecoll_error = system%Ecollisions / abs(system%Eorbit_orig) + system%Euntracked_error = system%Euntracked / abs(system%Eorbit_orig) + system%Etot_error = (Eorbit_now - system%Ecollisions - system%Eorbit_orig - system%Euntracked) / abs(system%Eorbit_orig) + + system%Lorbit_error = norm2(Lorbit_now(:) - system%Lorbit_orig(:)) / norm2(system%Ltot_orig(:)) + system%Lspin_error = norm2(Lspin_now(:) - system%Lspin_orig(:)) / norm2(system%Ltot_orig(:)) + system%Lescape_error = norm2(system%Lescape(:)) / norm2(system%Ltot_orig(:)) + system%Ltot_error = norm2(Ltot_now(:) - system%Ltot_orig(:)) / norm2(system%Ltot_orig(:)) + system%Mescape_error = system%GMescape / system%GMtot_orig + system%Mtot_error = (GMtot_now - system%GMtot_orig) / system%GMtot_orig + if (lterminal) write(display_unit, EGYTERMFMT) system%Ltot_error, system%Ecoll_error, system%Etot_error,system%Mtot_error if (abs(Merror) > 100 * epsilon(Merror)) 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 diff --git a/src/main/swiftest_driver.f90 b/src/main/swiftest_driver.f90 index 4cd537632..e557cbdfa 100644 --- a/src/main/swiftest_driver.f90 +++ b/src/main/swiftest_driver.f90 @@ -24,7 +24,6 @@ program swiftest_driver 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(I4B) :: ierr !! I/O error code - integer(I8B) :: iloop !! Loop counter integer(I8B) :: idump !! Dump cadence counter integer(I8B) :: iout !! Output cadence counter integer(I8B) :: ioutput_t0 !! The output frame counter at time 0 @@ -33,13 +32,15 @@ program swiftest_driver 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 - character(*), parameter :: statusfmt = '("Time = ", ES12.5, "; fraction done = ", F6.3, ' // & - '"; Number of active pl, tp = ", I5, ", ", I5)' - character(*), parameter :: symbastatfmt = '("Time = ", ES12.5, "; fraction done = ", F6.3, ' // & - '"; Number of active plm, pl, tp = ", I5, ", ", I5, ", ", I5)' + character(*), parameter :: statusfmt = '("Time = ", ES12.5, "; fraction done = ", F6.3, ' // & + '"; Number of active pl, tp = ", I6, ", ", I6)' + character(*), parameter :: symbastatfmt = '("Time = ", ES12.5, "; fraction done = ", F6.3, ' // & + '"; Number of active plm, pl, tp = ", I6, ", ", I6, ", ", I6)' character(*), parameter :: pbarfmt = '("Time = ", ES12.5," of ",ES12.5)' character(len=64) :: pbarmessage + character(*), parameter :: symbacompactfmt = '(";NPLM",ES22.15,$)' + call io_get_args(integrator, param_file_name, display_style) @@ -68,6 +69,7 @@ program swiftest_driver t0 => param%t0, & dt => param%dt, & tstop => param%tstop, & + iloop => param%iloop, & istep_out => param%istep_out, & istep_dump => param%istep_dump, & ioutput => param%ioutput, & @@ -93,13 +95,14 @@ program swiftest_driver if (istep_out > 0) call nbody_system%write_frame(param) end if - write(display_unit, *) " *************** Main Loop *************** " if (param%lrestart .and. param%lenergy) call nbody_system%conservation_report(param, lterminal=.true.) if (display_style == "PROGRESS") then call pbar%reset(nloops) write(pbarmessage,fmt=pbarfmt) t0, tstop call pbar%update(1,message=pbarmessage) + else if (display_style == "COMPACT") then + call nbody_system%compact_output(param,integration_timer) end if do iloop = 1, nloops !> Step the system forward in time @@ -136,6 +139,8 @@ program swiftest_driver if (display_style == "PROGRESS") then write(pbarmessage,fmt=pbarfmt) t, tstop call pbar%update(1,message=pbarmessage) + else if (display_style == "COMPACT") then + call nbody_system%compact_output(param,integration_timer) end if end if end if diff --git a/src/modules/swiftest_classes.f90 b/src/modules/swiftest_classes.f90 index 78b82d43b..26686c1d6 100644 --- a/src/modules/swiftest_classes.f90 +++ b/src/modules/swiftest_classes.f90 @@ -35,11 +35,12 @@ module swiftest_classes integer(I4B) :: integrator = UNKNOWN_INTEGRATOR !! Symbolic name of the nbody integrator used character(STRMAX) :: param_file_name = "param.in" !! The default name of the parameter input file integer(I4B) :: maxid = -1 !! The current maximum particle id number - integer(I4B) :: maxid_collision = 0 !! The current maximum collision id number + integer(I4B) :: maxid_collision = 0 !! The current maximum collision id number real(DP) :: t0 = -1.0_DP !! Integration start time real(DP) :: t = -1.0_DP !! Integration current time real(DP) :: tstop = -1.0_DP !! Integration stop time real(DP) :: dt = -1.0_DP !! Time step + integer(I8B) :: iloop = 0_I8B !! Main loop counter integer(I8B) :: ioutput = 0_I8B !! Output counter character(STRMAX) :: incbfile = CB_INFILE !! Name of input file for the central body character(STRMAX) :: inplfile = PL_INFILE !! Name of input file for massive bodies @@ -370,6 +371,9 @@ module swiftest_classes real(DP), dimension(NDIM) :: Lorbit = 0.0_DP !! System orbital angular momentum vector real(DP), dimension(NDIM) :: Lspin = 0.0_DP !! System spin angular momentum vector real(DP), dimension(NDIM) :: Ltot = 0.0_DP !! System angular momentum vector + real(DP) :: ke_orbit_orig = 0.0_DP!! Initial orbital kinetic energy + real(DP) :: ke_spin_orig = 0.0_DP!! Initial spin kinetic energy + real(DP) :: pe_orig = 0.0_DP !! Initial potential energy real(DP) :: Eorbit_orig = 0.0_DP !! Initial orbital energy real(DP) :: GMtot_orig = 0.0_DP !! Initial system mass real(DP), dimension(NDIM) :: Ltot_orig = 0.0_DP !! Initial total angular momentum vector @@ -379,6 +383,22 @@ module swiftest_classes real(DP) :: GMescape = 0.0_DP !! Mass of bodies that escaped the system (used for bookeeping) real(DP) :: Ecollisions = 0.0_DP !! Energy lost from system due to collisions real(DP) :: Euntracked = 0.0_DP !! Energy gained from system due to escaped bodies + + ! Energy, momentum, and mass errors (used in error reporting) + real(DP) :: ke_orbit_error = 0.0_DP + real(DP) :: ke_spin_error = 0.0_DP + real(DP) :: pe_error = 0.0_DP + real(DP) :: Eorbit_error = 0.0_DP + real(DP) :: Ecoll_error = 0.0_DP + real(DP) :: Euntracked_error = 0.0_DP + real(DP) :: Etot_error = 0.0_DP + real(DP) :: Lorbit_error = 0.0_DP + real(DP) :: Lspin_error = 0.0_DP + real(DP) :: Lescape_error = 0.0_DP + real(DP) :: Ltot_error = 0.0_DP + real(DP) :: Mtot_error = 0.0_DP + real(DP) :: Mescape_error = 0.0_DP + logical :: lbeg !! True if this is the beginning of a step. This is used so that test particle steps can be calculated !! separately from massive bodies. Massive body variables are saved at half steps, and passed to !! the test particles @@ -388,6 +408,7 @@ module swiftest_classes ! Concrete classes that are common to the basic integrator (only test particles considered for discard) procedure :: discard => discard_system !! Perform a discard step on the system + procedure :: compact_output => io_compact_output !! Prints out out terminal output when display_style is set to COMPACT procedure :: conservation_report => io_conservation_report !! Compute energy and momentum and print out the change with time procedure :: dump => io_dump_system !! Dump the state of the system to a file procedure :: get_old_t_final_bin => io_get_old_t_final_system !! Validates the dump file to check whether the dump file initial conditions duplicate the last frame of the binary output. @@ -589,6 +610,13 @@ pure module subroutine gr_vh2pv_body(self, param) class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters end subroutine gr_vh2pv_body + module subroutine io_compact_output(self, param, timer) + implicit none + class(swiftest_nbody_system), intent(in) :: self !! Swiftest nbody system object + class(swiftest_parameters), intent(in) :: param !! Input colleciton of user-defined parameters + class(*), intent(in) :: timer !! Object used for computing elapsed wall time + end subroutine io_compact_output + module subroutine io_conservation_report(self, param, lterminal) implicit none class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nbody system object From 568b29b266418be1499e879898b186ed18284e31 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Mon, 21 Nov 2022 17:11:11 -0500 Subject: [PATCH 114/569] Added check for unrecognized arguments --- python/swiftest/swiftest/simulation_class.py | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/python/swiftest/swiftest/simulation_class.py b/python/swiftest/swiftest/simulation_class.py index 113bab9a9..e4dae6068 100644 --- a/python/swiftest/swiftest/simulation_class.py +++ b/python/swiftest/swiftest/simulation_class.py @@ -727,6 +727,11 @@ def set_parameter(self, verbose: bool = True, **kwargs): if len(kwargs) == 0: kwargs = default_arguments + unrecognized = [k for k,v in kwargs.items() if k not in default_arguments] + if len(unrecognized) > 0: + for k in unrecognized: + warnings.warn(f'Unrecognized argument "{k}"',stacklevel=2) + # Add the verbose flag to the kwargs for passing down to the individual setters kwargs["verbose"] = verbose From c4424c549607d25ae2d31030c355b3a6f4cb1598 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Mon, 21 Nov 2022 17:28:08 -0500 Subject: [PATCH 115/569] Changed it so that it no longer says it is saving to files when adding bodies --- python/swiftest/swiftest/io.py | 5 ++-- python/swiftest/swiftest/simulation_class.py | 25 +++++++++++++++----- 2 files changed, 22 insertions(+), 8 deletions(-) diff --git a/python/swiftest/swiftest/io.py b/python/swiftest/swiftest/io.py index 672d762a3..3f5008bb9 100644 --- a/python/swiftest/swiftest/io.py +++ b/python/swiftest/swiftest/io.py @@ -1068,7 +1068,7 @@ def select_active_from_frame(ds, param, framenum=-1): return frame -def swiftest_xr2infile(ds, param, in_type="NETCDF_DOUBLE", infile_name=None,framenum=-1): +def swiftest_xr2infile(ds, param, in_type="NETCDF_DOUBLE", infile_name=None,framenum=-1,verbose=True): """ Writes a set of Swiftest input files from a single frame of a Swiftest xarray dataset @@ -1101,7 +1101,8 @@ def swiftest_xr2infile(ds, param, in_type="NETCDF_DOUBLE", infile_name=None,fram if infile_name is None: infile_name = param['NC_IN'] frame = unclean_string_values(frame) - print(f"Writing initial conditions to file {infile_name}") + if verbose: + print(f"Writing initial conditions to file {infile_name}") frame.to_netcdf(path=infile_name) return frame diff --git a/python/swiftest/swiftest/simulation_class.py b/python/swiftest/swiftest/simulation_class.py index e4dae6068..cc35103a6 100644 --- a/python/swiftest/swiftest/simulation_class.py +++ b/python/swiftest/swiftest/simulation_class.py @@ -2098,7 +2098,7 @@ def add_solar_system_body(self, J2=J2, J4=J4, t=t) dsnew = self._combine_and_fix_dsnew(dsnew) - self.save() + self.save(verbose=False) return dsnew @@ -2352,7 +2352,7 @@ def input_to_array(val,t,n=None): J2=J2, J4=J4,t=t) dsnew = self._combine_and_fix_dsnew(dsnew) - self.save() + self.save(verbose=False) return dsnew @@ -2483,7 +2483,14 @@ def write_param(self, param_file = self.param_file if param is None: param = self.param - print(f"Writing parameter inputs to file {param_file}") + + if "verbose" in kwargs: + verbose = kwargs['verbose'] + else: + verbose = self.verbose + + if verbose: + print(f"Writing parameter inputs to file {param_file}") param['! VERSION'] = f"{codename} input file" # Check to see if the parameter type matches the output type. If not, we need to convert @@ -2649,6 +2656,12 @@ def save(self, ------- None """ + + if "verbose" in kwargs: + verbose = kwargs['verbose'] + else: + verbose = self%verbose + if codename is None: codename = self.codename if param_file is None: @@ -2658,15 +2671,15 @@ def save(self, if codename == "Swiftest": infile_name = Path(self.sim_dir) / param['NC_IN'] - io.swiftest_xr2infile(ds=self.data, param=param, in_type=self.param['IN_TYPE'], infile_name=infile_name, framenum=framenum) - self.write_param(param_file=param_file) + io.swiftest_xr2infile(ds=self.data, param=param, in_type=self.param['IN_TYPE'], infile_name=infile_name, framenum=framenum, verbose=verbose) + self.write_param(param_file=param_file,**kwargs) elif codename == "Swifter": if codename == "Swiftest": swifter_param = io.swiftest2swifter_param(param) else: swifter_param = param io.swifter_xr2infile(self.data, swifter_param, framenum) - self.write_param(param_file, param=swifter_param) + self.write_param(param_file, param=swifter_param,**kwargs) else: warnings.warn(f'Saving to {codename} not supported',stacklevel=2) From 43afc025d79b673fa1820f1d3f6ef08fb91c3a5d Mon Sep 17 00:00:00 2001 From: David A Minton Date: Mon, 21 Nov 2022 20:24:38 -0500 Subject: [PATCH 116/569] Fixed issue where you couldn't generate initial conditions with just the Sun in them --- python/swiftest/swiftest/init_cond.py | 1 - python/swiftest/swiftest/simulation_class.py | 18 ++++++++++++------ 2 files changed, 12 insertions(+), 7 deletions(-) diff --git a/python/swiftest/swiftest/init_cond.py b/python/swiftest/swiftest/init_cond.py index ea28bcb8c..1d43fb599 100644 --- a/python/swiftest/swiftest/init_cond.py +++ b/python/swiftest/swiftest/init_cond.py @@ -329,7 +329,6 @@ def vec2xr(param: Dict, infodims = ['id', 'vec'] # 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) diff --git a/python/swiftest/swiftest/simulation_class.py b/python/swiftest/swiftest/simulation_class.py index cc35103a6..834f6e40a 100644 --- a/python/swiftest/swiftest/simulation_class.py +++ b/python/swiftest/swiftest/simulation_class.py @@ -2045,26 +2045,31 @@ def add_solar_system_body(self, body_list.append(init_cond.solar_system_horizons(n, self.param, date, idval=ephemeris_id[i])) #Convert the list receieved from the solar_system_horizons output and turn it into arguments to vec2xr - name,v1,v2,v3,v4,v5,v6,ephemeris_id,GMpl,Rpl,rhill,Ip1,Ip2,Ip3,rotx,roty,rotz,J2,J4 = tuple(np.squeeze(np.hsplit(np.array(body_list),19))) + if len(body_list) == 1: + name,v1,v2,v3,v4,v5,v6,ephemeris_id,GMpl,Rpl,rhill,Ip1,Ip2,Ip3,rotx,roty,rotz,J2,J4 = tuple(np.hsplit(np.array(body_list[0]),19)) + else: + name,v1,v2,v3,v4,v5,v6,ephemeris_id,GMpl,Rpl,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) - ephemeris_id = ephemeris_id.astype(int) + rhill = rhill.astype(np.float64) + J2 = J2.astype(np.float64) + J4 = J4.astype(np.float64) + GMpl = GMpl.astype(np.float64) Rpl = Rpl.astype(np.float64) - rhill = rhill.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) - J2 = J2.astype(np.float64) - J4 = J4.astype(np.float64) + if all(np.isnan(GMpl)): GMpl = None @@ -2098,7 +2103,8 @@ def add_solar_system_body(self, J2=J2, J4=J4, t=t) dsnew = self._combine_and_fix_dsnew(dsnew) - self.save(verbose=False) + if dsnew['npl'] > 0 or dsnew['ntp'] > 0: + self.save(verbose=False) return dsnew From f0fb208c21aa09ef622cbc2abae8dce1408c20e0 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Mon, 21 Nov 2022 22:52:57 -0500 Subject: [PATCH 117/569] Fixed bug where if you supply a floating point value for something that expects an integer, it raised an exception. Now it just converts it to int and moves on. --- python/swiftest/swiftest/io.py | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/python/swiftest/swiftest/io.py b/python/swiftest/swiftest/io.py index 3f5008bb9..e4d5ff139 100644 --- a/python/swiftest/swiftest/io.py +++ b/python/swiftest/swiftest/io.py @@ -175,11 +175,11 @@ def read_swiftest_param(param_file_name, param, verbose=True): param[uc] = param[uc].upper() for i in int_param: - if i in param and type(i) != int: - param[i] = int(param[i]) + if i in param and type(param[i]) != int: + param[i] = int(float(param[i])) for f in float_param: - if f in param and type(f) is str: + if f in param and type(param[f]) is str: param[f] = real2float(param[f]) for b in bool_param: From 5afb1ea51520df38c5fc848aa405e92ef9c1f3a9 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Tue, 22 Nov 2022 12:13:53 -0500 Subject: [PATCH 118/569] Created new compact formatted output that can be post-processed by Python --- src/io/io.f90 | 105 +++++++++++++++++++++++++------ src/main/swiftest_driver.f90 | 12 ++-- src/modules/swiftest_classes.f90 | 10 +-- src/modules/swiftest_globals.f90 | 18 +++--- src/modules/symba_classes.f90 | 2 +- src/symba/symba_io.f90 | 2 +- 6 files changed, 109 insertions(+), 40 deletions(-) diff --git a/src/io/io.f90 b/src/io/io.f90 index 974c6aae0..6b6654998 100644 --- a/src/io/io.f90 +++ b/src/io/io.f90 @@ -18,35 +18,100 @@ module subroutine io_compact_output(self, param, timer) !! Generates the terminal output displayed when display_style is set to COMPACT. This is used by the Python driver to !! make nice-looking progress reports. implicit none + + interface fmt + !! author: David Minton + !! + !! Formats a pair of variables and corresponding values for the compact display output. Generic interface for different variable types to format. + procedure :: fmt_I4B, fmt_I8B, fmt_DP + end interface + ! Arguments class(swiftest_nbody_system), intent(in) :: self !! Swiftest nbody system object class(swiftest_parameters), intent(in) :: param !! Input colleciton of user-defined parameters class(*), intent(in) :: timer !! Object used for computing elapsed wall time (must be unlimited polymorphic because the walltimer module requires swiftest_classes) ! Internals - character(*), parameter :: COMPACTFMT = '("ILOOP",I,";T",ES23.16,";WT",ES23.16,";IWT",ES23.16,";WTPS",ES23.16,";NPL",I,";NTP",I,";"$)' - character(*), parameter :: SYMBAFMT = '(";NPLM",I,$)' - character(*), parameter :: EGYFMT = '("LTOTERR",ES24.16,";ETOTERR",ES24.16,";MTOTERR",ES24.16,";KEOERR",ES24.16,";KESERR",ES24.16,";PEERR",ES24.16' & - // '";EORBERR",ES24.16,";ECOLERR",ES24.16,";EUNTRERR",ES24.16,";LSPINERR",ES24.16,";LESCERR",ES24.16' & - // '";MESCERR",ES24.16,$)' + !character(*), parameter :: COMPACTFMT = '("ILOOP",I,";T",ES23.16,";WT",ES23.16,";IWT",ES23.16,";WTPS",ES23.16,";NPL",I,";NTP",I,";"$)' + !character(*), parameter :: SYMBAFMT = '(";NPLM",I,$)' + !character(*), parameter :: EGYFMT = '("LTOTERR",ES24.16,";ETOTERR",ES24.16,";MTOTERR",ES24.16,";KEOERR",ES24.16,";KESERR",ES24.16,";PEERR",ES24.16' & + ! // '";EORBERR",ES24.16,";ECOLERR",ES24.16,";EUNTRERR",ES24.16,";LSPINERR",ES24.16,";LESCERR",ES24.16' & + ! // '";MESCERR",ES24.16,$)' + character(len=:), allocatable :: formatted_output + select type(timer) class is (walltimer) - if (.not. timer%main_is_started) then ! This is the start of a new run - write(*,*) "START" - write(*,COMPACTFMT) 0,param%t,0.0,0.0,0.0,self%pl%nbody, self%tp%nbody - else - write(*,COMPACTFMT) param%iloop,param%t, timer%wall_main, timer%wall_step, timer%wall_per_substep,self%pl%nbody, self%tp%nbody - end if + formatted_output = fmt("ILOOP",param%iloop) // fmt("T",param%t) // fmt("NPL",self%pl%nbody) // fmt("NTP",self%tp%nbody) select type(pl => self%pl) class is (symba_pl) - write(*,SYMBAFMT) pl%nplm + formatted_output = formatted_output // fmt("NPLM",pl%nplm) end select if (param%lenergy) then - write(*,EGYFMT) self%Ltot_error, self%Etot_error, self%Mtot_error, self%ke_orbit_error, self%ke_spin_error, self%pe_error, & - self%Eorbit_error, self%Ecoll_error, self%Euntracked_error, self%Lspin_error, self%Lescape_error, self%Mescape_error + formatted_output = formatted_output // fmt("LTOTERR",self%Ltot_error) // fmt("ETOTERR",self%Mtot_error) // fmt("MTOTERR",self%Mtot_error) & + // fmt("KEOERR",self%ke_orbit_error) // fmt("PEERR",self%pe_error) // fmt("EORBERR",self%Eorbit_error) & + // fmt("EUNTRERR",self%Euntracked_error) // fmt("LESCERR",self%Lescape_error) // fmt("MESCERR",self%Mescape_error) + if (param%lclose) formatted_output = formatted_output // fmt("ECOLLERR",self%Ecoll_error) + if (param%lrotation) formatted_output = formatted_output // fmt("KESPINERR",self%ke_spin_error) // fmt("LSPINERR",self%Lspin_error) + end if + + if (.not. timer%main_is_started) then ! This is the start of a new run + formatted_output = formatted_output // fmt("WT",0.0_DP) // fmt("IWT",0.0_DP) // fmt("WTPS",0.0_DP) + else + formatted_output = formatted_output // fmt("WT",timer%wall_main) // fmt("IWT",timer%wall_step) // fmt("WTPS",timer%wall_per_substep) end if - write(*,*) + write(*,*) formatted_output end select return + + contains + + function fmt_I4B(varname,val) result(pair_string) + implicit none + ! Arguments + character(*), intent(in) :: varname !! The variable name of the pair + integer(I4B), intent(in) :: val !! A 4-byte integer value + ! Result + character(len=:), allocatable :: pair_string + ! Internals + character(len=24) :: str_value + + write(str_value,*) val + pair_string = trim(adjustl(varname)) // " " // trim(adjustl(str_value)) // ";" + + return + end function fmt_I4B + + function fmt_I8B(varname, val) result(pair_string) + implicit none + ! Arguments + character(*), intent(in) :: varname !! The variable name of the pair + integer(I8B), intent(in) :: val !! An 8-byte integer value + ! Result + character(len=:), allocatable :: pair_string + ! Internals + character(len=24) :: str_value + + write(str_value,*) val + pair_string = trim(adjustl(varname)) // " " // trim(adjustl(str_value)) // ";" + + return + end function fmt_I8B + + function fmt_DP(varname, val) result(pair_string) + implicit none + ! Arguments + character(*), intent(in) :: varname !! The variable name of the pair + real(DP), intent(in) :: val !! A double precision floating point value + ! Result + character(len=:), allocatable :: pair_string + ! Internals + character(len=24) :: str_value + + write(str_value,'(ES24.16)') val + pair_string = trim(adjustl(varname)) // " " // trim(adjustl(str_value)) // ";" + + return + end function fmt_DP + end subroutine io_compact_output @@ -115,7 +180,7 @@ module subroutine io_conservation_report(self, param, lterminal) system%Mescape_error = system%GMescape / system%GMtot_orig system%Mtot_error = (GMtot_now - system%GMtot_orig) / system%GMtot_orig if (lterminal) write(display_unit, EGYTERMFMT) system%Ltot_error, system%Ecoll_error, system%Etot_error,system%Mtot_error - if (abs(Merror) > 100 * epsilon(Merror)) then + 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 @@ -379,9 +444,9 @@ module subroutine io_get_args(integrator, param_file_name, display_style) !! Reads in the name of the parameter file from command line arguments. implicit none ! Arguments - integer(I4B) :: integrator !! Symbolic code of the requested integrator - character(len=:), allocatable :: param_file_name !! Name of the input parameters file - character(len=:), allocatable :: display_style !! Style of the output display {"STANDARD", "COMPACT", "PROGRESS"}). Default is "STANDARD" + character(len=:), intent(inout), allocatable :: integrator !! Symbolic code of the requested integrator + character(len=:), intent(inout), allocatable :: param_file_name !! Name of the input parameters file + character(len=:), intent(inout), allocatable :: display_style !! Style of the output display {"STANDARD", "COMPACT", "PROGRESS"}). Default is "STANDARD" ! Internals character(len=STRMAX), dimension(:), allocatable :: arg integer(I4B), dimension(:), allocatable :: ierr @@ -599,7 +664,7 @@ module subroutine io_param_reader(self, unit, iotype, v_list, iostat, iomsg) integer, intent(in) :: unit !! File unit number character(len=*), intent(in) :: iotype !! Dummy argument passed to the input/output procedure contains the text from the char-literal-constant, prefixed with DT. !! If you do not include a char-literal-constant, the iotype argument contains only DT. - integer, intent(in) :: v_list(:) !! The first element passes the integrator code to the reader + character(len=*), intent(in) :: v_list(:) !! The first element passes the integrator code to the reader integer, intent(out) :: iostat !! IO status code character(len=*), intent(inout) :: iomsg !! Message to pass if iostat /= 0 ! Internals diff --git a/src/main/swiftest_driver.f90 b/src/main/swiftest_driver.f90 index e557cbdfa..c25566fe0 100644 --- a/src/main/swiftest_driver.f90 +++ b/src/main/swiftest_driver.f90 @@ -20,7 +20,7 @@ program swiftest_driver class(swiftest_nbody_system), allocatable :: nbody_system !! Polymorphic object containing the nbody system to be integrated class(swiftest_parameters), allocatable :: param !! Run configuration parameters - integer(I4B) :: integrator !! Integrator type code (see swiftest_globals for symbolic names) + character(len=:), allocatable :: 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(I4B) :: ierr !! I/O error code @@ -102,6 +102,7 @@ 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)) call nbody_system%compact_output(param,integration_timer) end if do iloop = 1, nloops @@ -121,7 +122,7 @@ program swiftest_driver iout = iout - 1 if (iout == 0) then ioutput = ioutput_t0 + iloop / istep_out - if (t > old_t_final) call nbody_system%write_frame(param) + call nbody_system%write_frame(param) tfrac = (param%t - param%t0) / (param%tstop - param%t0) @@ -133,15 +134,17 @@ program swiftest_driver end select if (param%lenergy) call nbody_system%conservation_report(param, lterminal=.true.) call integration_timer%report(message="Integration steps:", unit=display_unit, nsubsteps=istep_out) - call integration_timer%reset() - iout = istep_out if (display_style == "PROGRESS") then write(pbarmessage,fmt=pbarfmt) t, tstop call pbar%update(1,message=pbarmessage) else if (display_style == "COMPACT") then call nbody_system%compact_output(param,integration_timer) end if + + call integration_timer%reset() + + iout = istep_out end if end if @@ -154,6 +157,7 @@ program swiftest_driver end if end if end do + if (display_style == "COMPACT") write(*,*) "SWIFTEST STOP" // trim(adjustl(param%integrator)) end associate call nbody_system%dealloc() diff --git a/src/modules/swiftest_classes.f90 b/src/modules/swiftest_classes.f90 index 26686c1d6..00cf6583f 100644 --- a/src/modules/swiftest_classes.f90 +++ b/src/modules/swiftest_classes.f90 @@ -32,7 +32,7 @@ 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 - integer(I4B) :: integrator = UNKNOWN_INTEGRATOR !! Symbolic name of the nbody integrator used + 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 integer(I4B) :: maxid = -1 !! The current maximum particle id number integer(I4B) :: maxid_collision = 0 !! The current maximum collision id number @@ -657,9 +657,9 @@ end subroutine io_dump_system module subroutine io_get_args(integrator, param_file_name, display_style) implicit none - integer(I4B) :: integrator !! Symbolic code of the requested integrator - character(len=:), allocatable :: param_file_name !! Name of the input parameters file - character(len=:), allocatable :: display_style !! Style of the output display {"STANDARD", "COMPACT"}). Default is "STANDARD" + character(len=:), allocatable, intent(inout) :: integrator !! Symbolic code of the requested integrator + character(len=:), allocatable, intent(inout) :: param_file_name !! Name of the input parameters file + character(len=:), allocatable, intent(inout) :: display_style !! Style of the output display {"STANDARD", "COMPACT"}). Default is "STANDARD" end subroutine io_get_args module function io_get_old_t_final_system(self, param) result(old_t_final) @@ -697,7 +697,7 @@ module subroutine io_param_reader(self, unit, iotype, v_list, iostat, iomsg) integer(I4B), intent(in) :: unit !! File unit number character(len=*), intent(in) :: iotype !! Dummy argument passed to the input/output procedure contains the text from the char-literal-constant, prefixed with DT. !! If you do not include a char-literal-constant, the iotype argument contains only DT. - integer(I4B), intent(in) :: v_list(:) !! The first element passes the integrator code to the reader + character(len=*), intent(in) :: v_list(:) !! The first element passes the integrator code to the reader integer(I4B), intent(out) :: iostat !! IO status code character(len=*), intent(inout) :: iomsg !! Message to pass if iostat /= 0 end subroutine io_param_reader diff --git a/src/modules/swiftest_globals.f90 b/src/modules/swiftest_globals.f90 index dff9cad56..97c68b85e 100644 --- a/src/modules/swiftest_globals.f90 +++ b/src/modules/swiftest_globals.f90 @@ -44,15 +44,15 @@ module swiftest_globals real(SP), parameter :: VERSION_NUMBER = 1.0_SP !! swiftest version !> Symbolic name for integrator types - integer(I4B), parameter :: UNKNOWN_INTEGRATOR = 1 - integer(I4B), parameter :: BS = 2 - integer(I4B), parameter :: HELIO = 3 - integer(I4B), parameter :: RA15 = 4 - integer(I4B), parameter :: TU4 = 5 - integer(I4B), parameter :: WHM = 6 - integer(I4B), parameter :: RMVS = 7 - integer(I4B), parameter :: SYMBA = 8 - integer(I4B), parameter :: RINGMOONS = 9 + character(*), parameter :: UNKNOWN_INTEGRATOR = "UKNOWN INTEGRATOR" + character(*), parameter :: BS = "Bulirsch-Stoer" + character(*), parameter :: HELIO = "Democratic Heliocentric" + character(*), parameter :: RA15 = "Radau 15th order" + character(*), parameter :: TU4 = "T+U 4th order" + character(*), parameter :: WHM = "Wisdom-Holman Method" + character(*), parameter :: RMVS = "Regularized Mixed Variable Symplectic" + character(*), parameter :: SYMBA = "SyMBA" + character(*), parameter :: RINGMOONS = "SyMBA-RINGMOONS" integer(I4B), parameter :: STRMAX = 512 !! Maximum size of character strings integer(I4B), parameter :: NAMELEN = 32 !! Maximum size of name strings diff --git a/src/modules/symba_classes.f90 b/src/modules/symba_classes.f90 index cacad4b4d..e016a36b9 100644 --- a/src/modules/symba_classes.f90 +++ b/src/modules/symba_classes.f90 @@ -375,7 +375,7 @@ module subroutine symba_io_param_reader(self, unit, iotype, v_list, iostat, ioms integer, intent(in) :: unit !! File unit number character(len=*), intent(in) :: iotype !! Dummy argument passed to the input/output procedure contains the text from the char-literal-constant, prefixed with DT. !! If you do not include a char-literal-constant, the iotype argument contains only DT. - integer, intent(in) :: v_list(:) !! The first element passes the integrator code to the reader + character(len=*), intent(in) :: v_list(:) !! The first element passes the integrator code to the reader integer, intent(out) :: iostat !! IO status code character(len=*), intent(inout) :: iomsg !! Message to pass if iostat /= 0 end subroutine symba_io_param_reader diff --git a/src/symba/symba_io.f90 b/src/symba/symba_io.f90 index 7f2792309..d9a48b52a 100644 --- a/src/symba/symba_io.f90 +++ b/src/symba/symba_io.f90 @@ -24,7 +24,7 @@ module subroutine symba_io_param_reader(self, unit, iotype, v_list, iostat, ioms integer, intent(in) :: unit !! File unit number character(len=*), intent(in) :: iotype !! Dummy argument passed to the input/output procedure contains the text from the char-literal-constant, prefixed with DT. !! If you do not include a char-literal-constant, the iotype argument contains only DT. - integer, intent(in) :: v_list(:) !! The first element passes the integrator code to the reader + character(len=*), intent(in) :: v_list(:) !! The first element passes the integrator code to the reader integer, intent(out) :: iostat !! IO status code character(len=*), intent(inout) :: iomsg !! Message to pass if iostat /= 0 ! internals From 3fb5fff6d3fe7de40bcb9185baa50da2739a60ae Mon Sep 17 00:00:00 2001 From: David A Minton Date: Tue, 22 Nov 2022 17:03:32 -0500 Subject: [PATCH 119/569] Finished making compact output that can easily be turned into a Python dictionary --- python/swiftest/swiftest/simulation_class.py | 19 ++++++++++++------- src/io/io.f90 | 5 ----- 2 files changed, 12 insertions(+), 12 deletions(-) diff --git a/python/swiftest/swiftest/simulation_class.py b/python/swiftest/swiftest/simulation_class.py index 834f6e40a..9f1555411 100644 --- a/python/swiftest/swiftest/simulation_class.py +++ b/python/swiftest/swiftest/simulation_class.py @@ -365,7 +365,7 @@ def _run_swiftest_driver(self): f.write(f"#{self._shell_full} -l\n") f.write(f"source ~/.{self._shell}rc\n") f.write(f"cd {self.sim_dir}\n") - f.write(f"{str(self.driver_executable)} {self.integrator} {str(self.param_file)} progress\n") + f.write(f"{str(self.driver_executable)} {self.integrator} {str(self.param_file)} compact\n") cmd = f"{env['SHELL']} -l {driver_script}" @@ -375,13 +375,18 @@ def _run_swiftest_driver(self): stderr=subprocess.PIPE, env=env, universal_newlines=True) as p: + process_output = False for line in p.stdout: - if '[' in line: - print(line.replace('\n', '\r'), end='') - elif "Normal termination" in line: - print(line.replace("Normal termination", "\n\nNormal termination"), end='') - else: - print(line, end='') + if "SWIFTEST STOP" in line: + process_output = False + + if process_output: + kvstream=line.replace('\n','').strip().split(';') # Removes the newline character, + output_data = {kv.split()[0]: kv.split()[1] for kv in kvstream[:-1]} + + if "SWIFTEST START" in line: + process_output = True + res = p.communicate() if p.returncode != 0: for line in res[1]: diff --git a/src/io/io.f90 b/src/io/io.f90 index 6b6654998..c5af067f5 100644 --- a/src/io/io.f90 +++ b/src/io/io.f90 @@ -31,11 +31,6 @@ module subroutine io_compact_output(self, param, timer) class(swiftest_parameters), intent(in) :: param !! Input colleciton of user-defined parameters class(*), intent(in) :: timer !! Object used for computing elapsed wall time (must be unlimited polymorphic because the walltimer module requires swiftest_classes) ! Internals - !character(*), parameter :: COMPACTFMT = '("ILOOP",I,";T",ES23.16,";WT",ES23.16,";IWT",ES23.16,";WTPS",ES23.16,";NPL",I,";NTP",I,";"$)' - !character(*), parameter :: SYMBAFMT = '(";NPLM",I,$)' - !character(*), parameter :: EGYFMT = '("LTOTERR",ES24.16,";ETOTERR",ES24.16,";MTOTERR",ES24.16,";KEOERR",ES24.16,";KESERR",ES24.16,";PEERR",ES24.16' & - ! // '";EORBERR",ES24.16,";ECOLERR",ES24.16,";EUNTRERR",ES24.16,";LSPINERR",ES24.16,";LESCERR",ES24.16' & - ! // '";MESCERR",ES24.16,$)' character(len=:), allocatable :: formatted_output select type(timer) From 63617b1581910d07165da4b476fae846618d2f2f Mon Sep 17 00:00:00 2001 From: David A Minton Date: Tue, 22 Nov 2022 17:04:05 -0500 Subject: [PATCH 120/569] Changed cmake so that mod files get put in the includes directory instead of lib --- CMakeLists.txt | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index 96ce5efa9..828a37bb2 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -59,9 +59,10 @@ SET(SWIFTEST_DRIVER swiftest_driver) SET(SRC ${CMAKE_SOURCE_DIR}/src) SET(LIB ${CMAKE_SOURCE_DIR}/lib) SET(BIN ${CMAKE_SOURCE_DIR}/bin) +SET(MOD ${CMAKE_SOURCE_DIR}/include) # Have the .mod files placed in the lib folder -SET(CMAKE_Fortran_MODULE_DIRECTORY ${LIB}) +SET(CMAKE_Fortran_MODULE_DIRECTORY ${MOD}) # The source for the SWIFTEST binary and have it placed in the bin folder ADD_SUBDIRECTORY(${SRC} ${BIN}) From b037272b31b65aa68e4b44ba4b7e90b7b6b5ebbd Mon Sep 17 00:00:00 2001 From: David A Minton Date: Tue, 22 Nov 2022 17:06:27 -0500 Subject: [PATCH 121/569] Updated the ignore file to try to remove the simdata directory --- examples/.gitignore | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/examples/.gitignore b/examples/.gitignore index df5a1c5d1..4aceee79f 100644 --- a/examples/.gitignore +++ b/examples/.gitignore @@ -1,2 +1,4 @@ */param.* -*/.swiftest* +*/simdata/* +*/*/simdata/* + From 35d1cf079127f3ed735c9112ca86ea8f0137a1bf Mon Sep 17 00:00:00 2001 From: David A Minton Date: Tue, 22 Nov 2022 17:07:46 -0500 Subject: [PATCH 122/569] Removed param file from repo --- examples/Basic_Simulation/simdata/param.in | 37 ---------------------- 1 file changed, 37 deletions(-) delete mode 100644 examples/Basic_Simulation/simdata/param.in diff --git a/examples/Basic_Simulation/simdata/param.in b/examples/Basic_Simulation/simdata/param.in deleted file mode 100644 index 3246644ce..000000000 --- a/examples/Basic_Simulation/simdata/param.in +++ /dev/null @@ -1,37 +0,0 @@ -! VERSION Swiftest input file -T0 0.0 -TSTART 0.0 -TSTOP 1000.0 -DT 0.005 -ISTEP_OUT 200 -ISTEP_DUMP 200 -NC_IN init_cond.nc -IN_TYPE NETCDF_DOUBLE -IN_FORM EL -BIN_OUT bin.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 -GMTINY 9.869231602224408e-07 -FRAGMENTATION YES -MIN_GMFRAG 9.869231602224408e-10 -RESTART NO -CHK_CLOSE YES -GR YES -ROTATION YES -ENERGY NO -EXTRA_FORCE NO -BIG_DISCARD NO -RHILL_PRESENT NO -INTERACTION_LOOPS TRIANGULAR -ENCOUNTER_CHECK TRIANGULAR -TIDES NO From 9f429d11c0f6aaabd56b0417b87e93d367dcffa3 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Tue, 22 Nov 2022 17:19:07 -0500 Subject: [PATCH 123/569] Added tqdm progress bar --- python/swiftest/swiftest/simulation_class.py | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/python/swiftest/swiftest/simulation_class.py b/python/swiftest/swiftest/simulation_class.py index 9f1555411..436cfb605 100644 --- a/python/swiftest/swiftest/simulation_class.py +++ b/python/swiftest/swiftest/simulation_class.py @@ -26,6 +26,7 @@ import subprocess import shlex import warnings +from tqdm import tqdm from typing import ( Literal, Dict, @@ -376,7 +377,8 @@ def _run_swiftest_driver(self): env=env, universal_newlines=True) as p: process_output = False - for line in p.stdout: + noutput = int((self.param['TSTOP'] - self.param['T0']) / (self.param['DT'] * self.param['ISTEP_OUT'])) + for line in tqdm(p.stdout,total=noutput): if "SWIFTEST STOP" in line: process_output = False From e6de73a70a2c34e6d2188a8c697b4a4f397fb2d5 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Tue, 22 Nov 2022 17:30:13 -0500 Subject: [PATCH 124/569] Set the progress bar in tqdm so that it manually updates --- python/swiftest/swiftest/simulation_class.py | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/python/swiftest/swiftest/simulation_class.py b/python/swiftest/swiftest/simulation_class.py index 436cfb605..3ccea2d6a 100644 --- a/python/swiftest/swiftest/simulation_class.py +++ b/python/swiftest/swiftest/simulation_class.py @@ -377,14 +377,16 @@ def _run_swiftest_driver(self): env=env, universal_newlines=True) as p: process_output = False - noutput = int((self.param['TSTOP'] - self.param['T0']) / (self.param['DT'] * self.param['ISTEP_OUT'])) - for line in tqdm(p.stdout,total=noutput): + noutput = int((self.param['TSTOP'] - self.param['T0']) / self.param['DT']) + pbar = tqdm(total=noutput) + for line in p.stdout: if "SWIFTEST STOP" in line: process_output = False if process_output: kvstream=line.replace('\n','').strip().split(';') # Removes the newline character, output_data = {kv.split()[0]: kv.split()[1] for kv in kvstream[:-1]} + pbar.update(self.param['ISTEP_OUT']) if "SWIFTEST START" in line: process_output = True @@ -397,6 +399,7 @@ def _run_swiftest_driver(self): except: warnings.warn(f"Error executing main swiftest_driver program", stacklevel=2) + pbar.close() return def run(self,**kwargs): From d1599f3adbd36856638099d04a724c658a444a74 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Tue, 22 Nov 2022 19:43:04 -0500 Subject: [PATCH 125/569] Added time values to progress bar --- python/swiftest/swiftest/simulation_class.py | 19 +++++++++++++++++-- 1 file changed, 17 insertions(+), 2 deletions(-) diff --git a/python/swiftest/swiftest/simulation_class.py b/python/swiftest/swiftest/simulation_class.py index 3ccea2d6a..21b0e8e95 100644 --- a/python/swiftest/swiftest/simulation_class.py +++ b/python/swiftest/swiftest/simulation_class.py @@ -370,6 +370,15 @@ def _run_swiftest_driver(self): cmd = f"{env['SHELL']} -l {driver_script}" + def _type_scrub(output_data): + int_vars = ["ILOOP","NPL","NTP","NPLM"] + for k,v in output_data.items(): + if k in int_vars: + output_data[k] = int(v) + else: + output_data[k] = float(v) + return output_data + try: with subprocess.Popen(shlex.split(cmd), stdout=subprocess.PIPE, @@ -378,6 +387,7 @@ def _run_swiftest_driver(self): universal_newlines=True) as p: process_output = False noutput = int((self.param['TSTOP'] - self.param['T0']) / self.param['DT']) + iloop = int((self.param['TSTART'] - self.param['T0']) / self.param['DT']) pbar = tqdm(total=noutput) for line in p.stdout: if "SWIFTEST STOP" in line: @@ -385,8 +395,13 @@ def _run_swiftest_driver(self): if process_output: kvstream=line.replace('\n','').strip().split(';') # Removes the newline character, - output_data = {kv.split()[0]: kv.split()[1] for kv in kvstream[:-1]} - pbar.update(self.param['ISTEP_OUT']) + output_data = _type_scrub({kv.split()[0]: kv.split()[1] for kv in kvstream[:-1]}) + message = f"Time: {output_data['T']} {self.TU_name}/{self.param['TSTOP']} {self.TU_name}" + pbar.set_description_str(message) + interval = output_data['ILOOP'] - iloop + if interval > 0: + pbar.update(interval) + iloop = output_data['ILOOP'] if "SWIFTEST START" in line: process_output = True From 92702fc5978da97c36af765d44eed6740fb52757 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Wed, 23 Nov 2022 10:03:46 -0500 Subject: [PATCH 126/569] Added more data to the progress bar --- python/swiftest/swiftest/simulation_class.py | 10 +++++++--- 1 file changed, 7 insertions(+), 3 deletions(-) diff --git a/python/swiftest/swiftest/simulation_class.py b/python/swiftest/swiftest/simulation_class.py index 21b0e8e95..d0a3f2829 100644 --- a/python/swiftest/swiftest/simulation_class.py +++ b/python/swiftest/swiftest/simulation_class.py @@ -26,7 +26,7 @@ import subprocess import shlex import warnings -from tqdm import tqdm +from tqdm.auto import tqdm from typing import ( Literal, Dict, @@ -396,8 +396,12 @@ def _type_scrub(output_data): if process_output: kvstream=line.replace('\n','').strip().split(';') # Removes the newline character, output_data = _type_scrub({kv.split()[0]: kv.split()[1] for kv in kvstream[:-1]}) - message = f"Time: {output_data['T']} {self.TU_name}/{self.param['TSTOP']} {self.TU_name}" - pbar.set_description_str(message) + pre_message = f"Time: {output_data['T']} / {self.param['TSTOP']} {self.TU_name}" + post_message = f"npl: {output_data['NPL']} ntp: {output_data['NTP']}" + if "NPLM" in output_data: + post_message = post_message + f" nplm: {output_data['NPLM']}" + pbar.set_description_str(pre_message) + pbar.set_postfix_str(post_message) interval = output_data['ILOOP'] - iloop if interval > 0: pbar.update(interval) From 8306643ba1ecd2baec2cb6e3a33b4d97a0fa8619 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Wed, 23 Nov 2022 15:52:45 -0500 Subject: [PATCH 127/569] Got rid of all the extra stuff in the post table and added the running time and body number data to the end --- python/swiftest/swiftest/simulation_class.py | 35 +++++++++++++++----- 1 file changed, 26 insertions(+), 9 deletions(-) diff --git a/python/swiftest/swiftest/simulation_class.py b/python/swiftest/swiftest/simulation_class.py index d0a3f2829..4a9acfef6 100644 --- a/python/swiftest/swiftest/simulation_class.py +++ b/python/swiftest/swiftest/simulation_class.py @@ -40,7 +40,7 @@ class Simulation: This is a class that defines the basic Swift/Swifter/Swiftest simulation object """ - def __init__(self,read_param: bool = True, **kwargs: Any): + def __init__(self,read_param: bool = False, **kwargs: Any): """ Parameters @@ -330,6 +330,7 @@ def __init__(self,read_param: bool = True, **kwargs: Any): # overriding everything with defaults when there are no arguments passed to Simulation() kwargs['param_file'] = self.param_file param_file_found = True + else: param_file_found = False @@ -379,16 +380,21 @@ def _type_scrub(output_data): output_data[k] = float(v) return output_data + process_output = False + noutput = int((self.param['TSTOP'] - self.param['T0']) / self.param['DT']) + iloop = int((self.param['TSTART'] - self.param['T0']) / self.param['DT']) + post_message = f"Time: {self.param['TSTART']} / {self.param['TSTOP']} {self.TU_name}" + post_message += f"npl: {self.data['npl'].values[0]} ntp: {self.data['ntp'].values[0]}" + if "nplm" in self.data: + post_message += f" nplm: {self.data['nplm'].values[0]}" + pbar = tqdm(total=noutput, postfix=post_message, bar_format='{l_bar}{bar}{postfix}') try: with subprocess.Popen(shlex.split(cmd), stdout=subprocess.PIPE, stderr=subprocess.PIPE, env=env, universal_newlines=True) as p: - process_output = False - noutput = int((self.param['TSTOP'] - self.param['T0']) / self.param['DT']) - iloop = int((self.param['TSTART'] - self.param['T0']) / self.param['DT']) - pbar = tqdm(total=noutput) + for line in p.stdout: if "SWIFTEST STOP" in line: process_output = False @@ -396,11 +402,10 @@ def _type_scrub(output_data): if process_output: kvstream=line.replace('\n','').strip().split(';') # Removes the newline character, output_data = _type_scrub({kv.split()[0]: kv.split()[1] for kv in kvstream[:-1]}) - pre_message = f"Time: {output_data['T']} / {self.param['TSTOP']} {self.TU_name}" - post_message = f"npl: {output_data['NPL']} ntp: {output_data['NTP']}" + post_message = f"Time: {output_data['T']} / {self.param['TSTOP']} {self.TU_name}" + post_message += f"npl: {output_data['NPL']} ntp: {output_data['NTP']}" if "NPLM" in output_data: - post_message = post_message + f" nplm: {output_data['NPLM']}" - pbar.set_description_str(pre_message) + post_message += post_message + f" nplm: {output_data['NPLM']}" pbar.set_postfix_str(post_message) interval = output_data['ILOOP'] - iloop if interval > 0: @@ -2431,9 +2436,13 @@ def get_nvals(ds): if "Gmass" in ds: ds['ntp'] = ds[count_dim].where(np.isnan(ds['Gmass'])).count(dim=count_dim) ds['npl'] = ds[count_dim].where(~(np.isnan(ds['Gmass']))).count(dim=count_dim) - 1 + if self.integrator == "symba" and "GMTINY" in self.param and self.param['GMTINY'] is not None: + ds['nplm'] = ds[count_dim].where(ds['Gmass'] > self.param['GMTINY']).count(dim=count_dim) - 1 else: ds['ntp'] = ds[count_dim].count(dim=count_dim) ds['npl'] = xr.full_like(ds['ntp'],0) + if self.integrator == "symba" and "GMTINY" in self.param and self.param['GMTINY'] is not None: + ds['nplm'] = xr.full_like(ds['ntp'],0) return ds dsnew = get_nvals(dsnew) @@ -2477,6 +2486,14 @@ def read_param(self, if codename == "Swiftest": self.param = io.read_swiftest_param(param_file, self.param, verbose=verbose) + if "NETCDF" in self.param['IN_TYPE']: + init_cond_file = self.sim_dir / 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) + else: + warnings.warn(f"Initial conditions file file {init_cond_file} not found.", stacklevel=2) elif codename == "Swifter": self.param = io.read_swifter_param(param_file, verbose=verbose) elif codename == "Swift": From 2bcff5197b9f638e29067a4e402e235fda1c0d92 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Wed, 23 Nov 2022 16:05:36 -0500 Subject: [PATCH 128/569] Fixed typos --- python/swiftest/swiftest/simulation_class.py | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/python/swiftest/swiftest/simulation_class.py b/python/swiftest/swiftest/simulation_class.py index 4a9acfef6..f5ca2df8b 100644 --- a/python/swiftest/swiftest/simulation_class.py +++ b/python/swiftest/swiftest/simulation_class.py @@ -383,7 +383,7 @@ def _type_scrub(output_data): process_output = False noutput = int((self.param['TSTOP'] - self.param['T0']) / self.param['DT']) iloop = int((self.param['TSTART'] - self.param['T0']) / self.param['DT']) - post_message = f"Time: {self.param['TSTART']} / {self.param['TSTOP']} {self.TU_name}" + post_message = f"Time: {self.param['TSTART']} / {self.param['TSTOP']} {self.TU_name} " post_message += f"npl: {self.data['npl'].values[0]} ntp: {self.data['ntp'].values[0]}" if "nplm" in self.data: post_message += f" nplm: {self.data['nplm'].values[0]}" @@ -403,13 +403,13 @@ def _type_scrub(output_data): kvstream=line.replace('\n','').strip().split(';') # Removes the newline character, output_data = _type_scrub({kv.split()[0]: kv.split()[1] for kv in kvstream[:-1]}) post_message = f"Time: {output_data['T']} / {self.param['TSTOP']} {self.TU_name}" - post_message += f"npl: {output_data['NPL']} ntp: {output_data['NTP']}" + post_message += f" npl: {output_data['NPL']} ntp: {output_data['NTP']}" if "NPLM" in output_data: - post_message += post_message + f" nplm: {output_data['NPLM']}" - pbar.set_postfix_str(post_message) + post_message += f" nplm: {output_data['NPLM']}" interval = output_data['ILOOP'] - iloop if interval > 0: pbar.update(interval) + pbar.set_postfix_str(post_message) iloop = output_data['ILOOP'] if "SWIFTEST START" in line: From e3c03e6b4f9c920973b0f56219f6474fed704e16 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Mon, 28 Nov 2022 12:12:21 -0500 Subject: [PATCH 129/569] Added mkl library to cmake files and also added ability to compile with coarrays enabled --- CMakeLists.txt | 13 ++++++----- cmake/Modules/FindMKL.cmake | 17 ++++++++++++++ cmake/Modules/FindOpenMP_Fortran.cmake | 6 ++--- cmake/Modules/SetFortranFlags.cmake | 10 +++++++-- cmake/Modules/SetMKL.cmake | 14 ++++++++++++ cmake/Modules/SetParallelizationLibrary.cmake | 22 +++++++------------ 6 files changed, 58 insertions(+), 24 deletions(-) create mode 100644 cmake/Modules/FindMKL.cmake create mode 100644 cmake/Modules/SetMKL.cmake diff --git a/CMakeLists.txt b/CMakeLists.txt index 828a37bb2..5d4c8637f 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -29,18 +29,21 @@ ENDIF(NOT CMAKE_Fortran_COMPILER_SUPPORTS_F90) # Set some options the user may choose # Uncomment the below if you want the user to choose a parallelization library -OPTION(USE_MPI "Use the MPI library for parallelization" OFF) +OPTION(USE_MPI "Use the MPI library for parallelization" ON) OPTION(USE_OPENMP "Use OpenMP for parallelization" ON) -# This INCLUDE statement executes code that sets the compile flags for DEBUG, -# RELEASE, and TESTING. You should review this file and make sure the flags -# are to your liking. -INCLUDE(${CMAKE_MODULE_PATH}/SetFortranFlags.cmake) + # Locate and set parallelization libraries. There are some CMake peculiarities # taken care of here, such as the fact that the FindOpenMP routine doesn't know # about Fortran. INCLUDE(${CMAKE_MODULE_PATH}/SetParallelizationLibrary.cmake) INCLUDE(${CMAKE_MODULE_PATH}/SetUpNetCDF.cmake) +INCLUDE(${CMAKE_MODULE_PATH}/SetMKL.cmake) + +# This INCLUDE statement executes code that sets the compile flags for DEBUG, +# RELEASE, PROFILING, and TESTING. +INCLUDE(${CMAKE_MODULE_PATH}/SetFortranFlags.cmake) + # There is an error in CMAKE with this flag for pgf90. Unset it GET_FILENAME_COMPONENT(FCNAME ${CMAKE_Fortran_COMPILER} NAME) diff --git a/cmake/Modules/FindMKL.cmake b/cmake/Modules/FindMKL.cmake new file mode 100644 index 000000000..9e48932c3 --- /dev/null +++ b/cmake/Modules/FindMKL.cmake @@ -0,0 +1,17 @@ +# Copyright 2022 - David Minton, Carlisle Wishard, Jennifer Pouplin, Jake Elliott, & Dana Singh +# This file is part of Swiftest. +# Swiftest is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License +# as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. +# Swiftest is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty +# of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. +# You should have received a copy of the GNU General Public License along with Swiftest. +# If not, see: https://www.gnu.org/licenses. + +# - Finds the Intel MKL libraries +find_path(MKL_INCLUDE_DIR NAMES mkl.h HINTS ENV MKLROOT PATH_SUFFIXES include) +find_library(MKL_LIBRARY NAMES libmkl_core.a HINTS ENV MKLROOT PATH_SUFFIXES lib lib/intel64 ) + +set(MKL_FOUND TRUE) +set(MKL_INCLUDE_DIRS ${MKL_INCLUDE_DIR}) +set(MKL_LIBRARIES ${MKL_LIBRARY}) +mark_as_advanced(MKL_LIBRARY MKL_INCLUDE_DIR) \ No newline at end of file diff --git a/cmake/Modules/FindOpenMP_Fortran.cmake b/cmake/Modules/FindOpenMP_Fortran.cmake index 32777569e..c5c2047f8 100644 --- a/cmake/Modules/FindOpenMP_Fortran.cmake +++ b/cmake/Modules/FindOpenMP_Fortran.cmake @@ -27,11 +27,11 @@ INCLUDE (${CMAKE_ROOT}/Modules/FindPackageHandleStandardArgs.cmake) SET (OpenMP_Fortran_FLAG_CANDIDATES #Intel - "-qopenmp" + "-qopenmp -coarray" #Intel windows - "/Qopenmp" + "/Qopenmp /Qcoarray" #Gnu - "-fopenmp" + "-fopenmp -fcoarray=lib" #Portland Group "-mp" #Empty, if compiler automatically accepts openmp diff --git a/cmake/Modules/SetFortranFlags.cmake b/cmake/Modules/SetFortranFlags.cmake index 7850fbdb8..d869e89b6 100644 --- a/cmake/Modules/SetFortranFlags.cmake +++ b/cmake/Modules/SetFortranFlags.cmake @@ -222,9 +222,9 @@ SET_COMPILE_FLAG(CMAKE_Fortran_FLAGS_TESTING "${CMAKE_Fortran_FLAGS_TESTING}" # Unroll loops SET_COMPILE_FLAG(CMAKE_Fortran_FLAGS_RELEASE "${CMAKE_Fortran_FLAGS_RELEASE}" - Fortran "-funroll-loops" # GNU - "-unroll" # Intel + Fortran "-unroll" # Intel "/unroll" # Intel Windows + "-funroll-loops" # GNU "-Munroll" # Portland Group ) @@ -288,6 +288,12 @@ SET_COMPILE_FLAG(CMAKE_Fortran_FLAGS_RELEASE "${CMAKE_Fortran_FLAGS_RELEASE}" Fortran "-fma" # Intel ) +# Generate fused multiply-add instructions +SET_COMPILE_FLAG(CMAKE_Fortran_FLAGS_RELEASE "${CMAKE_Fortran_FLAGS_RELEASE}" + Fortran "-qmkl=cluster" # Intel + Fortran "-qmkl" # Intel + Fortran "-mkl" # Old Intel + ) ##################### ### MATH FLAGS ### diff --git a/cmake/Modules/SetMKL.cmake b/cmake/Modules/SetMKL.cmake new file mode 100644 index 000000000..e58c9f51a --- /dev/null +++ b/cmake/Modules/SetMKL.cmake @@ -0,0 +1,14 @@ +# Copyright 2022 - David Minton, Carlisle Wishard, Jennifer Pouplin, Jake Elliott, & Dana Singh +# This file is part of Swiftest. +# Swiftest is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License +# as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. +# Swiftest is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty +# of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. +# You should have received a copy of the GNU General Public License along with Swiftest. +# If not, see: https://www.gnu.org/licenses. + +# Find MKL if not already found +IF(NOT MKL_FOUND) + ENABLE_LANGUAGE(C) # Some libraries need a C compiler to find + FIND_PACKAGE(MKL REQUIRED) +ENDIF(NOT MKL_FOUND) diff --git a/cmake/Modules/SetParallelizationLibrary.cmake b/cmake/Modules/SetParallelizationLibrary.cmake index 03ab970e6..224806406 100644 --- a/cmake/Modules/SetParallelizationLibrary.cmake +++ b/cmake/Modules/SetParallelizationLibrary.cmake @@ -12,9 +12,7 @@ # When one is turned on, the other is turned off # If both are off, we explicitly disable them just in case -IF (USE_OPENMP AND USE_MPI) - MESSAGE (FATAL_ERROR "Cannot use both OpenMP and MPI") -ELSEIF (USE_OPENMP) +IF (USE_OPENMP) # Find OpenMP IF (NOT OpenMP_Fortran_FLAGS) FIND_PACKAGE (OpenMP_Fortran) @@ -23,20 +21,16 @@ ELSEIF (USE_OPENMP) ENDIF (NOT OpenMP_Fortran_FLAGS) ENDIF (NOT OpenMP_Fortran_FLAGS) # Turn of MPI - UNSET (MPI_FOUND CACHE) - UNSET (MPI_COMPILER CACHE) - UNSET (MPI_LIBRARY CACHE) -ELSEIF (USE_MPI) +ENDIF (USE_OPENMP) + +IF (USE_MPI) # Find MPI IF (NOT MPI_Fortran_FOUND) FIND_PACKAGE (MPI REQUIRED) ENDIF (NOT MPI_Fortran_FOUND) - # Turn off OpenMP - SET (OMP_NUM_PROCS 0 CACHE - STRING "Number of processors OpenMP may use" FORCE) - UNSET (OpenMP_C_FLAGS CACHE) - UNSET (GOMP_Fortran_LINK_FLAGS CACHE) -ELSE () +ENDIF (USE_MPI) + +IF (NOT USE_OPENMP AND NOT USE_MPI) # Turn off both OpenMP and MPI SET (OMP_NUM_PROCS 0 CACHE STRING "Number of processors OpenMP may use" FORCE) @@ -45,4 +39,4 @@ ELSE () UNSET (MPI_FOUND CACHE) UNSET (MPI_COMPILER CACHE) UNSET (MPI_LIBRARY CACHE) -ENDIF (USE_OPENMP AND USE_MPI) +ENDIF (NOT USE_OPENMP AND NOT USE_MPI) From ea4e0edb7526040c61d41b5b1ad61e85def57f67 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Mon, 28 Nov 2022 16:44:13 -0500 Subject: [PATCH 130/569] Removed coarray for now --- cmake/Modules/FindOpenMP_Fortran.cmake | 6 +- examples/Basic_Simulation/run_from_file.ipynb | 119 ++++++++++++++++++ python/swiftest/swiftest/simulation_class.py | 13 +- 3 files changed, 130 insertions(+), 8 deletions(-) create mode 100644 examples/Basic_Simulation/run_from_file.ipynb diff --git a/cmake/Modules/FindOpenMP_Fortran.cmake b/cmake/Modules/FindOpenMP_Fortran.cmake index c5c2047f8..32777569e 100644 --- a/cmake/Modules/FindOpenMP_Fortran.cmake +++ b/cmake/Modules/FindOpenMP_Fortran.cmake @@ -27,11 +27,11 @@ INCLUDE (${CMAKE_ROOT}/Modules/FindPackageHandleStandardArgs.cmake) SET (OpenMP_Fortran_FLAG_CANDIDATES #Intel - "-qopenmp -coarray" + "-qopenmp" #Intel windows - "/Qopenmp /Qcoarray" + "/Qopenmp" #Gnu - "-fopenmp -fcoarray=lib" + "-fopenmp" #Portland Group "-mp" #Empty, if compiler automatically accepts openmp diff --git a/examples/Basic_Simulation/run_from_file.ipynb b/examples/Basic_Simulation/run_from_file.ipynb new file mode 100644 index 000000000..d2f4fdeb1 --- /dev/null +++ b/examples/Basic_Simulation/run_from_file.ipynb @@ -0,0 +1,119 @@ +{ + "cells": [ + { + "cell_type": "code", + "execution_count": 1, + "id": "aa57e957-f141-4373-9a62-a91845203aa3", + "metadata": {}, + "outputs": [ + { + "name": "stdout", + "output_type": "stream", + "text": [ + "env: OMP_NUM_THREADS=8\n" + ] + } + ], + "source": [ + "import swiftest\n", + "import xarray as xr\n", + "import numpy as np\n", + "import os\n", + "%env OMP_NUM_THREADS=8" + ] + }, + { + "cell_type": "code", + "execution_count": 2, + "id": "a9c020aa-0a87-4fa9-9b11-62213edb370c", + "metadata": {}, + "outputs": [ + { + "name": "stdout", + "output_type": "stream", + "text": [ + "Reading Swiftest file /home/daminton/git_debug/swiftest/examples/Basic_Simulation/simdata/param.in\n", + "\n", + "Creating Dataset from NetCDF file\n", + "Successfully converted 1 output frames.\n" + ] + } + ], + "source": [ + "sim = swiftest.Simulation(read_param=True)" + ] + }, + { + "cell_type": "code", + "execution_count": 3, + "id": "209523b6-d7a8-46f0-8687-54f199015c2d", + "metadata": {}, + "outputs": [ + { + "name": "stdout", + "output_type": "stream", + "text": [ + "Writing parameter inputs to file /home/daminton/git_debug/swiftest/examples/Basic_Simulation/simdata/param.in\n", + "Running a Swiftest symba run from tstart=0.0 y to tstop=1000.0 y\n" + ] + }, + { + "data": { + "application/vnd.jupyter.widget-view+json": { + "model_id": "ca7e9529651b46209bc86174955f7a01", + "version_major": 2, + "version_minor": 0 + }, + "text/plain": [ + "Time: 0.0 / 1000.0 y : 0%| , npl: 14 ntp: 10 nplm: 13" + ] + }, + "metadata": {}, + "output_type": "display_data" + }, + { + "name": "stderr", + "output_type": "stream", + "text": [ + "/home/daminton/git_debug/swiftest/python/swiftest/swiftest/simulation_class.py:465: UserWarning: Error executing main swiftest_driver program\n", + " self._run_swiftest_driver()\n" + ] + }, + { + "name": "stdout", + "output_type": "stream", + "text": [ + "\n", + "Creating Dataset from NetCDF file\n", + "Successfully converted 19 output frames.\n", + "Swiftest simulation data stored as xarray DataSet .data\n" + ] + } + ], + "source": [ + "sim.run()" + ] + } + ], + "metadata": { + "kernelspec": { + "display_name": "Python (My debug_env Kernel)", + "language": "python", + "name": "debug_env" + }, + "language_info": { + "codemirror_mode": { + "name": "ipython", + "version": 3 + }, + "file_extension": ".py", + "mimetype": "text/x-python", + "name": "python", + "nbconvert_exporter": "python", + "pygments_lexer": "ipython3", + "version": "3.8.5" + } + }, + "nbformat": 4, + "nbformat_minor": 5 +} diff --git a/python/swiftest/swiftest/simulation_class.py b/python/swiftest/swiftest/simulation_class.py index f5ca2df8b..f4f244b73 100644 --- a/python/swiftest/swiftest/simulation_class.py +++ b/python/swiftest/swiftest/simulation_class.py @@ -383,11 +383,12 @@ def _type_scrub(output_data): process_output = False noutput = int((self.param['TSTOP'] - self.param['T0']) / self.param['DT']) iloop = int((self.param['TSTART'] - self.param['T0']) / self.param['DT']) - post_message = f"Time: {self.param['TSTART']} / {self.param['TSTOP']} {self.TU_name} " - post_message += f"npl: {self.data['npl'].values[0]} ntp: {self.data['ntp'].values[0]}" + if self.param['TSTOP'] < 1e4: + pre_message = f"Time: {self.param['TSTART']:>5} / {self.param['TSTOP']:>5} {self.TU_name} " + post_message = f"npl: {self.data['npl'].values[0]} ntp: {self.data['ntp'].values[0]}" if "nplm" in self.data: post_message += f" nplm: {self.data['nplm'].values[0]}" - pbar = tqdm(total=noutput, postfix=post_message, bar_format='{l_bar}{bar}{postfix}') + pbar = tqdm(total=noutput, desc=pre_message, postfix=post_message, bar_format='{l_bar}{bar}{postfix}') try: with subprocess.Popen(shlex.split(cmd), stdout=subprocess.PIPE, @@ -402,13 +403,15 @@ def _type_scrub(output_data): if process_output: kvstream=line.replace('\n','').strip().split(';') # Removes the newline character, output_data = _type_scrub({kv.split()[0]: kv.split()[1] for kv in kvstream[:-1]}) - post_message = f"Time: {output_data['T']} / {self.param['TSTOP']} {self.TU_name}" - post_message += f" npl: {output_data['NPL']} ntp: {output_data['NTP']}" + if self.param['TSTOP'] < 1e4: + pre_message = f"Time: {output_data['T']:>5} / {self.param['TSTOP']:>5} {self.TU_name}" + post_message = f" npl: {output_data['NPL']} ntp: {output_data['NTP']}" if "NPLM" in output_data: post_message += f" nplm: {output_data['NPLM']}" interval = output_data['ILOOP'] - iloop if interval > 0: pbar.update(interval) + pbar.set_description_str(pre_message) pbar.set_postfix_str(post_message) iloop = output_data['ILOOP'] From dfdccec7120a4c8202dfca3fbbefe866d9257d33 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Mon, 28 Nov 2022 16:53:56 -0500 Subject: [PATCH 131/569] Removed spurious comments from input files and reformatted them --- examples/Fragmentation/cb.in | 11 +---------- examples/Fragmentation/disruption_headon.in | 13 ++----------- examples/Fragmentation/hitandrun.in | 13 ++----------- 3 files changed, 5 insertions(+), 32 deletions(-) diff --git a/examples/Fragmentation/cb.in b/examples/Fragmentation/cb.in index 8766a22ae..a1275bf77 100644 --- a/examples/Fragmentation/cb.in +++ b/examples/Fragmentation/cb.in @@ -1,13 +1,4 @@ -!! Copyright 2022 - David Minton, Carlisle Wishard, Jennifer Pouplin, Jake Elliott, & Dana Singh -!! This file is part of Swiftest. -!! Swiftest is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License -!! as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. -!! Swiftest is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty -!! of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. -!! You should have received a copy of the GNU General Public License along with Swiftest. -!! If not, see: https://www.gnu.org/licenses. - -0 +Sun 39.47841760435743 ! G*Mass 0.005 ! Radius 0.0 ! J2 diff --git a/examples/Fragmentation/disruption_headon.in b/examples/Fragmentation/disruption_headon.in index 1f4b208f1..72c14edd1 100644 --- a/examples/Fragmentation/disruption_headon.in +++ b/examples/Fragmentation/disruption_headon.in @@ -1,20 +1,11 @@ -!! Copyright 2022 - David Minton, Carlisle Wishard, Jennifer Pouplin, Jake Elliott, & Dana Singh -!! This file is part of Swiftest. -!! Swiftest is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License -!! as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. -!! Swiftest is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty -!! of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. -!! You should have received a copy of the GNU General Public License along with Swiftest. -!! If not, see: https://www.gnu.org/licenses. - 2 -1 1e-07 0.0009 +Body1 1e-07 0.0009 7e-06 1.0 -1.807993e-05 0.0 -2.562596e-04 6.280005 0.0 0.4 0.4 0.4 !Ip 0.0 0.0 0.0 !rot -2 7e-10 0.0004 +Body2 7e-10 0.0004 3.25e-06 1.0 1.807993e-05 0.0 -2.562596e-04 -6.280005 0.0 diff --git a/examples/Fragmentation/hitandrun.in b/examples/Fragmentation/hitandrun.in index 285fc63a2..554d953ee 100644 --- a/examples/Fragmentation/hitandrun.in +++ b/examples/Fragmentation/hitandrun.in @@ -1,20 +1,11 @@ -!! Copyright 2022 - David Minton, Carlisle Wishard, Jennifer Pouplin, Jake Elliott, & Dana Singh -!! This file is part of Swiftest. -!! Swiftest is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License -!! as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. -!! Swiftest is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty -!! of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. -!! You should have received a copy of the GNU General Public License along with Swiftest. -!! If not, see: https://www.gnu.org/licenses. - 2 -1 1e-07 0.0009 +Body1 1e-07 0.0009 7e-06 1.0 -4.20E-05 0.0 0.00 6.28 0.0 0.4 0.4 0.4 !Ip 0.0 0.0 6.0e4 !rot -2 7e-10 0.0004 +Body2 7e-10 0.0004 3.25e-06 1.0 4.20E-05 0.0 -1.50 -6.28 0.0 From 45bf15d3789926a144ddac049e1d20fc921e4e5a Mon Sep 17 00:00:00 2001 From: David A Minton Date: Mon, 28 Nov 2022 17:28:54 -0500 Subject: [PATCH 132/569] Removeda bunch of old flat binary file cruft. --- .../Fragmentation/param.disruption_headon.in | 4 - examples/Fragmentation/param.hitandrun.in | 4 - .../param.supercatastrophic_off_axis.in | 4 - src/io/io.f90 | 194 ------------------ src/modules/swiftest_classes.f90 | 29 +-- src/modules/swiftest_globals.f90 | 1 - src/setup/setup.f90 | 4 +- src/symba/symba_util.f90 | 2 +- 8 files changed, 5 insertions(+), 237 deletions(-) diff --git a/examples/Fragmentation/param.disruption_headon.in b/examples/Fragmentation/param.disruption_headon.in index 0fd657831..96c8bcaa4 100644 --- a/examples/Fragmentation/param.disruption_headon.in +++ b/examples/Fragmentation/param.disruption_headon.in @@ -17,7 +17,6 @@ OUT_TYPE NETCDF_DOUBLE OUT_STAT REPLACE IN_FORM XV IN_TYPE ASCII -NC_IN -1.0 PL_IN disruption_headon.in TP_IN tp.in CB_IN cb.in @@ -32,7 +31,6 @@ MU2KG 1.98908e30 TU2S 3.1556925e7 DU2M 1.49598e11 EXTRA_FORCE no -PARTICLE_OUT -1.0 BIG_DISCARD no CHK_CLOSE yes GR NO @@ -42,8 +40,6 @@ RHILL_PRESENT yes FRAGMENTATION yes ROTATION yes ENERGY yes -ENERGY_OUT -1.0 -ENC_OUT -1.0 GMTINY 1.0e-11 MIN_GMFRAG 1.0e-11 TIDES NO diff --git a/examples/Fragmentation/param.hitandrun.in b/examples/Fragmentation/param.hitandrun.in index 1bd02166c..cbbbd7873 100644 --- a/examples/Fragmentation/param.hitandrun.in +++ b/examples/Fragmentation/param.hitandrun.in @@ -17,7 +17,6 @@ OUT_TYPE NETCDF_DOUBLE OUT_STAT REPLACE IN_FORM XV IN_TYPE ASCII -NC_IN -1.0 PL_IN hitandrun.in TP_IN tp.in CB_IN cb.in @@ -32,7 +31,6 @@ MU2KG 1.98908e30 TU2S 3.1556925e7 DU2M 1.49598e11 EXTRA_FORCE no -PARTICLE_OUT -1.0 BIG_DISCARD no CHK_CLOSE yes GR NO @@ -42,8 +40,6 @@ RHILL_PRESENT yes FRAGMENTATION yes ROTATION yes ENERGY yes -ENERGY_OUT -1.0 -ENC_OUT -1.0 GMTINY 1.0e-11 MIN_GMFRAG 1.0e-11 TIDES NO diff --git a/examples/Fragmentation/param.supercatastrophic_off_axis.in b/examples/Fragmentation/param.supercatastrophic_off_axis.in index 08b5dd71d..458491c20 100644 --- a/examples/Fragmentation/param.supercatastrophic_off_axis.in +++ b/examples/Fragmentation/param.supercatastrophic_off_axis.in @@ -17,7 +17,6 @@ OUT_TYPE NETCDF_DOUBLE OUT_STAT REPLACE IN_FORM XV IN_TYPE ASCII -NC_IN -1.0 PL_IN supercatastrophic_off_axis.in TP_IN tp.in CB_IN cb.in @@ -32,7 +31,6 @@ MU2KG 1.98908e30 TU2S 3.1556925e7 DU2M 1.49598e11 EXTRA_FORCE no -PARTICLE_OUT -1.0 BIG_DISCARD no CHK_CLOSE yes GR NO @@ -42,8 +40,6 @@ RHILL_PRESENT yes FRAGMENTATION yes ROTATION yes ENERGY yes -ENERGY_OUT -1.0 -ENC_OUT -1.0 GMTINY 1.0e-11 MIN_GMFRAG 1.0e-11 TIDES NO diff --git a/src/io/io.f90 b/src/io/io.f90 index c5af067f5..07ba1b737 100644 --- a/src/io/io.f90 +++ b/src/io/io.f90 @@ -228,97 +228,6 @@ module subroutine io_dump_param(self, param_file_name) end subroutine io_dump_param - module subroutine io_dump_particle_info(self, iu) - !! author: David A. Minton - !! - !! Reads in particle information object information from an open file unformatted file - implicit none - ! Arguments - class(swiftest_particle_info), intent(in) :: self !! Particle metadata information object - integer(I4B), intent(in) :: iu !! Open file unit number - ! Internals - character(STRMAX) :: errmsg - - write(iu, err = 667, iomsg = errmsg) self%name - write(iu, err = 667, iomsg = errmsg) self%particle_type - write(iu, err = 667, iomsg = errmsg) self%origin_type - write(iu, err = 667, iomsg = errmsg) self%origin_time - write(iu, err = 667, iomsg = errmsg) self%collision_id - write(iu, err = 667, iomsg = errmsg) self%origin_xh(:) - write(iu, err = 667, iomsg = errmsg) self%origin_vh(:) - - return - - 667 continue - write(*,*) "Error writing particle metadata information from file: " // trim(adjustl(errmsg)) - call util_exit(FAILURE) - end subroutine io_dump_particle_info - - - module subroutine io_dump_particle_info_base(self, param, idx) - !! author: David A. Minton - !! - !! Dumps the particle information data to a file. - !! Pass a list of array indices for test particles (tpidx) and/or massive bodies (plidx) to append - implicit none - ! Arguments - class(swiftest_base), intent(inout) :: self !! Swiftest base object (can be cb, pl, or tp) - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - integer(I4B), dimension(:), optional, intent(in) :: idx !! Array of test particle indices to append to the particle file - - ! Internals - logical, save :: lfirst = .true. - integer(I4B) :: i - character(STRMAX) :: errmsg - - if ((param%out_type == REAL4_TYPE) .or. (param%out_type == REAL8_TYPE)) then - if (lfirst) then - select case(param%out_stat) - case('APPEND') - open(unit=LUN, file=param%particle_out, status='OLD', position='APPEND', form='UNFORMATTED', err=667, iomsg=errmsg) - case('NEW', 'UNKNOWN', 'REPLACE') - open(unit=LUN, file=param%particle_out, status=param%out_stat, form='UNFORMATTED', err=667, iomsg=errmsg) - case default - write(*,*) 'Invalid status code',trim(adjustl(param%out_stat)) - call util_exit(FAILURE) - end select - - lfirst = .false. - else - open(unit=LUN, file=param%particle_out, status='OLD', position= 'APPEND', form='UNFORMATTED', err=667, iomsg=errmsg) - end if - - select type(self) - class is (swiftest_cb) - write(LUN, err = 667, iomsg = errmsg) self%id - call self%info%dump(LUN) - class is (swiftest_body) - if (present(idx)) then - do i = 1, size(idx) - write(LUN, err = 667, iomsg = errmsg) self%id(idx(i)) - call self%info(idx(i))%dump(LUN) - end do - else - do i = 1, self%nbody - write(LUN, err = 667, iomsg = errmsg) self%id(i) - call self%info(i)%dump(LUN) - end do - end if - end select - - close(unit = LUN, err = 667, iomsg = errmsg) - else if ((param%out_type == NETCDF_FLOAT_TYPE) .or. (param%out_type == NETCDF_DOUBLE_TYPE)) then - call self%write_particle_info(param%nciu, param) - end if - - return - - 667 continue - write(*,*) "Error writing particle information file: " // trim(adjustl(errmsg)) - call util_exit(FAILURE) - end subroutine io_dump_particle_info_base - - module subroutine io_dump_base(self, param) !! author: David A. Minton !! @@ -749,12 +658,6 @@ module subroutine io_param_reader(self, unit, iotype, v_list, iostat, iomsg) ifirst = ilast + 1 param_value = io_get_token(line, ifirst, ilast, iostat) read(param_value, *, err = 667, iomsg = iomsg) param%qmin_ahi - case ("ENC_OUT") - param%enc_out = param_value - case ("DISCARD_OUT") - param%discard_out = param_value - case ("ENERGY_OUT") - param%energy_out = param_value case ("EXTRA_FORCE") call io_toupper(param_value) if (param_value == "YES" .or. param_value == 'T') param%lextra_force = .true. @@ -843,8 +746,6 @@ module subroutine io_param_reader(self, unit, iotype, v_list, iostat, iomsg) read(param_value, *, err = 667, iomsg = iomsg) param%maxid case ("MAXID_COLLISION") read(param_value, *, err = 667, iomsg = iomsg) param%maxid_collision - case ("PARTICLE_OUT") - param%particle_out = param_value case ("RESTART") if (param_value == "NO" .or. param_value == 'F') then param%lrestart = .false. @@ -1090,12 +991,6 @@ module subroutine io_param_writer(self, unit, iotype, v_list, iostat, iomsg) call io_param_writer_one("OUT_FORM", param%out_form, unit) call io_param_writer_one("OUT_STAT", "APPEND", unit) end if - if ((param%out_type == REAL4_TYPE) .or. (param%out_type == REAL8_TYPE)) then - call io_param_writer_one("PARTICLE_OUT", param%particle_out, unit) - end if - if (param%enc_out /= "") then - call io_param_writer_one("ENC_OUT", param%enc_out, unit) - end if call io_param_writer_one("CHK_RMIN", param%rmin, unit) call io_param_writer_one("CHK_RMAX", param%rmax, unit) call io_param_writer_one("CHK_EJECT", param%rmaxu, unit) @@ -1109,17 +1004,8 @@ module subroutine io_param_writer(self, unit, iotype, v_list, iostat, iomsg) call io_param_writer_one("DU2M", param%DU2M, unit) call io_param_writer_one("RHILL_PRESENT", param%lrhill_present, unit) call io_param_writer_one("EXTRA_FORCE", param%lextra_force, unit) - if (param%discard_out /= "") then - call io_param_writer_one("DISCARD_OUT", param%discard_out, unit) - end if - if (param%discard_out /= "") then - call io_param_writer_one("BIG_DISCARD", param%lbig_discard, unit) - end if call io_param_writer_one("CHK_CLOSE", param%lclose, unit) call io_param_writer_one("ENERGY", param%lenergy, unit) - if (param%lenergy .and. (param%energy_out /= "")) then - call io_param_writer_one("ENERGY_OUT", param%energy_out, unit) - end if call io_param_writer_one("GR", param%lgr, unit) call io_param_writer_one("ROTATION", param%lrotation, unit) call io_param_writer_one("TIDES", param%ltides, unit) @@ -1129,17 +1015,6 @@ module subroutine io_param_writer(self, unit, iotype, v_list, iostat, iomsg) if (param%lenergy) then call io_param_writer_one("FIRSTENERGY", param%lfirstenergy, unit) - if ((param%out_type == REAL8_TYPE) .or. (param%out_type == REAL4_TYPE)) then - call io_param_writer_one("EORBIT_ORIG", param%Eorbit_orig, unit) - call io_param_writer_one("GMTOT_ORIG", param%GMtot_orig, unit) - call io_param_writer_one("LTOT_ORIG", param%Ltot_orig(:), unit) - call io_param_writer_one("LORBIT_ORIG", param%Lorbit_orig(:), unit) - call io_param_writer_one("LSPIN_ORIG", param%Lspin_orig(:), unit) - call io_param_writer_one("LESCAPE", param%Lescape(:), unit) - call io_param_writer_one("GMESCAPE",param%GMescape, unit) - call io_param_writer_one("ECOLLISIONS",param%Ecollisions, unit) - call io_param_writer_one("EUNTRACKED",param%Euntracked, unit) - end if end if call io_param_writer_one("FIRSTKICK",param%lfirstkick, unit) call io_param_writer_one("MAXID",param%maxid, unit) @@ -1940,75 +1815,6 @@ module subroutine io_read_in_particle_info(self, iu) end subroutine io_read_in_particle_info - module subroutine io_read_particle_info_system(self, param) - !! author: David A. Minton - !! - !! Reads an old particle information file for a restartd run - implicit none - ! Arguments - class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nbody system object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - ! Internals - integer(I4B) :: id, idx - logical :: lmatch - character(STRMAX) :: errmsg - type(swiftest_particle_info), allocatable :: tmpinfo - - if (.not.((param%out_type == REAL4_TYPE) .or. (param%out_type == REAL8_TYPE))) return ! This subroutine is only necessary for classic binary input files - - open(unit = LUN, file = param%particle_out, status = 'OLD', form = 'UNFORMATTED', err = 667, iomsg = errmsg) - - allocate(tmpinfo, mold=self%cb%info) - - select type(cb => self%cb) - class is (swiftest_cb) - select type(pl => self%pl) - class is (swiftest_pl) - select type(tp => self%tp) - class is (swiftest_tp) - associate(npl => pl%nbody, ntp => tp%nbody) - do - lmatch = .false. - read(LUN, err = 667, iomsg = errmsg, end = 333) id - - if (id == cb%id) then - call cb%info%read_in(LUN) - lmatch = .true. - else - if (npl > 0) then - idx = findloc(pl%id(1:npl), id, dim=1) - if (idx /= 0) then - call pl%info(idx)%read_in(LUN) - lmatch = .true. - end if - end if - if (.not.lmatch .and. ntp > 0) then - idx = findloc(tp%id(1:ntp), id, dim=1) - if (idx /= 0) then - call tp%info(idx)%read_in(LUN) - lmatch = .true. - end if - end if - end if - if (.not.lmatch) then - call tmpinfo%read_in(LUN) - end if - end do - end associate - close(unit = LUN, err = 667, iomsg = errmsg) - end select - end select - end select - - 333 continue - return - - 667 continue - write(*,*) "Error reading particle information file: " // trim(adjustl(errmsg)) - call util_exit(FAILURE) - end subroutine io_read_particle_info_system - - module subroutine io_set_display_param(self, display_style) !! author: David A. Minton !! diff --git a/src/modules/swiftest_classes.f90 b/src/modules/swiftest_classes.f90 index 00cf6583f..f04346624 100644 --- a/src/modules/swiftest_classes.f90 +++ b/src/modules/swiftest_classes.f90 @@ -53,7 +53,6 @@ module swiftest_classes character(STRMAX) :: out_type = NETCDF_DOUBLE_TYPE !! Binary format of output file character(STRMAX) :: out_form = XVEL !! Data to write to output file character(STRMAX) :: out_stat = 'NEW' !! Open status for output binary file - character(STRMAX) :: particle_out = PARTICLE_OUTFILE !! Name of output particle information file integer(I4B) :: istep_dump = -1 !! Number of time steps between dumps real(DP) :: rmin = -1.0_DP !! Minimum heliocentric radius for test particle real(DP) :: rmax = -1.0_DP !! Maximum heliocentric radius for test particle @@ -144,7 +143,6 @@ module swiftest_classes real(DP), dimension(NDIM) :: discard_vh !! The heliocentric velocity vector at the time of the particle's discard integer(I4B) :: discard_body_id !! The id of the other body involved in the discard (0 if no other body involved) contains - procedure :: dump => io_dump_particle_info !! Dumps contents of particle information to file procedure :: read_in => io_read_in_particle_info !! Read in a particle information object from an open file procedure :: copy => util_copy_particle_info !! Copies one set of information object components into another, component-by-component procedure :: set_value => util_set_particle_info !! Sets one or more values of the particle information metadata object @@ -158,12 +156,11 @@ module swiftest_classes contains !! The minimal methods that all systems must have procedure :: dump => io_dump_base !! Dump contents to file - procedure :: dump_particle_info => io_dump_particle_info_base !! Dump contents of particle information metadata to file procedure :: read_in => io_read_in_base !! Read in body initial conditions from a file procedure :: write_frame_netcdf => netcdf_write_frame_base !! I/O routine for writing out a single frame of time-series data for all bodies in the system in NetCDF format - procedure :: write_particle_info_netcdf => netcdf_write_particle_info_base !! Writes out the particle information metadata to NetCDF file + procedure :: write_particle_info_netcdf => netcdf_write_particle_info_base !! Dump contents of particle information metadata to file generic :: write_frame => write_frame_netcdf !! Set up generic procedure that will switch between NetCDF or Fortran binary depending on arguments - generic :: write_particle_info => write_particle_info_netcdf + generic :: write_particle_info => write_particle_info_netcdf !! Set up generic procedure that will switch between NetCDF or Fortran binary depending on arguments end type swiftest_base !******************************************************************************************************************************** @@ -421,7 +418,6 @@ module swiftest_classes procedure :: read_hdr_netcdf => netcdf_read_hdr_system !! Read a header for an output frame in NetCDF format procedure :: write_hdr_netcdf => netcdf_write_hdr_system !! Write a header for an output frame in NetCDF format procedure :: read_in => io_read_in_system !! Reads the initial conditions for an nbody system - procedure :: read_particle_info_bin => io_read_particle_info_system !! Read in particle metadata from file procedure :: read_particle_info_netcdf => netcdf_read_particle_info_system !! Read in particle metadata from file procedure :: write_discard => io_write_discard !! Write out information about discarded test particles procedure :: obl_pot => obl_pot_system !! Compute the contribution to the total gravitational potential due solely to the oblateness of the central body @@ -438,7 +434,7 @@ module swiftest_classes generic :: read_hdr => read_hdr_netcdf !! Generic method call for reading headers generic :: read_frame => read_frame_bin, read_frame_netcdf !! Generic method call for reading a frame of output data generic :: write_frame => write_frame_bin, write_frame_netcdf !! Generic method call for writing a frame of output data - generic :: read_particle_info => read_particle_info_bin, read_particle_info_netcdf !! Genereric method call for reading in the particle information metadata + generic :: read_particle_info => read_particle_info_netcdf !! Genereric method call for reading in the particle information metadata end type swiftest_nbody_system @@ -630,19 +626,6 @@ module subroutine io_dump_param(self, param_file_name) character(len=*), intent(in) :: param_file_name !! Parameter input file name (i.e. param.in) end subroutine io_dump_param - module subroutine io_dump_particle_info_base(self, param, idx) - implicit none - class(swiftest_base), intent(inout) :: self !! Swiftest base object (can be cb, pl, or tp) - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - integer(I4B), dimension(:), optional, intent(in) :: idx !! Array of test particle indices to append to the particle file - end subroutine io_dump_particle_info_base - - module subroutine io_dump_particle_info(self, iu) - implicit none - class(swiftest_particle_info), intent(in) :: self !! Swiftest particle info metadata object - integer(I4B), intent(in) :: iu !! Open unformatted file unit number - end subroutine io_dump_particle_info - module subroutine io_dump_base(self, param) implicit none class(swiftest_base), intent(inout) :: self !! Swiftest base object @@ -822,12 +805,6 @@ module function io_read_frame_system(self, iu, param) result(ierr) integer(I4B) :: ierr !! Error code: returns 0 if the read is successful end function io_read_frame_system - module subroutine io_read_particle_info_system(self, param) - implicit none - class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nbody system object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - end subroutine io_read_particle_info_system - module subroutine io_set_display_param(self, display_style) implicit none class(swiftest_parameters), intent(inout) :: self !! Current run configuration parameters diff --git a/src/modules/swiftest_globals.f90 b/src/modules/swiftest_globals.f90 index 97c68b85e..49fa0b834 100644 --- a/src/modules/swiftest_globals.f90 +++ b/src/modules/swiftest_globals.f90 @@ -133,7 +133,6 @@ module swiftest_globals character(*), parameter :: NC_INFILE = 'in.nc' character(*), parameter :: BIN_OUTFILE = 'bin.nc' integer(I4B), parameter :: BINUNIT = 20 !! File unit number for the binary output file - character(*), parameter :: PARTICLE_OUTFILE = 'particle.dat' integer(I4B), parameter :: PARTICLEUNIT = 44 !! File unit number for the binary particle info output file integer(I4B), parameter :: LUN = 42 !! File unit number for files that are opened and closed within a single subroutine call, and therefore should not collide diff --git a/src/setup/setup.f90 b/src/setup/setup.f90 index 859e8c6ba..3d0943d95 100644 --- a/src/setup/setup.f90 +++ b/src/setup/setup.f90 @@ -157,9 +157,7 @@ module subroutine setup_initialize_system(self, param) pl%lfirst = param%lfirstkick tp%lfirst = param%lfirstkick - if (param%lrestart) then - call system%read_particle_info(param) - else + if (.not.param%lrestart) then call system%init_particle_info(param) end if end associate diff --git a/src/symba/symba_util.f90 b/src/symba/symba_util.f90 index 8d110451f..0087c24e4 100644 --- a/src/symba/symba_util.f90 +++ b/src/symba/symba_util.f90 @@ -676,7 +676,7 @@ module subroutine symba_util_rearray_pl(self, system, param) end where end select - call pl%dump_particle_info(param, idx=pack([(i, i=1, npl)], ldump_mask)) + call pl%write_particle_info(param%nciu, param) deallocate(ldump_mask) ! Reindex the new list of bodies From f340cc9c51b19a876a568ed9a6999d48ad66467b Mon Sep 17 00:00:00 2001 From: David A Minton Date: Mon, 28 Nov 2022 19:10:25 -0500 Subject: [PATCH 133/569] Updated Fragmentation_Movie script with new structure --- examples/Fragmentation/Fragmentation_Movie.py | 18 +++++++++--------- python/swiftest/swiftest/io.py | 2 ++ python/swiftest/swiftest/simulation_class.py | 1 + 3 files changed, 12 insertions(+), 9 deletions(-) diff --git a/examples/Fragmentation/Fragmentation_Movie.py b/examples/Fragmentation/Fragmentation_Movie.py index 3c23a510a..c276f6e99 100644 --- a/examples/Fragmentation/Fragmentation_Movie.py +++ b/examples/Fragmentation/Fragmentation_Movie.py @@ -34,14 +34,14 @@ # Change this to be the parameter input file correlated with the run that you # wish to test. Swiftest will pull in the corresponding out.nc file automatically. -param_file = "param.hitandrun.in" +param_file = "param.disruption_headon.in" # Change this to an appropriate title and filename to appear on the movie. -movie_title = "Hit and Run" -movie_filename = "hitandrun.mp4" +movie_title = "Head-on Disruption" +movie_filename = "disruption_headon.mp4" # Pull in the Swiftest output data from the parameter file and store it as a Xarray dataset. -ds = swiftest.Simulation(param_file=param_file).ds +ds = swiftest.Simulation(read_param=True, param_file=param_file, read_old_output_file=True).data # Calculate the number of frames in the dataset. nframes = int(ds['time'].size) @@ -55,16 +55,16 @@ def center(xhx, xhy, xhz, Gmass): # Calculate the distance along the y-axis between the colliding bodies at the start of the simulation. # This will be used to scale the axis limits on the movie. -scale_frame = abs(ds['xhy'].isel(time=0).isel(id=1).values) + abs(ds['xhy'].isel(time=0).isel(id=2).values) +scale_frame = abs(ds['xhy'].isel(time=0, name=1).values) + abs(ds['xhy'].isel(time=0, name=2).values) # Set up the figure and the animation. fig, ax = plt.subplots(figsize=(4,4)) def animate(i): # Calculate the position and mass of all bodies in the system at time i and store as a numpy array. - xhx = ds['xhx'].isel(time=i).dropna(dim='id').values - xhy = ds['xhy'].isel(time=i).dropna(dim='id').values - xhz = ds['xhx'].isel(time=i).dropna(dim='id').values - Gmass = ds['Gmass'].isel(time=i).dropna(dim='id').values[1:] # Drop the Sun from the numpy array. + xhx = ds['xhx'].isel(time=i).dropna(dim='name').values + xhy = ds['xhy'].isel(time=i).dropna(dim='name').values + xhz = ds['xhx'].isel(time=i).dropna(dim='name').values + Gmass = ds['Gmass'].isel(time=i).dropna(dim='name').values[1:] # Drop the Sun from the numpy array. # Calculate the center of mass of the system at time i. While the center of mass relative to the # colliding bodies does not change, the center of mass of the collision will move as the bodies diff --git a/python/swiftest/swiftest/io.py b/python/swiftest/swiftest/io.py index e4d5ff139..5d1f72ad6 100644 --- a/python/swiftest/swiftest/io.py +++ b/python/swiftest/swiftest/io.py @@ -109,6 +109,8 @@ def str2bool(input_str): {True, False} """ + if type(input_str) is bool: + return input_str valid_true = ["YES", "Y", "T", "TRUE", ".TRUE."] valid_false = ["NO", "N", "F", "FALSE", ".FALSE."] if input_str.upper() in valid_true: diff --git a/python/swiftest/swiftest/simulation_class.py b/python/swiftest/swiftest/simulation_class.py index f4f244b73..625d0fae8 100644 --- a/python/swiftest/swiftest/simulation_class.py +++ b/python/swiftest/swiftest/simulation_class.py @@ -727,6 +727,7 @@ def set_parameter(self, verbose: bool = True, **kwargs): "init_cond_file_type": "NETCDF_DOUBLE", "init_cond_file_name": None, "init_cond_format": "EL", + "read_old_output_file": False, "output_file_type": "NETCDF_DOUBLE", "output_file_name": None, "output_format": "XVEL", From 04b2fad1e335397d0c9c853a27a3e0b321615204 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Tue, 29 Nov 2022 06:22:09 -0500 Subject: [PATCH 134/569] Set default istep_out and istep_dump to 1 --- python/swiftest/swiftest/simulation_class.py | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/python/swiftest/swiftest/simulation_class.py b/python/swiftest/swiftest/simulation_class.py index 625d0fae8..54f00a6c8 100644 --- a/python/swiftest/swiftest/simulation_class.py +++ b/python/swiftest/swiftest/simulation_class.py @@ -721,9 +721,9 @@ def set_parameter(self, verbose: bool = True, **kwargs): "tstart": 0.0, "tstop": None, "dt": None, - "istep_out": None, + "istep_out": 1, "tstep_out": None, - "istep_dump": None, + "istep_dump": 1, "init_cond_file_type": "NETCDF_DOUBLE", "init_cond_file_name": None, "init_cond_format": "EL", From 2cec6f877d4f9d6c869c465a108bfa8ee171122e Mon Sep 17 00:00:00 2001 From: David A Minton Date: Tue, 29 Nov 2022 06:24:21 -0500 Subject: [PATCH 135/569] Removed comment lines --- .../Fragmentation/supercatastrophic_off_axis.in | 13 ++----------- 1 file changed, 2 insertions(+), 11 deletions(-) diff --git a/examples/Fragmentation/supercatastrophic_off_axis.in b/examples/Fragmentation/supercatastrophic_off_axis.in index 03315636d..cd09c9070 100644 --- a/examples/Fragmentation/supercatastrophic_off_axis.in +++ b/examples/Fragmentation/supercatastrophic_off_axis.in @@ -1,20 +1,11 @@ -!! Copyright 2022 - David Minton, Carlisle Wishard, Jennifer Pouplin, Jake Elliott, & Dana Singh -!! This file is part of Swiftest. -!! Swiftest is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License -!! as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. -!! Swiftest is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty -!! of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. -!! You should have received a copy of the GNU General Public License along with Swiftest. -!! If not, see: https://www.gnu.org/licenses. - 2 -1 1e-07 0.0009 +Body1 1e-07 0.0009 7e-06 1.0 -4.2e-05 0.0 0.00 6.28 0.0 0.4 0.4 0.4 !Ip 0.0 0.0 -6.0e4 !rot -2 1e-08 0.0004 +Body2 1e-08 0.0004 3.25e-06 1.0 4.2e-05 0.0 1.00 -6.28 0.0 From 6012799dc239ffe84f459dd7769007dcdcab80e0 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Tue, 29 Nov 2022 06:27:59 -0500 Subject: [PATCH 136/569] Removed more old cruft from flat binary output code --- src/io/io.f90 | 145 ++++++++++++++------------------------------------ 1 file changed, 41 insertions(+), 104 deletions(-) diff --git a/src/io/io.f90 b/src/io/io.f90 index 07ba1b737..2c94ec725 100644 --- a/src/io/io.f90 +++ b/src/io/io.f90 @@ -291,49 +291,25 @@ module subroutine io_dump_system(self, param) param_file_name = trim(adjustl(DUMP_PARAM_FILE(idx))) dump_param%in_form = XV dump_param%out_stat = 'APPEND' - if ((param%out_type == REAL8_TYPE) .or. (param%out_type == REAL4_TYPE)) then - dump_param%in_type = REAL8_TYPE - dump_param%incbfile = trim(adjustl(DUMP_CB_FILE(idx))) - dump_param%inplfile = trim(adjustl(DUMP_PL_FILE(idx))) - dump_param%intpfile = trim(adjustl(DUMP_TP_FILE(idx))) - - dump_param%Eorbit_orig = self%Eorbit_orig - dump_param%GMtot_orig = self%GMtot_orig - dump_param%Ltot_orig(:) = self%Ltot_orig(:) - dump_param%Lorbit_orig(:) = self%Lorbit_orig(:) - dump_param%Lspin_orig(:) = self%Lspin_orig(:) - dump_param%GMescape = self%GMescape - dump_param%Ecollisions = self%Ecollisions - dump_param%Euntracked = self%Euntracked - dump_param%Lescape(:) = self%Lescape - - else if ((param%out_type == NETCDF_FLOAT_TYPE) .or. (param%out_type == NETCDF_DOUBLE_TYPE)) then - dump_param%in_type = NETCDF_DOUBLE_TYPE - dump_param%in_netcdf = trim(adjustl(DUMP_NC_FILE(idx))) - dump_param%nciu%id_chunk = self%pl%nbody + self%tp%nbody - dump_param%nciu%time_chunk = 1 - end if + dump_param%in_type = NETCDF_DOUBLE_TYPE + dump_param%in_netcdf = trim(adjustl(DUMP_NC_FILE(idx))) + dump_param%nciu%id_chunk = self%pl%nbody + self%tp%nbody + dump_param%nciu%time_chunk = 1 dump_param%T0 = param%t call dump_param%dump(param_file_name) dump_param%out_form = XV - if ((param%out_type == REAL8_TYPE) .or. (param%out_type == REAL4_TYPE)) then - call self%cb%dump(dump_param) - call self%pl%dump(dump_param) - call self%tp%dump(dump_param) - else if ((param%out_type == NETCDF_FLOAT_TYPE) .or. (param%out_type == NETCDF_DOUBLE_TYPE)) then - dump_param%outfile = trim(adjustl(DUMP_NC_FILE(idx))) - dump_param%ioutput = 0 - call dump_param%nciu%initialize(dump_param) - call self%write_hdr(dump_param%nciu, dump_param) - call self%cb%write_frame(dump_param%nciu, dump_param) - call self%pl%write_frame(dump_param%nciu, dump_param) - call self%tp%write_frame(dump_param%nciu, dump_param) - call dump_param%nciu%close() - ! Syncrhonize the disk and memory buffer of the NetCDF file (e.g. commit the frame files stored in memory to disk) - call param%nciu%flush(param) - end if + dump_param%outfile = trim(adjustl(DUMP_NC_FILE(idx))) + dump_param%ioutput = 0 + call dump_param%nciu%initialize(dump_param) + call self%write_hdr(dump_param%nciu, dump_param) + call self%cb%write_frame(dump_param%nciu, dump_param) + call self%pl%write_frame(dump_param%nciu, dump_param) + call self%tp%write_frame(dump_param%nciu, dump_param) + call dump_param%nciu%close() + ! Syncrhonize the disk and memory buffer of the NetCDF file (e.g. commit the frame files stored in memory to disk) + call param%nciu%flush(param) idx = idx + 1 if (idx > NDUMPFILES) idx = 1 @@ -796,8 +772,7 @@ module subroutine io_param_reader(self, unit, iotype, v_list, iostat, iomsg) end if param%lrestart = (param%out_stat == "APPEND") if (param%outfile /= "") then - if ((param%out_type /= REAL4_TYPE) .and. (param%out_type /= REAL8_TYPE) .and. & - (param%out_type /= NETCDF_FLOAT_TYPE) .and. (param%out_type /= NETCDF_DOUBLE_TYPE)) then + if ((param%out_type /= NETCDF_FLOAT_TYPE) .and. (param%out_type /= NETCDF_DOUBLE_TYPE)) then write(iomsg,*) 'Invalid out_type: ',trim(adjustl(param%out_type)) iostat = -1 return @@ -2092,74 +2067,36 @@ module subroutine io_write_frame_system(self, param) allocate(tp, source = self%tp) iu = BINUNIT - if ((param%out_type == REAL4_TYPE) .or. (param%out_type == REAL8_TYPE)) then - if (lfirst) then - select case(param%out_stat) - case('APPEND') - open(unit=iu, file=param%outfile, status='OLD', position='APPEND', form='UNFORMATTED', err=667, iomsg=errmsg) - case('NEW', 'REPLACE', 'UNKNOWN') - open(unit=iu, file=param%outfile, status=param%out_stat, form='UNFORMATTED', err=667, iomsg=errmsg) - case default - write(*,*) 'Invalid status code for OUT_STAT: ',trim(adjustl(param%out_stat)) - call util_exit(FAILURE) - end select - - lfirst = .false. - else - open(unit=iu, file=param%outfile, status='OLD', position= 'APPEND', form='UNFORMATTED', err=667, iomsg=errmsg) - end if - else if ((param%out_type == NETCDF_FLOAT_TYPE) .or. (param%out_type == NETCDF_DOUBLE_TYPE)) then - - param%nciu%id_chunk = pl%nbody + tp%nbody - param%nciu%time_chunk = max(param%istep_dump / param%istep_out, 1) - if (lfirst) then - inquire(file=param%outfile, exist=fileExists) - - select case(param%out_stat) - case('APPEND') - if (.not.fileExists) then - errmsg = param%outfile // " not found! You must specify OUT_STAT = NEW, REPLACE, or UNKNOWN" - goto 667 - end if - case('NEW') - if (fileExists) then - errmsg = param%outfile // " Alread Exists! You must specify OUT_STAT = APPEND, REPLACE, or UNKNOWN" - goto 667 - end if - call param%nciu%initialize(param) - case('REPLACE', 'UNKNOWN') - call param%nciu%initialize(param) - end select + param%nciu%id_chunk = pl%nbody + tp%nbody + param%nciu%time_chunk = max(param%istep_dump / param%istep_out, 1) + if (lfirst) then + inquire(file=param%outfile, exist=fileExists) + + select case(param%out_stat) + case('APPEND') + if (.not.fileExists) then + errmsg = param%outfile // " not found! You must specify OUT_STAT = NEW, REPLACE, or UNKNOWN" + goto 667 + end if + case('NEW') + if (fileExists) then + errmsg = param%outfile // " Alread Exists! You must specify OUT_STAT = APPEND, REPLACE, or UNKNOWN" + goto 667 + end if + call param%nciu%initialize(param) + case('REPLACE', 'UNKNOWN') + call param%nciu%initialize(param) + end select - lfirst = .false. - end if + lfirst = .false. end if ! Write out each data type frame - if ((param%out_type == REAL4_TYPE) .or. (param%out_type == REAL8_TYPE)) then - ! For these data types, do these conversion here before writing the output. - if (param%lgr) then - call pl%pv2v(param) - call tp%pv2v(param) - end if - - if ((param%out_form == EL) .or. (param%out_form == XVEL)) then ! Do an orbital element conversion prior to writing out the frame, as we have access to the central body here - call pl%xv2el(cb) - call tp%xv2el(cb) - end if - - call self%write_hdr(iu, param) - call cb%write_frame(iu, param) - call pl%write_frame(iu, param) - call tp%write_frame(iu, param) - close(iu, err = 667, iomsg = errmsg) - else if ((param%out_type == NETCDF_FLOAT_TYPE) .or. (param%out_type == NETCDF_DOUBLE_TYPE)) then - ! For NetCDF output, because we want to store the pseudovelocity separately from the true velocity, we need to do the orbital element conversion internally - call self%write_hdr(param%nciu, param) - call cb%write_frame(param%nciu, param) - call pl%write_frame(param%nciu, param) - call tp%write_frame(param%nciu, param) - end if + ! For NetCDF output, because we want to store the pseudovelocity separately from the true velocity, we need to do the orbital element conversion internally + call self%write_hdr(param%nciu, param) + call cb%write_frame(param%nciu, param) + call pl%write_frame(param%nciu, param) + call tp%write_frame(param%nciu, param) return From 71602745c30625a852d9d778e5abcfd6f36bd3d0 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Tue, 29 Nov 2022 12:23:50 -0500 Subject: [PATCH 137/569] Restructured the add_body method so it can take in position and velocity vectors rather than just components. Also made a number of updates to ensure that the parameter output directory is created correctly and that the progress bar time display is formatted correctly. --- python/swiftest/swiftest/simulation_class.py | 261 +++++++++++++------ 1 file changed, 176 insertions(+), 85 deletions(-) diff --git a/python/swiftest/swiftest/simulation_class.py b/python/swiftest/swiftest/simulation_class.py index 54f00a6c8..174c64296 100644 --- a/python/swiftest/swiftest/simulation_class.py +++ b/python/swiftest/swiftest/simulation_class.py @@ -302,19 +302,17 @@ def __init__(self,read_param: bool = False, **kwargs: Any): self.param = {} self.data = xr.Dataset() + # Set the location of the parameter input file, choosing the default if it isn't specified. + param_file = kwargs.pop("param_file",Path.cwd() / "simdata" / "param.in") + self.verbose = kwargs.pop("verbose",True) + # Parameters are set in reverse priority order. First the defaults, then values from a pre-existing input file, # then using the arguments passed via **kwargs. #-------------------------- # Lowest Priority: Defaults #-------------------------- - # Quietly set all parameters to their defaults. - self.verbose = kwargs.pop("verbose",True) - self.set_parameter(verbose=False) - - # Set the location of the parameter input file - param_file = kwargs.pop("param_file",self.param_file) self.set_parameter(verbose=False,param_file=param_file) #----------------------------------------------------------------- @@ -383,8 +381,8 @@ def _type_scrub(output_data): process_output = False noutput = int((self.param['TSTOP'] - self.param['T0']) / self.param['DT']) iloop = int((self.param['TSTART'] - self.param['T0']) / self.param['DT']) - if self.param['TSTOP'] < 1e4: - pre_message = f"Time: {self.param['TSTART']:>5} / {self.param['TSTOP']:>5} {self.TU_name} " + twidth = int(np.ceil(np.log10(self.param['TSTOP']/self.param['DT']))) + pre_message = f"Time: {self.param['TSTART']:.{twidth}e} / {self.param['TSTOP']:.{twidth}e} {self.TU_name} " post_message = f"npl: {self.data['npl'].values[0]} ntp: {self.data['ntp'].values[0]}" if "nplm" in self.data: post_message += f" nplm: {self.data['nplm'].values[0]}" @@ -403,8 +401,7 @@ def _type_scrub(output_data): if process_output: kvstream=line.replace('\n','').strip().split(';') # Removes the newline character, output_data = _type_scrub({kv.split()[0]: kv.split()[1] for kv in kvstream[:-1]}) - if self.param['TSTOP'] < 1e4: - pre_message = f"Time: {output_data['T']:>5} / {self.param['TSTOP']:>5} {self.TU_name}" + pre_message = f"Time: {output_data['T']:.{twidth}e} / {self.param['TSTOP']:.{twidth}e} {self.TU_name}" post_message = f" npl: {output_data['NPL']} ntp: {output_data['NTP']}" if "NPLM" in output_data: post_message += f" nplm: {output_data['NPLM']}" @@ -716,7 +713,6 @@ def set_parameter(self, verbose: bool = True, **kwargs): default_arguments = { "codename" : "Swiftest", "integrator": "symba", - "param_file": Path.cwd() / "simdata" / "param.in", "t0": 0.0, "tstart": 0.0, "tstop": None, @@ -743,7 +739,7 @@ def set_parameter(self, verbose: bool = True, **kwargs): "rmin": constants.RSun / constants.AU2M, "rmax": 10000.0, "qmin_coord": "HELIO", - "gmtiny": None, + "gmtiny": 0.0, "mtiny": None, "close_encounter_check": True, "general_relativity": True, @@ -760,19 +756,6 @@ def set_parameter(self, verbose: bool = True, **kwargs): "ephemeris_date": "MBCL", "restart": False, } - - # If no arguments (other than, possibly, verbose) are requested, use defaults - if len(kwargs) == 0: - kwargs = default_arguments - - unrecognized = [k for k,v in kwargs.items() if k not in default_arguments] - if len(unrecognized) > 0: - for k in unrecognized: - warnings.warn(f'Unrecognized argument "{k}"',stacklevel=2) - - # Add the verbose flag to the kwargs for passing down to the individual setters - kwargs["verbose"] = verbose - param_file = kwargs.pop("param_file",None) # Extract the simulation directory and create it if it doesn't exist @@ -787,6 +770,19 @@ def set_parameter(self, verbose: bool = True, **kwargs): else: self.sim_dir.mkdir(parents=True, exist_ok=False) + # If no arguments (other than, possibly, verbose) are requested, use defaults + if len(kwargs) == 0: + kwargs = default_arguments + + unrecognized = [k for k,v in kwargs.items() if k not in default_arguments] + if len(unrecognized) > 0: + for k in unrecognized: + warnings.warn(f'Unrecognized argument "{k}"',stacklevel=2) + + # Add the verbose flag to the kwargs for passing down to the individual setters + kwargs["verbose"] = verbose + + # Setters returning parameter dictionary values param_dict = {} @@ -2084,9 +2080,9 @@ def add_solar_system_body(self, #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,GMpl,Rpl,rhill,Ip1,Ip2,Ip3,rotx,roty,rotz,J2,J4 = tuple(np.hsplit(np.array(body_list[0]),19)) + 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)) else: - name,v1,v2,v3,v4,v5,v6,ephemeris_id,GMpl,Rpl,rhill,Ip1,Ip2,Ip3,rotx,roty,rotz,J2,J4 = tuple(np.squeeze(np.hsplit(np.array(body_list),19))) + 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) @@ -2099,8 +2095,8 @@ def add_solar_system_body(self, J2 = J2.astype(np.float64) J4 = J4.astype(np.float64) - GMpl = GMpl.astype(np.float64) - Rpl = Rpl.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) @@ -2109,10 +2105,10 @@ def add_solar_system_body(self, rotz = rotz.astype(np.float64) - if all(np.isnan(GMpl)): - GMpl = None - if all(np.isnan(Rpl)): - Rpl = None + 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)): @@ -2135,7 +2131,7 @@ def add_solar_system_body(self, t = self.param['TSTART'] dsnew = init_cond.vec2xr(self.param,name,v1,v2,v3,v4,v5,v6,ephemeris_id, - GMpl=GMpl, Rpl=Rpl, rhill=rhill, + GMpl=Gmass, Rpl=radius, rhill=rhill, Ip1=Ip1, Ip2=Ip2, Ip3=Ip3, rotx=rotx, roty=roty, rotz=rotz, J2=J2, J4=J4, t=t) @@ -2270,23 +2266,28 @@ def _get_instance_var(self, arg_list: str | List[str], valid_arg: Dict, verbose: return tuple(arg_vals) def add_body(self, - name: str | List[str] | npt.NDArray[np.str_], - v1: float | List[float] | npt.NDArray[np.float_], - v2: float | List[float] | npt.NDArray[np.float_], - v3: float | List[float] | npt.NDArray[np.float_], - v4: float | List[float] | npt.NDArray[np.float_], - v5: float | List[float] | npt.NDArray[np.float_], - v6: float | List[float] | npt.NDArray[np.float_], + name: str | List[str] | npt.NDArray[np.str_] | None=None, idvals: int | list[int] | npt.NDArray[np.int_] | None=None, - GMpl: float | List[float] | npt.NDArray[np.float_] | None=None, - Rpl: float | List[float] | npt.NDArray[np.float_] | 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] | npt.NDArray[np.float_] | None = None, + vh: List[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] | 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): """ @@ -2297,32 +2298,45 @@ def add_body(self, Parameters ---------- - name : str or array-like of str - Name or names of - v1 : float or array-like of float + 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 + 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 + 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 + 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 + 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 + 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 + v6 : float or array-like of float, optional vhz for param['IN_FORM'] == "XV"; capm for param['IN_FORM'] == "EL" - idvals : int or array-like of int, optional - Unique id values. If not passed, this will be computed based on the pre-existing Dataset ids. + xh : (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 + mass : float or array-like of float, optional + mass values if these are massive bodies (only one of mass or Gmass can be passed) Gmass : float or array-like of float, optional - G*mass values if these are massive bodies + 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, optional + rhill : float or array-like of float, optional Hill's radius values if these are massive bodies - Ip1,y,z : float, optional - Principal axes moments of inertia these are massive bodies with rotation enabled - rotx,y,z: float, optional + 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 + Ip: (3) or (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 Returns ------- @@ -2339,40 +2353,76 @@ def input_to_array(val,t,n=None): t = np.int64 elif t == "s": t = np.str + if val is None: - return None + return None, n + elif isinstance(val, np.ndarray): + pass elif np.isscalar(val): val = np.array([val],dtype=t) - elif type(val) is list: - val = np.array(val,dtype=t) + else: + try: + val = np.array(val,dtype=t) + except: + raise ValueError(f"{val} cannot be converted to a numpy array") if n is None: return val, len(val) else: if n != len(val): - raise ValueError(f"Error! Mismatched array lengths in add_body. Got {len(val)} when expecting {n}") - return val - - - name,nbodies = input_to_array(name,"s") - v1 = input_to_array(v1,"f",nbodies) - v2 = input_to_array(v2,"f",nbodies) - v3 = input_to_array(v3,"f",nbodies) - v4 = input_to_array(v4,"f",nbodies) - v5 = input_to_array(v5,"f",nbodies) - v6 = input_to_array(v6,"f",nbodies) - idvals = input_to_array(idvals,"i",nbodies) - GMpl = input_to_array(GMpl,"f",nbodies) - rhill = input_to_array(rhill,"f",nbodies) - Rpl = input_to_array(Rpl,"f",nbodies) - Ip1 = input_to_array(Ip1,"f",nbodies) - Ip2 = input_to_array(Ip2,"f",nbodies) - Ip3 = input_to_array(Ip3,"f",nbodies) - rotx = input_to_array(rotx,"f",nbodies) - roty = input_to_array(roty,"f",nbodies) - rotz = input_to_array(rotz,"f",nbodies) - J2 = input_to_array(J2,"f",nbodies) - J4 = input_to_array(J4,"f",nbodies) + raise ValueError(f"Mismatched array lengths in add_body. Got {len(val)} when expecting {n}") + return val, n + + def input_to_array_3d(val,n=None): + if val is None: + return None, n + elif isinstance(val, np.ndarray): + pass + else: + try: + val = np.array(val,dtype=np.float64) + except: + raise ValueError(f"{val} cannot be converted to a numpy array") + if n is None: + if val.dim > 2 or val.dim == 0: + raise ValueError(f"Argument must be an (n,3) array. This one is {val.shape}") + else: + if val.shape[-1] != 3: + raise ValueError(f"Argument must be a 3-dimensional vector. This one has {val.shape[0]}!") + if val.dim == 1: + n = 1 + else: + n = val.shape[0] + elif val.shape != (n,3): + raise ValueError(f"Argument is an incorrect shape. Expected {(n,3)}. Got {val.shape} instead") + return val, n + + 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) + 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) + vh,nbodies = input_to_array_3d(vh,nbodies) + rot,nbodies = input_to_array_3d(rot,nbodies) + Ip,nbodies = input_to_array_3d(Ip,nbodies) if len(self.data) == 0: maxid = -1 @@ -2382,6 +2432,9 @@ def input_to_array(val,t,n=None): if idvals is None: idvals = np.arange(start=maxid+1,stop=maxid+1+nbodies,dtype=int) + if name is None: + name=np.char.mod(f"Body%d",idvals) + if len(self.data) > 0: dup_id = np.in1d(idvals, self.data.id) if any(dup_id): @@ -2389,8 +2442,46 @@ def input_to_array(val,t,n=None): 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] + + if mass is not None: + if Gmass is not None: + raise ValueError("Cannot use mass and Gmass inputs simultaneously!") + else: + Gmass = self.param['GU'] * mass + dsnew = init_cond.vec2xr(self.param, name, v1, v2, v3, v4, v5, v6, idvals, - GMpl=GMpl, Rpl=Rpl, rhill=rhill, + GMpl=Gmass, Rpl=radius, rhill=rhill, Ip1=Ip1, Ip2=Ip2, Ip3=Ip3, rotx=rotx, roty=roty, rotz=rotz, J2=J2, J4=J4,t=t) From dd2c5356e705760c788ab3b90043b8e2a5be030b Mon Sep 17 00:00:00 2001 From: David A Minton Date: Tue, 29 Nov 2022 12:41:50 -0500 Subject: [PATCH 138/569] Added energy and momentum tracking to progress bar output. This is a stop-gap until a more complete progress display can be made --- .../Fragmentation/param.disruption_headon.in | 47 ------------------- examples/Fragmentation/param.hitandrun.in | 47 ------------------- .../param.supercatastrophic_off_axis.in | 47 ------------------- python/swiftest/swiftest/simulation_class.py | 10 ++-- 4 files changed, 7 insertions(+), 144 deletions(-) delete mode 100644 examples/Fragmentation/param.disruption_headon.in delete mode 100644 examples/Fragmentation/param.hitandrun.in delete mode 100644 examples/Fragmentation/param.supercatastrophic_off_axis.in diff --git a/examples/Fragmentation/param.disruption_headon.in b/examples/Fragmentation/param.disruption_headon.in deleted file mode 100644 index 96c8bcaa4..000000000 --- a/examples/Fragmentation/param.disruption_headon.in +++ /dev/null @@ -1,47 +0,0 @@ -!! Copyright 2022 - David Minton, Carlisle Wishard, Jennifer Pouplin, Jake Elliott, & Dana Singh -!! This file is part of Swiftest. -!! Swiftest is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License -!! as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. -!! Swiftest is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty -!! of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. -!! You should have received a copy of the GNU General Public License along with Swiftest. -!! If not, see: https://www.gnu.org/licenses. - -T0 0.0e0 -TSTOP 0.00001 -DT 0.00000001 -ISTEP_OUT 1 -ISTEP_DUMP 1 -OUT_FORM XVEL -OUT_TYPE NETCDF_DOUBLE -OUT_STAT REPLACE -IN_FORM XV -IN_TYPE ASCII -PL_IN disruption_headon.in -TP_IN tp.in -CB_IN cb.in -BIN_OUT disruption_headon.nc -CHK_QMIN -1.0 -CHK_RMIN 0.005 -CHK_RMAX 1e6 -CHK_EJECT -1.0 -CHK_QMIN_COORD -1.0 -CHK_QMIN_RANGE -1.0 -1.0 -MU2KG 1.98908e30 -TU2S 3.1556925e7 -DU2M 1.49598e11 -EXTRA_FORCE no -BIG_DISCARD no -CHK_CLOSE yes -GR NO -INTERACTION_LOOPS TRIANGULAR -ENCOUNTER_CHECK TRIANGULAR -RHILL_PRESENT yes -FRAGMENTATION yes -ROTATION yes -ENERGY yes -GMTINY 1.0e-11 -MIN_GMFRAG 1.0e-11 -TIDES NO -YORP NO -YARKOVSKY NO diff --git a/examples/Fragmentation/param.hitandrun.in b/examples/Fragmentation/param.hitandrun.in deleted file mode 100644 index cbbbd7873..000000000 --- a/examples/Fragmentation/param.hitandrun.in +++ /dev/null @@ -1,47 +0,0 @@ -!! Copyright 2022 - David Minton, Carlisle Wishard, Jennifer Pouplin, Jake Elliott, & Dana Singh -!! This file is part of Swiftest. -!! Swiftest is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License -!! as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. -!! Swiftest is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty -!! of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. -!! You should have received a copy of the GNU General Public License along with Swiftest. -!! If not, see: https://www.gnu.org/licenses. - -T0 0.0e0 -TSTOP 0.00001 -DT 0.00000001 -ISTEP_OUT 1 -ISTEP_DUMP 1 -OUT_FORM XVEL -OUT_TYPE NETCDF_DOUBLE -OUT_STAT REPLACE -IN_FORM XV -IN_TYPE ASCII -PL_IN hitandrun.in -TP_IN tp.in -CB_IN cb.in -BIN_OUT hitandrun.nc -CHK_QMIN -1.0 -CHK_RMIN 0.005 -CHK_RMAX 1e6 -CHK_EJECT -1.0 -CHK_QMIN_COORD -1.0 -CHK_QMIN_RANGE -1.0 -1.0 -MU2KG 1.98908e30 -TU2S 3.1556925e7 -DU2M 1.49598e11 -EXTRA_FORCE no -BIG_DISCARD no -CHK_CLOSE yes -GR NO -INTERACTION_LOOPS TRIANGULAR -ENCOUNTER_CHECK TRIANGULAR -RHILL_PRESENT yes -FRAGMENTATION yes -ROTATION yes -ENERGY yes -GMTINY 1.0e-11 -MIN_GMFRAG 1.0e-11 -TIDES NO -YORP NO -YARKOVSKY NO diff --git a/examples/Fragmentation/param.supercatastrophic_off_axis.in b/examples/Fragmentation/param.supercatastrophic_off_axis.in deleted file mode 100644 index 458491c20..000000000 --- a/examples/Fragmentation/param.supercatastrophic_off_axis.in +++ /dev/null @@ -1,47 +0,0 @@ -!! Copyright 2022 - David Minton, Carlisle Wishard, Jennifer Pouplin, Jake Elliott, & Dana Singh -!! This file is part of Swiftest. -!! Swiftest is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License -!! as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. -!! Swiftest is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty -!! of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. -!! You should have received a copy of the GNU General Public License along with Swiftest. -!! If not, see: https://www.gnu.org/licenses. - -T0 0.0e0 -TSTOP 0.00001 -DT 0.00000001 -ISTEP_OUT 1 -ISTEP_DUMP 1 -OUT_FORM XVEL -OUT_TYPE NETCDF_DOUBLE -OUT_STAT REPLACE -IN_FORM XV -IN_TYPE ASCII -PL_IN supercatastrophic_off_axis.in -TP_IN tp.in -CB_IN cb.in -BIN_OUT supercatastrophic_off_axis.nc -CHK_QMIN -1.0 -CHK_RMIN 0.005 -CHK_RMAX 1e6 -CHK_EJECT -1.0 -CHK_QMIN_COORD -1.0 -CHK_QMIN_RANGE -1.0 -1.0 -MU2KG 1.98908e30 -TU2S 3.1556925e7 -DU2M 1.49598e11 -EXTRA_FORCE no -BIG_DISCARD no -CHK_CLOSE yes -GR NO -INTERACTION_LOOPS TRIANGULAR -ENCOUNTER_CHECK TRIANGULAR -RHILL_PRESENT yes -FRAGMENTATION yes -ROTATION yes -ENERGY yes -GMTINY 1.0e-11 -MIN_GMFRAG 1.0e-11 -TIDES NO -YORP NO -YARKOVSKY NO diff --git a/python/swiftest/swiftest/simulation_class.py b/python/swiftest/swiftest/simulation_class.py index 174c64296..fbd0a3360 100644 --- a/python/swiftest/swiftest/simulation_class.py +++ b/python/swiftest/swiftest/simulation_class.py @@ -386,6 +386,8 @@ def _type_scrub(output_data): post_message = f"npl: {self.data['npl'].values[0]} ntp: {self.data['ntp'].values[0]}" if "nplm" in self.data: post_message += f" nplm: {self.data['nplm'].values[0]}" + if self.param['ENERGY']: + post_message += f" dL/L0: {0.0:.5e} dE/|E0|: {0.0:.5e}" pbar = tqdm(total=noutput, desc=pre_message, postfix=post_message, bar_format='{l_bar}{bar}{postfix}') try: with subprocess.Popen(shlex.split(cmd), @@ -405,6 +407,10 @@ def _type_scrub(output_data): post_message = f" npl: {output_data['NPL']} ntp: {output_data['NTP']}" if "NPLM" in output_data: post_message += f" nplm: {output_data['NPLM']}" + if "LTOTERR" in output_data: + post_message += f" dL/L0: {output_data['LTOTERR']:.5e}" + if "ETOTERR" in output_data: + post_message += f" dE/|E0|: {output_data['ETOTERR']:.5e}" interval = output_data['ILOOP'] - iloop if interval > 0: pbar.update(interval) @@ -745,7 +751,7 @@ def set_parameter(self, verbose: bool = True, **kwargs): "general_relativity": True, "fragmentation": False, "minimum_fragment_mass": None, - "minimum_fragment_gmass": None, + "minimum_fragment_gmass": 0.0, "rotation": False, "compute_conservation_values": False, "extra_force": False, @@ -782,8 +788,6 @@ def set_parameter(self, verbose: bool = True, **kwargs): # Add the verbose flag to the kwargs for passing down to the individual setters kwargs["verbose"] = verbose - - # Setters returning parameter dictionary values param_dict = {} param_dict.update(self.set_unit_system(**kwargs)) From 84481fb0672b4b89ef78110b40d503fa1261bc6f Mon Sep 17 00:00:00 2001 From: David A Minton Date: Tue, 29 Nov 2022 12:42:45 -0500 Subject: [PATCH 139/569] Restructured Fragmentation_Movie script. Currently, it does not output the correct type of collisions due to changes in the initial conditions. I will continue tweaking them to get a good set of collisions --- examples/Fragmentation/Fragmentation_Movie.py | 110 +++++++++++++----- 1 file changed, 83 insertions(+), 27 deletions(-) diff --git a/examples/Fragmentation/Fragmentation_Movie.py b/examples/Fragmentation/Fragmentation_Movie.py index c276f6e99..0fb803d8d 100644 --- a/examples/Fragmentation/Fragmentation_Movie.py +++ b/examples/Fragmentation/Fragmentation_Movie.py @@ -23,28 +23,66 @@ Returns ------- fragmentation.mp4 : mp4 movie file - Movide of a fragmentation event. + Movie of a fragmentation event. """ import swiftest import numpy as np import matplotlib.pyplot as plt import matplotlib.animation as animation -from matplotlib.animation import FuncAnimation +from pathlib import Path -# Change this to be the parameter input file correlated with the run that you -# wish to test. Swiftest will pull in the corresponding out.nc file automatically. -param_file = "param.disruption_headon.in" +print("Select a fragmentation movie to generate.") +print("1. Head-on disruption") +print("2. Off-axis supercatastrophic") +print("3. Hit and run") +print("4. All of the above") +user_selection = int(input("? ")) -# Change this to an appropriate title and filename to appear on the movie. -movie_title = "Head-on Disruption" -movie_filename = "disruption_headon.mp4" +available_movie_styles = ["disruption_headon", "supercatastrophic_off_axis", "hitandrun"] +movie_title_list = ["Head-on Disrutption", "Off-axis Supercatastrophic", "Hit and Run"] +movie_titles = dict(zip(available_movie_styles, movie_title_list)) -# Pull in the Swiftest output data from the parameter file and store it as a Xarray dataset. -ds = swiftest.Simulation(read_param=True, param_file=param_file, read_old_output_file=True).data +pos_vectors = {"disruption_headon" : [np.array([1.0, -1.807993e-05, 0.0]), + np.array([1.0, 1.807993e-05 ,0.0])], + "supercatastrophic_off_axis": [np.array([1.0, -4.2e-05, 0.0]), + np.array([1.0, 4.2e-05, 0.0])], + "hitandrun" : [np.array([1.0, -4.2e-05, 0.0]), + np.array([1.0, 4.2e-05, 0.0])] + } -# Calculate the number of frames in the dataset. -nframes = int(ds['time'].size) +vel_vectors = {"disruption_headon" : [np.array([-2.562596e-04, 6.280005, 0.0]), + np.array([-2.562596e-04, -6.280005, 0.0])], + "supercatastrophic_off_axis": [np.array([0.0, 6.28, 0.0]), + np.array([1.0, -6.28, 0.0])], + "hitandrun" : [np.array([0.0, 6.28, 0.0]), + np.array([-1.5, -6.28, 0.0])] + } + +rot_vectors = {"disruption_headon" : [np.array([0.0, 0.0, 0.0]), + np.array([0.0, 0.0, 0.0])], + "supercatastrophic_off_axis": [np.array([0.0, 0.0, -6.0e4]), + np.array([0.0, 0.0, 1.0e5])], + "hitandrun" : [np.array([0.0, 0.0, 6.0e4]), + np.array([0.0, 0.0, 1.0e5])] + } + +body_Gmass = {"disruption_headon" : [1e-7, 7e-10], + "supercatastrophic_off_axis": [1e-7, 1e-8], + "hitandrun" : [1e-7, 7e-10] + } + +density = 3000 * swiftest.AU2M**3 / swiftest.MSun +GU = swiftest.GMSun * swiftest.YR2S**2 / swiftest.AU2M**3 +body_radius = body_Gmass.copy() +for k,v in body_Gmass.items(): + body_radius[k] = [((Gmass/GU)/(4./3.*np.pi*density))**(1./3.) for Gmass in v] + +if user_selection > 0 and user_selection < 4: + movie_styles = [available_movie_styles[user_selection-1]] +else: + print("Generating all movie styles") + movie_styles = available_movie_styles.copy() # Define a function to calculate the center of mass of the system. def center(xhx, xhy, xhz, Gmass): @@ -53,24 +91,19 @@ def center(xhx, xhy, xhz, Gmass): z_com = np.sum(Gmass * xhz) / np.sum(Gmass) return x_com, y_com, z_com -# Calculate the distance along the y-axis between the colliding bodies at the start of the simulation. -# This will be used to scale the axis limits on the movie. -scale_frame = abs(ds['xhy'].isel(time=0, name=1).values) + abs(ds['xhy'].isel(time=0, name=2).values) +def animate(i,ds,movie_title): -# Set up the figure and the animation. -fig, ax = plt.subplots(figsize=(4,4)) -def animate(i): # Calculate the position and mass of all bodies in the system at time i and store as a numpy array. xhx = ds['xhx'].isel(time=i).dropna(dim='name').values xhy = ds['xhy'].isel(time=i).dropna(dim='name').values xhz = ds['xhx'].isel(time=i).dropna(dim='name').values - Gmass = ds['Gmass'].isel(time=i).dropna(dim='name').values[1:] # Drop the Sun from the numpy array. + Gmass = ds['Gmass'].isel(time=i).dropna(dim='name').values[1:] # Drop the Sun from the numpy array. - # Calculate the center of mass of the system at time i. While the center of mass relative to the + # Calculate the center of mass of the system at time i. While the center of mass relative to the # colliding bodies does not change, the center of mass of the collision will move as the bodies # orbit the system center of mass. x_com, y_com, z_com = center(xhx, xhy, xhz, Gmass) - + # Create the figure and plot the bodies as points. fig.clear() ax = fig.add_subplot(111) @@ -82,11 +115,34 @@ def animate(i): ax.grid(False) ax.set_xticks([]) ax.set_yticks([]) - - ax.scatter(xhx, xhy, s = (5000000000 * Gmass)) - + + ax.scatter(xhx, xhy, s=(5000000000 * Gmass)) + plt.tight_layout() -# Generate the movie. -ani = animation.FuncAnimation(fig, animate, interval=1, frames=nframes, repeat=False) -ani.save(movie_filename, fps=60, dpi=300, extra_args=['-vcodec', 'libx264']) \ No newline at end of file +for style in movie_styles: + param_file = Path(style) / "param.in" + + movie_filename = f"{style}.mp4" + + # Pull in the Swiftest output data from the parameter file and store it as a Xarray dataset. + sim = swiftest.Simulation(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]) + + # Set fragmentation parameters + sim.set_parameter(fragmentation = True, gmtiny=1e-11, minimum_fragment_gmass=1e-11) + sim.run(dt=1e-8, tstop=1e-5) + + # Calculate the number of frames in the dataset. + nframes = int(sim.data['time'].size) + + # Calculate the distance along the y-axis between the colliding bodies at the start of the simulation. + # This will be used to scale the axis limits on the movie. + scale_frame = abs(sim.data['xhy'].isel(time=0, name=1).values) + abs(sim.data['xhy'].isel(time=0, name=2).values) + + # Set up the figure and the animation. + fig, ax = plt.subplots(figsize=(4,4)) + # Generate the movie. + ani = animation.FuncAnimation(fig, animate, interval=1, frames=nframes, repeat=False) + ani.save(movie_filename, fps=60, dpi=300, extra_args=['-vcodec', 'libx264']) \ No newline at end of file From 3175f875bdadbbb1f483b7735849daa796b8c2aa Mon Sep 17 00:00:00 2001 From: David A Minton Date: Tue, 29 Nov 2022 13:44:14 -0500 Subject: [PATCH 140/569] Fixed typo in energy output in compact format --- src/io/io.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/io/io.f90 b/src/io/io.f90 index 2c94ec725..2d7f59de2 100644 --- a/src/io/io.f90 +++ b/src/io/io.f90 @@ -41,7 +41,7 @@ module subroutine io_compact_output(self, param, timer) formatted_output = formatted_output // fmt("NPLM",pl%nplm) end select if (param%lenergy) then - formatted_output = formatted_output // fmt("LTOTERR",self%Ltot_error) // fmt("ETOTERR",self%Mtot_error) // fmt("MTOTERR",self%Mtot_error) & + formatted_output = formatted_output // fmt("LTOTERR",self%Ltot_error) // fmt("ETOTERR",self%Etot_error) // fmt("MTOTERR",self%Mtot_error) & // fmt("KEOERR",self%ke_orbit_error) // fmt("PEERR",self%pe_error) // fmt("EORBERR",self%Eorbit_error) & // fmt("EUNTRERR",self%Euntracked_error) // fmt("LESCERR",self%Lescape_error) // fmt("MESCERR",self%Mescape_error) if (param%lclose) formatted_output = formatted_output // fmt("ECOLLERR",self%Ecoll_error) From 8b10f65c893126d42b037c6515b0277eddcde3ea Mon Sep 17 00:00:00 2001 From: David A Minton Date: Tue, 29 Nov 2022 16:05:47 -0500 Subject: [PATCH 141/569] Fixed bugs in Fraggle causing arithmetic exception when initial spins were 0 --- examples/Fragmentation/Fragmentation_Movie.py | 11 +++--- examples/Fragmentation/cb.in | 7 ---- examples/Fragmentation/disruption_headon.in | 13 ------- examples/Fragmentation/hitandrun.in | 13 ------- .../supercatastrophic_off_axis.in | 13 ------- examples/Fragmentation/tp.in | 10 ------ python/swiftest/swiftest/simulation_class.py | 11 +++--- src/fraggle/fraggle_generate.f90 | 36 +++++++++++-------- src/fraggle/fraggle_util.f90 | 16 ++++----- src/util/util_get_energy_momentum.f90 | 4 +-- 10 files changed, 42 insertions(+), 92 deletions(-) delete mode 100644 examples/Fragmentation/cb.in delete mode 100644 examples/Fragmentation/disruption_headon.in delete mode 100644 examples/Fragmentation/hitandrun.in delete mode 100644 examples/Fragmentation/supercatastrophic_off_axis.in delete mode 100644 examples/Fragmentation/tp.in diff --git a/examples/Fragmentation/Fragmentation_Movie.py b/examples/Fragmentation/Fragmentation_Movie.py index 0fb803d8d..ab666fb00 100644 --- a/examples/Fragmentation/Fragmentation_Movie.py +++ b/examples/Fragmentation/Fragmentation_Movie.py @@ -43,6 +43,7 @@ movie_title_list = ["Head-on Disrutption", "Off-axis Supercatastrophic", "Hit and Run"] movie_titles = dict(zip(available_movie_styles, movie_title_list)) +# These initial conditions were generated by trial and error pos_vectors = {"disruption_headon" : [np.array([1.0, -1.807993e-05, 0.0]), np.array([1.0, 1.807993e-05 ,0.0])], "supercatastrophic_off_axis": [np.array([1.0, -4.2e-05, 0.0]), @@ -67,7 +68,7 @@ np.array([0.0, 0.0, 1.0e5])] } -body_Gmass = {"disruption_headon" : [1e-7, 7e-10], +body_Gmass = {"disruption_headon" : [1e-7, 1e-10], "supercatastrophic_off_axis": [1e-7, 1e-8], "hitandrun" : [1e-7, 7e-10] } @@ -131,8 +132,10 @@ def animate(i,ds,movie_title): sim.add_body(Gmass=body_Gmass[style], radius=body_radius[style], xh=pos_vectors[style], vh=vel_vectors[style], rot=rot_vectors[style]) # Set fragmentation parameters - sim.set_parameter(fragmentation = True, gmtiny=1e-11, minimum_fragment_gmass=1e-11) - sim.run(dt=1e-8, tstop=1e-5) + 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) + sim.run(dt=1e-8, tstop=1.e-5) # Calculate the number of frames in the dataset. nframes = int(sim.data['time'].size) @@ -144,5 +147,5 @@ def animate(i,ds,movie_title): # Set up the figure and the animation. fig, ax = plt.subplots(figsize=(4,4)) # Generate the movie. - ani = animation.FuncAnimation(fig, animate, interval=1, frames=nframes, repeat=False) + ani = animation.FuncAnimation(fig, animate, fargs=(sim.data, movie_titles[style]), interval=1, frames=nframes, repeat=False) ani.save(movie_filename, fps=60, dpi=300, extra_args=['-vcodec', 'libx264']) \ No newline at end of file diff --git a/examples/Fragmentation/cb.in b/examples/Fragmentation/cb.in deleted file mode 100644 index a1275bf77..000000000 --- a/examples/Fragmentation/cb.in +++ /dev/null @@ -1,7 +0,0 @@ -Sun -39.47841760435743 ! G*Mass -0.005 ! Radius -0.0 ! J2 -0.0 ! J4 -0.4 0.4 0.4 !Ip -0.0 0.0 0.0 !rot !11.2093063 -38.75937204 82.25088158 ! rot (radian / year) \ No newline at end of file diff --git a/examples/Fragmentation/disruption_headon.in b/examples/Fragmentation/disruption_headon.in deleted file mode 100644 index 72c14edd1..000000000 --- a/examples/Fragmentation/disruption_headon.in +++ /dev/null @@ -1,13 +0,0 @@ -2 -Body1 1e-07 0.0009 -7e-06 -1.0 -1.807993e-05 0.0 --2.562596e-04 6.280005 0.0 -0.4 0.4 0.4 !Ip -0.0 0.0 0.0 !rot -Body2 7e-10 0.0004 -3.25e-06 -1.0 1.807993e-05 0.0 --2.562596e-04 -6.280005 0.0 -0.4 0.4 0.4 !Ip -0.0 0.0 0.0 !rot diff --git a/examples/Fragmentation/hitandrun.in b/examples/Fragmentation/hitandrun.in deleted file mode 100644 index 554d953ee..000000000 --- a/examples/Fragmentation/hitandrun.in +++ /dev/null @@ -1,13 +0,0 @@ -2 -Body1 1e-07 0.0009 -7e-06 -1.0 -4.20E-05 0.0 -0.00 6.28 0.0 -0.4 0.4 0.4 !Ip -0.0 0.0 6.0e4 !rot -Body2 7e-10 0.0004 -3.25e-06 -1.0 4.20E-05 0.0 --1.50 -6.28 0.0 -0.4 0.4 0.4 !Ip -0.0 0.0 1.0e5 !rot diff --git a/examples/Fragmentation/supercatastrophic_off_axis.in b/examples/Fragmentation/supercatastrophic_off_axis.in deleted file mode 100644 index cd09c9070..000000000 --- a/examples/Fragmentation/supercatastrophic_off_axis.in +++ /dev/null @@ -1,13 +0,0 @@ -2 -Body1 1e-07 0.0009 -7e-06 -1.0 -4.2e-05 0.0 -0.00 6.28 0.0 -0.4 0.4 0.4 !Ip -0.0 0.0 -6.0e4 !rot -Body2 1e-08 0.0004 -3.25e-06 -1.0 4.2e-05 0.0 -1.00 -6.28 0.0 -0.4 0.4 0.4 !Ip -0.0 0.0 1.0e5 !rot diff --git a/examples/Fragmentation/tp.in b/examples/Fragmentation/tp.in deleted file mode 100644 index 3c6f40630..000000000 --- a/examples/Fragmentation/tp.in +++ /dev/null @@ -1,10 +0,0 @@ -!! Copyright 2022 - David Minton, Carlisle Wishard, Jennifer Pouplin, Jake Elliott, & Dana Singh -!! This file is part of Swiftest. -!! Swiftest is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License -!! as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. -!! Swiftest is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty -!! of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. -!! You should have received a copy of the GNU General Public License along with Swiftest. -!! If not, see: https://www.gnu.org/licenses. - -0 diff --git a/python/swiftest/swiftest/simulation_class.py b/python/swiftest/swiftest/simulation_class.py index fbd0a3360..4a2687af7 100644 --- a/python/swiftest/swiftest/simulation_class.py +++ b/python/swiftest/swiftest/simulation_class.py @@ -31,6 +31,7 @@ Literal, Dict, List, + Tuple, Any ) @@ -387,7 +388,7 @@ def _type_scrub(output_data): if "nplm" in self.data: post_message += f" nplm: {self.data['nplm'].values[0]}" if self.param['ENERGY']: - post_message += f" dL/L0: {0.0:.5e} dE/|E0|: {0.0:.5e}" + post_message += f" dL/L0: {0.0:.5e} dE/|E0|: {0.0:+.5e}" pbar = tqdm(total=noutput, desc=pre_message, postfix=post_message, bar_format='{l_bar}{bar}{postfix}') try: with subprocess.Popen(shlex.split(cmd), @@ -410,7 +411,7 @@ def _type_scrub(output_data): if "LTOTERR" in output_data: post_message += f" dL/L0: {output_data['LTOTERR']:.5e}" if "ETOTERR" in output_data: - post_message += f" dE/|E0|: {output_data['ETOTERR']:.5e}" + post_message += f" dE/|E0|: {output_data['ETOTERR']:+.5e}" interval = output_data['ILOOP'] - iloop if interval > 0: pbar.update(interval) @@ -2278,8 +2279,8 @@ def add_body(self, 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] | npt.NDArray[np.float_] | None = None, - vh: List[float] | npt.NDArray[np.float_] | None = None, + xh: 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, @@ -2291,7 +2292,7 @@ def add_body(self, 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] | npt.NDArray[np.float_] | None=None, + rot: List[float] | List[npt.NDArray[np.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): """ diff --git a/src/fraggle/fraggle_generate.f90 b/src/fraggle/fraggle_generate.f90 index d59e2a9b7..3ec23ef99 100644 --- a/src/fraggle/fraggle_generate.f90 +++ b/src/fraggle/fraggle_generate.f90 @@ -57,8 +57,12 @@ module subroutine fraggle_generate_fragments(self, colliders, system, param, lfa end if f_spin = F_SPIN_FIRST - lk_plpl = allocated(pl%k_plpl) - if (lk_plpl) deallocate(pl%k_plpl) + if (param%lflatten_interactions) then + lk_plpl = allocated(pl%k_plpl) + if (lk_plpl) deallocate(pl%k_plpl) + else + lk_plpl = .false. + end if call frag%set_natural_scale(colliders) @@ -250,19 +254,21 @@ subroutine fraggle_generate_spins(frag, f_spin, lfailure) frag%rot(:,:) = 0.0_DP frag%ke_spin = 0.0_DP - do i = 1, nfrag - ! Convert a fraction (f_spin) of either the remaining angular momentum or kinetic energy budget into spin, whichever gives the smaller rotation so as not to blow any budgets - rot_ke(:) = sqrt(2 * f_spin * frag%ke_budget / (nfrag * frag%mass(i) * frag%radius(i)**2 * frag%Ip(3, i))) & - * L_remainder(:) / norm2(L_remainder(:)) - rot_L(:) = f_spin * L_remainder(:) / (nfrag * frag%mass(i) * frag%radius(i)**2 * frag%Ip(3, i)) - if (norm2(rot_ke) < norm2(rot_L)) then - frag%rot(:,i) = rot_ke(:) - else - frag%rot(:, i) = rot_L(:) - end if - frag%ke_spin = frag%ke_spin + frag%mass(i) * frag%Ip(3, i) * frag%radius(i)**2 & - * dot_product(frag%rot(:, i), frag%rot(:, i)) - end do + if (norm2(L_remainder(:)) > FRAGGLE_LTOL) then + do i = 1, nfrag + ! Convert a fraction (f_spin) of either the remaining angular momentum or kinetic energy budget into spin, whichever gives the smaller rotation so as not to blow any budgets + rot_ke(:) = sqrt(2 * f_spin * frag%ke_budget / (nfrag * frag%mass(i) * frag%radius(i)**2 * frag%Ip(3, i))) & + * L_remainder(:) / norm2(L_remainder(:)) + rot_L(:) = f_spin * L_remainder(:) / (nfrag * frag%mass(i) * frag%radius(i)**2 * frag%Ip(3, i)) + if (norm2(rot_ke) < norm2(rot_L)) then + frag%rot(:,i) = rot_ke(:) + else + frag%rot(:, i) = rot_L(:) + end if + frag%ke_spin = frag%ke_spin + frag%mass(i) * frag%Ip(3, i) * frag%radius(i)**2 & + * dot_product(frag%rot(:, i), frag%rot(:, i)) + end do + end if frag%ke_spin = 0.5_DP * frag%ke_spin lfailure = ((frag%ke_budget - frag%ke_spin - frag%ke_orbit) < 0.0_DP) diff --git a/src/fraggle/fraggle_util.f90 b/src/fraggle/fraggle_util.f90 index 8d9594974..e03e30eb5 100644 --- a/src/fraggle/fraggle_util.f90 +++ b/src/fraggle/fraggle_util.f90 @@ -87,7 +87,6 @@ module subroutine fraggle_util_construct_temporary_system(frag, system, param, t !! Author: David A. Minton !! !! Constructs a temporary internal system consisting of active bodies and additional fragments. This internal temporary system is used to calculate system energy with and without fragments - !! and optionally including fragments. implicit none ! Arguments class(fraggle_fragments), intent(in) :: frag !! Fraggle fragment system object @@ -147,7 +146,6 @@ module subroutine fraggle_util_get_energy_momentum(self, colliders, system, para class(swiftest_parameters), intent(inout) :: param !! Current swiftest run configuration parameters logical, intent(in) :: lbefore !! Flag indicating that this the "before" state of the system, with colliders included and fragments excluded or vice versa ! Internals - logical, dimension(:), allocatable :: lexclude class(swiftest_nbody_system), allocatable, save :: tmpsys class(swiftest_parameters), allocatable, save :: tmpparam integer(I4B) :: npl_before, npl_after @@ -162,24 +160,24 @@ module subroutine fraggle_util_get_energy_momentum(self, colliders, system, para npl_before = pl%nbody npl_after = npl_before + nfrag - ! Build the exluded body logical mask - allocate(lexclude(npl_after)) if (lbefore) then - lexclude(1:npl_before) = .false. - lexclude(npl_before+1:npl_after) = .true. call fraggle_util_construct_temporary_system(frag, system, param, tmpsys, tmpparam) + ! Build the exluded body logical mask for the *before* case: Only the original bodies are used to compute energy and momentum + tmpsys%pl%status(colliders%idx(1:colliders%ncoll)) = ACTIVE + tmpsys%pl%status(npl_before+1:npl_after) = INACTIVE else - lexclude(1:npl_after) = .false. - lexclude(colliders%idx(1:colliders%ncoll)) = .true. if (.not.allocated(tmpsys)) then write(*,*) "Error in fraggle_util_get_energy_momentum. " // & " This must be called with lbefore=.true. at least once before calling it with lbefore=.false." call util_exit(FAILURE) end if + ! Build the exluded body logical mask for the *after* case: Only the new bodies are used to compute energy and momentum call fraggle_util_add_fragments_to_system(frag, colliders, tmpsys, tmpparam) + tmpsys%pl%status(colliders%idx(1:colliders%ncoll)) = INACTIVE + tmpsys%pl%status(npl_before+1:npl_after) = ACTIVE end if - call tmpsys%pl%flatten(param) + if (param%lflatten_interactions) call tmpsys%pl%flatten(param) call tmpsys%get_energy_and_momentum(param) diff --git a/src/util/util_get_energy_momentum.f90 b/src/util/util_get_energy_momentum.f90 index 621ea80a6..ed7119d8b 100644 --- a/src/util/util_get_energy_momentum.f90 +++ b/src/util/util_get_energy_momentum.f90 @@ -23,7 +23,6 @@ module subroutine util_get_energy_momentum_system(self, param) class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters ! Internals integer(I4B) :: i - integer(I8B) :: nplpl real(DP) :: kecb, kespincb real(DP), dimension(self%pl%nbody) :: kepl, kespinpl real(DP), dimension(self%pl%nbody) :: Lplorbitx, Lplorbity, Lplorbitz @@ -32,7 +31,6 @@ module subroutine util_get_energy_momentum_system(self, param) real(DP) :: hx, hy, hz associate(system => self, pl => self%pl, npl => self%pl%nbody, cb => self%cb) - nplpl = pl%nplpl system%Lorbit(:) = 0.0_DP system%Lspin(:) = 0.0_DP system%Ltot(:) = 0.0_DP @@ -89,7 +87,7 @@ module subroutine util_get_energy_momentum_system(self, param) end if if (param%lflatten_interactions) then - call util_get_energy_potential_flat(npl, nplpl, pl%k_plpl, pl%lmask, cb%Gmass, pl%Gmass, pl%mass, pl%xb, system%pe) + call util_get_energy_potential_flat(npl, pl%nplpl, pl%k_plpl, pl%lmask, cb%Gmass, pl%Gmass, pl%mass, pl%xb, system%pe) else call util_get_energy_potential_triangular(npl, pl%lmask, cb%Gmass, pl%Gmass, pl%mass, pl%xb, system%pe) end if From 1b8a91f8786052a260fdab77dc89041feb07c81d Mon Sep 17 00:00:00 2001 From: David A Minton Date: Tue, 29 Nov 2022 16:16:53 -0500 Subject: [PATCH 142/569] Added wall time/step metric to progress --- python/swiftest/swiftest/simulation_class.py | 2 ++ 1 file changed, 2 insertions(+) diff --git a/python/swiftest/swiftest/simulation_class.py b/python/swiftest/swiftest/simulation_class.py index 4a2687af7..7669c774f 100644 --- a/python/swiftest/swiftest/simulation_class.py +++ b/python/swiftest/swiftest/simulation_class.py @@ -389,6 +389,7 @@ def _type_scrub(output_data): post_message += f" nplm: {self.data['nplm'].values[0]}" if self.param['ENERGY']: post_message += f" dL/L0: {0.0:.5e} dE/|E0|: {0.0:+.5e}" + post_message += f" Wall time / step: {0.0:.5e} s" pbar = tqdm(total=noutput, desc=pre_message, postfix=post_message, bar_format='{l_bar}{bar}{postfix}') try: with subprocess.Popen(shlex.split(cmd), @@ -412,6 +413,7 @@ def _type_scrub(output_data): post_message += f" dL/L0: {output_data['LTOTERR']:.5e}" if "ETOTERR" in output_data: post_message += f" dE/|E0|: {output_data['ETOTERR']:+.5e}" + post_message += f" Wall time / step: {output_data['WTPS']:.5e} s" interval = output_data['ILOOP'] - iloop if interval > 0: pbar.update(interval) From 57b140fe80080308922ba89f1f55c6e6f98ef30f Mon Sep 17 00:00:00 2001 From: David A Minton Date: Tue, 29 Nov 2022 17:04:20 -0500 Subject: [PATCH 143/569] Set it so that if you set read_old_output_file to True, it also reads the param file --- python/swiftest/swiftest/simulation_class.py | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/python/swiftest/swiftest/simulation_class.py b/python/swiftest/swiftest/simulation_class.py index 7669c774f..6a38fb23d 100644 --- a/python/swiftest/swiftest/simulation_class.py +++ b/python/swiftest/swiftest/simulation_class.py @@ -320,9 +320,9 @@ def __init__(self,read_param: bool = False, **kwargs: Any): # Higher Priority: Values from a file (if requested and it exists) #----------------------------------------------------------------- - # If the user asks to read in an old parameter file, override any default parameters with values from the file + # If the user asks to read in an old parameter file or output file, override any default parameters with values from the file # If the file doesn't exist, flag it for now so we know to create it - if read_param: + if read_param or read_old_output_file: #good_param is self.read_param() if self.read_param(): # We will add the parameter file to the kwarg list. This will keep the set_parameter method from From 1603e3e93aaeca55a83c5217e85bf6d955fab8b1 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Tue, 29 Nov 2022 17:08:06 -0500 Subject: [PATCH 144/569] Fixed problem with argument read_old_output_file when it is not supplied --- python/swiftest/swiftest/simulation_class.py | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/python/swiftest/swiftest/simulation_class.py b/python/swiftest/swiftest/simulation_class.py index 6a38fb23d..aeedc8ac6 100644 --- a/python/swiftest/swiftest/simulation_class.py +++ b/python/swiftest/swiftest/simulation_class.py @@ -41,7 +41,7 @@ class Simulation: This is a class that defines the basic Swift/Swifter/Swiftest simulation object """ - def __init__(self,read_param: bool = False, **kwargs: Any): + def __init__(self,read_param: bool = False, read_old_output_file: bool = False, **kwargs: Any): """ Parameters @@ -64,6 +64,10 @@ def __init__(self,read_param: bool = False, **kwargs: Any): - The argument has an equivalent parameter or set of parameters in the parameter input file. 3. Default values (see below) + read_old_output_file : bool, default False + If true, read in a pre-existing binary input file given by the argument `output_file_name` if it exists. + Parameter input file equivalent: None + **kwargs : See list of valid parameters and their defaults below codename : {"Swiftest", "Swifter", "Swift"}, default "Swiftest" @@ -140,9 +144,6 @@ def __init__(self,read_param: bool = False, **kwargs: Any): Specifies the format for the data saved to the output file. If "XV" then cartesian position and velocity vectors for all bodies are stored. If "XVEL" then the orbital elements are also stored. Parameter input file equivalent: `OUT_FORM` - read_old_output_file : bool, default False - If true, read in a pre-existing binary input file given by the argument `output_file_name` if it exists. - Parameter input file equivalent: None MU : str, default "MSUN" The mass unit system to use. Case-insensitive valid options are: * "Msun" : Solar mass @@ -344,7 +345,6 @@ def __init__(self,read_param: bool = False, **kwargs: Any): self.write_param() # Read in an old simulation file if requested - read_old_output_file = kwargs.pop("read_old_output_file",False) if read_old_output_file: binpath = os.path.join(self.sim_dir, self.param['BIN_OUT']) if os.path.exists(binpath): From 0d41a93a3ed191b57a136ee050ae69ac66ebb216 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Tue, 29 Nov 2022 17:16:39 -0500 Subject: [PATCH 145/569] Tweaked fragmentation movie script to make the movies a bit more fast-paced --- examples/Fragmentation/Fragmentation_Movie.py | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/examples/Fragmentation/Fragmentation_Movie.py b/examples/Fragmentation/Fragmentation_Movie.py index ab666fb00..08f872d0c 100644 --- a/examples/Fragmentation/Fragmentation_Movie.py +++ b/examples/Fragmentation/Fragmentation_Movie.py @@ -135,7 +135,7 @@ def animate(i,ds,movie_title): 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) - sim.run(dt=1e-8, tstop=1.e-5) + sim.run(dt=1e-8, tstop=2.e-5) # Calculate the number of frames in the dataset. nframes = int(sim.data['time'].size) @@ -147,5 +147,6 @@ def animate(i,ds,movie_title): # Set up the figure and the animation. fig, ax = plt.subplots(figsize=(4,4)) # Generate the movie. - ani = animation.FuncAnimation(fig, animate, fargs=(sim.data, movie_titles[style]), interval=1, frames=nframes, repeat=False) + nskip = 10 + ani = animation.FuncAnimation(fig, animate, fargs=(sim.data, movie_titles[style]), interval=1, frames=range(0,nframes,nskip), repeat=False) ani.save(movie_filename, fps=60, dpi=300, extra_args=['-vcodec', 'libx264']) \ No newline at end of file From 626faf1f3944655ea8f22a0224e85779f67586f9 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Tue, 29 Nov 2022 18:09:50 -0500 Subject: [PATCH 146/569] Fixed movie maker so that circles are the actual radius of the bodies --- examples/Fragmentation/Fragmentation_Movie.py | 17 +++++++++++------ 1 file changed, 11 insertions(+), 6 deletions(-) diff --git a/examples/Fragmentation/Fragmentation_Movie.py b/examples/Fragmentation/Fragmentation_Movie.py index 08f872d0c..d290267b7 100644 --- a/examples/Fragmentation/Fragmentation_Movie.py +++ b/examples/Fragmentation/Fragmentation_Movie.py @@ -49,7 +49,7 @@ "supercatastrophic_off_axis": [np.array([1.0, -4.2e-05, 0.0]), np.array([1.0, 4.2e-05, 0.0])], "hitandrun" : [np.array([1.0, -4.2e-05, 0.0]), - np.array([1.0, 4.2e-05, 0.0])] + np.array([0.9999999, 4.2e-05, 0.0])] } vel_vectors = {"disruption_headon" : [np.array([-2.562596e-04, 6.280005, 0.0]), @@ -57,7 +57,7 @@ "supercatastrophic_off_axis": [np.array([0.0, 6.28, 0.0]), np.array([1.0, -6.28, 0.0])], "hitandrun" : [np.array([0.0, 6.28, 0.0]), - np.array([-1.5, -6.28, 0.0])] + np.array([-0.1, -6.28, 0.0])] } rot_vectors = {"disruption_headon" : [np.array([0.0, 0.0, 0.0]), @@ -92,6 +92,8 @@ def center(xhx, xhy, xhz, Gmass): z_com = np.sum(Gmass * xhz) / np.sum(Gmass) return x_com, y_com, z_com +figsize = (4,4) + def animate(i,ds,movie_title): # Calculate the position and mass of all bodies in the system at time i and store as a numpy array. @@ -99,6 +101,7 @@ def animate(i,ds,movie_title): xhy = ds['xhy'].isel(time=i).dropna(dim='name').values xhz = ds['xhx'].isel(time=i).dropna(dim='name').values Gmass = ds['Gmass'].isel(time=i).dropna(dim='name').values[1:] # Drop the Sun from the numpy array. + radius = ds['radius'].isel(time=i).dropna(dim='name').values[1:] # Drop the Sun from the numpy array. # Calculate the center of mass of the system at time i. While the center of mass relative to the # colliding bodies does not change, the center of mass of the collision will move as the bodies @@ -117,7 +120,9 @@ def animate(i,ds,movie_title): ax.set_xticks([]) ax.set_yticks([]) - ax.scatter(xhx, xhy, s=(5000000000 * Gmass)) + ax_pt_size = figsize[0] * 72 / (2 * scale_frame) + point_rad = 2 * radius * ax_pt_size + ax.scatter(xhx, xhy, s=point_rad**2) plt.tight_layout() @@ -135,7 +140,7 @@ def animate(i,ds,movie_title): 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) - sim.run(dt=1e-8, tstop=2.e-5) + sim.run(dt=1e-8, tstop=1.e-5) # Calculate the number of frames in the dataset. nframes = int(sim.data['time'].size) @@ -145,8 +150,8 @@ def animate(i,ds,movie_title): scale_frame = abs(sim.data['xhy'].isel(time=0, name=1).values) + abs(sim.data['xhy'].isel(time=0, name=2).values) # Set up the figure and the animation. - fig, ax = plt.subplots(figsize=(4,4)) + fig, ax = plt.subplots(figsize=figsize) # Generate the movie. - nskip = 10 + nskip = 1 ani = animation.FuncAnimation(fig, animate, fargs=(sim.data, movie_titles[style]), interval=1, frames=range(0,nframes,nskip), repeat=False) ani.save(movie_filename, fps=60, dpi=300, extra_args=['-vcodec', 'libx264']) \ No newline at end of file From 9ab21056ea30a6f47e6e33060b299efa3ff06ffd Mon Sep 17 00:00:00 2001 From: David A Minton Date: Tue, 29 Nov 2022 20:37:50 -0500 Subject: [PATCH 147/569] Re-wrote the animation in proper OOP style. Figure is no longer re-drawn each frame --- examples/Fragmentation/Fragmentation_Movie.py | 130 ++++++++++-------- 1 file changed, 76 insertions(+), 54 deletions(-) diff --git a/examples/Fragmentation/Fragmentation_Movie.py b/examples/Fragmentation/Fragmentation_Movie.py index d290267b7..c1f1eebd3 100644 --- a/examples/Fragmentation/Fragmentation_Movie.py +++ b/examples/Fragmentation/Fragmentation_Movie.py @@ -48,8 +48,8 @@ np.array([1.0, 1.807993e-05 ,0.0])], "supercatastrophic_off_axis": [np.array([1.0, -4.2e-05, 0.0]), np.array([1.0, 4.2e-05, 0.0])], - "hitandrun" : [np.array([1.0, -4.2e-05, 0.0]), - np.array([0.9999999, 4.2e-05, 0.0])] + "hitandrun" : [np.array([1.0, -2.0e-05, 0.0]), + np.array([0.999999, 2.0e-05, 0.0])] } vel_vectors = {"disruption_headon" : [np.array([-2.562596e-04, 6.280005, 0.0]), @@ -85,46 +85,80 @@ print("Generating all movie styles") movie_styles = available_movie_styles.copy() -# Define a function to calculate the center of mass of the system. -def center(xhx, xhy, xhz, Gmass): - x_com = np.sum(Gmass * xhx) / np.sum(Gmass) - y_com = np.sum(Gmass * xhy) / np.sum(Gmass) - z_com = np.sum(Gmass * xhz) / np.sum(Gmass) - return x_com, y_com, z_com - figsize = (4,4) +class AnimatedScatter(object): + """An animated scatter plot using matplotlib.animations.FuncAnimation.""" + + def __init__(self, sim, animfile, title, nskip=1): + nframes = int(sim.data['time'].size) + self.sim = sim + self.title = title + self.body_color_list = {'Initial conditions': 'xkcd:windows blue', + 'Disruption': 'xkcd:baby poop', + 'Supercatastrophic': 'xkcd:shocking pink', + 'Hit and run fragment': 'xkcd:blue with a hint of purple', + 'Central body': 'xkcd:almost black'} + + # Set up the figure and axes... + self.fig, self.ax = self.setup_plot() + + # Then setup FuncAnimation. + self.ani = animation.FuncAnimation(self.fig, self.update_plot, interval=1, frames=range(0,nframes,nskip), + blit=True) + self.ani.save(animfile, fps=60, dpi=300, extra_args=['-vcodec', 'libx264']) + print(f"Finished writing {animfile}") + + def setup_plot(self): + fig = plt.figure(figsize=figsize, dpi=300) + plt.tight_layout(pad=0) + + + # Calculate the distance along the y-axis between the colliding bodies at the start of the simulation. + # This will be used to scale the axis limits on the movie. + scale_frame = abs(sim.data['xhy'].isel(time=0, name=1).values) \ + + abs( sim.data['xhy'].isel(time=0, name=2).values) + ax = plt.Axes(fig, [0.1, 0.1, 0.8, 0.8]) + self.ax_pt_size = figsize[0] * 0.8 * 72 / (2 * scale_frame) + ax.set_xlim(-scale_frame, scale_frame) + ax.set_ylim(-scale_frame, scale_frame) + ax.set_xticks([]) + ax.set_yticks([]) + ax.set_xlabel("xhx") + ax.set_ylabel("xhy") + ax.set_title(self.title) + fig.add_axes(ax) + + self.scatter_artist = ax.scatter([], [], animated=True) + return fig, ax + + def update_plot(self, frame): + # Define a function to calculate the center of mass of the system. + def center(frame): + ds = self.sim.data.isel(time=frame).where(self.sim.data['name'] != "Sun", drop=True) + Gmass = ds['Gmass'].values + xhx = ds['xhx'].values + xhy = ds['xhy'].values + x_com = np.sum(Gmass * xhx) / np.sum(Gmass) + y_com = np.sum(Gmass * xhy) / np.sum(Gmass) + return x_com, y_com + + x, y, point_rad = next(self.data_stream(frame)) + x_com, y_com = center(frame) + self.scatter_artist.set_offsets(np.c_[x - x_com, y - y_com]) + self.scatter_artist.set_sizes(point_rad) + return self.scatter_artist, + + def data_stream(self, frame=0): + while True: + ds = self.sim.data.isel(time=frame) + ds = ds.where(ds['name'] != "Sun", drop=True) + radius = ds['radius'].values + x = ds['xhx'].values + y = ds['xhy'].values + point_rad = 2 * radius * self.ax_pt_size + yield x, y, point_rad + -def animate(i,ds,movie_title): - - # Calculate the position and mass of all bodies in the system at time i and store as a numpy array. - xhx = ds['xhx'].isel(time=i).dropna(dim='name').values - xhy = ds['xhy'].isel(time=i).dropna(dim='name').values - xhz = ds['xhx'].isel(time=i).dropna(dim='name').values - Gmass = ds['Gmass'].isel(time=i).dropna(dim='name').values[1:] # Drop the Sun from the numpy array. - radius = ds['radius'].isel(time=i).dropna(dim='name').values[1:] # Drop the Sun from the numpy array. - - # Calculate the center of mass of the system at time i. While the center of mass relative to the - # colliding bodies does not change, the center of mass of the collision will move as the bodies - # orbit the system center of mass. - x_com, y_com, z_com = center(xhx, xhy, xhz, Gmass) - - # Create the figure and plot the bodies as points. - fig.clear() - ax = fig.add_subplot(111) - ax.set_title(movie_title) - ax.set_xlabel("xhx") - ax.set_ylabel("xhy") - ax.set_xlim(x_com - scale_frame, x_com + scale_frame) - ax.set_ylim(y_com - scale_frame, y_com + scale_frame) - ax.grid(False) - ax.set_xticks([]) - ax.set_yticks([]) - - ax_pt_size = figsize[0] * 72 / (2 * scale_frame) - point_rad = 2 * radius * ax_pt_size - ax.scatter(xhx, xhy, s=point_rad**2) - - plt.tight_layout() for style in movie_styles: param_file = Path(style) / "param.in" @@ -140,18 +174,6 @@ def animate(i,ds,movie_title): 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) - sim.run(dt=1e-8, tstop=1.e-5) - - # Calculate the number of frames in the dataset. - nframes = int(sim.data['time'].size) - - # Calculate the distance along the y-axis between the colliding bodies at the start of the simulation. - # This will be used to scale the axis limits on the movie. - scale_frame = abs(sim.data['xhy'].isel(time=0, name=1).values) + abs(sim.data['xhy'].isel(time=0, name=2).values) + sim.run(dt=1e-8, tstop=2.e-5) - # Set up the figure and the animation. - fig, ax = plt.subplots(figsize=figsize) - # Generate the movie. - nskip = 1 - ani = animation.FuncAnimation(fig, animate, fargs=(sim.data, movie_titles[style]), interval=1, frames=range(0,nframes,nskip), repeat=False) - ani.save(movie_filename, fps=60, dpi=300, extra_args=['-vcodec', 'libx264']) \ No newline at end of file + anim = AnimatedScatter(sim,movie_filename,movie_titles[style],nskip=10) From c0d25249df32bee28bcd5d80cbef416c09e3ae80 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Wed, 30 Nov 2022 09:29:49 -0500 Subject: [PATCH 148/569] Fixed issue where units were being recomputed even if they hadn't changed --- python/swiftest/swiftest/simulation_class.py | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/python/swiftest/swiftest/simulation_class.py b/python/swiftest/swiftest/simulation_class.py index aeedc8ac6..d5c6e21b8 100644 --- a/python/swiftest/swiftest/simulation_class.py +++ b/python/swiftest/swiftest/simulation_class.py @@ -1772,7 +1772,10 @@ def set_unit_system(self, if all(key in self.param for key in ["MU2KG","DU2M","TU2S"]): self.GU = constants.GC * self.param["TU2S"] ** 2 * self.param["MU2KG"] / self.param["DU2M"] ** 3 - if recompute_unit_values: + if recompute_unit_values and \ + MU2KG_old != self.param['MU2KG'] or \ + DU2M_old != self.param['DU2M'] or \ + TU2S_old != self.param['TU2S']: self.update_param_units(MU2KG_old, DU2M_old, TU2S_old) unit_dict = self.get_unit_system(update_list, verbose) @@ -1868,7 +1871,6 @@ def update_param_units(self, MU2KG_old, DU2M_old, TU2S_old): if MU2KG_old is not None: for k in mass_keys: if k in self.param: - print(f"param['{k}']: {self.param[k]}") self.param[k] *= MU2KG_old / self.param['MU2KG'] if DU2M_old is not None: From 2730cfcc29f7cfb8a1f8056b91c8465dfd75098f Mon Sep 17 00:00:00 2001 From: David A Minton Date: Wed, 30 Nov 2022 09:30:32 -0500 Subject: [PATCH 149/569] Restructured movie code a bit and added some more clarifying comments. Fixed bug that was causing bodies not to be drawn if there was a fragmentation event --- examples/Fragmentation/Fragmentation_Movie.py | 106 +++++++++++------- 1 file changed, 64 insertions(+), 42 deletions(-) diff --git a/examples/Fragmentation/Fragmentation_Movie.py b/examples/Fragmentation/Fragmentation_Movie.py index c1f1eebd3..8c2d2ca9d 100644 --- a/examples/Fragmentation/Fragmentation_Movie.py +++ b/examples/Fragmentation/Fragmentation_Movie.py @@ -32,13 +32,9 @@ import matplotlib.animation as animation from pathlib import Path -print("Select a fragmentation movie to generate.") -print("1. Head-on disruption") -print("2. Off-axis supercatastrophic") -print("3. Hit and run") -print("4. All of the above") -user_selection = int(input("? ")) - +# ---------------------------------------------------------------------------------------------------------------------- +# Define the names and initial conditions of the various fragmentation simulation types +# ---------------------------------------------------------------------------------------------------------------------- available_movie_styles = ["disruption_headon", "supercatastrophic_off_axis", "hitandrun"] movie_title_list = ["Head-on Disrutption", "Off-axis Supercatastrophic", "Hit and Run"] movie_titles = dict(zip(available_movie_styles, movie_title_list)) @@ -79,12 +75,10 @@ for k,v in body_Gmass.items(): body_radius[k] = [((Gmass/GU)/(4./3.*np.pi*density))**(1./3.) for Gmass in v] -if user_selection > 0 and user_selection < 4: - movie_styles = [available_movie_styles[user_selection-1]] -else: - print("Generating all movie styles") - movie_styles = available_movie_styles.copy() +# ---------------------------------------------------------------------------------------------------------------------- +# Define the animation class that will generate the movies of the fragmentation outcomes +# ---------------------------------------------------------------------------------------------------------------------- figsize = (4,4) class AnimatedScatter(object): """An animated scatter plot using matplotlib.animations.FuncAnimation.""" @@ -133,17 +127,16 @@ def setup_plot(self): def update_plot(self, frame): # Define a function to calculate the center of mass of the system. - def center(frame): - ds = self.sim.data.isel(time=frame).where(self.sim.data['name'] != "Sun", drop=True) - Gmass = ds['Gmass'].values - xhx = ds['xhx'].values - xhy = ds['xhy'].values - x_com = np.sum(Gmass * xhx) / np.sum(Gmass) - y_com = np.sum(Gmass * xhy) / np.sum(Gmass) + def center(Gmass, x, y): + x = x[~np.isnan(x)] + y = y[~np.isnan(y)] + Gmass = Gmass[~np.isnan(Gmass)] + x_com = np.sum(Gmass * x) / np.sum(Gmass) + y_com = np.sum(Gmass * y) / np.sum(Gmass) return x_com, y_com - x, y, point_rad = next(self.data_stream(frame)) - x_com, y_com = center(frame) + Gmass, x, y, point_rad = next(self.data_stream(frame)) + x_com, y_com = center(Gmass, x, y) self.scatter_artist.set_offsets(np.c_[x - x_com, y - y_com]) self.scatter_artist.set_sizes(point_rad) return self.scatter_artist, @@ -153,27 +146,56 @@ def data_stream(self, frame=0): ds = self.sim.data.isel(time=frame) ds = ds.where(ds['name'] != "Sun", drop=True) radius = ds['radius'].values + Gmass = ds['Gmass'].values x = ds['xhx'].values y = ds['xhy'].values point_rad = 2 * radius * self.ax_pt_size - yield x, y, point_rad - - - -for style in movie_styles: - param_file = Path(style) / "param.in" - - movie_filename = f"{style}.mp4" - - # Pull in the Swiftest output data from the parameter file and store it as a Xarray dataset. - sim = swiftest.Simulation(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]) - - # 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) - sim.run(dt=1e-8, tstop=2.e-5) - - anim = AnimatedScatter(sim,movie_filename,movie_titles[style],nskip=10) + yield Gmass, x, y, point_rad + +if __name__ == "__main__": + + print("Select a fragmentation movie to generate.") + print("1. Head-on disruption") + print("2. Off-axis supercatastrophic") + print("3. Hit and run") + print("4. All of the above") + user_selection = int(input("? ")) + + if user_selection > 0 and user_selection < 4: + movie_styles = [available_movie_styles[user_selection-1]] + else: + print("Generating all movie styles") + movie_styles = available_movie_styles.copy() + + for style in movie_styles: + param_file = Path(style) / "param.in" + bin_file = Path(style) / "bin.nc" + if bin_file.exists(): + user_selection = input(f"An older simulation of {movie_titles[style]} exists. Do you want to re-run it? [y/N] ") + if user_selection == "": + run_new = False + else: + try: + run_new = swiftest.io.str2bool(user_selection) + except: + run_new = False + else: + run_new = True + + movie_filename = f"{style}.mp4" + + # Pull in the Swiftest output data from the parameter file and store it as a Xarray dataset. + 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]) + + # 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) + else: + sim = swiftest.Simulation(param_file=param_file, read_old_output_file=True) + + anim = AnimatedScatter(sim,movie_filename,movie_titles[style],nskip=10) From 20065498b827e101f88e49941a3f818ec2ca2410 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Wed, 30 Nov 2022 10:26:33 -0500 Subject: [PATCH 150/569] Updated axes labels to x and y --- examples/Fragmentation/Fragmentation_Movie.py | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/examples/Fragmentation/Fragmentation_Movie.py b/examples/Fragmentation/Fragmentation_Movie.py index 8c2d2ca9d..c260c8116 100644 --- a/examples/Fragmentation/Fragmentation_Movie.py +++ b/examples/Fragmentation/Fragmentation_Movie.py @@ -117,8 +117,8 @@ def setup_plot(self): ax.set_ylim(-scale_frame, scale_frame) ax.set_xticks([]) ax.set_yticks([]) - ax.set_xlabel("xhx") - ax.set_ylabel("xhy") + ax.set_xlabel("x") + ax.set_ylabel("y") ax.set_title(self.title) fig.add_axes(ax) From ccdb4a319def2437c7a1d3a70b079c4c62784d53 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Wed, 30 Nov 2022 12:29:37 -0500 Subject: [PATCH 151/569] Changed computation of circle size in movie script because I think they were too small by a factor of 2 --- examples/Fragmentation/Fragmentation_Movie.py | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/examples/Fragmentation/Fragmentation_Movie.py b/examples/Fragmentation/Fragmentation_Movie.py index c260c8116..4759594d5 100644 --- a/examples/Fragmentation/Fragmentation_Movie.py +++ b/examples/Fragmentation/Fragmentation_Movie.py @@ -112,7 +112,7 @@ def setup_plot(self): scale_frame = abs(sim.data['xhy'].isel(time=0, name=1).values) \ + abs( sim.data['xhy'].isel(time=0, name=2).values) ax = plt.Axes(fig, [0.1, 0.1, 0.8, 0.8]) - self.ax_pt_size = figsize[0] * 0.8 * 72 / (2 * scale_frame) + self.ax_pt_size = figsize[0] * 0.8 * 72 / scale_frame ax.set_xlim(-scale_frame, scale_frame) ax.set_ylim(-scale_frame, scale_frame) ax.set_xticks([]) From 2ce15a9b1ddbe7832995027c78c5c96837c7420f Mon Sep 17 00:00:00 2001 From: David A Minton Date: Wed, 30 Nov 2022 16:00:00 -0500 Subject: [PATCH 152/569] Removed most of the rest of the flat binary file cruft --- .../Basic_Simulation/initial_conditions.ipynb | 8 +- .../Basic_Simulation/initial_conditions.py | 6 +- src/CMakeLists.txt | 2 - src/discard/discard.f90 | 4 +- src/encounter/encounter_io.f90 | 102 --- src/io/io.f90 | 701 ++---------------- src/main/swiftest_driver.f90 | 6 +- src/modules/encounter_classes.f90 | 10 - src/modules/rmvs_classes.f90 | 8 - src/modules/swiftest_classes.f90 | 105 +-- src/modules/swiftest_globals.f90 | 10 - src/netcdf/netcdf.f90 | 34 +- src/rmvs/rmvs_io.f90 | 56 -- src/rmvs/rmvs_step.f90 | 12 +- src/setup/setup.f90 | 4 +- src/symba/symba_discard.f90 | 2 +- src/symba/symba_io.f90 | 69 +- src/whm/whm_setup.f90 | 2 +- 18 files changed, 99 insertions(+), 1042 deletions(-) delete mode 100644 src/encounter/encounter_io.f90 delete mode 100644 src/rmvs/rmvs_io.f90 diff --git a/examples/Basic_Simulation/initial_conditions.ipynb b/examples/Basic_Simulation/initial_conditions.ipynb index 2bcd9cfe7..cdcaae0ed 100644 --- a/examples/Basic_Simulation/initial_conditions.ipynb +++ b/examples/Basic_Simulation/initial_conditions.ipynb @@ -21,7 +21,7 @@ "outputs": [], "source": [ "# Initialize the simulation object as a variable\n", - "sim = swiftest.Simulation(tstart=0.0, tstop=1.0e6, dt=0.005, tstep_out=1.0e3, fragmentation=True, minimum_fragment_mass = 2.5e-11, mtiny=2.5e-8)" + "sim = swiftest.Simulation(tstart=0.0, tstop=1.0e6, dt=0.01, tstep_out=1.0e3, fragmentation=True, minimum_fragment_mass = 2.5e-11, mtiny=2.5e-8)" ] }, { @@ -79,7 +79,7 @@ "metadata": {}, "outputs": [], "source": [ - "sim.add_body(name_pl, a_pl, e_pl, inc_pl, capom_pl, omega_pl, capm_pl, GMpl=GM_pl, Rpl=R_pl, rhill=Rh_pl, Ip1=Ip1_pl, Ip2=Ip2_pl, Ip3=Ip3_pl, rotx=rotx_pl, roty=roty_pl, rotz=rotz_pl)" + "sim.add_body(name_pl, a_pl, e_pl, inc_pl, capom_pl, omega_pl, 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)" ] }, { @@ -144,9 +144,9 @@ ], "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/Basic_Simulation/initial_conditions.py b/examples/Basic_Simulation/initial_conditions.py index 4accb67e7..9bb279b51 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.005, tstep_out=1.0e0, fragmentation=True, minimum_fragment_mass = 2.5e-11, mtiny=2.5e-8) +sim = swiftest.Simulation(tstart=0.0, tstop=1.0e3, dt=0.010, tstep_out=1.0e0, 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"]) @@ -49,7 +49,7 @@ roty_pl = [0.0, 0.0, 0.0, 0.0, 0.0] rotz_pl = [0.0, 0.0, 0.0, 0.0, 0.0] -sim.add_body(name_pl, a_pl, e_pl, inc_pl, capom_pl, omega_pl, capm_pl, GMpl=GM_pl, Rpl=R_pl, rhill=Rh_pl, Ip1=Ip1_pl, Ip2=Ip2_pl, Ip3=Ip3_pl, rotx=rotx_pl, roty=roty_pl, rotz=rotz_pl) +sim.add_body(name=name_pl, 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) # Add 10 user-defined test particles ntp = 10 @@ -62,7 +62,7 @@ omega_tp = default_rng().uniform(0.0, 360.0, ntp) capm_tp = default_rng().uniform(0.0, 360.0, ntp) -sim.add_body(name_tp, a_tp, e_tp, inc_tp, capom_tp, omega_tp, capm_tp) +sim.add_body(name=name_tp, v1=a_tp, v2=e_tp, v3=inc_tp, v4=capom_tp, v5=omega_tp, v6=capm_tp) # Display the run configuration parameters sim.get_parameter() diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index fd0bf10c3..63c89f2b3 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -28,7 +28,6 @@ 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 @@ -53,7 +52,6 @@ SET(FAST_MATH_FILES ${SRC}/orbel/orbel.f90 ${SRC}/rmvs/rmvs_discard.f90 ${SRC}/rmvs/rmvs_encounter_check.f90 - ${SRC}/rmvs/rmvs_io.f90 ${SRC}/rmvs/rmvs_setup.f90 ${SRC}/rmvs/rmvs_step.f90 ${SRC}/rmvs/rmvs_util.f90 diff --git a/src/discard/discard.f90 b/src/discard/discard.f90 index ffaba5dd6..6c799844f 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 (lpl_discards .or. ltp_discards) call system%write_discard(param) + 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 (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) diff --git a/src/encounter/encounter_io.f90 b/src/encounter/encounter_io.f90 deleted file mode 100644 index 199169b35..000000000 --- a/src/encounter/encounter_io.f90 +++ /dev/null @@ -1,102 +0,0 @@ -!! Copyright 2022 - David Minton, Carlisle Wishard, Jennifer Pouplin, Jake Elliott, & Dana Singh -!! This file is part of Swiftest. -!! Swiftest is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License -!! as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. -!! Swiftest is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty -!! of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. -!! You should have received a copy of the GNU General Public License along with Swiftest. -!! If not, see: https://www.gnu.org/licenses. - -submodule (encounter_classes) s_encounter_io - use swiftest -contains - - - module subroutine encounter_io_write_frame(iu, t, id1, id2, Gmass1, Gmass2, radius1, radius2, xh1, xh2, vh1, vh2) - !! author: David A. Minton - !! - !! Write a single frame of close encounter data to output binary files - !! - !! Adapted from David E. Kaufmann's Swifter routine: io_write_encounter.f90 - !! Adapted from Hal Levison's Swift routine io_write_encounter.f - implicit none - ! Arguments - integer(I4B), intent(in) :: iu !! Open file unit number - real(DP), intent(in) :: t !! Time of encounter - integer(I4B), intent(in) :: id1, id2 !! ids of the two encountering bodies - real(DP), intent(in) :: Gmass1, Gmass2 !! G*mass of the two encountering bodies - real(DP), intent(in) :: radius1, radius2 !! Radii of the two encountering bodies - real(DP), dimension(:), intent(in) :: xh1, xh2 !! Heliocentric position vectors of the two encountering bodies - real(DP), dimension(:), intent(in) :: vh1, vh2 !! Heliocentric velocity vectors of the two encountering bodies - ! Internals - character(len=STRMAX) :: errmsg - - write(iu, err=667, iomsg=errmsg) t - write(iu, err=667, iomsg=errmsg) id1, xh1(1), xh1(2), xh1(3), vh1(1), vh1(2), Gmass1, radius1 - write(iu, err=667, iomsg=errmsg) id2, xh2(1), xh2(2), xh2(3), vh2(1), vh2(2), Gmass2, radius2 - - return - 667 continue - write(*,*) "Error writing encounter file: " // trim(adjustl(errmsg)) - call util_exit(FAILURE) - end subroutine - - module subroutine encounter_io_write_list(self, pl, encbody, param) - !! author: David A. Minton - !! - !! Write the encounters to the output encounter binary files - implicit none - ! Arguments - class(encounter_list), intent(in) :: self !! Swiftest encounter list object - class(swiftest_pl), intent(in) :: pl !! Swiftest massive body object - class(swiftest_body), intent(in) :: encbody !! Encountering body - Swiftest generic body object (pl or tp) - class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters - ! Internals - logical , save :: lfirst = .true. - integer(I4B) :: k, ierr - character(len=STRMAX) :: errmsg - - if (param%enc_out == "" .or. self%nenc == 0) return - - open(unit=LUN, file=param%enc_out, status='OLD', position='APPEND', form='UNFORMATTED', iostat=ierr, iomsg=errmsg) - if (ierr /= 0) then - if (lfirst) then - open(unit=LUN, file=param%enc_out, status='NEW', form='UNFORMATTED', err=667, iomsg=errmsg) - else - goto 667 - end if - end if - lfirst = .false. - - associate(ind1 => self%index1, ind2 => self%index2) - select type(encbody) - class is (swiftest_pl) - do k = 1, self%nenc - call encounter_io_write_frame(LUN, self%t(k), & - pl%id(ind1(k)), encbody%id(ind2(k)), & - pl%Gmass(ind1(k)), encbody%Gmass(ind2(k)), & - pl%radius(ind1(k)), encbody%radius(ind2(k)), & - self%x1(:,k), self%x2(:,k), & - self%v1(:,k), self%v2(:,k)) - end do - class is (swiftest_tp) - do k = 1, self%nenc - call encounter_io_write_frame(LUN, self%t(k), & - pl%id(ind1(k)), encbody%id(ind2(k)), & - pl%Gmass(ind1(k)), 0.0_DP, & - pl%radius(ind1(k)), 0.0_DP, & - self%x1(:,k), self%x2(:,k), & - self%v1(:,k), self%v2(:,k)) - end do - end select - end associate - - close(unit = LUN, err = 667, iomsg = errmsg) - - return - 667 continue - write(*,*) "Error writing encounter file: " // trim(adjustl(errmsg)) - call util_exit(FAILURE) - end subroutine encounter_io_write_list - -end submodule s_encounter_io \ No newline at end of file diff --git a/src/io/io.f90 b/src/io/io.f90 index 2d7f59de2..de4c547e9 100644 --- a/src/io/io.f90 +++ b/src/io/io.f90 @@ -179,10 +179,7 @@ module subroutine io_conservation_report(self, param, lterminal) 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 - call pl%xv2el(cb) - call self%write_hdr(param%nciu, param) - call cb%write_frame(param%nciu, param) - call pl%write_frame(param%nciu, param) + call self%write_frame(param%nciu, param) call param%nciu%close() call util_exit(FAILURE) end if @@ -228,48 +225,6 @@ module subroutine io_dump_param(self, param_file_name) end subroutine io_dump_param - module subroutine io_dump_base(self, param) - !! author: David A. Minton - !! - !! Dump massive body data to files - !! - !! Adapted from David E. Kaufmann's Swifter routine: io_dump_pl.f90 and io_dump_tp.f90 - !! Adapted from Hal Levison's Swift routine io_dump_pl.f and io_dump_tp.f - implicit none - ! Arguments - class(swiftest_base), intent(inout) :: self !! Swiftest base object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - ! Internals - integer(I4B) :: iu = LUN - character(len=:), allocatable :: dump_file_name - character(STRMAX) :: errmsg - - select type(self) - class is(swiftest_cb) - dump_file_name = trim(adjustl(param%incbfile)) - class is (swiftest_pl) - dump_file_name = trim(adjustl(param%inplfile)) - class is (swiftest_tp) - dump_file_name = trim(adjustl(param%intpfile)) - end select - open(unit = iu, file = dump_file_name, form = "UNFORMATTED", status = 'replace', err = 667, iomsg = errmsg) - select type(self) - class is (swiftest_body) - write(iu, err = 667, iomsg = errmsg) self%nbody - call io_write_frame_body(self,iu, param) - class is (swiftest_cb) - call io_write_frame_cb(self,iu, param) - end select - close(iu, err = 667, iomsg = errmsg) - - return - - 667 continue - write(*,*) "Error dumping body data to file " // trim(adjustl(errmsg)) - call util_exit(FAILURE) - end subroutine io_dump_base - - module subroutine io_dump_system(self, param) !! author: David A. Minton !! @@ -289,9 +244,9 @@ module subroutine io_dump_system(self, param) allocate(dump_param, source=param) param_file_name = trim(adjustl(DUMP_PARAM_FILE(idx))) - dump_param%in_form = XV + dump_param%in_form = "XV" dump_param%out_stat = 'APPEND' - dump_param%in_type = NETCDF_DOUBLE_TYPE + dump_param%in_type = "NETCDF_DOUBLE" dump_param%in_netcdf = trim(adjustl(DUMP_NC_FILE(idx))) dump_param%nciu%id_chunk = self%pl%nbody + self%tp%nbody dump_param%nciu%time_chunk = 1 @@ -299,14 +254,11 @@ module subroutine io_dump_system(self, param) call dump_param%dump(param_file_name) - dump_param%out_form = XV + dump_param%out_form = "XV" dump_param%outfile = trim(adjustl(DUMP_NC_FILE(idx))) dump_param%ioutput = 0 call dump_param%nciu%initialize(dump_param) - call self%write_hdr(dump_param%nciu, dump_param) - call self%cb%write_frame(dump_param%nciu, dump_param) - call self%pl%write_frame(dump_param%nciu, dump_param) - call self%tp%write_frame(dump_param%nciu, dump_param) + call self%write_frame(dump_param%nciu, dump_param) call dump_param%nciu%close() ! Syncrhonize the disk and memory buffer of the NetCDF file (e.g. commit the frame files stored in memory to disk) call param%nciu%flush(param) @@ -392,45 +344,6 @@ module subroutine io_get_args(integrator, param_file_name, display_style) end subroutine io_get_args - module function io_get_old_t_final_system(self, param) result(old_t_final) - !! author: David A. Minton - !! - !! Validates the dump file to check whether the dump file initial conditions duplicate the last frame of the binary output. - !! - implicit none - ! Arguments - class(swiftest_nbody_system), intent(in) :: self - class(swiftest_parameters), intent(in) :: param - ! Result - real(DP) :: old_t_final - ! Internals - class(swiftest_nbody_system), allocatable :: tmpsys - class(swiftest_parameters), allocatable :: tmpparam - integer(I4B) :: ierr, iu = LUN - character(len=STRMAX) :: errmsg - - old_t_final = 0.0_DP - allocate(tmpsys, source=self) - allocate(tmpparam, source=param) - - ierr = 0 - open(unit = iu, file = param%outfile, status = 'OLD', form = 'UNFORMATTED', err = 667, iomsg = errmsg) - do - ierr = tmpsys%read_frame(iu, tmpparam) - if (ierr /= 0) exit - end do - if (is_iostat_end(ierr)) then - old_t_final = tmpparam%t - close(iu) - return - end if - - 667 continue - write(*,*) "Error reading binary output file. " // trim(adjustl(errmsg)) - call util_exit(FAILURE) - end function io_get_old_t_final_system - - module function io_get_token(buffer, ifirst, ilast, ierr) result(token) !! author: David A. Minton !! @@ -754,8 +667,7 @@ module subroutine io_param_reader(self, unit, iotype, v_list, iostat, iomsg) iostat = -1 return end if - if ((param%in_type /= REAL8_TYPE) .and. (param%in_type /= "ASCII") & - .and. (param%in_type /= NETCDF_FLOAT_TYPE) .and. (param%in_type /= NETCDF_DOUBLE_TYPE)) then + if ((param%in_type /= "ASCII") .and. (param%in_type /= "NETCDF_FLOAT") .and. (param%in_type /= "NETCDF_DOUBLE")) then write(iomsg,*) 'Invalid input file type:',trim(adjustl(param%in_type)) iostat = -1 return @@ -772,7 +684,7 @@ module subroutine io_param_reader(self, unit, iotype, v_list, iostat, iomsg) end if param%lrestart = (param%out_stat == "APPEND") if (param%outfile /= "") then - if ((param%out_type /= NETCDF_FLOAT_TYPE) .and. (param%out_type /= NETCDF_DOUBLE_TYPE)) then + if ((param%out_type /= "NETCDF_FLOAT") .and. (param%out_type /= "NETCDF_DOUBLE")) then write(iomsg,*) 'Invalid out_type: ',trim(adjustl(param%out_type)) iostat = -1 return @@ -949,11 +861,11 @@ module subroutine io_param_writer(self, unit, iotype, v_list, iostat, iomsg) call io_param_writer_one("TSTOP", param%tstop, unit) call io_param_writer_one("DT", param%dt, unit) call io_param_writer_one("IN_TYPE", param%in_type, unit) - if ((param%in_type == REAL4_TYPE) .or. (param%in_type == REAL8_TYPE)) then + if (param%in_type == "ASCII") then call io_param_writer_one("CB_IN", param%incbfile, unit) call io_param_writer_one("PL_IN", param%inplfile, unit) call io_param_writer_one("TP_IN", param%intpfile, unit) - else if ((param%in_type == NETCDF_FLOAT_TYPE) .or. (param%in_type == NETCDF_DOUBLE_TYPE)) then + else call io_param_writer_one("NC_IN", param%in_netcdf, unit) end if @@ -1204,7 +1116,7 @@ module subroutine io_read_in_base(self,param) class(swiftest_base), intent(inout) :: self !! Swiftest base object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - if ((param%in_type == NETCDF_FLOAT_TYPE) .or. (param%in_type == NETCDF_DOUBLE_TYPE)) return ! This method is not used in NetCDF mode, as reading is done for the whole system, not on individual particle types + if (param%in_type /= "ASCII") return ! This method is not used in NetCDF mode, as reading is done for the whole system, not on individual particle types select type(self) class is (swiftest_body) @@ -1231,13 +1143,13 @@ subroutine io_read_in_body(self, param) ! Internals integer(I4B) :: iu = LUN integer(I4B) :: i, nbody - logical :: is_ascii character(len=:), allocatable :: infile character(STRMAX) :: errmsg ! Internals integer(I4B) :: ierr !! Error code: returns 0 if the read is successful ! Select the appropriate polymorphic class (test particle or massive body) + if (param%in_type /= "ASCII") return ! Not for NetCDF select type(self) class is (swiftest_pl) @@ -1246,18 +1158,8 @@ subroutine io_read_in_body(self, param) infile = param%intpfile end select - is_ascii = (param%in_type == 'ASCII') - select case(param%in_type) - case(ASCII_TYPE) - open(unit = iu, file = infile, status = 'old', form = 'FORMATTED', err = 667, iomsg = errmsg) - read(iu, *, err = 667, iomsg = errmsg) nbody - case (REAL4_TYPE, REAL8_TYPE) - open(unit=iu, file=infile, status='old', form='UNFORMATTED', err = 667, iomsg = errmsg) - read(iu, err = 667, iomsg = errmsg) nbody - case default - write(errmsg,*) trim(adjustl(param%in_type)) // ' is an unrecognized file type' - goto 667 - end select + open(unit = iu, file = infile, status = 'old', form = 'FORMATTED', err = 667, iomsg = errmsg) + read(iu, *, err = 667, iomsg = errmsg) nbody call self%setup(nbody, param) ierr = 0 @@ -1271,7 +1173,6 @@ subroutine io_read_in_body(self, param) end if close(iu, err = 667, iomsg = errmsg) - if (ierr == 0) return 667 continue @@ -1297,26 +1198,23 @@ subroutine io_read_in_cb(self, param) integer(I4B) :: ierr character(len=NAMELEN) :: name - if (param%in_type == 'ASCII') then - self%id = 0 - param%maxid = 0 - open(unit = iu, file = param%incbfile, status = 'old', form = 'FORMATTED', err = 667, iomsg = errmsg) - read(iu, *, err = 667, iomsg = errmsg) name - call self%info%set_value(name=name) - read(iu, *, err = 667, iomsg = errmsg) self%Gmass - self%mass = real(self%Gmass / param%GU, kind=DP) - read(iu, *, err = 667, iomsg = errmsg) self%radius - read(iu, *, err = 667, iomsg = errmsg) self%j2rp2 - read(iu, *, err = 667, iomsg = errmsg) self%j4rp4 - if (param%lrotation) then - read(iu, *, err = 667, iomsg = errmsg) self%Ip(1), self%Ip(2), self%Ip(3) - read(iu, *, err = 667, iomsg = errmsg) self%rot(1), self%rot(2), self%rot(3) - end if - ierr = 0 - else - open(unit = iu, file = param%incbfile, status = 'old', form = 'UNFORMATTED', err = 667, iomsg = errmsg) - ierr = self%read_frame(iu, param) + if (param%in_type /= "ASCII") return ! Not for NetCDF + + self%id = 0 + param%maxid = 0 + open(unit = iu, file = param%incbfile, status = 'old', form = 'FORMATTED', err = 667, iomsg = errmsg) + read(iu, *, err = 667, iomsg = errmsg) name + call self%info%set_value(name=name) + read(iu, *, err = 667, iomsg = errmsg) self%Gmass + self%mass = real(self%Gmass / param%GU, kind=DP) + read(iu, *, err = 667, iomsg = errmsg) self%radius + read(iu, *, err = 667, iomsg = errmsg) self%j2rp2 + read(iu, *, err = 667, iomsg = errmsg) self%j4rp4 + if (param%lrotation) then + read(iu, *, err = 667, iomsg = errmsg) self%Ip(1), self%Ip(2), self%Ip(3) + read(iu, *, err = 667, iomsg = errmsg) self%rot(1), self%rot(2), self%rot(3) end if + ierr = 0 close(iu, err = 667, iomsg = errmsg) if (ierr == 0) then @@ -1354,18 +1252,7 @@ module subroutine io_read_in_system(self, param) integer(I4B) :: ierr class(swiftest_parameters), allocatable :: tmp_param - if ((param%in_type == NETCDF_DOUBLE_TYPE) .or. (param%in_type == NETCDF_FLOAT_TYPE)) then - allocate(tmp_param, source=param) - tmp_param%outfile = param%in_netcdf - tmp_param%out_form = param%in_form - if (.not. param%lrestart) then - ! Turn off energy computation so we don't have to feed it into the initial conditions - tmp_param%lenergy = .false. - end if - ierr = self%read_frame(tmp_param%nciu, tmp_param) - deallocate(tmp_param) - if (ierr /=0) call util_exit(FAILURE) - else + if (param%in_type == "ASCII") then call self%cb%read_in(param) call self%pl%read_in(param) call self%tp%read_in(param) @@ -1378,6 +1265,17 @@ module subroutine io_read_in_system(self, param) self%Lescape(:) = param%Lescape(:) self%Ecollisions = param%Ecollisions self%Euntracked = param%Euntracked + else + allocate(tmp_param, source=param) + tmp_param%outfile = param%in_netcdf + tmp_param%out_form = param%in_form + if (.not. param%lrestart) then + ! Turn off energy computation so we don't have to feed it into the initial conditions + tmp_param%lenergy = .false. + end if + ierr = self%read_frame(tmp_param%nciu, tmp_param) + deallocate(tmp_param) + if (ierr /=0) call util_exit(FAILURE) end if param%loblatecb = ((self%cb%j2rp2 /= 0.0_DP) .or. (self%cb%j4rp4 /= 0.0_DP)) @@ -1390,56 +1288,6 @@ module subroutine io_read_in_system(self, param) end subroutine io_read_in_system - function io_read_encounter(t, id1, id2, Gmass1, Gmass2, radius1, radius2, & - xh1, xh2, vh1, vh2, enc_out, out_type) result(ierr) - !! author: David A. Minton - !! - !! Read close encounter data from input binary files - !! Other than time t, there is no direct file input from this function - !! Function returns read error status (0 = OK, nonzero = ERROR) - !! Adapted from David E. Kaufmann's Swifter routine: io_read_encounter.f90 - implicit none - ! Arguments - integer(I4B), intent(out) :: id1, id2 - real(DP), intent(out) :: t, Gmass1, Gmass2, radius1, radius2 - real(DP), dimension(:), intent(out) :: xh1, xh2, vh1, vh2 - character(*), intent(in) :: enc_out, out_type - ! Result - integer(I4B) :: ierr - ! Internals - logical , save :: lfirst = .true. - integer(I4B), save :: iu = lun - - if (lfirst) then - open(unit = iu, file = enc_out, status = 'OLD', form = 'UNFORMATTED', iostat = ierr) - if (ierr /= 0) then - write(*, *) "Swiftest Error:" - write(*, *) " unable to open binary encounter file" - call util_exit(FAILURE) - end if - lfirst = .false. - end if - read(iu, iostat = ierr) t - if (ierr /= 0) then - close(unit = iu, iostat = ierr) - return - end if - - read(iu, iostat = ierr) id1, xh1(1), xh1(2), xh1(3), vh1(1), vh1(2), vh1(3), Gmass1, radius1 - if (ierr /= 0) then - close(unit = iu, iostat = ierr) - return - end if - read(iu, iostat = ierr) id2, xh2(2), xh2(2), xh2(3), vh2(2), vh2(2), vh2(3), Gmass2, radius2 - if (ierr /= 0) then - close(unit = iu, iostat = ierr) - return - end if - - return - end function io_read_encounter - - module function io_read_frame_body(self, iu, param) result(ierr) !! author: David A. Minton !! @@ -1462,14 +1310,14 @@ module function io_read_frame_body(self, iu, param) result(ierr) if (self%nbody == 0) return - if ((param%in_form /= EL) .and. (param%in_form /= XV)) then + if ((param%in_form /= "EL") .and. (param%in_form /= "XV")) then write(errmsg, *) trim(adjustl(param%in_form)) // " is not a recognized format code for input files." goto 667 end if associate(n => self%nbody) - if (param%in_form == EL) then + if (param%in_form == "EL") then if (.not.allocated(self%a)) allocate(self%a(n)) if (.not.allocated(self%e)) allocate(self%e(n)) if (.not.allocated(self%inc)) allocate(self%inc(n)) @@ -1479,53 +1327,7 @@ module function io_read_frame_body(self, iu, param) result(ierr) end if select case(param%in_type) - case (REAL4_TYPE, REAL8_TYPE) - read(iu, err = 667, iomsg = errmsg) self%id(:) - read(iu, err = 667, iomsg = errmsg) name(:) - do i = 1, n - call self%info(i)%set_value(name=name(i)) - end do - - select case (param%in_form) - case (XV) - read(iu, err = 667, iomsg = errmsg) self%xh(1, :) - read(iu, err = 667, iomsg = errmsg) self%xh(2, :) - read(iu, err = 667, iomsg = errmsg) self%xh(3, :) - read(iu, err = 667, iomsg = errmsg) self%vh(1, :) - read(iu, err = 667, iomsg = errmsg) self%vh(2, :) - read(iu, err = 667, iomsg = errmsg) self%vh(3, :) - case (EL) - read(iu, err = 667, iomsg = errmsg) self%a(:) - read(iu, err = 667, iomsg = errmsg) self%e(:) - read(iu, err = 667, iomsg = errmsg) self%inc(:) - read(iu, err = 667, iomsg = errmsg) self%capom(:) - read(iu, err = 667, iomsg = errmsg) self%omega(:) - read(iu, err = 667, iomsg = errmsg) self%capm(:) - end select - - select type(pl => self) - class is (swiftest_pl) ! Additional output if the passed polymorphic object is a massive body - read(iu, err = 667, iomsg = errmsg) pl%Gmass(:) - pl%mass(:) = pl%Gmass(:) / param%GU - if (param%lrhill_present) read(iu, err = 667, iomsg = errmsg) pl%rhill(:) - if (param%lclose) read(iu, err = 667, iomsg = errmsg) pl%radius(:) - if (param%lrotation) then - read(iu, err = 667, iomsg = errmsg) pl%Ip(1, :) - read(iu, err = 667, iomsg = errmsg) pl%Ip(2, :) - read(iu, err = 667, iomsg = errmsg) pl%Ip(3, :) - read(iu, err = 667, iomsg = errmsg) pl%rot(1, :) - read(iu, err = 667, iomsg = errmsg) pl%rot(2, :) - read(iu, err = 667, iomsg = errmsg) pl%rot(3, :) - end if - ! if (param%ltides) then - ! read(iu, err = 667, iomsg = errmsg) pl%k2(:) - ! read(iu, err = 667, iomsg = errmsg) pl%Q(:) - ! end if - end select - - param%maxid = max(param%maxid, maxval(self%id(1:n))) - - case (ASCII_TYPE) + case ("ASCII") do i = 1, n select type(self) class is (swiftest_pl) @@ -1543,10 +1345,10 @@ module function io_read_frame_body(self, iu, param) result(ierr) call self%info(i)%set_value(name=name(i)) select case(param%in_form) - case (XV) + case ("XV") read(iu, *, err = 667, iomsg = errmsg) self%xh(1, i), self%xh(2, i), self%xh(3, i) read(iu, *, err = 667, iomsg = errmsg) self%vh(1, i), self%vh(2, i), self%vh(3, i) - case (EL) + case ("EL") read(iu, *, err = 667, iomsg = errmsg) self%a(i), self%e(i), self%inc(i) read(iu, *, err = 667, iomsg = errmsg) self%capom(i), self%omega(i), self%capm(i) end select @@ -1567,7 +1369,7 @@ module function io_read_frame_body(self, iu, param) result(ierr) end do end select - if (param%in_form == EL) then + if (param%in_form == "EL") then self%inc(1:n) = self%inc(1:n) * DEG2RAD self%capom(1:n) = self%capom(1:n) * DEG2RAD self%omega(1:n) = self%omega(1:n) * DEG2RAD @@ -1591,146 +1393,6 @@ module function io_read_frame_body(self, iu, param) result(ierr) end function io_read_frame_body - module function io_read_frame_cb(self, iu, param) result(ierr) - !! author: David A. Minton - !! - !! Reads a frame of output of central body data to the binary output file - !! - !! Adapted from David E. Kaufmann's Swifter routine io_read_frame.f90 - !! Adapted from Hal Levison's Swift routine io_read_frame.F - implicit none - ! Arguments - class(swiftest_cb), intent(inout) :: self !! Swiftest central body object - integer(I4B), intent(inout) :: iu !! Unit number for the output file to write frame to - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - ! Result - integer(I4B) :: ierr !! Error code: returns 0 if the read is successful - ! Internals - character(len=STRMAX) :: errmsg - character(len=NAMELEN) :: name - - read(iu, err = 667, iomsg = errmsg) self%id - read(iu, err = 667, iomsg = errmsg) name - call self%info%set_value(name=name) - read(iu, err = 667, iomsg = errmsg) self%Gmass - self%mass = self%Gmass / param%GU - read(iu, err = 667, iomsg = errmsg) self%radius - read(iu, err = 667, iomsg = errmsg) self%j2rp2 - read(iu, err = 667, iomsg = errmsg) self%j4rp4 - if (param%lrotation) then - read(iu, err = 667, iomsg = errmsg) self%Ip(1) - read(iu, err = 667, iomsg = errmsg) self%Ip(2) - read(iu, err = 667, iomsg = errmsg) self%Ip(3) - read(iu, err = 667, iomsg = errmsg) self%rot(1) - read(iu, err = 667, iomsg = errmsg) self%rot(2) - read(iu, err = 667, iomsg = errmsg) self%rot(3) - end if - ! if (param%ltides) then - ! read(iu, err = 667, iomsg = errmsg) self%k2 - ! read(iu, err = 667, iomsg = errmsg) self%Q - ! end if - - ierr = 0 - return - - 667 continue - write(*,*) "Error reading central body frame: " // trim(adjustl(errmsg)) - call util_exit(FAILURE) - end function io_read_frame_cb - - - module function io_read_frame_system(self, iu, param) result(ierr) - !! author: The Purdue Swiftest Team - David A. Minton, Carlisle A. Wishard, Jennifer L.L. Pouplin, and Jacob R. Elliott - !! - !! Read a frame (header plus records for each massive body and active test particle) from a output binary file - implicit none - ! Arguments - class(swiftest_nbody_system), intent(inout) :: self !! Swiftest system object - integer(I4B), intent(inout) :: iu !! Unit number for the output file to write frame to - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - ! Result - integer(I4B) :: ierr !! Error code: returns 0 if the read is successful - ! Internals - character(len=STRMAX) :: errmsg - integer(I4B) :: npl, ntp - - ierr = io_read_hdr(iu, param%t, npl, ntp, param%out_form, param%out_type) - if (is_iostat_end(ierr)) return ! Reached the end of the frames - call self%pl%setup(npl, param) - call self%tp%setup(ntp, param) - - if (ierr /= 0) then - write(errmsg, *) "Cannot read frame header." - goto 667 - end if - ierr = self%cb%read_frame(iu, param) - if (ierr /= 0) then - write(errmsg, *) "Cannot read central body frame." - goto 667 - end if - ierr = self%pl%read_frame(iu, param) - if (ierr /= 0) then - write(errmsg, *) "Cannot read massive body frame." - goto 667 - end if - ierr = self%tp%read_frame(iu, param) - if (ierr /= 0) then - write(errmsg, *) "Cannot read test particle frame." - goto 667 - end if - - return - - 667 continue - write(*,*) "Error reading system frame: " // trim(adjustl(errmsg)) - end function io_read_frame_system - - - function io_read_hdr(iu, t, npl, ntp, out_form, out_type) result(ierr) - !! author: David A. Minton - !! - !! Read frame header from input binary files - !! Function returns read error status (0 = OK, nonzero = ERROR) - !! Adapted from David E. Kaufmann's Swifter routine: io_read_hdr.f90 - !! Adapted from Hal Levison's Swift routine io_read_hdr.f - implicit none - ! Arguments - integer(I4B), intent(in) :: iu - integer(I4B), intent(out) :: npl, ntp - character(*), intent(out) :: out_form - real(DP), intent(out) :: t - character(*), intent(in) :: out_type - ! Result - integer(I4B) :: ierr - ! Internals - real(SP) :: ttmp - character(len=STRMAX) :: errmsg - - select case (out_type) - case (REAL4_TYPE) - read(iu, iostat = ierr, err = 667, iomsg = errmsg, end = 333) ttmp - t = ttmp - case (REAL8_TYPE) - read(iu, iostat = ierr, err = 667, iomsg = errmsg, end = 333) t - case default - write(errmsg,*) trim(adjustl(out_type)) // ' is an unrecognized file type' - ierr = -1 - end select - read(iu, iostat = ierr, err = 667, iomsg = errmsg) npl - read(iu, iostat = ierr, err = 667, iomsg = errmsg) ntp - read(iu, iostat = ierr, err = 667, iomsg = errmsg) out_form - - return - - 667 continue - write(*,*) "Error reading header: " // trim(adjustl(errmsg)) - 333 continue - return - - return - end function io_read_hdr - - module subroutine io_read_in_param(self, param_file_name) !! author: David A. Minton !! @@ -1763,33 +1425,6 @@ module subroutine io_read_in_param(self, param_file_name) end subroutine io_read_in_param - module subroutine io_read_in_particle_info(self, iu) - !! author: David A. Minton - !! - !! Reads in particle information object information from an open file unformatted file - implicit none - ! Arguments - class(swiftest_particle_info), intent(inout) :: self !! Particle metadata information object - integer(I4B), intent(in) :: iu !! Open file unit number - ! Internals - character(STRMAX) :: errmsg - - read(iu, err = 667, iomsg = errmsg) self%name - read(iu, err = 667, iomsg = errmsg) self%particle_type - read(iu, err = 667, iomsg = errmsg) self%origin_type - read(iu, err = 667, iomsg = errmsg) self%origin_time - read(iu, err = 667, iomsg = errmsg) self%collision_id - read(iu, err = 667, iomsg = errmsg) self%origin_xh(:) - read(iu, err = 667, iomsg = errmsg) self%origin_vh(:) - - return - - 667 continue - write(*,*) "Error reading particle metadata information from file: " // trim(adjustl(errmsg)) - call util_exit(FAILURE) - end subroutine io_read_in_particle_info - - module subroutine io_set_display_param(self, display_style) !! author: David A. Minton !! @@ -1850,197 +1485,6 @@ module subroutine io_toupper(string) end subroutine io_toupper - module subroutine io_write_discard(self, param) - !! author: David A. Minton - !! - !! Write out information about discarded test particle - !! - !! Adapted from David E. Kaufmann's Swifter routine io_discard_write.f90 - !! Adapted from Hal Levison's Swift routine io_discard_write.f - implicit none - ! Arguments - class(swiftest_nbody_system), intent(inout) :: self !! Swiftest system object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - ! Internals - integer(I4B) :: i - logical, save :: lfirst = .true. - real(DP), dimension(:,:), allocatable :: vh - character(*), parameter :: HDRFMT = '(E23.16, 1X, I8, 1X, L1)' - character(*), parameter :: NAMEFMT = '(A, 2(1X, I8))' - character(*), parameter :: VECFMT = '(3(E23.16, 1X))' - character(*), parameter :: NPLFMT = '(I8)' - character(*), parameter :: PLNAMEFMT = '(I8, 2(1X, E23.16))' - class(swiftest_body), allocatable :: pltemp - character(len=STRMAX) :: errmsg, out_stat - - associate(tp_discards => self%tp_discards, nsp => self%tp_discards%nbody, pl => self%pl, npl => self%pl%nbody) - - ! Record the discarded body metadata information to file - if ((param%out_type == NETCDF_FLOAT_TYPE) .or. (param%out_type == NETCDF_DOUBLE_TYPE)) then - call tp_discards%write_particle_info(param%nciu, param) - end if - - if (param%discard_out == "") return - - if (nsp == 0) return - if (lfirst) then - out_stat = param%out_stat - else - out_stat = 'APPEND' - end if - select case(out_stat) - case('APPEND') - open(unit=LUN, file=param%discard_out, status='OLD', position='APPEND', form='FORMATTED', err=667, iomsg=errmsg) - case('NEW', 'REPLACE', 'UNKNOWN') - open(unit=LUN, file=param%discard_out, status=out_stat, form='FORMATTED', err=667, iomsg=errmsg) - case default - write(*,*) 'Invalid status code for OUT_STAT: ',trim(adjustl(out_stat)) - call util_exit(FAILURE) - end select - lfirst = .false. - if (param%lgr) call tp_discards%pv2v(param) - - write(LUN, HDRFMT) param%t, nsp, param%lbig_discard - do i = 1, nsp - write(LUN, NAMEFMT, err = 667, iomsg = errmsg) SUB, tp_discards%id(i), tp_discards%status(i) - write(LUN, VECFMT, err = 667, iomsg = errmsg) tp_discards%xh(1, i), tp_discards%xh(2, i), tp_discards%xh(3, i) - write(LUN, VECFMT, err = 667, iomsg = errmsg) tp_discards%vh(1, i), tp_discards%vh(2, i), tp_discards%vh(3, i) - end do - if (param%lbig_discard) then - if (param%lgr) then - allocate(pltemp, source = pl) - call pltemp%pv2v(param) - allocate(vh, source = pltemp%vh) - deallocate(pltemp) - else - allocate(vh, source = pl%vh) - end if - - write(LUN, NPLFMT) npl - do i = 1, npl - write(LUN, PLNAMEFMT, err = 667, iomsg = errmsg) pl%id(i), pl%Gmass(i), pl%radius(i) - write(LUN, VECFMT, err = 667, iomsg = errmsg) pl%xh(1, i), pl%xh(2, i), pl%xh(3, i) - write(LUN, VECFMT, err = 667, iomsg = errmsg) vh(1, i), vh(2, i), vh(3, i) - end do - deallocate(vh) - end if - close(LUN) - end associate - - return - - 667 continue - write(*,*) "Error writing discard file: " // trim(adjustl(errmsg)) - call util_exit(FAILURE) - end subroutine io_write_discard - - - module subroutine io_write_frame_body(self, iu, param) - !! author: David A. Minton - !! - !! Write a frame of output of either test particle or massive body data to the binary output file - !! Note: If outputting to orbital elements, but sure that the conversion is done prior to calling this method - !! - !! Adapted from David E. Kaufmann's Swifter routine io_write_frame.f90 - !! Adapted from Hal Levison's Swift routine io_write_frame.F - implicit none - ! Arguments - class(swiftest_body), intent(in) :: self !! Swiftest particle object - integer(I4B), intent(inout) :: iu !! Unit number for the output file to write frame to - class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters - ! Internals - character(len=STRMAX) :: errmsg - - associate(n => self%nbody) - if (n == 0) return - write(iu, err = 667, iomsg = errmsg) self%id(1:n) - write(iu, err = 667, iomsg = errmsg) self%info(1:n)%name - if ((param%out_form == XV) .or. (param%out_form == XVEL)) then - write(iu, err = 667, iomsg = errmsg) self%xh(1, 1:n) - write(iu, err = 667, iomsg = errmsg) self%xh(2, 1:n) - write(iu, err = 667, iomsg = errmsg) self%xh(3, 1:n) - write(iu, err = 667, iomsg = errmsg) self%vh(1, 1:n) - write(iu, err = 667, iomsg = errmsg) self%vh(2, 1:n) - write(iu, err = 667, iomsg = errmsg) self%vh(3, 1:n) - end if - if ((param%out_form == EL) .or. (param%out_form == XVEL)) then - write(iu, err = 667, iomsg = errmsg) self%a(1:n) - write(iu, err = 667, iomsg = errmsg) self%e(1:n) - write(iu, err = 667, iomsg = errmsg) self%inc(1:n) * RAD2DEG - write(iu, err = 667, iomsg = errmsg) self%capom(1:n) * RAD2DEG - write(iu, err = 667, iomsg = errmsg) self%omega(1:n) * RAD2DEG - write(iu, err = 667, iomsg = errmsg) self%capm(1:n) * RAD2DEG - end if - select type(pl => self) - class is (swiftest_pl) ! Additional output if the passed polymorphic object is a massive body - write(iu, err = 667, iomsg = errmsg) pl%Gmass(1:n) - if (param%lrhill_present) write(iu, err = 667, iomsg = errmsg) pl%rhill(1:n) - if (param%lclose) write(iu, err = 667, iomsg = errmsg) pl%radius(1:n) - if (param%lrotation) then - write(iu, err = 667, iomsg = errmsg) pl%Ip(1, 1:n) - write(iu, err = 667, iomsg = errmsg) pl%Ip(2, 1:n) - write(iu, err = 667, iomsg = errmsg) pl%Ip(3, 1:n) - write(iu, err = 667, iomsg = errmsg) pl%rot(1, 1:n) - write(iu, err = 667, iomsg = errmsg) pl%rot(2, 1:n) - write(iu, err = 667, iomsg = errmsg) pl%rot(3, 1:n) - end if - ! if (param%ltides) then - ! write(iu, err = 667, iomsg = errmsg) pl%k2(1:n) - ! write(iu, err = 667, iomsg = errmsg) pl%Q(1:n) - ! end if - end select - end associate - - return - 667 continue - write(*,*) "Error writing body frame: " // trim(adjustl(errmsg)) - call util_exit(FAILURE) - end subroutine io_write_frame_body - - - module subroutine io_write_frame_cb(self, iu, param) - !! author: David A. Minton - !! - !! Write a frame of output of central body data to the binary output file - !! - !! Adapted from David E. Kaufmann's Swifter routine io_write_frame.f90 - !! Adapted from Hal Levison's Swift routine io_write_frame.F - implicit none - ! Arguments - class(swiftest_cb), intent(in) :: self !! Swiftest central body object - integer(I4B), intent(inout) :: iu !! Unit number for the output file to write frame to - class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters - ! Internals - character(len=STRMAX) :: errmsg - - associate(cb => self) - write(iu, err = 667, iomsg = errmsg) cb%id - write(iu, err = 667, iomsg = errmsg) cb%info%name - write(iu, err = 667, iomsg = errmsg) cb%Gmass - write(iu, err = 667, iomsg = errmsg) cb%radius - write(iu, err = 667, iomsg = errmsg) cb%j2rp2 - write(iu, err = 667, iomsg = errmsg) cb%j4rp4 - if (param%lrotation) then - write(iu, err = 667, iomsg = errmsg) cb%Ip(1) - write(iu, err = 667, iomsg = errmsg) cb%Ip(2) - write(iu, err = 667, iomsg = errmsg) cb%Ip(3) - write(iu, err = 667, iomsg = errmsg) cb%rot(1) - write(iu, err = 667, iomsg = errmsg) cb%rot(2) - write(iu, err = 667, iomsg = errmsg) cb%rot(3) - end if - ! if (param%ltides) then - ! write(iu, err = 667, iomsg = errmsg) cb%k2 - ! write(iu, err = 667, iomsg = errmsg) cb%Q - ! end if - end associate - - return - 667 continue - write(*,*) "Error writing central body frame: " // trim(adjustl(errmsg)) - call util_exit(FAILURE) - end subroutine io_write_frame_cb - - module subroutine io_write_frame_system(self, param) !! author: The Purdue Swiftest Team - David A. Minton, Carlisle A. Wishard, Jennifer L.L. Pouplin, and Jacob R. Elliott !! @@ -2055,19 +1499,10 @@ module subroutine io_write_frame_system(self, param) class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters ! Internals logical, save :: lfirst = .true. !! Flag to determine if this is the first call of this method - class(swiftest_cb), allocatable :: cb !! Temporary local version of pl structure used for non-destructive conversions - class(swiftest_pl), allocatable :: pl !! Temporary local version of pl structure used for non-destructive conversions - class(swiftest_tp), allocatable :: tp !! Temporary local version of pl structure used for non-destructive conversions character(len=STRMAX) :: errmsg - integer(I4B) :: iu = BINUNIT !! Unit number for the output file to write frame to logical :: fileExists - allocate(cb, source = self%cb) - allocate(pl, source = self%pl) - allocate(tp, source = self%tp) - iu = BINUNIT - - param%nciu%id_chunk = pl%nbody + tp%nbody + param%nciu%id_chunk = self%pl%nbody + self%tp%nbody param%nciu%time_chunk = max(param%istep_dump / param%istep_out, 1) if (lfirst) then inquire(file=param%outfile, exist=fileExists) @@ -2091,12 +1526,7 @@ module subroutine io_write_frame_system(self, param) lfirst = .false. end if - ! Write out each data type frame - ! For NetCDF output, because we want to store the pseudovelocity separately from the true velocity, we need to do the orbital element conversion internally - call self%write_hdr(param%nciu, param) - call cb%write_frame(param%nciu, param) - call pl%write_frame(param%nciu, param) - call tp%write_frame(param%nciu, param) + call self%write_frame(param%nciu, param) return @@ -2105,37 +1535,4 @@ module subroutine io_write_frame_system(self, param) call util_exit(FAILURE) end subroutine io_write_frame_system - - module subroutine io_write_hdr_system(self, iu, param) ! t, npl, ntp, out_form, out_type) - !! author: The Purdue Swiftest Team - David A. Minton, Carlisle A. Wishard, Jennifer L.L. Pouplin, and Jacob R. Elliott - !! - !! Write frame header to output binary file - !! - !! Adapted from David Adapted from David E. Kaufmann's Swifter routine io_write_hdr.f90 - !! Adapted from Hal Levison's Swift routine io_write_hdr.F - implicit none - ! Arguments - class(swiftest_nbody_system), intent(in) :: self !! Swiftest nbody system object - integer(I4B), intent(inout) :: iu !! Output file unit number - class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters - ! Internals - character(len=STRMAX) :: errmsg - - select case (param%out_type) - case (REAL4_TYPE) - write(iu, err = 667, iomsg = errmsg) real(param%t, kind=SP) - case (REAL8_TYPE) - write(iu, err = 667, iomsg = errmsg) param%t - end select - write(iu, err = 667, iomsg = errmsg) self%pl%nbody - write(iu, err = 667, iomsg = errmsg) self%tp%nbody - write(iu, err = 667, iomsg = errmsg) param%out_form - - return - - 667 continue - write(*,*) "Error writing header: " // trim(adjustl(errmsg)) - call util_exit(FAILURE) - end subroutine io_write_hdr_system - end submodule s_io diff --git a/src/main/swiftest_driver.f90 b/src/main/swiftest_driver.f90 index c25566fe0..8f02b74f8 100644 --- a/src/main/swiftest_driver.f90 +++ b/src/main/swiftest_driver.f90 @@ -85,10 +85,8 @@ program swiftest_driver ioutput_t0 = int(t0 / dt / istep_out, kind=I8B) ioutput = ioutput_t0 ! Prevent duplicate frames from being written if this is a restarted run - if ((param%lrestart) .and. ((param%out_type == REAL8_TYPE) .or. param%out_type == REAL4_TYPE)) then - old_t_final = nbody_system%get_old_t_final_bin(param) - else if ((param%lrestart) .and. ((param%out_type == NETCDF_DOUBLE_TYPE) .or. param%out_type == NETCDF_FLOAT_TYPE)) then - old_t_final = nbody_system%get_old_t_final_netcdf(param) + if (param%lrestart) then + old_t_final = nbody_system%get_old_t_final(param) else old_t_final = t0 if (param%lenergy) call nbody_system%conservation_report(param, lterminal=.false.) ! This will save the initial values of energy and momentum diff --git a/src/modules/encounter_classes.f90 b/src/modules/encounter_classes.f90 index bf209c477..b562def23 100644 --- a/src/modules/encounter_classes.f90 +++ b/src/modules/encounter_classes.f90 @@ -38,7 +38,6 @@ module encounter_classes procedure :: dealloc => encounter_util_dealloc_list !! Deallocates all allocatables procedure :: spill => encounter_util_spill_list !! "Spills" bodies from one object to another depending on the results of a mask (uses the PACK intrinsic) procedure :: resize => encounter_util_resize_list !! Checks the current size of the encounter list against the required size and extends it by a factor of 2 more than requested if it is too small. - procedure :: write => encounter_io_write_list !! Write close encounter data to output binary file final :: encounter_util_final_list !! Finalize the encounter list - deallocates all allocatables end type encounter_list @@ -185,15 +184,6 @@ module subroutine encounter_io_write_frame(iu, t, id1, id2, Gmass1, Gmass2, radi real(DP), dimension(:), intent(in) :: vh1, vh2 !! Swiftestcentric velocity vectors of the two encountering bodies end subroutine encounter_io_write_frame - module subroutine encounter_io_write_list(self, pl, encbody, param) - use swiftest_classes, only : swiftest_pl, swiftest_body, swiftest_parameters - implicit none - class(encounter_list), intent(in) :: self !! Swiftest encounter list object - class(swiftest_pl), intent(in) :: pl !! Swiftest massive body object - class(swiftest_body), intent(in) :: encbody !! Encountering body - Swiftest generic body object (pl or tp) - class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters - end subroutine encounter_io_write_list - module subroutine encounter_setup_aabb(self, n, n_last) implicit none class(encounter_bounding_box), intent(inout) :: self !! Swiftest encounter structure diff --git a/src/modules/rmvs_classes.f90 b/src/modules/rmvs_classes.f90 index 7fe65ffc9..5c3dc7adc 100644 --- a/src/modules/rmvs_classes.f90 +++ b/src/modules/rmvs_classes.f90 @@ -141,14 +141,6 @@ module function rmvs_encounter_check_tp(self, param, system, dt) result(lencount logical :: lencounter !! Returns true if there is at least one close encounter end function rmvs_encounter_check_tp - module subroutine rmvs_io_write_encounter(t, id1, id2, Gmass1, Gmass2, radius1, radius2, xh1, xh2, vh1, vh2, enc_out) - implicit none - integer(I4B), intent(in) :: id1, id2 - real(DP), intent(in) :: t, Gmass1, Gmass2, radius1, radius2 - real(DP), dimension(:), intent(in) :: xh1, xh2, vh1, vh2 - character(*), intent(in) :: enc_out - end subroutine rmvs_io_write_encounter - module subroutine rmvs_kick_getacch_tp(self, system, param, t, lbeg) use swiftest_classes, only : swiftest_nbody_system, swiftest_parameters implicit none diff --git a/src/modules/swiftest_classes.f90 b/src/modules/swiftest_classes.f90 index f04346624..874bfdf31 100644 --- a/src/modules/swiftest_classes.f90 +++ b/src/modules/swiftest_classes.f90 @@ -46,12 +46,12 @@ module swiftest_classes character(STRMAX) :: inplfile = PL_INFILE !! Name of input file for massive bodies character(STRMAX) :: intpfile = TP_INFILE !! Name of input file for test particles character(STRMAX) :: in_netcdf = NC_INFILE !! Name of system input file for NetCDF input - character(STRMAX) :: in_type = ASCII_TYPE !! Data representation type of input data files - character(STRMAX) :: in_form = XV !! Format of input data files (EL or XV) + 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 binary outputs character(STRMAX) :: outfile = NETCDF_OUTFILE !! Name of output binary file - character(STRMAX) :: out_type = NETCDF_DOUBLE_TYPE !! Binary format of output file - character(STRMAX) :: out_form = XVEL !! Data to write to output file + character(STRMAX) :: out_type = "NETCDF_DOUBLE" !! Binary format of output file + character(STRMAX) :: out_form = "XVEL" !! Data to write to output file character(STRMAX) :: out_stat = 'NEW' !! Open status for output binary file integer(I4B) :: istep_dump = -1 !! Number of time steps between dumps real(DP) :: rmin = -1.0_DP !! Minimum heliocentric radius for test particle @@ -61,14 +61,11 @@ module swiftest_classes character(STRMAX) :: qmin_coord = 'HELIO' !! Coordinate frame to use for qmin real(DP) :: qmin_alo = -1.0_DP !! Minimum semimajor axis for qmin real(DP) :: qmin_ahi = -1.0_DP !! Maximum semimajor axis for qmin - character(STRMAX) :: enc_out = "" !! Name of output file for encounters - character(STRMAX) :: discard_out = "" !! Name of output file for discards real(QP) :: MU2KG = -1.0_QP !! Converts mass units to grams real(QP) :: TU2S = -1.0_QP !! Converts time units to seconds real(QP) :: DU2M = -1.0_QP !! Converts distance unit to centimeters real(DP) :: GU = -1.0_DP !! Universal gravitational constant in the system units real(DP) :: inv_c2 = -1.0_DP !! Inverse speed of light squared in the system units - character(STRMAX) :: energy_out = "" !! Name of output energy and momentum report file character(NAMELEN) :: interaction_loops = "ADAPTIVE" !! Method used to compute interaction loops. Options are "TRIANGULAR", "FLAT", or "ADAPTIVE" character(NAMELEN) :: encounter_check_plpl = "ADAPTIVE" !! Method used to compute pl-pl encounter checks. Options are "TRIANGULAR", "SORTSWEEP", or "ADAPTIVE" character(NAMELEN) :: encounter_check_pltp = "ADAPTIVE" !! Method used to compute pl-tp encounter checks. Options are "TRIANGULAR", "SORTSWEEP", or "ADAPTIVE" @@ -143,7 +140,6 @@ module swiftest_classes real(DP), dimension(NDIM) :: discard_vh !! The heliocentric velocity vector at the time of the particle's discard integer(I4B) :: discard_body_id !! The id of the other body involved in the discard (0 if no other body involved) contains - procedure :: read_in => io_read_in_particle_info !! Read in a particle information object from an open file procedure :: copy => util_copy_particle_info !! Copies one set of information object components into another, component-by-component procedure :: set_value => util_set_particle_info !! Sets one or more values of the particle information metadata object end type swiftest_particle_info @@ -155,12 +151,9 @@ module swiftest_classes !! An abstract superclass for a generic Swiftest object contains !! The minimal methods that all systems must have - procedure :: dump => io_dump_base !! Dump contents to file - procedure :: read_in => io_read_in_base !! Read in body initial conditions from a file - procedure :: write_frame_netcdf => netcdf_write_frame_base !! I/O routine for writing out a single frame of time-series data for all bodies in the system in NetCDF format - procedure :: write_particle_info_netcdf => netcdf_write_particle_info_base !! Dump contents of particle information metadata to file - generic :: write_frame => write_frame_netcdf !! Set up generic procedure that will switch between NetCDF or Fortran binary depending on arguments - generic :: write_particle_info => write_particle_info_netcdf !! Set up generic procedure that will switch between NetCDF or Fortran binary depending on arguments + 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 end type swiftest_base !******************************************************************************************************************************** @@ -193,10 +186,6 @@ module swiftest_classes real(DP), dimension(NDIM) :: L0 = 0.0_DP !! Initial angular momentum of the central body real(DP), dimension(NDIM) :: dL = 0.0_DP !! Change in angular momentum of the central body contains - procedure :: read_frame_bin => io_read_frame_cb !! I/O routine for reading out a single frame of time-series data for the central body - procedure :: write_frame_bin => io_write_frame_cb !! I/O routine for writing out a single frame of time-series data for the central body - generic :: write_frame => write_frame_bin !! Write a frame (either binary or NetCDF, using generic procedures) - generic :: read_frame => read_frame_bin !! Write a frame (either binary or NetCDF, using generic procedures) end type swiftest_cb !******************************************************************************************************************************** @@ -241,7 +230,6 @@ module swiftest_classes procedure :: v2pv => gr_vh2pv_body !! Converts from velocity to psudeovelocity for GR calculations using symplectic integrators procedure :: pv2v => gr_pv2vh_body !! Converts from psudeovelocity to velocity for GR calculations using symplectic integrators procedure :: read_frame_bin => io_read_frame_body !! I/O routine for writing out a single frame of time-series data for the central body - procedure :: write_frame_bin => io_write_frame_body !! I/O routine for writing out a single frame of time-series data for the central body procedure :: accel_obl => obl_acc_body !! Compute the barycentric accelerations of bodies due to the oblateness of the central body procedure :: el2xv => orbel_el2xv_vec !! Convert orbital elements to position and velocity vectors procedure :: xv2el => orbel_xv2el_vec !! Convert position and velocity vectors to orbital elements @@ -255,7 +243,6 @@ module swiftest_classes procedure :: sort => util_sort_body !! Sorts body arrays by a sortable componen procedure :: rearrange => util_sort_rearrange_body !! Rearranges the order of array elements of body based on an input index array. Used in sorting methods procedure :: spill => util_spill_body !! "Spills" bodies from one object to another depending on the results of a mask (uses the PACK intrinsic) - generic :: write_frame => write_frame_bin !! Add the generic write frame for Fortran binary files generic :: read_frame => read_frame_bin !! Add the generic read frame for Fortran binary files end type swiftest_body @@ -408,18 +395,14 @@ module swiftest_classes procedure :: compact_output => io_compact_output !! Prints out out terminal output when display_style is set to COMPACT procedure :: conservation_report => io_conservation_report !! Compute energy and momentum and print out the change with time procedure :: dump => io_dump_system !! Dump the state of the system to a file - procedure :: get_old_t_final_bin => io_get_old_t_final_system !! Validates the dump file to check whether the dump file initial conditions duplicate the last frame of the binary output. - procedure :: get_old_t_final_netcdf => netcdf_get_old_t_final_system !! Validates the dump file to check whether the dump file initial conditions duplicate the last frame of the netcdf output. - procedure :: read_frame_bin => io_read_frame_system !! Read in a frame of input data from file - procedure :: write_frame_bin => io_write_frame_system !! Append a frame of output data to file - procedure :: read_frame_netcdf => netcdf_read_frame_system !! Read in a frame of input data from file + procedure :: get_old_t_final => netcdf_get_old_t_final_system !! Validates the dump file to check whether the dump file initial conditions duplicate the last frame of the netcdf output. + procedure :: read_frame => netcdf_read_frame_system !! Read in a frame of input data from file procedure :: write_frame_netcdf => netcdf_write_frame_system !! Write a frame of input data from file - procedure :: write_hdr_bin => io_write_hdr_system !! Write a header for an output frame in Fortran binary format - procedure :: read_hdr_netcdf => netcdf_read_hdr_system !! Read a header for an output frame in NetCDF format - procedure :: write_hdr_netcdf => netcdf_write_hdr_system !! Write a header for an output frame in NetCDF format + procedure :: write_frame_system => io_write_frame_system !! Write a frame of input data from file + procedure :: read_hdr => netcdf_read_hdr_system !! Read a header for an output frame in NetCDF format + procedure :: write_hdr => netcdf_write_hdr_system !! Write a header for an output frame in NetCDF format procedure :: read_in => io_read_in_system !! Reads the initial conditions for an nbody system - procedure :: read_particle_info_netcdf => netcdf_read_particle_info_system !! Read in particle metadata from file - procedure :: write_discard => io_write_discard !! Write out information about discarded test particles + procedure :: read_particle_info => netcdf_read_particle_info_system !! Read in particle metadata from file procedure :: obl_pot => obl_pot_system !! Compute the contribution to the total gravitational potential due solely to the oblateness of the central body procedure :: finalize => setup_finalize_system !! Runs any finalization subroutines when ending the simulation. procedure :: initialize => setup_initialize_system !! Initialize the system from input files @@ -430,11 +413,7 @@ module swiftest_classes procedure :: get_energy_and_momentum => util_get_energy_momentum_system !! Calculates the total system energy and momentum procedure :: rescale => util_rescale_system !! Rescales the system into a new set of units procedure :: validate_ids => util_valid_id_system !! Validate the numerical ids passed to the system and save the maximum value - generic :: write_hdr => write_hdr_bin, write_hdr_netcdf !! Generic method call for writing headers - generic :: read_hdr => read_hdr_netcdf !! Generic method call for reading headers - generic :: read_frame => read_frame_bin, read_frame_netcdf !! Generic method call for reading a frame of output data - generic :: write_frame => write_frame_bin, write_frame_netcdf !! Generic method call for writing a frame of output data - generic :: read_particle_info => read_particle_info_netcdf !! Genereric method call for reading in the particle information metadata + generic :: write_frame => write_frame_system, write_frame_netcdf !! Generic method call for reading a frame of output data end type swiftest_nbody_system @@ -626,12 +605,6 @@ module subroutine io_dump_param(self, param_file_name) character(len=*), intent(in) :: param_file_name !! Parameter input file name (i.e. param.in) end subroutine io_dump_param - module subroutine io_dump_base(self, param) - implicit none - class(swiftest_base), intent(inout) :: self !! Swiftest base object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - end subroutine io_dump_base - module subroutine io_dump_system(self, param) implicit none class(swiftest_nbody_system), intent(inout) :: self !! Swiftest system object @@ -645,13 +618,6 @@ module subroutine io_get_args(integrator, param_file_name, display_style) character(len=:), allocatable, intent(inout) :: display_style !! Style of the output display {"STANDARD", "COMPACT"}). Default is "STANDARD" end subroutine io_get_args - module function io_get_old_t_final_system(self, param) result(old_t_final) - implicit none - class(swiftest_nbody_system), intent(in) :: self - class(swiftest_parameters), intent(in) :: param - real(DP) :: old_t_final - end function io_get_old_t_final_system - module function io_get_token(buffer, ifirst, ilast, ierr) result(token) implicit none character(len=*), intent(in) :: buffer !! Input string buffer @@ -769,12 +735,6 @@ module subroutine io_read_in_param(self, param_file_name) character(len=*), intent(in) :: param_file_name !! Parameter input file name (i.e. param.in) end subroutine io_read_in_param - module subroutine io_read_in_particle_info(self, iu) - implicit none - class(swiftest_particle_info), intent(inout) :: self !! Particle metadata information object - integer(I4B), intent(in) :: iu !! Open file unit number - end subroutine io_read_in_particle_info - module subroutine io_read_in_system(self, param) implicit none class(swiftest_nbody_system), intent(inout) :: self @@ -789,18 +749,10 @@ module function io_read_frame_body(self, iu, param) result(ierr) integer(I4B) :: ierr !! Error code: returns 0 if the read is successful end function io_read_frame_body - module function io_read_frame_cb(self, iu, param) result(ierr) - implicit none - class(swiftest_cb), intent(inout) :: self !! Swiftest central body object - integer(I4B), intent(inout) :: iu !! Unit number for the output file to write frame to - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - integer(I4B) :: ierr !! Error code: returns 0 if the read is successful - end function io_read_frame_cb - module function io_read_frame_system(self, iu, param) result(ierr) implicit none class(swiftest_nbody_system),intent(inout) :: self !! Swiftest system object - integer(I4B), intent(inout) :: iu !! Unit number for the output file to write frame to + integer(I4B), intent(inout) :: iu !! Unit number for the output file to read frame from class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters integer(I4B) :: ierr !! Error code: returns 0 if the read is successful end function io_read_frame_system @@ -816,39 +768,12 @@ module subroutine io_toupper(string) character(*), intent(inout) :: string !! String to make upper case end subroutine io_toupper - module subroutine io_write_discard(self, param) - implicit none - class(swiftest_nbody_system), intent(inout) :: self !! Swiftest system object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - end subroutine io_write_discard - - module subroutine io_write_frame_body(self, iu, param) - implicit none - class(swiftest_body), intent(in) :: self !! Swiftest body object - integer(I4B), intent(inout) :: iu !! Unit number for the output file to write frame to - class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters - end subroutine io_write_frame_body - - module subroutine io_write_frame_cb(self, iu, param) - implicit none - class(swiftest_cb), intent(in) :: self !! Swiftest central body object - integer(I4B), intent(inout) :: iu !! Unit number for the output file to write frame to - class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters - end subroutine io_write_frame_cb - module subroutine io_write_frame_system(self, param) implicit none class(swiftest_nbody_system), intent(inout) :: self !! Swiftest system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters end subroutine io_write_frame_system - module subroutine io_write_hdr_system(self, iu, param) - implicit none - class(swiftest_nbody_system), intent(in) :: self !! Swiftest nbody system object - integer(I4B), intent(inout) :: iu !! Output file unit number - class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters - end subroutine io_write_hdr_system - module subroutine kick_getacch_int_pl(self, param) implicit none class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object diff --git a/src/modules/swiftest_globals.f90 b/src/modules/swiftest_globals.f90 index 49fa0b834..f8e5674e4 100644 --- a/src/modules/swiftest_globals.f90 +++ b/src/modules/swiftest_globals.f90 @@ -57,16 +57,6 @@ module swiftest_globals integer(I4B), parameter :: STRMAX = 512 !! Maximum size of character strings integer(I4B), parameter :: NAMELEN = 32 !! Maximum size of name strings - character(*), parameter :: ASCII_TYPE = 'ASCII' !! Symbolic name for ASCII file type - character(*), parameter :: REAL4_TYPE = 'REAL4' !! Symbolic name for binary file type REAL4 - character(*), parameter :: REAL8_TYPE = 'REAL8' !! Symbolic name for binary file type REAL8 - character(*), parameter :: NETCDF_FLOAT_TYPE = 'NETCDF_FLOAT' !! Symbolic name for binary file type REAL8 - character(*), parameter :: NETCDF_DOUBLE_TYPE = 'NETCDF_DOUBLE' !! Symbolic name for binary file type REAL8 - - character(*), parameter :: EL = 'EL' !! Symbolic name for binary output file contents for orbital elements - character(*), parameter :: XV = 'XV' !! Symbolic name for binary output file contents for cartesian position and velocity vectors - character(*), parameter :: XVEL = 'XVEL' !! Symbolic name for binary output file contents for both cartesian position and velocity and orbital elements - character(*), parameter :: CB_TYPE_NAME = "Central Body" character(*), parameter :: PL_TYPE_NAME = "Massive Body" character(*), parameter :: TP_TYPE_NAME = "Test Particle" diff --git a/src/netcdf/netcdf.f90 b/src/netcdf/netcdf.f90 index aa599f94e..89824e4ec 100644 --- a/src/netcdf/netcdf.f90 +++ b/src/netcdf/netcdf.f90 @@ -202,9 +202,9 @@ module subroutine netcdf_initialize_output(self, param) call check( nf90_def_dim(self%ncid, TIME_DIMNAME, NF90_UNLIMITED, self%time_dimid), "netcdf_initialize_output nf90_def_dim time_dimid" ) ! 'y' dimension select case (param%out_type) - case(NETCDF_FLOAT_TYPE) + case("NETCDF_FLOAT") self%out_type = NF90_FLOAT - case(NETCDF_DOUBLE_TYPE) + case("NETCDF_DOUBLE") self%out_type = NF90_DOUBLE end select @@ -218,7 +218,7 @@ module subroutine netcdf_initialize_output(self, param) 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 + 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" ) @@ -237,7 +237,7 @@ module subroutine netcdf_initialize_output(self, param) end if - if ((param%out_form == EL) .or. (param%out_form == XVEL)) then + 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" ) @@ -381,7 +381,7 @@ module subroutine netcdf_open(self, param, readonly) 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 + 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" ) @@ -408,7 +408,7 @@ module subroutine netcdf_open(self, param, readonly) end if end if - if ((param%out_form == EL) .or. (param%out_form == XVEL)) then + 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" ) @@ -531,7 +531,7 @@ module function netcdf_read_frame_system(self, iu, param) result(ierr) call check( nf90_inquire_dimension(iu%ncid, iu%str_dimid, len=str_max), "netcdf_read_frame_system nf90_inquire_dimension str_dimid" ) ! First filter out only the id slots that contain valid bodies - if (param%in_form == XV) then + if (param%in_form == "XV") then call check( nf90_get_var(iu%ncid, iu%xhx_varid, rtemp(:), start=[1, tslot]), "netcdf_read_frame_system filter pass nf90_getvar xhx_varid" ) else call check( nf90_get_var(iu%ncid, iu%a_varid, rtemp(:), start=[1, tslot]), "netcdf_read_frame_system filter pass nf90_getvar a_varid" ) @@ -572,7 +572,7 @@ module function netcdf_read_frame_system(self, iu, param) result(ierr) end select ! Now read in each variable and split the outputs by body type - if ((param%in_form == XV) .or. (param%in_form == XVEL)) then + 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) @@ -612,7 +612,7 @@ module function netcdf_read_frame_system(self, iu, param) result(ierr) end if end if - if ((param%in_form == EL) .or. (param%in_form == XVEL)) then + if ((param%in_form == "EL") .or. (param%in_form == "XVEL")) then call check( nf90_get_var(iu%ncid, iu%a_varid, rtemp, start=[1, tslot]), "netcdf_read_frame_system nf90_getvar a_varid" ) if (.not.allocated(pl%a)) allocate(pl%a(npl)) if (.not.allocated(tp%a)) allocate(tp%a(ntp)) @@ -995,7 +995,7 @@ module subroutine netcdf_read_particle_info_system(self, iu, param, plmask, tpma status = nf90_inq_varid(iu%ncid, ORIGIN_XHX_VARNAME, iu%origin_xhx_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" ) - else if ((param%out_form == XV) .or. (param%out_form == XVEL)) then + 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" ) else rtemp_arr(1,:) = 0._DP @@ -1004,7 +1004,7 @@ module subroutine netcdf_read_particle_info_system(self, iu, param, plmask, tpma 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 + 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 @@ -1013,7 +1013,7 @@ module subroutine netcdf_read_particle_info_system(self, iu, param, plmask, tpma 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 + 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 @@ -1029,7 +1029,7 @@ module subroutine netcdf_read_particle_info_system(self, iu, param, plmask, tpma status = nf90_inq_varid(iu%ncid, ORIGIN_VHX_VARNAME, iu%origin_vhx_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" ) - else if ((param%out_form == XV) .or. (param%out_form == XVEL)) then + 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" ) else rtemp_arr(1,:) = 0._DP @@ -1038,7 +1038,7 @@ module subroutine netcdf_read_particle_info_system(self, iu, param, plmask, tpma 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 + 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 @@ -1047,7 +1047,7 @@ module subroutine netcdf_read_particle_info_system(self, iu, param, plmask, tpma 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 + 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 @@ -1202,7 +1202,7 @@ module subroutine netcdf_write_frame_base(self, iu, param) !! Convert from pseudovelocity to heliocentric without replacing the current value of pseudovelocity if (param%lgr) call gr_pseudovel2vel(param, self%mu(j), self%xh(:, j), self%vh(:, j), vh(:)) - if ((param%out_form == XV) .or. (param%out_form == XVEL)) then + 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" ) @@ -1221,7 +1221,7 @@ module subroutine netcdf_write_frame_base(self, iu, param) end if end if - if ((param%out_form == EL) .or. (param%out_form == XVEL)) then + if ((param%out_form == "EL") .or. (param%out_form == "XVEL")) then if (param%lgr) then !! For GR-enabled runs, use the true value of velocity computed above call orbel_xv2el(self%mu(j), self%xh(1,j), self%xh(2,j), self%xh(3,j), & vh(1), vh(2), vh(3), & diff --git a/src/rmvs/rmvs_io.f90 b/src/rmvs/rmvs_io.f90 deleted file mode 100644 index 4d04dc150..000000000 --- a/src/rmvs/rmvs_io.f90 +++ /dev/null @@ -1,56 +0,0 @@ -!! Copyright 2022 - David Minton, Carlisle Wishard, Jennifer Pouplin, Jake Elliott, & Dana Singh -!! This file is part of Swiftest. -!! Swiftest is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License -!! as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. -!! Swiftest is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty -!! of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. -!! You should have received a copy of the GNU General Public License along with Swiftest. -!! If not, see: https://www.gnu.org/licenses. - -submodule (rmvs_classes) s_rmvs_io - use swiftest -contains - - module subroutine rmvs_io_write_encounter(t, id1, id2, Gmass1, Gmass2, radius1, radius2, & - xh1, xh2, vh1, vh2, enc_out) - !! author: David A. Minton - !! - !! Write close encounter data from RMVS to output binary files - !! There is no direct file output from this subroutine - !! - !! Adapted from David E. Kaufmann's Swifter routine: io_write_encounter.f90 - !! Adapted from Hal Levison's Swift routine io_write_encounter.f - implicit none - ! Arguments - integer(I4B), intent(in) :: id1, id2 - real(DP), intent(in) :: t, Gmass1, Gmass2, radius1, radius2 - real(DP), dimension(:), intent(in) :: xh1, xh2, vh1, vh2 - character(*), intent(in) :: enc_out - ! Internals - logical , save :: lfirst = .true. - integer(I4B) :: ierr - - if (enc_out == "") return - - open(unit = LUN, file = enc_out, status = 'OLD', position = 'APPEND', form = 'UNFORMATTED', iostat = ierr) - if ((ierr /= 0) .and. lfirst) then - open(unit = LUN, file = enc_out, status = 'NEW', form = 'UNFORMATTED', iostat = ierr) - end if - if (ierr /= 0) then - write(*, *) "Swiftest Error:" - write(*, *) " Unable to open binary encounter file" - call util_exit(FAILURE) - end if - lfirst = .false. - call encounter_io_write_frame(LUN, t, id1, id2, Gmass1, Gmass2, radius1, radius2, xh1, xh2, vh1, vh2) - close(unit = LUN, iostat = ierr) - if (ierr /= 0) then - write(*, *) "Swiftest Error:" - write(*, *) " Unable to close binary encounter file" - call util_exit(FAILURE) - end if - - return - end subroutine rmvs_io_write_encounter - -end submodule s_rmvs_io \ No newline at end of file diff --git a/src/rmvs/rmvs_step.f90 b/src/rmvs/rmvs_step.f90 index 25285899f..7c39614e1 100644 --- a/src/rmvs/rmvs_step.f90 +++ b/src/rmvs/rmvs_step.f90 @@ -561,17 +561,7 @@ subroutine rmvs_peri_tp(tp, pl, t, dt, lfirst, inner_index, ipleP, param) a, peri, capm, tperi) r2 = dot_product(xpc(:, i), xpc(:, i)) if ((abs(tperi) > FACQDT * dt) .or. (r2 > rhill2)) peri = sqrt(r2) - if (param%enc_out /= "") then - id1 = pl%id(ipleP) - rpl = pl%radius(ipleP) - xh1(:) = pl%inner(inner_index)%x(:, ipleP) - vh1(:) = pl%inner(inner_index)%v(:, ipleP) - id2 = tp%id(i) - xh2(:) = xpc(:, i) + xh1(:) - vh2(:) = xpc(:, i) + vh1(:) - call rmvs_io_write_encounter(t, id1, id2, mu, 0.0_DP, rpl, 0.0_DP, & - xh1(:), xh2(:), vh1(:), vh2(:), param%enc_out) - end if + ! TODO: write NetCDF encounter output writer if (tp%lperi(i)) then if (peri < tp%peri(i)) then tp%peri(i) = peri diff --git a/src/setup/setup.f90 b/src/setup/setup.f90 index 3d0943d95..ae157eaae 100644 --- a/src/setup/setup.f90 +++ b/src/setup/setup.f90 @@ -91,7 +91,7 @@ module subroutine setup_finalize_system(self, param) class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters associate(system => self) - if ((param%out_type == NETCDF_FLOAT_TYPE) .or. (param%out_type == NETCDF_DOUBLE_TYPE)) then + if ((param%out_type == "NETCDF_FLOAT") .or. (param%out_type == "NETCDF_DOUBLE")) then call param%nciu%close() end if end associate @@ -148,7 +148,7 @@ module subroutine setup_initialize_system(self, param) call system%set_msys() call pl%set_mu(cb) call tp%set_mu(cb) - if (param%in_form == EL) then + if (param%in_form == "EL") then call pl%el2xv(cb) call tp%el2xv(cb) end if diff --git a/src/symba/symba_discard.f90 b/src/symba/symba_discard.f90 index f60b91a28..f00b222cb 100644 --- a/src/symba/symba_discard.f90 +++ b/src/symba/symba_discard.f90 @@ -361,7 +361,7 @@ module subroutine symba_discard_pl(self, system, param) associate(pl => self, plplenc_list => system%plplenc_list, plplcollision_list => system%plplcollision_list) call pl%vb2vh(system%cb) call pl%xh2xb(system%cb) - call plplenc_list%write(pl, pl, param) + !call plplenc_list%write(pl, pl, param) TODO: write the encounter list writer for NetCDF call symba_discard_nonplpl(self, system, param) diff --git a/src/symba/symba_io.f90 b/src/symba/symba_io.f90 index d9a48b52a..d5dd06308 100644 --- a/src/symba/symba_io.f90 +++ b/src/symba/symba_io.f90 @@ -174,85 +174,20 @@ module subroutine symba_io_write_discard(self, param) class(symba_nbody_system), intent(inout) :: self !! SyMBA nbody system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters ! Internals - integer(I4B) :: iadd, isub, j, nsub, nadd - logical, save :: lfirst = .true. - character(*), parameter :: HDRFMT = '(E23.16, 1X, I8, 1X, L1)' - character(*), parameter :: NAMEFMT = '(A, 2(1X, I8))' - character(*), parameter :: VECFMT = '(3(E23.16, 1X))' - character(*), parameter :: NPLFMT = '(I8)' - character(*), parameter :: PLNAMEFMT = '(I8, 2(1X, E23.16))' - character(STRMAX) :: errmsg, out_stat associate(pl => self%pl, npl => self%pl%nbody, pl_adds => self%pl_adds) - if (self%tp_discards%nbody > 0) call io_write_discard(self, param) + if (self%tp_discards%nbody > 0) call self%tp_discards%write_particle_info(param%nciu, param) select type(pl_discards => self%pl_discards) class is (symba_merger) if (pl_discards%nbody == 0) return - ! Record the discarded body metadata information to file - if ((param%out_type == NETCDF_FLOAT_TYPE) .or. (param%out_type == NETCDF_DOUBLE_TYPE)) then - call pl_discards%write_particle_info(param%nciu, param) - end if - - if (param%discard_out == "") return - if (lfirst) then - out_stat = param%out_stat - else - out_stat = 'APPEND' - end if - select case(out_stat) - case('APPEND') - open(unit=LUN, file=param%discard_out, status='OLD', position='APPEND', form='FORMATTED', err=667, iomsg=errmsg) - case('NEW', 'REPLACE', 'UNKNOWN') - open(unit=LUN, file=param%discard_out, status=param%out_stat, form='FORMATTED', err=667, iomsg=errmsg) - case default - write(*,*) 'Invalid status code for OUT_STAT: ',trim(adjustl(param%out_stat)) - call util_exit(FAILURE) - end select - lfirst = .false. - if (param%lgr) then - call pl_discards%pv2v(param) - call pl_adds%pv2v(param) - end if - - write(LUN, HDRFMT, err=667, iomsg=errmsg) param%t, pl_discards%nbody, param%lbig_discard - iadd = 1 - isub = 1 - do while (iadd <= pl_adds%nbody) - nadd = pl_adds%ncomp(iadd) - nsub = pl_discards%ncomp(isub) - do j = 1, nadd - if (iadd <= pl_adds%nbody) then - write(LUN, NAMEFMT, err=667, iomsg=errmsg) ADD, pl_adds%id(iadd), pl_adds%status(iadd) - write(LUN, VECFMT, err=667, iomsg=errmsg) pl_adds%xh(1, iadd), pl_adds%xh(2, iadd), pl_adds%xh(3, iadd) - write(LUN, VECFMT, err=667, iomsg=errmsg) pl_adds%vh(1, iadd), pl_adds%vh(2, iadd), pl_adds%vh(3, iadd) - else - exit - end if - iadd = iadd + 1 - end do - do j = 1, nsub - if (isub <= pl_discards%nbody) then - write(LUN,NAMEFMT,err=667,iomsg=errmsg) SUB, pl_discards%id(isub), pl_discards%status(isub) - write(LUN,VECFMT,err=667,iomsg=errmsg) pl_discards%xh(1,isub), pl_discards%xh(2,isub), pl_discards%xh(3,isub) - write(LUN,VECFMT,err=667,iomsg=errmsg) pl_discards%vh(1,isub), pl_discards%vh(2,isub), pl_discards%vh(3,isub) - else - exit - end if - isub = isub + 1 - end do - end do - - close(LUN) + call pl_discards%write_particle_info(param%nciu, param) end select end associate return - 667 continue - write(*,*) "Error writing discard file: " // trim(adjustl(errmsg)) - call util_exit(FAILURE) end subroutine symba_io_write_discard end submodule s_symba_io diff --git a/src/whm/whm_setup.f90 b/src/whm/whm_setup.f90 index 8196a5f77..a9755d0d4 100644 --- a/src/whm/whm_setup.f90 +++ b/src/whm/whm_setup.f90 @@ -89,7 +89,7 @@ module subroutine whm_setup_initialize_system(self, param) call self%tp_discards%setup(0, param) call self%pl%set_mu(self%cb) call self%tp%set_mu(self%cb) - if (param%lgr .and. ((param%in_type == REAL8_TYPE) .or. (param%in_type == REAL4_TYPE))) then !! pseudovelocity conversion for NetCDF input files is handled by NetCDF routines + if (param%lgr .and. param%in_type == "ASCII") then !! pseudovelocity conversion for NetCDF input files is handled by NetCDF routines call self%pl%v2pv(param) call self%tp%v2pv(param) end if From 875e4c5ae932bb58473047573a6342f3728e572e Mon Sep 17 00:00:00 2001 From: David A Minton Date: Wed, 30 Nov 2022 17:31:55 -0500 Subject: [PATCH 153/569] Created new swiftest_storage class to store simulation data between file outputs --- src/modules/swiftest_classes.f90 | 22 +++++++++++++++++++++- 1 file changed, 21 insertions(+), 1 deletion(-) diff --git a/src/modules/swiftest_classes.f90 b/src/modules/swiftest_classes.f90 index 874bfdf31..53aef6a78 100644 --- a/src/modules/swiftest_classes.f90 +++ b/src/modules/swiftest_classes.f90 @@ -156,10 +156,30 @@ module swiftest_classes procedure :: write_particle_info => netcdf_write_particle_info_base !! Dump contents of particle information metadata to file end type swiftest_base + type, abstract, extends(swiftest_base) :: swiftest_storage + !! An abstract superclass for a generic Swiftest object that is used to store simulation history data between file I/O + contains + procedure(abstract_store), deferred :: store !! Stores the state of the simulation in memory + procedure(abstract_dump_storage), deferred :: dump !! Dumps contents of the variable to file + end type swiftest_storage + + abstract interface + subroutine abstract_store(self) + import swiftest_storage + class(swiftest_storage), intent(inout) :: self + end subroutine abstract_store + + subroutine abstract_dump_storage(self) + import swiftest_storage + class(swiftest_storage), intent(inout) :: self + end subroutine abstract_dump_storage + end interface + + !******************************************************************************************************************************** ! swiftest_cb class definitions and methods !******************************************************************************************************************************** - !> A concrete lass for the central body in a Swiftest simulation + !> An abstract class for a generic central body in a Swiftest simulation type, abstract, extends(swiftest_base) :: swiftest_cb type(swiftest_particle_info) :: info !! Particle metadata information integer(I4B) :: id = 0 !! External identifier (unique) From 5daefbb76371da36a10d8c919745e9de4373d123 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Wed, 30 Nov 2022 19:55:23 -0500 Subject: [PATCH 154/569] Rearranged the definition of the swiftest_storage class a bit. Now using a parameterized derived type of an abstract class wrapper. --- src/modules/swiftest_classes.f90 | 38 +++++++++++++++----------------- 1 file changed, 18 insertions(+), 20 deletions(-) diff --git a/src/modules/swiftest_classes.f90 b/src/modules/swiftest_classes.f90 index 53aef6a78..086b00676 100644 --- a/src/modules/swiftest_classes.f90 +++ b/src/modules/swiftest_classes.f90 @@ -156,26 +156,6 @@ module swiftest_classes procedure :: write_particle_info => netcdf_write_particle_info_base !! Dump contents of particle information metadata to file end type swiftest_base - type, abstract, extends(swiftest_base) :: swiftest_storage - !! An abstract superclass for a generic Swiftest object that is used to store simulation history data between file I/O - contains - procedure(abstract_store), deferred :: store !! Stores the state of the simulation in memory - procedure(abstract_dump_storage), deferred :: dump !! Dumps contents of the variable to file - end type swiftest_storage - - abstract interface - subroutine abstract_store(self) - import swiftest_storage - class(swiftest_storage), intent(inout) :: self - end subroutine abstract_store - - subroutine abstract_dump_storage(self) - import swiftest_storage - class(swiftest_storage), intent(inout) :: self - end subroutine abstract_dump_storage - end interface - - !******************************************************************************************************************************** ! swiftest_cb class definitions and methods !******************************************************************************************************************************** @@ -436,6 +416,18 @@ end subroutine abstract_dump_storage 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 system_storage_frame + class(swiftest_nbody_system), allocatable :: system + end type + + type, extends(swiftest_base) :: swiftest_storage(nframes) + integer(I4B), len :: nframes + !! A class that that is used to store simulation history data between file output + type(system_storage_frame), dimension(nframes) :: frame + contains + procedure :: initialize => setup_initialize_storage + end type swiftest_storage + abstract interface @@ -1052,6 +1044,12 @@ module subroutine setup_initialize_particle_info_system(self, param) class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters end subroutine setup_initialize_particle_info_system + module subroutine setup_initialize_storage(self, param) + implicit none + class(swiftest_storage(*)), intent(inout) :: self !! Swiftest storage object + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + end subroutine setup_initialize_storage + module subroutine setup_initialize_system(self, param) implicit none class(swiftest_nbody_system), intent(inout) :: self !! Swiftest system object From 5db84c4e9e303437b848311f9c96d2582f90d4ba Mon Sep 17 00:00:00 2001 From: David A Minton Date: Wed, 30 Nov 2022 19:55:40 -0500 Subject: [PATCH 155/569] Removed unnecessary if statement from finalizer --- src/setup/setup.f90 | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/src/setup/setup.f90 b/src/setup/setup.f90 index ae157eaae..655d15b58 100644 --- a/src/setup/setup.f90 +++ b/src/setup/setup.f90 @@ -91,9 +91,7 @@ module subroutine setup_finalize_system(self, param) class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters associate(system => self) - if ((param%out_type == "NETCDF_FLOAT") .or. (param%out_type == "NETCDF_DOUBLE")) then - call param%nciu%close() - end if + call param%nciu%close() end associate return From b7afb0de6e41da2a7e78074e069c065de3907963 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Thu, 1 Dec 2022 08:54:39 -0500 Subject: [PATCH 156/569] Created new storage class and= operator overloading to enable storage of system snapshots for later dumping --- src/io/io.f90 | 2 +- src/main/swiftest_driver.f90 | 1 + src/modules/swiftest_classes.f90 | 29 ++++++++++++++++++----------- src/util/util_copy.f90 | 11 +++++++++++ 4 files changed, 31 insertions(+), 12 deletions(-) diff --git a/src/io/io.f90 b/src/io/io.f90 index de4c547e9..91f20ed23 100644 --- a/src/io/io.f90 +++ b/src/io/io.f90 @@ -526,7 +526,7 @@ module subroutine io_param_reader(self, unit, iotype, v_list, iostat, iomsg) case ("OUT_STAT") call io_toupper(param_value) param%out_stat = param_value - case ("ISTEP_DUMP") + case ("DUMP_CADENCE") read(param_value, *, err = 667, iomsg = iomsg) param%istep_dump case ("CHK_CLOSE") call io_toupper(param_value) diff --git a/src/main/swiftest_driver.f90 b/src/main/swiftest_driver.f90 index 8f02b74f8..037592432 100644 --- a/src/main/swiftest_driver.f90 +++ b/src/main/swiftest_driver.f90 @@ -40,6 +40,7 @@ program swiftest_driver character(len=64) :: pbarmessage character(*), parameter :: symbacompactfmt = '(";NPLM",ES22.15,$)' + type(swiftest_storage(nframes=:)), allocatable :: system_history call io_get_args(integrator, param_file_name, display_style) diff --git a/src/modules/swiftest_classes.f90 b/src/modules/swiftest_classes.f90 index 086b00676..50f1c33ee 100644 --- a/src/modules/swiftest_classes.f90 +++ b/src/modules/swiftest_classes.f90 @@ -46,14 +46,14 @@ module swiftest_classes character(STRMAX) :: inplfile = PL_INFILE !! Name of input file for massive bodies character(STRMAX) :: intpfile = TP_INFILE !! Name of input file for test particles character(STRMAX) :: in_netcdf = NC_INFILE !! Name of system input file for NetCDF input - character(STRMAX) :: in_type = "ASCII" !! Data representation type of input data files - character(STRMAX) :: in_form = "XV" !! Format of input data files ("EL" or "XV") - integer(I4B) :: istep_out = -1 !! Number of time steps between binary outputs + character(STRMAX) :: 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) :: out_type = "NETCDF_DOUBLE" !! Binary format of output file - character(STRMAX) :: out_form = "XVEL" !! Data to write to output file + character(STRMAX) :: out_type = "NETCDF_DOUBLE" !! Binary format of output file + character(STRMAX) :: out_form = "XVEL" !! Data to write to output file character(STRMAX) :: out_stat = 'NEW' !! Open status for output binary file - integer(I4B) :: istep_dump = -1 !! Number of time steps between dumps + integer(I4B) :: dump_cadence = 1 !! Number of output steps between dumping simulation data to file real(DP) :: rmin = -1.0_DP !! Minimum heliocentric radius for test particle real(DP) :: rmax = -1.0_DP !! Maximum heliocentric radius for test particle real(DP) :: rmaxu = -1.0_DP !! Maximum unbound heliocentric radius for test particle @@ -413,24 +413,25 @@ module swiftest_classes procedure :: get_energy_and_momentum => util_get_energy_momentum_system !! Calculates the total system energy and momentum procedure :: rescale => util_rescale_system !! Rescales the system into a new set of units procedure :: validate_ids => util_valid_id_system !! Validate the numerical ids passed to the system and save the maximum value - generic :: write_frame => write_frame_system, write_frame_netcdf !! Generic method call for reading a frame of output data + 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 system_storage_frame + type storage_frame class(swiftest_nbody_system), allocatable :: system + 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. + generic :: assignment(=) => store end type type, extends(swiftest_base) :: swiftest_storage(nframes) integer(I4B), len :: nframes !! A class that that is used to store simulation history data between file output - type(system_storage_frame), dimension(nframes) :: frame + type(storage_frame), dimension(nframes) :: frame contains procedure :: initialize => setup_initialize_storage end type swiftest_storage - abstract interface - subroutine abstract_accel(self, system, param, t, lbeg) import swiftest_body, swiftest_nbody_system, swiftest_parameters, DP class(swiftest_body), intent(inout) :: self !! Swiftest body data structure @@ -1240,6 +1241,12 @@ 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) + 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 + module subroutine util_dealloc_body(self) implicit none class(swiftest_body), intent(inout) :: self diff --git a/src/util/util_copy.f90 b/src/util/util_copy.f90 index 2266396fb..fed2f0604 100644 --- a/src/util/util_copy.f90 +++ b/src/util/util_copy.f90 @@ -78,5 +78,16 @@ 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) + !! 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 + + allocate(self%system, source=system) + + end subroutine util_copy_store_system end submodule s_util_copy From 3e791e934c19bf3155ca041ce5823ce355eb7c8b Mon Sep 17 00:00:00 2001 From: David A Minton Date: Thu, 1 Dec 2022 08:57:09 -0500 Subject: [PATCH 157/569] Cleaned up formatting of swiftest_parameters definition --- src/modules/swiftest_classes.f90 | 74 ++++++++++++++++---------------- 1 file changed, 37 insertions(+), 37 deletions(-) diff --git a/src/modules/swiftest_classes.f90 b/src/modules/swiftest_classes.f90 index 50f1c33ee..65a98f788 100644 --- a/src/modules/swiftest_classes.f90 +++ b/src/modules/swiftest_classes.f90 @@ -32,43 +32,43 @@ 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 - integer(I4B) :: maxid = -1 !! The current maximum particle id number - integer(I4B) :: maxid_collision = 0 !! The current maximum collision id number - real(DP) :: t0 = -1.0_DP !! Integration start time - real(DP) :: t = -1.0_DP !! Integration current time - real(DP) :: tstop = -1.0_DP !! Integration stop time - real(DP) :: dt = -1.0_DP !! Time step - integer(I8B) :: iloop = 0_I8B !! Main loop counter - integer(I8B) :: ioutput = 0_I8B !! Output counter - character(STRMAX) :: incbfile = CB_INFILE !! Name of input file for the central body - character(STRMAX) :: inplfile = PL_INFILE !! Name of input file for massive bodies - character(STRMAX) :: intpfile = TP_INFILE !! Name of input file for test particles - character(STRMAX) :: in_netcdf = NC_INFILE !! Name of system input file for NetCDF input - character(STRMAX) :: in_type = "ASCII" !! 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) :: out_type = "NETCDF_DOUBLE" !! Binary format of output file - character(STRMAX) :: out_form = "XVEL" !! Data to write to output file - character(STRMAX) :: out_stat = 'NEW' !! Open status for output binary file - integer(I4B) :: dump_cadence = 1 !! Number of output steps between dumping simulation data to file - real(DP) :: rmin = -1.0_DP !! Minimum heliocentric radius for test particle - real(DP) :: rmax = -1.0_DP !! Maximum heliocentric radius for test particle - real(DP) :: rmaxu = -1.0_DP !! Maximum unbound heliocentric radius for test particle - real(DP) :: qmin = -1.0_DP !! Minimum pericenter distance for test particle - character(STRMAX) :: qmin_coord = 'HELIO' !! Coordinate frame to use for qmin - real(DP) :: qmin_alo = -1.0_DP !! Minimum semimajor axis for qmin - real(DP) :: qmin_ahi = -1.0_DP !! Maximum semimajor axis for qmin - real(QP) :: MU2KG = -1.0_QP !! Converts mass units to grams - real(QP) :: TU2S = -1.0_QP !! Converts time units to seconds - real(QP) :: DU2M = -1.0_QP !! Converts distance unit to centimeters - real(DP) :: GU = -1.0_DP !! Universal gravitational constant in the system units - real(DP) :: inv_c2 = -1.0_DP !! Inverse speed of light squared in the system units - character(NAMELEN) :: interaction_loops = "ADAPTIVE" !! Method used to compute interaction loops. Options are "TRIANGULAR", "FLAT", or "ADAPTIVE" - character(NAMELEN) :: encounter_check_plpl = "ADAPTIVE" !! Method used to compute pl-pl encounter checks. Options are "TRIANGULAR", "SORTSWEEP", or "ADAPTIVE" - character(NAMELEN) :: encounter_check_pltp = "ADAPTIVE" !! Method used to compute pl-tp encounter checks. Options are "TRIANGULAR", "SORTSWEEP", or "ADAPTIVE" + 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 + integer(I4B) :: maxid = -1 !! The current maximum particle id number + integer(I4B) :: maxid_collision = 0 !! The current maximum collision id number + real(DP) :: t0 = -1.0_DP !! Integration start time + real(DP) :: t = -1.0_DP !! Integration current time + real(DP) :: tstop = -1.0_DP !! Integration stop time + real(DP) :: dt = -1.0_DP !! Time step + integer(I8B) :: iloop = 0_I8B !! Main loop counter + integer(I8B) :: ioutput = 0_I8B !! Output counter + character(STRMAX) :: incbfile = CB_INFILE !! Name of input file for the central body + character(STRMAX) :: inplfile = PL_INFILE !! Name of input file for massive bodies + character(STRMAX) :: intpfile = TP_INFILE !! Name of input file for test particles + character(STRMAX) :: in_netcdf = NC_INFILE !! Name of system input file for NetCDF input + character(STRMAX) :: in_type = "ASCII" !! 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) :: out_type = "NETCDF_DOUBLE" !! Binary format of output file + character(STRMAX) :: out_form = "XVEL" !! Data to write to output file + character(STRMAX) :: out_stat = 'NEW' !! Open status for output binary file + integer(I4B) :: dump_cadence = 1 !! Number of output steps between dumping simulation data to file + real(DP) :: rmin = -1.0_DP !! Minimum heliocentric radius for test particle + real(DP) :: rmax = -1.0_DP !! Maximum heliocentric radius for test particle + real(DP) :: rmaxu = -1.0_DP !! Maximum unbound heliocentric radius for test particle + real(DP) :: qmin = -1.0_DP !! Minimum pericenter distance for test particle + character(STRMAX) :: qmin_coord = 'HELIO' !! Coordinate frame to use for qmin + real(DP) :: qmin_alo = -1.0_DP !! Minimum semimajor axis for qmin + real(DP) :: qmin_ahi = -1.0_DP !! Maximum semimajor axis for qmin + real(QP) :: MU2KG = -1.0_QP !! Converts mass units to grams + real(QP) :: TU2S = -1.0_QP !! Converts time units to seconds + real(QP) :: DU2M = -1.0_QP !! Converts distance unit to centimeters + real(DP) :: GU = -1.0_DP !! Universal gravitational constant in the system units + real(DP) :: inv_c2 = -1.0_DP !! Inverse speed of light squared in the system units + character(NAMELEN) :: interaction_loops = "ADAPTIVE" !! Method used to compute interaction loops. Options are "TRIANGULAR", "FLAT", or "ADAPTIVE" + character(NAMELEN) :: encounter_check_plpl = "ADAPTIVE" !! Method used to compute pl-pl encounter checks. Options are "TRIANGULAR", "SORTSWEEP", or "ADAPTIVE" + character(NAMELEN) :: encounter_check_pltp = "ADAPTIVE" !! Method used to compute pl-tp encounter checks. Options are "TRIANGULAR", "SORTSWEEP", or "ADAPTIVE" ! The following are used internally, and are not set by the user, but instead are determined by the input value of INTERACTION_LOOPS logical :: lflatten_interactions = .false. !! Use the flattened upper triangular matrix for pl-pl interaction loops From fe4f44c25f8935c1f2780275db0ccc63d48e820f Mon Sep 17 00:00:00 2001 From: David A Minton Date: Thu, 1 Dec 2022 08:58:14 -0500 Subject: [PATCH 158/569] Cleaned up formatting of swiftest_parameters definition --- src/modules/swiftest_classes.f90 | 22 +++++++++++----------- 1 file changed, 11 insertions(+), 11 deletions(-) diff --git a/src/modules/swiftest_classes.f90 b/src/modules/swiftest_classes.f90 index 65a98f788..33aa49d23 100644 --- a/src/modules/swiftest_classes.f90 +++ b/src/modules/swiftest_classes.f90 @@ -89,18 +89,18 @@ module swiftest_classes logical :: ltides = .false. !! Include tidal dissipation ! Initial values to pass to the energy report subroutine (usually only used in the case of a restart, otherwise these will be updated with initial conditions values) - real(DP) :: Eorbit_orig = 0.0_DP !! Initial orbital energy - real(DP) :: GMtot_orig = 0.0_DP !! Initial system mass - real(DP), dimension(NDIM) :: Ltot_orig = 0.0_DP !! Initial total angular momentum vector - real(DP), dimension(NDIM) :: Lorbit_orig = 0.0_DP !! Initial orbital angular momentum - real(DP), dimension(NDIM) :: Lspin_orig = 0.0_DP !! Initial spin angular momentum vector - real(DP), dimension(NDIM) :: Lescape = 0.0_DP !! Angular momentum of bodies that escaped the system (used for bookeeping) - real(DP) :: GMescape = 0.0_DP !! Mass of bodies that escaped the system (used for bookeeping) - real(DP) :: Ecollisions = 0.0_DP !! Energy lost from system due to collisions - real(DP) :: Euntracked = 0.0_DP !! Energy gained from system due to escaped bodies + real(DP) :: Eorbit_orig = 0.0_DP !! Initial orbital energy + real(DP) :: GMtot_orig = 0.0_DP !! Initial system mass + real(DP), dimension(NDIM) :: Ltot_orig = 0.0_DP !! Initial total angular momentum vector + real(DP), dimension(NDIM) :: Lorbit_orig = 0.0_DP !! Initial orbital angular momentum + real(DP), dimension(NDIM) :: Lspin_orig = 0.0_DP !! Initial spin angular momentum vector + real(DP), dimension(NDIM) :: Lescape = 0.0_DP !! Angular momentum of bodies that escaped the system (used for bookeeping) + real(DP) :: GMescape = 0.0_DP !! Mass of bodies that escaped the system (used for bookeeping) + real(DP) :: Ecollisions = 0.0_DP !! Energy lost from system due to collisions + real(DP) :: Euntracked = 0.0_DP !! Energy gained from system due to escaped bodies logical :: lfirstenergy = .true. !! This is the first time computing energe - logical :: lfirstkick = .true. !! Initiate the first kick in a symplectic step - logical :: lrestart = .false. !! Indicates whether or not this is a restarted run + logical :: lfirstkick = .true. !! Initiate the first kick in a symplectic step + logical :: lrestart = .false. !! Indicates whether or not this is a restarted run character(len=:), allocatable :: display_style !! Style of the output display {"STANDARD", "COMPACT"}). Default is "STANDARD" integer(I4B) :: display_unit !! File unit number for display (either to stdout or to a log file) From 13acd7e370519b6c23c3acccbc9e58a47c941e29 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Thu, 1 Dec 2022 09:17:41 -0500 Subject: [PATCH 159/569] Replaced istep_dump parameter variable with dump_cadence. This specifies the number of output steps between file dumps --- src/io/io.f90 | 15 ++++++++++----- src/main/swiftest_driver.f90 | 9 +++++---- 2 files changed, 15 insertions(+), 9 deletions(-) diff --git a/src/io/io.f90 b/src/io/io.f90 index 91f20ed23..5e1d69767 100644 --- a/src/io/io.f90 +++ b/src/io/io.f90 @@ -527,7 +527,7 @@ module subroutine io_param_reader(self, unit, iotype, v_list, iostat, iomsg) call io_toupper(param_value) param%out_stat = param_value case ("DUMP_CADENCE") - read(param_value, *, err = 667, iomsg = iomsg) param%istep_dump + read(param_value, *, err = 667, iomsg = iomsg) param%dump_cadence case ("CHK_CLOSE") call io_toupper(param_value) if (param_value == "YES" .or. param_value == 'T') param%lclose = .true. @@ -672,8 +672,13 @@ module subroutine io_param_reader(self, unit, iotype, v_list, iostat, iomsg) iostat = -1 return end if - if ((param%istep_out <= 0) .and. (param%istep_dump <= 0)) then - write(iomsg,*) 'Invalid istep' + if (param%istep_out <= 0) then + write(iomsg,*) 'Invalid ISTEP_OUT. Must be a positive integer' + iostat = -1 + return + end if + if (param%dump_cadence < 0) then + write(iomsg,*) 'Invalid DUMP_CADENCE. Must be a positive integer or 0.' iostat = -1 return end if @@ -870,7 +875,7 @@ module subroutine io_param_writer(self, unit, iotype, v_list, iostat, iomsg) end if call io_param_writer_one("IN_FORM", param%in_form, unit) - if (param%istep_dump > 0) call io_param_writer_one("ISTEP_DUMP",param%istep_dump, unit) + if (param%dump_cadence > 0) call io_param_writer_one("DUMP_CADENCE",param%dump_cadence, unit) if (param%istep_out > 0) then call io_param_writer_one("ISTEP_OUT", param%istep_out, unit) call io_param_writer_one("BIN_OUT", param%outfile, unit) @@ -1503,7 +1508,7 @@ module subroutine io_write_frame_system(self, param) logical :: fileExists param%nciu%id_chunk = self%pl%nbody + self%tp%nbody - param%nciu%time_chunk = max(param%istep_dump / param%istep_out, 1) + param%nciu%time_chunk = max(param%dump_cadence / param%istep_out, 1) if (lfirst) then inquire(file=param%outfile, exist=fileExists) diff --git a/src/main/swiftest_driver.f90 b/src/main/swiftest_driver.f90 index 037592432..f0b9b5013 100644 --- a/src/main/swiftest_driver.f90 +++ b/src/main/swiftest_driver.f90 @@ -72,7 +72,7 @@ program swiftest_driver tstop => param%tstop, & iloop => param%iloop, & istep_out => param%istep_out, & - istep_dump => param%istep_dump, & + dump_cadence => param%dump_cadence, & ioutput => param%ioutput, & display_style => param%display_style, & display_unit => param%display_unit) @@ -81,7 +81,7 @@ program swiftest_driver t = t0 iloop = 0 iout = istep_out - idump = istep_dump + idump = dump_cadence nloops = ceiling((tstop - t0) / dt, kind=I8B) ioutput_t0 = int(t0 / dt / istep_out, kind=I8B) ioutput = ioutput_t0 @@ -123,6 +123,7 @@ program swiftest_driver ioutput = ioutput_t0 + iloop / istep_out call nbody_system%write_frame(param) + tfrac = (param%t - param%t0) / (param%tstop - param%t0) select type(pl => nbody_system%pl) @@ -148,11 +149,11 @@ program swiftest_driver end if !> If the loop counter is at the dump cadence value, dump the state of the system to a file in case it needs to be restarted - if (istep_dump > 0) then + if (dump_cadence > 0) then idump = idump - 1 if (idump == 0) then call nbody_system%dump(param) - idump = istep_dump + idump = dump_cadence end if end if end do From b7d8357c396a7a1620dc62bad5ccdd05b49d6091 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Thu, 1 Dec 2022 09:30:17 -0500 Subject: [PATCH 160/569] Restructured the loop counter with new definitions for t and tstart --- src/io/io.f90 | 9 ++++----- src/main/swiftest_driver.f90 | 15 +++++++-------- src/modules/swiftest_classes.f90 | 3 ++- 3 files changed, 13 insertions(+), 14 deletions(-) diff --git a/src/io/io.f90 b/src/io/io.f90 index 5e1d69767..a92b32780 100644 --- a/src/io/io.f90 +++ b/src/io/io.f90 @@ -250,7 +250,7 @@ module subroutine io_dump_system(self, param) dump_param%in_netcdf = trim(adjustl(DUMP_NC_FILE(idx))) dump_param%nciu%id_chunk = self%pl%nbody + self%tp%nbody dump_param%nciu%time_chunk = 1 - dump_param%T0 = param%t + dump_param%tstart = param%t call dump_param%dump(param_file_name) @@ -461,7 +461,6 @@ module subroutine io_param_reader(self, unit, iotype, v_list, iostat, iomsg) integer, intent(out) :: iostat !! IO status code character(len=*), intent(inout) :: iomsg !! Message to pass if iostat /= 0 ! Internals - logical :: t0_set = .false. !! Is the initial time set in the input file? logical :: tstart_set = .false. !! Is the final time set in the input file? logical :: tstop_set = .false. !! Is the final time set in the input file? logical :: dt_set = .false. !! Is the step size set in the input file? @@ -489,9 +488,8 @@ module subroutine io_param_reader(self, unit, iotype, v_list, iostat, iomsg) select case (param_name) case ("T0") read(param_value, *, err = 667, iomsg = iomsg) param%t0 - t0_set = .true. case ("TSTART") - read(param_value, *, err = 667, iomsg = iomsg) param%t0 + read(param_value, *, err = 667, iomsg = iomsg) param%tstart tstart_set = .true. case ("TSTOP") read(param_value, *, err = 667, iomsg = iomsg) param%tstop @@ -652,7 +650,7 @@ module subroutine io_param_reader(self, unit, iotype, v_list, iostat, iomsg) iostat = 0 ! Do basic sanity checks on the input values - if ((.not. t0_set) .or. (.not. tstop_set) .or. (.not. dt_set)) then + if ((.not. tstart_set) .or. (.not. tstop_set) .or. (.not. dt_set)) then write(iomsg,*) 'Valid simulation time not set' iostat = -1 return @@ -863,6 +861,7 @@ module subroutine io_param_writer(self, unit, iotype, v_list, iostat, iomsg) associate(param => self) call io_param_writer_one("T0", param%t0, unit) + call io_param_writer_one("TSTART", param%tstart, unit) call io_param_writer_one("TSTOP", param%tstop, unit) call io_param_writer_one("DT", param%dt, unit) call io_param_writer_one("IN_TYPE", param%in_type, unit) diff --git a/src/main/swiftest_driver.f90 b/src/main/swiftest_driver.f90 index f0b9b5013..6bee4374b 100644 --- a/src/main/swiftest_driver.f90 +++ b/src/main/swiftest_driver.f90 @@ -23,10 +23,9 @@ program swiftest_driver 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(I4B) :: ierr !! I/O error code integer(I8B) :: idump !! Dump cadence counter integer(I8B) :: iout !! Output cadence counter - integer(I8B) :: ioutput_t0 !! The output frame counter at time 0 + integer(I8B) :: istart !! Starting index for loop counter integer(I8B) :: nloops !! Number of steps to take in the simulation real(DP) :: old_t_final = 0.0_DP !! Output time at which writing should start, in order to prevent duplicate lines being written for restarts type(walltimer) :: integration_timer !! Object used for computing elapsed wall time @@ -68,6 +67,7 @@ program swiftest_driver associate(t => param%t, & t0 => param%t0, & + tstart => param%tstart, & dt => param%dt, & tstop => param%tstop, & iloop => param%iloop, & @@ -78,13 +78,12 @@ program swiftest_driver display_unit => param%display_unit) call nbody_system%initialize(param) - t = t0 - iloop = 0 + t = tstart iout = istep_out idump = dump_cadence nloops = ceiling((tstop - t0) / dt, kind=I8B) - ioutput_t0 = int(t0 / dt / istep_out, kind=I8B) - ioutput = ioutput_t0 + istart = ceiling((tstart - t0) / dt, kind=I8B) + ioutput = int(istart / istep_out, kind=I8B) ! Prevent duplicate frames from being written if this is a restarted run if (param%lrestart) then old_t_final = nbody_system%get_old_t_final(param) @@ -104,7 +103,7 @@ program swiftest_driver write(*,*) "SWIFTEST START " // trim(adjustl(param%integrator)) call nbody_system%compact_output(param,integration_timer) end if - do iloop = 1, nloops + do iloop = istart, nloops !> Step the system forward in time call integration_timer%start() call nbody_system%step(param, t, dt) @@ -120,7 +119,7 @@ program swiftest_driver if (istep_out > 0) then iout = iout - 1 if (iout == 0) then - ioutput = ioutput_t0 + iloop / istep_out + ioutput = int(iloop / istep_out, kind=I8B) call nbody_system%write_frame(param) diff --git a/src/modules/swiftest_classes.f90 b/src/modules/swiftest_classes.f90 index 33aa49d23..7952b28ac 100644 --- a/src/modules/swiftest_classes.f90 +++ b/src/modules/swiftest_classes.f90 @@ -36,8 +36,9 @@ module swiftest_classes character(STRMAX) :: param_file_name = "param.in" !! The default name of the parameter input file integer(I4B) :: maxid = -1 !! The current maximum particle id number integer(I4B) :: maxid_collision = 0 !! The current maximum collision id number - real(DP) :: t0 = -1.0_DP !! Integration start time + real(DP) :: t0 = 0.0_DP !! Integration reference time real(DP) :: t = -1.0_DP !! Integration current time + real(DP) :: tstart = -1.0_DP !! Integration start time real(DP) :: tstop = -1.0_DP !! Integration stop time real(DP) :: dt = -1.0_DP !! Time step integer(I8B) :: iloop = 0_I8B !! Main loop counter From 1e75a0ed0310abeb87938f247d6885a5db20d027 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Thu, 1 Dec 2022 10:21:31 -0500 Subject: [PATCH 161/569] updated basic simulation with new dump cadence parameter --- .../Basic_Simulation/initial_conditions.py | 2 +- .../whm_gr_test/swiftest_relativity.ipynb | 84 +++++++++---------- python/swiftest/swiftest/simulation_class.py | 41 +++++---- 3 files changed, 60 insertions(+), 67 deletions(-) diff --git a/examples/Basic_Simulation/initial_conditions.py b/examples/Basic_Simulation/initial_conditions.py index 9bb279b51..3683ae077 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.010, tstep_out=1.0e0, fragmentation=True, minimum_fragment_mass = 2.5e-11, mtiny=2.5e-8) +sim = swiftest.Simulation(tstart=0.0, tstop=1.0e3, dt=0.005, tstep_out=1.0e0, dump_cadence=0, 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"]) diff --git a/examples/whm_gr_test/swiftest_relativity.ipynb b/examples/whm_gr_test/swiftest_relativity.ipynb index 113e10f81..0e5f26360 100644 --- a/examples/whm_gr_test/swiftest_relativity.ipynb +++ b/examples/whm_gr_test/swiftest_relativity.ipynb @@ -30,9 +30,7 @@ "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", - "Writing initial conditions to file init_cond.nc\n", - "Writing parameter inputs to file /home/daminton/git_debug/swiftest/examples/whm_gr_test/param.gr.in\n" + "Fetching ephemerides data for Neptune from JPL/Horizons\n" ] }, { @@ -394,7 +392,7 @@ "Coordinates:\n", " * name (name) <U32 'Sun' 'Mercury' 'Venus' ... 'Uranus' 'Neptune'\n", " * time (time) float64 0.0\n", - "Data variables: (12/14)\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", @@ -402,33 +400,33 @@ " 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", - " Gmass (time, name) float64 39.48 6.554e-06 ... 0.001724 0.002034\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
    • " ], "text/plain": [ "\n", @@ -436,7 +434,7 @@ "Coordinates:\n", " * name (name)
    • " ], "text/plain": [ "\n", @@ -885,7 +881,7 @@ "Coordinates:\n", " * name (name) Date: Thu, 1 Dec 2022 11:31:45 -0500 Subject: [PATCH 162/569] Fixed issues getting dump_cadence set properly on the Python side --- python/swiftest/swiftest/io.py | 7 ++++--- python/swiftest/swiftest/simulation_class.py | 4 ++-- 2 files changed, 6 insertions(+), 5 deletions(-) diff --git a/python/swiftest/swiftest/io.py b/python/swiftest/swiftest/io.py index 5d1f72ad6..92eeec73e 100644 --- a/python/swiftest/swiftest/io.py +++ b/python/swiftest/swiftest/io.py @@ -30,7 +30,8 @@ "SEED", "INTERACTION_LOOPS", "ENCOUNTER_CHECK", - "TSTART") + "TSTART", + "DUMP_CADENCE") # This list defines features that are booleans, so must be converted to/from string when writing/reading from file bool_param = ["RESTART", @@ -46,7 +47,7 @@ "YARKOVSKY", "YORP"] -int_param = ["ISTEP_OUT", "ISTEP_DUMP"] +int_param = ["ISTEP_OUT", "DUMP_CADENCE"] float_param = ["T0", "TSTART", "TSTOP", "DT", "CHK_RMIN", "CHK_RMAX", "CHK_EJECT", "CHK_QMIN", "DU2M", "MU2KG", "TU2S", "MIN_GMFRAG", "GMTINY"] @@ -409,7 +410,7 @@ def write_labeled_param(param, param_file_name): 'TSTOP', 'DT', 'ISTEP_OUT', - 'ISTEP_DUMP', + 'DUMP_CADENCE', 'NC_IN', 'PL_IN', 'TP_IN', diff --git a/python/swiftest/swiftest/simulation_class.py b/python/swiftest/swiftest/simulation_class.py index 8abf27d27..709e7e45d 100644 --- a/python/swiftest/swiftest/simulation_class.py +++ b/python/swiftest/swiftest/simulation_class.py @@ -628,10 +628,10 @@ def set_simulation_time(self, if dump_cadence is None: dump_cadence = self.param.pop("DUMP_CADENCE", 1) - self.param['DUMP_CADENCE'] = dump_cadence else: update_list.append("dump_cadence") - + self.param['DUMP_CADENCE'] = dump_cadence + time_dict = self.get_simulation_time(update_list, verbose=verbose) return time_dict From 864b02da4ed811f69c428159bf9d227a30c585da Mon Sep 17 00:00:00 2001 From: David A Minton Date: Thu, 1 Dec 2022 11:32:41 -0500 Subject: [PATCH 163/569] Added the storage of nbody_system snapshots between output dumps --- src/main/swiftest_driver.f90 | 35 ++++++++++++++++++++------------ src/modules/swiftest_classes.f90 | 9 +------- src/util/util_copy.f90 | 2 ++ 3 files changed, 25 insertions(+), 21 deletions(-) diff --git a/src/main/swiftest_driver.f90 b/src/main/swiftest_driver.f90 index 6bee4374b..42dfcd059 100644 --- a/src/main/swiftest_driver.f90 +++ b/src/main/swiftest_driver.f90 @@ -27,6 +27,7 @@ program swiftest_driver 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 real(DP) :: old_t_final = 0.0_DP !! Output time at which writing should start, in order to prevent duplicate lines being written for restarts type(walltimer) :: integration_timer !! Object used for computing elapsed wall time real(DP) :: tfrac @@ -78,12 +79,19 @@ program swiftest_driver display_unit => param%display_unit) call nbody_system%initialize(param) + + ! Set up loop and output cadence variables t = tstart iout = istep_out - idump = dump_cadence nloops = ceiling((tstop - t0) / dt, kind=I8B) - istart = ceiling((tstart - t0) / dt, kind=I8B) + istart = ceiling((tstart - t0) / dt + 1, kind=I8B) ioutput = int(istart / istep_out, kind=I8B) + + ! Set up system storage for intermittent file dumps + if (dump_cadence == 0) dump_cadence = nloops + allocate(swiftest_storage(dump_cadence) :: system_history) + idump = dump_cadence + ! Prevent duplicate frames from being written if this is a restarted run if (param%lrestart) then old_t_final = nbody_system%get_old_t_final(param) @@ -119,9 +127,18 @@ program swiftest_driver if (istep_out > 0) then iout = iout - 1 if (iout == 0) then - ioutput = int(iloop / istep_out, kind=I8B) - call nbody_system%write_frame(param) - + idump = idump - 1 + iframe = dump_cadence - idump + system_history%frame(iframe) = nbody_system + + if (idump == 0) then + call nbody_system%dump(param) + do iframe = 1_I8B, dump_cadence + ioutput = int((iloop - dump_cadence - 1_I8B + iframe) / istep_out, kind=I8B) + call system_history%frame(iframe)%system%write_frame(param) + end do + idump = dump_cadence + end if tfrac = (param%t - param%t0) / (param%tstop - param%t0) @@ -147,14 +164,6 @@ program swiftest_driver end if end if - !> If the loop counter is at the dump cadence value, dump the state of the system to a file in case it needs to be restarted - if (dump_cadence > 0) then - idump = idump - 1 - if (idump == 0) then - call nbody_system%dump(param) - idump = dump_cadence - end if - end if end do if (display_style == "COMPACT") write(*,*) "SWIFTEST STOP" // trim(adjustl(param%integrator)) end associate diff --git a/src/modules/swiftest_classes.f90 b/src/modules/swiftest_classes.f90 index 7952b28ac..5883adc44 100644 --- a/src/modules/swiftest_classes.f90 +++ b/src/modules/swiftest_classes.f90 @@ -425,11 +425,10 @@ module swiftest_classes end type type, extends(swiftest_base) :: swiftest_storage(nframes) - integer(I4B), len :: 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 contains - procedure :: initialize => setup_initialize_storage end type swiftest_storage abstract interface @@ -1046,12 +1045,6 @@ module subroutine setup_initialize_particle_info_system(self, param) class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters end subroutine setup_initialize_particle_info_system - module subroutine setup_initialize_storage(self, param) - implicit none - class(swiftest_storage(*)), intent(inout) :: self !! Swiftest storage object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - end subroutine setup_initialize_storage - module subroutine setup_initialize_system(self, param) implicit none class(swiftest_nbody_system), intent(inout) :: self !! Swiftest system object diff --git a/src/util/util_copy.f90 b/src/util/util_copy.f90 index fed2f0604..51e210787 100644 --- a/src/util/util_copy.f90 +++ b/src/util/util_copy.f90 @@ -86,7 +86,9 @@ module subroutine util_copy_store_system(self, system) class(storage_frame), intent(inout) :: self !! Swiftest storage frame object class(swiftest_nbody_system), intent(in) :: system !! Swiftest n-body system object + if (allocated(self%system)) deallocate(self%system) allocate(self%system, source=system) + return end subroutine util_copy_store_system From 5827b34998015e7a8dae28cf55a8e43792e96de8 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Thu, 1 Dec 2022 12:04:55 -0500 Subject: [PATCH 164/569] Fixed output cadence variable bug --- src/io/io.f90 | 20 ++++++++++++++++++++ src/main/swiftest_driver.f90 | 5 +---- src/modules/swiftest_classes.f90 | 8 ++++++++ 3 files changed, 29 insertions(+), 4 deletions(-) diff --git a/src/io/io.f90 b/src/io/io.f90 index a92b32780..43489e4b0 100644 --- a/src/io/io.f90 +++ b/src/io/io.f90 @@ -269,6 +269,26 @@ module subroutine io_dump_system(self, param) return end subroutine io_dump_system + module subroutine io_dump_system_storage(self, param) + !! author: David A. Minton + !! + !! Dumps the time history of the simulation to file + implicit none + ! Arguments + class(swiftest_storage(*)), intent(inout) :: self !! Swiftest simulation history storage object + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + ! Internals + integer(I8B) :: i, iloop_start + + iloop_start = param%iloop - param%istep_out * param%dump_cadence + 1_I8B + do i = 1_I8B, param%dump_cadence + param%ioutput = int(iloop_start / param%istep_out, kind=I8B) + i + call self%frame(i)%system%write_frame(param) + end do + + return + end subroutine io_dump_system_storage + module subroutine io_get_args(integrator, param_file_name, display_style) !! author: David A. Minton diff --git a/src/main/swiftest_driver.f90 b/src/main/swiftest_driver.f90 index 42dfcd059..14b06485b 100644 --- a/src/main/swiftest_driver.f90 +++ b/src/main/swiftest_driver.f90 @@ -133,10 +133,7 @@ program swiftest_driver if (idump == 0) then call nbody_system%dump(param) - do iframe = 1_I8B, dump_cadence - ioutput = int((iloop - dump_cadence - 1_I8B + iframe) / istep_out, kind=I8B) - call system_history%frame(iframe)%system%write_frame(param) - end do + call system_history%dump(param) idump = dump_cadence end if diff --git a/src/modules/swiftest_classes.f90 b/src/modules/swiftest_classes.f90 index 5883adc44..14f0e3369 100644 --- a/src/modules/swiftest_classes.f90 +++ b/src/modules/swiftest_classes.f90 @@ -429,6 +429,7 @@ module swiftest_classes !! A class that that is used to store simulation history data between file output type(storage_frame), dimension(nframes) :: frame contains + procedure :: dump => io_dump_system_storage end type swiftest_storage abstract interface @@ -624,6 +625,13 @@ 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) + 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 + module subroutine io_get_args(integrator, param_file_name, display_style) implicit none character(len=:), allocatable, intent(inout) :: integrator !! Symbolic code of the requested integrator From 43f84b35ebb3318479c6a0e040df7aa9a8434b1f Mon Sep 17 00:00:00 2001 From: David A Minton Date: Thu, 1 Dec 2022 12:05:23 -0500 Subject: [PATCH 165/569] Fixed bugs --- python/swiftest/swiftest/simulation_class.py | 33 ++++++++++++-------- 1 file changed, 20 insertions(+), 13 deletions(-) diff --git a/python/swiftest/swiftest/simulation_class.py b/python/swiftest/swiftest/simulation_class.py index 709e7e45d..012aeddbe 100644 --- a/python/swiftest/swiftest/simulation_class.py +++ b/python/swiftest/swiftest/simulation_class.py @@ -324,8 +324,8 @@ def __init__(self,read_param: bool = False, read_old_output_file: bool = False, # If the user asks to read in an old parameter file or output file, override any default parameters with values from the file # If the file doesn't exist, flag it for now so we know to create it if read_param or read_old_output_file: - #good_param is self.read_param() - if self.read_param(): + + if self.read_param(read_init_cond = not read_old_output_file): # We will add the parameter file to the kwarg list. This will keep the set_parameter method from # overriding everything with defaults when there are no arguments passed to Simulation() kwargs['param_file'] = self.param_file @@ -2556,6 +2556,7 @@ def get_nvals(ds): def read_param(self, param_file : os.PathLike | str | None = None, codename: Literal["Swiftest", "Swifter", "Swift"] | None = None, + read_init_cond : Bool | None = None, verbose: bool | None = None): """ Reads in an input parameter file and stores the values in the param dictionary. @@ -2563,9 +2564,11 @@ def read_param(self, Parameters ---------- param_file : str or path-like, default is the value of the Simulation object's internal `param_file`. - File name of the input parameter file + File name of the input parameter file codename : {"Swiftest", "Swifter", "Swift"}, default is the value of the Simulation object's internal`codename` - Type of parameter file, either "Swift", "Swifter", or "Swiftest" + Type of parameter file, either "Swift", "Swifter", or "Swiftest" + read_init_cond : bool, optional + If true, will read in the initial conditions file into the data instance variable. Default True verbose : bool, default is the value of the Simulation object's internal `verbose` If set to True, then more information is printed by Simulation methods as they are executed. Setting to False suppresses most messages other than errors. @@ -2575,7 +2578,8 @@ def read_param(self, """ if param_file is None: param_file = self.param_file - + if read_init_cond is None: + read_init_cond = True if codename is None: codename = self.codename @@ -2587,14 +2591,17 @@ def read_param(self, if codename == "Swiftest": self.param = io.read_swiftest_param(param_file, self.param, verbose=verbose) - if "NETCDF" in self.param['IN_TYPE']: - init_cond_file = self.sim_dir / 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) - else: - warnings.warn(f"Initial conditions file file {init_cond_file} not found.", stacklevel=2) + if read_init_cond: + if "NETCDF" in self.param['IN_TYPE']: + init_cond_file = self.sim_dir / 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) + else: + warnings.warn(f"Initial conditions file file {init_cond_file} not found.", stacklevel=2) + else: + warnings.warn("Reading in ASCII initial conditions files in Python is not yet supported") elif codename == "Swifter": self.param = io.read_swifter_param(param_file, verbose=verbose) elif codename == "Swift": From cdc12bcfa698cd4a2b8df7334b4d3ee72d0a1fab Mon Sep 17 00:00:00 2001 From: David A Minton Date: Thu, 1 Dec 2022 12:05:58 -0500 Subject: [PATCH 166/569] Fixed some issues with basic simulation for testing dump_cadence --- .../Basic_Simulation/initial_conditions.ipynb | 1483 ++++++++++++++++- .../Basic_Simulation/initial_conditions.py | 2 +- examples/Basic_Simulation/read_old_run.ipynb | 853 ++++++++++ examples/Basic_Simulation/read_old_run.py | 2 + 4 files changed, 2319 insertions(+), 21 deletions(-) create mode 100644 examples/Basic_Simulation/read_old_run.ipynb create mode 100644 examples/Basic_Simulation/read_old_run.py diff --git a/examples/Basic_Simulation/initial_conditions.ipynb b/examples/Basic_Simulation/initial_conditions.ipynb index cdcaae0ed..17b85582f 100644 --- a/examples/Basic_Simulation/initial_conditions.ipynb +++ b/examples/Basic_Simulation/initial_conditions.ipynb @@ -2,10 +2,18 @@ "cells": [ { "cell_type": "code", - "execution_count": null, + "execution_count": 1, "id": "2c4f59ea-1251-49f6-af1e-5695d7e25500", "metadata": {}, - "outputs": [], + "outputs": [ + { + "name": "stdout", + "output_type": "stream", + "text": [ + "env: OMP_NUM_THREADS=4\n" + ] + } + ], "source": [ "import swiftest\n", "import numpy as np\n", @@ -15,21 +23,468 @@ }, { "cell_type": "code", - "execution_count": null, + "execution_count": 2, "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.0e6, dt=0.01, tstep_out=1.0e3, fragmentation=True, minimum_fragment_mass = 2.5e-11, mtiny=2.5e-8)" + "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)" ] }, { "cell_type": "code", - "execution_count": null, + "execution_count": 3, "id": "1c122676-bacb-447c-bc37-5ef8019be0d0", "metadata": {}, - "outputs": [], + "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: " + ] + } + ], "source": [ "# Run the simulation\n", "sim.run()" ] + }, + { + "cell_type": "code", + "execution_count": null, + "id": "02a8911d-3b2c-415c-9290-bf1519a3f5c6", + "metadata": {}, + "outputs": [], + "source": [] } ], "metadata": { diff --git a/examples/Basic_Simulation/initial_conditions.py b/examples/Basic_Simulation/initial_conditions.py index 3683ae077..4d7fe7ae5 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.005, tstep_out=1.0e0, dump_cadence=0, fragmentation=True, minimum_fragment_mass = 2.5e-11, mtiny=2.5e-8) +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) # 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"]) diff --git a/examples/Basic_Simulation/read_old_run.ipynb b/examples/Basic_Simulation/read_old_run.ipynb new file mode 100644 index 000000000..0a7459084 --- /dev/null +++ b/examples/Basic_Simulation/read_old_run.ipynb @@ -0,0 +1,853 @@ +{ + "cells": [ + { + "cell_type": "code", + "execution_count": 1, + "id": "86b309f3-d400-4164-88fc-cf56b6cfcf5f", + "metadata": {}, + "outputs": [], + "source": [ + "import swiftest" + ] + }, + { + "cell_type": "code", + "execution_count": 2, + "id": "353b2559-83a2-496f-8648-60f6121333a5", + "metadata": {}, + "outputs": [ + { + "name": "stdout", + "output_type": "stream", + "text": [ + "Reading Swiftest file /home/daminton/git_debug/swiftest/examples/Basic_Simulation/simdata/param.in\n", + "\n", + "Creating Dataset from NetCDF file\n", + "Successfully converted 78 output frames.\n", + "Swiftest simulation data stored as xarray DataSet .data\n" + ] + } + ], + "source": [ + "sim = swiftest.Simulation(read_old_output_file=True)" + ] + }, + { + "cell_type": "code", + "execution_count": 3, + "id": "c7bceca2-678d-469d-a3a7-06cfa9f29fc0", + "metadata": {}, + "outputs": [ + { + "data": { + "text/html": [ + "
    \n", + "\n", + "\n", + "\n", + "\n", + "\n", + "\n", + "\n", + "\n", + "\n", + "\n", + "\n", + "\n", + "\n", + "\n", + "
    <xarray.Dataset>\n",
+       "Dimensions:          (time: 78, name: 25)\n",
+       "Coordinates:\n",
+       "  * time             (time) float64 0.0 2.0 nan 4.0 nan ... nan 76.0 nan 78.0\n",
+       "  * name             (name) <U32 'Sun' 'Mercury' ... 'TestParticle_10'\n",
+       "Data variables: (12/45)\n",
+       "    id               (name) int64 0 1 2 3 4 5 6 7 8 ... 17 18 19 20 21 22 23 24\n",
+       "    npl              (time) int64 14 14 -2147483647 14 ... 14 -2147483647 14\n",
+       "    ntp              (time) int64 10 10 -2147483647 10 ... 10 -2147483647 10\n",
+       "    nplm             (time) int64 13 13 -2147483647 13 ... 13 -2147483647 13\n",
+       "    particle_type    (name) <U32 'Central Body' ... 'Test Particle'\n",
+       "    status           (name) <U32 'ACTIVE' 'ACTIVE' ... 'ACTIVE' 'ACTIVE'\n",
+       "    ...               ...\n",
+       "    Ip3              (time, name) float64 0.07 0.346 0.4 0.3307 ... nan nan nan\n",
+       "    rotx             (time, name) float64 11.21 3.573 0.1765 ... nan nan nan\n",
+       "    roty             (time, name) float64 -38.76 -18.38 -3.661 ... nan nan nan\n",
+       "    rotz             (time, name) float64 82.25 34.36 8.703 ... nan nan nan\n",
+       "    j2rp2            (time) float64 4.754e-12 4.754e-12 nan ... nan 4.754e-12\n",
+       "    j4rp4            (time) float64 -2.247e-18 -2.247e-18 nan ... nan -2.247e-18
    " + ], + "text/plain": [ + "\n", + "Dimensions: (time: 78, name: 25)\n", + "Coordinates:\n", + " * time (time) float64 0.0 2.0 nan 4.0 nan ... nan 76.0 nan 78.0\n", + " * name (name) Date: Thu, 1 Dec 2022 12:37:07 -0500 Subject: [PATCH 167/569] Moved time variable from param to nbody_system so that the system history dumps have the correct time associated with them --- src/discard/discard.f90 | 24 +- src/io/io.f90 | 4 +- src/main/swiftest_driver.f90 | 8 +- src/modules/swiftest_classes.f90 | 2 +- src/netcdf/netcdf.f90 | 4 +- src/rmvs/rmvs_discard.f90 | 2 +- src/setup/symba_collision.f90 | 1090 ++++++++++++++++++++++++++++++ src/symba/symba_collision.f90 | 15 +- src/symba/symba_discard.f90 | 16 +- src/walltime/walltime.f90 | 1 - 10 files changed, 1127 insertions(+), 39 deletions(-) create mode 100644 src/setup/symba_collision.f90 diff --git a/src/discard/discard.f90 b/src/discard/discard.f90 index 6c799844f..55ad97f65 100644 --- a/src/discard/discard.f90 +++ b/src/discard/discard.f90 @@ -135,22 +135,22 @@ subroutine discard_cb_tp(tp, system, param) if ((param%rmax >= 0.0_DP) .and. (rh2 > rmax2)) then tp%status(i) = DISCARDED_RMAX write(idstr, *) tp%id(i) - write(timestr, *) param%t + write(timestr, *) system%t write(*, *) "Particle " // trim(adjustl(tp%info(i)%name)) // " (" // trim(adjustl(idstr)) // ")" // & " too far from the central body at t = " // trim(adjustl(timestr)) tp%ldiscard(i) = .true. tp%lmask(i) = .false. - call tp%info(i)%set_value(status="DISCARDED_RMAX", discard_time=param%t, discard_xh=tp%xh(:,i), & + call tp%info(i)%set_value(status="DISCARDED_RMAX", discard_time=system%t, discard_xh=tp%xh(:,i), & discard_vh=tp%vh(:,i)) else if ((param%rmin >= 0.0_DP) .and. (rh2 < rmin2)) then tp%status(i) = DISCARDED_RMIN write(idstr, *) tp%id(i) - write(timestr, *) param%t + write(timestr, *) system%t write(*, *) "Particle " // trim(adjustl(tp%info(i)%name)) // " (" // trim(adjustl(idstr)) // ")" // & " too close to the central body at t = " // trim(adjustl(timestr)) tp%ldiscard(i) = .true. tp%lmask(i) = .false. - call tp%info(i)%set_value(status="DISCARDED_RMIN", discard_time=param%t, discard_xh=tp%xh(:,i), & + call tp%info(i)%set_value(status="DISCARDED_RMIN", discard_time=system%t, discard_xh=tp%xh(:,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)) @@ -159,12 +159,12 @@ subroutine discard_cb_tp(tp, system, param) if ((energy > 0.0_DP) .and. (rb2 > rmaxu2)) then tp%status(i) = DISCARDED_RMAXU write(idstr, *) tp%id(i) - write(timestr, *) param%t + write(timestr, *) system%t write(*, *) "Particle " // trim(adjustl(tp%info(i)%name)) // " (" // trim(adjustl(idstr)) // ")" // & " is unbound and too far from barycenter at t = " // trim(adjustl(timestr)) tp%ldiscard(i) = .true. tp%lmask(i) = .false. - call tp%info(i)%set_value(status="DISCARDED_RMAXU", discard_time=param%t, discard_xh=tp%xh(:,i), & + call tp%info(i)%set_value(status="DISCARDED_RMAXU", discard_time=system%t, discard_xh=tp%xh(:,i), & discard_vh=tp%vh(:,i)) end if end if @@ -194,7 +194,7 @@ subroutine discard_peri_tp(tp, system, param) real(DP), dimension(NDIM) :: dx character(len=STRMAX) :: idstr, timestr - associate(cb => system%cb, ntp => tp%nbody, pl => system%pl, npl => system%pl%nbody, t => param%t) + associate(cb => system%cb, ntp => tp%nbody, pl => system%pl, npl => system%pl%nbody, t => system%t) call tp%get_peri(system, param) do i = 1, ntp if (tp%status(i) == ACTIVE) then @@ -211,11 +211,11 @@ subroutine discard_peri_tp(tp, system, param) (tp%peri(i) <= param%qmin)) then tp%status(i) = DISCARDED_PERI write(idstr, *) tp%id(i) - write(timestr, *) param%t + write(timestr, *) system%t write(*, *) "Particle " // trim(adjustl(tp%info(i)%name)) // " (" // trim(adjustl(idstr)) // ")" // & " perihelion distance too small at t = " // trim(adjustl(timestr)) tp%ldiscard(i) = .true. - call tp%info(i)%set_value(status="DISCARDED_PERI", discard_time=param%t, discard_xh=tp%xh(:,i), & + call tp%info(i)%set_value(status="DISCARDED_PERI", discard_time=system%t, discard_xh=tp%xh(:,i), & discard_vh=tp%vh(:,i), discard_body_id=pl%id(j)) end if end if @@ -246,7 +246,7 @@ subroutine discard_pl_tp(tp, system, param) real(DP), dimension(NDIM) :: dx, dv character(len=STRMAX) :: idstri, idstrj, timestr - associate(ntp => tp%nbody, pl => system%pl, npl => system%pl%nbody, t => param%t, dt => param%dt) + associate(ntp => tp%nbody, pl => system%pl, npl => system%pl%nbody, t => system%t, dt => param%dt) do i = 1, ntp if (tp%status(i) == ACTIVE) then do j = 1, npl @@ -260,12 +260,12 @@ subroutine discard_pl_tp(tp, system, param) pl%ldiscard(j) = .true. write(idstri, *) tp%id(i) write(idstrj, *) pl%id(j) - write(timestr, *) param%t + write(timestr, *) system%t write(*, *) "Test particle " // trim(adjustl(tp%info(i)%name)) // " (" // trim(adjustl(idstri)) // ")" & // " too close to massive body " // trim(adjustl(pl%info(j)%name)) // " (" // trim(adjustl(idstrj)) // ")" & // " at t = " // trim(adjustl(timestr)) tp%ldiscard(i) = .true. - call tp%info(i)%set_value(status="DISCARDED_PLR", discard_time=param%t, discard_xh=tp%xh(:,i), & + call tp%info(i)%set_value(status="DISCARDED_PLR", discard_time=system%t, discard_xh=tp%xh(:,i), & discard_vh=tp%vh(:,i), discard_body_id=pl%id(j)) exit end if diff --git a/src/io/io.f90 b/src/io/io.f90 index 43489e4b0..f77278424 100644 --- a/src/io/io.f90 +++ b/src/io/io.f90 @@ -35,7 +35,7 @@ module subroutine io_compact_output(self, param, timer) select type(timer) class is (walltimer) - formatted_output = fmt("ILOOP",param%iloop) // fmt("T",param%t) // fmt("NPL",self%pl%nbody) // fmt("NTP",self%tp%nbody) + formatted_output = fmt("ILOOP",param%iloop) // fmt("T",self%t) // fmt("NPL",self%pl%nbody) // fmt("NTP",self%tp%nbody) select type(pl => self%pl) class is (symba_pl) formatted_output = formatted_output // fmt("NPLM",pl%nplm) @@ -250,7 +250,7 @@ module subroutine io_dump_system(self, param) dump_param%in_netcdf = trim(adjustl(DUMP_NC_FILE(idx))) dump_param%nciu%id_chunk = self%pl%nbody + self%tp%nbody dump_param%nciu%time_chunk = 1 - dump_param%tstart = param%t + dump_param%tstart = self%t call dump_param%dump(param_file_name) diff --git a/src/main/swiftest_driver.f90 b/src/main/swiftest_driver.f90 index 14b06485b..1ec5df880 100644 --- a/src/main/swiftest_driver.f90 +++ b/src/main/swiftest_driver.f90 @@ -66,7 +66,7 @@ program swiftest_driver call setup_construct_system(nbody_system, param) call param%read_in(param_file_name) - associate(t => param%t, & + associate(t => nbody_system%t, & t0 => param%t0, & tstart => param%tstart, & dt => param%dt, & @@ -137,13 +137,13 @@ program swiftest_driver idump = dump_cadence end if - tfrac = (param%t - param%t0) / (param%tstop - param%t0) + tfrac = (t - t0) / (tstop - t0) select type(pl => nbody_system%pl) class is (symba_pl) - write(display_unit, symbastatfmt) param%t, tfrac, pl%nplm, pl%nbody, nbody_system%tp%nbody + write(display_unit, symbastatfmt) t, tfrac, pl%nplm, pl%nbody, nbody_system%tp%nbody class default - write(display_unit, statusfmt) param%t, tfrac, pl%nbody, nbody_system%tp%nbody + write(display_unit, statusfmt) t, tfrac, pl%nbody, nbody_system%tp%nbody end select if (param%lenergy) call nbody_system%conservation_report(param, lterminal=.true.) call integration_timer%report(message="Integration steps:", unit=display_unit, nsubsteps=istep_out) diff --git a/src/modules/swiftest_classes.f90 b/src/modules/swiftest_classes.f90 index 14f0e3369..878b5d308 100644 --- a/src/modules/swiftest_classes.f90 +++ b/src/modules/swiftest_classes.f90 @@ -37,7 +37,6 @@ module swiftest_classes integer(I4B) :: maxid = -1 !! The current maximum particle id number integer(I4B) :: maxid_collision = 0 !! The current maximum collision id number real(DP) :: t0 = 0.0_DP !! Integration reference time - real(DP) :: t = -1.0_DP !! Integration current time real(DP) :: tstart = -1.0_DP !! Integration start time real(DP) :: tstop = -1.0_DP !! Integration stop time real(DP) :: dt = -1.0_DP !! Time step @@ -347,6 +346,7 @@ module swiftest_classes class(swiftest_tp), allocatable :: tp !! Test particle data structure class(swiftest_tp), allocatable :: tp_discards !! Discarded test particle data structure class(swiftest_pl), allocatable :: pl_discards !! Discarded massive body particle data structure + real(DP) :: t = -1.0_DP !! Integration current time real(DP) :: GMtot = 0.0_DP !! Total system mass - used for barycentric coordinate conversion real(DP) :: ke_orbit = 0.0_DP !! System orbital kinetic energy real(DP) :: ke_spin = 0.0_DP !! System spin kinetic energy diff --git a/src/netcdf/netcdf.f90 b/src/netcdf/netcdf.f90 index 89824e4ec..abd03f1d6 100644 --- a/src/netcdf/netcdf.f90 +++ b/src/netcdf/netcdf.f90 @@ -793,7 +793,7 @@ module subroutine netcdf_read_hdr_system(self, iu, param) tslot = int(param%ioutput, kind=I4B) + 1 call check( nf90_inquire_dimension(iu%ncid, iu%id_dimid, len=idmax), "netcdf_read_frame_system nf90_inquire_dimension id_dimid" ) - call check( nf90_get_var(iu%ncid, iu%time_varid, param%t, start=[tslot]), "netcdf_read_hdr_system nf90_getvar time_varid" ) + call check( nf90_get_var(iu%ncid, iu%time_varid, self%t, start=[tslot]), "netcdf_read_hdr_system nf90_getvar time_varid" ) allocate(gmtemp(idmax)) allocate(tpmask(idmax)) @@ -1428,7 +1428,7 @@ module subroutine netcdf_write_hdr_system(self, iu, param) tslot = int(param%ioutput, kind=I4B) + 1 - call check( nf90_put_var(iu%ncid, iu%time_varid, param%t, start=[tslot]), "netcdf_write_hdr_system nf90_put_var time_varid" ) + call check( nf90_put_var(iu%ncid, iu%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" ) select type(pl => self%pl) diff --git a/src/rmvs/rmvs_discard.f90 b/src/rmvs/rmvs_discard.f90 index 732cbdea0..60be2f6b0 100644 --- a/src/rmvs/rmvs_discard.f90 +++ b/src/rmvs/rmvs_discard.f90 @@ -29,7 +29,7 @@ module subroutine rmvs_discard_tp(self, system, param) if (self%nbody == 0) return - associate(tp => self, ntp => self%nbody, pl => system%pl, t => param%t) + associate(tp => self, ntp => self%nbody, pl => system%pl, t => system%t) do i = 1, ntp associate(iplperP => tp%plperP(i)) if ((tp%status(i) == ACTIVE) .and. (tp%lperi(i))) then diff --git a/src/setup/symba_collision.f90 b/src/setup/symba_collision.f90 new file mode 100644 index 000000000..e839af1de --- /dev/null +++ b/src/setup/symba_collision.f90 @@ -0,0 +1,1090 @@ +!! Copyright 2022 - David Minton, Carlisle Wishard, Jennifer Pouplin, Jake Elliott, & Dana Singh +!! This file is part of Swiftest. +!! Swiftest is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License +!! as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. +!! Swiftest is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty +!! of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. +!! You should have received a copy of the GNU General Public License along with Swiftest. +!! If not, see: https://www.gnu.org/licenses. + +submodule (symba_classes) s_symba_collision + use swiftest + +contains + + module function symba_collision_casedisruption(system, param, colliders, frag) result(status) + !! author: Jennifer L.L. Pouplin, Carlisle A. Wishard, and David A. Minton + !! + !! Create the fragments resulting from a non-catastrophic disruption collision + !! + implicit none + ! Arguments + class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object + class(symba_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions + class(fraggle_colliders), intent(inout) :: colliders !! Fraggle colliders object + class(fraggle_fragments), intent(inout) :: frag !! Fraggle fragmentation system object + ! Result + integer(I4B) :: status !! Status flag assigned to this outcome + ! Internals + integer(I4B) :: i, nfrag + logical :: lfailure + character(len=STRMAX) :: message + + select case(frag%regime) + case(COLLRESOLVE_REGIME_DISRUPTION) + message = "Disruption between" + case(COLLRESOLVE_REGIME_SUPERCATASTROPHIC) + message = "Supercatastrophic disruption between" + end select + call symba_collision_collider_message(system%pl, colliders%idx, message) + call io_log_one_message(FRAGGLE_LOG_OUT, message) + + ! Collisional fragments will be uniformly distributed around the pre-impact barycenter + call frag%set_mass_dist(colliders, param) + + ! Generate the position and velocity distributions of the fragments + call frag%generate_fragments(colliders, system, param, lfailure) + + if (lfailure) then + call io_log_one_message(FRAGGLE_LOG_OUT, "No fragment solution found, so treat as a pure hit-and-run") + status = ACTIVE + nfrag = 0 + select type(pl => system%pl) + class is (symba_pl) + pl%status(colliders%idx(:)) = status + pl%ldiscard(colliders%idx(:)) = .false. + pl%lcollision(colliders%idx(:)) = .false. + end select + else + ! Populate the list of new bodies + nfrag = frag%nbody + write(message, *) nfrag + call io_log_one_message(FRAGGLE_LOG_OUT, "Generating " // trim(adjustl(message)) // " fragments") + select case(frag%regime) + case(COLLRESOLVE_REGIME_DISRUPTION) + status = DISRUPTION + case(COLLRESOLVE_REGIME_SUPERCATASTROPHIC) + status = SUPERCATASTROPHIC + end select + frag%id(1:nfrag) = [(i, i = param%maxid + 1, param%maxid + nfrag)] + param%maxid = frag%id(nfrag) + call symba_collision_mergeaddsub(system, param, colliders, frag, status) + end if + + return + end function symba_collision_casedisruption + + + module function symba_collision_casehitandrun(system, param, colliders, frag) result(status) + !! author: Jennifer L.L. Pouplin, Carlisle A. Wishard, and David A. Minton + !! + !! Create the fragments resulting from a non-catastrophic hit-and-run collision + !! + implicit none + ! Arguments + class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object + class(symba_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions + class(fraggle_colliders), intent(inout) :: colliders !! Fraggle colliders object + class(fraggle_fragments), intent(inout) :: frag !! Fraggle fragmentation system object + ! Result + integer(I4B) :: status !! Status flag assigned to this outcom + ! Internals + integer(I4B) :: i, ibiggest, nfrag, jtarg, jproj + logical :: lpure + character(len=STRMAX) :: message + + message = "Hit and run between" + call symba_collision_collider_message(system%pl, colliders%idx, message) + call io_log_one_message(FRAGGLE_LOG_OUT, trim(adjustl(message))) + + if (colliders%mass(1) > colliders%mass(2)) then + jtarg = 1 + jproj = 2 + else + jtarg = 2 + jproj = 1 + end if + + if (frag%mass_dist(2) > 0.9_DP * colliders%mass(jproj)) then ! Pure hit and run, so we'll just keep the two bodies untouched + call io_log_one_message(FRAGGLE_LOG_OUT, "Pure hit and run. No new fragments generated.") + nfrag = 0 + lpure = .true. + else ! Imperfect hit and run, so we'll keep the largest body and destroy the other + lpure = .false. + call frag%set_mass_dist(colliders, param) + + ! Generate the position and velocity distributions of the fragments + call frag%generate_fragments(colliders, system, param, lpure) + + if (lpure) then + call io_log_one_message(FRAGGLE_LOG_OUT, "Should have been a pure hit and run instead") + nfrag = 0 + else + nfrag = frag%nbody + write(message, *) nfrag + call io_log_one_message(FRAGGLE_LOG_OUT, "Generating " // trim(adjustl(message)) // " fragments") + end if + end if + if (lpure) then ! Reset these bodies back to being active so that nothing further is done to them + status = HIT_AND_RUN_PURE + select type(pl => system%pl) + class is (symba_pl) + pl%status(colliders%idx(:)) = ACTIVE + pl%ldiscard(colliders%idx(:)) = .false. + pl%lcollision(colliders%idx(:)) = .false. + end select + else + ibiggest = colliders%idx(maxloc(system%pl%Gmass(colliders%idx(:)), dim=1)) + frag%id(1) = system%pl%id(ibiggest) + frag%id(2:nfrag) = [(i, i = param%maxid + 1, param%maxid + nfrag - 1)] + param%maxid = frag%id(nfrag) + status = HIT_AND_RUN_DISRUPT + call symba_collision_mergeaddsub(system, param, colliders, frag, status) + end if + + return + end function symba_collision_casehitandrun + + + module function symba_collision_casemerge(system, param, colliders, frag) result(status) + !! author: Jennifer L.L. Pouplin, Carlisle A. Wishard, and David A. Minton + !! + !! Merge massive bodies. + !! + !! Adapted from David E. Kaufmann's Swifter routines symba_merge_pl.f90 and symba_discard_merge_pl.f90 + !! + !! Adapted from Hal Levison's Swift routines symba5_merge.f and discard_mass_merge.f + implicit none + ! Arguments + class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object + class(symba_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions + class(fraggle_colliders), intent(inout) :: colliders !! Fraggle colliders object + class(fraggle_fragments), intent(inout) :: frag !! Fraggle fragmentation system object + ! Result + integer(I4B) :: status !! Status flag assigned to this outcome + ! Internals + integer(I4B) :: i, j, k, ibiggest + real(DP) :: pe + real(DP), dimension(NDIM) :: L_spin_new + character(len=STRMAX) :: message + + message = "Merging" + call symba_collision_collider_message(system%pl, colliders%idx, message) + call io_log_one_message(FRAGGLE_LOG_OUT, message) + + select type(pl => system%pl) + class is (symba_pl) + + call frag%set_mass_dist(colliders, param) + ibiggest = colliders%idx(maxloc(pl%Gmass(colliders%idx(:)), dim=1)) + frag%id(1) = pl%id(ibiggest) + frag%xb(:,1) = frag%xbcom(:) + frag%vb(:,1) = frag%vbcom(:) + + if (param%lrotation) then + ! Conserve angular momentum by putting pre-impact orbital momentum into spin of the new body + L_spin_new(:) = colliders%L_orbit(:,1) + colliders%L_orbit(:,2) + colliders%L_spin(:,1) + colliders%L_spin(:,2) + + ! Assume prinicpal axis rotation on 3rd Ip axis + frag%rot(:,1) = L_spin_new(:) / (frag%Ip(3,1) * frag%mass(1) * frag%radius(1)**2) + else ! If spin is not enabled, we will consider the lost pre-collision angular momentum as "escaped" and add it to our bookkeeping variable + param%Lescape(:) = param%Lescape(:) + colliders%L_orbit(:,1) + colliders%L_orbit(:,2) + end if + + ! Keep track of the component of potential energy due to the pre-impact colliders%idx for book-keeping + pe = 0.0_DP + do j = 1, colliders%ncoll + do i = j + 1, colliders%ncoll + pe = pe - pl%Gmass(i) * pl%mass(j) / norm2(pl%xb(:, i) - pl%xb(:, j)) + end do + end do + system%Ecollisions = system%Ecollisions + pe + system%Euntracked = system%Euntracked - pe + + ! Update any encounter lists that have the removed bodies in them so that they instead point to the new + do k = 1, system%plplenc_list%nenc + do j = 1, colliders%ncoll + i = colliders%idx(j) + if (i == ibiggest) cycle + if (system%plplenc_list%id1(k) == pl%id(i)) then + system%plplenc_list%id1(k) = pl%id(ibiggest) + system%plplenc_list%index1(k) = i + end if + if (system%plplenc_list%id2(k) == pl%id(i)) then + system%plplenc_list%id2(k) = pl%id(ibiggest) + system%plplenc_list%index2(k) = i + end if + if (system%plplenc_list%id1(k) == system%plplenc_list%id2(k)) system%plplenc_list%status(k) = INACTIVE + end do + end do + + status = MERGED + + call symba_collision_mergeaddsub(system, param, colliders, frag, status) + + end select + + return + end function symba_collision_casemerge + + + subroutine symba_collision_collider_message(pl, collidx, collider_message) + !! author: David A. Minton + !! + !! Prints a nicely formatted message about which bodies collided, including their names and ids. + !! This subroutine appends the body names and ids to an input message. + implicit none + ! Arguments + class(swiftest_pl), intent(in) :: pl !! Swiftest massive body object + integer(I4B), dimension(:), intent(in) :: collidx !! Index of collisional colliders%idx members + character(*), intent(inout) :: collider_message !! The message to print to the screen. + ! Internals + integer(I4B) :: i, n + character(len=STRMAX) :: idstr + + n = size(collidx) + if (n == 0) return + + do i = 1, n + if (i > 1) collider_message = trim(adjustl(collider_message)) // " and " + collider_message = " " // trim(adjustl(collider_message)) // " " // trim(adjustl(pl%info(collidx(i))%name)) + write(idstr, '(I10)') pl%id(collidx(i)) + collider_message = trim(adjustl(collider_message)) // " (" // trim(adjustl(idstr)) // ") " + end do + + return + end subroutine symba_collision_collider_message + + + module function symba_collision_check_encounter(self, system, param, t, dt, irec) result(lany_collision) + !! author: David A. Minton + !! + !! Check for merger between massive bodies and test particles in SyMBA + !! + !! Adapted from David E. Kaufmann's Swifter routine symba_merge.f90 and symba_merge_tp.f90 + !! + !! Adapted from Hal Levison's Swift routine symba5_merge.f + implicit none + ! Arguments + class(symba_encounter), intent(inout) :: self !! SyMBA pl-tp encounter list object + class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object + class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters + real(DP), intent(in) :: t !! current time + real(DP), intent(in) :: dt !! step size + integer(I4B), intent(in) :: irec !! Current recursion level + ! Result + logical :: lany_collision !! Returns true if cany pair of encounters resulted in a collision + ! Internals + logical, dimension(:), allocatable :: lcollision, lmask + real(DP), dimension(NDIM) :: xr, vr + integer(I4B) :: i, j, k, nenc + real(DP) :: rlim, Gmtot + logical :: isplpl + character(len=STRMAX) :: timestr, idstri, idstrj, message + class(symba_encounter), allocatable :: tmp + + lany_collision = .false. + if (self%nenc == 0) return + + select type(self) + class is (symba_plplenc) + isplpl = .true. + class default + isplpl = .false. + end select + + select type(pl => system%pl) + class is (symba_pl) + select type(tp => system%tp) + class is (symba_tp) + nenc = self%nenc + allocate(lmask(nenc)) + lmask(:) = ((self%status(1:nenc) == ACTIVE) .and. (pl%levelg(self%index1(1:nenc)) >= irec)) + if (isplpl) then + lmask(:) = lmask(:) .and. (pl%levelg(self%index2(1:nenc)) >= irec) + else + lmask(:) = lmask(:) .and. (tp%levelg(self%index2(1:nenc)) >= irec) + end if + if (.not.any(lmask(:))) return + + allocate(lcollision(nenc)) + lcollision(:) = .false. + + if (isplpl) then + do concurrent(k = 1:nenc, lmask(k)) + i = self%index1(k) + j = self%index2(k) + xr(:) = pl%xh(:, i) - pl%xh(:, j) + vr(:) = pl%vb(:, i) - pl%vb(:, j) + rlim = pl%radius(i) + pl%radius(j) + Gmtot = pl%Gmass(i) + pl%Gmass(j) + lcollision(k) = symba_collision_check_one(xr(1), xr(2), xr(3), vr(1), vr(2), vr(3), & + Gmtot, rlim, dt, self%lvdotr(k)) + end do + else + do concurrent(k = 1:nenc, lmask(k)) + i = self%index1(k) + j = self%index2(k) + xr(:) = pl%xh(:, i) - tp%xh(:, j) + vr(:) = pl%vb(:, i) - tp%vb(:, j) + lcollision(k) = symba_collision_check_one(xr(1), xr(2), xr(3), vr(1), vr(2), vr(3), & + pl%Gmass(i), pl%radius(i), dt, self%lvdotr(k)) + end do + end if + + lany_collision = any(lcollision(:)) + if (lany_collision) then + call pl%xh2xb(system%cb) ! Update the central body barycenteric position vector to get us out of DH and into bary + do k = 1, nenc + i = self%index1(k) + j = self%index2(k) + if (lcollision(k)) self%status(k) = COLLISION + self%t(k) = t + self%x1(:,k) = pl%xh(:,i) + system%cb%xb(:) + self%v1(:,k) = pl%vb(:,i) + if (isplpl) then + self%x2(:,k) = pl%xh(:,j) + system%cb%xb(:) + self%v2(:,k) = pl%vb(:,j) + if (lcollision(k)) then + ! Check to see if either of these bodies has been involved with a collision before, and if so, make this a collisional colliders%idx + if (pl%lcollision(i) .or. pl%lcollision(j)) call pl%make_colliders([i,j]) + + ! Set the collision flag for these to bodies to true in case they become involved in another collision later in the step + pl%lcollision([i, j]) = .true. + pl%status([i, j]) = COLLISION + call pl%info(i)%set_value(status="COLLISION", discard_time=t, discard_xh=pl%xh(:,i), discard_vh=pl%vh(:,i)) + call pl%info(j)%set_value(status="COLLISION", discard_time=t, discard_xh=pl%xh(:,j), discard_vh=pl%vh(:,j)) + end if + else + self%x2(:,k) = tp%xh(:,j) + system%cb%xb(:) + self%v2(:,k) = tp%vb(:,j) + if (lcollision(k)) then + tp%status(j) = DISCARDED_PLR + tp%ldiscard(j) = .true. + write(idstri, *) pl%id(i) + write(idstrj, *) tp%id(j) + write(timestr, *) t + call tp%info(j)%set_value(status="DISCARDED_PLR", discard_time=t, discard_xh=tp%xh(:,j), discard_vh=tp%vh(:,j)) + write(message, *) "Particle " // trim(adjustl(tp%info(j)%name)) // " (" // trim(adjustl(idstrj)) // ")" & + // " collided with massive body " // trim(adjustl(pl%info(i)%name)) // " (" // trim(adjustl(idstri)) // ")" & + // " at t = " // trim(adjustl(timestr)) + call io_log_one_message(FRAGGLE_LOG_OUT, message) + end if + end if + end do + end if + end select + end select + + ! Extract the pl-pl or pl-tp encounter list and return the pl-pl or pl-tp collision_list + if (lany_collision) then + select type(self) + class is (symba_plplenc) + call self%extract_collisions(system, param) + class default + allocate(tmp, mold=self) + call self%spill(tmp, lcollision, ldestructive=.true.) ! Remove this encounter pair from the encounter list + end select + end if + + return + end function symba_collision_check_encounter + + + pure elemental function symba_collision_check_one(xr, yr, zr, vxr, vyr, vzr, Gmtot, rlim, dt, lvdotr) result(lcollision) + !! author: David A. Minton + !! + !! Check for a merger between a single pair of particles + !! + !! Adapted from David E. Kaufmann's Swifter routines symba_merge_tp.f90 and symba_merge_pl.f90 + !! + !! Adapted from Hal Levison's Swift routine symba5_merge.f + implicit none + ! Arguments + real(DP), intent(in) :: xr, yr, zr !! Relative position vector components + real(DP), intent(in) :: vxr, vyr, vzr !! Relative velocity vector components + real(DP), intent(in) :: Gmtot !! Sum of G*mass of colliding bodies + real(DP), intent(in) :: rlim !! Collision limit - Typically the sum of the radii of colliding bodies + real(DP), intent(in) :: dt !! Step size + logical, intent(in) :: lvdotr !! Logical flag indicating that these two bodies are approaching in the current substep + ! Result + logical :: lcollision !! Logical flag indicating whether these two bodies will collide or not + ! Internals + real(DP) :: r2, rlim2, a, e, q, vdotr, tcr2, dt2 + + r2 = xr**2 + yr**2 + zr**2 + rlim2 = rlim**2 + + if (r2 <= rlim2) then ! checks if bodies are actively colliding in this time step + lcollision = .true. + else ! if they are not actively colliding in this time step, checks if they are going to collide next time step based on velocities and q + lcollision = .false. + vdotr = xr * vxr + yr * vyr + zr * vzr + if (lvdotr .and. (vdotr > 0.0_DP)) then + tcr2 = r2 / (vxr**2 + vyr**2 + vzr**2) + dt2 = dt**2 + if (tcr2 <= dt2) then + call orbel_xv2aeq(Gmtot, xr, yr, zr, vxr, vyr, vzr, a, e, q) + lcollision = (q < rlim) + end if + end if + end if + + return + end function symba_collision_check_one + + + function symba_collision_consolidate_colliders(pl, cb, param, idx_parent, colliders) result(lflag) + !! author: David A. Minton + !! + !! Loops through the pl-pl collision list and groups families together by index. Outputs the indices of all colliders%idx members, + !! and pairs of quantities (x and v vectors, mass, radius, L_spin, and Ip) that can be used to resolve the collisional outcome. + implicit none + ! Arguments + class(symba_pl), intent(inout) :: pl !! SyMBA massive body object + class(symba_cb), intent(inout) :: cb !! SyMBA central body object + class(symba_parameters), intent(in) :: param !! Current run configuration parameters with SyMBA additions + integer(I4B), dimension(2), intent(inout) :: idx_parent !! Index of the two bodies considered the "parents" of the collision + class(fraggle_colliders), intent(out) :: colliders + ! Result + logical :: lflag !! Logical flag indicating whether a colliders%idx was successfully created or not + ! Internals + type collidx_array + integer(I4B), dimension(:), allocatable :: id + integer(I4B), dimension(:), allocatable :: idx + end type collidx_array + type(collidx_array), dimension(2) :: parent_child_index_array + integer(I4B), dimension(2) :: nchild + integer(I4B) :: i, j, ncolliders, idx_child + real(DP), dimension(2) :: volume, density + real(DP) :: mchild, volchild + real(DP), dimension(NDIM) :: xc, vc, xcom, vcom, xchild, vchild, xcrossv + real(DP), dimension(NDIM,2) :: mxc, vcc + + nchild(:) = pl%kin(idx_parent(:))%nchild + ! If all of these bodies share a parent, but this is still a unique collision, move the last child + ! out of the parent's position and make it the secondary body + if (idx_parent(1) == idx_parent(2)) then + if (nchild(1) == 0) then ! There is only one valid body recorded in this pair (this could happen due to restructuring of the kinship relationships, though it should be rare) + lflag = .false. + call pl%reset_kinship([idx_parent(1)]) + return + end if + idx_parent(2) = pl%kin(idx_parent(1))%child(nchild(1)) + nchild(1) = nchild(1) - 1 + nchild(2) = 0 + pl%kin(idx_parent(:))%nchild = nchild(:) + pl%kin(idx_parent(2))%parent = idx_parent(1) + end if + + colliders%mass(:) = pl%mass(idx_parent(:)) ! Note: This is meant to mass, not G*mass, as the collisional regime determination uses mass values that will be converted to Si + colliders%radius(:) = pl%radius(idx_parent(:)) + volume(:) = (4.0_DP / 3.0_DP) * PI * colliders%radius(:)**3 + + ! Group together the ids and indexes of each collisional parent and its children + do j = 1, 2 + allocate(parent_child_index_array(j)%idx(nchild(j)+ 1)) + allocate(parent_child_index_array(j)%id(nchild(j)+ 1)) + associate(idx_arr => parent_child_index_array(j)%idx, & + id_arr => parent_child_index_array(j)%id, & + ncj => nchild(j), & + pl => pl, & + plkinj => pl%kin(idx_parent(j))) + idx_arr(1) = idx_parent(j) + if (ncj > 0) idx_arr(2:ncj + 1) = plkinj%child(1:ncj) + id_arr(:) = pl%id(idx_arr(:)) + end associate + end do + + ! Consolidate the groups of collsional parents with any children they may have into a single "colliders%idx" index array + ncolliders = 2 + sum(nchild(:)) + allocate(colliders%idx(ncolliders)) + colliders%idx = [parent_child_index_array(1)%idx(:),parent_child_index_array(2)%idx(:)] + + colliders%ncoll = count(pl%lcollision(colliders%idx(:))) + colliders%idx = pack(colliders%idx(:), pl%lcollision(colliders%idx(:))) + colliders%L_spin(:,:) = 0.0_DP + colliders%Ip(:,:) = 0.0_DP + + ! Find the barycenter of each body along with its children, if it has any + do j = 1, 2 + colliders%xb(:, j) = pl%xh(:, idx_parent(j)) + cb%xb(:) + colliders%vb(:, j) = pl%vb(:, idx_parent(j)) + ! Assume principal axis rotation about axis corresponding to highest moment of inertia (3rd Ip) + if (param%lrotation) then + colliders%Ip(:, j) = colliders%mass(j) * pl%Ip(:, idx_parent(j)) + colliders%L_spin(:, j) = colliders%Ip(3, j) * colliders%radius(j)**2 * pl%rot(:, idx_parent(j)) + end if + + if (nchild(j) > 0) then + do i = 1, nchild(j) ! Loop over all children and take the mass weighted mean of the properties + idx_child = parent_child_index_array(j)%idx(i + 1) + if (.not. pl%lcollision(idx_child)) cycle + mchild = pl%mass(idx_child) + xchild(:) = pl%xh(:, idx_child) + cb%xb(:) + vchild(:) = pl%vb(:, idx_child) + volchild = (4.0_DP / 3.0_DP) * PI * pl%radius(idx_child)**3 + volume(j) = volume(j) + volchild + ! Get angular momentum of the child-parent pair and add that to the spin + ! Add the child's spin + if (param%lrotation) then + xcom(:) = (colliders%mass(j) * colliders%xb(:,j) + mchild * xchild(:)) / (colliders%mass(j) + mchild) + vcom(:) = (colliders%mass(j) * colliders%vb(:,j) + mchild * vchild(:)) / (colliders%mass(j) + mchild) + xc(:) = colliders%xb(:, j) - xcom(:) + vc(:) = colliders%vb(:, j) - vcom(:) + xcrossv(:) = xc(:) .cross. vc(:) + colliders%L_spin(:, j) = colliders%L_spin(:, j) + colliders%mass(j) * xcrossv(:) + + xc(:) = xchild(:) - xcom(:) + vc(:) = vchild(:) - vcom(:) + xcrossv(:) = xc(:) .cross. vc(:) + colliders%L_spin(:, j) = colliders%L_spin(:, j) + mchild * xcrossv(:) + + colliders%L_spin(:, j) = colliders%L_spin(:, j) + mchild * pl%Ip(3, idx_child) & + * pl%radius(idx_child)**2 & + * pl%rot(:, idx_child) + colliders%Ip(:, j) = colliders%Ip(:, j) + mchild * pl%Ip(:, idx_child) + end if + + ! Merge the child and parent + colliders%mass(j) = colliders%mass(j) + mchild + colliders%xb(:, j) = xcom(:) + colliders%vb(:, j) = vcom(:) + end do + end if + density(j) = colliders%mass(j) / volume(j) + colliders%radius(j) = (3 * volume(j) / (4 * PI))**(1.0_DP / 3.0_DP) + if (param%lrotation) colliders%Ip(:, j) = colliders%Ip(:, j) / colliders%mass(j) + end do + lflag = .true. + + xcom(:) = (colliders%mass(1) * colliders%xb(:, 1) + colliders%mass(2) * colliders%xb(:, 2)) / sum(colliders%mass(:)) + vcom(:) = (colliders%mass(1) * colliders%vb(:, 1) + colliders%mass(2) * colliders%vb(:, 2)) / sum(colliders%mass(:)) + mxc(:, 1) = colliders%mass(1) * (colliders%xb(:, 1) - xcom(:)) + mxc(:, 2) = colliders%mass(2) * (colliders%xb(:, 2) - xcom(:)) + vcc(:, 1) = colliders%vb(:, 1) - vcom(:) + vcc(:, 2) = colliders%vb(:, 2) - vcom(:) + colliders%L_orbit(:,:) = mxc(:,:) .cross. vcc(:,:) + + ! Destroy the kinship relationships for all members of this colliders%idx + call pl%reset_kinship(colliders%idx(:)) + + return + end function symba_collision_consolidate_colliders + + + module subroutine symba_collision_encounter_extract_collisions(self, system, param) + !! author: David A. Minton + !! + !! Processes the pl-pl encounter list remove only those encounters that led to a collision + !! + implicit none + ! Arguments + class(symba_plplenc), intent(inout) :: self !! SyMBA pl-pl encounter list + class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object + class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters + ! Internals + logical, dimension(:), allocatable :: lplpl_collision + logical, dimension(:), allocatable :: lplpl_unique_parent + integer(I4B), dimension(:), pointer :: plparent + integer(I4B), dimension(:), allocatable :: collision_idx, unique_parent_idx + integer(I4B) :: i, index_coll, ncollisions, nunique_parent, nplplenc + + select type (pl => system%pl) + class is (symba_pl) + associate(plplenc_list => self, idx1 => self%index1, idx2 => self%index2, plparent => pl%kin%parent) + nplplenc = plplenc_list%nenc + allocate(lplpl_collision(nplplenc)) + lplpl_collision(:) = plplenc_list%status(1:nplplenc) == COLLISION + if (.not.any(lplpl_collision)) return + ! Collisions have been detected in this step. So we need to determine which of them are between unique bodies. + + ! Get the subset of pl-pl encounters that lead to a collision + ncollisions = count(lplpl_collision(:)) + allocate(collision_idx(ncollisions)) + collision_idx = pack([(i, i=1, nplplenc)], lplpl_collision) + + ! Get the subset of collisions that involve a unique pair of parents + allocate(lplpl_unique_parent(ncollisions)) + + lplpl_unique_parent(:) = plparent(idx1(collision_idx(:))) /= plparent(idx2(collision_idx(:))) + nunique_parent = count(lplpl_unique_parent(:)) + allocate(unique_parent_idx(nunique_parent)) + unique_parent_idx = pack(collision_idx(:), lplpl_unique_parent(:)) + + ! Scrub all pl-pl collisions involving unique pairs of parents, which will remove all duplicates and leave behind + ! all pairs that have themselves as parents but are not part of the unique parent list. This can hapepn in rare cases + ! due to restructuring of parent/child relationships when there are large numbers of multi-body collisions in a single + ! step + lplpl_unique_parent(:) = .true. + do index_coll = 1, ncollisions + associate(ip1 => plparent(idx1(collision_idx(index_coll))), ip2 => plparent(idx2(collision_idx(index_coll)))) + lplpl_unique_parent(:) = .not. ( any(plparent(idx1(unique_parent_idx(:))) == ip1) .or. & + any(plparent(idx2(unique_parent_idx(:))) == ip1) .or. & + any(plparent(idx1(unique_parent_idx(:))) == ip2) .or. & + any(plparent(idx2(unique_parent_idx(:))) == ip2) ) + end associate + end do + + ! Reassemble collision index list to include only those containing the unique pairs of parents, plus all the non-unique pairs that don't + ! contain a parent body on the unique parent list. + ncollisions = nunique_parent + count(lplpl_unique_parent) + collision_idx = [unique_parent_idx(:), pack(collision_idx(:), lplpl_unique_parent(:))] + + ! Create a mask that contains only the pl-pl encounters that did not result in a collision, and then discard them + lplpl_collision(:) = .false. + lplpl_collision(collision_idx(:)) = .true. + call plplenc_list%spill(system%plplcollision_list, lplpl_collision, ldestructive=.true.) ! Extract any encounters that are not collisions from the list. + end associate + end select + + return + end subroutine symba_collision_encounter_extract_collisions + + + module subroutine symba_collision_make_colliders_pl(self, idx) + !! author: Jennifer L.L. Pouplin, Carlisle A. wishard, and David A. Minton + !! + !! When a single body is involved in more than one collision in a single step, it becomes part of a colliders%idx. + !! The largest body involved in a multi-body collision is the "parent" and all bodies that collide with it are its "children," + !! including those that collide with the children. + !! + !! Adapted from David E. Kaufmann's Swifter routine symba_merge_pl.f90 + !! + !! Adapted from Hal Levison's Swift routine symba5_merge.f + implicit none + ! Arguments + class(symba_pl), intent(inout) :: self !! SyMBA massive body object + integer(I4B), dimension(2), intent(in) :: idx !! Array holding the indices of the two bodies involved in the collision + ! Internals + integer(I4B) :: i, j, index_parent, index_child, p1, p2 + integer(I4B) :: nchild_inherit, nchild_orig, nchild_new + integer(I4B), dimension(:), allocatable :: temp + + associate(pl => self) + p1 = pl%kin(idx(1))%parent + p2 = pl%kin(idx(2))%parent + if (p1 == p2) return ! This is a collision between to children of a shared parent. We will ignore it. + + if (pl%mass(p1) > pl%mass(p2)) then + index_parent = p1 + index_child = p2 + else + index_parent = p2 + index_child = p1 + end if + + ! Expand the child array (or create it if necessary) and copy over the previous lists of children + nchild_orig = pl%kin(index_parent)%nchild + nchild_inherit = pl%kin(index_child)%nchild + nchild_new = nchild_orig + nchild_inherit + 1 + allocate(temp(nchild_new)) + + if (nchild_orig > 0) temp(1:nchild_orig) = pl%kin(index_parent)%child(1:nchild_orig) + ! Find out if the child body has any children of its own. The new parent wil inherit these children + if (nchild_inherit > 0) then + temp(nchild_orig+1:nchild_orig+nchild_inherit) = pl%kin(index_child)%child(1:nchild_inherit) + do i = 1, nchild_inherit + j = pl%kin(index_child)%child(i) + ! Set the childrens' parent to the new parent + pl%kin(j)%parent = index_parent + end do + end if + call pl%reset_kinship([index_child]) + ! Add the new child to its parent + pl%kin(index_child)%parent = index_parent + temp(nchild_new) = index_child + ! Save the new child array to the parent + pl%kin(index_parent)%nchild = nchild_new + call move_alloc(from=temp, to=pl%kin(index_parent)%child) + end associate + + return + end subroutine symba_collision_make_colliders_pl + + + subroutine symba_collision_mergeaddsub(system, param, colliders, frag, status) + !! author: David A. Minton + !! + !! Fills the pl_discards and pl_adds with removed and added bodies + !! + implicit none + ! Arguments + class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object + class(symba_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions + class(fraggle_colliders), intent(inout) :: colliders !! Fraggle colliders object + class(fraggle_fragments), intent(inout) :: frag !! Fraggle fragmentation system object + integer(I4B), intent(in) :: status !! Status flag to assign to adds + ! Internals + integer(I4B) :: i, ibiggest, ismallest, iother, nstart, nend, ncolliders, nfrag + logical, dimension(system%pl%nbody) :: lmask + class(symba_pl), allocatable :: plnew, plsub + character(*), parameter :: FRAGFMT = '("Newbody",I0.7)' + character(len=NAMELEN) :: newname + + select type(pl => system%pl) + class is (symba_pl) + select type(pl_discards => system%pl_discards) + class is (symba_merger) + associate(info => pl%info, pl_adds => system%pl_adds, cb => system%cb, npl => pl%nbody) + ! Add the colliders%idx bodies to the subtraction list + ncolliders = colliders%ncoll + nfrag = frag%nbody + + param%maxid_collision = max(param%maxid_collision, maxval(system%pl%info(:)%collision_id)) + param%maxid_collision = param%maxid_collision + 1 + + ! Setup new bodies + allocate(plnew, mold=pl) + call plnew%setup(nfrag, param) + ibiggest = colliders%idx(maxloc(pl%Gmass(colliders%idx(:)), dim=1)) + ismallest = colliders%idx(minloc(pl%Gmass(colliders%idx(:)), dim=1)) + + ! Copy over identification, information, and physical properties of the new bodies from the fragment list + plnew%id(1:nfrag) = frag%id(1:nfrag) + plnew%xb(:, 1:nfrag) = frag%xb(:, 1:nfrag) + plnew%vb(:, 1:nfrag) = frag%vb(:, 1:nfrag) + call pl%vb2vh(cb) + call pl%xh2xb(cb) + do i = 1, nfrag + plnew%xh(:,i) = frag%xb(:, i) - cb%xb(:) + plnew%vh(:,i) = frag%vb(:, i) - cb%vb(:) + end do + plnew%mass(1:nfrag) = frag%mass(1:nfrag) + plnew%Gmass(1:nfrag) = param%GU * frag%mass(1:nfrag) + plnew%radius(1:nfrag) = frag%radius(1:nfrag) + plnew%density(1:nfrag) = frag%mass(1:nfrag) / frag%radius(1:nfrag) + call plnew%set_rhill(cb) + + select case(status) + case(DISRUPTION) + plnew%status(1:nfrag) = NEW_PARTICLE + do i = 1, nfrag + write(newname, FRAGFMT) frag%id(i) + call plnew%info(i)%set_value(origin_type="Disruption", origin_time=system%t, name=newname, & + origin_xh=plnew%xh(:,i), & + origin_vh=plnew%vh(:,i), collision_id=param%maxid_collision) + end do + do i = 1, ncolliders + if (colliders%idx(i) == ibiggest) then + iother = ismallest + else + iother = ibiggest + end if + call pl%info(colliders%idx(i))%set_value(status="Disruption", discard_time=system%t, & + discard_xh=pl%xh(:,i), discard_vh=pl%vh(:,i), discard_body_id=iother) + end do + case(SUPERCATASTROPHIC) + plnew%status(1:nfrag) = NEW_PARTICLE + do i = 1, nfrag + write(newname, FRAGFMT) frag%id(i) + call plnew%info(i)%set_value(origin_type="Supercatastrophic", origin_time=system%t, name=newname, & + origin_xh=plnew%xh(:,i), origin_vh=plnew%vh(:,i), & + collision_id=param%maxid_collision) + end do + do i = 1, ncolliders + if (colliders%idx(i) == ibiggest) then + iother = ismallest + else + iother = ibiggest + end if + call pl%info(colliders%idx(i))%set_value(status="Supercatastrophic", discard_time=system%t, & + discard_xh=pl%xh(:,i), discard_vh=pl%vh(:,i), & + discard_body_id=iother) + end do + case(HIT_AND_RUN_DISRUPT) + call plnew%info(1)%copy(pl%info(ibiggest)) + plnew%status(1) = OLD_PARTICLE + do i = 2, nfrag + write(newname, FRAGFMT) frag%id(i) + call plnew%info(i)%set_value(origin_type="Hit and run fragment", origin_time=system%t, name=newname, & + origin_xh=plnew%xh(:,i), origin_vh=plnew%vh(:,i), & + collision_id=param%maxid_collision) + end do + do i = 1, ncolliders + if (colliders%idx(i) == ibiggest) cycle + iother = ibiggest + call pl%info(colliders%idx(i))%set_value(status="Hit and run fragmention", discard_time=system%t, & + discard_xh=pl%xh(:,i), discard_vh=pl%vh(:,i), & + discard_body_id=iother) + end do + case(MERGED) + call plnew%info(1)%copy(pl%info(ibiggest)) + plnew%status(1) = OLD_PARTICLE + do i = 1, ncolliders + if (colliders%idx(i) == ibiggest) cycle + + iother = ibiggest + call pl%info(colliders%idx(i))%set_value(status="MERGED", discard_time=system%t, discard_xh=pl%xh(:,i), & + discard_vh=pl%vh(:,i), discard_body_id=iother) + end do + end select + + if (param%lrotation) then + plnew%Ip(:, 1:nfrag) = frag%Ip(:, 1:nfrag) + plnew%rot(:, 1:nfrag) = frag%rot(:, 1:nfrag) + end if + + ! if (param%ltides) then + ! plnew%Q = pl%Q(ibiggest) + ! plnew%k2 = pl%k2(ibiggest) + ! plnew%tlag = pl%tlag(ibiggest) + ! end if + + !Copy over or set integration parameters for new bodies + plnew%lcollision(1:nfrag) = .false. + plnew%ldiscard(1:nfrag) = .false. + plnew%levelg(1:nfrag) = pl%levelg(ibiggest) + plnew%levelm(1:nfrag) = pl%levelm(ibiggest) + + ! Log the properties of the new bodies + call fraggle_io_log_pl(plnew, param) + + ! Append the new merged body to the list + nstart = pl_adds%nbody + 1 + nend = pl_adds%nbody + nfrag + call pl_adds%append(plnew, lsource_mask=[(.true., i=1, nfrag)]) + ! Record how many bodies were added in this event + pl_adds%ncomp(nstart:nend) = plnew%nbody + + ! Add the discarded bodies to the discard list + pl%status(colliders%idx(:)) = MERGED + pl%ldiscard(colliders%idx(:)) = .true. + pl%lcollision(colliders%idx(:)) = .true. + lmask(:) = .false. + lmask(colliders%idx(:)) = .true. + + call plnew%setup(0, param) + deallocate(plnew) + + allocate(plsub, mold=pl) + call pl%spill(plsub, lmask, ldestructive=.false.) + + nstart = pl_discards%nbody + 1 + nend = pl_discards%nbody + ncolliders + call pl_discards%append(plsub, lsource_mask=[(.true., i = 1, ncolliders)]) + + ! Record how many bodies were subtracted in this event + pl_discards%ncomp(nstart:nend) = ncolliders + + call plsub%setup(0, param) + deallocate(plsub) + end associate + end select + end select + + return + end subroutine symba_collision_mergeaddsub + + + module subroutine symba_collision_resolve_fragmentations(self, system, param) + !! author: David A. Minton + !! + !! Process list of collisions, determine the collisional regime, and then create fragments. + !! + implicit none + ! Arguments + class(symba_plplenc), intent(inout) :: self !! SyMBA pl-pl encounter list + class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object + class(symba_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions + ! Internals + ! Internals + integer(I4B), dimension(2) :: idx_parent !! Index of the two bodies considered the "parents" of the collision + logical :: lgoodcollision + integer(I4B) :: i + type(fraggle_colliders) :: colliders !! Fraggle colliders object + type(fraggle_fragments) :: frag !! Fraggle fragmentation system object + + associate(plplcollision_list => self, ncollisions => self%nenc, idx1 => self%index1, idx2 => self%index2) + select type(pl => system%pl) + class is (symba_pl) + select type (cb => system%cb) + class is (symba_cb) + do i = 1, ncollisions + idx_parent(1) = pl%kin(idx1(i))%parent + idx_parent(2) = pl%kin(idx2(i))%parent + lgoodcollision = symba_collision_consolidate_colliders(pl, cb, param, idx_parent, colliders) + if ((.not. lgoodcollision) .or. any(pl%status(idx_parent(:)) /= COLLISION)) cycle + + call colliders%regime(frag, system, param) + + select case (frag%regime) + case (COLLRESOLVE_REGIME_DISRUPTION, COLLRESOLVE_REGIME_SUPERCATASTROPHIC) + plplcollision_list%status(i) = symba_collision_casedisruption(system, param, colliders, frag) + case (COLLRESOLVE_REGIME_HIT_AND_RUN) + plplcollision_list%status(i) = symba_collision_casehitandrun(system, param, colliders, frag) + case (COLLRESOLVE_REGIME_MERGE, COLLRESOLVE_REGIME_GRAZE_AND_MERGE) + plplcollision_list%status(i) = symba_collision_casemerge(system, param, colliders, frag) + case default + write(*,*) "Error in symba_collision, unrecognized collision regime" + call util_exit(FAILURE) + end select + end do + end select + end select + end associate + + return + end subroutine symba_collision_resolve_fragmentations + + + module subroutine symba_collision_resolve_mergers(self, system, param) + !! author: David A. Minton + !! + !! Process list of collisions and merge colliding bodies together. + !! + implicit none + ! Arguments + class(symba_plplenc), intent(inout) :: self !! SyMBA pl-pl encounter list + class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object + class(symba_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions + ! Internals + integer(I4B), dimension(2) :: idx_parent !! Index of the two bodies considered the "parents" of the collision + logical :: lgoodcollision + integer(I4B) :: i + type(fraggle_colliders) :: colliders !! Fraggle colliders object + type(fraggle_fragments) :: frag !! Fraggle fragmentation system object + + associate(plplcollision_list => self, ncollisions => self%nenc, idx1 => self%index1, idx2 => self%index2) + select type(pl => system%pl) + class is (symba_pl) + select type(cb => system%cb) + class is (symba_cb) + do i = 1, ncollisions + idx_parent(1) = pl%kin(idx1(i))%parent + idx_parent(2) = pl%kin(idx2(i))%parent + lgoodcollision = symba_collision_consolidate_colliders(pl, cb, param, idx_parent, colliders) + if (.not. lgoodcollision) cycle + if (any(pl%status(idx_parent(:)) /= COLLISION)) cycle ! One of these two bodies has already been resolved + + frag%regime = COLLRESOLVE_REGIME_MERGE + frag%mtot = sum(colliders%mass(:)) + frag%mass_dist(1) = frag%mtot + frag%mass_dist(2) = 0.0_DP + frag%mass_dist(3) = 0.0_DP + frag%xbcom(:) = (colliders%mass(1) * colliders%xb(:,1) + colliders%mass(2) * colliders%xb(:,2)) / frag%mtot + frag%vbcom(:) = (colliders%mass(1) * colliders%vb(:,1) + colliders%mass(2) * colliders%vb(:,2)) / frag%mtot + plplcollision_list%status(i) = symba_collision_casemerge(system, param, colliders, frag) + end do + end select + end select + end associate + + return + end subroutine symba_collision_resolve_mergers + + + module subroutine symba_collision_resolve_plplenc(self, system, param, t, dt, irec) + !! author: David A. Minton + !! + !! Process the pl-pl collision list, then modifiy the massive bodies based on the outcome of the collision + !! + implicit none + ! Arguments + class(symba_plplenc), intent(inout) :: self !! SyMBA pl-pl encounter list + class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions + real(DP), intent(in) :: t !! Current simulation time + real(DP), intent(in) :: dt !! Current simulation step size + integer(I4B), intent(in) :: irec !! Current recursion level + ! Internals + real(DP) :: Eorbit_before, Eorbit_after + logical :: lplpl_collision + character(len=STRMAX) :: timestr + class(symba_parameters), allocatable :: tmp_param + + associate(plplenc_list => self, plplcollision_list => system%plplcollision_list) + select type(pl => system%pl) + class is (symba_pl) + select type(param) + class is (symba_parameters) + if (plplcollision_list%nenc == 0) return ! No collisions to resolve + ! Make sure that the heliocentric and barycentric coordinates are consistent with each other + call pl%vb2vh(system%cb) + call pl%xh2xb(system%cb) + + ! Get the energy before the collision is resolved + if (param%lenergy) then + call system%get_energy_and_momentum(param) + Eorbit_before = system%te + end if + + do + write(timestr,*) t + call io_log_one_message(FRAGGLE_LOG_OUT, "") + call io_log_one_message(FRAGGLE_LOG_OUT, "***********************************************************" // & + "***********************************************************") + call io_log_one_message(FRAGGLE_LOG_OUT, "Collision between massive bodies detected at time t = " // & + trim(adjustl(timestr))) + call io_log_one_message(FRAGGLE_LOG_OUT, "***********************************************************" // & + "***********************************************************") + allocate(tmp_param, source=param) + if (param%lfragmentation) then + call plplcollision_list%resolve_fragmentations(system, param) + else + call plplcollision_list%resolve_mergers(system, param) + end if + + ! Destroy the collision list now that the collisions are resolved + call plplcollision_list%setup(0_I8B) + + if ((system%pl_adds%nbody == 0) .and. (system%pl_discards%nbody == 0)) exit + + ! Save the add/discard information to file + call system%write_discard(tmp_param) + + ! Rearrange the arrays: Remove discarded bodies, add any new bodies, resort, and recompute all indices and encounter lists + call pl%rearray(system, tmp_param) + + ! Destroy the add/discard list so that we don't append the same body multiple times if another collision is detected + call system%pl_discards%setup(0, param) + call system%pl_adds%setup(0, param) + deallocate(tmp_param) + + ! Check whether or not any of the particles that were just added are themselves in a collision state. This will generate a new plplcollision_list + lplpl_collision = plplenc_list%collision_check(system, param, t, dt, irec) + + if (.not.lplpl_collision) exit + end do + + if (param%lenergy) then + call system%get_energy_and_momentum(param) + Eorbit_after = system%te + system%Ecollisions = system%Ecollisions + (Eorbit_after - Eorbit_before) + end if + + end select + end select + end associate + + return + end subroutine symba_collision_resolve_plplenc + + + module subroutine symba_collision_resolve_pltpenc(self, system, param, t, dt, irec) + !! author: David A. Minton + !! + !! Process the pl-tp collision list, then modifiy the massive bodies based on the outcome of the collision + !! + implicit none + ! Arguments + class(symba_pltpenc), intent(inout) :: self !! SyMBA pl-pl encounter list + class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions + real(DP), intent(in) :: t !! Current simulation tim + real(DP), intent(in) :: dt !! Current simulation step size + integer(I4B), intent(in) :: irec !! Current recursion level + + ! Make sure coordinate systems are all synced up due to being inside the recursion at this point + call system%pl%vb2vh(system%cb) + call system%tp%vb2vh(system%cb%vb) + call system%pl%b2h(system%cb) + call system%tp%b2h(system%cb) + + ! Discard the collider + call system%tp%discard(system, param) + + return + end subroutine symba_collision_resolve_pltpenc + +end submodule s_symba_collision \ No newline at end of file diff --git a/src/symba/symba_collision.f90 b/src/symba/symba_collision.f90 index 1423adc7e..e839af1de 100644 --- a/src/symba/symba_collision.f90 +++ b/src/symba/symba_collision.f90 @@ -761,7 +761,7 @@ subroutine symba_collision_mergeaddsub(system, param, colliders, frag, status) plnew%status(1:nfrag) = NEW_PARTICLE do i = 1, nfrag write(newname, FRAGFMT) frag%id(i) - call plnew%info(i)%set_value(origin_type="Disruption", origin_time=param%t, name=newname, & + call plnew%info(i)%set_value(origin_type="Disruption", origin_time=system%t, name=newname, & origin_xh=plnew%xh(:,i), & origin_vh=plnew%vh(:,i), collision_id=param%maxid_collision) end do @@ -771,14 +771,14 @@ subroutine symba_collision_mergeaddsub(system, param, colliders, frag, status) else iother = ibiggest end if - call pl%info(colliders%idx(i))%set_value(status="Disruption", discard_time=param%t, & + 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) end do case(SUPERCATASTROPHIC) plnew%status(1:nfrag) = NEW_PARTICLE do i = 1, nfrag write(newname, FRAGFMT) frag%id(i) - call plnew%info(i)%set_value(origin_type="Supercatastrophic", origin_time=param%t, name=newname, & + 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), & collision_id=param%maxid_collision) end do @@ -788,7 +788,7 @@ subroutine symba_collision_mergeaddsub(system, param, colliders, frag, status) else iother = ibiggest end if - call pl%info(colliders%idx(i))%set_value(status="Supercatastrophic", discard_time=param%t, & + 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_body_id=iother) end do @@ -797,14 +797,14 @@ subroutine symba_collision_mergeaddsub(system, param, colliders, frag, status) plnew%status(1) = OLD_PARTICLE do i = 2, nfrag write(newname, FRAGFMT) frag%id(i) - call plnew%info(i)%set_value(origin_type="Hit and run fragment", origin_time=param%t, name=newname, & + 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), & collision_id=param%maxid_collision) end do do i = 1, ncolliders if (colliders%idx(i) == ibiggest) cycle iother = ibiggest - call pl%info(colliders%idx(i))%set_value(status="Hit and run fragmention", discard_time=param%t, & + 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_body_id=iother) end do @@ -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=param%t, discard_xh=pl%xh(:,i), & + call pl%info(colliders%idx(i))%set_value(status="MERGED", discard_time=system%t, discard_xh=pl%xh(:,i), & discard_vh=pl%vh(:,i), discard_body_id=iother) end do end select @@ -1019,7 +1019,6 @@ module subroutine symba_collision_resolve_plplenc(self, system, param, t, dt, ir call io_log_one_message(FRAGGLE_LOG_OUT, "***********************************************************" // & "***********************************************************") allocate(tmp_param, source=param) - tmp_param%t = t if (param%lfragmentation) then call plplcollision_list%resolve_fragmentations(system, param) else diff --git a/src/symba/symba_discard.f90 b/src/symba/symba_discard.f90 index f00b222cb..76bcbaf41 100644 --- a/src/symba/symba_discard.f90 +++ b/src/symba/symba_discard.f90 @@ -44,7 +44,7 @@ subroutine symba_discard_cb_pl(pl, system, param) pl%lcollision(i) = .false. pl%status(i) = DISCARDED_RMAX write(idstr, *) pl%id(i) - write(timestr, *) param%t + write(timestr, *) system%t write(message, *) trim(adjustl(pl%info(i)%name)) // " (" // trim(adjustl(idstr)) // ")" // & " too far from the central body at t = " // trim(adjustl(timestr)) call io_log_one_message(FRAGGLE_LOG_OUT, "") @@ -54,14 +54,14 @@ 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=param%t, discard_xh=pl%xh(:,i), & + call pl%info(i)%set_value(status="DISCARDED_RMAX", discard_time=system%t, discard_xh=pl%xh(:,i), & discard_vh=pl%vh(:,i)) else if ((param%rmin >= 0.0_DP) .and. (rh2 < rmin2)) then pl%ldiscard(i) = .true. pl%lcollision(i) = .false. pl%status(i) = DISCARDED_RMIN write(idstr, *) pl%id(i) - write(timestr, *) param%t + write(timestr, *) system%t write(message, *) trim(adjustl(pl%info(i)%name)) // " (" // trim(adjustl(idstr)) // ")" // & " too close to the central body at t = " // trim(adjustl(timestr)) call io_log_one_message(FRAGGLE_LOG_OUT, "") @@ -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=param%t, discard_xh=pl%xh(:,i), & + call pl%info(i)%set_value(status="DISCARDED_RMIN", discard_time=system%t, discard_xh=pl%xh(:,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)) @@ -82,7 +82,7 @@ subroutine symba_discard_cb_pl(pl, system, param) pl%lcollision(i) = .false. pl%status(i) = DISCARDED_RMAXU write(idstr, *) pl%id(i) - write(timestr, *) param%t + write(timestr, *) system%t write(message, *) trim(adjustl(pl%info(i)%name)) // " (" // trim(adjustl(idstr)) // ")" // & " is unbound and too far from barycenter at t = " // trim(adjustl(timestr)) call io_log_one_message(FRAGGLE_LOG_OUT, "") @@ -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=param%t, discard_xh=pl%xh(:,i), & + call pl%info(i)%set_value(status="DISCARDED_RMAXU", discard_time=system%t, discard_xh=pl%xh(:,i), & discard_vh=pl%vh(:,i)) end if end if @@ -325,11 +325,11 @@ subroutine symba_discard_peri_pl(pl, system, param) pl%ldiscard(i) = .true. pl%lcollision(i) = .false. pl%status(i) = DISCARDED_PERI - write(timestr, *) param%t + write(timestr, *) system%t write(idstr, *) pl%id(i) write(*, *) trim(adjustl(pl%info(i)%name)) // " (" // trim(adjustl(idstr)) // & ") perihelion distance too small at t = " // trim(adjustl(timestr)) - call pl%info(i)%set_value(status="DISCARDED_PERI", discard_time=param%t, & + 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) end if end if diff --git a/src/walltime/walltime.f90 b/src/walltime/walltime.f90 index 104b63d95..491a2e478 100644 --- a/src/walltime/walltime.f90 +++ b/src/walltime/walltime.f90 @@ -314,7 +314,6 @@ module subroutine walltime_interaction_time_this_loop(self, param, ninteractions end select self%is_on = .true. - write(tstr,*) param%t select case(self%stage) case(1) self%stage1_ninteractions = ninteractions From 74e5fdec2fe4777316ac6e2e226202a46e2fdc7f Mon Sep 17 00:00:00 2001 From: David A Minton Date: Thu, 1 Dec 2022 13:21:05 -0500 Subject: [PATCH 168/569] Simplified the driver program --- src/main/swiftest_driver.f90 | 11 +++++------ 1 file changed, 5 insertions(+), 6 deletions(-) diff --git a/src/main/swiftest_driver.f90 b/src/main/swiftest_driver.f90 index 1ec5df880..3737b4075 100644 --- a/src/main/swiftest_driver.f90 +++ b/src/main/swiftest_driver.f90 @@ -28,7 +28,6 @@ program swiftest_driver 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 - real(DP) :: old_t_final = 0.0_DP !! Output time at which writing should start, in order to prevent duplicate lines being written for restarts type(walltimer) :: integration_timer !! Object used for computing elapsed wall time real(DP) :: tfrac type(progress_bar) :: pbar !! Object used to print out a progress bar @@ -92,17 +91,16 @@ program swiftest_driver allocate(swiftest_storage(dump_cadence) :: system_history) idump = dump_cadence - ! Prevent duplicate frames from being written if this is a restarted run + ! 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 - old_t_final = nbody_system%get_old_t_final(param) + if (param%lenergy) call nbody_system%conservation_report(param, lterminal=.true.) else - old_t_final = t0 if (param%lenergy) call nbody_system%conservation_report(param, lterminal=.false.) ! This will save the initial values of energy and momentum - if (istep_out > 0) call nbody_system%write_frame(param) + call nbody_system%write_frame(param) end if write(display_unit, *) " *************** Main Loop *************** " - if (param%lrestart .and. param%lenergy) call nbody_system%conservation_report(param, lterminal=.true.) + if (display_style == "PROGRESS") then call pbar%reset(nloops) write(pbarmessage,fmt=pbarfmt) t0, tstop @@ -111,6 +109,7 @@ program swiftest_driver write(*,*) "SWIFTEST START " // trim(adjustl(param%integrator)) call nbody_system%compact_output(param,integration_timer) end if + do iloop = istart, nloops !> Step the system forward in time call integration_timer%start() From 561c0b87053ac48ac9e59514f9a9bbe5aa05664a Mon Sep 17 00:00:00 2001 From: David A Minton Date: Thu, 1 Dec 2022 13:34:10 -0500 Subject: [PATCH 169/569] Simplified swiftest_driver even further. No need to explicitly call the dealloc method on the nbody_system, all possible types have finalizers built in that do that automatically --- src/io/io.f90 | 5 ++++- src/main/swiftest_driver.f90 | 6 ++---- src/symba/symba_util.f90 | 2 ++ 3 files changed, 8 insertions(+), 5 deletions(-) diff --git a/src/io/io.f90 b/src/io/io.f90 index f77278424..129f1e82d 100644 --- a/src/io/io.f90 +++ b/src/io/io.f90 @@ -283,7 +283,10 @@ module subroutine io_dump_system_storage(self, param) iloop_start = param%iloop - param%istep_out * param%dump_cadence + 1_I8B do i = 1_I8B, param%dump_cadence param%ioutput = int(iloop_start / param%istep_out, kind=I8B) + i - call self%frame(i)%system%write_frame(param) + if (allocated(self%frame(i)%system)) then + call self%frame(i)%system%write_frame(param) + deallocate(self%frame(i)%system) + end if end do return diff --git a/src/main/swiftest_driver.f90 b/src/main/swiftest_driver.f90 index 3737b4075..8845be170 100644 --- a/src/main/swiftest_driver.f90 +++ b/src/main/swiftest_driver.f90 @@ -161,12 +161,10 @@ program swiftest_driver 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)) end associate - call nbody_system%dealloc() - call util_exit(SUCCESS) - - stop end program swiftest_driver diff --git a/src/symba/symba_util.f90 b/src/symba/symba_util.f90 index 0087c24e4..f0f300bc1 100644 --- a/src/symba/symba_util.f90 +++ b/src/symba/symba_util.f90 @@ -482,6 +482,7 @@ module subroutine symba_util_final_pl(self) return end subroutine symba_util_final_pl + module subroutine symba_util_final_system(self) !! author: David A. Minton !! @@ -495,6 +496,7 @@ module subroutine symba_util_final_system(self) return end subroutine symba_util_final_system + module subroutine symba_util_final_tp(self) !! author: David A. Minton !! From 7bda5cadfcb8d2558cdea70a469b658dff0c572c Mon Sep 17 00:00:00 2001 From: David A Minton Date: Thu, 1 Dec 2022 13:39:13 -0500 Subject: [PATCH 170/569] Cleaned up io_dump_system_storage and wrote more verbose comments --- src/io/io.f90 | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/src/io/io.f90 b/src/io/io.f90 index 129f1e82d..7ee5b9cbd 100644 --- a/src/io/io.f90 +++ b/src/io/io.f90 @@ -269,10 +269,14 @@ module subroutine io_dump_system(self, param) return end subroutine io_dump_system + module subroutine io_dump_system_storage(self, param) !! author: David A. Minton !! - !! Dumps the time history of the simulation to file + !! Dumps the time history of the simulation to file. Each time it writes a frame to file, it deallocates the system + !! object from inside. It will only dump frames with systems that are allocated, so this can be called at the end of + !! a simulation for cases when the number of saved frames is not equal to the dump cadence (for instance, if the dump + !! cadence is not divisible by the total number of loops). implicit none ! Arguments class(swiftest_storage(*)), intent(inout) :: self !! Swiftest simulation history storage object @@ -282,8 +286,8 @@ module subroutine io_dump_system_storage(self, param) iloop_start = param%iloop - param%istep_out * param%dump_cadence + 1_I8B do i = 1_I8B, param%dump_cadence - param%ioutput = int(iloop_start / param%istep_out, kind=I8B) + i 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) end if From a0032559bf4edcd11c2041113690098e4fce3544 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Thu, 1 Dec 2022 13:42:05 -0500 Subject: [PATCH 171/569] Corrected the computation of the width of the time report output variable so that it has only the number of significant digits needed --- python/swiftest/swiftest/simulation_class.py | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/python/swiftest/swiftest/simulation_class.py b/python/swiftest/swiftest/simulation_class.py index 012aeddbe..ec4c9b6cd 100644 --- a/python/swiftest/swiftest/simulation_class.py +++ b/python/swiftest/swiftest/simulation_class.py @@ -382,7 +382,7 @@ def _type_scrub(output_data): process_output = False noutput = int((self.param['TSTOP'] - self.param['T0']) / self.param['DT']) iloop = int((self.param['TSTART'] - self.param['T0']) / self.param['DT']) - twidth = int(np.ceil(np.log10(self.param['TSTOP']/self.param['DT']))) + twidth = int(np.ceil(np.log10(self.param['TSTOP']/(self.param['DT'] * self.param['ISTEP_OUT'])))) pre_message = f"Time: {self.param['TSTART']:.{twidth}e} / {self.param['TSTOP']:.{twidth}e} {self.TU_name} " post_message = f"npl: {self.data['npl'].values[0]} ntp: {self.data['ntp'].values[0]}" if "nplm" in self.data: From 8d29013c7951d84d99bc6d849801a2763bd271e0 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Thu, 1 Dec 2022 14:11:55 -0500 Subject: [PATCH 172/569] Fixed computation of the dump_cadence when the user passes 0 (only dump at the end) --- src/main/swiftest_driver.f90 | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/src/main/swiftest_driver.f90 b/src/main/swiftest_driver.f90 index 8845be170..a9af0cc71 100644 --- a/src/main/swiftest_driver.f90 +++ b/src/main/swiftest_driver.f90 @@ -41,7 +41,6 @@ program swiftest_driver character(*), parameter :: symbacompactfmt = '(";NPLM",ES22.15,$)' type(swiftest_storage(nframes=:)), allocatable :: system_history - call io_get_args(integrator, param_file_name, display_style) !> Read in the user-defined parameters file and the initial conditions of the system @@ -87,7 +86,7 @@ program swiftest_driver ioutput = int(istart / istep_out, kind=I8B) ! Set up system storage for intermittent file dumps - if (dump_cadence == 0) dump_cadence = nloops + 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 From e5e7eddf286ca3250b5355168939c50c964b64e1 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Thu, 1 Dec 2022 14:17:51 -0500 Subject: [PATCH 173/569] Set default dump_cadence to 10 because of how much it improves performance --- python/swiftest/swiftest/simulation_class.py | 7 +++---- src/modules/swiftest_classes.f90 | 2 +- 2 files changed, 4 insertions(+), 5 deletions(-) diff --git a/python/swiftest/swiftest/simulation_class.py b/python/swiftest/swiftest/simulation_class.py index ec4c9b6cd..aad511e92 100644 --- a/python/swiftest/swiftest/simulation_class.py +++ b/python/swiftest/swiftest/simulation_class.py @@ -63,7 +63,6 @@ def __init__(self,read_param: bool = False, read_old_output_file: bool = False, inside the current working directory, which can be changed by passing `param_file` as an argument. - The argument has an equivalent parameter or set of parameters in the parameter input file. 3. Default values (see below) - read_old_output_file : bool, default False If true, read in a pre-existing binary input file given by the argument `output_file_name` if it exists. Parameter input file equivalent: None @@ -98,7 +97,7 @@ def __init__(self,read_param: bool = False, read_old_output_file: bool = False, Parameter input file equivalent: `ISTEP_OUT` dump_cadence : int, optional The number of output steps (given by `istep_out`) between when the saved data is dumped to a file. Setting it to 0 - is equivalent to only dumping data to file at the end of the simulation. + is equivalent to only dumping data to file at the end of the simulation. Default value is 10. Parameter input file equivalent: `DUMP_CADENCE` tstep_out : float, optional The approximate time between when outputs are written to file. Passing this computes @@ -547,7 +546,7 @@ def set_simulation_time(self, `istep_out = floor(tstep_out/dt)`. *Note*: only `istep_out` or `toutput` can be set. dump_cadence : int, optional The number of output steps (given by `istep_out`) between when the saved data is dumped to a file. Setting it to 0 - is equivalent to only dumping data to file at the end of the simulation. + is equivalent to only dumping data to file at the end of the simulation. Default value is 10. Parameter input file equivalent: `DUMP_CADENCE` verbose: bool, optional If passed, it will override the Simulation object's verbose flag @@ -725,7 +724,7 @@ def set_parameter(self, verbose: bool = True, **kwargs): "dt": None, "istep_out": 1, "tstep_out": None, - "dump_cadence": 1, + "dump_cadence": 10, "init_cond_file_type": "NETCDF_DOUBLE", "init_cond_file_name": None, "init_cond_format": "EL", diff --git a/src/modules/swiftest_classes.f90 b/src/modules/swiftest_classes.f90 index 878b5d308..8170caf8c 100644 --- a/src/modules/swiftest_classes.f90 +++ b/src/modules/swiftest_classes.f90 @@ -53,7 +53,7 @@ module swiftest_classes character(STRMAX) :: out_type = "NETCDF_DOUBLE" !! Binary format of output file character(STRMAX) :: out_form = "XVEL" !! Data to write to output file character(STRMAX) :: out_stat = 'NEW' !! Open status for output binary file - integer(I4B) :: dump_cadence = 1 !! Number of output steps between dumping simulation data to file + integer(I4B) :: dump_cadence = 10 !! Number of output steps between dumping simulation data to file real(DP) :: rmin = -1.0_DP !! Minimum heliocentric radius for test particle real(DP) :: rmax = -1.0_DP !! Maximum heliocentric radius for test particle real(DP) :: rmaxu = -1.0_DP !! Maximum unbound heliocentric radius for test particle From cc6428c02736db6586e5cd4c9f7390b20953d8de Mon Sep 17 00:00:00 2001 From: David A Minton Date: Thu, 1 Dec 2022 15:54:25 -0500 Subject: [PATCH 174/569] Minor formatting tweak --- src/modules/swiftest_classes.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/modules/swiftest_classes.f90 b/src/modules/swiftest_classes.f90 index 8170caf8c..ab7000e36 100644 --- a/src/modules/swiftest_classes.f90 +++ b/src/modules/swiftest_classes.f90 @@ -32,7 +32,7 @@ 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) :: integrator = UNKNOWN_INTEGRATOR !! Symbolic name of the nbody integrator used character(STRMAX) :: param_file_name = "param.in" !! The default name of the parameter input file integer(I4B) :: maxid = -1 !! The current maximum particle id number integer(I4B) :: maxid_collision = 0 !! The current maximum collision id number From 49837389ff8f76b60a769175ca40bc495e486e68 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Thu, 1 Dec 2022 16:00:56 -0500 Subject: [PATCH 175/569] Minor formatting tweak --- src/modules/swiftest_classes.f90 | 160 +++++++++++++++---------------- 1 file changed, 80 insertions(+), 80 deletions(-) diff --git a/src/modules/swiftest_classes.f90 b/src/modules/swiftest_classes.f90 index ab7000e36..33d5aa79e 100644 --- a/src/modules/swiftest_classes.f90 +++ b/src/modules/swiftest_classes.f90 @@ -274,7 +274,7 @@ module swiftest_classes ! Massive body-specific concrete methods ! These are concrete because they are the same implemenation for all integrators procedure :: discard => discard_pl !! Placeholder method for discarding massive bodies - procedure :: flatten => util_flatten_eucl_plpl !! Sets up the (i, j) -> k indexing used for the single-loop blocking Euclidean distance matrix + procedure :: flatten => util_flatten_eucl_plpl !! Sets up the (i, j) -> k indexing used for the single-loop blocking Euclidean distance matrix procedure :: accel_int => kick_getacch_int_pl !! Compute direct cross (third) term heliocentric accelerations of massive bodies procedure :: accel_obl => obl_acc_pl !! Compute the barycentric accelerations of bodies due to the oblateness of the central body procedure :: setup => setup_pl !! A base constructor that sets the number of bodies and allocates and initializes all arrays @@ -341,33 +341,33 @@ module swiftest_classes !> An abstract class for a basic Swiftest nbody system type, abstract :: swiftest_nbody_system !! This superclass contains a minimial system of a set of test particles (tp), massive bodies (pl), and a central body (cb) - class(swiftest_cb), allocatable :: cb !! Central body data structure - class(swiftest_pl), allocatable :: pl !! Massive body data structure - class(swiftest_tp), allocatable :: tp !! Test particle data structure - class(swiftest_tp), allocatable :: tp_discards !! Discarded test particle data structure - class(swiftest_pl), allocatable :: pl_discards !! Discarded massive body particle data structure - real(DP) :: t = -1.0_DP !! Integration current time - real(DP) :: GMtot = 0.0_DP !! Total system mass - used for barycentric coordinate conversion - real(DP) :: ke_orbit = 0.0_DP !! System orbital kinetic energy - real(DP) :: ke_spin = 0.0_DP !! System spin kinetic energy - real(DP) :: pe = 0.0_DP !! System potential energy - real(DP) :: te = 0.0_DP !! System total energy - real(DP) :: oblpot = 0.0_DP !! System potential energy due to oblateness of the central body - real(DP), dimension(NDIM) :: Lorbit = 0.0_DP !! System orbital angular momentum vector - real(DP), dimension(NDIM) :: Lspin = 0.0_DP !! System spin angular momentum vector - real(DP), dimension(NDIM) :: Ltot = 0.0_DP !! System angular momentum vector - real(DP) :: ke_orbit_orig = 0.0_DP!! Initial orbital kinetic energy - real(DP) :: ke_spin_orig = 0.0_DP!! Initial spin kinetic energy - real(DP) :: pe_orig = 0.0_DP !! Initial potential energy - real(DP) :: Eorbit_orig = 0.0_DP !! Initial orbital energy - real(DP) :: GMtot_orig = 0.0_DP !! Initial system mass - real(DP), dimension(NDIM) :: Ltot_orig = 0.0_DP !! Initial total angular momentum vector - real(DP), dimension(NDIM) :: Lorbit_orig = 0.0_DP !! Initial orbital angular momentum - real(DP), dimension(NDIM) :: Lspin_orig = 0.0_DP !! Initial spin angular momentum vector - real(DP), dimension(NDIM) :: Lescape = 0.0_DP !! Angular momentum of bodies that escaped the system (used for bookeeping) - real(DP) :: GMescape = 0.0_DP !! Mass of bodies that escaped the system (used for bookeeping) - real(DP) :: Ecollisions = 0.0_DP !! Energy lost from system due to collisions - real(DP) :: Euntracked = 0.0_DP !! Energy gained from system due to escaped bodies + class(swiftest_cb), allocatable :: cb !! Central body data structure + class(swiftest_pl), allocatable :: pl !! Massive body data structure + class(swiftest_tp), allocatable :: tp !! Test particle data structure + class(swiftest_tp), allocatable :: tp_discards !! Discarded test particle data structure + class(swiftest_pl), allocatable :: pl_discards !! Discarded massive body particle data structure + real(DP) :: t = -1.0_DP !! Integration current time + real(DP) :: GMtot = 0.0_DP !! Total system mass - used for barycentric coordinate conversion + real(DP) :: ke_orbit = 0.0_DP !! System orbital kinetic energy + real(DP) :: ke_spin = 0.0_DP !! System spin kinetic energy + real(DP) :: pe = 0.0_DP !! System potential energy + real(DP) :: te = 0.0_DP !! System total energy + real(DP) :: oblpot = 0.0_DP !! System potential energy due to oblateness of the central body + real(DP), dimension(NDIM) :: Lorbit = 0.0_DP !! System orbital angular momentum vector + real(DP), dimension(NDIM) :: Lspin = 0.0_DP !! System spin angular momentum vector + real(DP), dimension(NDIM) :: Ltot = 0.0_DP !! System angular momentum vector + real(DP) :: ke_orbit_orig = 0.0_DP !! Initial orbital kinetic energy + real(DP) :: ke_spin_orig = 0.0_DP !! Initial spin kinetic energy + real(DP) :: pe_orig = 0.0_DP !! Initial potential energy + real(DP) :: Eorbit_orig = 0.0_DP !! Initial orbital energy + real(DP) :: GMtot_orig = 0.0_DP !! Initial system mass + real(DP), dimension(NDIM) :: Ltot_orig = 0.0_DP !! Initial total angular momentum vector + real(DP), dimension(NDIM) :: Lorbit_orig = 0.0_DP !! Initial orbital angular momentum + real(DP), dimension(NDIM) :: Lspin_orig = 0.0_DP !! Initial spin angular momentum vector + real(DP), dimension(NDIM) :: Lescape = 0.0_DP !! Angular momentum of bodies that escaped the system (used for bookeeping) + real(DP) :: GMescape = 0.0_DP !! Mass of bodies that escaped the system (used for bookeeping) + real(DP) :: Ecollisions = 0.0_DP !! Energy lost from system due to collisions + real(DP) :: Euntracked = 0.0_DP !! Energy gained from system due to escaped bodies ! Energy, momentum, and mass errors (used in error reporting) real(DP) :: ke_orbit_error = 0.0_DP @@ -399,16 +399,16 @@ module swiftest_classes procedure :: get_old_t_final => netcdf_get_old_t_final_system !! Validates the dump file to check whether the dump file initial conditions duplicate the last frame of the netcdf output. procedure :: read_frame => netcdf_read_frame_system !! Read in a frame of input data from file procedure :: write_frame_netcdf => netcdf_write_frame_system !! Write a frame of input data from file - procedure :: write_frame_system => io_write_frame_system !! Write a frame of input data from file + procedure :: write_frame_system => io_write_frame_system !! Write a frame of input data from file procedure :: read_hdr => netcdf_read_hdr_system !! Read a header for an output frame in NetCDF format procedure :: write_hdr => netcdf_write_hdr_system !! Write a header for an output frame in NetCDF format procedure :: read_in => io_read_in_system !! Reads the initial conditions for an nbody system - procedure :: read_particle_info => netcdf_read_particle_info_system !! Read in particle metadata from file + procedure :: read_particle_info => netcdf_read_particle_info_system !! Read in particle metadata from file procedure :: obl_pot => obl_pot_system !! Compute the contribution to the total gravitational potential due solely to the oblateness of the central body procedure :: finalize => setup_finalize_system !! Runs any finalization subroutines when ending the simulation. procedure :: initialize => setup_initialize_system !! Initialize the system from input files procedure :: init_particle_info => setup_initialize_particle_info_system !! Initialize the system from input files - ! procedure :: step_spin => tides_step_spin_system !! Steps the spins of the massive & central bodies due to tides. + ! procedure :: step_spin => tides_step_spin_system !! Steps the spins of the massive & central bodies due to tides. procedure :: dealloc => util_dealloc_system !! Deallocates all allocatable components of the system procedure :: set_msys => util_set_msys !! Sets the value of msys from the masses of system bodies. procedure :: get_energy_and_momentum => util_get_energy_momentum_system !! Calculates the total system energy and momentum @@ -603,7 +603,7 @@ module subroutine io_compact_output(self, param, timer) implicit none class(swiftest_nbody_system), intent(in) :: self !! Swiftest nbody system object class(swiftest_parameters), intent(in) :: param !! Input colleciton of user-defined parameters - class(*), intent(in) :: timer !! Object used for computing elapsed wall time + class(*), intent(in) :: timer !! Object used for computing elapsed wall time end subroutine io_compact_output module subroutine io_conservation_report(self, param, lterminal) @@ -621,7 +621,7 @@ end subroutine io_dump_param module subroutine io_dump_system(self, param) implicit none - class(swiftest_nbody_system), intent(inout) :: self !! Swiftest system object + class(swiftest_nbody_system), intent(inout) :: self !! Swiftest system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters end subroutine io_dump_system @@ -833,13 +833,13 @@ end subroutine kick_getacch_int_all_triangular_pl module subroutine kick_getacch_int_all_tp(ntp, npl, xtp, xpl, GMpl, lmask, acc) implicit none - integer(I4B), intent(in) :: ntp !! Number of test particles - integer(I4B), intent(in) :: npl !! Number of massive bodies - real(DP), dimension(:,:), intent(in) :: xtp !! Test particle position vector array - real(DP), dimension(:,:), intent(in) :: xpl !! Massive body particle position vector array - real(DP), dimension(:), intent(in) :: GMpl !! Array of massive body G*mass - logical, dimension(:), intent(in) :: lmask !! Logical mask indicating which test particles should be computed - real(DP), dimension(:,:), intent(inout) :: acc !! Acceleration vector array + integer(I4B), intent(in) :: ntp !! Number of test particles + integer(I4B), intent(in) :: npl !! Number of massive bodies + real(DP), dimension(:,:), intent(in) :: xtp !! Test particle position vector array + real(DP), dimension(:,:), intent(in) :: xpl !! Massive body particle position vector array + real(DP), dimension(:), intent(in) :: GMpl !! Array of massive body G*mass + logical, dimension(:), intent(in) :: lmask !! Logical mask indicating which test particles should be computed + real(DP), dimension(:,:), intent(inout) :: acc !! Acceleration vector array end subroutine kick_getacch_int_all_tp pure module subroutine kick_getacch_int_one_pl(rji2, xr, yr, zr, Gmi, Gmj, axi, ayi, azi, axj, ayj, azj) @@ -864,7 +864,7 @@ end subroutine kick_getacch_int_one_tp module subroutine netcdf_close(self) implicit none - class(netcdf_parameters), intent(inout) :: self !! Parameters used to identify a particular NetCDF dataset + class(netcdf_parameters), intent(inout) :: self !! Parameters used to identify a particular NetCDF dataset end subroutine netcdf_close module subroutine netcdf_flush(self, param) @@ -888,8 +888,8 @@ end subroutine netcdf_initialize_output module subroutine netcdf_open(self, param, readonly) implicit none - class(netcdf_parameters), intent(inout) :: self !! Parameters used to identify a particular NetCDF dataset - class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters + class(netcdf_parameters), intent(inout) :: self !! Parameters used to identify a particular NetCDF dataset + class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters logical, optional, intent(in) :: readonly !! Logical flag indicating that this should be open read only end subroutine netcdf_open @@ -945,8 +945,8 @@ end subroutine netcdf_write_hdr_system module subroutine netcdf_write_particle_info_base(self, iu, param) implicit none - class(swiftest_base), intent(in) :: self !! Swiftest particle object - class(netcdf_parameters), intent(inout) :: iu !! Parameters used to identify a particular NetCDF dataset + class(swiftest_base), intent(in) :: self !! Swiftest particle object + class(netcdf_parameters), intent(inout) :: iu !! Parameters used to identify a particular NetCDF dataset class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters end subroutine netcdf_write_particle_info_base @@ -989,30 +989,30 @@ end subroutine orbel_scget pure module subroutine orbel_xv2aeq(mu, px, py, pz, vx, vy, vz, a, e, q) !$omp declare simd(orbel_xv2aeq) implicit none - real(DP), intent(in) :: mu !! Gravitational constant - real(DP), intent(in) :: px,py,pz !! Position vector - real(DP), intent(in) :: vx,vy,vz !! Velocity vector - real(DP), intent(out) :: a !! semimajor axis - real(DP), intent(out) :: e !! eccentricity - real(DP), intent(out) :: q !! periapsis + real(DP), intent(in) :: mu !! Gravitational constant + real(DP), intent(in) :: px,py,pz !! Position vector + real(DP), intent(in) :: vx,vy,vz !! Velocity vector + real(DP), intent(out) :: a !! semimajor axis + real(DP), intent(out) :: e !! eccentricity + real(DP), intent(out) :: q !! periapsis end subroutine orbel_xv2aeq pure module subroutine orbel_xv2aqt(mu, px, py, pz, vx, vy, vz, a, q, capm, tperi) !$omp declare simd(orbel_xv2aqt) implicit none - real(DP), intent(in) :: mu !! Gravitational constant + real(DP), intent(in) :: mu !! Gravitational constant real(DP), intent(in) :: px,py,pz !! Position vector - real(DP), intent(in) :: vx,vy,vz !! Velocity vector - real(DP), intent(out) :: a !! semimajor axis - real(DP), intent(out) :: q !! periapsis - real(DP), intent(out) :: capm !! mean anomaly - real(DP), intent(out) :: tperi !! time of pericenter passage + real(DP), intent(in) :: vx,vy,vz !! Velocity vector + real(DP), intent(out) :: a !! semimajor axis + real(DP), intent(out) :: q !! periapsis + real(DP), intent(out) :: capm !! mean anomaly + real(DP), intent(out) :: tperi !! time of pericenter passage end subroutine orbel_xv2aqt pure module subroutine orbel_xv2el(mu, px, py, pz, vx, vy, vz, a, e, inc, capom, omega, capm) implicit none real(DP), intent(in) :: mu !! Gravitational constant - real(DP), intent(in) :: px,py,pz !! Position vector + real(DP), intent(in) :: px,py,pz !! Position vector real(DP), intent(in) :: vx,vy,vz !! Velocity vector real(DP), intent(out) :: a !! semimajor axis real(DP), intent(out) :: e !! eccentricity @@ -1030,8 +1030,8 @@ end subroutine orbel_xv2el_vec module subroutine setup_body(self, n, param) implicit none - class(swiftest_body), intent(inout) :: self !! Swiftest body object - integer(I4B), intent(in) :: n !! Number of particles to allocate space for + class(swiftest_body), intent(inout) :: self !! Swiftest body object + integer(I4B), intent(in) :: n !! Number of particles to allocate space for class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters end subroutine setup_body @@ -1068,8 +1068,8 @@ end subroutine setup_pl module subroutine setup_tp(self, n, param) implicit none - class(swiftest_tp), intent(inout) :: self !! Swiftest test particle object - integer(I4B), intent(in) :: n !! Number of particles to allocate space for + class(swiftest_tp), intent(inout) :: self !! Swiftest test particle object + integer(I4B), intent(in) :: n !! Number of particles to allocate space for class(swiftest_parameters), intent(in) :: param !! Current run configuration parametersr end subroutine setup_tp @@ -1135,8 +1135,8 @@ module subroutine util_append_arr_info(arr, source, nold, nsrc, lsource_mask) implicit none type(swiftest_particle_info), dimension(:), allocatable, intent(inout) :: arr !! Destination array type(swiftest_particle_info), dimension(:), allocatable, intent(in) :: source !! Array to append - integer(I4B), intent(in) :: nold, nsrc !! Extend of the old array and the source array, respectively - logical, dimension(:), intent(in) :: lsource_mask !! Logical mask indicating which elements to append to + integer(I4B), intent(in) :: nold, nsrc !! Extend of the old array and the source array, respectively + logical, dimension(:), intent(in) :: lsource_mask !! Logical mask indicating which elements to append to end subroutine util_append_arr_info module subroutine util_append_arr_logical(arr, source, nold, nsrc, lsource_mask) @@ -1214,7 +1214,7 @@ end subroutine util_coord_vh2vb_pl module subroutine util_coord_vh2vb_tp(self, vbcb) implicit none - class(swiftest_tp), intent(inout) :: self !! Swiftest test particle object + class(swiftest_tp), intent(inout) :: self !! Swiftest test particle object real(DP), dimension(:), intent(in) :: vbcb !! Barycentric velocity of the central body end subroutine util_coord_vh2vb_tp @@ -1434,7 +1434,7 @@ end subroutine util_resize_arr_I4B module subroutine util_resize_arr_info(arr, nnew) implicit none type(swiftest_particle_info), dimension(:), allocatable, intent(inout) :: arr !! Array to resize - integer(I4B), intent(in) :: nnew !! New size + integer(I4B), intent(in) :: nnew !! New size end subroutine util_resize_arr_info module subroutine util_resize_arr_logical(arr, nnew) @@ -1633,8 +1633,8 @@ end subroutine util_sort_rearrange_arr_char_string pure module subroutine util_sort_rearrange_arr_DP(arr, ind, n) implicit none real(DP), dimension(:), allocatable, intent(inout) :: arr !! Destination array - integer(I4B), dimension(:), intent(in) :: ind !! Index to rearrange against - integer(I4B), intent(in) :: n !! Number of elements in arr and ind to rearrange + integer(I4B), dimension(:), intent(in) :: ind !! Index to rearrange against + integer(I4B), intent(in) :: n !! Number of elements in arr and ind to rearrange end subroutine util_sort_rearrange_arr_DP pure module subroutine util_sort_rearrange_arr_DPvec(arr, ind, n) @@ -1648,7 +1648,7 @@ pure module subroutine util_sort_rearrange_arr_I4B(arr, ind, n) implicit none integer(I4B), dimension(:), allocatable, intent(inout) :: arr !! Destination array integer(I4B), dimension(:), intent(in) :: ind !! Index to rearrange against - integer(I4B), intent(in) :: n !! Number of elements in arr and ind to rearrange + integer(I4B), intent(in) :: n !! Number of elements in arr and ind to rearrange end subroutine util_sort_rearrange_arr_I4B pure module subroutine util_sort_rearrange_arr_I4B_I8Bind(arr, ind, n) @@ -1701,22 +1701,22 @@ end subroutine util_sort_rearrange_tp module subroutine util_sort_body(self, sortby, ascending) implicit none - class(swiftest_body), intent(inout) :: self !! Swiftest body object - character(*), intent(in) :: sortby !! Sorting attribute + class(swiftest_body), intent(inout) :: self !! Swiftest body object + character(*), intent(in) :: sortby !! Sorting attribute logical, intent(in) :: ascending !! Logical flag indicating whether or not the sorting should be in ascending or descending order end subroutine util_sort_body module subroutine util_sort_pl(self, sortby, ascending) implicit none - class(swiftest_pl), intent(inout) :: self !! Swiftest body object - character(*), intent(in) :: sortby !! Sorting attribute + class(swiftest_pl), intent(inout) :: self !! Swiftest body object + character(*), intent(in) :: sortby !! Sorting attribute logical, intent(in) :: ascending !! Logical flag indicating whether or not the sorting should be in ascending or descending order end subroutine util_sort_pl module subroutine util_sort_tp(self, sortby, ascending) implicit none - class(swiftest_tp), intent(inout) :: self !! Swiftest body object - character(*), intent(in) :: sortby !! Sorting attribute + class(swiftest_tp), intent(inout) :: self !! Swiftest body object + character(*), intent(in) :: sortby !! Sorting attribute logical, intent(in) :: ascending !! Logical flag indicating whether or not the sorting should be in ascending or descending order end subroutine util_sort_tp @@ -1769,8 +1769,8 @@ module subroutine util_spill_arr_info(keeps, discards, lspill_list, ldestructive implicit none type(swiftest_particle_info), dimension(:), allocatable, intent(inout) :: keeps !! Array of values to keep type(swiftest_particle_info), dimension(:), allocatable, intent(inout) :: discards !! Array of discards - logical, dimension(:), intent(in) :: lspill_list !! Logical array of bodies to spill into the discardss - logical, intent(in) :: ldestructive !! Logical flag indicating whether or not this operation should alter the keeps array or not + logical, dimension(:), intent(in) :: lspill_list !! Logical array of bodies to spill into the discardss + logical, intent(in) :: ldestructive !! Logical flag indicating whether or not this operation should alter the keeps array or not end subroutine util_spill_arr_info module subroutine util_spill_arr_logical(keeps, discards, lspill_list, ldestructive) @@ -1785,9 +1785,9 @@ end subroutine util_spill_arr_logical interface module subroutine util_spill_body(self, discards, lspill_list, ldestructive) implicit none - class(swiftest_body), intent(inout) :: self !! Swiftest body object - class(swiftest_body), intent(inout) :: discards !! Discarded object - logical, dimension(:), intent(in) :: lspill_list !! Logical array of bodies to spill into the discards + class(swiftest_body), intent(inout) :: self !! Swiftest body object + class(swiftest_body), intent(inout) :: discards !! Discarded object + logical, dimension(:), intent(in) :: lspill_list !! Logical array of bodies to spill into the discards logical, intent(in) :: ldestructive !! Logical flag indicating whether or not this operation should alter the keeps array or not end subroutine util_spill_body From 910e8e946e99c6c049d4cba73ca0ac99686d5ec0 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Thu, 1 Dec 2022 16:01:53 -0500 Subject: [PATCH 176/569] Minor formatting tweak --- src/modules/swiftest_classes.f90 | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/src/modules/swiftest_classes.f90 b/src/modules/swiftest_classes.f90 index 33d5aa79e..a7d3965c5 100644 --- a/src/modules/swiftest_classes.f90 +++ b/src/modules/swiftest_classes.f90 @@ -1793,17 +1793,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 From 1dbe3369d48a570fb11cb1beb6dbc330645fbb78 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Thu, 1 Dec 2022 16:11:45 -0500 Subject: [PATCH 177/569] Switched frame counter variables to I4B to simplify the code, as it really doesn't need to be I8B --- src/io/io.f90 | 11 ++++++----- src/main/swiftest_driver.f90 | 22 +++++++++++----------- src/modules/swiftest_classes.f90 | 4 ++-- src/netcdf/netcdf.f90 | 8 ++++---- 4 files changed, 23 insertions(+), 22 deletions(-) diff --git a/src/io/io.f90 b/src/io/io.f90 index 7ee5b9cbd..ce17cdadf 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) @@ -282,12 +282,13 @@ module subroutine io_dump_system_storage(self, param) 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 + integer(I4B) :: i + integer(I8B) :: iloop_start - iloop_start = param%iloop - param%istep_out * param%dump_cadence + 1_I8B - do i = 1_I8B, param%dump_cadence + iloop_start = param%iloop - int(param%istep_out * param%dump_cadence + 1, kind=I8B) + do i = 1, param%dump_cadence if (allocated(self%frame(i)%system)) then - param%ioutput = int(iloop_start / param%istep_out, kind=I8B) + i + param%ioutput = int(iloop_start / param%istep_out, kind=I4B) + i call self%frame(i)%system%write_frame(param) deallocate(self%frame(i)%system) end if diff --git a/src/main/swiftest_driver.f90 b/src/main/swiftest_driver.f90 index a9af0cc71..b14abec80 100644 --- a/src/main/swiftest_driver.f90 +++ b/src/main/swiftest_driver.f90 @@ -18,16 +18,16 @@ 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 + integer(I4B) :: iframe !! System history frame cindex 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 @@ -83,7 +83,7 @@ program swiftest_driver 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) diff --git a/src/modules/swiftest_classes.f90 b/src/modules/swiftest_classes.f90 index a7d3965c5..6f0d10857 100644 --- a/src/modules/swiftest_classes.f90 +++ b/src/modules/swiftest_classes.f90 @@ -41,7 +41,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 @@ -425,7 +425,7 @@ module swiftest_classes end type type, extends(swiftest_base) :: swiftest_storage(nframes) - integer(I8B), len :: nframes + integer(I4B), len :: nframes !! A class that that is used to store simulation history data between file output type(storage_frame), dimension(nframes) :: frame contains diff --git a/src/netcdf/netcdf.f90 b/src/netcdf/netcdf.f90 index abd03f1d6..4b56715fd 100644 --- a/src/netcdf/netcdf.f90 +++ b/src/netcdf/netcdf.f90 @@ -519,7 +519,7 @@ module function netcdf_read_frame_system(self, iu, param) result(ierr) 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" ) allocate(rtemp(idmax)) @@ -791,7 +791,7 @@ module subroutine netcdf_read_hdr_system(self, iu, param) logical, dimension(:), allocatable :: plmask, tpmask, plmmask - 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_get_var(iu%ncid, iu%time_varid, self%t, start=[tslot]), "netcdf_read_hdr_system nf90_getvar time_varid" ) @@ -1185,7 +1185,7 @@ module subroutine netcdf_write_frame_base(self, iu, param) call self%write_particle_info(iu, 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" ) select type(self) @@ -1426,7 +1426,7 @@ module subroutine netcdf_write_hdr_system(self, iu, param) ! 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" ) From 7d48f803cff810660eeaa4a17eaf2211fd11363d Mon Sep 17 00:00:00 2001 From: David A Minton Date: Thu, 1 Dec 2022 16:21:48 -0500 Subject: [PATCH 178/569] Refactored write_particle_info to just write_info to cut down on uneccesary wordiness --- src/discard/discard.f90 | 4 +- src/modules/swiftest_classes.f90 | 10 ++-- src/netcdf/netcdf.f90 | 90 ++++++++++++++++---------------- src/symba/symba_io.f90 | 4 +- src/symba/symba_util.f90 | 2 +- 5 files changed, 55 insertions(+), 55 deletions(-) diff --git a/src/discard/discard.f90 b/src/discard/discard.f90 index 55ad97f65..2019774a8 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) diff --git a/src/modules/swiftest_classes.f90 b/src/modules/swiftest_classes.f90 index 6f0d10857..6a37a4894 100644 --- a/src/modules/swiftest_classes.f90 +++ b/src/modules/swiftest_classes.f90 @@ -151,9 +151,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 !******************************************************************************************************************************** @@ -943,12 +943,12 @@ module subroutine netcdf_write_hdr_system(self, iu, param) 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, iu, param) implicit none class(swiftest_base), intent(in) :: self !! Swiftest particle object class(netcdf_parameters), intent(inout) :: iu !! Parameters used to identify a particular NetCDF dataset class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - end subroutine netcdf_write_particle_info_base + end subroutine netcdf_write_info_base module subroutine obl_acc_body(self, system) implicit none diff --git a/src/netcdf/netcdf.f90 b/src/netcdf/netcdf.f90 index 4b56715fd..1dd114f92 100644 --- a/src/netcdf/netcdf.f90 +++ b/src/netcdf/netcdf.f90 @@ -1183,7 +1183,7 @@ module subroutine netcdf_write_frame_base(self, iu, param) real(DP), dimension(NDIM) :: vh !! Temporary variable to store heliocentric velocity values when converting from pseudovelocity in GR-enabled runs real(DP) :: a, e, inc, omega, capom, capm - call self%write_particle_info(iu, param) + call self%write_info(iu, param) tslot = param%ioutput + 1 @@ -1309,7 +1309,7 @@ module subroutine netcdf_write_frame_system(self, iu, param) end subroutine netcdf_write_frame_system - module subroutine netcdf_write_particle_info_base(self, iu, param) + module subroutine netcdf_write_info_base(self, iu, param) !! author: Carlisle A. Wishard, Dana Singh, and David A. Minton !! !! Write all current particle to file @@ -1324,7 +1324,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(iu%ncid, nf90_nofill, old_mode), "netcdf_write_info_base nf90_set_fill nf90_nofill" ) select type(self) class is (swiftest_body) @@ -1335,36 +1335,36 @@ 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(iu%ncid, iu%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(iu%ncid, iu%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(iu%ncid, iu%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(iu%ncid, iu%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(iu%ncid, iu%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(iu%ncid, iu%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(iu%ncid, iu%origin_xhx_varid, self%info(j)%origin_xh(1), start=[idslot]), "netcdf_write_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_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_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_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_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_info_base nf90_put_var origin_vhz_varid" ) - call check( nf90_put_var(iu%ncid, iu%collision_id_varid, self%info(j)%collision_id, start=[idslot]), "netcdf_write_particle_info_base nf90_put_var collision_id_varid" ) - call check( nf90_put_var(iu%ncid, iu%discard_time_varid, self%info(j)%discard_time, start=[idslot]), "netcdf_write_particle_info_base nf90_put_var discard_time_varid" ) - call check( nf90_put_var(iu%ncid, iu%discard_xhx_varid, self%info(j)%discard_xh(1), start=[idslot]), "netcdf_write_particle_info_base nf90_put_var discard_xhx_varid" ) - call check( nf90_put_var(iu%ncid, iu%discard_xhy_varid, self%info(j)%discard_xh(2), start=[idslot]), "netcdf_write_particle_info_base nf90_put_var discard_xhy_varid" ) - call check( nf90_put_var(iu%ncid, iu%discard_xhz_varid, self%info(j)%discard_xh(3), start=[idslot]), "netcdf_write_particle_info_base nf90_put_var discard_xhz_varid" ) - call check( nf90_put_var(iu%ncid, iu%discard_vhx_varid, self%info(j)%discard_vh(1), start=[idslot]), "netcdf_write_particle_info_base nf90_put_var discard_vhx_varid" ) - call check( nf90_put_var(iu%ncid, iu%discard_vhy_varid, self%info(j)%discard_vh(2), start=[idslot]), "netcdf_write_particle_info_base nf90_put_var discard_vhy_varid" ) - call check( nf90_put_var(iu%ncid, iu%discard_vhz_varid, self%info(j)%discard_vh(3), start=[idslot]), "netcdf_write_particle_info_base nf90_put_var discard_vhz_varid" ) + call check( nf90_put_var(iu%ncid, iu%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(iu%ncid, iu%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(iu%ncid, iu%discard_xhx_varid, self%info(j)%discard_xh(1), start=[idslot]), "netcdf_write_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_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_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_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_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_info_base nf90_put_var discard_vhz_varid" ) end if end do @@ -1372,44 +1372,44 @@ 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(iu%ncid, iu%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(iu%ncid, iu%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(iu%ncid, iu%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(iu%ncid, iu%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(iu%ncid, iu%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(iu%ncid, iu%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(iu%ncid, iu%origin_xhx_varid, self%info%origin_xh(1), start=[idslot]), "netcdf_write_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_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_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_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_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_info_base nf90_put_var cb origin_vhz_varid" ) - call check( nf90_put_var(iu%ncid, iu%collision_id_varid, self%info%collision_id, start=[idslot]), "netcdf_write_particle_info_base nf90_put_var cb collision_id_varid" ) - call check( nf90_put_var(iu%ncid, iu%discard_time_varid, self%info%discard_time, start=[idslot]), "netcdf_write_particle_info_base nf90_put_var cb discard_time_varid" ) - call check( nf90_put_var(iu%ncid, iu%discard_xhx_varid, self%info%discard_xh(1), start=[idslot]), "netcdf_write_particle_info_base nf90_put_var cb discard_xhx_varid" ) - call check( nf90_put_var(iu%ncid, iu%discard_xhy_varid, self%info%discard_xh(2), start=[idslot]), "netcdf_write_particle_info_base nf90_put_var cb discard_xhy_varid" ) - call check( nf90_put_var(iu%ncid, iu%discard_xhz_varid, self%info%discard_xh(3), start=[idslot]), "netcdf_write_particle_info_base nf90_put_var cb discard_xhz_varid" ) - call check( nf90_put_var(iu%ncid, iu%discard_vhx_varid, self%info%discard_vh(1), start=[idslot]), "netcdf_write_particle_info_base nf90_put_var cb discard_vhx_varid" ) - call check( nf90_put_var(iu%ncid, iu%discard_vhy_varid, self%info%discard_vh(2), start=[idslot]), "netcdf_write_particle_info_base nf90_put_var cb discard_vhy_varid" ) - call check( nf90_put_var(iu%ncid, iu%discard_vhz_varid, self%info%discard_vh(3), start=[idslot]), "netcdf_write_particle_info_base nf90_put_var cb discard_vhz_varid" ) + call check( nf90_put_var(iu%ncid, iu%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(iu%ncid, iu%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(iu%ncid, iu%discard_xhx_varid, self%info%discard_xh(1), start=[idslot]), "netcdf_write_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_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_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_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_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_info_base nf90_put_var cb discard_vhz_varid" ) end if end select call check( nf90_set_fill(iu%ncid, old_mode, old_mode) ) return - end subroutine netcdf_write_particle_info_base + end subroutine netcdf_write_info_base module subroutine netcdf_write_hdr_system(self, iu, param) diff --git a/src/symba/symba_io.f90 b/src/symba/symba_io.f90 index d5dd06308..38ead96f1 100644 --- a/src/symba/symba_io.f90 +++ b/src/symba/symba_io.f90 @@ -177,12 +177,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_util.f90 b/src/symba/symba_util.f90 index f0f300bc1..6f53d6bbd 100644 --- a/src/symba/symba_util.f90 +++ b/src/symba/symba_util.f90 @@ -678,7 +678,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 From 01762bfcf5e671b302660629a08fcabf3998c4df Mon Sep 17 00:00:00 2001 From: David A Minton Date: Thu, 1 Dec 2022 16:31:11 -0500 Subject: [PATCH 179/569] Refactored some of the storage procedure names to keep the naming scheme somewhat consistent --- src/io/io.f90 | 4 ++-- src/modules/encounter_classes.f90 | 2 +- src/modules/swiftest_classes.f90 | 12 ++++++------ src/util/util_copy.f90 | 2 +- 4 files changed, 10 insertions(+), 10 deletions(-) diff --git a/src/io/io.f90 b/src/io/io.f90 index ce17cdadf..8da42117a 100644 --- a/src/io/io.f90 +++ b/src/io/io.f90 @@ -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_system(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 @@ -295,7 +295,7 @@ module subroutine io_dump_system_storage(self, param) end do return - end subroutine io_dump_system_storage + end subroutine io_dump_storage_system module subroutine io_get_args(integrator, param_file_name, display_style) diff --git a/src/modules/encounter_classes.f90 b/src/modules/encounter_classes.f90 index b562def23..580becc40 100644 --- a/src/modules/encounter_classes.f90 +++ b/src/modules/encounter_classes.f90 @@ -38,7 +38,7 @@ module encounter_classes 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 + final :: encounter_util_final_list !! Finalize the encounter list - deallocates all allocatables end type encounter_list type encounter_bounding_box_1D diff --git a/src/modules/swiftest_classes.f90 b/src/modules/swiftest_classes.f90 index 6a37a4894..07f446946 100644 --- a/src/modules/swiftest_classes.f90 +++ b/src/modules/swiftest_classes.f90 @@ -417,7 +417,7 @@ 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 + type swiftest_storage_frame_system class(swiftest_nbody_system), allocatable :: system 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. @@ -427,9 +427,9 @@ module swiftest_classes type, extends(swiftest_base) :: swiftest_storage(nframes) integer(I4B), 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_frame_system), dimension(nframes) :: frame contains - procedure :: dump => io_dump_system_storage + procedure :: dump => io_dump_storage_system end type swiftest_storage abstract interface @@ -626,11 +626,11 @@ 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_system(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 + end subroutine io_dump_storage_system module subroutine io_get_args(integrator, param_file_name, display_style) implicit none @@ -1245,7 +1245,7 @@ end subroutine util_copy_particle_info_arr module subroutine util_copy_store_system(self, system) implicit none - class(storage_frame), intent(inout) :: self !! Swiftest storage frame object + class(swiftest_storage_frame_system), 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 diff --git a/src/util/util_copy.f90 b/src/util/util_copy.f90 index 51e210787..cb1117df9 100644 --- a/src/util/util_copy.f90 +++ b/src/util/util_copy.f90 @@ -83,7 +83,7 @@ module subroutine util_copy_store_system(self, system) !! !! 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_storage_frame_system), intent(inout) :: self !! Swiftest storage frame object class(swiftest_nbody_system), intent(in) :: system !! Swiftest n-body system object if (allocated(self%system)) deallocate(self%system) From 5d243fdf0e5e6597ed3031c139ad2c4030a1d2a8 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Thu, 1 Dec 2022 16:39:32 -0500 Subject: [PATCH 180/569] Restructured the driver to simplify the counting variables. Variables now count up instead of down, simplifying the indexing of the storage frames --- src/main/swiftest_driver.f90 | 22 ++++++++++------------ 1 file changed, 10 insertions(+), 12 deletions(-) diff --git a/src/main/swiftest_driver.f90 b/src/main/swiftest_driver.f90 index b14abec80..75c601024 100644 --- a/src/main/swiftest_driver.f90 +++ b/src/main/swiftest_driver.f90 @@ -27,7 +27,6 @@ program swiftest_driver integer(I8B) :: nloops !! Number of steps to take in the simulation integer(I4B) :: iout !! Output cadence counter integer(I4B) :: idump !! Dump cadence counter - integer(I4B) :: iframe !! System history frame cindex 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 @@ -80,7 +79,6 @@ 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=I4B) @@ -88,7 +86,6 @@ program swiftest_driver ! 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 @@ -109,6 +106,8 @@ program swiftest_driver 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 +122,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,7 +154,6 @@ program swiftest_driver call integration_timer%reset() - iout = istep_out end if end if From 08584c42b474cc19ea2e783f4108399ee081d953 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Thu, 1 Dec 2022 16:52:47 -0500 Subject: [PATCH 181/569] Added encounter storage object using the same pattern as the system storage object. Also got rid of some old pre-NetCDF cruft in encounter_classes --- src/modules/encounter_classes.f90 | 34 +++++++++++++++++++++++-------- src/modules/swiftest_classes.f90 | 7 +++---- 2 files changed, 28 insertions(+), 13 deletions(-) diff --git a/src/modules/encounter_classes.f90 b/src/modules/encounter_classes.f90 index 580becc40..b14fd5da0 100644 --- a/src/modules/encounter_classes.f90 +++ b/src/modules/encounter_classes.f90 @@ -41,6 +41,21 @@ module encounter_classes final :: encounter_util_final_list !! Finalize the encounter list - deallocates all allocatables end type encounter_list + type encounter_storage_frame_list + class(swiftest_nbody_system), allocatable :: system + contains + procedure :: store => encounter_util_copy_store_list !! Stores a snapshot of the nbody system so that later it can be retrieved for saving to file. + generic :: assignment(=) => store + end type + + type :: encounter_storage(nframes) + integer(I4B), len :: nframes + !! A class that that is used to store simulation history data between file output + type(encounter_storage_frame_list), dimension(nframes) :: frame + contains + procedure :: dump => encounter_io_dump_storage_list + 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,16 +188,11 @@ 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 - integer(I4B), intent(in) :: iu !! Open file unit number - real(DP), intent(in) :: t !! Time of encounter - integer(I4B), intent(in) :: id1, id2 !! ids of the two encountering bodies - real(DP), intent(in) :: Gmass1, Gmass2 !! G*mass of the two encountering bodies - real(DP), intent(in) :: radius1, radius2 !! Radii of the two encountering bodies - real(DP), dimension(:), intent(in) :: xh1, xh2 !! Swiftestcentric position vectors of the two encountering bodies - real(DP), dimension(:), intent(in) :: vh1, vh2 !! Swiftestcentric velocity vectors of the two encountering bodies - end subroutine encounter_io_write_frame + 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_setup_aabb(self, n, n_last) implicit none @@ -210,6 +220,12 @@ module subroutine encounter_util_copy_list(self, source) class(encounter_list), intent(in) :: source !! Source object to copy into end subroutine encounter_util_copy_list + module subroutine encounter_util_copy_store_list(self, system) + implicit none + class(encounter_storage_frame_list), intent(inout) :: self !! Encounter storage object + class(encounter_list), intent(in) :: system !! Swiftest encounter list structure + end subroutine encounter_util_copy_store_list + module subroutine encounter_util_dealloc_aabb(self) implicit none class(encounter_bounding_box_1D), intent(inout) :: self !!Bounding box structure along a single dimension diff --git a/src/modules/swiftest_classes.f90 b/src/modules/swiftest_classes.f90 index 07f446946..54881ae19 100644 --- a/src/modules/swiftest_classes.f90 +++ b/src/modules/swiftest_classes.f90 @@ -424,7 +424,7 @@ module swiftest_classes generic :: assignment(=) => store end type - type, extends(swiftest_base) :: swiftest_storage(nframes) + type :: swiftest_storage(nframes) integer(I4B), len :: nframes !! A class that that is used to store simulation history data between file output type(swiftest_storage_frame_system), dimension(nframes) :: frame @@ -625,7 +625,6 @@ 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_storage_system(self, param) implicit none class(swiftest_storage(*)), intent(inout) :: self !! Swiftest simulation history storage object @@ -1245,8 +1244,8 @@ end subroutine util_copy_particle_info_arr module subroutine util_copy_store_system(self, system) implicit none - class(swiftest_storage_frame_system), intent(inout) :: self !! Swiftest storage frame object - class(swiftest_nbody_system), intent(in) :: system !! Swiftest n-body system object + class(swiftest_storage_frame_system), 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 module subroutine util_dealloc_body(self) From c2c781f2e0e34110a3e644c1e89360af261379d7 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Thu, 1 Dec 2022 17:30:01 -0500 Subject: [PATCH 182/569] Restructured the swiftest_storage object to be a general purpose storage tool capabable of storing *any* object you want. I added an extension in the encounter class definitions that will specialized in encounter list storage --- src/CMakeLists.txt | 1 + src/encounter/encounter_io.f90 | 24 ++++++++++++++++++++++++ src/encounter/encounter_util.f90 | 11 +++++------ src/io/io.f90 | 15 +++++++++------ src/main/swiftest_driver.f90 | 2 +- src/modules/encounter_classes.f90 | 17 +---------------- src/modules/swiftest_classes.f90 | 26 +++++++++++++------------- src/util/util_copy.f90 | 14 +++++++------- 8 files changed, 61 insertions(+), 49 deletions(-) create mode 100644 src/encounter/encounter_io.f90 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/encounter/encounter_io.f90 b/src/encounter/encounter_io.f90 new file mode 100644 index 000000000..43d89add6 --- /dev/null +++ b/src/encounter/encounter_io.f90 @@ -0,0 +1,24 @@ +!! 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 +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 + end subroutine encounter_io_dump_storage_list + +end submodule s_encounter_io \ No newline at end of file diff --git a/src/encounter/encounter_util.f90 b/src/encounter/encounter_util.f90 index 09cf6107e..76ac0e492 100644 --- a/src/encounter/encounter_util.f90 +++ b/src/encounter/encounter_util.f90 @@ -70,7 +70,6 @@ module subroutine encounter_util_copy_list(self, source) return end subroutine encounter_util_copy_list - module subroutine encounter_util_dealloc_aabb(self) !! author: David A. Minton !! @@ -149,11 +148,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 +184,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 diff --git a/src/io/io.f90 b/src/io/io.f90 index 8da42117a..e8936d018 100644 --- a/src/io/io.f90 +++ b/src/io/io.f90 @@ -270,7 +270,7 @@ module subroutine io_dump_system(self, param) end subroutine io_dump_system - module subroutine io_dump_storage_system(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 @@ -287,15 +287,18 @@ module subroutine io_dump_storage_system(self, param) iloop_start = param%iloop - int(param%istep_out * param%dump_cadence + 1, kind=I8B) do i = 1, param%dump_cadence - if (allocated(self%frame(i)%system)) then - param%ioutput = int(iloop_start / param%istep_out, kind=I4B) + i - call self%frame(i)%system%write_frame(param) - deallocate(self%frame(i)%system) + 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_storage_system + end subroutine io_dump_storage module subroutine io_get_args(integrator, param_file_name, display_style) diff --git a/src/main/swiftest_driver.f90 b/src/main/swiftest_driver.f90 index 75c601024..3f9a36adc 100644 --- a/src/main/swiftest_driver.f90 +++ b/src/main/swiftest_driver.f90 @@ -38,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) diff --git a/src/modules/encounter_classes.f90 b/src/modules/encounter_classes.f90 index b14fd5da0..91ef22d43 100644 --- a/src/modules/encounter_classes.f90 +++ b/src/modules/encounter_classes.f90 @@ -41,17 +41,8 @@ module encounter_classes final :: encounter_util_final_list !! Finalize the encounter list - deallocates all allocatables end type encounter_list - type encounter_storage_frame_list - class(swiftest_nbody_system), allocatable :: system - contains - procedure :: store => encounter_util_copy_store_list !! Stores a snapshot of the nbody system so that later it can be retrieved for saving to file. - generic :: assignment(=) => store - end type - - type :: encounter_storage(nframes) - integer(I4B), len :: nframes + type, extends(swiftest_storage) :: encounter_storage !! A class that that is used to store simulation history data between file output - type(encounter_storage_frame_list), dimension(nframes) :: frame contains procedure :: dump => encounter_io_dump_storage_list end type encounter_storage @@ -220,12 +211,6 @@ module subroutine encounter_util_copy_list(self, source) class(encounter_list), intent(in) :: source !! Source object to copy into end subroutine encounter_util_copy_list - module subroutine encounter_util_copy_store_list(self, system) - implicit none - class(encounter_storage_frame_list), intent(inout) :: self !! Encounter storage object - class(encounter_list), intent(in) :: system !! Swiftest encounter list structure - end subroutine encounter_util_copy_store_list - module subroutine encounter_util_dealloc_aabb(self) implicit none class(encounter_bounding_box_1D), intent(inout) :: self !!Bounding box structure along a single dimension diff --git a/src/modules/swiftest_classes.f90 b/src/modules/swiftest_classes.f90 index 54881ae19..f23a3c76e 100644 --- a/src/modules/swiftest_classes.f90 +++ b/src/modules/swiftest_classes.f90 @@ -417,19 +417,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 swiftest_storage_frame_system - 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 :: swiftest_storage(nframes) integer(I4B), len :: nframes - !! A class that that is used to store simulation history data between file output - type(swiftest_storage_frame_system), dimension(nframes) :: frame + !! An abstract class that establishes the pattern for various storage objects + type(swiftest_storage_frame), dimension(nframes) :: frame contains - procedure :: dump => io_dump_storage_system + procedure :: dump => io_dump_storage end type swiftest_storage abstract interface @@ -449,7 +449,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,6 +492,7 @@ 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 @@ -625,11 +625,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_storage_system(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_storage_system + end subroutine io_dump_storage module subroutine io_get_args(integrator, param_file_name, display_style) implicit none @@ -1242,11 +1242,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(swiftest_storage_frame_system), 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 diff --git a/src/util/util_copy.f90 b/src/util/util_copy.f90 index cb1117df9..6674cf431 100644 --- a/src/util/util_copy.f90 +++ b/src/util/util_copy.f90 @@ -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(swiftest_storage_frame_system), 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 From 61321de6f5e4deb570509e22756d78bd5ec488fd Mon Sep 17 00:00:00 2001 From: David A Minton Date: Thu, 1 Dec 2022 19:19:41 -0500 Subject: [PATCH 183/569] Added templates for the encounter io netcdf methods --- src/encounter/encounter_io.f90 | 25 +++++++++++++++++++++++++ src/modules/encounter_classes.f90 | 21 ++++++++++++++++++++- src/modules/symba_classes.f90 | 27 ++++++++++++++------------- 3 files changed, 59 insertions(+), 14 deletions(-) diff --git a/src/encounter/encounter_io.f90 b/src/encounter/encounter_io.f90 index 43d89add6..ba00e3634 100644 --- a/src/encounter/encounter_io.f90 +++ b/src/encounter/encounter_io.f90 @@ -21,4 +21,29 @@ module subroutine encounter_io_dump_storage_list(self, param) 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) + !! author: David A. Minton + !! + !! Initialize a NetCDF encounter file system and defines all variables. + 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 + + return + 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 + + return + end subroutine encounter_io_open_file + end submodule s_encounter_io \ No newline at end of file diff --git a/src/modules/encounter_classes.f90 b/src/modules/encounter_classes.f90 index 91ef22d43..f41c350e0 100644 --- a/src/modules/encounter_classes.f90 +++ b/src/modules/encounter_classes.f90 @@ -46,7 +46,13 @@ module encounter_classes contains procedure :: dump => encounter_io_dump_storage_list end type encounter_storage - + + type, extends(netcdf_parameters) :: encounter_io_parameters + 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 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) @@ -185,6 +191,19 @@ module subroutine encounter_io_dump_storage_list(self, param) 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_setup_aabb(self, n, n_last) implicit none class(encounter_bounding_box), intent(inout) :: self !! Swiftest encounter structure diff --git a/src/modules/symba_classes.f90 b/src/modules/symba_classes.f90 index e016a36b9..42b676c22 100644 --- a/src/modules/symba_classes.f90 +++ b/src/modules/symba_classes.f90 @@ -16,20 +16,20 @@ 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. contains procedure :: reader => symba_io_param_reader procedure :: writer => symba_io_param_writer @@ -45,7 +45,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 +53,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 @@ -184,6 +184,7 @@ module symba_classes 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 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 @@ -219,7 +220,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) From 5bcf737b4c1a7a613847548486e9700c0201a578 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Thu, 1 Dec 2022 19:30:10 -0500 Subject: [PATCH 184/569] Added new SyMBA-only input parameter indicating how to save encounters --- src/encounter/encounter_io.f90 | 2 ++ src/modules/symba_classes.f90 | 1 + src/symba/symba_io.f90 | 10 ++++++++++ 3 files changed, 13 insertions(+) diff --git a/src/encounter/encounter_io.f90 b/src/encounter/encounter_io.f90 index ba00e3634..1e2f97a1a 100644 --- a/src/encounter/encounter_io.f90 +++ b/src/encounter/encounter_io.f90 @@ -21,6 +21,7 @@ module subroutine encounter_io_dump_storage_list(self, param) 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) !! author: David A. Minton !! @@ -33,6 +34,7 @@ module subroutine encounter_io_initialize_output(self, param) return end subroutine encounter_io_initialize_output + module subroutine encounter_io_open_file(self, param, readonly) !! author: David A. Minton !! diff --git a/src/modules/symba_classes.f90 b/src/modules/symba_classes.f90 index 42b676c22..988d75d95 100644 --- a/src/modules/symba_classes.f90 +++ b/src/modules/symba_classes.f90 @@ -30,6 +30,7 @@ module symba_classes 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 diff --git a/src/symba/symba_io.f90 b/src/symba/symba_io.f90 index 38ead96f1..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 From 3154dfae7de9f2e3a98712fb8246b951a1d074c9 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Thu, 1 Dec 2022 20:09:34 -0500 Subject: [PATCH 185/569] Added initialization of NetCDF encounter data file variables --- src/encounter/encounter_io.f90 | 71 +++++++++++++++++++++++++++++++ src/modules/encounter_classes.f90 | 38 +++++++++++++++++ src/modules/swiftest_classes.f90 | 7 +++ src/netcdf/netcdf.f90 | 2 +- 4 files changed, 117 insertions(+), 1 deletion(-) diff --git a/src/encounter/encounter_io.f90 b/src/encounter/encounter_io.f90 index 1e2f97a1a..5530b61e6 100644 --- a/src/encounter/encounter_io.f90 +++ b/src/encounter/encounter_io.f90 @@ -9,6 +9,7 @@ submodule (encounter_classes) s_encounter_io use swiftest + use netcdf contains module subroutine encounter_io_dump_storage_list(self, param) @@ -26,12 +27,70 @@ 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 + integer(I4B) :: nvar, varid, vartype + real(DP) :: dfill + real(SP) :: sfill + logical :: fileExists + character(len=STRMAX) :: errmsg + integer(I4B) :: ndims + + dfill = ieee_value(dfill, IEEE_QUIET_NAN) + sfill = ieee_value(sfill, IEEE_QUIET_NAN) + + ! Check if the file exists, and if it does, delete it + inquire(file=param%outfile, exist=fileExists) + if (fileExists) then + open(unit=LUN, file=self%outfile, status="old", err=667, iomsg=errmsg) + close(unit=LUN, status="delete") + end if + + call check( nf90_create(self%outfile, NF90_NETCDF4, self%ncid), "encounter_io_initialize_output nf90_create" ) + + call check( nf90_def_dim(self%ncid, ENCID_DIMNAME, NF90_UNLIMITED, self%encid_dimid), "encounter_io_initialize_output nf90_def_dim encid_dimid" ) + call check( nf90_def_dim(self%ncid, 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%ncid, TIME_DIMNAME, NF90_UNLIMITED, self%time_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%ncid, 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%ncid, ENCID_DIMNAME, NF90_INT, self%encid_dimid, self%encid_varid), "encounter_io_initialize_output nf90_def_var encid_varid" ) + call check( nf90_def_var(self%ncid, 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%ncid, ID1_VARNAME, NF90_INT, [self%encid_dimid, self%time_dimid], self%id1_varid), "encounter_io_initialize_output nf90_def_var id1_varid" ) + call check( nf90_def_var(self%ncid, ID2_VARNAME, NF90_INT, [self%encid_dimid, self%time_dimid], self%id2_varid), "encounter_io_initialize_output nf90_def_var id2_varid" ) + call check( nf90_def_var(self%ncid, X1X_VARNAME, self%out_type, [self%encid_dimid, self%time_dimid], self%x1x_varid), "encounter_io_initialize_output nf90_def_var x1x_varid" ) + call check( nf90_def_var(self%ncid, X1Y_VARNAME, self%out_type, [self%encid_dimid, self%time_dimid], self%x1y_varid), "encounter_io_initialize_output nf90_def_var x1y_varid" ) + call check( nf90_def_var(self%ncid, X1Z_VARNAME, self%out_type, [self%encid_dimid, self%time_dimid], self%x1z_varid), "encounter_io_initialize_output nf90_def_var x1z_varid" ) + call check( nf90_def_var(self%ncid, X2X_VARNAME, self%out_type, [self%encid_dimid, self%time_dimid], self%x2x_varid), "encounter_io_initialize_output nf90_def_var x2x_varid" ) + call check( nf90_def_var(self%ncid, X2Y_VARNAME, self%out_type, [self%encid_dimid, self%time_dimid], self%x2y_varid), "encounter_io_initialize_output nf90_def_var x2y_varid" ) + call check( nf90_def_var(self%ncid, X2Z_VARNAME, self%out_type, [self%encid_dimid, self%time_dimid], self%x2z_varid), "encounter_io_initialize_output nf90_def_var x2z_varid" ) + call check( nf90_def_var(self%ncid, V1X_VARNAME, self%out_type, [self%encid_dimid, self%time_dimid], self%v1x_varid), "encounter_io_initialize_output nf90_def_var v1x_varid" ) + call check( nf90_def_var(self%ncid, V1Y_VARNAME, self%out_type, [self%encid_dimid, self%time_dimid], self%v1y_varid), "encounter_io_initialize_output nf90_def_var v1y_varid" ) + call check( nf90_def_var(self%ncid, V1Z_VARNAME, self%out_type, [self%encid_dimid, self%time_dimid], self%v1z_varid), "encounter_io_initialize_output nf90_def_var v1z_varid" ) + call check( nf90_def_var(self%ncid, V2X_VARNAME, self%out_type, [self%encid_dimid, self%time_dimid], self%v2x_varid), "encounter_io_initialize_output nf90_def_var v2x_varid" ) + call check( nf90_def_var(self%ncid, V2Y_VARNAME, self%out_type, [self%encid_dimid, self%time_dimid], self%v2y_varid), "encounter_io_initialize_output nf90_def_var v2y_varid" ) + call check( nf90_def_var(self%ncid, V2Z_VARNAME, self%out_type, [self%encid_dimid, self%time_dimid], self%v2z_varid), "encounter_io_initialize_output nf90_def_var v2z_varid" ) + call check( nf90_def_var(self%ncid, LEVEL_VARNAME, NF90_INT, [self%encid_dimid, self%time_dimid], self%level_varid), "encounter_io_initialize_output nf90_def_var level_varid" ) + + + ! Take the file out of define mode + call check( nf90_enddef(self%ncid), "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 @@ -44,6 +103,18 @@ module subroutine encounter_io_open_file(self, param, readonly) 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, status + character(len=NF90_MAX_NAME) :: str_dim_name + character(len=STRMAX) :: errmsg + + mode = NF90_WRITE + if (present(readonly)) then + if (readonly) mode = NF90_NOWRITE + end if + + write(errmsg,*) "netcdf_open nf90_open ",trim(adjustl(param%outfile)) + call check( nf90_open(self%outfile, mode, self%ncid), errmsg) return end subroutine encounter_io_open_file diff --git a/src/modules/encounter_classes.f90 b/src/modules/encounter_classes.f90 index f41c350e0..144369346 100644 --- a/src/modules/encounter_classes.f90 +++ b/src/modules/encounter_classes.f90 @@ -17,6 +17,24 @@ module encounter_classes public integer(I4B), parameter :: SWEEPDIM = 3 + !! NetCDF dimension and variable names for the enounter save object + character(*), parameter :: ENCID_DIMNAME = "encounter" + character(*), parameter :: NENC_VARNAME = "nenc" + character(*), parameter :: ID1_VARNAME = "id1" + character(*), parameter :: ID2_VARNAME = "id2" + character(*), parameter :: X1X_VARNAME = "x1x" + character(*), parameter :: X1Y_VARNAME = "x1y" + character(*), parameter :: X1Z_VARNAME = "x1z" + character(*), parameter :: X2X_VARNAME = "x2x" + character(*), parameter :: X2Y_VARNAME = "x2y" + character(*), parameter :: X2Z_VARNAME = "x2z" + character(*), parameter :: V1X_VARNAME = "v1x" + character(*), parameter :: V1Y_VARNAME = "v1y" + character(*), parameter :: V1Z_VARNAME = "v1z" + character(*), parameter :: V2X_VARNAME = "v2x" + character(*), parameter :: V2Y_VARNAME = "v2y" + character(*), parameter :: V2Z_VARNAME = "v2z" + character(*), parameter :: LEVEL_VARNAME = "level" type :: encounter_list integer(I8B) :: nenc = 0 !! Total number of encounters @@ -48,6 +66,26 @@ module encounter_classes end type encounter_storage type, extends(netcdf_parameters) :: encounter_io_parameters + character(STRMAX) :: outfile = "encounter.nc" !! Encounter output file name + integer(I4B) :: encid_dimid !! NetCDF ID for the encounter pair index dimension + integer(I4B) :: encid_varid !! NetCDF ID for the encounter pair index variable + integer(I4B) :: nenc_varid !! NetCDF ID for the number of encounters variable + integer(I4B) :: id1_varid !! NetCDF ID for the id1 of the encounter variable + integer(I4B) :: id2_varid !! NetCDF ID for the id2 of the encounter variable + integer(I4B) :: x1x_varid !! NetCDF ID for the body1 x position variable + integer(I4B) :: x1y_varid !! NetCDF ID for the body1 y position variable + integer(I4B) :: x1z_varid !! NetCDF ID for the body1 z position variable + integer(I4B) :: x2x_varid !! NetCDF ID for the body2 x position variable + integer(I4B) :: x2y_varid !! NetCDF ID for the body2 y position variable + integer(I4B) :: x2z_varid !! NetCDF ID for the body2 z position variable + integer(I4B) :: v1x_varid !! NetCDF ID for the body1 x velocity variable + integer(I4B) :: v1y_varid !! NetCDF ID for the body1 y velocity variable + integer(I4B) :: v1z_varid !! NetCDF ID for the body1 z velocity variable + integer(I4B) :: v2x_varid !! NetCDF ID for the body2 x velocity variable + integer(I4B) :: v2y_varid !! NetCDF ID for the body2 y velocity variable + integer(I4B) :: v2z_varid !! NetCDF ID for the body2 z velocity variable + integer(I4B) :: level_varid !! NetCDF 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 diff --git a/src/modules/swiftest_classes.f90 b/src/modules/swiftest_classes.f90 index f23a3c76e..fe35c647c 100644 --- a/src/modules/swiftest_classes.f90 +++ b/src/modules/swiftest_classes.f90 @@ -496,6 +496,13 @@ 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 diff --git a/src/netcdf/netcdf.f90 b/src/netcdf/netcdf.f90 index 1dd114f92..d0098765d 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 From 88489cb62684b39fc4017fd94fa446ee674fa731 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Fri, 2 Dec 2022 08:34:01 -0500 Subject: [PATCH 186/569] Restructured encounter io with new dimension for the collidiers so I can reuse the regular variables from before --- src/encounter/encounter_io.f90 | 46 ++++++++++++++++++++----------- src/modules/encounter_classes.f90 | 43 +++++++---------------------- src/modules/swiftest_globals.f90 | 1 - 3 files changed, 40 insertions(+), 50 deletions(-) diff --git a/src/encounter/encounter_io.f90 b/src/encounter/encounter_io.f90 index 5530b61e6..f858d83cf 100644 --- a/src/encounter/encounter_io.f90 +++ b/src/encounter/encounter_io.f90 @@ -55,6 +55,7 @@ module subroutine encounter_io_initialize_output(self, param) call check( nf90_def_dim(self%ncid, ENCID_DIMNAME, NF90_UNLIMITED, self%encid_dimid), "encounter_io_initialize_output nf90_def_dim encid_dimid" ) call check( nf90_def_dim(self%ncid, 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%ncid, TIME_DIMNAME, NF90_UNLIMITED, self%time_dimid), "encounter_io_initialize_output nf90_def_dim time_dimid" ) ! 'y' dimension + call check( nf90_def_dim(self%ncid, COLLIDER_DIMNAME, 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") @@ -65,21 +66,16 @@ module subroutine encounter_io_initialize_output(self, param) call check( nf90_def_var(self%ncid, 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%ncid, ENCID_DIMNAME, NF90_INT, self%encid_dimid, self%encid_varid), "encounter_io_initialize_output nf90_def_var encid_varid" ) + call check( nf90_def_var(self%ncid, COLLIDER_DIMNAME, NF90_INT, self%collider_dimid, self%encid_varid), "encounter_io_initialize_output nf90_def_var collider_varid" ) call check( nf90_def_var(self%ncid, 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%ncid, ID1_VARNAME, NF90_INT, [self%encid_dimid, self%time_dimid], self%id1_varid), "encounter_io_initialize_output nf90_def_var id1_varid" ) - call check( nf90_def_var(self%ncid, ID2_VARNAME, NF90_INT, [self%encid_dimid, self%time_dimid], self%id2_varid), "encounter_io_initialize_output nf90_def_var id2_varid" ) - call check( nf90_def_var(self%ncid, X1X_VARNAME, self%out_type, [self%encid_dimid, self%time_dimid], self%x1x_varid), "encounter_io_initialize_output nf90_def_var x1x_varid" ) - call check( nf90_def_var(self%ncid, X1Y_VARNAME, self%out_type, [self%encid_dimid, self%time_dimid], self%x1y_varid), "encounter_io_initialize_output nf90_def_var x1y_varid" ) - call check( nf90_def_var(self%ncid, X1Z_VARNAME, self%out_type, [self%encid_dimid, self%time_dimid], self%x1z_varid), "encounter_io_initialize_output nf90_def_var x1z_varid" ) - call check( nf90_def_var(self%ncid, X2X_VARNAME, self%out_type, [self%encid_dimid, self%time_dimid], self%x2x_varid), "encounter_io_initialize_output nf90_def_var x2x_varid" ) - call check( nf90_def_var(self%ncid, X2Y_VARNAME, self%out_type, [self%encid_dimid, self%time_dimid], self%x2y_varid), "encounter_io_initialize_output nf90_def_var x2y_varid" ) - call check( nf90_def_var(self%ncid, X2Z_VARNAME, self%out_type, [self%encid_dimid, self%time_dimid], self%x2z_varid), "encounter_io_initialize_output nf90_def_var x2z_varid" ) - call check( nf90_def_var(self%ncid, V1X_VARNAME, self%out_type, [self%encid_dimid, self%time_dimid], self%v1x_varid), "encounter_io_initialize_output nf90_def_var v1x_varid" ) - call check( nf90_def_var(self%ncid, V1Y_VARNAME, self%out_type, [self%encid_dimid, self%time_dimid], self%v1y_varid), "encounter_io_initialize_output nf90_def_var v1y_varid" ) - call check( nf90_def_var(self%ncid, V1Z_VARNAME, self%out_type, [self%encid_dimid, self%time_dimid], self%v1z_varid), "encounter_io_initialize_output nf90_def_var v1z_varid" ) - call check( nf90_def_var(self%ncid, V2X_VARNAME, self%out_type, [self%encid_dimid, self%time_dimid], self%v2x_varid), "encounter_io_initialize_output nf90_def_var v2x_varid" ) - call check( nf90_def_var(self%ncid, V2Y_VARNAME, self%out_type, [self%encid_dimid, self%time_dimid], self%v2y_varid), "encounter_io_initialize_output nf90_def_var v2y_varid" ) - call check( nf90_def_var(self%ncid, V2Z_VARNAME, self%out_type, [self%encid_dimid, self%time_dimid], self%v2z_varid), "encounter_io_initialize_output nf90_def_var v2z_varid" ) + call check( nf90_def_var(self%ncid, NAME_VARNAME, NF90_CHAR, [self%str_dimid, self%collider_dimid, self%encid_dimid], self%name_varid), "encounter_io_initialize_output nf90_def_var name_varid" ) + call check( nf90_def_var(self%ncid, ID_DIMNAME, NF90_INT, [self%collider_dimid, self%encid_dimid, self%time_dimid], self%id_varid), "encounter_io_initialize_output nf90_def_var id_varid" ) + call check( nf90_def_var(self%ncid, XHX_VARNAME, self%out_type, [self%collider_dimid, self%encid_dimid, self%time_dimid], self%xhx_varid), "encounter_io_initialize_output nf90_def_var xhx_varid" ) + call check( nf90_def_var(self%ncid, XHY_VARNAME, self%out_type, [self%collider_dimid, self%encid_dimid, self%time_dimid], self%xhy_varid), "encounter_io_initialize_output nf90_def_var xhy_varid" ) + call check( nf90_def_var(self%ncid, XHZ_VARNAME, self%out_type, [self%collider_dimid, self%encid_dimid, self%time_dimid], self%xhz_varid), "encounter_io_initialize_output nf90_def_var xhz_varid" ) + call check( nf90_def_var(self%ncid, VHX_VARNAME, self%out_type, [self%collider_dimid, self%encid_dimid, self%time_dimid], self%vhx_varid), "encounter_io_initialize_output nf90_def_var vhx_varid" ) + call check( nf90_def_var(self%ncid, VHY_VARNAME, self%out_type, [self%collider_dimid, self%encid_dimid, self%time_dimid], self%vhy_varid), "encounter_io_initialize_output nf90_def_var vhy_varid" ) + call check( nf90_def_var(self%ncid, VHZ_VARNAME, self%out_type, [self%collider_dimid, self%encid_dimid, self%time_dimid], self%vhz_varid), "encounter_io_initialize_output nf90_def_var vhz_varid" ) call check( nf90_def_var(self%ncid, LEVEL_VARNAME, NF90_INT, [self%encid_dimid, self%time_dimid], self%level_varid), "encounter_io_initialize_output nf90_def_var level_varid" ) @@ -105,7 +101,6 @@ module subroutine encounter_io_open_file(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 @@ -113,9 +108,28 @@ module subroutine encounter_io_open_file(self, param, readonly) if (readonly) mode = NF90_NOWRITE end if - write(errmsg,*) "netcdf_open nf90_open ",trim(adjustl(param%outfile)) + write(errmsg,*) "encounter_io_open_file nf90_open ",trim(adjustl(param%outfile)) call check( nf90_open(self%outfile, mode, self%ncid), errmsg) + call check( nf90_inq_dimid(self%ncid, TIME_DIMNAME, self%time_dimid), "encounter_io_open_file nf90_inq_dimid time_dimid" ) + call check( nf90_inq_dimid(self%ncid, ENCID_DIMNAME, self%encid_dimid), "encounter_io_open_file nf90_inq_dimid encid_dimid" ) + call check( nf90_inq_dimid(self%ncid, COLLIDER_DIMNAME, self%collider_dimid), "encounter_io_open_file nf90_inq_dimid collider_dimid" ) + call check( nf90_inq_dimid(self%ncid, STR_DIMNAME, self%str_dimid), "encounter_io_open_file nf90_inq_dimid collider_str" ) + + call check( nf90_inq_varid(self%ncid, TIME_DIMNAME, self%time_varid), "encounter_io_open_file nf90_inq_varid time_varid" ) + call check( nf90_inq_varid(self%ncid, ENCID_DIMNAME, self%encid_varid), "encounter_io_open_file nf90_inq_varid encid_varid" ) + call check( nf90_inq_varid(self%ncid, COLLIDER_DIMNAME, self%collider_varid), "encounter_io_open_file nf90_inq_varid collider_varid" ) + call check( nf90_inq_varid(self%ncid, NAME_VARNAME, self%name_varid), "encounter_io_open_file nf90_inq_varid name_varid" ) + call check( nf90_inq_varid(self%ncid, NENC_VARNAME, self%nenc_varid), "encounter_io_open_file nf90_inq_varid nenc_varid" ) + + call check( nf90_inq_varid(self%ncid, XHX_VARNAME, self%xhx_varid), "encounter_io_open_file nf90_inq_varid xhx_varid" ) + call check( nf90_inq_varid(self%ncid, XHY_VARNAME, self%xhy_varid), "encounter_io_open_file nf90_inq_varid xhy_varid" ) + call check( nf90_inq_varid(self%ncid, XHZ_VARNAME, self%xhz_varid), "encounter_io_open_file nf90_inq_varid xhz_varid" ) + call check( nf90_inq_varid(self%ncid, VHX_VARNAME, self%vhx_varid), "encounter_io_open_file nf90_inq_varid vhx_varid" ) + call check( nf90_inq_varid(self%ncid, VHY_VARNAME, self%vhy_varid), "encounter_io_open_file nf90_inq_varid vhy_varid" ) + call check( nf90_inq_varid(self%ncid, VHZ_VARNAME, self%vhz_varid), "encounter_io_open_file nf90_inq_varid vhz_varid" ) + call check( nf90_inq_varid(self%ncid, LEVEL_VARNAME, self%level_varid), "encounter_io_open_file nf90_inq_varid level_varid" ) + return end subroutine encounter_io_open_file diff --git a/src/modules/encounter_classes.f90 b/src/modules/encounter_classes.f90 index 144369346..6f6cfa68f 100644 --- a/src/modules/encounter_classes.f90 +++ b/src/modules/encounter_classes.f90 @@ -17,24 +17,6 @@ module encounter_classes public integer(I4B), parameter :: SWEEPDIM = 3 - !! NetCDF dimension and variable names for the enounter save object - character(*), parameter :: ENCID_DIMNAME = "encounter" - character(*), parameter :: NENC_VARNAME = "nenc" - character(*), parameter :: ID1_VARNAME = "id1" - character(*), parameter :: ID2_VARNAME = "id2" - character(*), parameter :: X1X_VARNAME = "x1x" - character(*), parameter :: X1Y_VARNAME = "x1y" - character(*), parameter :: X1Z_VARNAME = "x1z" - character(*), parameter :: X2X_VARNAME = "x2x" - character(*), parameter :: X2Y_VARNAME = "x2y" - character(*), parameter :: X2Z_VARNAME = "x2z" - character(*), parameter :: V1X_VARNAME = "v1x" - character(*), parameter :: V1Y_VARNAME = "v1y" - character(*), parameter :: V1Z_VARNAME = "v1z" - character(*), parameter :: V2X_VARNAME = "v2x" - character(*), parameter :: V2Y_VARNAME = "v2y" - character(*), parameter :: V2Z_VARNAME = "v2z" - character(*), parameter :: LEVEL_VARNAME = "level" type :: encounter_list integer(I8B) :: nenc = 0 !! Total number of encounters @@ -64,26 +46,21 @@ module encounter_classes contains procedure :: dump => encounter_io_dump_storage_list end type encounter_storage - + + !! NetCDF dimension and variable names for the enounter save object + character(*), parameter :: ENCID_DIMNAME = "encounter" !! The index of the encountering pair in the encounter list + character(*), parameter :: COLLIDER_DIMNAME = "collider" !! Dimension that defines the colliding bodies (bodies 1 and 2 are at dimension coordinates 1 and 2, respectively) + integer(I4B), parameter :: COLLIDER_DIM_SIZE = 2 !! Size of collider dimension + character(*), parameter :: NENC_VARNAME = "nenc" !! Total number of encounters + character(*), parameter :: LEVEL_VARNAME = "level" !! Recursion depth + type, extends(netcdf_parameters) :: encounter_io_parameters character(STRMAX) :: outfile = "encounter.nc" !! Encounter output file name integer(I4B) :: encid_dimid !! NetCDF ID for the encounter pair index dimension + integer(I4B) :: collider_dimid !! NetCDF ID for the collider dimension + integer(I4B) :: collider_varid !! NetCDF ID for the collider variable integer(I4B) :: encid_varid !! NetCDF ID for the encounter pair index variable integer(I4B) :: nenc_varid !! NetCDF ID for the number of encounters variable - integer(I4B) :: id1_varid !! NetCDF ID for the id1 of the encounter variable - integer(I4B) :: id2_varid !! NetCDF ID for the id2 of the encounter variable - integer(I4B) :: x1x_varid !! NetCDF ID for the body1 x position variable - integer(I4B) :: x1y_varid !! NetCDF ID for the body1 y position variable - integer(I4B) :: x1z_varid !! NetCDF ID for the body1 z position variable - integer(I4B) :: x2x_varid !! NetCDF ID for the body2 x position variable - integer(I4B) :: x2y_varid !! NetCDF ID for the body2 y position variable - integer(I4B) :: x2z_varid !! NetCDF ID for the body2 z position variable - integer(I4B) :: v1x_varid !! NetCDF ID for the body1 x velocity variable - integer(I4B) :: v1y_varid !! NetCDF ID for the body1 y velocity variable - integer(I4B) :: v1z_varid !! NetCDF ID for the body1 z velocity variable - integer(I4B) :: v2x_varid !! NetCDF ID for the body2 x velocity variable - integer(I4B) :: v2y_varid !! NetCDF ID for the body2 y velocity variable - integer(I4B) :: v2z_varid !! NetCDF ID for the body2 z velocity variable integer(I4B) :: level_varid !! NetCDF ID for the recursion level variable contains diff --git a/src/modules/swiftest_globals.f90 b/src/modules/swiftest_globals.f90 index f8e5674e4..feeb0ef1c 100644 --- a/src/modules/swiftest_globals.f90 +++ b/src/modules/swiftest_globals.f90 @@ -207,7 +207,6 @@ module swiftest_globals 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 From 41e353e7b96dab3bf3acb3b3e15134596c213146 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Fri, 2 Dec 2022 10:29:39 -0500 Subject: [PATCH 187/569] Added template for a new write_frame method for encounter list objects --- src/encounter/encounter_io.f90 | 15 ++++++++++++++- src/modules/encounter_classes.f90 | 32 +++++++++++++++++++------------ 2 files changed, 34 insertions(+), 13 deletions(-) diff --git a/src/encounter/encounter_io.f90 b/src/encounter/encounter_io.f90 index f858d83cf..4a53e2db6 100644 --- a/src/encounter/encounter_io.f90 +++ b/src/encounter/encounter_io.f90 @@ -100,7 +100,7 @@ module subroutine encounter_io_open_file(self, param, readonly) class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters logical, optional, intent(in) :: readonly !! Logical flag indicating that this should be open read only ! Internals - integer(I4B) :: mode, status + integer(I4B) :: mode character(len=STRMAX) :: errmsg mode = NF90_WRITE @@ -133,4 +133,17 @@ module subroutine encounter_io_open_file(self, param, readonly) 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 + + return + end subroutine encounter_io_write_frame + end submodule s_encounter_io \ No newline at end of file diff --git a/src/modules/encounter_classes.f90 b/src/modules/encounter_classes.f90 index 6f6cfa68f..17bb81d9d 100644 --- a/src/modules/encounter_classes.f90 +++ b/src/modules/encounter_classes.f90 @@ -32,13 +32,14 @@ module encounter_classes real(DP), dimension(:,:), allocatable :: v2 !! the velocity of body 2 in the encounter real(DP), dimension(:), allocatable :: t !! Time of 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 type, extends(swiftest_storage) :: encounter_storage @@ -48,11 +49,11 @@ module encounter_classes end type encounter_storage !! NetCDF dimension and variable names for the enounter save object - character(*), parameter :: ENCID_DIMNAME = "encounter" !! The index of the encountering pair in the encounter list - character(*), parameter :: COLLIDER_DIMNAME = "collider" !! Dimension that defines the colliding bodies (bodies 1 and 2 are at dimension coordinates 1 and 2, respectively) - integer(I4B), parameter :: COLLIDER_DIM_SIZE = 2 !! Size of collider dimension - character(*), parameter :: NENC_VARNAME = "nenc" !! Total number of encounters - character(*), parameter :: LEVEL_VARNAME = "level" !! Recursion depth + character(*), parameter :: ENCID_DIMNAME = "encounter" !! The index of the encountering pair in the encounter list + character(*), parameter :: COLLIDER_DIMNAME = "collider" !! Dimension that defines the colliding bodies (bodies 1 and 2 are at dimension coordinates 1 and 2, respectively) + integer(I4B), parameter :: COLLIDER_DIM_SIZE = 2 !! Size of collider dimension + character(*), parameter :: NENC_VARNAME = "nenc" !! Total number of encounters + character(*), parameter :: LEVEL_VARNAME = "level" !! Recursion depth type, extends(netcdf_parameters) :: encounter_io_parameters character(STRMAX) :: outfile = "encounter.nc" !! Encounter output file name @@ -219,6 +220,13 @@ module subroutine encounter_io_open_file(self, param, readonly) 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 + 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) implicit none class(encounter_bounding_box), intent(inout) :: self !! Swiftest encounter structure From 49133c6afadfb5bd9beeae9d933f4e520751c174 Mon Sep 17 00:00:00 2001 From: MintoDA1 <51412913+MintoDA1@users.noreply.github.com> Date: Fri, 2 Dec 2022 10:43:34 -0500 Subject: [PATCH 188/569] Updated comment to be more accurate --- src/symba/symba_encounter_check.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/symba/symba_encounter_check.f90 b/src/symba/symba_encounter_check.f90 index 035d7fd3c..f574a9a3e 100644 --- a/src/symba/symba_encounter_check.f90 +++ b/src/symba/symba_encounter_check.f90 @@ -85,7 +85,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 From c927119872c122a33e6a1f43ce3d1a19cae66184 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Fri, 2 Dec 2022 11:06:12 -0500 Subject: [PATCH 189/569] Fixed problem where encounter checks were using heliocentric instead of barycentric velocities --- src/symba/symba_encounter_check.f90 | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/src/symba/symba_encounter_check.f90 b/src/symba/symba_encounter_check.f90 index 035d7fd3c..48672142e 100644 --- a/src/symba/symba_encounter_check.f90 +++ b/src/symba/symba_encounter_check.f90 @@ -43,10 +43,10 @@ module function symba_encounter_check_pl(self, param, system, dt, irec) result(l call pl%set_renc(irec) if (nplt == 0) then - call encounter_check_all_plpl(param, npl, pl%xh, pl%vh, pl%renc, dt, nenc, index1, index2, lvdotr) + call encounter_check_all_plpl(param, npl, pl%xh, pl%vb, pl%renc, dt, nenc, index1, index2, lvdotr) else - call encounter_check_all_plplm(param, nplm, nplt, pl%xh(:,1:nplm), pl%vh(:,1:nplm), pl%xh(:,nplm+1:npl), & - pl%vh(:,nplm+1:npl), pl%renc(1:nplm), pl%renc(nplm+1:npl), dt, nenc, index1, index2, lvdotr) + call encounter_check_all_plplm(param, nplm, nplt, pl%xh(:,1:nplm), pl%vb(:,1:nplm), pl%xh(:,nplm+1:npl), & + pl%vb(:,nplm+1:npl), pl%renc(1:nplm), pl%renc(nplm+1:npl), dt, nenc, index1, index2, lvdotr) end if lany_encounter = nenc > 0_I8B @@ -136,7 +136,7 @@ module function symba_encounter_check(self, param, system, dt, irec) result(lany i = self%index1(k) j = self%index2(k) xr(:) = pl%xh(:,j) - pl%xh(:,i) - vr(:) = pl%vh(:,j) - pl%vh(:,i) + vr(:) = pl%vb(:,j) - pl%vb(:,i) rcrit12 = pl%renc(i) + pl%renc(j) call encounter_check_one(xr(1), xr(2), xr(3), vr(1), vr(2), vr(3), rcrit12, dt, lencounter(lidx), self%lvdotr(k)) if (lencounter(lidx)) then @@ -151,7 +151,7 @@ module function symba_encounter_check(self, param, system, dt, irec) result(lany i = self%index1(k) j = self%index2(k) xr(:) = tp%xh(:,j) - pl%xh(:,i) - vr(:) = tp%vh(:,j) - pl%vh(:,i) + vr(:) = tp%vb(:,j) - pl%vb(:,i) call encounter_check_one(xr(1), xr(2), xr(3), vr(1), vr(2), vr(3), pl%renc(i), dt, & lencounter(lidx), self%lvdotr(k)) if (lencounter(lidx)) then @@ -213,7 +213,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%vh, tp%xh, tp%vh, pl%renc, dt, nenc, index1, index2, lvdotr) + call encounter_check_all_pltp(param, npl, ntp, pl%xh, pl%vb, tp%xh, tp%vb, pl%renc, dt, nenc, index1, index2, lvdotr) lany_encounter = nenc > 0 if (lany_encounter) then From eb7bf33ffacb075e2097ea2279d839566383d05c Mon Sep 17 00:00:00 2001 From: Carlisle Wishard Date: Fri, 2 Dec 2022 11:08:45 -0500 Subject: [PATCH 190/569] updated output_reader.py to reflect new IO syntax --- examples/Basic_Simulation/output_reader.py | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/examples/Basic_Simulation/output_reader.py b/examples/Basic_Simulation/output_reader.py index 539038291..b171eb402 100644 --- a/examples/Basic_Simulation/output_reader.py +++ b/examples/Basic_Simulation/output_reader.py @@ -29,7 +29,7 @@ import matplotlib.pyplot as plt # Read in the simulation output and store it as an Xarray dataset -ds = swiftest.Simulation(param_file="param.in").ds +ds = swiftest.Simulation(param_file="simdata/param.in", read_old_output_file=True).data # Plot of the data and save the output plot colors = ['white' if x == 'Massive Body' else 'black' for x in ds['particle_type']] From 3742cc8c730e8429166c257f6458c82f57337b42 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Fri, 2 Dec 2022 11:06:12 -0500 Subject: [PATCH 191/569] Fixed problem where encounter checks were using heliocentric instead of barycentric velocities --- src/symba/symba_encounter_check.f90 | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/src/symba/symba_encounter_check.f90 b/src/symba/symba_encounter_check.f90 index 035d7fd3c..48672142e 100644 --- a/src/symba/symba_encounter_check.f90 +++ b/src/symba/symba_encounter_check.f90 @@ -43,10 +43,10 @@ module function symba_encounter_check_pl(self, param, system, dt, irec) result(l call pl%set_renc(irec) if (nplt == 0) then - call encounter_check_all_plpl(param, npl, pl%xh, pl%vh, pl%renc, dt, nenc, index1, index2, lvdotr) + call encounter_check_all_plpl(param, npl, pl%xh, pl%vb, pl%renc, dt, nenc, index1, index2, lvdotr) else - call encounter_check_all_plplm(param, nplm, nplt, pl%xh(:,1:nplm), pl%vh(:,1:nplm), pl%xh(:,nplm+1:npl), & - pl%vh(:,nplm+1:npl), pl%renc(1:nplm), pl%renc(nplm+1:npl), dt, nenc, index1, index2, lvdotr) + call encounter_check_all_plplm(param, nplm, nplt, pl%xh(:,1:nplm), pl%vb(:,1:nplm), pl%xh(:,nplm+1:npl), & + pl%vb(:,nplm+1:npl), pl%renc(1:nplm), pl%renc(nplm+1:npl), dt, nenc, index1, index2, lvdotr) end if lany_encounter = nenc > 0_I8B @@ -136,7 +136,7 @@ module function symba_encounter_check(self, param, system, dt, irec) result(lany i = self%index1(k) j = self%index2(k) xr(:) = pl%xh(:,j) - pl%xh(:,i) - vr(:) = pl%vh(:,j) - pl%vh(:,i) + vr(:) = pl%vb(:,j) - pl%vb(:,i) rcrit12 = pl%renc(i) + pl%renc(j) call encounter_check_one(xr(1), xr(2), xr(3), vr(1), vr(2), vr(3), rcrit12, dt, lencounter(lidx), self%lvdotr(k)) if (lencounter(lidx)) then @@ -151,7 +151,7 @@ module function symba_encounter_check(self, param, system, dt, irec) result(lany i = self%index1(k) j = self%index2(k) xr(:) = tp%xh(:,j) - pl%xh(:,i) - vr(:) = tp%vh(:,j) - pl%vh(:,i) + vr(:) = tp%vb(:,j) - pl%vb(:,i) call encounter_check_one(xr(1), xr(2), xr(3), vr(1), vr(2), vr(3), pl%renc(i), dt, & lencounter(lidx), self%lvdotr(k)) if (lencounter(lidx)) then @@ -213,7 +213,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%vh, tp%xh, tp%vh, pl%renc, dt, nenc, index1, index2, lvdotr) + call encounter_check_all_pltp(param, npl, ntp, pl%xh, pl%vb, tp%xh, tp%vb, pl%renc, dt, nenc, index1, index2, lvdotr) lany_encounter = nenc > 0 if (lany_encounter) then From de9db5fba167b9f5ef71937f54eb6631a239e8c0 Mon Sep 17 00:00:00 2001 From: Carlisle April Wishard Date: Fri, 2 Dec 2022 11:34:42 -0500 Subject: [PATCH 192/569] added fragmentation example --- .../Fragmentation/swiftest_fragmentation.py | 41 +++++++++++++++++++ 1 file changed, 41 insertions(+) create mode 100644 examples/Fragmentation/swiftest_fragmentation.py diff --git a/examples/Fragmentation/swiftest_fragmentation.py b/examples/Fragmentation/swiftest_fragmentation.py new file mode 100644 index 000000000..241391104 --- /dev/null +++ b/examples/Fragmentation/swiftest_fragmentation.py @@ -0,0 +1,41 @@ +""" + Copyright 2022 - David Minton, Carlisle Wishard, Jennifer Pouplin, Jake Elliott, & Dana Singh + This file is part of Swiftest. + Swiftest is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License + as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. + Swiftest is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty + of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. + You should have received a copy of the GNU General Public License along with Swiftest. + If not, see: https://www.gnu.org/licenses. +""" +#!/usr/bin/env python3 +""" +Generates a set of Swiftest input files from initial conditions, runs Swiftest, and generates fragmentation movies. +Returns +------- +Updates sim.data with the simulation data, produces fragmentation movies. +""" +import swiftest +import numpy as np +from numpy.random import default_rng + +sim_disruption = swiftest.Simulation(param_file="param.disruption.in", output_file_name="disruption.nc", tstart=0.0, tstop=1.0e-5, dt=1.0e-8, istep_out=1.0, fragmentation=True, minimum_fragment_gmass=1.0e-11, gmtiny=1.0e-11, output_file_format="XVEL", init_cond_format="XV") +sim_disruption.add_solar_system_body(["Sun"]) +sim_disruption.add_body(name="Target", v1=1.0, v2=-1.807993e-05, v3=0.0, v4=-2.562596e-04, v5=6.280005, v6=0.0, idvals=1, Gmass=1e-7, radius=7e-6, rhill=9e-4, Ip1=0.4, Ip2=0.4, Ip3=0.4, rotx=0.0, roty=0.0, rotz=0.0) +sim_disruption.add_body(name="Projectile", v1=1.0, v2=1.807993e-05, v3=0.0, v4=-2.562596e-04, v5=-6.280005, v6=0.0, idvals=2, Gmass=7e-10, radius=3.25e-6, rhill=4e-4, Ip1=0.4, Ip2=0.4, Ip3=0.4, rotx=0.0, roty=0.0, rotz=0.0) +sim_disruption.get_parameter() +sim_disruption.run() + +sim_hitandrun = swiftest.Simulation(param_file="param.hitandrun.in", output_file_name="hitandrun.nc", tstart=0.0, tstop=1.0e-5, dt=1.0e-8, istep_out=1.0, fragmentation=True, minimum_fragment_gmass=1.0e-11, gmtiny=1.0e-11, output_file_format="XVEL", init_cond_format="XV") +sim_hitandrun.add_solar_system_body(["Sun"]) +sim_hitandrun.add_body(name="Target", v1=1.0, v2=-4.2e-05, v3=0.0, v4=0.0, v5=6.28, v6=0.0, idvals=1, Gmass=1e-7, radius=7e-6, rhill=9e-4, Ip1=0.4, Ip2=0.4, Ip3=0.4, rotx=0.0, roty=0.0, rotz=6.0e4) +sim_hitandrun.add_body(name="Projectile", v1=1.0, v2=4.2e-05, v3=0.0, v4=-1.5, v5=-6.28, v6=0.0, idvals=2, Gmass=7e-10, radius=3.25e-6, rhill=4e-4, Ip1=0.4, Ip2=0.4, Ip3=0.4, rotx=0.0, roty=0.0, rotz=1.0e5) +sim_hitandrun.get_parameter() +sim_hitandrun.run() + +sim_supercat = swiftest.Simulation(param_file="param.supercat.in", output_file_name="supercat.nc", tstart=0.0, tstop=1.0e-5, dt=1.0e-8, istep_out=1.0, fragmentation=True, minimum_fragment_gmass=1.0e-11, gmtiny=1.0e-11, output_file_format="XVEL", init_cond_format="XV") +sim_supercat.add_solar_system_body(["Sun"]) +sim_supercat.add_body(name="Target", v1=1.0, v2=-4.2e-05, v3=0.0, v4=0.0, v5=6.28, v6=0.0, idvals=1, Gmass=1e-7, radius=7e-6, rhill=9e-4, Ip1=0.4, Ip2=0.4, Ip3=0.4, rotx=0.0, roty=0.0, rotz=-6.0e4) +sim_supercat.add_body(name="Projectile", v1=1.0, v2=4.2e-05, v3=0.0, v4=1.0, v5=-6.28, v6=0.0, idvals=2, Gmass=1e-8, radius=3.25e-6, rhill=4e-4, Ip1=0.4, Ip2=0.4, Ip3=0.4, rotx=0.0, roty=0.0, rotz=1.0e5) +sim_supercat.get_parameter() +sim_supercat.run() From 82c93299426345e493675d0b2d98324450868c30 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Fri, 2 Dec 2022 12:27:05 -0500 Subject: [PATCH 193/569] Added a resize method and more operations leading up to saving the encounter list history --- src/encounter/encounter_util.f90 | 38 +++++++++++++++++++++++++++++ src/modules/encounter_classes.f90 | 8 +++++- src/modules/symba_classes.f90 | 1 + src/symba/symba_encounter_check.f90 | 10 ++++++-- src/symba/symba_step.f90 | 1 + 5 files changed, 55 insertions(+), 3 deletions(-) diff --git a/src/encounter/encounter_util.f90 b/src/encounter/encounter_util.f90 index 76ac0e492..8cdc5c94f 100644 --- a/src/encounter/encounter_util.f90 +++ b/src/encounter/encounter_util.f90 @@ -176,6 +176,44 @@ module subroutine encounter_util_resize_list(self, nnew) end subroutine encounter_util_resize_list + module subroutine encounter_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(encounter_storage(*)), allocatable, 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) + if (lmalloc) then + nold = self%nframes + else + nold = 0 + end if + + if (nnew > nold) then + allocate(encounter_storage(nnew) :: tmp) + if (lmalloc) then + do i = 1, nold + if (allocated(self%frame(i)%item)) tmp%frame(i) = self%frame(i)%item + end do + deallocate(self) + end if + call move_alloc(tmp,self) + end if + + return + end subroutine encounter_util_resize_storage + module subroutine encounter_util_spill_list(self, discards, lspill_list, ldestructive) !! author: David A. Minton !! diff --git a/src/modules/encounter_classes.f90 b/src/modules/encounter_classes.f90 index 17bb81d9d..10c9cceec 100644 --- a/src/modules/encounter_classes.f90 +++ b/src/modules/encounter_classes.f90 @@ -43,7 +43,7 @@ module encounter_classes end type encounter_list type, extends(swiftest_storage) :: encounter_storage - !! A class that that is used to store simulation history data between file output + !! A class that that is used to store simulation history data between file output contains procedure :: dump => encounter_io_dump_storage_list end type encounter_storage @@ -279,6 +279,12 @@ module subroutine encounter_util_resize_list(self, nnew) integer(I8B), intent(in) :: nnew !! New size of list needed end subroutine encounter_util_resize_list + module subroutine encounter_util_resize_storage(self, nnew) + implicit none + class(encounter_storage(*)), allocatable, intent(inout) :: self !! Swiftest encounter list + integer(I4B), intent(in) :: nnew !! New size of list needed + end subroutine encounter_util_resize_storage + module subroutine encounter_util_spill_list(self, discards, lspill_list, ldestructive) implicit none class(encounter_list), intent(inout) :: self !! Swiftest encounter list diff --git a/src/modules/symba_classes.f90 b/src/modules/symba_classes.f90 index 988d75d95..f303d6143 100644 --- a/src/modules/symba_classes.f90 +++ b/src/modules/symba_classes.f90 @@ -186,6 +186,7 @@ module symba_classes 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 + integer(I4B) :: iframe = 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 diff --git a/src/symba/symba_encounter_check.f90 b/src/symba/symba_encounter_check.f90 index 26996302f..8983dfa97 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, iframe => system%iframe, encounter_history => system%encounter_history) npl = pl%nbody nplm = pl%nplm @@ -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%xh(:,i) + plplenc_list%x2(:,k) = pl%xh(:,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 @@ -74,6 +78,8 @@ module function symba_encounter_check_pl(self, param, system, dt, irec) result(l pl%nplenc(i) = pl%nplenc(i) + 1 pl%nplenc(j) = pl%nplenc(j) + 1 end do + iframe = iframe + 1 + encounter_history%frame(iframe) = plplenc_list end if end associate diff --git a/src/symba/symba_step.f90 b/src/symba/symba_step.f90 index e24eeec31..d936ebcea 100644 --- a/src/symba/symba_step.f90 +++ b/src/symba/symba_step.f90 @@ -275,6 +275,7 @@ 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%iframe = 0 if (npl > 0) then pl%lcollision(1:npl) = .false. call pl%reset_kinship([(i, i=1, npl)]) From 538310cf552aa354d3883b0305ae49a4adfeb0a0 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Fri, 2 Dec 2022 14:35:06 -0500 Subject: [PATCH 194/569] updated resizer to double the size each time it needs to grow --- src/encounter/encounter_util.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/encounter/encounter_util.f90 b/src/encounter/encounter_util.f90 index 8cdc5c94f..c2597377a 100644 --- a/src/encounter/encounter_util.f90 +++ b/src/encounter/encounter_util.f90 @@ -201,7 +201,7 @@ module subroutine encounter_util_resize_storage(self, nnew) end if if (nnew > nold) then - allocate(encounter_storage(nnew) :: tmp) + allocate(encounter_storage(2 * nnew) :: tmp) if (lmalloc) then do i = 1, nold if (allocated(self%frame(i)%item)) tmp%frame(i) = self%frame(i)%item From 813c736fb8dca38ec5d85a6d7f9f415210a01ee6 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Fri, 2 Dec 2022 15:06:30 -0500 Subject: [PATCH 195/569] Added mass, radius, and name variables to encounter list. Also added collision time to SyMBAs version of the list. Added methods needed for basic operations on the lists --- src/encounter/encounter_setup.f90 | 26 ++++++++++++++++++++++--- src/encounter/encounter_util.f90 | 30 +++++++++++++++++++++++++---- src/modules/encounter_classes.f90 | 30 +++++++++++++++++------------ src/modules/symba_classes.f90 | 17 ++++++++-------- src/symba/symba_collision.f90 | 2 +- src/symba/symba_encounter_check.f90 | 15 ++++++++++++--- src/symba/symba_setup.f90 | 3 +++ src/symba/symba_step.f90 | 3 ++- src/symba/symba_util.f90 | 26 ++++++++++++++++++++++--- 9 files changed, 117 insertions(+), 35 deletions(-) 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 c2597377a..e6d70dd53 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,7 +70,12 @@ 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 @@ -104,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 @@ -214,6 +230,7 @@ module subroutine encounter_util_resize_storage(self, nnew) return end subroutine encounter_util_resize_storage + module subroutine encounter_util_spill_list(self, discards, lspill_list, ldestructive) !! author: David A. Minton !! @@ -238,7 +255,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/modules/encounter_classes.f90 b/src/modules/encounter_classes.f90 index 10c9cceec..b8f26ce23 100644 --- a/src/modules/encounter_classes.f90 +++ b/src/modules/encounter_classes.f90 @@ -19,18 +19,24 @@ 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 diff --git a/src/modules/symba_classes.f90 b/src/modules/symba_classes.f90 index f303d6143..139b221e0 100644 --- a/src/modules/symba_classes.f90 +++ b/src/modules/symba_classes.f90 @@ -142,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 @@ -180,13 +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 - type(encounter_storage(nframes=:)), allocatable :: encounter_history - integer(I4B) :: iframe = 0 !! Encounter history frame number + 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 diff --git a/src/symba/symba_collision.f90 b/src/symba/symba_collision.f90 index e839af1de..04ec18b46 100644 --- a/src/symba/symba_collision.f90 +++ b/src/symba/symba_collision.f90 @@ -339,7 +339,7 @@ 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%tcollision(k) = t self%x1(:,k) = pl%xh(:,i) + system%cb%xb(:) self%v1(:,k) = pl%vb(:,i) if (isplpl) then diff --git a/src/symba/symba_encounter_check.f90 b/src/symba/symba_encounter_check.f90 index 8983dfa97..1e900a94a 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, cb => system%cb, iframe => system%iframe, encounter_history => system%encounter_history) + associate(pl => self, plplenc_list => system%plplenc_list, cb => system%cb, ienc_frame => system%ienc_frame, encounter_history => system%encounter_history) npl = pl%nbody nplm = pl%nplm @@ -69,6 +69,15 @@ module function symba_encounter_check_pl(self, param, system, dt, irec) result(l plplenc_list%x2(:,k) = pl%xh(:,j) plplenc_list%v1(:,k) = pl%vb(:,i) - cb%vb(:) plplenc_list%v2(:,k) = pl%vb(:,j) - cb%vb(:) + plplenc_list%Gmass1(k) = pl%Gmass(i) + plplenc_list%Gmass2(k) = pl%Gmass(j) + if (param%lclose) then + plplenc_list%radius1(k) = pl%radius(i) + plplenc_list%radius2(k) = pl%radius(j) + end if + plplenc_list%name1(k) = pl%info(i)%name + plplenc_list%name2(k) = pl%info(j)%name + pl%lencounter(i) = .true. pl%lencounter(j) = .true. pl%levelg(i) = irec @@ -78,8 +87,8 @@ module function symba_encounter_check_pl(self, param, system, dt, irec) result(l pl%nplenc(i) = pl%nplenc(i) + 1 pl%nplenc(j) = pl%nplenc(j) + 1 end do - iframe = iframe + 1 - encounter_history%frame(iframe) = plplenc_list + ienc_frame = ienc_frame + 1 + encounter_history%frame(ienc_frame) = plplenc_list end if end associate 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 d936ebcea..29011331d 100644 --- a/src/symba/symba_step.f90 +++ b/src/symba/symba_step.f90 @@ -275,7 +275,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%iframe = 0 + 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 6f53d6bbd..805addee8 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 @@ -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)) From fee22243f20764647dfdbc38d670b88f1205bc71 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Fri, 2 Dec 2022 15:22:33 -0500 Subject: [PATCH 196/569] Added encounter history file dump operation --- src/symba/symba_step.f90 | 1 + 1 file changed, 1 insertion(+) diff --git a/src/symba/symba_step.f90 b/src/symba/symba_step.f90 index 29011331d..183105b35 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) From ad01e29972972a9de58503d407073dc8fb55dbe5 Mon Sep 17 00:00:00 2001 From: David Minton Date: Fri, 2 Dec 2022 15:38:57 -0500 Subject: [PATCH 197/569] Added enc_file to the encounter_io_parameters data type --- src/modules/encounter_classes.f90 | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/src/modules/encounter_classes.f90 b/src/modules/encounter_classes.f90 index b8f26ce23..49678f388 100644 --- a/src/modules/encounter_classes.f90 +++ b/src/modules/encounter_classes.f90 @@ -62,13 +62,13 @@ module encounter_classes character(*), parameter :: LEVEL_VARNAME = "level" !! Recursion depth type, extends(netcdf_parameters) :: encounter_io_parameters - character(STRMAX) :: outfile = "encounter.nc" !! Encounter output file name - integer(I4B) :: encid_dimid !! NetCDF ID for the encounter pair index dimension - integer(I4B) :: collider_dimid !! NetCDF ID for the collider dimension - integer(I4B) :: collider_varid !! NetCDF ID for the collider variable - integer(I4B) :: encid_varid !! NetCDF ID for the encounter pair index variable - integer(I4B) :: nenc_varid !! NetCDF ID for the number of encounters variable - integer(I4B) :: level_varid !! NetCDF ID for the recursion level variable + character(STRMAX) :: enc_file = "encounter.nc" !! Encounter output file name + integer(I4B) :: encid_dimid !! NetCDF ID for the encounter pair index dimension + integer(I4B) :: collider_dimid !! NetCDF ID for the collider dimension + integer(I4B) :: collider_varid !! NetCDF ID for the collider variable + integer(I4B) :: encid_varid !! NetCDF ID for the encounter pair index variable + integer(I4B) :: nenc_varid !! NetCDF ID for the number of encounters variable + integer(I4B) :: level_varid !! NetCDF 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 From f7b3b38d0b2e6906dcca48f2b4900dda181a13d1 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Fri, 2 Dec 2022 15:45:08 -0500 Subject: [PATCH 198/569] Added file i/o parameters to the encounter history storage --- src/encounter/encounter_io.f90 | 23 ++++++++++++++++------- src/io/io.f90 | 7 ++++--- src/modules/encounter_classes.f90 | 21 +++++++++++---------- src/modules/swiftest_classes.f90 | 7 ++++--- 4 files changed, 35 insertions(+), 23 deletions(-) diff --git a/src/encounter/encounter_io.f90 b/src/encounter/encounter_io.f90 index 4a53e2db6..9ab5947b1 100644 --- a/src/encounter/encounter_io.f90 +++ b/src/encounter/encounter_io.f90 @@ -12,14 +12,23 @@ use netcdf contains - module subroutine encounter_io_dump_storage_list(self, param) + module subroutine encounter_io_dump_storage_list(self, param, system) !! 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 + class(encounter_storage(*)), intent(inout) :: self !! Encounter storage object + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + class(swiftest_nbody_system), intent(in), optional :: system !! Swiftest nbody system object + ! Internals + + ! Most of this is just temporary test code just to get something working. Eventually this should get cleaned up. + + + + + return end subroutine encounter_io_dump_storage_list @@ -44,13 +53,13 @@ module subroutine encounter_io_initialize_output(self, param) sfill = ieee_value(sfill, IEEE_QUIET_NAN) ! Check if the file exists, and if it does, delete it - inquire(file=param%outfile, exist=fileExists) + inquire(file=self%enc_file, exist=fileExists) if (fileExists) then - open(unit=LUN, file=self%outfile, status="old", err=667, iomsg=errmsg) + 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%outfile, NF90_NETCDF4, self%ncid), "encounter_io_initialize_output nf90_create" ) + call check( nf90_create(self%enc_file, NF90_NETCDF4, self%ncid), "encounter_io_initialize_output nf90_create" ) call check( nf90_def_dim(self%ncid, ENCID_DIMNAME, NF90_UNLIMITED, self%encid_dimid), "encounter_io_initialize_output nf90_def_dim encid_dimid" ) call check( nf90_def_dim(self%ncid, STR_DIMNAME, NAMELEN, self%str_dimid), "encounter_io_initialize_output nf90_def_dim str_dimid" ) ! Dimension for string variables (aka character arrays) @@ -109,7 +118,7 @@ module subroutine encounter_io_open_file(self, param, readonly) end if write(errmsg,*) "encounter_io_open_file nf90_open ",trim(adjustl(param%outfile)) - call check( nf90_open(self%outfile, mode, self%ncid), errmsg) + call check( nf90_open(self%enc_file, mode, self%ncid), errmsg) call check( nf90_inq_dimid(self%ncid, TIME_DIMNAME, self%time_dimid), "encounter_io_open_file nf90_inq_dimid time_dimid" ) call check( nf90_inq_dimid(self%ncid, ENCID_DIMNAME, self%encid_dimid), "encounter_io_open_file nf90_inq_dimid encid_dimid" ) diff --git a/src/io/io.f90 b/src/io/io.f90 index e8936d018..85a8d42b3 100644 --- a/src/io/io.f90 +++ b/src/io/io.f90 @@ -270,7 +270,7 @@ module subroutine io_dump_system(self, param) end subroutine io_dump_system - module subroutine io_dump_storage(self, param) + module subroutine io_dump_storage(self, param, system) !! 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,8 +279,9 @@ module subroutine io_dump_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 + class(swiftest_nbody_system), intent(in), optional :: system !! Swiftest nbody system object (Note, only here so that it can be used in the extended type for encounter_storage) ! Internals integer(I4B) :: i integer(I8B) :: iloop_start diff --git a/src/modules/encounter_classes.f90 b/src/modules/encounter_classes.f90 index 49678f388..b3d913f02 100644 --- a/src/modules/encounter_classes.f90 +++ b/src/modules/encounter_classes.f90 @@ -48,12 +48,6 @@ module encounter_classes final :: encounter_util_final_list !! Finalize the encounter list - deallocates all allocatables end type encounter_list - type, extends(swiftest_storage) :: encounter_storage - !! A class that that is used to store simulation history data between file output - contains - procedure :: dump => encounter_io_dump_storage_list - end type encounter_storage - !! NetCDF dimension and variable names for the enounter save object character(*), parameter :: ENCID_DIMNAME = "encounter" !! The index of the encountering pair in the encounter list character(*), parameter :: COLLIDER_DIMNAME = "collider" !! Dimension that defines the colliding bodies (bodies 1 and 2 are at dimension coordinates 1 and 2, respectively) @@ -69,12 +63,18 @@ module encounter_classes integer(I4B) :: encid_varid !! NetCDF ID for the encounter pair index variable integer(I4B) :: nenc_varid !! NetCDF ID for the number of encounters variable integer(I4B) :: level_varid !! NetCDF 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 + 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) @@ -207,10 +207,11 @@ 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_dump_storage_list(self, param) + module subroutine encounter_io_dump_storage_list(self, param, system) implicit none - class(encounter_storage(*)), intent(inout) :: self !! Encounter storage object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + class(encounter_storage(*)), intent(inout) :: self !! Encounter storage object + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + class(swiftest_nbody_system), intent(in), optional :: system !! Swiftest nbody system object end subroutine encounter_io_dump_storage_list module subroutine encounter_io_initialize_output(self, param) diff --git a/src/modules/swiftest_classes.f90 b/src/modules/swiftest_classes.f90 index fe35c647c..fa0bdf865 100644 --- a/src/modules/swiftest_classes.f90 +++ b/src/modules/swiftest_classes.f90 @@ -632,10 +632,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_storage(self, param) + module subroutine io_dump_storage(self, param, system) implicit none - class(swiftest_storage(*)), intent(inout) :: self !! Swiftest simulation history storage object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + class(swiftest_storage(*)), intent(inout) :: self !! Swiftest simulation history storage object + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + class(swiftest_nbody_system), intent(in), optional :: system !! Swiftest nbody system object end subroutine io_dump_storage module subroutine io_get_args(integrator, param_file_name, display_style) From 9bb2bda37383b2709d7556456ec58d5222047fe1 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Fri, 2 Dec 2022 16:12:35 -0500 Subject: [PATCH 199/569] removed the unneeded system variable from the dump implementation --- src/io/io.f90 | 3 +-- src/modules/swiftest_classes.f90 | 3 +-- 2 files changed, 2 insertions(+), 4 deletions(-) diff --git a/src/io/io.f90 b/src/io/io.f90 index 85a8d42b3..b0a752863 100644 --- a/src/io/io.f90 +++ b/src/io/io.f90 @@ -270,7 +270,7 @@ module subroutine io_dump_system(self, param) end subroutine io_dump_system - module subroutine io_dump_storage(self, param, system) + 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 @@ -281,7 +281,6 @@ module subroutine io_dump_storage(self, param, system) ! Arguments class(swiftest_storage(*)), intent(inout) :: self !! Swiftest simulation history storage object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - class(swiftest_nbody_system), intent(in), optional :: system !! Swiftest nbody system object (Note, only here so that it can be used in the extended type for encounter_storage) ! Internals integer(I4B) :: i integer(I8B) :: iloop_start diff --git a/src/modules/swiftest_classes.f90 b/src/modules/swiftest_classes.f90 index fa0bdf865..8ddaf0c65 100644 --- a/src/modules/swiftest_classes.f90 +++ b/src/modules/swiftest_classes.f90 @@ -632,11 +632,10 @@ 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_storage(self, param, system) + 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 - class(swiftest_nbody_system), intent(in), optional :: system !! Swiftest nbody system object end subroutine io_dump_storage module subroutine io_get_args(integrator, param_file_name, display_style) From 8b431a021b79a3ec11c76fdbbbc02954daae0df4 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Fri, 2 Dec 2022 16:16:27 -0500 Subject: [PATCH 200/569] More updates to encounter write methods --- src/encounter/encounter_io.f90 | 28 ++++++++++++++++++++++------ src/modules/encounter_classes.f90 | 4 ++-- 2 files changed, 24 insertions(+), 8 deletions(-) diff --git a/src/encounter/encounter_io.f90 b/src/encounter/encounter_io.f90 index 9ab5947b1..33915313d 100644 --- a/src/encounter/encounter_io.f90 +++ b/src/encounter/encounter_io.f90 @@ -12,7 +12,7 @@ use netcdf contains - module subroutine encounter_io_dump_storage_list(self, param, system) + module subroutine encounter_io_dump_storage_list(self, param) !! author: David A. Minton !! !! Dumps the time history of an encounter to file. @@ -20,12 +20,21 @@ module subroutine encounter_io_dump_storage_list(self, param, system) ! Arguments class(encounter_storage(*)), intent(inout) :: self !! Encounter storage object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - class(swiftest_nbody_system), intent(in), optional :: system !! Swiftest nbody system object ! 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 @@ -42,12 +51,10 @@ module subroutine encounter_io_initialize_output(self, param) 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 - integer(I4B) :: nvar, varid, vartype real(DP) :: dfill real(SP) :: sfill logical :: fileExists character(len=STRMAX) :: errmsg - integer(I4B) :: ndims dfill = ieee_value(dfill, IEEE_QUIET_NAN) sfill = ieee_value(sfill, IEEE_QUIET_NAN) @@ -151,6 +158,15 @@ module subroutine encounter_io_write_frame(self, iu, param) 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%ncid, nf90_nofill, old_mode), "encounter_io_write_frame_base nf90_set_fill" ) + call check( nf90_put_var(iu%ncid, iu%time_varid, self%t, start=[i]), "netcdf_write_hdr_system nf90_put_var time_varid" ) + call check( nf90_put_var(iu%ncid, iu%xhx_varid, self%x1(1, 1), start=[1, 1, i]), "netcdf_write_frame_base nf90_put_var xhx_varid" ) + return end subroutine encounter_io_write_frame diff --git a/src/modules/encounter_classes.f90 b/src/modules/encounter_classes.f90 index b3d913f02..585992384 100644 --- a/src/modules/encounter_classes.f90 +++ b/src/modules/encounter_classes.f90 @@ -63,6 +63,7 @@ module encounter_classes integer(I4B) :: encid_varid !! NetCDF ID for the encounter pair index variable integer(I4B) :: nenc_varid !! NetCDF ID for the number of encounters variable integer(I4B) :: level_varid !! NetCDF ID for the recursion level variable + integer(I4B) :: ienc_frame !! Current frame number for the encounter history 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 @@ -207,11 +208,10 @@ 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_dump_storage_list(self, param, system) + 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 - class(swiftest_nbody_system), intent(in), optional :: system !! Swiftest nbody system object end subroutine encounter_io_dump_storage_list module subroutine encounter_io_initialize_output(self, param) From 83f72dc6b2200aba3e908f49eb1d9256801bf662 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Fri, 2 Dec 2022 16:26:27 -0500 Subject: [PATCH 201/569] Added the rest of the write statements --- src/encounter/encounter_io.f90 | 23 ++++++++++++++++++++++- 1 file changed, 22 insertions(+), 1 deletion(-) diff --git a/src/encounter/encounter_io.f90 b/src/encounter/encounter_io.f90 index 33915313d..39c1c84cd 100644 --- a/src/encounter/encounter_io.f90 +++ b/src/encounter/encounter_io.f90 @@ -93,6 +93,8 @@ module subroutine encounter_io_initialize_output(self, param) call check( nf90_def_var(self%ncid, VHY_VARNAME, self%out_type, [self%collider_dimid, self%encid_dimid, self%time_dimid], self%vhy_varid), "encounter_io_initialize_output nf90_def_var vhy_varid" ) call check( nf90_def_var(self%ncid, VHZ_VARNAME, self%out_type, [self%collider_dimid, self%encid_dimid, self%time_dimid], self%vhz_varid), "encounter_io_initialize_output nf90_def_var vhz_varid" ) call check( nf90_def_var(self%ncid, LEVEL_VARNAME, NF90_INT, [self%encid_dimid, self%time_dimid], self%level_varid), "encounter_io_initialize_output nf90_def_var level_varid" ) + call check( nf90_def_var(self%ncid, GMASS_VARNAME, self%out_type, [self%collider_dimid, self%encid_dimid, self%time_dimid], self%Gmass_varid), "encounter_io_initialize_output nf90_def_var Gmass_varid" ) + call check( nf90_def_var(self%ncid, RADIUS_VARNAME, self%out_type, [self%collider_dimid, self%encid_dimid, self%time_dimid], self%radius_varid), "encounter_io_initialize_output nf90_def_var radius_varid" ) ! Take the file out of define mode @@ -145,6 +147,8 @@ module subroutine encounter_io_open_file(self, param, readonly) call check( nf90_inq_varid(self%ncid, VHY_VARNAME, self%vhy_varid), "encounter_io_open_file nf90_inq_varid vhy_varid" ) call check( nf90_inq_varid(self%ncid, VHZ_VARNAME, self%vhz_varid), "encounter_io_open_file nf90_inq_varid vhz_varid" ) call check( nf90_inq_varid(self%ncid, LEVEL_VARNAME, self%level_varid), "encounter_io_open_file nf90_inq_varid level_varid" ) + call check( nf90_inq_varid(self%ncid, GMASS_VARNAME, self%Gmass_varid), "encounter_io_open_file nf90_inq_varid Gmass_varid" ) + call check( nf90_inq_varid(self%ncid, RADIUS_VARNAME, self%radius_varid), "encounter_io_open_file nf90_inq_varid radius_varid" ) return end subroutine encounter_io_open_file @@ -165,7 +169,24 @@ module subroutine encounter_io_write_frame(self, iu, param) n = int(self%nenc, kind=I4B) call check( nf90_set_fill(iu%ncid, nf90_nofill, old_mode), "encounter_io_write_frame_base nf90_set_fill" ) call check( nf90_put_var(iu%ncid, iu%time_varid, self%t, start=[i]), "netcdf_write_hdr_system nf90_put_var time_varid" ) - call check( nf90_put_var(iu%ncid, iu%xhx_varid, self%x1(1, 1), start=[1, 1, i]), "netcdf_write_frame_base nf90_put_var xhx_varid" ) + call check( nf90_put_var(iu%ncid, iu%xhx_varid, self%x1(1, :), start=[1, 1, i]), "netcdf_write_frame_base nf90_put_var xhx_varid 1" ) + call check( nf90_put_var(iu%ncid, iu%xhy_varid, self%x1(2, :), start=[1, 1, i]), "netcdf_write_frame_base nf90_put_var xhy_varid 1" ) + call check( nf90_put_var(iu%ncid, iu%xhz_varid, self%x1(3, :), start=[1, 1, i]), "netcdf_write_frame_base nf90_put_var xhz_varid 1" ) + call check( nf90_put_var(iu%ncid, iu%xhx_varid, self%x2(1, :), start=[2, 1, i]), "netcdf_write_frame_base nf90_put_var xhx_varid 2" ) + call check( nf90_put_var(iu%ncid, iu%xhy_varid, self%x2(2, :), start=[2, 1, i]), "netcdf_write_frame_base nf90_put_var xhy_varid 2" ) + call check( nf90_put_var(iu%ncid, iu%xhz_varid, self%x2(3, :), start=[2, 1, i]), "netcdf_write_frame_base nf90_put_var xhz_varid 2" ) + call check( nf90_put_var(iu%ncid, iu%vhx_varid, self%v1(1, :), start=[1, 1, i]), "netcdf_write_frame_base nf90_put_var vhx_varid 1" ) + call check( nf90_put_var(iu%ncid, iu%vhy_varid, self%v1(2, :), start=[1, 1, i]), "netcdf_write_frame_base nf90_put_var vhy_varid 1" ) + call check( nf90_put_var(iu%ncid, iu%vhz_varid, self%v1(3, :), start=[1, 1, i]), "netcdf_write_frame_base nf90_put_var vhz_varid 1" ) + call check( nf90_put_var(iu%ncid, iu%vhx_varid, self%v2(1, :), start=[2, 1, i]), "netcdf_write_frame_base nf90_put_var vhx_varid 2" ) + call check( nf90_put_var(iu%ncid, iu%vhy_varid, self%v2(2, :), start=[2, 1, i]), "netcdf_write_frame_base nf90_put_var vhy_varid 2" ) + call check( nf90_put_var(iu%ncid, iu%vhz_varid, self%v2(3, :), start=[2, 1, i]), "netcdf_write_frame_base nf90_put_var vhz_varid 2" ) + call check( nf90_put_var(iu%ncid, iu%name_varid, self%name1(:), start=[1, 1, i]), "netcdf_write_frame_base nf90_put_var name 1" ) + call check( nf90_put_var(iu%ncid, iu%name_varid, self%name2(:), start=[1, 2, i]), "netcdf_write_frame_base nf90_put_var name 2" ) + call check( nf90_put_var(iu%ncid, iu%Gmass_varid, self%Gmass1(:), start=[1, 1, i]), "netcdf_write_frame_base nf90_put_var Gmass 1" ) + call check( nf90_put_var(iu%ncid, iu%Gmass_varid, self%Gmass2(:), start=[2, 1, i]), "netcdf_write_frame_base nf90_put_var Gmass 2" ) + call check( nf90_put_var(iu%ncid, iu%radius_varid, self%radius1(:), start=[1, 1, i]), "netcdf_write_frame_base nf90_put_var radius 1" ) + call check( nf90_put_var(iu%ncid, iu%radius_varid, self%radius2(:), start=[2, 1, i]), "netcdf_write_frame_base nf90_put_var radius 2" ) return From 7f651c44cbb557d82cdb8dcadffa4861a5b7ab36 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Fri, 2 Dec 2022 16:40:57 -0500 Subject: [PATCH 202/569] Moved the resize storage method to symba_nbody_system so that it can be reallocated --- src/encounter/encounter_util.f90 | 39 ---------------------------- src/modules/encounter_classes.f90 | 8 +----- src/modules/symba_classes.f90 | 7 +++++ src/symba/symba_encounter_check.f90 | 1 + src/symba/symba_util.f90 | 40 +++++++++++++++++++++++++++++ 5 files changed, 49 insertions(+), 46 deletions(-) diff --git a/src/encounter/encounter_util.f90 b/src/encounter/encounter_util.f90 index e6d70dd53..cf7dc3a71 100644 --- a/src/encounter/encounter_util.f90 +++ b/src/encounter/encounter_util.f90 @@ -192,45 +192,6 @@ module subroutine encounter_util_resize_list(self, nnew) end subroutine encounter_util_resize_list - module subroutine encounter_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(encounter_storage(*)), allocatable, 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) - if (lmalloc) then - nold = self%nframes - else - nold = 0 - end if - - if (nnew > nold) then - allocate(encounter_storage(2 * nnew) :: tmp) - if (lmalloc) then - do i = 1, nold - if (allocated(self%frame(i)%item)) tmp%frame(i) = self%frame(i)%item - end do - deallocate(self) - end if - call move_alloc(tmp,self) - end if - - return - end subroutine encounter_util_resize_storage - - module subroutine encounter_util_spill_list(self, discards, lspill_list, ldestructive) !! author: David A. Minton !! diff --git a/src/modules/encounter_classes.f90 b/src/modules/encounter_classes.f90 index 585992384..1f213f84a 100644 --- a/src/modules/encounter_classes.f90 +++ b/src/modules/encounter_classes.f90 @@ -73,7 +73,7 @@ module encounter_classes !! 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 + procedure :: dump => encounter_io_dump_storage_list !! Dumps contents of encounter history to file end type encounter_storage type encounter_bounding_box_1D @@ -286,12 +286,6 @@ module subroutine encounter_util_resize_list(self, nnew) integer(I8B), intent(in) :: nnew !! New size of list needed end subroutine encounter_util_resize_list - module subroutine encounter_util_resize_storage(self, nnew) - implicit none - class(encounter_storage(*)), allocatable, intent(inout) :: self !! Swiftest encounter list - integer(I4B), intent(in) :: nnew !! New size of list needed - end subroutine encounter_util_resize_storage - module subroutine encounter_util_spill_list(self, discards, lspill_list, ldestructive) implicit none class(encounter_list), intent(inout) :: self !! Swiftest encounter list diff --git a/src/modules/symba_classes.f90 b/src/modules/symba_classes.f90 index 139b221e0..cd97b74bd 100644 --- a/src/modules/symba_classes.f90 +++ b/src/modules/symba_classes.f90 @@ -197,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 @@ -700,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/symba/symba_encounter_check.f90 b/src/symba/symba_encounter_check.f90 index 1e900a94a..60febb3fe 100644 --- a/src/symba/symba_encounter_check.f90 +++ b/src/symba/symba_encounter_check.f90 @@ -88,6 +88,7 @@ module function symba_encounter_check_pl(self, param, system, dt, irec) result(l pl%nplenc(j) = pl%nplenc(j) + 1 end do ienc_frame = ienc_frame + 1 + call system%resize_storage(ienc_frame) encounter_history%frame(ienc_frame) = plplenc_list end if diff --git a/src/symba/symba_util.f90 b/src/symba/symba_util.f90 index 805addee8..6b3661abb 100644 --- a/src/symba/symba_util.f90 +++ b/src/symba/symba_util.f90 @@ -900,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(2 * 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 !! From 17e7dcb50fb15dedfb68b5e253e0930e07576ad8 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Fri, 2 Dec 2022 16:54:11 -0500 Subject: [PATCH 203/569] Fixed some NetCDF stuff --- src/encounter/encounter_io.f90 | 36 ++++++++++++++--------------- src/symba/symba_encounter_check.f90 | 4 ++-- 2 files changed, 20 insertions(+), 20 deletions(-) diff --git a/src/encounter/encounter_io.f90 b/src/encounter/encounter_io.f90 index 39c1c84cd..8df13d35c 100644 --- a/src/encounter/encounter_io.f90 +++ b/src/encounter/encounter_io.f90 @@ -169,24 +169,24 @@ module subroutine encounter_io_write_frame(self, iu, param) n = int(self%nenc, kind=I4B) call check( nf90_set_fill(iu%ncid, nf90_nofill, old_mode), "encounter_io_write_frame_base nf90_set_fill" ) call check( nf90_put_var(iu%ncid, iu%time_varid, self%t, start=[i]), "netcdf_write_hdr_system nf90_put_var time_varid" ) - call check( nf90_put_var(iu%ncid, iu%xhx_varid, self%x1(1, :), start=[1, 1, i]), "netcdf_write_frame_base nf90_put_var xhx_varid 1" ) - call check( nf90_put_var(iu%ncid, iu%xhy_varid, self%x1(2, :), start=[1, 1, i]), "netcdf_write_frame_base nf90_put_var xhy_varid 1" ) - call check( nf90_put_var(iu%ncid, iu%xhz_varid, self%x1(3, :), start=[1, 1, i]), "netcdf_write_frame_base nf90_put_var xhz_varid 1" ) - call check( nf90_put_var(iu%ncid, iu%xhx_varid, self%x2(1, :), start=[2, 1, i]), "netcdf_write_frame_base nf90_put_var xhx_varid 2" ) - call check( nf90_put_var(iu%ncid, iu%xhy_varid, self%x2(2, :), start=[2, 1, i]), "netcdf_write_frame_base nf90_put_var xhy_varid 2" ) - call check( nf90_put_var(iu%ncid, iu%xhz_varid, self%x2(3, :), start=[2, 1, i]), "netcdf_write_frame_base nf90_put_var xhz_varid 2" ) - call check( nf90_put_var(iu%ncid, iu%vhx_varid, self%v1(1, :), start=[1, 1, i]), "netcdf_write_frame_base nf90_put_var vhx_varid 1" ) - call check( nf90_put_var(iu%ncid, iu%vhy_varid, self%v1(2, :), start=[1, 1, i]), "netcdf_write_frame_base nf90_put_var vhy_varid 1" ) - call check( nf90_put_var(iu%ncid, iu%vhz_varid, self%v1(3, :), start=[1, 1, i]), "netcdf_write_frame_base nf90_put_var vhz_varid 1" ) - call check( nf90_put_var(iu%ncid, iu%vhx_varid, self%v2(1, :), start=[2, 1, i]), "netcdf_write_frame_base nf90_put_var vhx_varid 2" ) - call check( nf90_put_var(iu%ncid, iu%vhy_varid, self%v2(2, :), start=[2, 1, i]), "netcdf_write_frame_base nf90_put_var vhy_varid 2" ) - call check( nf90_put_var(iu%ncid, iu%vhz_varid, self%v2(3, :), start=[2, 1, i]), "netcdf_write_frame_base nf90_put_var vhz_varid 2" ) - call check( nf90_put_var(iu%ncid, iu%name_varid, self%name1(:), start=[1, 1, i]), "netcdf_write_frame_base nf90_put_var name 1" ) - call check( nf90_put_var(iu%ncid, iu%name_varid, self%name2(:), start=[1, 2, i]), "netcdf_write_frame_base nf90_put_var name 2" ) - call check( nf90_put_var(iu%ncid, iu%Gmass_varid, self%Gmass1(:), start=[1, 1, i]), "netcdf_write_frame_base nf90_put_var Gmass 1" ) - call check( nf90_put_var(iu%ncid, iu%Gmass_varid, self%Gmass2(:), start=[2, 1, i]), "netcdf_write_frame_base nf90_put_var Gmass 2" ) - call check( nf90_put_var(iu%ncid, iu%radius_varid, self%radius1(:), start=[1, 1, i]), "netcdf_write_frame_base nf90_put_var radius 1" ) - call check( nf90_put_var(iu%ncid, iu%radius_varid, self%radius2(:), start=[2, 1, i]), "netcdf_write_frame_base nf90_put_var radius 2" ) + call check( nf90_put_var(iu%ncid, iu%xhx_varid, self%x1(1, :), start=[1, 1, i], count=[1,n,1]), "netcdf_write_frame_base nf90_put_var xhx_varid 1" ) + call check( nf90_put_var(iu%ncid, iu%xhy_varid, self%x1(2, :), start=[1, 1, i], count=[1,n,1]), "netcdf_write_frame_base nf90_put_var xhy_varid 1" ) + call check( nf90_put_var(iu%ncid, iu%xhz_varid, self%x1(3, :), start=[1, 1, i], count=[1,n,1]), "netcdf_write_frame_base nf90_put_var xhz_varid 1" ) + call check( nf90_put_var(iu%ncid, iu%xhx_varid, self%x2(1, :), start=[2, 1, i], count=[1,n,1]), "netcdf_write_frame_base nf90_put_var xhx_varid 2" ) + call check( nf90_put_var(iu%ncid, iu%xhy_varid, self%x2(2, :), start=[2, 1, i], count=[1,n,1]), "netcdf_write_frame_base nf90_put_var xhy_varid 2" ) + call check( nf90_put_var(iu%ncid, iu%xhz_varid, self%x2(3, :), start=[2, 1, i], count=[1,n,1]), "netcdf_write_frame_base nf90_put_var xhz_varid 2" ) + call check( nf90_put_var(iu%ncid, iu%vhx_varid, self%v1(1, :), start=[1, 1, i], count=[1,n,1]), "netcdf_write_frame_base nf90_put_var vhx_varid 1" ) + call check( nf90_put_var(iu%ncid, iu%vhy_varid, self%v1(2, :), start=[1, 1, i], count=[1,n,1]), "netcdf_write_frame_base nf90_put_var vhy_varid 1" ) + call check( nf90_put_var(iu%ncid, iu%vhz_varid, self%v1(3, :), start=[1, 1, i], count=[1,n,1]), "netcdf_write_frame_base nf90_put_var vhz_varid 1" ) + call check( nf90_put_var(iu%ncid, iu%vhx_varid, self%v2(1, :), start=[2, 1, i], count=[1,n,1]), "netcdf_write_frame_base nf90_put_var vhx_varid 2" ) + call check( nf90_put_var(iu%ncid, iu%vhy_varid, self%v2(2, :), start=[2, 1, i], count=[1,n,1]), "netcdf_write_frame_base nf90_put_var vhy_varid 2" ) + call check( nf90_put_var(iu%ncid, iu%vhz_varid, self%v2(3, :), start=[2, 1, i], count=[1,n,1]), "netcdf_write_frame_base nf90_put_var vhz_varid 2" ) + call check( nf90_put_var(iu%ncid, iu%name_varid, self%name1(:), start=[1, 1, i], count=[NAMELEN,1,1]), "netcdf_write_frame_base nf90_put_var name 1" ) + call check( nf90_put_var(iu%ncid, iu%name_varid, self%name2(:), start=[1, 2, i], count=[NAMELEN,1,1]), "netcdf_write_frame_base nf90_put_var name 2" ) + call check( nf90_put_var(iu%ncid, iu%Gmass_varid, self%Gmass1(:), start=[1, 1, i], count=[1,n,1]), "netcdf_write_frame_base nf90_put_var Gmass 1" ) + call check( nf90_put_var(iu%ncid, iu%Gmass_varid, self%Gmass2(:), start=[2, 1, i], count=[1,n,1]), "netcdf_write_frame_base nf90_put_var Gmass 2" ) + call check( nf90_put_var(iu%ncid, iu%radius_varid, self%radius1(:), start=[1, 1, i], count=[1,n,1]), "netcdf_write_frame_base nf90_put_var radius 1" ) + call check( nf90_put_var(iu%ncid, iu%radius_varid, self%radius2(:), start=[2, 1, i], count=[1,n,1]), "netcdf_write_frame_base nf90_put_var radius 2" ) return diff --git a/src/symba/symba_encounter_check.f90 b/src/symba/symba_encounter_check.f90 index 60febb3fe..f07119dba 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, cb => system%cb, ienc_frame => system%ienc_frame, encounter_history => system%encounter_history) + associate(pl => self, plplenc_list => system%plplenc_list, cb => system%cb, ienc_frame => system%ienc_frame) npl = pl%nbody nplm = pl%nplm @@ -89,7 +89,7 @@ module function symba_encounter_check_pl(self, param, system, dt, irec) result(l end do ienc_frame = ienc_frame + 1 call system%resize_storage(ienc_frame) - encounter_history%frame(ienc_frame) = plplenc_list + system%encounter_history%frame(ienc_frame) = plplenc_list end if end associate From 52a595a0af457cfff33a03e6975a49d8587b7479 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Fri, 2 Dec 2022 19:21:30 -0500 Subject: [PATCH 204/569] Fixed a bunch of issues, but the NetCDF file is still not quite there --- src/encounter/encounter_io.f90 | 45 +++++++++++++++++++--------------- src/symba/symba_util.f90 | 2 +- 2 files changed, 26 insertions(+), 21 deletions(-) diff --git a/src/encounter/encounter_io.f90 b/src/encounter/encounter_io.f90 index 8df13d35c..f1a553a97 100644 --- a/src/encounter/encounter_io.f90 +++ b/src/encounter/encounter_io.f90 @@ -55,6 +55,7 @@ module subroutine encounter_io_initialize_output(self, param) 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) @@ -82,7 +83,7 @@ module subroutine encounter_io_initialize_output(self, param) call check( nf90_def_var(self%ncid, 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%ncid, ENCID_DIMNAME, NF90_INT, self%encid_dimid, self%encid_varid), "encounter_io_initialize_output nf90_def_var encid_varid" ) - call check( nf90_def_var(self%ncid, COLLIDER_DIMNAME, NF90_INT, self%collider_dimid, self%encid_varid), "encounter_io_initialize_output nf90_def_var collider_varid" ) + call check( nf90_def_var(self%ncid, COLLIDER_DIMNAME, NF90_INT, self%collider_dimid, self%collider_varid), "encounter_io_initialize_output nf90_def_var collider_varid" ) call check( nf90_def_var(self%ncid, 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%ncid, NAME_VARNAME, NF90_CHAR, [self%str_dimid, self%collider_dimid, self%encid_dimid], self%name_varid), "encounter_io_initialize_output nf90_def_var name_varid" ) call check( nf90_def_var(self%ncid, ID_DIMNAME, NF90_INT, [self%collider_dimid, self%encid_dimid, self%time_dimid], self%id_varid), "encounter_io_initialize_output nf90_def_var id_varid" ) @@ -99,6 +100,7 @@ module subroutine encounter_io_initialize_output(self, param) ! Take the file out of define mode call check( nf90_enddef(self%ncid), "encounter_io_initialize_output nf90_enddef" ) + call check( nf90_put_var(self%ncid, self%collider_varid, collider_dimension, start=[1], count=[2]), "encounter_io_initialize_output nf90_put_var collider_varid" ) return @@ -168,25 +170,28 @@ module subroutine encounter_io_write_frame(self, iu, param) i = iu%ienc_frame n = int(self%nenc, kind=I4B) call check( nf90_set_fill(iu%ncid, nf90_nofill, old_mode), "encounter_io_write_frame_base nf90_set_fill" ) - call check( nf90_put_var(iu%ncid, iu%time_varid, self%t, start=[i]), "netcdf_write_hdr_system nf90_put_var time_varid" ) - call check( nf90_put_var(iu%ncid, iu%xhx_varid, self%x1(1, :), start=[1, 1, i], count=[1,n,1]), "netcdf_write_frame_base nf90_put_var xhx_varid 1" ) - call check( nf90_put_var(iu%ncid, iu%xhy_varid, self%x1(2, :), start=[1, 1, i], count=[1,n,1]), "netcdf_write_frame_base nf90_put_var xhy_varid 1" ) - call check( nf90_put_var(iu%ncid, iu%xhz_varid, self%x1(3, :), start=[1, 1, i], count=[1,n,1]), "netcdf_write_frame_base nf90_put_var xhz_varid 1" ) - call check( nf90_put_var(iu%ncid, iu%xhx_varid, self%x2(1, :), start=[2, 1, i], count=[1,n,1]), "netcdf_write_frame_base nf90_put_var xhx_varid 2" ) - call check( nf90_put_var(iu%ncid, iu%xhy_varid, self%x2(2, :), start=[2, 1, i], count=[1,n,1]), "netcdf_write_frame_base nf90_put_var xhy_varid 2" ) - call check( nf90_put_var(iu%ncid, iu%xhz_varid, self%x2(3, :), start=[2, 1, i], count=[1,n,1]), "netcdf_write_frame_base nf90_put_var xhz_varid 2" ) - call check( nf90_put_var(iu%ncid, iu%vhx_varid, self%v1(1, :), start=[1, 1, i], count=[1,n,1]), "netcdf_write_frame_base nf90_put_var vhx_varid 1" ) - call check( nf90_put_var(iu%ncid, iu%vhy_varid, self%v1(2, :), start=[1, 1, i], count=[1,n,1]), "netcdf_write_frame_base nf90_put_var vhy_varid 1" ) - call check( nf90_put_var(iu%ncid, iu%vhz_varid, self%v1(3, :), start=[1, 1, i], count=[1,n,1]), "netcdf_write_frame_base nf90_put_var vhz_varid 1" ) - call check( nf90_put_var(iu%ncid, iu%vhx_varid, self%v2(1, :), start=[2, 1, i], count=[1,n,1]), "netcdf_write_frame_base nf90_put_var vhx_varid 2" ) - call check( nf90_put_var(iu%ncid, iu%vhy_varid, self%v2(2, :), start=[2, 1, i], count=[1,n,1]), "netcdf_write_frame_base nf90_put_var vhy_varid 2" ) - call check( nf90_put_var(iu%ncid, iu%vhz_varid, self%v2(3, :), start=[2, 1, i], count=[1,n,1]), "netcdf_write_frame_base nf90_put_var vhz_varid 2" ) - call check( nf90_put_var(iu%ncid, iu%name_varid, self%name1(:), start=[1, 1, i], count=[NAMELEN,1,1]), "netcdf_write_frame_base nf90_put_var name 1" ) - call check( nf90_put_var(iu%ncid, iu%name_varid, self%name2(:), start=[1, 2, i], count=[NAMELEN,1,1]), "netcdf_write_frame_base nf90_put_var name 2" ) - call check( nf90_put_var(iu%ncid, iu%Gmass_varid, self%Gmass1(:), start=[1, 1, i], count=[1,n,1]), "netcdf_write_frame_base nf90_put_var Gmass 1" ) - call check( nf90_put_var(iu%ncid, iu%Gmass_varid, self%Gmass2(:), start=[2, 1, i], count=[1,n,1]), "netcdf_write_frame_base nf90_put_var Gmass 2" ) - call check( nf90_put_var(iu%ncid, iu%radius_varid, self%radius1(:), start=[1, 1, i], count=[1,n,1]), "netcdf_write_frame_base nf90_put_var radius 1" ) - call check( nf90_put_var(iu%ncid, iu%radius_varid, self%radius2(:), start=[2, 1, i], count=[1,n,1]), "netcdf_write_frame_base nf90_put_var radius 2" ) + call check( nf90_put_var(iu%ncid, iu%time_varid, self%t, start=[i]), "encounter_io_write_frame nf90_put_var time_varid" ) + call check( nf90_put_var(iu%ncid, iu%encid_varid, [(i, i=1,n)], start=[i], count=[n]), "encounter_io_write_frame nf90_put_var encid_varid" ) + + call check( nf90_put_var(iu%ncid, iu%nenc_varid, self%nenc, start=[i]), "encounter_io_frame nf90_put_var nenc_varid" ) + call check( nf90_put_var(iu%ncid, iu%name_varid, self%name1(1:n), start=[1, 1, i], count=[NAMELEN,1,1]), "netcdf_write_frame_base nf90_put_var name 1" ) + call check( nf90_put_var(iu%ncid, iu%name_varid, self%name2(1:n), start=[1, 2, i], count=[NAMELEN,1,1]), "netcdf_write_frame_base nf90_put_var name 2" ) + call check( nf90_put_var(iu%ncid, iu%xhx_varid, self%x1(1, 1:n), start=[1, 1, i], count=[1,n,1]), "netcdf_write_frame_base nf90_put_var xhx_varid 1" ) + call check( nf90_put_var(iu%ncid, iu%xhy_varid, self%x1(2, 1:n), start=[1, 1, i], count=[1,n,1]), "netcdf_write_frame_base nf90_put_var xhy_varid 1" ) + call check( nf90_put_var(iu%ncid, iu%xhz_varid, self%x1(3, 1:n), start=[1, 1, i], count=[1,n,1]), "netcdf_write_frame_base nf90_put_var xhz_varid 1" ) + call check( nf90_put_var(iu%ncid, iu%xhx_varid, self%x2(1, 1:n), start=[2, 1, i], count=[1,n,1]), "netcdf_write_frame_base nf90_put_var xhx_varid 2" ) + call check( nf90_put_var(iu%ncid, iu%xhy_varid, self%x2(2, 1:n), start=[2, 1, i], count=[1,n,1]), "netcdf_write_frame_base nf90_put_var xhy_varid 2" ) + call check( nf90_put_var(iu%ncid, iu%xhz_varid, self%x2(3, 1:n), start=[2, 1, i], count=[1,n,1]), "netcdf_write_frame_base nf90_put_var xhz_varid 2" ) + call check( nf90_put_var(iu%ncid, iu%vhx_varid, self%v1(1, 1:n), start=[1, 1, i], count=[1,n,1]), "netcdf_write_frame_base nf90_put_var vhx_varid 1" ) + call check( nf90_put_var(iu%ncid, iu%vhy_varid, self%v1(2, 1:n), start=[1, 1, i], count=[1,n,1]), "netcdf_write_frame_base nf90_put_var vhy_varid 1" ) + call check( nf90_put_var(iu%ncid, iu%vhz_varid, self%v1(3, 1:n), start=[1, 1, i], count=[1,n,1]), "netcdf_write_frame_base nf90_put_var vhz_varid 1" ) + call check( nf90_put_var(iu%ncid, iu%vhx_varid, self%v2(1, 1:n), start=[2, 1, i], count=[1,n,1]), "netcdf_write_frame_base nf90_put_var vhx_varid 2" ) + call check( nf90_put_var(iu%ncid, iu%vhy_varid, self%v2(2, 1:n), start=[2, 1, i], count=[1,n,1]), "netcdf_write_frame_base nf90_put_var vhy_varid 2" ) + call check( nf90_put_var(iu%ncid, iu%vhz_varid, self%v2(3, 1:n), start=[2, 1, i], count=[1,n,1]), "netcdf_write_frame_base nf90_put_var vhz_varid 2" ) + call check( nf90_put_var(iu%ncid, iu%Gmass_varid, self%Gmass1(1:n), start=[1, 1, i], count=[1,n,1]), "netcdf_write_frame_base nf90_put_var Gmass 1" ) + call check( nf90_put_var(iu%ncid, iu%Gmass_varid, self%Gmass2(1:n), start=[2, 1, i], count=[1,n,1]), "netcdf_write_frame_base nf90_put_var Gmass 2" ) + call check( nf90_put_var(iu%ncid, iu%radius_varid, self%radius1(1:n), start=[1, 1, i], count=[1,n,1]), "netcdf_write_frame_base nf90_put_var radius 1" ) + call check( nf90_put_var(iu%ncid, iu%radius_varid, self%radius2(1:n), start=[2, 1, i], count=[1,n,1]), "netcdf_write_frame_base nf90_put_var radius 2" ) return diff --git a/src/symba/symba_util.f90 b/src/symba/symba_util.f90 index 6b3661abb..b7cc9c915 100644 --- a/src/symba/symba_util.f90 +++ b/src/symba/symba_util.f90 @@ -925,7 +925,7 @@ module subroutine symba_util_resize_storage(self, nnew) end if if (nnew > nold) then - allocate(encounter_storage(2 * nnew) :: tmp) + 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 From d8783a3c56c5d56d04efd06f786c5ad630513a54 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Fri, 2 Dec 2022 20:15:09 -0500 Subject: [PATCH 205/569] More small fixes --- src/encounter/encounter_io.f90 | 47 +++++++++++++++---------------- src/modules/encounter_classes.f90 | 2 -- 2 files changed, 22 insertions(+), 27 deletions(-) diff --git a/src/encounter/encounter_io.f90 b/src/encounter/encounter_io.f90 index f1a553a97..18b64bd3b 100644 --- a/src/encounter/encounter_io.f90 +++ b/src/encounter/encounter_io.f90 @@ -82,8 +82,6 @@ module subroutine encounter_io_initialize_output(self, param) end select call check( nf90_def_var(self%ncid, 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%ncid, ENCID_DIMNAME, NF90_INT, self%encid_dimid, self%encid_varid), "encounter_io_initialize_output nf90_def_var encid_varid" ) - call check( nf90_def_var(self%ncid, COLLIDER_DIMNAME, NF90_INT, self%collider_dimid, self%collider_varid), "encounter_io_initialize_output nf90_def_var collider_varid" ) call check( nf90_def_var(self%ncid, 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%ncid, NAME_VARNAME, NF90_CHAR, [self%str_dimid, self%collider_dimid, self%encid_dimid], self%name_varid), "encounter_io_initialize_output nf90_def_var name_varid" ) call check( nf90_def_var(self%ncid, ID_DIMNAME, NF90_INT, [self%collider_dimid, self%encid_dimid, self%time_dimid], self%id_varid), "encounter_io_initialize_output nf90_def_var id_varid" ) @@ -100,7 +98,6 @@ module subroutine encounter_io_initialize_output(self, param) ! Take the file out of define mode call check( nf90_enddef(self%ncid), "encounter_io_initialize_output nf90_enddef" ) - call check( nf90_put_var(self%ncid, self%collider_varid, collider_dimension, start=[1], count=[2]), "encounter_io_initialize_output nf90_put_var collider_varid" ) return @@ -137,8 +134,6 @@ module subroutine encounter_io_open_file(self, param, readonly) call check( nf90_inq_dimid(self%ncid, STR_DIMNAME, self%str_dimid), "encounter_io_open_file nf90_inq_dimid collider_str" ) call check( nf90_inq_varid(self%ncid, TIME_DIMNAME, self%time_varid), "encounter_io_open_file nf90_inq_varid time_varid" ) - call check( nf90_inq_varid(self%ncid, ENCID_DIMNAME, self%encid_varid), "encounter_io_open_file nf90_inq_varid encid_varid" ) - call check( nf90_inq_varid(self%ncid, COLLIDER_DIMNAME, self%collider_varid), "encounter_io_open_file nf90_inq_varid collider_varid" ) call check( nf90_inq_varid(self%ncid, NAME_VARNAME, self%name_varid), "encounter_io_open_file nf90_inq_varid name_varid" ) call check( nf90_inq_varid(self%ncid, NENC_VARNAME, self%nenc_varid), "encounter_io_open_file nf90_inq_varid nenc_varid" ) @@ -171,28 +166,30 @@ module subroutine encounter_io_write_frame(self, iu, param) n = int(self%nenc, kind=I4B) call check( nf90_set_fill(iu%ncid, nf90_nofill, old_mode), "encounter_io_write_frame_base nf90_set_fill" ) call check( nf90_put_var(iu%ncid, iu%time_varid, self%t, start=[i]), "encounter_io_write_frame nf90_put_var time_varid" ) - call check( nf90_put_var(iu%ncid, iu%encid_varid, [(i, i=1,n)], start=[i], count=[n]), "encounter_io_write_frame nf90_put_var encid_varid" ) call check( nf90_put_var(iu%ncid, iu%nenc_varid, self%nenc, start=[i]), "encounter_io_frame nf90_put_var nenc_varid" ) - call check( nf90_put_var(iu%ncid, iu%name_varid, self%name1(1:n), start=[1, 1, i], count=[NAMELEN,1,1]), "netcdf_write_frame_base nf90_put_var name 1" ) - call check( nf90_put_var(iu%ncid, iu%name_varid, self%name2(1:n), start=[1, 2, i], count=[NAMELEN,1,1]), "netcdf_write_frame_base nf90_put_var name 2" ) - call check( nf90_put_var(iu%ncid, iu%xhx_varid, self%x1(1, 1:n), start=[1, 1, i], count=[1,n,1]), "netcdf_write_frame_base nf90_put_var xhx_varid 1" ) - call check( nf90_put_var(iu%ncid, iu%xhy_varid, self%x1(2, 1:n), start=[1, 1, i], count=[1,n,1]), "netcdf_write_frame_base nf90_put_var xhy_varid 1" ) - call check( nf90_put_var(iu%ncid, iu%xhz_varid, self%x1(3, 1:n), start=[1, 1, i], count=[1,n,1]), "netcdf_write_frame_base nf90_put_var xhz_varid 1" ) - call check( nf90_put_var(iu%ncid, iu%xhx_varid, self%x2(1, 1:n), start=[2, 1, i], count=[1,n,1]), "netcdf_write_frame_base nf90_put_var xhx_varid 2" ) - call check( nf90_put_var(iu%ncid, iu%xhy_varid, self%x2(2, 1:n), start=[2, 1, i], count=[1,n,1]), "netcdf_write_frame_base nf90_put_var xhy_varid 2" ) - call check( nf90_put_var(iu%ncid, iu%xhz_varid, self%x2(3, 1:n), start=[2, 1, i], count=[1,n,1]), "netcdf_write_frame_base nf90_put_var xhz_varid 2" ) - call check( nf90_put_var(iu%ncid, iu%vhx_varid, self%v1(1, 1:n), start=[1, 1, i], count=[1,n,1]), "netcdf_write_frame_base nf90_put_var vhx_varid 1" ) - call check( nf90_put_var(iu%ncid, iu%vhy_varid, self%v1(2, 1:n), start=[1, 1, i], count=[1,n,1]), "netcdf_write_frame_base nf90_put_var vhy_varid 1" ) - call check( nf90_put_var(iu%ncid, iu%vhz_varid, self%v1(3, 1:n), start=[1, 1, i], count=[1,n,1]), "netcdf_write_frame_base nf90_put_var vhz_varid 1" ) - call check( nf90_put_var(iu%ncid, iu%vhx_varid, self%v2(1, 1:n), start=[2, 1, i], count=[1,n,1]), "netcdf_write_frame_base nf90_put_var vhx_varid 2" ) - call check( nf90_put_var(iu%ncid, iu%vhy_varid, self%v2(2, 1:n), start=[2, 1, i], count=[1,n,1]), "netcdf_write_frame_base nf90_put_var vhy_varid 2" ) - call check( nf90_put_var(iu%ncid, iu%vhz_varid, self%v2(3, 1:n), start=[2, 1, i], count=[1,n,1]), "netcdf_write_frame_base nf90_put_var vhz_varid 2" ) - call check( nf90_put_var(iu%ncid, iu%Gmass_varid, self%Gmass1(1:n), start=[1, 1, i], count=[1,n,1]), "netcdf_write_frame_base nf90_put_var Gmass 1" ) - call check( nf90_put_var(iu%ncid, iu%Gmass_varid, self%Gmass2(1:n), start=[2, 1, i], count=[1,n,1]), "netcdf_write_frame_base nf90_put_var Gmass 2" ) - call check( nf90_put_var(iu%ncid, iu%radius_varid, self%radius1(1:n), start=[1, 1, i], count=[1,n,1]), "netcdf_write_frame_base nf90_put_var radius 1" ) - call check( nf90_put_var(iu%ncid, iu%radius_varid, self%radius2(1:n), start=[2, 1, i], count=[1,n,1]), "netcdf_write_frame_base nf90_put_var radius 2" ) - + call check( nf90_put_var(iu%ncid, 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%ncid, 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%ncid, 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%ncid, 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%ncid, 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%ncid, 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%ncid, 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%ncid, 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%ncid, 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%ncid, 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%ncid, 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%ncid, 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%ncid, 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%ncid, 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%ncid, 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%ncid, 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%ncid, 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%ncid, 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%ncid, 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 diff --git a/src/modules/encounter_classes.f90 b/src/modules/encounter_classes.f90 index 1f213f84a..5d883162a 100644 --- a/src/modules/encounter_classes.f90 +++ b/src/modules/encounter_classes.f90 @@ -59,8 +59,6 @@ module encounter_classes character(STRMAX) :: enc_file = "encounter.nc" !! Encounter output file name integer(I4B) :: encid_dimid !! NetCDF ID for the encounter pair index dimension integer(I4B) :: collider_dimid !! NetCDF ID for the collider dimension - integer(I4B) :: collider_varid !! NetCDF ID for the collider variable - integer(I4B) :: encid_varid !! NetCDF ID for the encounter pair index variable integer(I4B) :: nenc_varid !! NetCDF ID for the number of encounters variable integer(I4B) :: level_varid !! NetCDF ID for the recursion level variable integer(I4B) :: ienc_frame !! Current frame number for the encounter history From c48f09f40942f2112f39c9a51cbdfbb6f456a844 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Sat, 3 Dec 2022 05:43:06 -0500 Subject: [PATCH 206/569] Moved NetCDF variable and class definitions to swiftest_classes out of swiftest_globals --- src/modules/swiftest_classes.f90 | 153 +++++++++++++++++++++++++++++++ src/modules/swiftest_globals.f90 | 152 ------------------------------ 2 files changed, 153 insertions(+), 152 deletions(-) diff --git a/src/modules/swiftest_classes.f90 b/src/modules/swiftest_classes.f90 index 8ddaf0c65..724a17994 100644 --- a/src/modules/swiftest_classes.f90 +++ b/src/modules/swiftest_classes.f90 @@ -16,6 +16,159 @@ module swiftest_classes implicit none public + !> 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) :: 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 + + type, extends(netcdf_variables) :: netcdf_parameters contains procedure :: close => netcdf_close !! Closes an open NetCDF file diff --git a/src/modules/swiftest_globals.f90 b/src/modules/swiftest_globals.f90 index feeb0ef1c..4c8c21693 100644 --- a/src/modules/swiftest_globals.f90 +++ b/src/modules/swiftest_globals.f90 @@ -131,156 +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) :: 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 From 428dc10e3d3f4279a014a69c62d00df474012265 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Sat, 3 Dec 2022 06:31:38 -0500 Subject: [PATCH 207/569] Restructured NetCDF parameter definition to consolidate all definitions into one place instead --- src/encounter/encounter_io.f90 | 70 +++--- src/modules/encounter_classes.f90 | 24 +- src/modules/swiftest_classes.f90 | 299 +++++++++++++------------ src/netcdf/netcdf.f90 | 358 +++++++++++++++--------------- 4 files changed, 378 insertions(+), 373 deletions(-) diff --git a/src/encounter/encounter_io.f90 b/src/encounter/encounter_io.f90 index 18b64bd3b..badd3685a 100644 --- a/src/encounter/encounter_io.f90 +++ b/src/encounter/encounter_io.f90 @@ -69,10 +69,10 @@ module subroutine encounter_io_initialize_output(self, param) call check( nf90_create(self%enc_file, NF90_NETCDF4, self%ncid), "encounter_io_initialize_output nf90_create" ) - call check( nf90_def_dim(self%ncid, ENCID_DIMNAME, NF90_UNLIMITED, self%encid_dimid), "encounter_io_initialize_output nf90_def_dim encid_dimid" ) - call check( nf90_def_dim(self%ncid, 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%ncid, TIME_DIMNAME, NF90_UNLIMITED, self%time_dimid), "encounter_io_initialize_output nf90_def_dim time_dimid" ) ! 'y' dimension - call check( nf90_def_dim(self%ncid, COLLIDER_DIMNAME, COLLIDER_DIM_SIZE, self%collider_dimid), "encounter_io_initialize_output nf90_def_dim time_dimid" ) ! 'y' dimension + call check( nf90_def_dim(self%ncid, self%encid_dimname, NF90_UNLIMITED, self%encid_dimid), "encounter_io_initialize_output nf90_def_dim encid_dimid" ) + call check( nf90_def_dim(self%ncid, 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%ncid, 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%ncid, 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") @@ -81,19 +81,19 @@ module subroutine encounter_io_initialize_output(self, param) self%out_type = NF90_DOUBLE end select - call check( nf90_def_var(self%ncid, 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%ncid, 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%ncid, NAME_VARNAME, NF90_CHAR, [self%str_dimid, self%collider_dimid, self%encid_dimid], self%name_varid), "encounter_io_initialize_output nf90_def_var name_varid" ) - call check( nf90_def_var(self%ncid, ID_DIMNAME, NF90_INT, [self%collider_dimid, self%encid_dimid, self%time_dimid], self%id_varid), "encounter_io_initialize_output nf90_def_var id_varid" ) - call check( nf90_def_var(self%ncid, XHX_VARNAME, self%out_type, [self%collider_dimid, self%encid_dimid, self%time_dimid], self%xhx_varid), "encounter_io_initialize_output nf90_def_var xhx_varid" ) - call check( nf90_def_var(self%ncid, XHY_VARNAME, self%out_type, [self%collider_dimid, self%encid_dimid, self%time_dimid], self%xhy_varid), "encounter_io_initialize_output nf90_def_var xhy_varid" ) - call check( nf90_def_var(self%ncid, XHZ_VARNAME, self%out_type, [self%collider_dimid, self%encid_dimid, self%time_dimid], self%xhz_varid), "encounter_io_initialize_output nf90_def_var xhz_varid" ) - call check( nf90_def_var(self%ncid, VHX_VARNAME, self%out_type, [self%collider_dimid, self%encid_dimid, self%time_dimid], self%vhx_varid), "encounter_io_initialize_output nf90_def_var vhx_varid" ) - call check( nf90_def_var(self%ncid, VHY_VARNAME, self%out_type, [self%collider_dimid, self%encid_dimid, self%time_dimid], self%vhy_varid), "encounter_io_initialize_output nf90_def_var vhy_varid" ) - call check( nf90_def_var(self%ncid, VHZ_VARNAME, self%out_type, [self%collider_dimid, self%encid_dimid, self%time_dimid], self%vhz_varid), "encounter_io_initialize_output nf90_def_var vhz_varid" ) - call check( nf90_def_var(self%ncid, LEVEL_VARNAME, NF90_INT, [self%encid_dimid, self%time_dimid], self%level_varid), "encounter_io_initialize_output nf90_def_var level_varid" ) - call check( nf90_def_var(self%ncid, GMASS_VARNAME, self%out_type, [self%collider_dimid, self%encid_dimid, self%time_dimid], self%Gmass_varid), "encounter_io_initialize_output nf90_def_var Gmass_varid" ) - call check( nf90_def_var(self%ncid, RADIUS_VARNAME, self%out_type, [self%collider_dimid, self%encid_dimid, self%time_dimid], self%radius_varid), "encounter_io_initialize_output nf90_def_var radius_varid" ) + call check( nf90_def_var(self%ncid, 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%ncid, 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%ncid, self%name_varname, NF90_CHAR, [self%str_dimid, self%collider_dimid, self%encid_dimid], self%name_varid), "encounter_io_initialize_output nf90_def_var name_varid" ) + call check( nf90_def_var(self%ncid, self%id_dimname, NF90_INT, [self%collider_dimid, self%encid_dimid, self%time_dimid], self%id_varid), "encounter_io_initialize_output nf90_def_var id_varid" ) + call check( nf90_def_var(self%ncid, self%xhx_varname, self%out_type, [self%collider_dimid, self%encid_dimid, self%time_dimid], self%xhx_varid), "encounter_io_initialize_output nf90_def_var xhx_varid" ) + call check( nf90_def_var(self%ncid, self%xhy_varname, self%out_type, [self%collider_dimid, self%encid_dimid, self%time_dimid], self%xhy_varid), "encounter_io_initialize_output nf90_def_var xhy_varid" ) + call check( nf90_def_var(self%ncid, self%xhz_varname, self%out_type, [self%collider_dimid, self%encid_dimid, self%time_dimid], self%xhz_varid), "encounter_io_initialize_output nf90_def_var xhz_varid" ) + call check( nf90_def_var(self%ncid, self%vhx_varname, self%out_type, [self%collider_dimid, self%encid_dimid, self%time_dimid], self%vhx_varid), "encounter_io_initialize_output nf90_def_var vhx_varid" ) + call check( nf90_def_var(self%ncid, self%vhy_varname, self%out_type, [self%collider_dimid, self%encid_dimid, self%time_dimid], self%vhy_varid), "encounter_io_initialize_output nf90_def_var vhy_varid" ) + call check( nf90_def_var(self%ncid, self%vhz_varname, self%out_type, [self%collider_dimid, self%encid_dimid, self%time_dimid], self%vhz_varid), "encounter_io_initialize_output nf90_def_var vhz_varid" ) + call check( nf90_def_var(self%ncid, self%level_varname, NF90_INT, [self%encid_dimid, self%time_dimid], self%level_varid), "encounter_io_initialize_output nf90_def_var level_varid" ) + call check( nf90_def_var(self%ncid, self%gmass_varname, self%out_type, [self%collider_dimid, self%encid_dimid, self%time_dimid], self%Gmass_varid), "encounter_io_initialize_output nf90_def_var Gmass_varid" ) + call check( nf90_def_var(self%ncid, self%radius_varname, self%out_type, [self%collider_dimid, self%encid_dimid, self%time_dimid], self%radius_varid), "encounter_io_initialize_output nf90_def_var radius_varid" ) ! Take the file out of define mode @@ -128,24 +128,24 @@ module subroutine encounter_io_open_file(self, param, readonly) write(errmsg,*) "encounter_io_open_file nf90_open ",trim(adjustl(param%outfile)) call check( nf90_open(self%enc_file, mode, self%ncid), errmsg) - call check( nf90_inq_dimid(self%ncid, TIME_DIMNAME, self%time_dimid), "encounter_io_open_file nf90_inq_dimid time_dimid" ) - call check( nf90_inq_dimid(self%ncid, ENCID_DIMNAME, self%encid_dimid), "encounter_io_open_file nf90_inq_dimid encid_dimid" ) - call check( nf90_inq_dimid(self%ncid, COLLIDER_DIMNAME, self%collider_dimid), "encounter_io_open_file nf90_inq_dimid collider_dimid" ) - call check( nf90_inq_dimid(self%ncid, STR_DIMNAME, self%str_dimid), "encounter_io_open_file nf90_inq_dimid collider_str" ) - - call check( nf90_inq_varid(self%ncid, TIME_DIMNAME, self%time_varid), "encounter_io_open_file nf90_inq_varid time_varid" ) - call check( nf90_inq_varid(self%ncid, NAME_VARNAME, self%name_varid), "encounter_io_open_file nf90_inq_varid name_varid" ) - call check( nf90_inq_varid(self%ncid, NENC_VARNAME, self%nenc_varid), "encounter_io_open_file nf90_inq_varid nenc_varid" ) - - call check( nf90_inq_varid(self%ncid, XHX_VARNAME, self%xhx_varid), "encounter_io_open_file nf90_inq_varid xhx_varid" ) - call check( nf90_inq_varid(self%ncid, XHY_VARNAME, self%xhy_varid), "encounter_io_open_file nf90_inq_varid xhy_varid" ) - call check( nf90_inq_varid(self%ncid, XHZ_VARNAME, self%xhz_varid), "encounter_io_open_file nf90_inq_varid xhz_varid" ) - call check( nf90_inq_varid(self%ncid, VHX_VARNAME, self%vhx_varid), "encounter_io_open_file nf90_inq_varid vhx_varid" ) - call check( nf90_inq_varid(self%ncid, VHY_VARNAME, self%vhy_varid), "encounter_io_open_file nf90_inq_varid vhy_varid" ) - call check( nf90_inq_varid(self%ncid, VHZ_VARNAME, self%vhz_varid), "encounter_io_open_file nf90_inq_varid vhz_varid" ) - call check( nf90_inq_varid(self%ncid, LEVEL_VARNAME, self%level_varid), "encounter_io_open_file nf90_inq_varid level_varid" ) - call check( nf90_inq_varid(self%ncid, GMASS_VARNAME, self%Gmass_varid), "encounter_io_open_file nf90_inq_varid Gmass_varid" ) - call check( nf90_inq_varid(self%ncid, RADIUS_VARNAME, self%radius_varid), "encounter_io_open_file nf90_inq_varid radius_varid" ) + call check( nf90_inq_dimid(self%ncid, self%time_dimname, self%time_dimid), "encounter_io_open_file nf90_inq_dimid time_dimid" ) + call check( nf90_inq_dimid(self%ncid, self%encid_dimname, self%encid_dimid), "encounter_io_open_file nf90_inq_dimid encid_dimid" ) + call check( nf90_inq_dimid(self%ncid, self%collider_dimname, self%collider_dimid), "encounter_io_open_file nf90_inq_dimid collider_dimid" ) + call check( nf90_inq_dimid(self%ncid, self%str_dimname, self%str_dimid), "encounter_io_open_file nf90_inq_dimid collider_str" ) + + call check( nf90_inq_varid(self%ncid, self%time_dimname, self%time_varid), "encounter_io_open_file nf90_inq_varid time_varid" ) + call check( nf90_inq_varid(self%ncid, self%name_varname, self%name_varid), "encounter_io_open_file nf90_inq_varid name_varid" ) + call check( nf90_inq_varid(self%ncid, self%nenc_varname, self%nenc_varid), "encounter_io_open_file nf90_inq_varid nenc_varid" ) + + call check( nf90_inq_varid(self%ncid, self%xhx_varname, self%xhx_varid), "encounter_io_open_file nf90_inq_varid xhx_varid" ) + call check( nf90_inq_varid(self%ncid, self%xhy_varname, self%xhy_varid), "encounter_io_open_file nf90_inq_varid xhy_varid" ) + call check( nf90_inq_varid(self%ncid, self%xhz_varname, self%xhz_varid), "encounter_io_open_file nf90_inq_varid xhz_varid" ) + call check( nf90_inq_varid(self%ncid, self%vhx_varname, self%vhx_varid), "encounter_io_open_file nf90_inq_varid vhx_varid" ) + call check( nf90_inq_varid(self%ncid, self%vhy_varname, self%vhy_varid), "encounter_io_open_file nf90_inq_varid vhy_varid" ) + call check( nf90_inq_varid(self%ncid, self%vhz_varname, self%vhz_varid), "encounter_io_open_file nf90_inq_varid vhz_varid" ) + call check( nf90_inq_varid(self%ncid, self%level_varname, self%level_varid), "encounter_io_open_file nf90_inq_varid level_varid" ) + call check( nf90_inq_varid(self%ncid, self%gmass_varname, self%Gmass_varid), "encounter_io_open_file nf90_inq_varid Gmass_varid" ) + call check( nf90_inq_varid(self%ncid, self%radius_varname, self%radius_varid), "encounter_io_open_file nf90_inq_varid radius_varid" ) return end subroutine encounter_io_open_file diff --git a/src/modules/encounter_classes.f90 b/src/modules/encounter_classes.f90 index 5d883162a..1bb595b02 100644 --- a/src/modules/encounter_classes.f90 +++ b/src/modules/encounter_classes.f90 @@ -49,19 +49,19 @@ module encounter_classes end type encounter_list !! NetCDF dimension and variable names for the enounter save object - character(*), parameter :: ENCID_DIMNAME = "encounter" !! The index of the encountering pair in the encounter list - character(*), parameter :: COLLIDER_DIMNAME = "collider" !! Dimension that defines the colliding bodies (bodies 1 and 2 are at dimension coordinates 1 and 2, respectively) - integer(I4B), parameter :: COLLIDER_DIM_SIZE = 2 !! Size of collider dimension - character(*), parameter :: NENC_VARNAME = "nenc" !! Total number of encounters - character(*), parameter :: LEVEL_VARNAME = "level" !! Recursion depth - type, extends(netcdf_parameters) :: encounter_io_parameters - character(STRMAX) :: enc_file = "encounter.nc" !! Encounter output file name - integer(I4B) :: encid_dimid !! NetCDF ID for the encounter pair index dimension - integer(I4B) :: collider_dimid !! NetCDF ID for the collider dimension - integer(I4B) :: nenc_varid !! NetCDF ID for the number of encounters variable - integer(I4B) :: level_varid !! NetCDF ID for the recursion level variable - integer(I4B) :: ienc_frame !! Current frame number for the encounter history + 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) :: encid_dimname = "encounter" !! The index of the encountering pair in the encounter list + integer(I4B) :: encid_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 diff --git a/src/modules/swiftest_classes.f90 b/src/modules/swiftest_classes.f90 index 724a17994..5c75908fb 100644 --- a/src/modules/swiftest_classes.f90 +++ b/src/modules/swiftest_classes.f90 @@ -17,155 +17,160 @@ module swiftest_classes public !> 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) :: 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. + integer(I4B) :: out_type !! output type (will be assigned either NF90_DOUBLE or NF90_FLOAT, depending on the user parameter) + integer(I4B) :: ncid !! 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 + integer(I4B) :: time_dimid !! ID for the time dimension + integer(I4B) :: id_dimid !! ID for the particle id dimension + 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_varid !! ID for the time variable + character(NAMELEN) :: id_dimname = "id" !! name of 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_varid !! ID for the space variable + + ! 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. periapsis variable + integer(I4B) :: omega_varid !! ID for the arg. 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) :: xhx_varname = "xhx" !! name of the heliocentric position x variable + integer(I4B) :: xhx_varid !! ID for the heliocentric position x variable + character(NAMELEN) :: xhy_varname = "xhy" !! name of the heliocentric position y variable + integer(I4B) :: xhy_varid !! ID for the heliocentric position y variable + character(NAMELEN) :: xhz_varname = "xhz" !! name of the heliocentric position z variable + integer(I4B) :: xhz_varid !! ID for the heliocentric position z variable + character(NAMELEN) :: vhx_varname = "vhx" !! name of the heliocentric velocity x variable + integer(I4B) :: vhx_varid !! ID for the heliocentric velocity x variable + character(NAMELEN) :: vhy_varname = "vhy" !! name of the heliocentric velocity y variable + integer(I4B) :: vhy_varid !! ID for the heliocentric velocity y variable + character(NAMELEN) :: vhz_varname = "vhz" !! name of the heliocentric velocity z variable + integer(I4B) :: vhz_varid !! ID for the heliocentric velocity z variable + character(NAMELEN) :: gr_pseudo_vhx_varname = "gr_pseudo_vhx" !! name of the heliocentric pseudovelocity x variable (used in GR only) + integer(I4B) :: gr_pseudo_vhx_varid !! ID for the heliocentric pseudovelocity x variable (used in GR) + character(NAMELEN) :: gr_pseudo_vhy_varname = "gr_pseudo_vhy" !! name of the heliocentric pseudovelocity y variable (used in GR only) + integer(I4B) :: gr_pseudo_vhy_varid !! ID for the heliocentric pseudovelocity y variable (used in GR) + character(NAMELEN) :: gr_pseudo_vhz_varname = "gr_pseudo_vhz" !! name of the heliocentric pseudovelocity z variable (used in GR only) + integer(I4B) :: gr_pseudo_vhz_varid !! ID for the heliocentric psuedovelocity z 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) :: ip1_varname = "Ip1" !! name of the axis 1 principal moment of inertial variable + integer(I4B) :: Ip1_varid !! ID for the axis 1 principal moment of inertia variable + character(NAMELEN) :: ip2_varname = "Ip2" !! name of the axis 2 principal moment of inertial variable + integer(I4B) :: Ip2_varid !! ID for the axis 2 principal moment of inertia variable + character(NAMELEN) :: ip3_varname = "Ip3" !! name of the axis 3 principal moment of inertial variable + integer(I4B) :: Ip3_varid !! ID for the axis 3 principal moment of inertia variable + character(NAMELEN) :: rotx_varname = "rotx" !! name of the rotation x variable + integer(I4B) :: rotx_varid !! ID for the rotation x variable + character(NAMELEN) :: roty_varname = "roty" !! name of the rotation y variable + integer(I4B) :: roty_varid !! ID for the rotation y variable + character(NAMELEN) :: rotz_varname = "rotz" !! name of the rotation z variable + integer(I4B) :: rotz_varid !! ID for the rotation z 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_orbx_varname = "L_orbx" !! name of the orbital angular momentum x variable + integer(I4B) :: L_orbx_varid !! ID for the system orbital angular momentum x variable + character(NAMELEN) :: l_orby_varname = "L_orby" !! name of the orbital angular momentum y variable + integer(I4B) :: L_orby_varid !! ID for the system orbital angular momentum y variable + character(NAMELEN) :: l_orbz_varname = "L_orbz" !! name of the orbital angular momentum z variable + integer(I4B) :: L_orbz_varid !! ID for the system orbital angular momentum z variable + character(NAMELEN) :: l_spinx_varname = "L_spinx" !! name of the spin angular momentum x variable + integer(I4B) :: L_spinx_varid !! ID for the system spin angular momentum x variable + character(NAMELEN) :: l_spiny_varname = "L_spiny" !! name of the spin angular momentum y variable + integer(I4B) :: L_spiny_varid !! ID for the system spin angular momentum y variable + character(NAMELEN) :: l_spinz_varname = "L_spinz" !! name of the spin angular momentum z variable + integer(I4B) :: L_spinz_varid !! ID for the system spin angular momentum z variable + character(NAMELEN) :: l_escapex_varname = "L_escapex" !! name of the escaped angular momentum x variable + integer(I4B) :: L_escapex_varid !! ID for the escaped angular momentum x variable + character(NAMELEN) :: l_escapey_varname = "L_escapey" !! name of the escaped angular momentum y variable + integer(I4B) :: L_escapey_varid !! ID for the escaped angular momentum x variable + character(NAMELEN) :: l_escapez_varname = "L_escapez" !! name of the escaped angular momentum z variable + integer(I4B) :: L_escapez_varid !! ID for the escaped angular momentum x 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_xhx_varname = "origin_xhx" !! name of the heliocentric position of the body at the time of origin x variable + integer(I4B) :: origin_xhx_varid !! ID for the origin xh x component + character(NAMELEN) :: origin_xhy_varname = "origin_xhy" !! name of the heliocentric position of the body at the time of origin y variable + integer(I4B) :: origin_xhy_varid !! ID for the origin xh y component + character(NAMELEN) :: origin_xhz_varname = "origin_xhz" !! name of the heliocentric position of the body at the time of origin z variable + integer(I4B) :: origin_xhz_varid !! ID for the origin xh z component + character(NAMELEN) :: origin_vhx_varname = "origin_vhx" !! name of the heliocentric velocity of the body at the time of origin x variable + integer(I4B) :: origin_vhx_varid !! ID for the origin xh x component + character(NAMELEN) :: origin_vhy_varname = "origin_vhy" !! name of the heliocentric velocity of the body at the time of origin y variable + integer(I4B) :: origin_vhy_varid !! ID for the origin xh y component + character(NAMELEN) :: origin_vhz_varname = "origin_vhz" !! name of the heliocentric velocity of the body at the time of origin z variable + integer(I4B) :: origin_vhz_varid !! ID for the origin xh z 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_xhx_varname = "discard_xhx" !! name of the heliocentric position of the body at the time of discard x variable + integer(I4B) :: discard_xhx_varid !! ID for the heliocentric position of the body at the time of discard x variable + character(NAMELEN) :: discard_xhy_varname = "discard_xhy" !! name of the heliocentric position of the body at the time of discard y variable + integer(I4B) :: discard_xhy_varid !! ID for the heliocentric position of the body at the time of discard y variable + character(NAMELEN) :: discard_xhz_varname = "discard_xhz" !! name of the heliocentric position of the body at the time of discard z variable + integer(I4B) :: discard_xhz_varid !! ID for the heliocentric position of the body at the time of discard z variable + character(NAMELEN) :: discard_vhx_varname = "discard_vhx" !! name of the heliocentric velocity of the body at the time of discard x variable + integer(I4B) :: discard_vhx_varid !! ID for the heliocentric velocity of the body at the time of discard x variable + character(NAMELEN) :: discard_vhy_varname = "discard_vhy" !! name of the heliocentric velocity of the body at the time of discard y variable + integer(I4B) :: discard_vhy_varid !! ID for the heliocentric velocity of the body at the time of discard y variable + character(NAMELEN) :: discard_vhz_varname = "discard_vhz" !! name of the heliocentric velocity of the body at the time of discard z variable + integer(I4B) :: discard_vhz_varid !! ID for the heliocentric velocity of the body at the time of discard z 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 @@ -202,7 +207,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 diff --git a/src/netcdf/netcdf.f90 b/src/netcdf/netcdf.f90 index d0098765d..42aa78882 100644 --- a/src/netcdf/netcdf.f90 +++ b/src/netcdf/netcdf.f90 @@ -197,9 +197,9 @@ module subroutine netcdf_initialize_output(self, param) call check( nf90_create(param%outfile, NF90_NETCDF4, self%ncid), "netcdf_initialize_output nf90_create" ) ! Define the NetCDF dimensions with particle name as the record dimension - call check( nf90_def_dim(self%ncid, ID_DIMNAME, NF90_UNLIMITED, self%id_dimid), "netcdf_initialize_output nf90_def_dim id_dimid" ) ! 'x' dimension - call check( nf90_def_dim(self%ncid, 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 + call check( nf90_def_dim(self%ncid, self%id_dimname, NF90_UNLIMITED, self%id_dimid), "netcdf_initialize_output nf90_def_dim id_dimid" ) ! 'x' dimension + call check( nf90_def_dim(self%ncid, self%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, self%time_dimname, NF90_UNLIMITED, self%time_dimid), "netcdf_initialize_output nf90_def_dim time_dimid" ) ! 'y' dimension select case (param%out_type) case("NETCDF_FLOAT") @@ -209,107 +209,107 @@ module subroutine netcdf_initialize_output(self, param) end select !! Define the variables - call check( nf90_def_var(self%ncid, TIME_DIMNAME, self%out_type, self%time_dimid, self%time_varid), "netcdf_initialize_output nf90_def_var time_varid" ) - call check( nf90_def_var(self%ncid, ID_DIMNAME, NF90_INT, self%id_dimid, self%id_varid), "netcdf_initialize_output nf90_def_var id_varid" ) - call check( nf90_def_var(self%ncid, NPL_VARNAME, NF90_INT, self%time_dimid, self%npl_varid), "netcdf_initialize_output nf90_def_var npl_varid" ) - call check( nf90_def_var(self%ncid, NTP_VARNAME, NF90_INT, self%time_dimid, self%ntp_varid), "netcdf_initialize_output nf90_def_var ntp_varid" ) - if (param%integrator == SYMBA) call check( nf90_def_var(self%ncid, NPLM_VARNAME, NF90_INT, self%time_dimid, self%nplm_varid), "netcdf_initialize_output nf90_def_var nplm_varid" ) - call check( nf90_def_var(self%ncid, NAME_VARNAME, NF90_CHAR, [self%str_dimid, self%id_dimid], self%name_varid), "netcdf_initialize_output nf90_def_var name_varid" ) - call check( nf90_def_var(self%ncid, PTYPE_VARNAME, NF90_CHAR, [self%str_dimid, self%id_dimid], self%ptype_varid), "netcdf_initialize_output nf90_def_var ptype_varid" ) - call check( nf90_def_var(self%ncid, STATUS_VARNAME, NF90_CHAR, [self%str_dimid, self%id_dimid], self%status_varid), "netcdf_initialize_output nf90_def_var status_varid" ) + call check( nf90_def_var(self%ncid, self%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, self%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, self%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, self%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, self%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, self%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, self%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, self%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" ) + call check( nf90_def_var(self%ncid, self%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, self%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, self%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, self%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, self%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, self%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" ) + call check( nf90_def_var(self%ncid, self%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, self%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, self%gr_pseudo_vhz_varname, self%out_type, [self%id_dimid, self%time_dimid], self%gr_pseudo_vhz_varid), "netcdf_initialize_output nf90_def_var gr_psuedo_vhz_varid" ) self%lpseudo_vel_exists = .true. end if end if if ((param%out_form == "EL") .or. (param%out_form == "XVEL")) then - call check( nf90_def_var(self%ncid, A_VARNAME, self%out_type, [self%id_dimid, self%time_dimid], self%a_varid), "netcdf_initialize_output nf90_def_var a_varid" ) - call check( nf90_def_var(self%ncid, E_VARNAME, self%out_type, [self%id_dimid, self%time_dimid], self%e_varid), "netcdf_initialize_output nf90_def_var e_varid" ) - call check( nf90_def_var(self%ncid, INC_VARNAME, self%out_type, [self%id_dimid, self%time_dimid], self%inc_varid), "netcdf_initialize_output nf90_def_var inc_varid" ) - call check( nf90_def_var(self%ncid, CAPOM_VARNAME, self%out_type, [self%id_dimid, self%time_dimid], self%capom_varid), "netcdf_initialize_output nf90_def_var capom_varid" ) - call check( nf90_def_var(self%ncid, OMEGA_VARNAME, self%out_type, [self%id_dimid, self%time_dimid], self%omega_varid), "netcdf_initialize_output nf90_def_var omega_varid" ) - call check( nf90_def_var(self%ncid, CAPM_VARNAME, self%out_type, [self%id_dimid, self%time_dimid], self%capm_varid), "netcdf_initialize_output nf90_def_var capm_varid" ) + call check( nf90_def_var(self%ncid, self%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, self%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, self%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, self%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, self%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, self%capm_varname, self%out_type, [self%id_dimid, self%time_dimid], self%capm_varid), "netcdf_initialize_output nf90_def_var capm_varid" ) end if - call check( nf90_def_var(self%ncid, GMASS_VARNAME, self%out_type, [self%id_dimid, self%time_dimid], self%Gmass_varid), "netcdf_initialize_output nf90_def_var Gmass_varid" ) + call check( nf90_def_var(self%ncid, self%gmass_varname, self%out_type, [self%id_dimid, self%time_dimid], self%Gmass_varid), "netcdf_initialize_output nf90_def_var Gmass_varid" ) if (param%lrhill_present) then - call check( nf90_def_var(self%ncid, RHILL_VARNAME, self%out_type, [self%id_dimid, self%time_dimid], self%rhill_varid), "netcdf_initialize_output nf90_def_var rhill_varid" ) + call check( nf90_def_var(self%ncid, self%rhill_varname, self%out_type, [self%id_dimid, self%time_dimid], self%rhill_varid), "netcdf_initialize_output nf90_def_var rhill_varid" ) end if if (param%lclose) then - call check( nf90_def_var(self%ncid, RADIUS_VARNAME, self%out_type, [self%id_dimid, self%time_dimid], self%radius_varid), "netcdf_initialize_output nf90_def_var radius_varid" ) + call check( nf90_def_var(self%ncid, self%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], & + call check( nf90_def_var(self%ncid, self%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, self%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" ) + call check( nf90_def_var(self%ncid, self%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, self%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, self%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, self%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, self%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, self%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, self%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, self%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, self%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, self%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, self%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, self%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, self%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, self%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, self%discard_body_id_varname, NF90_INT, self%id_dimid, self%discard_body_id_varid), "netcdf_initialize_output nf90_def_var discard_body_id_varid" ) end if if (param%lrotation) then - call check( nf90_def_var(self%ncid, IP1_VARNAME, self%out_type, [self%id_dimid, self%time_dimid], self%Ip1_varid), "netcdf_initialize_output nf90_def_var Ip1_varid" ) - call check( nf90_def_var(self%ncid, IP2_VARNAME, self%out_type, [self%id_dimid, self%time_dimid], self%Ip2_varid), "netcdf_initialize_output nf90_def_var Ip2_varid" ) - call check( nf90_def_var(self%ncid, IP3_VARNAME, self%out_type, [self%id_dimid, self%time_dimid], self%Ip3_varid), "netcdf_initialize_output nf90_def_var Ip3_varid" ) - call check( nf90_def_var(self%ncid, ROTX_VARNAME, self%out_type, [self%id_dimid, self%time_dimid], self%rotx_varid), "netcdf_initialize_output nf90_def_var rotx_varid" ) - call check( nf90_def_var(self%ncid, ROTY_VARNAME, self%out_type, [self%id_dimid, self%time_dimid], self%roty_varid), "netcdf_initialize_output nf90_def_var roty_varid" ) - call check( nf90_def_var(self%ncid, ROTZ_VARNAME, self%out_type, [self%id_dimid, self%time_dimid], self%rotz_varid), "netcdf_initialize_output nf90_def_var rotz_varid" ) + call check( nf90_def_var(self%ncid, self%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, self%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, self%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, self%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, self%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, self%rotz_varname, self%out_type, [self%id_dimid, self%time_dimid], self%rotz_varid), "netcdf_initialize_output nf90_def_var rotz_varid" ) end if ! if (param%ltides) then - ! call check( nf90_def_var(self%ncid, K2_VARNAME, self%out_type, [self%id_dimid, self%time_dimid], self%k2_varid), "netcdf_initialize_output nf90_def_var k2_varid" ) - ! call check( nf90_def_var(self%ncid, Q_VARNAME, self%out_type, [self%id_dimid, self%time_dimid], self%Q_varid), "netcdf_initialize_output nf90_def_var Q_varid" ) + ! call check( nf90_def_var(self%ncid, self%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, self%q_varname, self%out_type, [self%id_dimid, self%time_dimid], self%Q_varid), "netcdf_initialize_output nf90_def_var Q_varid" ) ! end if if (param%lenergy) then - call check( nf90_def_var(self%ncid, KE_ORB_VARNAME, self%out_type, self%time_dimid, self%KE_orb_varid), "netcdf_initialize_output nf90_def_var KE_orb_varid" ) - call check( nf90_def_var(self%ncid, KE_SPIN_VARNAME, self%out_type, self%time_dimid, self%KE_spin_varid), "netcdf_initialize_output nf90_def_var KE_spin_varid" ) - call check( nf90_def_var(self%ncid, PE_VARNAME, self%out_type, self%time_dimid, self%PE_varid), "netcdf_initialize_output nf90_def_var PE_varid" ) - call check( nf90_def_var(self%ncid, L_ORBX_VARNAME, self%out_type, self%time_dimid, self%L_orbx_varid), "netcdf_initialize_output nf90_def_var L_orbx_varid" ) - call check( nf90_def_var(self%ncid, L_ORBY_VARNAME, self%out_type, self%time_dimid, self%L_orby_varid), "netcdf_initialize_output nf90_def_var L_orby_varid" ) - call check( nf90_def_var(self%ncid, L_ORBZ_VARNAME, self%out_type, self%time_dimid, self%L_orbz_varid), "netcdf_initialize_output nf90_def_var L_orbz_varid" ) - call check( nf90_def_var(self%ncid, L_SPINX_VARNAME, self%out_type, self%time_dimid, self%L_spinx_varid), "netcdf_initialize_output nf90_def_var L_spinx_varid" ) - call check( nf90_def_var(self%ncid, L_SPINY_VARNAME, self%out_type, self%time_dimid, self%L_spiny_varid), "netcdf_initialize_output nf90_def_var L_spiny_varid" ) - call check( nf90_def_var(self%ncid, L_SPINZ_VARNAME, self%out_type, self%time_dimid, self%L_spinz_varid), "netcdf_initialize_output nf90_def_var L_spinz_varid" ) - call check( nf90_def_var(self%ncid, L_ESCAPEX_VARNAME, self%out_type, self%time_dimid, self%L_escapex_varid), "netcdf_initialize_output nf90_def_var L_escapex_varid" ) - call check( nf90_def_var(self%ncid, L_ESCAPEY_VARNAME, self%out_type, self%time_dimid, self%L_escapey_varid), "netcdf_initialize_output nf90_def_var L_escapey_varid" ) - call check( nf90_def_var(self%ncid, L_ESCAPEZ_VARNAME, self%out_type, self%time_dimid, self%L_escapez_varid), "netcdf_initialize_output nf90_def_var L_escapez_varid" ) - call check( nf90_def_var(self%ncid, ECOLLISIONS_VARNAME, self%out_type, self%time_dimid, self%Ecollisions_varid), "netcdf_initialize_output nf90_def_var Ecollisions_varid" ) - call check( nf90_def_var(self%ncid, EUNTRACKED_VARNAME, self%out_type, self%time_dimid, self%Euntracked_varid), "netcdf_initialize_output nf90_def_var Euntracked_varid" ) - call check( nf90_def_var(self%ncid, GMESCAPE_VARNAME, self%out_type, self%time_dimid, self%GMescape_varid), "netcdf_initialize_output nf90_def_var GMescape_varid" ) + call check( nf90_def_var(self%ncid, self%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, self%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, self%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, self%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, self%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, self%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, self%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, self%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, self%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, self%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, self%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, self%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, self%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, self%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, self%gmescape_varname, self%out_type, self%time_dimid, self%GMescape_varid), "netcdf_initialize_output nf90_def_var GMescape_varid" ) end if - call check( nf90_def_var(self%ncid, J2RP2_VARNAME, self%out_type, self%time_dimid, self%j2rp2_varid), "netcdf_initialize_output nf90_def_var j2rp2_varid" ) - call check( nf90_def_var(self%ncid, J4RP4_VARNAME, self%out_type, self%time_dimid, self%j4rp4_varid), "netcdf_initialize_output nf90_def_var j4rp4_varid" ) + call check( nf90_def_var(self%ncid, self%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, self%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 @@ -361,8 +361,8 @@ module subroutine netcdf_open(self, param, readonly) write(errmsg,*) "netcdf_open nf90_open ",trim(adjustl(param%outfile)) call check( nf90_open(param%outfile, mode, self%ncid), errmsg) - call check( nf90_inq_dimid(self%ncid, TIME_DIMNAME, self%time_dimid), "netcdf_open nf90_inq_dimid time_dimid" ) - call check( nf90_inq_dimid(self%ncid, ID_DIMNAME, self%id_dimid), "netcdf_open nf90_inq_dimid id_dimid" ) + call check( nf90_inq_dimid(self%ncid, self%time_dimname, self%time_dimid), "netcdf_open nf90_inq_dimid time_dimid" ) + call check( nf90_inq_dimid(self%ncid, self%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 @@ -375,29 +375,29 @@ module subroutine netcdf_open(self, param, readonly) ! 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" ) + call check( nf90_inq_varid(self%ncid, self%time_dimname, self%time_varid), "netcdf_open nf90_inq_varid time_varid" ) + call check( nf90_inq_varid(self%ncid, self%id_dimname, self%id_varid), "netcdf_open nf90_inq_varid id_varid" ) + call check( nf90_inq_varid(self%ncid, self%name_varname, self%name_varid), "netcdf_open nf90_inq_varid name_varid" ) + call check( nf90_inq_varid(self%ncid, self%ptype_varname, self%ptype_varid), "netcdf_open nf90_inq_varid ptype_varid" ) + call check( nf90_inq_varid(self%ncid, self%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" ) + call check( nf90_inq_varid(self%ncid, self%xhx_varname, self%xhx_varid), "netcdf_open nf90_inq_varid xhx_varid" ) + call check( nf90_inq_varid(self%ncid, self%xhy_varname, self%xhy_varid), "netcdf_open nf90_inq_varid xhy_varid" ) + call check( nf90_inq_varid(self%ncid, self%xhz_varname, self%xhz_varid), "netcdf_open nf90_inq_varid xhz_varid" ) + call check( nf90_inq_varid(self%ncid, self%vhx_varname, self%vhx_varid), "netcdf_open nf90_inq_varid vhx_varid" ) + call check( nf90_inq_varid(self%ncid, self%vhy_varname, self%vhy_varid), "netcdf_open nf90_inq_varid vhy_varid" ) + call check( nf90_inq_varid(self%ncid, self%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) + status = nf90_inq_varid(self%ncid, self%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) + status = nf90_inq_varid(self%ncid, self%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) + status = nf90_inq_varid(self%ncid, self%gr_pseudo_vhz_varname, self%gr_pseudo_vhz_varid) self%lpseudo_vel_exists = (status == nf90_noerr) end if end if @@ -409,85 +409,85 @@ module subroutine netcdf_open(self, param, readonly) 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" ) + call check( nf90_inq_varid(self%ncid, self%a_varname, self%a_varid), "netcdf_open nf90_inq_varid a_varid" ) + call check( nf90_inq_varid(self%ncid, self%e_varname, self%e_varid), "netcdf_open nf90_inq_varid e_varid" ) + call check( nf90_inq_varid(self%ncid, self%inc_varname, self%inc_varid), "netcdf_open nf90_inq_varid inc_varid" ) + call check( nf90_inq_varid(self%ncid, self%capom_varname, self%capom_varid), "netcdf_open nf90_inq_varid capom_varid" ) + call check( nf90_inq_varid(self%ncid, self%omega_varname, self%omega_varid), "netcdf_open nf90_inq_varid omega_varid" ) + call check( nf90_inq_varid(self%ncid, self%capm_varname, self%capm_varid), "netcdf_open nf90_inq_varid capm_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" ) + call check( nf90_inq_varid(self%ncid, self%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" ) + call check( nf90_inq_varid(self%ncid, self%ip1_varname, self%Ip1_varid), "netcdf_open nf90_inq_varid Ip1_varid" ) + call check( nf90_inq_varid(self%ncid, self%ip2_varname, self%Ip2_varid), "netcdf_open nf90_inq_varid Ip2_varid" ) + call check( nf90_inq_varid(self%ncid, self%ip3_varname, self%Ip3_varid), "netcdf_open nf90_inq_varid Ip3_varid" ) + call check( nf90_inq_varid(self%ncid, self%rotx_varname, self%rotx_varid), "netcdf_open nf90_inq_varid rotx_varid" ) + call check( nf90_inq_varid(self%ncid, self%roty_varname, self%roty_varid), "netcdf_open nf90_inq_varid roty_varid" ) + call check( nf90_inq_varid(self%ncid, self%rotz_varname, self%rotz_varid), "netcdf_open nf90_inq_varid rotz_varid" ) end if ! if (param%ltides) then - ! call check( nf90_inq_varid(self%ncid, K2_VARNAME, self%k2_varid), "netcdf_open nf90_inq_varid k2_varid" ) - ! call check( nf90_inq_varid(self%ncid, Q_VARNAME, self%Q_varid), "netcdf_open nf90_inq_varid Q_varid" ) + ! call check( nf90_inq_varid(self%ncid, self%k2_varname, self%k2_varid), "netcdf_open nf90_inq_varid k2_varid" ) + ! call check( nf90_inq_varid(self%ncid, self%q_varname, self%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) + status = nf90_inq_varid(self%ncid, self%rhill_varname, self%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) + status = nf90_inq_varid(self%ncid, self%npl_varname, self%npl_varid) + status = nf90_inq_varid(self%ncid, self%ntp_varname, self%ntp_varid) + status = nf90_inq_varid(self%ncid, self%status_varname, self%status_varid) + status = nf90_inq_varid(self%ncid, self%j2rp2_varname, self%j2rp2_varid) + status = nf90_inq_varid(self%ncid, self%j4rp4_varname, self%j4rp4_varid) if (param%integrator == SYMBA) then - status = nf90_inq_varid(self%ncid, NPLM_VARNAME, self%nplm_varid) + status = nf90_inq_varid(self%ncid, self%nplm_varname, self%nplm_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) + status = nf90_inq_varid(self%ncid, self%origin_type_varname, self%origin_type_varid) + status = nf90_inq_varid(self%ncid, self%origin_time_varname, self%origin_time_varid) + status = nf90_inq_varid(self%ncid, self%origin_xhx_varname, self%origin_xhx_varid) + status = nf90_inq_varid(self%ncid, self%origin_xhy_varname, self%origin_xhy_varid) + status = nf90_inq_varid(self%ncid, self%origin_xhz_varname, self%origin_xhz_varid) + status = nf90_inq_varid(self%ncid, self%origin_vhx_varname, self%origin_vhx_varid) + status = nf90_inq_varid(self%ncid, self%origin_vhy_varname, self%origin_vhy_varid) + status = nf90_inq_varid(self%ncid, self%origin_vhz_varname, self%origin_vhz_varid) + status = nf90_inq_varid(self%ncid, self%collision_id_varname, self%collision_id_varid) + status = nf90_inq_varid(self%ncid, self%discard_time_varname, self%discard_time_varid) + status = nf90_inq_varid(self%ncid, self%discard_xhx_varname, self%discard_xhx_varid) + status = nf90_inq_varid(self%ncid, self%discard_xhy_varname, self%discard_xhy_varid) + status = nf90_inq_varid(self%ncid, self%discard_xhz_varname, self%discard_xhz_varid) + status = nf90_inq_varid(self%ncid, self%discard_vhx_varname, self%discard_vhx_varid) + status = nf90_inq_varid(self%ncid, self%discard_vhy_varname, self%discard_vhy_varid) + status = nf90_inq_varid(self%ncid, self%discard_vhz_varname, self%discard_vhz_varid) + status = nf90_inq_varid(self%ncid, self%discard_body_id_varname, self%discard_body_id_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) + status = nf90_inq_varid(self%ncid, self%ke_orb_varname, self%KE_orb_varid) + status = nf90_inq_varid(self%ncid, self%ke_spin_varname, self%KE_spin_varid) + status = nf90_inq_varid(self%ncid, self%pe_varname, self%PE_varid) + status = nf90_inq_varid(self%ncid, self%l_orbx_varname, self%L_orbx_varid) + status = nf90_inq_varid(self%ncid, self%l_orby_varname, self%L_orby_varid) + status = nf90_inq_varid(self%ncid, self%l_orbz_varname, self%L_orbz_varid) + status = nf90_inq_varid(self%ncid, self%l_spinx_varname, self%L_spinx_varid) + status = nf90_inq_varid(self%ncid, self%l_spiny_varname, self%L_spiny_varid) + status = nf90_inq_varid(self%ncid, self%l_spinz_varname, self%L_spinz_varid) + status = nf90_inq_varid(self%ncid, self%l_escapex_varname, self%L_escapex_varid) + status = nf90_inq_varid(self%ncid, self%l_escapey_varname, self%L_escapey_varid) + status = nf90_inq_varid(self%ncid, self%l_escapez_varname, self%L_escapez_varid) + status = nf90_inq_varid(self%ncid, self%ecollisions_varname, self%Ecollisions_varid) + status = nf90_inq_varid(self%ncid, self%euntracked_varname, self%Euntracked_varid) + status = nf90_inq_varid(self%ncid, self%gmescape_varname, self%GMescape_varid) end if return @@ -733,14 +733,14 @@ module function netcdf_read_frame_system(self, iu, param) result(ierr) ! 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(iu%ncid, iu%j2rp2_varname, iu%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" ) else cb%j2rp2 = 0.0_DP end if - status = nf90_inq_varid(iu%ncid, J4RP4_VARNAME, iu%j4rp4_varid) + status = nf90_inq_varid(iu%ncid, iu%j4rp4_varname, iu%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" ) else @@ -813,14 +813,14 @@ 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(iu%ncid, iu%npl_varname, iu%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" ) else self%pl%nbody = count(plmask(:)) end if - status = nf90_inq_varid(iu%ncid, NTP_VARNAME, iu%ntp_varid) + status = nf90_inq_varid(iu%ncid, iu%ntp_varname, iu%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" ) else @@ -828,7 +828,7 @@ module subroutine netcdf_read_hdr_system(self, iu, param) end if if (param%integrator == SYMBA) then - status = nf90_inq_varid(iu%ncid, NPLM_VARNAME, iu%nplm_varid) + status = nf90_inq_varid(iu%ncid, iu%nplm_varname, iu%nplm_varid) select type(pl => self%pl) class is (symba_pl) if (status == nf90_noerr) then @@ -840,35 +840,35 @@ 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) + status = nf90_inq_varid(iu%ncid, iu%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) + status = nf90_inq_varid(iu%ncid, iu%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) + status = nf90_inq_varid(iu%ncid, iu%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) + status = nf90_inq_varid(iu%ncid, iu%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) + status = nf90_inq_varid(iu%ncid, iu%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) + status = nf90_inq_varid(iu%ncid, iu%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) + status = nf90_inq_varid(iu%ncid, iu%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) + status = nf90_inq_varid(iu%ncid, iu%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) + status = nf90_inq_varid(iu%ncid, iu%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) + status = nf90_inq_varid(iu%ncid, iu%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) + status = nf90_inq_varid(iu%ncid, iu%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) + status = nf90_inq_varid(iu%ncid, iu%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) + status = nf90_inq_varid(iu%ncid, iu%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) + status = nf90_inq_varid(iu%ncid, iu%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) + status = nf90_inq_varid(iu%ncid, iu%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" ) end if @@ -946,7 +946,7 @@ module subroutine netcdf_read_particle_info_system(self, iu, param, plmask, tpma call tp%info(i)%set_value(particle_type=ctemp(tpind(i))) end do - status = nf90_inq_varid(iu%ncid, STATUS_VARNAME, iu%status_varid) + status = nf90_inq_varid(iu%ncid, iu%status_varname, iu%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 cb%info%set_value(status=ctemp(1)) @@ -962,7 +962,7 @@ 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(iu%ncid, iu%origin_type_varname, iu%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" ) else @@ -977,7 +977,7 @@ 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(iu%ncid, iu%origin_time_varname, iu%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" ) else @@ -992,7 +992,7 @@ 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(iu%ncid, iu%origin_xhx_varname, iu%origin_xhx_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" ) else if ((param%out_form == "XV") .or. (param%out_form == "XVEL")) then @@ -1001,7 +1001,7 @@ module subroutine netcdf_read_particle_info_system(self, iu, param, plmask, tpma rtemp_arr(1,:) = 0._DP end if - status = nf90_inq_varid(iu%ncid, ORIGIN_XHY_VARNAME, iu%origin_xhy_varid) + status = nf90_inq_varid(iu%ncid, iu%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 @@ -1010,7 +1010,7 @@ module subroutine netcdf_read_particle_info_system(self, iu, param, plmask, tpma rtemp_arr(2,:) = 0._DP end if - status = nf90_inq_varid(iu%ncid, ORIGIN_XHZ_VARNAME, iu%origin_xhz_varid) + status = nf90_inq_varid(iu%ncid, iu%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 @@ -1026,7 +1026,7 @@ module subroutine netcdf_read_particle_info_system(self, iu, param, plmask, tpma call tp%info(i)%set_value(origin_xh=rtemp_arr(:,tpind(i))) end do - status = nf90_inq_varid(iu%ncid, ORIGIN_VHX_VARNAME, iu%origin_vhx_varid) + status = nf90_inq_varid(iu%ncid, iu%origin_vhx_varname, iu%origin_vhx_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" ) else if ((param%out_form == "XV") .or. (param%out_form == "XVEL")) then @@ -1035,7 +1035,7 @@ module subroutine netcdf_read_particle_info_system(self, iu, param, plmask, tpma rtemp_arr(1,:) = 0._DP end if - status = nf90_inq_varid(iu%ncid, ORIGIN_VHY_VARNAME, iu%origin_vhy_varid) + status = nf90_inq_varid(iu%ncid, iu%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 @@ -1044,7 +1044,7 @@ module subroutine netcdf_read_particle_info_system(self, iu, param, plmask, tpma rtemp_arr(2,:) = 0._DP end if - status = nf90_inq_varid(iu%ncid, ORIGIN_VHZ_VARNAME, iu%origin_vhz_varid) + status = nf90_inq_varid(iu%ncid, iu%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 @@ -1060,7 +1060,7 @@ module subroutine netcdf_read_particle_info_system(self, iu, param, plmask, tpma call tp%info(i)%set_value(origin_vh=rtemp_arr(:,tpind(i))) end do - status = nf90_inq_varid(iu%ncid, COLLISION_ID_VARNAME, iu%collision_id_varid) + status = nf90_inq_varid(iu%ncid, iu%collision_id_varname, iu%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" ) else @@ -1074,7 +1074,7 @@ 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(iu%ncid, iu%discard_time_varname, iu%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" ) else @@ -1089,21 +1089,21 @@ 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) + status = nf90_inq_varid(iu%ncid, iu%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) + status = nf90_inq_varid(iu%ncid, iu%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(iu%ncid, iu%discard_xhz_varname, iu%discard_xhz_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" ) else @@ -1117,21 +1117,21 @@ module subroutine netcdf_read_particle_info_system(self, iu, param, plmask, tpma call tp%info(i)%set_value(discard_xh=rtemp_arr(:,tpind(i))) end do - status = nf90_inq_varid(iu%ncid, DISCARD_VHX_VARNAME, iu%discard_vhx_varid) + status = nf90_inq_varid(iu%ncid, iu%discard_vhx_varname, iu%discard_vhx_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" ) else rtemp_arr(1,:) = 0.0_DP end if - status = nf90_inq_varid(iu%ncid, DISCARD_VHY_VARNAME, iu%discard_vhy_varid) + status = nf90_inq_varid(iu%ncid, iu%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) + status = nf90_inq_varid(iu%ncid, iu%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 From c514868dc0d8b6de40300bca73a706c23bac0aa9 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Sat, 3 Dec 2022 06:37:01 -0500 Subject: [PATCH 208/569] Removed space stuff for new branch --- src/modules/swiftest_classes.f90 | 2 -- 1 file changed, 2 deletions(-) diff --git a/src/modules/swiftest_classes.f90 b/src/modules/swiftest_classes.f90 index 5c75908fb..3c4543886 100644 --- a/src/modules/swiftest_classes.f90 +++ b/src/modules/swiftest_classes.f90 @@ -36,8 +36,6 @@ module swiftest_classes integer(I4B) :: time_varid !! ID for the time variable character(NAMELEN) :: id_dimname = "id" !! name of 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_varid !! ID for the space variable ! Non-dimension ids and variable names character(NAMELEN) :: ptype_varname = "particle_type" !! name of the particle type variable From d2221e2d249d63ba10fe1e414a8e6b4e89aaf814 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Sat, 3 Dec 2022 06:39:17 -0500 Subject: [PATCH 209/569] Disabled the encounter dumps for testing --- src/symba/symba_step.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/symba/symba_step.f90 b/src/symba/symba_step.f90 index 183105b35..ecf1874f6 100644 --- a/src/symba/symba_step.f90 +++ b/src/symba/symba_step.f90 @@ -38,7 +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) + !call self%encounter_history%dump(param) else self%irec = -1 call helio_step_system(self, param, t, dt) From 6585cd46c7b1b09d60930e22f8ede47a4aa2aa70 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Sat, 3 Dec 2022 06:41:42 -0500 Subject: [PATCH 210/569] Added the SPACE DIMENSION! --- src/modules/swiftest_classes.f90 | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/modules/swiftest_classes.f90 b/src/modules/swiftest_classes.f90 index 3c4543886..5c75908fb 100644 --- a/src/modules/swiftest_classes.f90 +++ b/src/modules/swiftest_classes.f90 @@ -36,6 +36,8 @@ module swiftest_classes integer(I4B) :: time_varid !! ID for the time variable character(NAMELEN) :: id_dimname = "id" !! name of 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_varid !! ID for the space variable ! Non-dimension ids and variable names character(NAMELEN) :: ptype_varname = "particle_type" !! name of the particle type variable From 2f24f6fb8dd96c3eb8ebfc71f47485b68ec28b0d Mon Sep 17 00:00:00 2001 From: David A Minton Date: Sat, 3 Dec 2022 07:06:38 -0500 Subject: [PATCH 211/569] Refactored NetCDF subroutines and arguments for consistency and clarity --- src/encounter/encounter_io.f90 | 124 ++-- src/modules/encounter_classes.f90 | 4 +- src/modules/swiftest_classes.f90 | 35 +- src/netcdf/netcdf.f90 | 989 ++++++++++++++-------------- src/symba/symba_encounter_check.f90 | 14 +- 5 files changed, 586 insertions(+), 580 deletions(-) diff --git a/src/encounter/encounter_io.f90 b/src/encounter/encounter_io.f90 index badd3685a..e425c0ae1 100644 --- a/src/encounter/encounter_io.f90 +++ b/src/encounter/encounter_io.f90 @@ -67,12 +67,12 @@ module subroutine encounter_io_initialize_output(self, param) close(unit=LUN, status="delete") end if - call check( nf90_create(self%enc_file, NF90_NETCDF4, self%ncid), "encounter_io_initialize_output nf90_create" ) + call check( nf90_create(self%enc_file, NF90_NETCDF4, self%id), "encounter_io_initialize_output nf90_create" ) - call check( nf90_def_dim(self%ncid, self%encid_dimname, NF90_UNLIMITED, self%encid_dimid), "encounter_io_initialize_output nf90_def_dim encid_dimid" ) - call check( nf90_def_dim(self%ncid, 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%ncid, 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%ncid, self%collider_dimname, self%collider_dim_size, self%collider_dimid), "encounter_io_initialize_output nf90_def_dim time_dimid" ) ! 'y' dimension + 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") @@ -81,23 +81,23 @@ module subroutine encounter_io_initialize_output(self, param) self%out_type = NF90_DOUBLE end select - call check( nf90_def_var(self%ncid, 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%ncid, 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%ncid, self%name_varname, NF90_CHAR, [self%str_dimid, self%collider_dimid, self%encid_dimid], self%name_varid), "encounter_io_initialize_output nf90_def_var name_varid" ) - call check( nf90_def_var(self%ncid, self%id_dimname, NF90_INT, [self%collider_dimid, self%encid_dimid, self%time_dimid], self%id_varid), "encounter_io_initialize_output nf90_def_var id_varid" ) - call check( nf90_def_var(self%ncid, self%xhx_varname, self%out_type, [self%collider_dimid, self%encid_dimid, self%time_dimid], self%xhx_varid), "encounter_io_initialize_output nf90_def_var xhx_varid" ) - call check( nf90_def_var(self%ncid, self%xhy_varname, self%out_type, [self%collider_dimid, self%encid_dimid, self%time_dimid], self%xhy_varid), "encounter_io_initialize_output nf90_def_var xhy_varid" ) - call check( nf90_def_var(self%ncid, self%xhz_varname, self%out_type, [self%collider_dimid, self%encid_dimid, self%time_dimid], self%xhz_varid), "encounter_io_initialize_output nf90_def_var xhz_varid" ) - call check( nf90_def_var(self%ncid, self%vhx_varname, self%out_type, [self%collider_dimid, self%encid_dimid, self%time_dimid], self%vhx_varid), "encounter_io_initialize_output nf90_def_var vhx_varid" ) - call check( nf90_def_var(self%ncid, self%vhy_varname, self%out_type, [self%collider_dimid, self%encid_dimid, self%time_dimid], self%vhy_varid), "encounter_io_initialize_output nf90_def_var vhy_varid" ) - call check( nf90_def_var(self%ncid, self%vhz_varname, self%out_type, [self%collider_dimid, self%encid_dimid, self%time_dimid], self%vhz_varid), "encounter_io_initialize_output nf90_def_var vhz_varid" ) - call check( nf90_def_var(self%ncid, self%level_varname, NF90_INT, [self%encid_dimid, self%time_dimid], self%level_varid), "encounter_io_initialize_output nf90_def_var level_varid" ) - call check( nf90_def_var(self%ncid, self%gmass_varname, self%out_type, [self%collider_dimid, self%encid_dimid, self%time_dimid], self%Gmass_varid), "encounter_io_initialize_output nf90_def_var Gmass_varid" ) - call check( nf90_def_var(self%ncid, self%radius_varname, self%out_type, [self%collider_dimid, self%encid_dimid, self%time_dimid], self%radius_varid), "encounter_io_initialize_output nf90_def_var radius_varid" ) + 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%xhx_varname, self%out_type, [self%collider_dimid, self%eid_dimid, self%time_dimid], self%xhx_varid), "encounter_io_initialize_output nf90_def_var xhx_varid" ) + call check( nf90_def_var(self%id, self%xhy_varname, self%out_type, [self%collider_dimid, self%eid_dimid, self%time_dimid], self%xhy_varid), "encounter_io_initialize_output nf90_def_var xhy_varid" ) + call check( nf90_def_var(self%id, self%xhz_varname, self%out_type, [self%collider_dimid, self%eid_dimid, self%time_dimid], self%xhz_varid), "encounter_io_initialize_output nf90_def_var xhz_varid" ) + call check( nf90_def_var(self%id, self%vhx_varname, self%out_type, [self%collider_dimid, self%eid_dimid, self%time_dimid], self%vhx_varid), "encounter_io_initialize_output nf90_def_var vhx_varid" ) + call check( nf90_def_var(self%id, self%vhy_varname, self%out_type, [self%collider_dimid, self%eid_dimid, self%time_dimid], self%vhy_varid), "encounter_io_initialize_output nf90_def_var vhy_varid" ) + call check( nf90_def_var(self%id, self%vhz_varname, self%out_type, [self%collider_dimid, self%eid_dimid, self%time_dimid], self%vhz_varid), "encounter_io_initialize_output nf90_def_var vhz_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%ncid), "encounter_io_initialize_output nf90_enddef" ) + call check( nf90_enddef(self%id), "encounter_io_initialize_output nf90_enddef" ) return @@ -126,26 +126,26 @@ module subroutine encounter_io_open_file(self, param, readonly) end if write(errmsg,*) "encounter_io_open_file nf90_open ",trim(adjustl(param%outfile)) - call check( nf90_open(self%enc_file, mode, self%ncid), errmsg) - - call check( nf90_inq_dimid(self%ncid, self%time_dimname, self%time_dimid), "encounter_io_open_file nf90_inq_dimid time_dimid" ) - call check( nf90_inq_dimid(self%ncid, self%encid_dimname, self%encid_dimid), "encounter_io_open_file nf90_inq_dimid encid_dimid" ) - call check( nf90_inq_dimid(self%ncid, self%collider_dimname, self%collider_dimid), "encounter_io_open_file nf90_inq_dimid collider_dimid" ) - call check( nf90_inq_dimid(self%ncid, self%str_dimname, self%str_dimid), "encounter_io_open_file nf90_inq_dimid collider_str" ) - - call check( nf90_inq_varid(self%ncid, self%time_dimname, self%time_varid), "encounter_io_open_file nf90_inq_varid time_varid" ) - call check( nf90_inq_varid(self%ncid, self%name_varname, self%name_varid), "encounter_io_open_file nf90_inq_varid name_varid" ) - call check( nf90_inq_varid(self%ncid, self%nenc_varname, self%nenc_varid), "encounter_io_open_file nf90_inq_varid nenc_varid" ) - - call check( nf90_inq_varid(self%ncid, self%xhx_varname, self%xhx_varid), "encounter_io_open_file nf90_inq_varid xhx_varid" ) - call check( nf90_inq_varid(self%ncid, self%xhy_varname, self%xhy_varid), "encounter_io_open_file nf90_inq_varid xhy_varid" ) - call check( nf90_inq_varid(self%ncid, self%xhz_varname, self%xhz_varid), "encounter_io_open_file nf90_inq_varid xhz_varid" ) - call check( nf90_inq_varid(self%ncid, self%vhx_varname, self%vhx_varid), "encounter_io_open_file nf90_inq_varid vhx_varid" ) - call check( nf90_inq_varid(self%ncid, self%vhy_varname, self%vhy_varid), "encounter_io_open_file nf90_inq_varid vhy_varid" ) - call check( nf90_inq_varid(self%ncid, self%vhz_varname, self%vhz_varid), "encounter_io_open_file nf90_inq_varid vhz_varid" ) - call check( nf90_inq_varid(self%ncid, self%level_varname, self%level_varid), "encounter_io_open_file nf90_inq_varid level_varid" ) - call check( nf90_inq_varid(self%ncid, self%gmass_varname, self%Gmass_varid), "encounter_io_open_file nf90_inq_varid Gmass_varid" ) - call check( nf90_inq_varid(self%ncid, self%radius_varname, self%radius_varid), "encounter_io_open_file nf90_inq_varid radius_varid" ) + 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 @@ -164,31 +164,31 @@ module subroutine encounter_io_write_frame(self, iu, param) i = iu%ienc_frame n = int(self%nenc, kind=I4B) - call check( nf90_set_fill(iu%ncid, nf90_nofill, old_mode), "encounter_io_write_frame_base nf90_set_fill" ) - call check( nf90_put_var(iu%ncid, iu%time_varid, self%t, start=[i]), "encounter_io_write_frame nf90_put_var time_varid" ) - - call check( nf90_put_var(iu%ncid, iu%nenc_varid, self%nenc, start=[i]), "encounter_io_frame nf90_put_var nenc_varid" ) - call check( nf90_put_var(iu%ncid, 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%ncid, 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%ncid, 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%ncid, 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%ncid, 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%ncid, 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%ncid, 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%ncid, 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%ncid, 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%ncid, 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%ncid, 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%ncid, 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%ncid, 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%ncid, 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%ncid, 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%ncid, 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%ncid, 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%ncid, iu%radius_varid, self%radius2(1:n), start=[2, 1, i], count=[1,n,1]), "netcdf_write_frame nf90_put_var radius 2" ) + 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%ncid, iu%level_varid, self%level(1:n), start=[1, i], count=[n,1]), "netcdf_write_frame nf90_put_var level" ) + 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 diff --git a/src/modules/encounter_classes.f90 b/src/modules/encounter_classes.f90 index 1bb595b02..a7f2d72ac 100644 --- a/src/modules/encounter_classes.f90 +++ b/src/modules/encounter_classes.f90 @@ -54,8 +54,8 @@ module encounter_classes integer(I4B) :: ienc_frame !! Current frame number for the encounter history character(STRMAX) :: enc_file = "encounter.nc" !! Encounter output file name - character(NAMELEN) :: encid_dimname = "encounter" !! The index of the encountering pair in the encounter list - integer(I4B) :: encid_dimid !! ID for the encounter pair index dimension + 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 diff --git a/src/modules/swiftest_classes.f90 b/src/modules/swiftest_classes.f90 index 5c75908fb..f3704a978 100644 --- a/src/modules/swiftest_classes.f90 +++ b/src/modules/swiftest_classes.f90 @@ -21,22 +21,23 @@ module swiftest_classes !! 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) :: ncid !! ID for the output file + 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 - integer(I4B) :: time_dimid !! ID for the time dimension - integer(I4B) :: id_dimid !! ID for the particle id dimension 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 ! Non-dimension ids and variable names @@ -1062,55 +1063,55 @@ 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_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_info_base diff --git a/src/netcdf/netcdf.f90 b/src/netcdf/netcdf.f90 index 42aa78882..a01482202 100644 --- a/src/netcdf/netcdf.f90 +++ b/src/netcdf/netcdf.f90 @@ -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 @@ -81,51 +81,51 @@ module function netcdf_get_old_t_final_system(self, param) result(old_t_final) 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, val, start=[1], count=[1]), "netcdf_get_old_t_final_system time_varid" ) !old_t_final = val(1) old_t_final = param%t0 ! For NetCDF it is safe to overwrite the final t value on a restart if (param%lenergy) then - call check( nf90_get_var(param%nciu%ncid, param%nciu%KE_orb_varid, val, start=[1], count=[1]), "netcdf_get_old_t_final_system KE_orb_varid" ) + call check( nf90_get_var(param%nciu%id, param%nciu%KE_orb_varid, val, start=[1], count=[1]), "netcdf_get_old_t_final_system KE_orb_varid" ) KE_orb_orig = val(1) - call check( nf90_get_var(param%nciu%ncid, param%nciu%KE_spin_varid, val, start=[1], count=[1]), "netcdf_get_old_t_final_system KE_spin_varid" ) + call check( nf90_get_var(param%nciu%id, param%nciu%KE_spin_varid, val, start=[1], count=[1]), "netcdf_get_old_t_final_system KE_spin_varid" ) KE_spin_orig = val(1) - call check( nf90_get_var(param%nciu%ncid, param%nciu%PE_varid, val, start=[1], count=[1]), "netcdf_get_old_t_final_system PE_varid" ) + call check( nf90_get_var(param%nciu%id, param%nciu%PE_varid, val, start=[1], count=[1]), "netcdf_get_old_t_final_system PE_varid" ) PE_orig = val(1) - call check( nf90_get_var(param%nciu%ncid, param%nciu%Ecollisions_varid, self%Ecollisions, start=[1]), "netcdf_get_old_t_final_system Ecollisions_varid" ) - call check( nf90_get_var(param%nciu%ncid, param%nciu%Euntracked_varid, self%Euntracked, start=[1]), "netcdf_get_old_t_final_system Euntracked_varid" ) + 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" ) + call check( nf90_get_var(param%nciu%id, 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" ) + call check( nf90_get_var(param%nciu%id, 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" ) + call check( nf90_get_var(param%nciu%id, 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" ) + call check( nf90_get_var(param%nciu%id, 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" ) + call check( nf90_get_var(param%nciu%id, 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" ) + call check( nf90_get_var(param%nciu%id, 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_escapex_varid, self%Lescape(1), start=[1]), "netcdf_get_old_t_final_system L_escapex_varid" ) + call check( nf90_get_var(param%nciu%id, 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%id, param%nciu%L_escapez_varid, self%Lescape(3), start=[1]), "netcdf_get_old_t_final_system L_escapez_varid" ) self%Ltot_orig(:) = self%Lorbit_orig(:) + self%Lspin_orig(:) + self%Lescape(:) - call check( nf90_get_var(param%nciu%ncid, param%nciu%Gmass_varid, vals, start=[1,1], count=[idmax,1]), "netcdf_get_old_t_final_system Gmass_varid" ) - call check( nf90_get_var(param%nciu%ncid, param%nciu%GMescape_varid, self%GMescape, start=[1]), "netcdf_get_old_t_final_system GMescape_varid" ) + 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,23 +133,23 @@ 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" ) + call check( nf90_get_var(param%nciu%id, param%nciu%radius_varid, val, start=[1,1], count=[1,1]), "netcdf_get_old_t_final_system radius_varid" ) cb%R0 = val(1) if (param%lrotation) then - call check( nf90_get_var(param%nciu%ncid, param%nciu%rotx_varid, val, start=[1,1], count=[1,1]), "netcdf_get_old_t_final_system rotx_varid" ) + call check( nf90_get_var(param%nciu%id, 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" ) + call check( nf90_get_var(param%nciu%id, 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" ) + call check( nf90_get_var(param%nciu%id, 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" ) + call check( nf90_get_var(param%nciu%id, 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" ) + call check( nf90_get_var(param%nciu%id, 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" ) + call check( nf90_get_var(param%nciu%id, param%nciu%Ip3_varid, val, start=[1,1], count=[1,1]), "netcdf_get_old_t_final_system Ip3_varid" ) Ip0(3) = val(1) cb%L0(:) = Ip0(3) * cb%GM0 * cb%R0**2 * rot0(:) @@ -175,7 +175,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 +184,163 @@ 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 - - call check( nf90_create(param%outfile, NF90_NETCDF4, self%ncid), "netcdf_initialize_output nf90_create" ) + dfill = ieee_value(dfill, IEEE_QUIET_NAN) + sfill = ieee_value(sfill, IEEE_QUIET_NAN) - ! Define the NetCDF dimensions with particle name as the record dimension - call check( nf90_def_dim(self%ncid, self%id_dimname, NF90_UNLIMITED, self%id_dimid), "netcdf_initialize_output nf90_def_dim id_dimid" ) ! 'x' dimension - call check( nf90_def_dim(self%ncid, self%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, self%time_dimname, NF90_UNLIMITED, self%time_dimid), "netcdf_initialize_output nf90_def_dim time_dimid" ) ! 'y' dimension + select case (param%out_type) + case("NETCDF_FLOAT") + nciu%out_type = NF90_FLOAT + case("NETCDF_DOUBLE") + nciu%out_type = NF90_DOUBLE + end select - select case (param%out_type) - case("NETCDF_FLOAT") - self%out_type = NF90_FLOAT - case("NETCDF_DOUBLE") - self%out_type = NF90_DOUBLE - end select + ! 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 - !! Define the variables - call check( nf90_def_var(self%ncid, self%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, self%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, self%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, self%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, self%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, self%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, self%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, self%status_varname, NF90_CHAR, [self%str_dimid, self%id_dimid], self%status_varid), "netcdf_initialize_output nf90_def_var status_varid" ) + ! 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%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%space_dimname, 3, nciu%space_dimid), "netcdf_initialize_output nf90_def_dim space_dimid" ) ! 3D space dimension + 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%id_dimname, NF90_INT, nciu%id_dimid, nciu%id_varid), "netcdf_initialize_output nf90_def_var id_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" ) + + ! 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%xhx_varname, nciu%out_type, [nciu%id_dimid, nciu%time_dimid], nciu%xhx_varid), "netcdf_initialize_output nf90_def_var xhx_varid" ) + call check( nf90_def_var(nciu%id, nciu%xhy_varname, nciu%out_type, [nciu%id_dimid, nciu%time_dimid], nciu%xhy_varid), "netcdf_initialize_output nf90_def_var xhy_varid" ) + call check( nf90_def_var(nciu%id, nciu%xhz_varname, nciu%out_type, [nciu%id_dimid, nciu%time_dimid], nciu%xhz_varid), "netcdf_initialize_output nf90_def_var xhz_varid" ) + call check( nf90_def_var(nciu%id, nciu%vhx_varname, nciu%out_type, [nciu%id_dimid, nciu%time_dimid], nciu%vhx_varid), "netcdf_initialize_output nf90_def_var vhx_varid" ) + call check( nf90_def_var(nciu%id, nciu%vhy_varname, nciu%out_type, [nciu%id_dimid, nciu%time_dimid], nciu%vhy_varid), "netcdf_initialize_output nf90_def_var vhy_varid" ) + call check( nf90_def_var(nciu%id, nciu%vhz_varname, nciu%out_type, [nciu%id_dimid, nciu%time_dimid], nciu%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(nciu%id, nciu%gr_pseudo_vhx_varname, nciu%out_type, [nciu%id_dimid, nciu%time_dimid], nciu%gr_pseudo_vhx_varid), "netcdf_initialize_output nf90_def_var gr_psuedo_vhx_varid" ) + call check( nf90_def_var(nciu%id, nciu%gr_pseudo_vhy_varname, nciu%out_type, [nciu%id_dimid, nciu%time_dimid], nciu%gr_pseudo_vhy_varid), "netcdf_initialize_output nf90_def_var gr_psuedo_vhy_varid" ) + call check( nf90_def_var(nciu%id, nciu%gr_pseudo_vhz_varname, nciu%out_type, [nciu%id_dimid, nciu%time_dimid], nciu%gr_pseudo_vhz_varid), "netcdf_initialize_output nf90_def_var gr_psuedo_vhz_varid" ) + nciu%lpseudo_vel_exists = .true. + end if - if ((param%out_form == "XV") .or. (param%out_form == "XVEL")) then - call check( nf90_def_var(self%ncid, self%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, self%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, self%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, self%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, self%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, self%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, self%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, self%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, self%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" ) end if - end if - - if ((param%out_form == "EL") .or. (param%out_form == "XVEL")) then - call check( nf90_def_var(self%ncid, self%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, self%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, self%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, self%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, self%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, self%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, self%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, self%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_xhx_varname, nciu%out_type, nciu%id_dimid, nciu%origin_xhx_varid), "netcdf_initialize_output nf90_def_var origin_xhx_varid" ) + call check( nf90_def_var(nciu%id, nciu%origin_xhy_varname, nciu%out_type, nciu%id_dimid, nciu%origin_xhy_varid), "netcdf_initialize_output nf90_def_var origin_xhy_varid" ) + call check( nf90_def_var(nciu%id, nciu%origin_xhz_varname, nciu%out_type, nciu%id_dimid, nciu%origin_xhz_varid), "netcdf_initialize_output nf90_def_var origin_xhz_varid" ) + call check( nf90_def_var(nciu%id, nciu%origin_vhx_varname, nciu%out_type, nciu%id_dimid, nciu%origin_vhx_varid), "netcdf_initialize_output nf90_def_var origin_vhx_varid" ) + call check( nf90_def_var(nciu%id, nciu%origin_vhy_varname, nciu%out_type, nciu%id_dimid, nciu%origin_vhy_varid), "netcdf_initialize_output nf90_def_var origin_vhy_varid" ) + call check( nf90_def_var(nciu%id, nciu%origin_vhz_varname, nciu%out_type, nciu%id_dimid, nciu%origin_vhz_varid), "netcdf_initialize_output nf90_def_var origin_vhz_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_xhx_varname, nciu%out_type, nciu%id_dimid, nciu%discard_xhx_varid), "netcdf_initialize_output nf90_def_var discard_xhx_varid" ) + call check( nf90_def_var(nciu%id, nciu%discard_xhy_varname, nciu%out_type, nciu%id_dimid, nciu%discard_xhy_varid), "netcdf_initialize_output nf90_def_var discard_xhy_varid" ) + call check( nf90_def_var(nciu%id, nciu%discard_xhz_varname, nciu%out_type, nciu%id_dimid, nciu%discard_xhz_varid), "netcdf_initialize_output nf90_def_var discard_xhz_varid" ) + call check( nf90_def_var(nciu%id, nciu%discard_vhx_varname, nciu%out_type, nciu%id_dimid, nciu%discard_vhx_varid), "netcdf_initialize_output nf90_def_var discard_vhx_varid" ) + call check( nf90_def_var(nciu%id, nciu%discard_vhy_varname, nciu%out_type, nciu%id_dimid, nciu%discard_vhy_varid), "netcdf_initialize_output nf90_def_var discard_vhy_varid" ) + call check( nf90_def_var(nciu%id, nciu%discard_vhz_varname, nciu%out_type, nciu%id_dimid, nciu%discard_vhz_varid), "netcdf_initialize_output nf90_def_var discard_vhz_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, self%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, self%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, self%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, self%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, self%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, self%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, self%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, self%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, self%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, self%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, self%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, self%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, self%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, self%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, self%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, self%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, self%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, self%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%ip1_varname, nciu%out_type, [nciu%id_dimid, nciu%time_dimid], nciu%Ip1_varid), "netcdf_initialize_output nf90_def_var Ip1_varid" ) + call check( nf90_def_var(nciu%id, nciu%ip2_varname, nciu%out_type, [nciu%id_dimid, nciu%time_dimid], nciu%Ip2_varid), "netcdf_initialize_output nf90_def_var Ip2_varid" ) + call check( nf90_def_var(nciu%id, nciu%ip3_varname, nciu%out_type, [nciu%id_dimid, nciu%time_dimid], nciu%Ip3_varid), "netcdf_initialize_output nf90_def_var Ip3_varid" ) + call check( nf90_def_var(nciu%id, nciu%rotx_varname, nciu%out_type, [nciu%id_dimid, nciu%time_dimid], nciu%rotx_varid), "netcdf_initialize_output nf90_def_var rotx_varid" ) + call check( nf90_def_var(nciu%id, nciu%roty_varname, nciu%out_type, [nciu%id_dimid, nciu%time_dimid], nciu%roty_varid), "netcdf_initialize_output nf90_def_var roty_varid" ) + call check( nf90_def_var(nciu%id, nciu%rotz_varname, nciu%out_type, [nciu%id_dimid, nciu%time_dimid], nciu%rotz_varid), "netcdf_initialize_output nf90_def_var rotz_varid" ) + end if - if (param%lrotation) then - call check( nf90_def_var(self%ncid, self%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, self%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, self%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, self%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, self%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, self%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, self%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, self%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_orbx_varname, nciu%out_type, nciu%time_dimid, nciu%L_orbx_varid), "netcdf_initialize_output nf90_def_var L_orbx_varid" ) + call check( nf90_def_var(nciu%id, nciu%l_orby_varname, nciu%out_type, nciu%time_dimid, nciu%L_orby_varid), "netcdf_initialize_output nf90_def_var L_orby_varid" ) + call check( nf90_def_var(nciu%id, nciu%l_orbz_varname, nciu%out_type, nciu%time_dimid, nciu%L_orbz_varid), "netcdf_initialize_output nf90_def_var L_orbz_varid" ) + call check( nf90_def_var(nciu%id, nciu%l_spinx_varname, nciu%out_type, nciu%time_dimid, nciu%L_spinx_varid), "netcdf_initialize_output nf90_def_var L_spinx_varid" ) + call check( nf90_def_var(nciu%id, nciu%l_spiny_varname, nciu%out_type, nciu%time_dimid, nciu%L_spiny_varid), "netcdf_initialize_output nf90_def_var L_spiny_varid" ) + call check( nf90_def_var(nciu%id, nciu%l_spinz_varname, nciu%out_type, nciu%time_dimid, nciu%L_spinz_varid), "netcdf_initialize_output nf90_def_var L_spinz_varid" ) + call check( nf90_def_var(nciu%id, nciu%l_escapex_varname, nciu%out_type, nciu%time_dimid, nciu%L_escapex_varid), "netcdf_initialize_output nf90_def_var L_escapex_varid" ) + call check( nf90_def_var(nciu%id, nciu%l_escapey_varname, nciu%out_type, nciu%time_dimid, nciu%L_escapey_varid), "netcdf_initialize_output nf90_def_var L_escapey_varid" ) + call check( nf90_def_var(nciu%id, nciu%l_escapez_varname, nciu%out_type, nciu%time_dimid, nciu%L_escapez_varid), "netcdf_initialize_output nf90_def_var L_escapez_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, self%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, self%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, self%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, self%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, self%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, self%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, self%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, self%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, self%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, self%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, self%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, self%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, self%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, self%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, self%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, self%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, self%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, ["x","y","z"], start=[1], count=[3]), "netcdf_initialize_output nf90_put_var space" ) + end associate return 667 continue @@ -350,7 +360,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 @@ -359,45 +368,41 @@ module subroutine netcdf_open(self, param, readonly) end if write(errmsg,*) "netcdf_open nf90_open ",trim(adjustl(param%outfile)) - call check( nf90_open(param%outfile, mode, self%ncid), errmsg) - - call check( nf90_inq_dimid(self%ncid, self%time_dimname, self%time_dimid), "netcdf_open nf90_inq_dimid time_dimid" ) - call check( nf90_inq_dimid(self%ncid, self%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" ) + call check( nf90_open(param%outfile, mode, self%id), errmsg) - ! Required Variables + ! Dimensions + call check( nf90_inq_dimid(self%id, self%time_dimname, self%time_dimid), "netcdf_open nf90_inq_dimid time_dimid" ) + call check( nf90_inq_dimid(self%id, self%id_dimname, self%id_dimid), "netcdf_open nf90_inq_dimid id_dimid" ) + call check( nf90_inq_dimid(self%id, self%space_dimname, self%space_dimid), "netcdf_open nf90_inq_dimid space_dimid" ) + call check( nf90_inq_dimid(self%id, self%str_dimname, self%str_dimid), "netcdf_open nf90_inq_dimid str_dimid" ) - call check( nf90_inq_varid(self%ncid, self%time_dimname, self%time_varid), "netcdf_open nf90_inq_varid time_varid" ) - call check( nf90_inq_varid(self%ncid, self%id_dimname, self%id_varid), "netcdf_open nf90_inq_varid id_varid" ) - call check( nf90_inq_varid(self%ncid, self%name_varname, self%name_varid), "netcdf_open nf90_inq_varid name_varid" ) - call check( nf90_inq_varid(self%ncid, self%ptype_varname, self%ptype_varid), "netcdf_open nf90_inq_varid ptype_varid" ) - call check( nf90_inq_varid(self%ncid, self%gmass_varname, self%Gmass_varid), "netcdf_open nf90_inq_varid Gmass_varid" ) + ! Dimension coordinates + call check( nf90_inq_varid(self%id, self%time_dimname, self%time_varid), "netcdf_open nf90_inq_varid time_varid" ) + call check( nf90_inq_varid(self%id, self%id_dimname, self%id_varid), "netcdf_open nf90_inq_varid id_varid" ) + call check( nf90_inq_varid(self%id, self%space_dimname, self%space_varid), "netcdf_open nf90_inq_varid space_varid" ) + + ! Required Variables + call check( nf90_inq_varid(self%id, self%name_varname, self%name_varid), "netcdf_open nf90_inq_varid name_varid" ) + call check( nf90_inq_varid(self%id, self%ptype_varname, self%ptype_varid), "netcdf_open nf90_inq_varid ptype_varid" ) + call check( nf90_inq_varid(self%id, self%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, self%xhx_varname, self%xhx_varid), "netcdf_open nf90_inq_varid xhx_varid" ) - call check( nf90_inq_varid(self%ncid, self%xhy_varname, self%xhy_varid), "netcdf_open nf90_inq_varid xhy_varid" ) - call check( nf90_inq_varid(self%ncid, self%xhz_varname, self%xhz_varid), "netcdf_open nf90_inq_varid xhz_varid" ) - call check( nf90_inq_varid(self%ncid, self%vhx_varname, self%vhx_varid), "netcdf_open nf90_inq_varid vhx_varid" ) - call check( nf90_inq_varid(self%ncid, self%vhy_varname, self%vhy_varid), "netcdf_open nf90_inq_varid vhy_varid" ) - call check( nf90_inq_varid(self%ncid, self%vhz_varname, self%vhz_varid), "netcdf_open nf90_inq_varid vhz_varid" ) + call check( nf90_inq_varid(self%id, self%xhx_varname, self%xhx_varid), "netcdf_open nf90_inq_varid xhx_varid" ) + call check( nf90_inq_varid(self%id, self%xhy_varname, self%xhy_varid), "netcdf_open nf90_inq_varid xhy_varid" ) + call check( nf90_inq_varid(self%id, self%xhz_varname, self%xhz_varid), "netcdf_open nf90_inq_varid xhz_varid" ) + call check( nf90_inq_varid(self%id, self%vhx_varname, self%vhx_varid), "netcdf_open nf90_inq_varid vhx_varid" ) + call check( nf90_inq_varid(self%id, self%vhy_varname, self%vhy_varid), "netcdf_open nf90_inq_varid vhy_varid" ) + call check( nf90_inq_varid(self%id, self%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, self%gr_pseudo_vhx_varname, self%gr_pseudo_vhx_varid) + status = nf90_inq_varid(self%id, self%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, self%gr_pseudo_vhy_varname, self%gr_pseudo_vhy_varid) + status = nf90_inq_varid(self%id, self%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, self%gr_pseudo_vhz_varname, self%gr_pseudo_vhz_varid) + status = nf90_inq_varid(self%id, self%gr_pseudo_vhz_varname, self%gr_pseudo_vhz_varid) self%lpseudo_vel_exists = (status == nf90_noerr) end if end if @@ -409,99 +414,99 @@ module subroutine netcdf_open(self, param, readonly) end if if ((param%out_form == "EL") .or. (param%out_form == "XVEL")) then - call check( nf90_inq_varid(self%ncid, self%a_varname, self%a_varid), "netcdf_open nf90_inq_varid a_varid" ) - call check( nf90_inq_varid(self%ncid, self%e_varname, self%e_varid), "netcdf_open nf90_inq_varid e_varid" ) - call check( nf90_inq_varid(self%ncid, self%inc_varname, self%inc_varid), "netcdf_open nf90_inq_varid inc_varid" ) - call check( nf90_inq_varid(self%ncid, self%capom_varname, self%capom_varid), "netcdf_open nf90_inq_varid capom_varid" ) - call check( nf90_inq_varid(self%ncid, self%omega_varname, self%omega_varid), "netcdf_open nf90_inq_varid omega_varid" ) - call check( nf90_inq_varid(self%ncid, self%capm_varname, self%capm_varid), "netcdf_open nf90_inq_varid capm_varid" ) + call check( nf90_inq_varid(self%id, self%a_varname, self%a_varid), "netcdf_open nf90_inq_varid a_varid" ) + call check( nf90_inq_varid(self%id, self%e_varname, self%e_varid), "netcdf_open nf90_inq_varid e_varid" ) + call check( nf90_inq_varid(self%id, self%inc_varname, self%inc_varid), "netcdf_open nf90_inq_varid inc_varid" ) + call check( nf90_inq_varid(self%id, self%capom_varname, self%capom_varid), "netcdf_open nf90_inq_varid capom_varid" ) + call check( nf90_inq_varid(self%id, self%omega_varname, self%omega_varid), "netcdf_open nf90_inq_varid omega_varid" ) + call check( nf90_inq_varid(self%id, self%capm_varname, self%capm_varid), "netcdf_open nf90_inq_varid capm_varid" ) end if if (param%lclose) then - call check( nf90_inq_varid(self%ncid, self%radius_varname, self%radius_varid), "netcdf_open nf90_inq_varid radius_varid" ) + call check( nf90_inq_varid(self%id, self%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, self%ip1_varname, self%Ip1_varid), "netcdf_open nf90_inq_varid Ip1_varid" ) - call check( nf90_inq_varid(self%ncid, self%ip2_varname, self%Ip2_varid), "netcdf_open nf90_inq_varid Ip2_varid" ) - call check( nf90_inq_varid(self%ncid, self%ip3_varname, self%Ip3_varid), "netcdf_open nf90_inq_varid Ip3_varid" ) - call check( nf90_inq_varid(self%ncid, self%rotx_varname, self%rotx_varid), "netcdf_open nf90_inq_varid rotx_varid" ) - call check( nf90_inq_varid(self%ncid, self%roty_varname, self%roty_varid), "netcdf_open nf90_inq_varid roty_varid" ) - call check( nf90_inq_varid(self%ncid, self%rotz_varname, self%rotz_varid), "netcdf_open nf90_inq_varid rotz_varid" ) + call check( nf90_inq_varid(self%id, self%ip1_varname, self%Ip1_varid), "netcdf_open nf90_inq_varid Ip1_varid" ) + call check( nf90_inq_varid(self%id, self%ip2_varname, self%Ip2_varid), "netcdf_open nf90_inq_varid Ip2_varid" ) + call check( nf90_inq_varid(self%id, self%ip3_varname, self%Ip3_varid), "netcdf_open nf90_inq_varid Ip3_varid" ) + call check( nf90_inq_varid(self%id, self%rotx_varname, self%rotx_varid), "netcdf_open nf90_inq_varid rotx_varid" ) + call check( nf90_inq_varid(self%id, self%roty_varname, self%roty_varid), "netcdf_open nf90_inq_varid roty_varid" ) + call check( nf90_inq_varid(self%id, self%rotz_varname, self%rotz_varid), "netcdf_open nf90_inq_varid rotz_varid" ) end if ! if (param%ltides) then - ! call check( nf90_inq_varid(self%ncid, self%k2_varname, self%k2_varid), "netcdf_open nf90_inq_varid k2_varid" ) - ! call check( nf90_inq_varid(self%ncid, self%q_varname, self%Q_varid), "netcdf_open nf90_inq_varid Q_varid" ) + ! call check( nf90_inq_varid(self%id, self%k2_varname, self%k2_varid), "netcdf_open nf90_inq_varid k2_varid" ) + ! call check( nf90_inq_varid(self%id, self%q_varname, self%Q_varid), "netcdf_open nf90_inq_varid Q_varid" ) ! end if ! Optional Variables if (param%lrhill_present) then - status = nf90_inq_varid(self%ncid, self%rhill_varname, self%rhill_varid) + status = nf90_inq_varid(self%id, self%rhill_varname, self%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, self%npl_varname, self%npl_varid) - status = nf90_inq_varid(self%ncid, self%ntp_varname, self%ntp_varid) - status = nf90_inq_varid(self%ncid, self%status_varname, self%status_varid) - status = nf90_inq_varid(self%ncid, self%j2rp2_varname, self%j2rp2_varid) - status = nf90_inq_varid(self%ncid, self%j4rp4_varname, self%j4rp4_varid) + status = nf90_inq_varid(self%id, self%npl_varname, self%npl_varid) + status = nf90_inq_varid(self%id, self%ntp_varname, self%ntp_varid) + status = nf90_inq_varid(self%id, self%status_varname, self%status_varid) + status = nf90_inq_varid(self%id, self%j2rp2_varname, self%j2rp2_varid) + status = nf90_inq_varid(self%id, self%j4rp4_varname, self%j4rp4_varid) if (param%integrator == SYMBA) then - status = nf90_inq_varid(self%ncid, self%nplm_varname, self%nplm_varid) + status = nf90_inq_varid(self%id, self%nplm_varname, self%nplm_varid) end if if (param%lclose) then - status = nf90_inq_varid(self%ncid, self%origin_type_varname, self%origin_type_varid) - status = nf90_inq_varid(self%ncid, self%origin_time_varname, self%origin_time_varid) - status = nf90_inq_varid(self%ncid, self%origin_xhx_varname, self%origin_xhx_varid) - status = nf90_inq_varid(self%ncid, self%origin_xhy_varname, self%origin_xhy_varid) - status = nf90_inq_varid(self%ncid, self%origin_xhz_varname, self%origin_xhz_varid) - status = nf90_inq_varid(self%ncid, self%origin_vhx_varname, self%origin_vhx_varid) - status = nf90_inq_varid(self%ncid, self%origin_vhy_varname, self%origin_vhy_varid) - status = nf90_inq_varid(self%ncid, self%origin_vhz_varname, self%origin_vhz_varid) - status = nf90_inq_varid(self%ncid, self%collision_id_varname, self%collision_id_varid) - status = nf90_inq_varid(self%ncid, self%discard_time_varname, self%discard_time_varid) - status = nf90_inq_varid(self%ncid, self%discard_xhx_varname, self%discard_xhx_varid) - status = nf90_inq_varid(self%ncid, self%discard_xhy_varname, self%discard_xhy_varid) - status = nf90_inq_varid(self%ncid, self%discard_xhz_varname, self%discard_xhz_varid) - status = nf90_inq_varid(self%ncid, self%discard_vhx_varname, self%discard_vhx_varid) - status = nf90_inq_varid(self%ncid, self%discard_vhy_varname, self%discard_vhy_varid) - status = nf90_inq_varid(self%ncid, self%discard_vhz_varname, self%discard_vhz_varid) - status = nf90_inq_varid(self%ncid, self%discard_body_id_varname, self%discard_body_id_varid) + status = nf90_inq_varid(self%id, self%origin_type_varname, self%origin_type_varid) + status = nf90_inq_varid(self%id, self%origin_time_varname, self%origin_time_varid) + status = nf90_inq_varid(self%id, self%origin_xhx_varname, self%origin_xhx_varid) + status = nf90_inq_varid(self%id, self%origin_xhy_varname, self%origin_xhy_varid) + status = nf90_inq_varid(self%id, self%origin_xhz_varname, self%origin_xhz_varid) + status = nf90_inq_varid(self%id, self%origin_vhx_varname, self%origin_vhx_varid) + status = nf90_inq_varid(self%id, self%origin_vhy_varname, self%origin_vhy_varid) + status = nf90_inq_varid(self%id, self%origin_vhz_varname, self%origin_vhz_varid) + status = nf90_inq_varid(self%id, self%collision_id_varname, self%collision_id_varid) + status = nf90_inq_varid(self%id, self%discard_time_varname, self%discard_time_varid) + status = nf90_inq_varid(self%id, self%discard_xhx_varname, self%discard_xhx_varid) + status = nf90_inq_varid(self%id, self%discard_xhy_varname, self%discard_xhy_varid) + status = nf90_inq_varid(self%id, self%discard_xhz_varname, self%discard_xhz_varid) + status = nf90_inq_varid(self%id, self%discard_vhx_varname, self%discard_vhx_varid) + status = nf90_inq_varid(self%id, self%discard_vhy_varname, self%discard_vhy_varid) + status = nf90_inq_varid(self%id, self%discard_vhz_varname, self%discard_vhz_varid) + status = nf90_inq_varid(self%id, self%discard_body_id_varname, self%discard_body_id_varid) end if if (param%lenergy) then - status = nf90_inq_varid(self%ncid, self%ke_orb_varname, self%KE_orb_varid) - status = nf90_inq_varid(self%ncid, self%ke_spin_varname, self%KE_spin_varid) - status = nf90_inq_varid(self%ncid, self%pe_varname, self%PE_varid) - status = nf90_inq_varid(self%ncid, self%l_orbx_varname, self%L_orbx_varid) - status = nf90_inq_varid(self%ncid, self%l_orby_varname, self%L_orby_varid) - status = nf90_inq_varid(self%ncid, self%l_orbz_varname, self%L_orbz_varid) - status = nf90_inq_varid(self%ncid, self%l_spinx_varname, self%L_spinx_varid) - status = nf90_inq_varid(self%ncid, self%l_spiny_varname, self%L_spiny_varid) - status = nf90_inq_varid(self%ncid, self%l_spinz_varname, self%L_spinz_varid) - status = nf90_inq_varid(self%ncid, self%l_escapex_varname, self%L_escapex_varid) - status = nf90_inq_varid(self%ncid, self%l_escapey_varname, self%L_escapey_varid) - status = nf90_inq_varid(self%ncid, self%l_escapez_varname, self%L_escapez_varid) - status = nf90_inq_varid(self%ncid, self%ecollisions_varname, self%Ecollisions_varid) - status = nf90_inq_varid(self%ncid, self%euntracked_varname, self%Euntracked_varid) - status = nf90_inq_varid(self%ncid, self%gmescape_varname, self%GMescape_varid) + status = nf90_inq_varid(self%id, self%ke_orb_varname, self%KE_orb_varid) + status = nf90_inq_varid(self%id, self%ke_spin_varname, self%KE_spin_varid) + status = nf90_inq_varid(self%id, self%pe_varname, self%PE_varid) + status = nf90_inq_varid(self%id, self%l_orbx_varname, self%L_orbx_varid) + status = nf90_inq_varid(self%id, self%l_orby_varname, self%L_orby_varid) + status = nf90_inq_varid(self%id, self%l_orbz_varname, self%L_orbz_varid) + status = nf90_inq_varid(self%id, self%l_spinx_varname, self%L_spinx_varid) + status = nf90_inq_varid(self%id, self%l_spiny_varname, self%L_spiny_varid) + status = nf90_inq_varid(self%id, self%l_spinz_varname, self%L_spinz_varid) + status = nf90_inq_varid(self%id, self%l_escapex_varname, self%L_escapex_varid) + status = nf90_inq_varid(self%id, self%l_escapey_varname, self%L_escapey_varid) + status = nf90_inq_varid(self%id, self%l_escapez_varname, self%L_escapez_varid) + status = nf90_inq_varid(self%id, self%ecollisions_varname, self%Ecollisions_varid) + status = nf90_inq_varid(self%id, self%euntracked_varname, self%Euntracked_varid) + status = nf90_inq_varid(self%id, self%gmescape_varname, self%GMescape_varid) end if 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 @@ -511,8 +516,8 @@ module function netcdf_read_frame_system(self, iu, param) result(ierr) 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) @@ -521,26 +526,26 @@ module function netcdf_read_frame_system(self, iu, param) result(ierr) 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(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%xhx_varid, rtemp(:), start=[1, tslot]), "netcdf_read_frame_system filter pass nf90_getvar xhx_varid" ) else - call check( nf90_get_var(iu%ncid, iu%a_varid, rtemp(:), start=[1, tslot]), "netcdf_read_frame_system filter pass nf90_getvar a_varid" ) + call check( nf90_get_var(nciu%id, nciu%a_varid, rtemp(:), start=[1, tslot]), "netcdf_read_frame_system filter pass nf90_getvar a_varid" ) end if validmask(:) = rtemp(:) == rtemp(:) ! Next, filter only bodies that don't have mass (test particles) - call check( nf90_get_var(iu%ncid, iu%Gmass_varid, rtemp(:), start=[1, tslot]), "netcdf_read_frame_system nf90_getvar Gmass_varid" ) + call check( nf90_get_var(nciu%id, nciu%Gmass_varid, rtemp(:), start=[1, tslot]), "netcdf_read_frame_system nf90_getvar Gmass_varid" ) plmask(:) = rtemp(:) == rtemp(:) .and. validmask(:) tpmask(:) = .not. plmask(:) .and. validmask(:) plmask(1) = .false. ! This is the central body @@ -573,80 +578,80 @@ 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" ) + call check( nf90_get_var(nciu%id, nciu%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" ) + call check( nf90_get_var(nciu%id, nciu%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" ) + call check( nf90_get_var(nciu%id, nciu%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 (param%lgr .and. nciu%lpseudo_vel_exists) then + call check( nf90_get_var(nciu%id, nciu%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" ) + call check( nf90_get_var(nciu%id, nciu%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" ) + call check( nf90_get_var(nciu%id, nciu%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" ) + call check( nf90_get_var(nciu%id, nciu%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" ) + call check( nf90_get_var(nciu%id, nciu%vhy_varid, rtemp, start=[1, tslot]), "netcdf_read_frame_system nf90_getvar vhy_varid" ) if (npl > 0) pl%vh(2,:) = pack(rtemp, plmask) if (ntp > 0) tp%vh(2,:) = pack(rtemp, tpmask) - call check( nf90_get_var(iu%ncid, iu%vhz_varid, rtemp, start=[1, tslot]), "netcdf_read_frame_system nf90_getvar vhz_varid" ) + call check( nf90_get_var(nciu%id, nciu%vhz_varid, rtemp, start=[1, tslot]), "netcdf_read_frame_system nf90_getvar vhz_varid" ) if (npl > 0) pl%vh(3,:) = pack(rtemp, plmask) if (ntp > 0) tp%vh(3,:) = pack(rtemp, tpmask) end if end if if ((param%in_form == "EL") .or. (param%in_form == "XVEL")) then - call check( nf90_get_var(iu%ncid, iu%a_varid, rtemp, start=[1, tslot]), "netcdf_read_frame_system nf90_getvar a_varid" ) + call check( nf90_get_var(nciu%id, nciu%a_varid, rtemp, start=[1, tslot]), "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]), "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]), "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]), "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]), "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]), "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 +660,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]), "netcdf_read_frame_system nf90_getvar Gmass_varid" ) cb%Gmass = rtemp(1) cb%mass = cb%Gmass / param%GU @@ -671,13 +676,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]), "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]), "netcdf_read_frame_system nf90_getvar radius_varid" ) cb%radius = rtemp(1) ! Set initial central body radius for SyMBA bookkeeping @@ -692,27 +697,27 @@ 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" ) + call check( nf90_get_var(nciu%id, nciu%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" ) + call check( nf90_get_var(nciu%id, nciu%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" ) + call check( nf90_get_var(nciu%id, nciu%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" ) + call check( nf90_get_var(nciu%id, nciu%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" ) + call check( nf90_get_var(nciu%id, nciu%roty_varid, rtemp, start=[1, tslot]), "netcdf_read_frame_system nf90_getvar roty_varid" ) cb%rot(2) = rtemp(1) if (npl > 0) pl%rot(2,:) = pack(rtemp, plmask) - call check( nf90_get_var(iu%ncid, iu%rotz_varid, rtemp, start=[1, tslot]), "netcdf_read_frame_system nf90_getvar rotz_varid" ) + call check( nf90_get_var(nciu%id, nciu%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) @@ -724,37 +729,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, iu%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, iu%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 +768,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 +779,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 +788,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 @@ -792,15 +797,15 @@ module subroutine netcdf_read_hdr_system(self, iu, param) 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_get_var(iu%ncid, iu%time_varid, self%t, start=[tslot]), "netcdf_read_hdr_system nf90_getvar time_varid" ) + call check( nf90_inquire_dimension(nciu%id, nciu%id_dimid, len=idmax), "netcdf_read_frame_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]), "netcdf_read_frame_system nf90_getvar Gmass_varid" ) plmask(:) = gmtemp(:) == gmtemp(:) tpmask(:) = .not. plmask(:) @@ -813,26 +818,26 @@ module subroutine netcdf_read_hdr_system(self, iu, param) endwhere end select - status = nf90_inq_varid(iu%ncid, iu%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, iu%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, iu%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,50 +845,50 @@ module subroutine netcdf_read_hdr_system(self, iu, param) end if if (param%lenergy) then - status = nf90_inq_varid(iu%ncid, iu%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, iu%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, iu%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, iu%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, iu%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, iu%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, iu%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, iu%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, iu%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, iu%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, iu%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, iu%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, iu%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, iu%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, iu%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_orbx_varname, nciu%L_orbx_varid) + if (status == nf90_noerr) call check( nf90_get_var(nciu%id, nciu%L_orbx_varid, self%Lorbit(1), start=[tslot]), "netcdf_read_hdr_system nf90_getvar L_orbx_varid" ) + status = nf90_inq_varid(nciu%id, nciu%l_orby_varname, nciu%L_orby_varid) + if (status == nf90_noerr) call check( nf90_get_var(nciu%id, nciu%L_orby_varid, self%Lorbit(2), start=[tslot]), "netcdf_read_hdr_system nf90_getvar L_orby_varid" ) + status = nf90_inq_varid(nciu%id, nciu%l_orbz_varname, nciu%L_orbz_varid) + if (status == nf90_noerr) call check( nf90_get_var(nciu%id, nciu%L_orbz_varid, self%Lorbit(3), start=[tslot]), "netcdf_read_hdr_system nf90_getvar L_orbz_varid" ) + status = nf90_inq_varid(nciu%id, nciu%l_spinx_varname, nciu%L_spinx_varid) + if (status == nf90_noerr) call check( nf90_get_var(nciu%id, nciu%L_spinx_varid, self%Lspin(1), start=[tslot]), "netcdf_read_hdr_system nf90_getvar L_spinx_varid" ) + status = nf90_inq_varid(nciu%id, nciu%l_spiny_varname, nciu%L_spiny_varid) + if (status == nf90_noerr) call check( nf90_get_var(nciu%id, nciu%L_spiny_varid, self%Lspin(2), start=[tslot]), "netcdf_read_hdr_system nf90_getvar L_spiny_varid" ) + status = nf90_inq_varid(nciu%id, nciu%l_spinz_varname, nciu%L_spinz_varid) + if (status == nf90_noerr) call check( nf90_get_var(nciu%id, nciu%L_spinz_varid, self%Lspin(3), start=[tslot]), "netcdf_read_hdr_system nf90_getvar L_spinz_varid" ) + status = nf90_inq_varid(nciu%id, nciu%l_escapex_varname, nciu%L_escapex_varid) + if (status == nf90_noerr) call check( nf90_get_var(nciu%id, nciu%L_escapex_varid, self%Lescape(1), start=[tslot]), "netcdf_read_hdr_system nf90_getvar L_escapex_varid" ) + status = nf90_inq_varid(nciu%id, nciu%l_escapey_varname, nciu%L_escapey_varid) + if (status == nf90_noerr) call check( nf90_get_var(nciu%id, nciu%L_escapey_varid, self%Lescape(2), start=[tslot]), "netcdf_read_hdr_system nf90_getvar L_escapey_varid" ) + status = nf90_inq_varid(nciu%id, nciu%l_escapez_varname, nciu%L_escapez_varid) + if (status == nf90_noerr) call check( nf90_get_var(nciu%id, nciu%L_escapez_varid, self%Lescape(3), start=[tslot]), "netcdf_read_hdr_system nf90_getvar L_escapez_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 @@ -923,12 +928,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,7 +942,7 @@ 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 check( nf90_get_var(nciu%id, nciu%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))) @@ -946,9 +951,9 @@ module subroutine netcdf_read_particle_info_system(self, iu, param, plmask, tpma call tp%info(i)%set_value(particle_type=ctemp(tpind(i))) end do - status = nf90_inq_varid(iu%ncid, iu%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 +967,9 @@ module subroutine netcdf_read_particle_info_system(self, iu, param, plmask, tpma if (param%lclose) then - status = nf90_inq_varid(iu%ncid, iu%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 +982,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, iu%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,29 +997,29 @@ 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, iu%origin_xhx_varname, iu%origin_xhx_varid) + status = nf90_inq_varid(nciu%id, nciu%origin_xhx_varname, nciu%origin_xhx_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_xhx_varid, rtemp_arr(1,:)), "netcdf_read_particle_info_system nf90_getvar origin_xhx_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%xhx_varid, rtemp_arr(1,:)), "netcdf_read_particle_info_system nf90_getvar xhx_varid" ) else rtemp_arr(1,:) = 0._DP end if - status = nf90_inq_varid(iu%ncid, iu%origin_xhy_varname, iu%origin_xhy_varid) + status = nf90_inq_varid(nciu%id, nciu%origin_xhy_varname, nciu%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" ) + call check( nf90_get_var(nciu%id, nciu%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" ) + call check( nf90_get_var(nciu%id, nciu%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, iu%origin_xhz_varname, iu%origin_xhz_varid) + status = nf90_inq_varid(nciu%id, nciu%origin_xhz_varname, nciu%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" ) + call check( nf90_get_var(nciu%id, nciu%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" ) + call check( nf90_get_var(nciu%id, nciu%xhz_varid, rtemp_arr(3,:)), "netcdf_read_particle_info_system nf90_getvar xhz_varid" ) else rtemp_arr(3,:) = 0._DP end if @@ -1026,29 +1031,29 @@ module subroutine netcdf_read_particle_info_system(self, iu, param, plmask, tpma call tp%info(i)%set_value(origin_xh=rtemp_arr(:,tpind(i))) end do - status = nf90_inq_varid(iu%ncid, iu%origin_vhx_varname, iu%origin_vhx_varid) + status = nf90_inq_varid(nciu%id, nciu%origin_vhx_varname, nciu%origin_vhx_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_vhx_varid, rtemp_arr(1,:)), "netcdf_read_particle_info_system nf90_getvar origin_vhx_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%vhx_varid, rtemp_arr(1,:)), "netcdf_read_particle_info_system nf90_getvar vhx_varid" ) else rtemp_arr(1,:) = 0._DP end if - status = nf90_inq_varid(iu%ncid, iu%origin_vhy_varname, iu%origin_vhy_varid) + status = nf90_inq_varid(nciu%id, nciu%origin_vhy_varname, nciu%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" ) + call check( nf90_get_var(nciu%id, nciu%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" ) + call check( nf90_get_var(nciu%id, nciu%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, iu%origin_vhz_varname, iu%origin_vhz_varid) + status = nf90_inq_varid(nciu%id, nciu%origin_vhz_varname, nciu%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" ) + call check( nf90_get_var(nciu%id, nciu%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" ) + call check( nf90_get_var(nciu%id, nciu%vhz_varid, rtemp_arr(3,:)), "netcdf_read_particle_info_system nf90_getvar vhz_varid" ) else rtemp_arr(3,:) = 0._DP end if @@ -1060,9 +1065,9 @@ module subroutine netcdf_read_particle_info_system(self, iu, param, plmask, tpma call tp%info(i)%set_value(origin_vh=rtemp_arr(:,tpind(i))) end do - status = nf90_inq_varid(iu%ncid, iu%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 +1079,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, iu%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,23 +1094,23 @@ 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, iu%discard_xhx_varname, iu%discard_xhx_varid) + status = nf90_inq_varid(nciu%id, nciu%discard_xhx_varname, nciu%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" ) + call check( nf90_get_var(nciu%id, nciu%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, iu%discard_xhy_varname, iu%discard_xhy_varid) + status = nf90_inq_varid(nciu%id, nciu%discard_xhy_varname, nciu%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" ) + call check( nf90_get_var(nciu%id, nciu%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, iu%discard_xhz_varname, iu%discard_xhz_varid) + status = nf90_inq_varid(nciu%id, nciu%discard_xhz_varname, nciu%discard_xhz_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_xhz_varid, rtemp_arr(3,:)), "netcdf_read_particle_info_system nf90_getvar discard_xhz_varid" ) else rtemp_arr(3,:) = 0.0_DP end if @@ -1117,23 +1122,23 @@ module subroutine netcdf_read_particle_info_system(self, iu, param, plmask, tpma call tp%info(i)%set_value(discard_xh=rtemp_arr(:,tpind(i))) end do - status = nf90_inq_varid(iu%ncid, iu%discard_vhx_varname, iu%discard_vhx_varid) + status = nf90_inq_varid(nciu%id, nciu%discard_vhx_varname, nciu%discard_vhx_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_vhx_varid, rtemp_arr(1,:)), "netcdf_read_particle_info_system nf90_getvar discard_vhx_varid" ) else rtemp_arr(1,:) = 0.0_DP end if - status = nf90_inq_varid(iu%ncid, iu%discard_vhy_varname, iu%discard_vhy_varid) + status = nf90_inq_varid(nciu%id, nciu%discard_vhy_varname, nciu%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" ) + call check( nf90_get_var(nciu%id, nciu%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, iu%discard_vhz_varname, iu%discard_vhz_varid) + status = nf90_inq_varid(nciu%id, nciu%discard_vhz_varname, nciu%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" ) + call check( nf90_get_var(nciu%id, nciu%discard_vhz_varid, rtemp_arr(3,:)), "netcdf_read_particle_info_system nf90_getvar discard_vhz_varid" ) else rtemp_arr(3,:) = 0.0_DP end if @@ -1161,13 +1166,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,7 +1180,7 @@ 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 @@ -1183,11 +1188,11 @@ module subroutine netcdf_write_frame_base(self, iu, param) real(DP), dimension(NDIM) :: vh !! Temporary variable to store heliocentric velocity values when converting from pseudovelocity in GR-enabled runs real(DP) :: a, e, inc, omega, capom, capm - call self%write_info(iu, param) + call self%write_info(nciu, param) 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) @@ -1203,21 +1208,21 @@ module subroutine netcdf_write_frame_base(self, iu, param) if (param%lgr) call gr_pseudovel2vel(param, self%mu(j), self%xh(:, j), self%vh(:, j), vh(:)) if ((param%out_form == "XV") .or. (param%out_form == "XVEL")) then - call check( nf90_put_var(iu%ncid, iu%xhx_varid, self%xh(1, j), start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var xhx_varid" ) - call check( nf90_put_var(iu%ncid, iu%xhy_varid, self%xh(2, j), start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var xhy_varid" ) - call check( nf90_put_var(iu%ncid, iu%xhz_varid, self%xh(3, j), start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var xhz_varid" ) + call check( nf90_put_var(nciu%id, nciu%xhx_varid, self%xh(1, j), start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var xhx_varid" ) + call check( nf90_put_var(nciu%id, nciu%xhy_varid, self%xh(2, j), start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var xhy_varid" ) + call check( nf90_put_var(nciu%id, nciu%xhz_varid, self%xh(3, j), start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var xhz_varid" ) if (param%lgr) then !! Convert from pseudovelocity to heliocentric without replacing the current value of pseudovelocity - call check( nf90_put_var(iu%ncid, iu%vhx_varid, vh(1), start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var vhx_varid (gr case)" ) - call check( nf90_put_var(iu%ncid, iu%vhy_varid, vh(2), start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var vhy_varid (gr case)" ) - call check( nf90_put_var(iu%ncid, iu%vhz_varid, vh(3), start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var vhz_varid (gr case)" ) - call check( nf90_put_var(iu%ncid, iu%gr_pseudo_vhx_varid, self%vh(1, j), start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var gr_pseudo_vhx_varid" ) - call check( nf90_put_var(iu%ncid, iu%gr_pseudo_vhy_varid, self%vh(2, j), start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var gr_pseudo_vhy_varid" ) - call check( nf90_put_var(iu%ncid, iu%gr_pseudo_vhz_varid, self%vh(3, j), start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var gr_pseudo_vhz_varid" ) + call check( nf90_put_var(nciu%id, nciu%vhx_varid, vh(1), start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var vhx_varid (gr case)" ) + call check( nf90_put_var(nciu%id, nciu%vhy_varid, vh(2), start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var vhy_varid (gr case)" ) + call check( nf90_put_var(nciu%id, nciu%vhz_varid, vh(3), start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var vhz_varid (gr case)" ) + call check( nf90_put_var(nciu%id, nciu%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(nciu%id, nciu%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(nciu%id, nciu%gr_pseudo_vhz_varid, self%vh(3, j), start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var gr_pseudo_vhz_varid" ) else - call check( nf90_put_var(iu%ncid, iu%vhx_varid, self%vh(1, j), start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var vhx_varid" ) - call check( nf90_put_var(iu%ncid, iu%vhy_varid, self%vh(2, j), start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var vhy_varid" ) - call check( nf90_put_var(iu%ncid, iu%vhz_varid, self%vh(3, j), start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var vhz_varid" ) + call check( nf90_put_var(nciu%id, nciu%vhx_varid, self%vh(1, j), start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var vhx_varid" ) + call check( nf90_put_var(nciu%id, nciu%vhy_varid, self%vh(2, j), start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var vhy_varid" ) + call check( nf90_put_var(nciu%id, nciu%vhz_varid, self%vh(3, j), start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var vhz_varid" ) end if end if @@ -1231,32 +1236,32 @@ module subroutine netcdf_write_frame_base(self, iu, param) self%vh(1,j), self%vh(2,j), self%vh(3,j), & a, e, inc, capom, omega, capm) end if - call check( nf90_put_var(iu%ncid, iu%a_varid, a, start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var a_varid" ) - call check( nf90_put_var(iu%ncid, iu%e_varid, e, start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var e_varid" ) - call check( nf90_put_var(iu%ncid, iu%inc_varid, inc * RAD2DEG, start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var inc_varid" ) - call check( nf90_put_var(iu%ncid, iu%capom_varid, capom * RAD2DEG, start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var capom_varid" ) - call check( nf90_put_var(iu%ncid, iu%omega_varid, omega * RAD2DEG, start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var omega_varid" ) - call check( nf90_put_var(iu%ncid, iu%capm_varid, capm * RAD2DEG, start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var capm_varid" ) + call check( nf90_put_var(nciu%id, nciu%a_varid, a, start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var a_varid" ) + call check( nf90_put_var(nciu%id, nciu%e_varid, e, start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var e_varid" ) + call check( nf90_put_var(nciu%id, nciu%inc_varid, inc * RAD2DEG, start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var inc_varid" ) + call check( nf90_put_var(nciu%id, nciu%capom_varid, capom * RAD2DEG, start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var capom_varid" ) + call check( nf90_put_var(nciu%id, nciu%omega_varid, omega * RAD2DEG, start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var omega_varid" ) + call check( nf90_put_var(nciu%id, nciu%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 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 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 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%Ip1_varid, self%Ip(1, j), start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var Ip1_varid" ) + call check( nf90_put_var(nciu%id, nciu%Ip2_varid, self%Ip(2, j), start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var Ip2_varid" ) + call check( nf90_put_var(nciu%id, nciu%Ip3_varid, self%Ip(3, j), start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var Ip3_varid" ) + call check( nf90_put_var(nciu%id, nciu%rotx_varid, self%rot(1, j), start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var rotx_varid" ) + call check( nf90_put_var(nciu%id, nciu%roty_varid, self%rot(2, j), start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var roty_varid" ) + call check( nf90_put_var(nciu%id, nciu%rotz_varid, self%rot(3, j), start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var rotz_varid" ) end if ! if (param%ltides) then - ! call check( nf90_put_var(iu%ncid, iu%k2_varid, self%k2(j), start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var k2_varid" ) - ! call check( nf90_put_var(iu%ncid, iu%Q_varid, self%Q(j), start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var Q_varid" ) + ! call check( nf90_put_var(nciu%id, nciu%k2_varid, self%k2(j), start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var 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 Q_varid" ) ! end if end select @@ -1264,59 +1269,59 @@ 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%Ip1_varid, self%Ip(1), start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var cb Ip1_varid" ) + call check( nf90_put_var(nciu%id, nciu%Ip2_varid, self%Ip(2), start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var cb Ip2_varid" ) + call check( nf90_put_var(nciu%id, nciu%Ip3_varid, self%Ip(3), start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var cb Ip3_varid" ) + call check( nf90_put_var(nciu%id, nciu%rotx_varid, self%rot(1), start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var cb rotx_varid" ) + call check( nf90_put_var(nciu%id, nciu%roty_varid, self%rot(2), start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var cb roty_varid" ) + call check( nf90_put_var(nciu%id, nciu%rotz_varid, self%rot(3), start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var cb rotz_varid" ) end if ! if (param%ltides) then - ! call check( nf90_put_var(iu%ncid, iu%k2_varid, self%k2, start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var cb k2_varid" ) - ! call check( nf90_put_var(iu%ncid, iu%Q_varid, self%Q, start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var cb Q_varid" ) + ! 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_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 +1329,7 @@ module subroutine netcdf_write_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_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 +1340,36 @@ module subroutine netcdf_write_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_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_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_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_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_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_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_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_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_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_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_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_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_xhx_varid, self%info(j)%origin_xh(1), start=[idslot]), "netcdf_write_info_base nf90_put_var origin_xhx_varid" ) + call check( nf90_put_var(nciu%id, nciu%origin_xhy_varid, self%info(j)%origin_xh(2), start=[idslot]), "netcdf_write_info_base nf90_put_var origin_xhy_varid" ) + call check( nf90_put_var(nciu%id, nciu%origin_xhz_varid, self%info(j)%origin_xh(3), start=[idslot]), "netcdf_write_info_base nf90_put_var origin_xhz_varid" ) + call check( nf90_put_var(nciu%id, nciu%origin_vhx_varid, self%info(j)%origin_vh(1), start=[idslot]), "netcdf_write_info_base nf90_put_var origin_vhx_varid" ) + call check( nf90_put_var(nciu%id, nciu%origin_vhy_varid, self%info(j)%origin_vh(2), start=[idslot]), "netcdf_write_info_base nf90_put_var origin_vhy_varid" ) + call check( nf90_put_var(nciu%id, nciu%origin_vhz_varid, self%info(j)%origin_vh(3), start=[idslot]), "netcdf_write_info_base nf90_put_var origin_vhz_varid" ) - call check( nf90_put_var(iu%ncid, iu%collision_id_varid, self%info(j)%collision_id, start=[idslot]), "netcdf_write_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_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_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_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_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_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_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_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_xhx_varid, self%info(j)%discard_xh(1), start=[idslot]), "netcdf_write_info_base nf90_put_var discard_xhx_varid" ) + call check( nf90_put_var(nciu%id, nciu%discard_xhy_varid, self%info(j)%discard_xh(2), start=[idslot]), "netcdf_write_info_base nf90_put_var discard_xhy_varid" ) + call check( nf90_put_var(nciu%id, nciu%discard_xhz_varid, self%info(j)%discard_xh(3), start=[idslot]), "netcdf_write_info_base nf90_put_var discard_xhz_varid" ) + call check( nf90_put_var(nciu%id, nciu%discard_vhx_varid, self%info(j)%discard_vh(1), start=[idslot]), "netcdf_write_info_base nf90_put_var discard_vhx_varid" ) + call check( nf90_put_var(nciu%id, nciu%discard_vhy_varid, self%info(j)%discard_vh(2), start=[idslot]), "netcdf_write_info_base nf90_put_var discard_vhy_varid" ) + call check( nf90_put_var(nciu%id, nciu%discard_vhz_varid, self%info(j)%discard_vh(3), start=[idslot]), "netcdf_write_info_base nf90_put_var discard_vhz_varid" ) end if end do @@ -1372,47 +1377,47 @@ module subroutine netcdf_write_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_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_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_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_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_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_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_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_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_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_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_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_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_xhx_varid, self%info%origin_xh(1), start=[idslot]), "netcdf_write_info_base nf90_put_var cb origin_xhx_varid" ) + call check( nf90_put_var(nciu%id, nciu%origin_xhy_varid, self%info%origin_xh(2), start=[idslot]), "netcdf_write_info_base nf90_put_var cb origin_xhy_varid" ) + call check( nf90_put_var(nciu%id, nciu%origin_xhz_varid, self%info%origin_xh(3), start=[idslot]), "netcdf_write_info_base nf90_put_var cb origin_xhz_varid" ) + call check( nf90_put_var(nciu%id, nciu%origin_vhx_varid, self%info%origin_vh(1), start=[idslot]), "netcdf_write_info_base nf90_put_var cb origin_vhx_varid" ) + call check( nf90_put_var(nciu%id, nciu%origin_vhy_varid, self%info%origin_vh(2), start=[idslot]), "netcdf_write_info_base nf90_put_var cb origin_vhy_varid" ) + call check( nf90_put_var(nciu%id, nciu%origin_vhz_varid, self%info%origin_vh(3), start=[idslot]), "netcdf_write_info_base nf90_put_var cb origin_vhz_varid" ) - call check( nf90_put_var(iu%ncid, iu%collision_id_varid, self%info%collision_id, start=[idslot]), "netcdf_write_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_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_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_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_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_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_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_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_xhx_varid, self%info%discard_xh(1), start=[idslot]), "netcdf_write_info_base nf90_put_var cb discard_xhx_varid" ) + call check( nf90_put_var(nciu%id, nciu%discard_xhy_varid, self%info%discard_xh(2), start=[idslot]), "netcdf_write_info_base nf90_put_var cb discard_xhy_varid" ) + call check( nf90_put_var(nciu%id, nciu%discard_xhz_varid, self%info%discard_xh(3), start=[idslot]), "netcdf_write_info_base nf90_put_var cb discard_xhz_varid" ) + call check( nf90_put_var(nciu%id, nciu%discard_vhx_varid, self%info%discard_vh(1), start=[idslot]), "netcdf_write_info_base nf90_put_var cb discard_vhx_varid" ) + call check( nf90_put_var(nciu%id, nciu%discard_vhy_varid, self%info%discard_vh(2), start=[idslot]), "netcdf_write_info_base nf90_put_var cb discard_vhy_varid" ) + call check( nf90_put_var(nciu%id, nciu%discard_vhz_varid, self%info%discard_vh(3), start=[idslot]), "netcdf_write_info_base nf90_put_var cb discard_vhz_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_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 +1426,37 @@ 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 = 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_orbx_varid, self%Lorbit(1), start=[tslot]), "netcdf_write_hdr_system nf90_put_var L_orbx_varid" ) + call check( nf90_put_var(nciu%id, nciu%L_orby_varid, self%Lorbit(2), start=[tslot]), "netcdf_write_hdr_system nf90_put_var L_orby_varid" ) + call check( nf90_put_var(nciu%id, nciu%L_orbz_varid, self%Lorbit(3), start=[tslot]), "netcdf_write_hdr_system nf90_put_var L_orbz_varid" ) + call check( nf90_put_var(nciu%id, nciu%L_spinx_varid, self%Lspin(1), start=[tslot]), "netcdf_write_hdr_system nf90_put_var L_spinx_varid" ) + call check( nf90_put_var(nciu%id, nciu%L_spiny_varid, self%Lspin(2), start=[tslot]), "netcdf_write_hdr_system nf90_put_var L_spiny_varid" ) + call check( nf90_put_var(nciu%id, nciu%L_spinz_varid, self%Lspin(3), start=[tslot]), "netcdf_write_hdr_system nf90_put_var L_spinz_varid" ) + call check( nf90_put_var(nciu%id, nciu%L_escapex_varid, self%Lescape(1), start=[tslot]), "netcdf_write_hdr_system nf90_put_var L_escapex_varid" ) + call check( nf90_put_var(nciu%id, nciu%L_escapey_varid, self%Lescape(2), start=[tslot]), "netcdf_write_hdr_system nf90_put_var L_escapey_varid" ) + call check( nf90_put_var(nciu%id, nciu%L_escapez_varid, self%Lescape(3), start=[tslot]), "netcdf_write_hdr_system nf90_put_var L_escapez_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/symba/symba_encounter_check.f90 b/src/symba/symba_encounter_check.f90 index f07119dba..1cfa81c88 100644 --- a/src/symba/symba_encounter_check.f90 +++ b/src/symba/symba_encounter_check.f90 @@ -119,7 +119,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 @@ -142,13 +142,13 @@ 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) @@ -163,7 +163,7 @@ 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) @@ -180,9 +180,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 From d4ff657f433e68e26a7705ce5d03ae961e7bb772 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Sat, 3 Dec 2022 07:09:44 -0500 Subject: [PATCH 212/569] Continued to refactor netcdf --- src/netcdf/netcdf.f90 | 234 +++++++++++++++++++++--------------------- 1 file changed, 119 insertions(+), 115 deletions(-) diff --git a/src/netcdf/netcdf.f90 b/src/netcdf/netcdf.f90 index a01482202..dca6d7dbf 100644 --- a/src/netcdf/netcdf.f90 +++ b/src/netcdf/netcdf.f90 @@ -367,133 +367,137 @@ 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%id), errmsg) - - ! Dimensions - call check( nf90_inq_dimid(self%id, self%time_dimname, self%time_dimid), "netcdf_open nf90_inq_dimid time_dimid" ) - call check( nf90_inq_dimid(self%id, self%id_dimname, self%id_dimid), "netcdf_open nf90_inq_dimid id_dimid" ) - call check( nf90_inq_dimid(self%id, self%space_dimname, self%space_dimid), "netcdf_open nf90_inq_dimid space_dimid" ) - call check( nf90_inq_dimid(self%id, self%str_dimname, self%str_dimid), "netcdf_open nf90_inq_dimid str_dimid" ) - - ! Dimension coordinates - call check( nf90_inq_varid(self%id, self%time_dimname, self%time_varid), "netcdf_open nf90_inq_varid time_varid" ) - call check( nf90_inq_varid(self%id, self%id_dimname, self%id_varid), "netcdf_open nf90_inq_varid id_varid" ) - call check( nf90_inq_varid(self%id, self%space_dimname, self%space_varid), "netcdf_open nf90_inq_varid space_varid" ) - - ! Required Variables - call check( nf90_inq_varid(self%id, self%name_varname, self%name_varid), "netcdf_open nf90_inq_varid name_varid" ) - call check( nf90_inq_varid(self%id, self%ptype_varname, self%ptype_varid), "netcdf_open nf90_inq_varid ptype_varid" ) - call check( nf90_inq_varid(self%id, self%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%id, self%xhx_varname, self%xhx_varid), "netcdf_open nf90_inq_varid xhx_varid" ) - call check( nf90_inq_varid(self%id, self%xhy_varname, self%xhy_varid), "netcdf_open nf90_inq_varid xhy_varid" ) - call check( nf90_inq_varid(self%id, self%xhz_varname, self%xhz_varid), "netcdf_open nf90_inq_varid xhz_varid" ) - call check( nf90_inq_varid(self%id, self%vhx_varname, self%vhx_varid), "netcdf_open nf90_inq_varid vhx_varid" ) - call check( nf90_inq_varid(self%id, self%vhy_varname, self%vhy_varid), "netcdf_open nf90_inq_varid vhy_varid" ) - call check( nf90_inq_varid(self%id, self%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%id, self%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%id, self%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%id, self%gr_pseudo_vhz_varname, self%gr_pseudo_vhz_varid) - self%lpseudo_vel_exists = (status == nf90_noerr) + associate(nciu => self) + + 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%id_dimname, nciu%id_dimid), "netcdf_open nf90_inq_dimid id_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%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%id_dimname, nciu%id_varid), "netcdf_open nf90_inq_varid id_varid" ) + call check( nf90_inq_varid(nciu%id, nciu%space_dimname, nciu%space_varid), "netcdf_open nf90_inq_varid space_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%ptype_varname, nciu%ptype_varid), "netcdf_open nf90_inq_varid ptype_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%xhx_varname, nciu%xhx_varid), "netcdf_open nf90_inq_varid xhx_varid" ) + call check( nf90_inq_varid(nciu%id, nciu%xhy_varname, nciu%xhy_varid), "netcdf_open nf90_inq_varid xhy_varid" ) + call check( nf90_inq_varid(nciu%id, nciu%xhz_varname, nciu%xhz_varid), "netcdf_open nf90_inq_varid xhz_varid" ) + call check( nf90_inq_varid(nciu%id, nciu%vhx_varname, nciu%vhx_varid), "netcdf_open nf90_inq_varid vhx_varid" ) + call check( nf90_inq_varid(nciu%id, nciu%vhy_varname, nciu%vhy_varid), "netcdf_open nf90_inq_varid vhy_varid" ) + call check( nf90_inq_varid(nciu%id, nciu%vhz_varname, nciu%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(nciu%id, nciu%gr_pseudo_vhx_varname, nciu%gr_pseudo_vhx_varid) + nciu%lpseudo_vel_exists = (status == nf90_noerr) + if (nciu%lpseudo_vel_exists) then + status = nf90_inq_varid(nciu%id, nciu%gr_pseudo_vhy_varname, nciu%gr_pseudo_vhy_varid) + nciu%lpseudo_vel_exists = (status == nf90_noerr) + if (nciu%lpseudo_vel_exists) then + status = nf90_inq_varid(nciu%id, nciu%gr_pseudo_vhz_varname, nciu%gr_pseudo_vhz_varid) + nciu%lpseudo_vel_exists = (status == nf90_noerr) + end if end if + 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%id, self%a_varname, self%a_varid), "netcdf_open nf90_inq_varid a_varid" ) - call check( nf90_inq_varid(self%id, self%e_varname, self%e_varid), "netcdf_open nf90_inq_varid e_varid" ) - call check( nf90_inq_varid(self%id, self%inc_varname, self%inc_varid), "netcdf_open nf90_inq_varid inc_varid" ) - call check( nf90_inq_varid(self%id, self%capom_varname, self%capom_varid), "netcdf_open nf90_inq_varid capom_varid" ) - call check( nf90_inq_varid(self%id, self%omega_varname, self%omega_varid), "netcdf_open nf90_inq_varid omega_varid" ) - call check( nf90_inq_varid(self%id, self%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%id, self%radius_varname, self%radius_varid), "netcdf_open nf90_inq_varid radius_varid" ) - end if - - if (param%lrotation) then - call check( nf90_inq_varid(self%id, self%ip1_varname, self%Ip1_varid), "netcdf_open nf90_inq_varid Ip1_varid" ) - call check( nf90_inq_varid(self%id, self%ip2_varname, self%Ip2_varid), "netcdf_open nf90_inq_varid Ip2_varid" ) - call check( nf90_inq_varid(self%id, self%ip3_varname, self%Ip3_varid), "netcdf_open nf90_inq_varid Ip3_varid" ) - call check( nf90_inq_varid(self%id, self%rotx_varname, self%rotx_varid), "netcdf_open nf90_inq_varid rotx_varid" ) - call check( nf90_inq_varid(self%id, self%roty_varname, self%roty_varid), "netcdf_open nf90_inq_varid roty_varid" ) - call check( nf90_inq_varid(self%id, self%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%ip1_varname, nciu%Ip1_varid), "netcdf_open nf90_inq_varid Ip1_varid" ) + call check( nf90_inq_varid(nciu%id, nciu%ip2_varname, nciu%Ip2_varid), "netcdf_open nf90_inq_varid Ip2_varid" ) + call check( nf90_inq_varid(nciu%id, nciu%ip3_varname, nciu%Ip3_varid), "netcdf_open nf90_inq_varid Ip3_varid" ) + call check( nf90_inq_varid(nciu%id, nciu%rotx_varname, nciu%rotx_varid), "netcdf_open nf90_inq_varid rotx_varid" ) + call check( nf90_inq_varid(nciu%id, nciu%roty_varname, nciu%roty_varid), "netcdf_open nf90_inq_varid roty_varid" ) + call check( nf90_inq_varid(nciu%id, nciu%rotz_varname, nciu%rotz_varid), "netcdf_open nf90_inq_varid rotz_varid" ) + end if - ! if (param%ltides) then - ! call check( nf90_inq_varid(self%id, self%k2_varname, self%k2_varid), "netcdf_open nf90_inq_varid k2_varid" ) - ! call check( nf90_inq_varid(self%id, self%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%id, self%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%id, self%npl_varname, self%npl_varid) - status = nf90_inq_varid(self%id, self%ntp_varname, self%ntp_varid) - status = nf90_inq_varid(self%id, self%status_varname, self%status_varid) - status = nf90_inq_varid(self%id, self%j2rp2_varname, self%j2rp2_varid) - status = nf90_inq_varid(self%id, self%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) - if (param%integrator == SYMBA) then - status = nf90_inq_varid(self%id, self%nplm_varname, self%nplm_varid) - end if + if (param%integrator == SYMBA) then + status = nf90_inq_varid(nciu%id, nciu%nplm_varname, nciu%nplm_varid) + end if - if (param%lclose) then - status = nf90_inq_varid(self%id, self%origin_type_varname, self%origin_type_varid) - status = nf90_inq_varid(self%id, self%origin_time_varname, self%origin_time_varid) - status = nf90_inq_varid(self%id, self%origin_xhx_varname, self%origin_xhx_varid) - status = nf90_inq_varid(self%id, self%origin_xhy_varname, self%origin_xhy_varid) - status = nf90_inq_varid(self%id, self%origin_xhz_varname, self%origin_xhz_varid) - status = nf90_inq_varid(self%id, self%origin_vhx_varname, self%origin_vhx_varid) - status = nf90_inq_varid(self%id, self%origin_vhy_varname, self%origin_vhy_varid) - status = nf90_inq_varid(self%id, self%origin_vhz_varname, self%origin_vhz_varid) - status = nf90_inq_varid(self%id, self%collision_id_varname, self%collision_id_varid) - status = nf90_inq_varid(self%id, self%discard_time_varname, self%discard_time_varid) - status = nf90_inq_varid(self%id, self%discard_xhx_varname, self%discard_xhx_varid) - status = nf90_inq_varid(self%id, self%discard_xhy_varname, self%discard_xhy_varid) - status = nf90_inq_varid(self%id, self%discard_xhz_varname, self%discard_xhz_varid) - status = nf90_inq_varid(self%id, self%discard_vhx_varname, self%discard_vhx_varid) - status = nf90_inq_varid(self%id, self%discard_vhy_varname, self%discard_vhy_varid) - status = nf90_inq_varid(self%id, self%discard_vhz_varname, self%discard_vhz_varid) - status = nf90_inq_varid(self%id, self%discard_body_id_varname, self%discard_body_id_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_xhx_varname, nciu%origin_xhx_varid) + status = nf90_inq_varid(nciu%id, nciu%origin_xhy_varname, nciu%origin_xhy_varid) + status = nf90_inq_varid(nciu%id, nciu%origin_xhz_varname, nciu%origin_xhz_varid) + status = nf90_inq_varid(nciu%id, nciu%origin_vhx_varname, nciu%origin_vhx_varid) + status = nf90_inq_varid(nciu%id, nciu%origin_vhy_varname, nciu%origin_vhy_varid) + status = nf90_inq_varid(nciu%id, nciu%origin_vhz_varname, nciu%origin_vhz_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_xhx_varname, nciu%discard_xhx_varid) + status = nf90_inq_varid(nciu%id, nciu%discard_xhy_varname, nciu%discard_xhy_varid) + status = nf90_inq_varid(nciu%id, nciu%discard_xhz_varname, nciu%discard_xhz_varid) + status = nf90_inq_varid(nciu%id, nciu%discard_vhx_varname, nciu%discard_vhx_varid) + status = nf90_inq_varid(nciu%id, nciu%discard_vhy_varname, nciu%discard_vhy_varid) + status = nf90_inq_varid(nciu%id, nciu%discard_vhz_varname, nciu%discard_vhz_varid) + status = nf90_inq_varid(nciu%id, nciu%discard_body_id_varname, nciu%discard_body_id_varid) + end if - if (param%lenergy) then - status = nf90_inq_varid(self%id, self%ke_orb_varname, self%KE_orb_varid) - status = nf90_inq_varid(self%id, self%ke_spin_varname, self%KE_spin_varid) - status = nf90_inq_varid(self%id, self%pe_varname, self%PE_varid) - status = nf90_inq_varid(self%id, self%l_orbx_varname, self%L_orbx_varid) - status = nf90_inq_varid(self%id, self%l_orby_varname, self%L_orby_varid) - status = nf90_inq_varid(self%id, self%l_orbz_varname, self%L_orbz_varid) - status = nf90_inq_varid(self%id, self%l_spinx_varname, self%L_spinx_varid) - status = nf90_inq_varid(self%id, self%l_spiny_varname, self%L_spiny_varid) - status = nf90_inq_varid(self%id, self%l_spinz_varname, self%L_spinz_varid) - status = nf90_inq_varid(self%id, self%l_escapex_varname, self%L_escapex_varid) - status = nf90_inq_varid(self%id, self%l_escapey_varname, self%L_escapey_varid) - status = nf90_inq_varid(self%id, self%l_escapez_varname, self%L_escapez_varid) - status = nf90_inq_varid(self%id, self%ecollisions_varname, self%Ecollisions_varid) - status = nf90_inq_varid(self%id, self%euntracked_varname, self%Euntracked_varid) - status = nf90_inq_varid(self%id, self%gmescape_varname, self%GMescape_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_orbx_varname, nciu%L_orbx_varid) + status = nf90_inq_varid(nciu%id, nciu%l_orby_varname, nciu%L_orby_varid) + status = nf90_inq_varid(nciu%id, nciu%l_orbz_varname, nciu%L_orbz_varid) + status = nf90_inq_varid(nciu%id, nciu%l_spinx_varname, nciu%L_spinx_varid) + status = nf90_inq_varid(nciu%id, nciu%l_spiny_varname, nciu%L_spiny_varid) + status = nf90_inq_varid(nciu%id, nciu%l_spinz_varname, nciu%L_spinz_varid) + status = nf90_inq_varid(nciu%id, nciu%l_escapex_varname, nciu%L_escapex_varid) + status = nf90_inq_varid(nciu%id, nciu%l_escapey_varname, nciu%L_escapey_varid) + status = nf90_inq_varid(nciu%id, nciu%l_escapez_varname, nciu%L_escapez_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 + + end associate return end subroutine netcdf_open From c8145640030038b07b6d040664cc339b0c28e6e0 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Sat, 3 Dec 2022 10:00:08 -0500 Subject: [PATCH 213/569] Added space dimension to initial conditions generator --- python/swiftest/swiftest/init_cond.py | 27 ++++++++++++-------- python/swiftest/swiftest/io.py | 36 ++++++++++++++++++++++++--- 2 files changed, 49 insertions(+), 14 deletions(-) diff --git a/python/swiftest/swiftest/init_cond.py b/python/swiftest/swiftest/init_cond.py index 1d43fb599..27763ef14 100644 --- a/python/swiftest/swiftest/init_cond.py +++ b/python/swiftest/swiftest/init_cond.py @@ -325,8 +325,9 @@ def vec2xr(param: Dict, if rotz is None: rotz = np.full_like(v1, 0.0) - dims = ['time', 'id', 'vec'] + dims = ['id', 'vec'] infodims = ['id', 'vec'] + space_var = np.array(["x","y","z"]) # The central body is always given id 0 if GMpl is not None: @@ -360,16 +361,19 @@ def vec2xr(param: Dict, vec = np.vstack([v1,v2,v3,v4,v5,v6]) if iscb: + particle_type[icb] = "Central Body" 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') + + ds_cb = xr.DataArray(vec_cb.T, dims=dims, coords={'id': idvals[icb], 'vec': lab_cb}) + ds_cb = ds_cb.expand_dims({"time":1}).assign_coords({"time": [t]}).to_dataset(dim='vec') else: ds_cb = None + if ispl: + particle_type[ipl] = np.repeat("Massive Body",idvals[ipl].size) lab_pl = plab.copy() vec_pl = np.vstack([vec[:,ipl], GMpl[ipl]]) if param['CHK_CLOSE']: @@ -378,16 +382,18 @@ def vec2xr(param: Dict, 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') + + ds_pl = xr.DataArray(vec_pl.T, dims=dims, coords={'id': idvals[ipl], 'vec': lab_pl}) + ds_pl = ds_pl.expand_dims({"time":1}).assign_coords({"time": [t]}).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) + lab_tp = tlab.copy() + vec_tp = vec[:,itp] + ds_tp = xr.DataArray(vec_tp.T, dims=dims, coords={'id': idvals[itp], 'vec': lab_tp}) + ds_tp = ds_tp.expand_dims({"time":1}).assign_coords({"time": [t]}).to_dataset(dim='vec') else: ds_tp = None @@ -398,5 +404,6 @@ def vec2xr(param: Dict, else: ds = ds[0] ds = xr.merge([ds_info,ds]) + ds["space"] = xr.DataArray(space_var,dims=["space"],coords={"space":space_var}) return ds \ No newline at end of file diff --git a/python/swiftest/swiftest/io.py b/python/swiftest/swiftest/io.py index 92eeec73e..01983bad6 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): @@ -805,7 +806,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: @@ -889,7 +890,7 @@ def string_converter(da): Parameters ---------- da : xarray dataset - + Returns ------- da : xarray dataset with the strings cleaned up @@ -900,6 +901,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(' Date: Sat, 3 Dec 2022 10:00:54 -0500 Subject: [PATCH 214/569] Added space dimension to netcdf procedures --- src/netcdf/netcdf.f90 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/netcdf/netcdf.f90 b/src/netcdf/netcdf.f90 index dca6d7dbf..aac5a8a4c 100644 --- a/src/netcdf/netcdf.f90 +++ b/src/netcdf/netcdf.f90 @@ -208,14 +208,14 @@ module subroutine netcdf_initialize_output(self, param) ! 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%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%space_dimname, 3, 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%id_dimname, NF90_INT, nciu%id_dimid, nciu%id_varid), "netcdf_initialize_output nf90_def_var id_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" ) @@ -374,14 +374,14 @@ module subroutine netcdf_open(self, param, readonly) ! 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%id_dimname, nciu%id_dimid), "netcdf_open nf90_inq_dimid id_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%id_dimname, nciu%id_varid), "netcdf_open nf90_inq_varid id_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" ) From 1d4d18a792cf18356fc4cd626fca616ad350040c Mon Sep 17 00:00:00 2001 From: David A Minton Date: Sat, 3 Dec 2022 10:07:52 -0500 Subject: [PATCH 215/569] Cleaned up space coordinate dimension file stuff --- python/swiftest/swiftest/init_cond.py | 4 ++-- src/modules/swiftest_classes.f90 | 1 + src/netcdf/netcdf.f90 | 2 +- 3 files changed, 4 insertions(+), 3 deletions(-) diff --git a/python/swiftest/swiftest/init_cond.py b/python/swiftest/swiftest/init_cond.py index 27763ef14..b0dabe922 100644 --- a/python/swiftest/swiftest/init_cond.py +++ b/python/swiftest/swiftest/init_cond.py @@ -327,7 +327,7 @@ def vec2xr(param: Dict, dims = ['id', 'vec'] infodims = ['id', 'vec'] - space_var = np.array(["x","y","z"]) + space_coords = np.array(["x","y","z"]) # The central body is always given id 0 if GMpl is not None: @@ -404,6 +404,6 @@ def vec2xr(param: Dict, else: ds = ds[0] ds = xr.merge([ds_info,ds]) - ds["space"] = xr.DataArray(space_var,dims=["space"],coords={"space":space_var}) + ds["space"] = xr.DataArray(space_coords,dims=["space"],coords={"space":space_coords}) return ds \ No newline at end of file diff --git a/src/modules/swiftest_classes.f90 b/src/modules/swiftest_classes.f90 index f3704a978..61e0ac846 100644 --- a/src/modules/swiftest_classes.f90 +++ b/src/modules/swiftest_classes.f90 @@ -39,6 +39,7 @@ module swiftest_classes 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 diff --git a/src/netcdf/netcdf.f90 b/src/netcdf/netcdf.f90 index aac5a8a4c..1459cf02b 100644 --- a/src/netcdf/netcdf.f90 +++ b/src/netcdf/netcdf.f90 @@ -338,7 +338,7 @@ module subroutine netcdf_initialize_output(self, param) ! Take the file out of define mode call check( nf90_enddef(nciu%id), "netcdf_initialize_output nf90_enddef" ) - call check( nf90_put_var(nciu%id, nciu%space_varid, ["x","y","z"], start=[1], count=[3]), "netcdf_initialize_output nf90_put_var space" ) + call check( nf90_put_var(nciu%id, nciu%space_varid, nciu%space_coords, start=[1], count=[3]), "netcdf_initialize_output nf90_put_var space" ) end associate return From 968d3951cd8c776a9ffed8f62ff5eeb45682f88f Mon Sep 17 00:00:00 2001 From: David A Minton Date: Sat, 3 Dec 2022 10:39:47 -0500 Subject: [PATCH 216/569] Did some more to try to get dimensions into the order I want --- examples/Basic_Simulation/initial_conditions.py | 4 ++-- python/swiftest/swiftest/init_cond.py | 6 ++++++ python/swiftest/swiftest/io.py | 15 ++++++++++++++- python/swiftest/swiftest/simulation_class.py | 1 + 4 files changed, 23 insertions(+), 3 deletions(-) diff --git a/examples/Basic_Simulation/initial_conditions.py b/examples/Basic_Simulation/initial_conditions.py index 4d7fe7ae5..a577c6658 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"]) @@ -67,4 +67,4 @@ sim.get_parameter() # Run the simulation -sim.run() +sim.run(tstart=0.0, tstop=1.0e2, dt=0.01, tstep_out=1.0e0, dump_cadence=0, ) diff --git a/python/swiftest/swiftest/init_cond.py b/python/swiftest/swiftest/init_cond.py index b0dabe922..fb7ae2fbd 100644 --- a/python/swiftest/swiftest/init_cond.py +++ b/python/swiftest/swiftest/init_cond.py @@ -406,4 +406,10 @@ def vec2xr(param: Dict, ds = xr.merge([ds_info,ds]) ds["space"] = xr.DataArray(space_coords,dims=["space"],coords={"space":space_coords}) + # Re-order dimension coordinates so that they are in the same order as the Fortran side + idx = ds.indexes + dim_order = ["time", "space", "id"] + idx = {index_name: idx[index_name] for index_name in dim_order} + ds = ds.reindex(idx) + return ds \ No newline at end of file diff --git a/python/swiftest/swiftest/io.py b/python/swiftest/swiftest/io.py index 01983bad6..caa36926a 100644 --- a/python/swiftest/swiftest/io.py +++ b/python/swiftest/swiftest/io.py @@ -193,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", "space", "id"] + elif "name" in idx: + dim_order = ["time", "space", "name"] + 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 @@ -1134,6 +1146,7 @@ def swiftest_xr2infile(ds, param, in_type="NETCDF_DOUBLE", infile_name=None,fram frame = unclean_string_values(frame) if verbose: print(f"Writing initial conditions to file {infile_name}") + frame = reorder_dims(frame) frame.to_netcdf(path=infile_name) return frame diff --git a/python/swiftest/swiftest/simulation_class.py b/python/swiftest/swiftest/simulation_class.py index aad511e92..9e1279a79 100644 --- a/python/swiftest/swiftest/simulation_class.py +++ b/python/swiftest/swiftest/simulation_class.py @@ -2549,6 +2549,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 From 6e22638e1c2b6ff6b6dfbfe44f0039dda5060455 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Sat, 3 Dec 2022 10:54:58 -0500 Subject: [PATCH 217/569] Experimenting with saving the vector position and velocity data rather than by component --- src/modules/swiftest_classes.f90 | 4 ++++ src/netcdf/netcdf.f90 | 6 ++++++ 2 files changed, 10 insertions(+) diff --git a/src/modules/swiftest_classes.f90 b/src/modules/swiftest_classes.f90 index 61e0ac846..d136cd7f6 100644 --- a/src/modules/swiftest_classes.f90 +++ b/src/modules/swiftest_classes.f90 @@ -64,6 +64,10 @@ module swiftest_classes integer(I4B) :: omega_varid !! ID for the arg. 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) :: 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) :: xhx_varname = "xhx" !! name of the heliocentric position x variable integer(I4B) :: xhx_varid !! ID for the heliocentric position x variable character(NAMELEN) :: xhy_varname = "xhy" !! name of the heliocentric position y variable diff --git a/src/netcdf/netcdf.f90 b/src/netcdf/netcdf.f90 index 1459cf02b..818fa3302 100644 --- a/src/netcdf/netcdf.f90 +++ b/src/netcdf/netcdf.f90 @@ -226,6 +226,8 @@ module subroutine netcdf_initialize_output(self, param) 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" ) call check( nf90_def_var(nciu%id, nciu%xhx_varname, nciu%out_type, [nciu%id_dimid, nciu%time_dimid], nciu%xhx_varid), "netcdf_initialize_output nf90_def_var xhx_varid" ) call check( nf90_def_var(nciu%id, nciu%xhy_varname, nciu%out_type, [nciu%id_dimid, nciu%time_dimid], nciu%xhy_varid), "netcdf_initialize_output nf90_def_var xhy_varid" ) call check( nf90_def_var(nciu%id, nciu%xhz_varname, nciu%out_type, [nciu%id_dimid, nciu%time_dimid], nciu%xhz_varid), "netcdf_initialize_output nf90_def_var xhz_varid" ) @@ -389,6 +391,8 @@ module subroutine netcdf_open(self, param, readonly) 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 + status = nf90_inq_varid(nciu%id, nciu%rh_varname, nciu%rh_varid) + status = nf90_inq_varid(nciu%id, nciu%vh_varname, nciu%vh_varid) call check( nf90_inq_varid(nciu%id, nciu%xhx_varname, nciu%xhx_varid), "netcdf_open nf90_inq_varid xhx_varid" ) call check( nf90_inq_varid(nciu%id, nciu%xhy_varname, nciu%xhy_varid), "netcdf_open nf90_inq_varid xhy_varid" ) call check( nf90_inq_varid(nciu%id, nciu%xhz_varname, nciu%xhz_varid), "netcdf_open nf90_inq_varid xhz_varid" ) @@ -1212,6 +1216,8 @@ module subroutine netcdf_write_frame_base(self, nciu, param) if (param%lgr) call gr_pseudovel2vel(param, self%mu(j), self%xh(:, j), self%vh(:, j), vh(:)) if ((param%out_form == "XV") .or. (param%out_form == "XVEL")) then + call check( nf90_put_var(nciu%id, nciu%rh_varid, self%xh(:, j), start=[1,idslot, tslot], count=[3,1,1]), "netcdf_write_frame_base nf90_put_var rh_varid" ) + call check( nf90_put_var(nciu%id, nciu%vh_varid, self%vh(:, j), start=[1,idslot, tslot], count=[3,1,1]), "netcdf_write_frame_base nf90_put_var vh_varid" ) call check( nf90_put_var(nciu%id, nciu%xhx_varid, self%xh(1, j), start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var xhx_varid" ) call check( nf90_put_var(nciu%id, nciu%xhy_varid, self%xh(2, j), start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var xhy_varid" ) call check( nf90_put_var(nciu%id, nciu%xhz_varid, self%xh(3, j), start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var xhz_varid" ) From 4f1d1aef068331ae490b7f828d7e08b0b7152ea0 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Sat, 3 Dec 2022 12:17:30 -0500 Subject: [PATCH 218/569] Converted NetCDF vector component variables to vector variables --- python/swiftest/swiftest/io.py | 4 +- src/modules/swiftest_classes.f90 | 100 ++++++++----------------------- 2 files changed, 26 insertions(+), 78 deletions(-) diff --git a/python/swiftest/swiftest/io.py b/python/swiftest/swiftest/io.py index caa36926a..7a67f9a8a 100644 --- a/python/swiftest/swiftest/io.py +++ b/python/swiftest/swiftest/io.py @@ -198,9 +198,9 @@ 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", "space", "id"] + dim_order = ["time", "id", "space"] elif "name" in idx: - dim_order = ["time", "space", "name"] + dim_order = ["time", "name", "space"] else: dim_order = idx idx = {index_name: idx[index_name] for index_name in dim_order} diff --git a/src/modules/swiftest_classes.f90 b/src/modules/swiftest_classes.f90 index d136cd7f6..302d09eea 100644 --- a/src/modules/swiftest_classes.f90 +++ b/src/modules/swiftest_classes.f90 @@ -21,7 +21,7 @@ module swiftest_classes !! 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) :: 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 @@ -68,42 +68,18 @@ module swiftest_classes 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) :: xhx_varname = "xhx" !! name of the heliocentric position x variable - integer(I4B) :: xhx_varid !! ID for the heliocentric position x variable - character(NAMELEN) :: xhy_varname = "xhy" !! name of the heliocentric position y variable - integer(I4B) :: xhy_varid !! ID for the heliocentric position y variable - character(NAMELEN) :: xhz_varname = "xhz" !! name of the heliocentric position z variable - integer(I4B) :: xhz_varid !! ID for the heliocentric position z variable - character(NAMELEN) :: vhx_varname = "vhx" !! name of the heliocentric velocity x variable - integer(I4B) :: vhx_varid !! ID for the heliocentric velocity x variable - character(NAMELEN) :: vhy_varname = "vhy" !! name of the heliocentric velocity y variable - integer(I4B) :: vhy_varid !! ID for the heliocentric velocity y variable - character(NAMELEN) :: vhz_varname = "vhz" !! name of the heliocentric velocity z variable - integer(I4B) :: vhz_varid !! ID for the heliocentric velocity z variable - character(NAMELEN) :: gr_pseudo_vhx_varname = "gr_pseudo_vhx" !! name of the heliocentric pseudovelocity x variable (used in GR only) - integer(I4B) :: gr_pseudo_vhx_varid !! ID for the heliocentric pseudovelocity x variable (used in GR) - character(NAMELEN) :: gr_pseudo_vhy_varname = "gr_pseudo_vhy" !! name of the heliocentric pseudovelocity y variable (used in GR only) - integer(I4B) :: gr_pseudo_vhy_varid !! ID for the heliocentric pseudovelocity y variable (used in GR) - character(NAMELEN) :: gr_pseudo_vhz_varname = "gr_pseudo_vhz" !! name of the heliocentric pseudovelocity z variable (used in GR only) - integer(I4B) :: gr_pseudo_vhz_varid !! ID for the heliocentric psuedovelocity z variable (used in GR) + 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) :: ip1_varname = "Ip1" !! name of the axis 1 principal moment of inertial variable - integer(I4B) :: Ip1_varid !! ID for the axis 1 principal moment of inertia variable - character(NAMELEN) :: ip2_varname = "Ip2" !! name of the axis 2 principal moment of inertial variable - integer(I4B) :: Ip2_varid !! ID for the axis 2 principal moment of inertia variable - character(NAMELEN) :: ip3_varname = "Ip3" !! name of the axis 3 principal moment of inertial variable - integer(I4B) :: Ip3_varid !! ID for the axis 3 principal moment of inertia variable - character(NAMELEN) :: rotx_varname = "rotx" !! name of the rotation x variable - integer(I4B) :: rotx_varid !! ID for the rotation x variable - character(NAMELEN) :: roty_varname = "roty" !! name of the rotation y variable - integer(I4B) :: roty_varid !! ID for the rotation y variable - character(NAMELEN) :: rotz_varname = "rotz" !! name of the rotation z variable - integer(I4B) :: rotz_varid !! ID for the rotation z 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 @@ -118,29 +94,17 @@ module swiftest_classes 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_orbx_varname = "L_orbx" !! name of the orbital angular momentum x variable - integer(I4B) :: L_orbx_varid !! ID for the system orbital angular momentum x variable - character(NAMELEN) :: l_orby_varname = "L_orby" !! name of the orbital angular momentum y variable - integer(I4B) :: L_orby_varid !! ID for the system orbital angular momentum y variable - character(NAMELEN) :: l_orbz_varname = "L_orbz" !! name of the orbital angular momentum z variable - integer(I4B) :: L_orbz_varid !! ID for the system orbital angular momentum z variable - character(NAMELEN) :: l_spinx_varname = "L_spinx" !! name of the spin angular momentum x variable - integer(I4B) :: L_spinx_varid !! ID for the system spin angular momentum x variable - character(NAMELEN) :: l_spiny_varname = "L_spiny" !! name of the spin angular momentum y variable - integer(I4B) :: L_spiny_varid !! ID for the system spin angular momentum y variable - character(NAMELEN) :: l_spinz_varname = "L_spinz" !! name of the spin angular momentum z variable - integer(I4B) :: L_spinz_varid !! ID for the system spin angular momentum z variable - character(NAMELEN) :: l_escapex_varname = "L_escapex" !! name of the escaped angular momentum x variable - integer(I4B) :: L_escapex_varid !! ID for the escaped angular momentum x variable - character(NAMELEN) :: l_escapey_varname = "L_escapey" !! name of the escaped angular momentum y variable - integer(I4B) :: L_escapey_varid !! ID for the escaped angular momentum x variable - character(NAMELEN) :: l_escapez_varname = "L_escapez" !! name of the escaped angular momentum z variable - integer(I4B) :: L_escapez_varid !! ID for the escaped angular momentum x variable - character(NAMELEN) :: ecollisions_varname = "Ecollisions" !! name of the escaped angular momentum y 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) + 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 + 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 @@ -150,32 +114,16 @@ module swiftest_classes 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_xhx_varname = "origin_xhx" !! name of the heliocentric position of the body at the time of origin x variable - integer(I4B) :: origin_xhx_varid !! ID for the origin xh x component - character(NAMELEN) :: origin_xhy_varname = "origin_xhy" !! name of the heliocentric position of the body at the time of origin y variable - integer(I4B) :: origin_xhy_varid !! ID for the origin xh y component - character(NAMELEN) :: origin_xhz_varname = "origin_xhz" !! name of the heliocentric position of the body at the time of origin z variable - integer(I4B) :: origin_xhz_varid !! ID for the origin xh z component - character(NAMELEN) :: origin_vhx_varname = "origin_vhx" !! name of the heliocentric velocity of the body at the time of origin x variable - integer(I4B) :: origin_vhx_varid !! ID for the origin xh x component - character(NAMELEN) :: origin_vhy_varname = "origin_vhy" !! name of the heliocentric velocity of the body at the time of origin y variable - integer(I4B) :: origin_vhy_varid !! ID for the origin xh y component - character(NAMELEN) :: origin_vhz_varname = "origin_vhz" !! name of the heliocentric velocity of the body at the time of origin z variable - integer(I4B) :: origin_vhz_varid !! ID for the origin xh z component + 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_xhx_varname = "discard_xhx" !! name of the heliocentric position of the body at the time of discard x variable - integer(I4B) :: discard_xhx_varid !! ID for the heliocentric position of the body at the time of discard x variable - character(NAMELEN) :: discard_xhy_varname = "discard_xhy" !! name of the heliocentric position of the body at the time of discard y variable - integer(I4B) :: discard_xhy_varid !! ID for the heliocentric position of the body at the time of discard y variable - character(NAMELEN) :: discard_xhz_varname = "discard_xhz" !! name of the heliocentric position of the body at the time of discard z variable - integer(I4B) :: discard_xhz_varid !! ID for the heliocentric position of the body at the time of discard z variable - character(NAMELEN) :: discard_vhx_varname = "discard_vhx" !! name of the heliocentric velocity of the body at the time of discard x variable - integer(I4B) :: discard_vhx_varid !! ID for the heliocentric velocity of the body at the time of discard x variable - character(NAMELEN) :: discard_vhy_varname = "discard_vhy" !! name of the heliocentric velocity of the body at the time of discard y variable - integer(I4B) :: discard_vhy_varid !! ID for the heliocentric velocity of the body at the time of discard y variable - character(NAMELEN) :: discard_vhz_varname = "discard_vhz" !! name of the heliocentric velocity of the body at the time of discard z variable - integer(I4B) :: discard_vhz_varid !! ID for the heliocentric velocity of the body at the time of discard z 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 From 013178900a92946143f52e3aac8c30bf3a169592 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Sat, 3 Dec 2022 15:51:00 -0500 Subject: [PATCH 219/569] Major refactoring! Changed all NetCDF component variables to vectors in the SPACE DIMENSION. Also refactored xh to rh, as that's has been bugging me for years. --- src/discard/discard.f90 | 16 +- src/drift/drift.f90 | 2 +- src/encounter/encounter_io.f90 | 104 +++--- src/fraggle/fraggle_io.f90 | 4 +- src/fraggle/fraggle_util.f90 | 2 +- src/gr/gr.f90 | 22 +- src/helio/helio_drift.f90 | 26 +- src/helio/helio_gr.f90 | 8 +- src/helio/helio_kick.f90 | 4 +- src/io/io.f90 | 2 +- src/kick/kick.f90 | 10 +- src/modules/swiftest_classes.f90 | 32 +- src/netcdf/netcdf.f90 | 517 ++++++++-------------------- src/obl/obl.f90 | 10 +- src/orbel/orbel.f90 | 4 +- src/rmvs/rmvs_discard.f90 | 2 +- src/rmvs/rmvs_encounter_check.f90 | 2 +- src/rmvs/rmvs_kick.f90 | 12 +- src/rmvs/rmvs_step.f90 | 30 +- src/setup/setup.f90 | 14 +- src/setup/symba_collision.f90 | 36 +- src/symba/symba_collision.f90 | 36 +- src/symba/symba_discard.f90 | 10 +- src/symba/symba_encounter_check.f90 | 14 +- src/symba/symba_kick.f90 | 14 +- src/symba/symba_util.f90 | 6 +- src/tides/tides_getacch_pl.f90 | 4 +- src/util/util_append.f90 | 2 +- src/util/util_coord.f90 | 24 +- src/util/util_copy.f90 | 4 +- src/util/util_dealloc.f90 | 2 +- src/util/util_fill.f90 | 2 +- src/util/util_peri.f90 | 4 +- src/util/util_rescale.f90 | 2 +- src/util/util_resize.f90 | 2 +- src/util/util_set.f90 | 20 +- src/util/util_sort.f90 | 4 +- src/util/util_spill.f90 | 2 +- src/whm/whm_coord.f90 | 14 +- src/whm/whm_gr.f90 | 4 +- src/whm/whm_kick.f90 | 8 +- src/whm/whm_util.f90 | 2 +- 42 files changed, 404 insertions(+), 635 deletions(-) diff --git a/src/discard/discard.f90 b/src/discard/discard.f90 index 2019774a8..41ece554b 100644 --- a/src/discard/discard.f90 +++ b/src/discard/discard.f90 @@ -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 index e425c0ae1..d28ecd1f5 100644 --- a/src/encounter/encounter_io.f90 +++ b/src/encounter/encounter_io.f90 @@ -81,19 +81,15 @@ module subroutine encounter_io_initialize_output(self, param) 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%xhx_varname, self%out_type, [self%collider_dimid, self%eid_dimid, self%time_dimid], self%xhx_varid), "encounter_io_initialize_output nf90_def_var xhx_varid" ) - call check( nf90_def_var(self%id, self%xhy_varname, self%out_type, [self%collider_dimid, self%eid_dimid, self%time_dimid], self%xhy_varid), "encounter_io_initialize_output nf90_def_var xhy_varid" ) - call check( nf90_def_var(self%id, self%xhz_varname, self%out_type, [self%collider_dimid, self%eid_dimid, self%time_dimid], self%xhz_varid), "encounter_io_initialize_output nf90_def_var xhz_varid" ) - call check( nf90_def_var(self%id, self%vhx_varname, self%out_type, [self%collider_dimid, self%eid_dimid, self%time_dimid], self%vhx_varid), "encounter_io_initialize_output nf90_def_var vhx_varid" ) - call check( nf90_def_var(self%id, self%vhy_varname, self%out_type, [self%collider_dimid, self%eid_dimid, self%time_dimid], self%vhy_varid), "encounter_io_initialize_output nf90_def_var vhy_varid" ) - call check( nf90_def_var(self%id, self%vhz_varname, self%out_type, [self%collider_dimid, self%eid_dimid, self%time_dimid], self%vhz_varid), "encounter_io_initialize_output nf90_def_var vhz_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" ) + ! 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 @@ -128,24 +124,24 @@ module subroutine encounter_io_open_file(self, param, readonly) 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" ) + ! 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 @@ -167,29 +163,29 @@ module subroutine encounter_io_write_frame(self, iu, param) 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 + ! 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 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 b0a752863..e0b381aec 100644 --- a/src/io/io.f90 +++ b/src/io/io.f90 @@ -1381,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) 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/modules/swiftest_classes.f90 b/src/modules/swiftest_classes.f90 index 302d09eea..73ad063e6 100644 --- a/src/modules/swiftest_classes.f90 +++ b/src/modules/swiftest_classes.f90 @@ -244,11 +244,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 @@ -314,7 +314,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 @@ -396,7 +396,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. @@ -436,7 +436,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 @@ -688,11 +688,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 @@ -703,11 +703,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 @@ -1336,17 +1336,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 @@ -1618,7 +1618,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 @@ -1627,10 +1627,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 diff --git a/src/netcdf/netcdf.f90 b/src/netcdf/netcdf.f90 index 818fa3302..fd3bf2ec5 100644 --- a/src/netcdf/netcdf.f90 +++ b/src/netcdf/netcdf.f90 @@ -76,51 +76,37 @@ 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%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%id, 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%id, 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%id, 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%id, 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%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%id, 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%id, 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%id, 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%id, 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%id, 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%id, 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%id, 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%id, 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%id, 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(:) @@ -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%id, 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%id, 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%id, 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%id, 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%id, 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%id, 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%id, 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(:) @@ -208,7 +183,7 @@ module subroutine netcdf_initialize_output(self, param) ! 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, 3, nciu%space_dimid), "netcdf_initialize_output nf90_def_dim space_dimid" ) ! 3D space 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) @@ -228,19 +203,11 @@ module subroutine netcdf_initialize_output(self, param) 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" ) - call check( nf90_def_var(nciu%id, nciu%xhx_varname, nciu%out_type, [nciu%id_dimid, nciu%time_dimid], nciu%xhx_varid), "netcdf_initialize_output nf90_def_var xhx_varid" ) - call check( nf90_def_var(nciu%id, nciu%xhy_varname, nciu%out_type, [nciu%id_dimid, nciu%time_dimid], nciu%xhy_varid), "netcdf_initialize_output nf90_def_var xhy_varid" ) - call check( nf90_def_var(nciu%id, nciu%xhz_varname, nciu%out_type, [nciu%id_dimid, nciu%time_dimid], nciu%xhz_varid), "netcdf_initialize_output nf90_def_var xhz_varid" ) - call check( nf90_def_var(nciu%id, nciu%vhx_varname, nciu%out_type, [nciu%id_dimid, nciu%time_dimid], nciu%vhx_varid), "netcdf_initialize_output nf90_def_var vhx_varid" ) - call check( nf90_def_var(nciu%id, nciu%vhy_varname, nciu%out_type, [nciu%id_dimid, nciu%time_dimid], nciu%vhy_varid), "netcdf_initialize_output nf90_def_var vhy_varid" ) - call check( nf90_def_var(nciu%id, nciu%vhz_varname, nciu%out_type, [nciu%id_dimid, nciu%time_dimid], nciu%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(nciu%id, nciu%gr_pseudo_vhx_varname, nciu%out_type, [nciu%id_dimid, nciu%time_dimid], nciu%gr_pseudo_vhx_varid), "netcdf_initialize_output nf90_def_var gr_psuedo_vhx_varid" ) - call check( nf90_def_var(nciu%id, nciu%gr_pseudo_vhy_varname, nciu%out_type, [nciu%id_dimid, nciu%time_dimid], nciu%gr_pseudo_vhy_varid), "netcdf_initialize_output nf90_def_var gr_psuedo_vhy_varid" ) - call check( nf90_def_var(nciu%id, nciu%gr_pseudo_vhz_varname, nciu%out_type, [nciu%id_dimid, nciu%time_dimid], nciu%gr_pseudo_vhz_varid), "netcdf_initialize_output nf90_def_var gr_psuedo_vhz_varid" ) + 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 @@ -267,31 +234,19 @@ module subroutine netcdf_initialize_output(self, param) 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_xhx_varname, nciu%out_type, nciu%id_dimid, nciu%origin_xhx_varid), "netcdf_initialize_output nf90_def_var origin_xhx_varid" ) - call check( nf90_def_var(nciu%id, nciu%origin_xhy_varname, nciu%out_type, nciu%id_dimid, nciu%origin_xhy_varid), "netcdf_initialize_output nf90_def_var origin_xhy_varid" ) - call check( nf90_def_var(nciu%id, nciu%origin_xhz_varname, nciu%out_type, nciu%id_dimid, nciu%origin_xhz_varid), "netcdf_initialize_output nf90_def_var origin_xhz_varid" ) - call check( nf90_def_var(nciu%id, nciu%origin_vhx_varname, nciu%out_type, nciu%id_dimid, nciu%origin_vhx_varid), "netcdf_initialize_output nf90_def_var origin_vhx_varid" ) - call check( nf90_def_var(nciu%id, nciu%origin_vhy_varname, nciu%out_type, nciu%id_dimid, nciu%origin_vhy_varid), "netcdf_initialize_output nf90_def_var origin_vhy_varid" ) - call check( nf90_def_var(nciu%id, nciu%origin_vhz_varname, nciu%out_type, nciu%id_dimid, nciu%origin_vhz_varid), "netcdf_initialize_output nf90_def_var origin_vhz_varid" ) + 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_xhx_varname, nciu%out_type, nciu%id_dimid, nciu%discard_xhx_varid), "netcdf_initialize_output nf90_def_var discard_xhx_varid" ) - call check( nf90_def_var(nciu%id, nciu%discard_xhy_varname, nciu%out_type, nciu%id_dimid, nciu%discard_xhy_varid), "netcdf_initialize_output nf90_def_var discard_xhy_varid" ) - call check( nf90_def_var(nciu%id, nciu%discard_xhz_varname, nciu%out_type, nciu%id_dimid, nciu%discard_xhz_varid), "netcdf_initialize_output nf90_def_var discard_xhz_varid" ) - call check( nf90_def_var(nciu%id, nciu%discard_vhx_varname, nciu%out_type, nciu%id_dimid, nciu%discard_vhx_varid), "netcdf_initialize_output nf90_def_var discard_vhx_varid" ) - call check( nf90_def_var(nciu%id, nciu%discard_vhy_varname, nciu%out_type, nciu%id_dimid, nciu%discard_vhy_varid), "netcdf_initialize_output nf90_def_var discard_vhy_varid" ) - call check( nf90_def_var(nciu%id, nciu%discard_vhz_varname, nciu%out_type, nciu%id_dimid, nciu%discard_vhz_varid), "netcdf_initialize_output nf90_def_var discard_vhz_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%lrotation) then - call check( nf90_def_var(nciu%id, nciu%ip1_varname, nciu%out_type, [nciu%id_dimid, nciu%time_dimid], nciu%Ip1_varid), "netcdf_initialize_output nf90_def_var Ip1_varid" ) - call check( nf90_def_var(nciu%id, nciu%ip2_varname, nciu%out_type, [nciu%id_dimid, nciu%time_dimid], nciu%Ip2_varid), "netcdf_initialize_output nf90_def_var Ip2_varid" ) - call check( nf90_def_var(nciu%id, nciu%ip3_varname, nciu%out_type, [nciu%id_dimid, nciu%time_dimid], nciu%Ip3_varid), "netcdf_initialize_output nf90_def_var Ip3_varid" ) - call check( nf90_def_var(nciu%id, nciu%rotx_varname, nciu%out_type, [nciu%id_dimid, nciu%time_dimid], nciu%rotx_varid), "netcdf_initialize_output nf90_def_var rotx_varid" ) - call check( nf90_def_var(nciu%id, nciu%roty_varname, nciu%out_type, [nciu%id_dimid, nciu%time_dimid], nciu%roty_varid), "netcdf_initialize_output nf90_def_var roty_varid" ) - call check( nf90_def_var(nciu%id, nciu%rotz_varname, nciu%out_type, [nciu%id_dimid, nciu%time_dimid], nciu%rotz_varid), "netcdf_initialize_output nf90_def_var rotz_varid" ) + 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%ltides) then @@ -303,18 +258,12 @@ module subroutine netcdf_initialize_output(self, param) 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_orbx_varname, nciu%out_type, nciu%time_dimid, nciu%L_orbx_varid), "netcdf_initialize_output nf90_def_var L_orbx_varid" ) - call check( nf90_def_var(nciu%id, nciu%l_orby_varname, nciu%out_type, nciu%time_dimid, nciu%L_orby_varid), "netcdf_initialize_output nf90_def_var L_orby_varid" ) - call check( nf90_def_var(nciu%id, nciu%l_orbz_varname, nciu%out_type, nciu%time_dimid, nciu%L_orbz_varid), "netcdf_initialize_output nf90_def_var L_orbz_varid" ) - call check( nf90_def_var(nciu%id, nciu%l_spinx_varname, nciu%out_type, nciu%time_dimid, nciu%L_spinx_varid), "netcdf_initialize_output nf90_def_var L_spinx_varid" ) - call check( nf90_def_var(nciu%id, nciu%l_spiny_varname, nciu%out_type, nciu%time_dimid, nciu%L_spiny_varid), "netcdf_initialize_output nf90_def_var L_spiny_varid" ) - call check( nf90_def_var(nciu%id, nciu%l_spinz_varname, nciu%out_type, nciu%time_dimid, nciu%L_spinz_varid), "netcdf_initialize_output nf90_def_var L_spinz_varid" ) - call check( nf90_def_var(nciu%id, nciu%l_escapex_varname, nciu%out_type, nciu%time_dimid, nciu%L_escapex_varid), "netcdf_initialize_output nf90_def_var L_escapex_varid" ) - call check( nf90_def_var(nciu%id, nciu%l_escapey_varname, nciu%out_type, nciu%time_dimid, nciu%L_escapey_varid), "netcdf_initialize_output nf90_def_var L_escapey_varid" ) - call check( nf90_def_var(nciu%id, nciu%l_escapez_varname, nciu%out_type, nciu%time_dimid, nciu%L_escapez_varid), "netcdf_initialize_output nf90_def_var L_escapez_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" ) + 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 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" ) @@ -340,7 +289,7 @@ module subroutine netcdf_initialize_output(self, param) ! Take the file out of define mode call check( nf90_enddef(nciu%id), "netcdf_initialize_output nf90_enddef" ) - call check( nf90_put_var(nciu%id, nciu%space_varid, nciu%space_coords, start=[1], count=[3]), "netcdf_initialize_output nf90_put_var space" ) + 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 @@ -391,27 +340,13 @@ module subroutine netcdf_open(self, param, readonly) 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 - status = nf90_inq_varid(nciu%id, nciu%rh_varname, nciu%rh_varid) - status = nf90_inq_varid(nciu%id, nciu%vh_varname, nciu%vh_varid) - call check( nf90_inq_varid(nciu%id, nciu%xhx_varname, nciu%xhx_varid), "netcdf_open nf90_inq_varid xhx_varid" ) - call check( nf90_inq_varid(nciu%id, nciu%xhy_varname, nciu%xhy_varid), "netcdf_open nf90_inq_varid xhy_varid" ) - call check( nf90_inq_varid(nciu%id, nciu%xhz_varname, nciu%xhz_varid), "netcdf_open nf90_inq_varid xhz_varid" ) - call check( nf90_inq_varid(nciu%id, nciu%vhx_varname, nciu%vhx_varid), "netcdf_open nf90_inq_varid vhx_varid" ) - call check( nf90_inq_varid(nciu%id, nciu%vhy_varname, nciu%vhy_varid), "netcdf_open nf90_inq_varid vhy_varid" ) - call check( nf90_inq_varid(nciu%id, nciu%vhz_varname, nciu%vhz_varid), "netcdf_open nf90_inq_varid vhz_varid" ) + 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_vhx_varname, nciu%gr_pseudo_vhx_varid) + status = nf90_inq_varid(nciu%id, nciu%gr_pseudo_vh_varname, nciu%gr_pseudo_vh_varid) nciu%lpseudo_vel_exists = (status == nf90_noerr) - if (nciu%lpseudo_vel_exists) then - status = nf90_inq_varid(nciu%id, nciu%gr_pseudo_vhy_varname, nciu%gr_pseudo_vhy_varid) - nciu%lpseudo_vel_exists = (status == nf90_noerr) - if (nciu%lpseudo_vel_exists) then - status = nf90_inq_varid(nciu%id, nciu%gr_pseudo_vhz_varname, nciu%gr_pseudo_vhz_varid) - nciu%lpseudo_vel_exists = (status == nf90_noerr) - end if - end if 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 @@ -433,12 +368,8 @@ module subroutine netcdf_open(self, param, readonly) end if if (param%lrotation) then - call check( nf90_inq_varid(nciu%id, nciu%ip1_varname, nciu%Ip1_varid), "netcdf_open nf90_inq_varid Ip1_varid" ) - call check( nf90_inq_varid(nciu%id, nciu%ip2_varname, nciu%Ip2_varid), "netcdf_open nf90_inq_varid Ip2_varid" ) - call check( nf90_inq_varid(nciu%id, nciu%ip3_varname, nciu%Ip3_varid), "netcdf_open nf90_inq_varid Ip3_varid" ) - call check( nf90_inq_varid(nciu%id, nciu%rotx_varname, nciu%rotx_varid), "netcdf_open nf90_inq_varid rotx_varid" ) - call check( nf90_inq_varid(nciu%id, nciu%roty_varname, nciu%roty_varid), "netcdf_open nf90_inq_varid roty_varid" ) - call check( nf90_inq_varid(nciu%id, nciu%rotz_varname, nciu%rotz_varid), "netcdf_open nf90_inq_varid rotz_varid" ) + 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 @@ -466,20 +397,12 @@ module subroutine netcdf_open(self, param, readonly) 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_xhx_varname, nciu%origin_xhx_varid) - status = nf90_inq_varid(nciu%id, nciu%origin_xhy_varname, nciu%origin_xhy_varid) - status = nf90_inq_varid(nciu%id, nciu%origin_xhz_varname, nciu%origin_xhz_varid) - status = nf90_inq_varid(nciu%id, nciu%origin_vhx_varname, nciu%origin_vhx_varid) - status = nf90_inq_varid(nciu%id, nciu%origin_vhy_varname, nciu%origin_vhy_varid) - status = nf90_inq_varid(nciu%id, nciu%origin_vhz_varname, nciu%origin_vhz_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_xhx_varname, nciu%discard_xhx_varid) - status = nf90_inq_varid(nciu%id, nciu%discard_xhy_varname, nciu%discard_xhy_varid) - status = nf90_inq_varid(nciu%id, nciu%discard_xhz_varname, nciu%discard_xhz_varid) - status = nf90_inq_varid(nciu%id, nciu%discard_vhx_varname, nciu%discard_vhx_varid) - status = nf90_inq_varid(nciu%id, nciu%discard_vhy_varname, nciu%discard_vhy_varid) - status = nf90_inq_varid(nciu%id, nciu%discard_vhz_varname, nciu%discard_vhz_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 @@ -487,18 +410,12 @@ module subroutine netcdf_open(self, param, readonly) 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_orbx_varname, nciu%L_orbx_varid) - status = nf90_inq_varid(nciu%id, nciu%l_orby_varname, nciu%L_orby_varid) - status = nf90_inq_varid(nciu%id, nciu%l_orbz_varname, nciu%L_orbz_varid) - status = nf90_inq_varid(nciu%id, nciu%l_spinx_varname, nciu%L_spinx_varid) - status = nf90_inq_varid(nciu%id, nciu%l_spiny_varname, nciu%L_spiny_varid) - status = nf90_inq_varid(nciu%id, nciu%l_spinz_varname, nciu%L_spinz_varid) - status = nf90_inq_varid(nciu%id, nciu%l_escapex_varname, nciu%L_escapex_varid) - status = nf90_inq_varid(nciu%id, nciu%l_escapey_varname, nciu%L_escapey_varid) - status = nf90_inq_varid(nciu%id, nciu%l_escapez_varname, nciu%L_escapez_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) + 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 end associate @@ -519,8 +436,9 @@ module function netcdf_read_frame_system(self, nciu, param) result(ierr) ! 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 @@ -536,6 +454,7 @@ module function netcdf_read_frame_system(self, nciu, param) result(ierr) 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)) @@ -545,16 +464,16 @@ module function netcdf_read_frame_system(self, nciu, param) result(ierr) ! First filter out only the id slots that contain valid bodies if (param%in_form == "XV") then - call check( nf90_get_var(nciu%id, nciu%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(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(nciu%id, nciu%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, vectemp(:,:), start=[1, 1, tslot]), "netcdf_read_frame_system nf90_getvar Gmass_varid" ) + plmask(:) = vectemp(1,:) == vectemp(1,:) .and. validmask(:) tpmask(:) = .not. plmask(:) .and. validmask(:) plmask(1) = .false. ! This is the central body @@ -586,80 +505,62 @@ module function netcdf_read_frame_system(self, nciu, 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(nciu%id, nciu%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(nciu%id, nciu%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(nciu%id, nciu%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) + 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 if (param%lgr .and. nciu%lpseudo_vel_exists) then - call check( nf90_get_var(nciu%id, nciu%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(nciu%id, nciu%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(nciu%id, nciu%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) + 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%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(nciu%id, nciu%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%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) + 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(nciu%id, nciu%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(nciu%id, nciu%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(nciu%id, nciu%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(nciu%id, nciu%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(nciu%id, nciu%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(nciu%id, nciu%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)) @@ -668,7 +569,7 @@ module function netcdf_read_frame_system(self, nciu, param) result(ierr) end if - call check( nf90_get_var(nciu%id, nciu%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 @@ -684,13 +585,13 @@ module function netcdf_read_frame_system(self, nciu, param) result(ierr) pl%mass(:) = pl%Gmass(:) / param%GU if (param%lrhill_present) then - call check( nf90_get_var(nciu%id, nciu%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(nciu%id, nciu%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 @@ -705,29 +606,17 @@ module function netcdf_read_frame_system(self, nciu, param) result(ierr) end if if (param%lrotation) then - call check( nf90_get_var(nciu%id, nciu%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(nciu%id, nciu%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(nciu%id, nciu%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(nciu%id, nciu%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(nciu%id, nciu%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(nciu%id, nciu%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) @@ -813,7 +702,7 @@ module subroutine netcdf_read_hdr_system(self, nciu, param) allocate(plmask(idmax)) allocate(plmmask(idmax)) - call check( nf90_get_var(nciu%id, nciu%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_frame_system nf90_getvar Gmass_varid" ) plmask(:) = gmtemp(:) == gmtemp(:) tpmask(:) = .not. plmask(:) @@ -859,29 +748,17 @@ module subroutine netcdf_read_hdr_system(self, nciu, param) 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_orbx_varname, nciu%L_orbx_varid) - if (status == nf90_noerr) call check( nf90_get_var(nciu%id, nciu%L_orbx_varid, self%Lorbit(1), start=[tslot]), "netcdf_read_hdr_system nf90_getvar L_orbx_varid" ) - status = nf90_inq_varid(nciu%id, nciu%l_orby_varname, nciu%L_orby_varid) - if (status == nf90_noerr) call check( nf90_get_var(nciu%id, nciu%L_orby_varid, self%Lorbit(2), start=[tslot]), "netcdf_read_hdr_system nf90_getvar L_orby_varid" ) - status = nf90_inq_varid(nciu%id, nciu%l_orbz_varname, nciu%L_orbz_varid) - if (status == nf90_noerr) call check( nf90_get_var(nciu%id, nciu%L_orbz_varid, self%Lorbit(3), start=[tslot]), "netcdf_read_hdr_system nf90_getvar L_orbz_varid" ) - status = nf90_inq_varid(nciu%id, nciu%l_spinx_varname, nciu%L_spinx_varid) - if (status == nf90_noerr) call check( nf90_get_var(nciu%id, nciu%L_spinx_varid, self%Lspin(1), start=[tslot]), "netcdf_read_hdr_system nf90_getvar L_spinx_varid" ) - status = nf90_inq_varid(nciu%id, nciu%l_spiny_varname, nciu%L_spiny_varid) - if (status == nf90_noerr) call check( nf90_get_var(nciu%id, nciu%L_spiny_varid, self%Lspin(2), start=[tslot]), "netcdf_read_hdr_system nf90_getvar L_spiny_varid" ) - status = nf90_inq_varid(nciu%id, nciu%l_spinz_varname, nciu%L_spinz_varid) - if (status == nf90_noerr) call check( nf90_get_var(nciu%id, nciu%L_spinz_varid, self%Lspin(3), start=[tslot]), "netcdf_read_hdr_system nf90_getvar L_spinz_varid" ) - status = nf90_inq_varid(nciu%id, nciu%l_escapex_varname, nciu%L_escapex_varid) - if (status == nf90_noerr) call check( nf90_get_var(nciu%id, nciu%L_escapex_varid, self%Lescape(1), start=[tslot]), "netcdf_read_hdr_system nf90_getvar L_escapex_varid" ) - status = nf90_inq_varid(nciu%id, nciu%l_escapey_varname, nciu%L_escapey_varid) - if (status == nf90_noerr) call check( nf90_get_var(nciu%id, nciu%L_escapey_varid, self%Lescape(2), start=[tslot]), "netcdf_read_hdr_system nf90_getvar L_escapey_varid" ) - status = nf90_inq_varid(nciu%id, nciu%l_escapez_varname, nciu%L_escapez_varid) - if (status == nf90_noerr) call check( nf90_get_var(nciu%id, nciu%L_escapez_varid, self%Lescape(3), start=[tslot]), "netcdf_read_hdr_system nf90_getvar L_escapez_varid" ) - status = nf90_inq_varid(nciu%id, nciu%ecollisions_varname, nciu%Ecollisions_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) + 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) + 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 @@ -903,7 +780,7 @@ module subroutine netcdf_read_particle_info_system(self, nciu, param, plmask, tp ! 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 @@ -911,7 +788,7 @@ module subroutine netcdf_read_particle_info_system(self, nciu, param, plmask, tp ! 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)) @@ -1005,72 +882,36 @@ module subroutine netcdf_read_particle_info_system(self, nciu, param, plmask, tp call tp%info(i)%set_value(origin_time=rtemp(tpind(i))) end do - status = nf90_inq_varid(nciu%id, nciu%origin_xhx_varname, nciu%origin_xhx_varid) - if (status == nf90_noerr) then - call check( nf90_get_var(nciu%id, nciu%origin_xhx_varid, rtemp_arr(1,:)), "netcdf_read_particle_info_system nf90_getvar origin_xhx_varid" ) - else if ((param%out_form == "XV") .or. (param%out_form == "XVEL")) then - call check( nf90_get_var(nciu%id, nciu%xhx_varid, rtemp_arr(1,:)), "netcdf_read_particle_info_system nf90_getvar xhx_varid" ) - else - rtemp_arr(1,:) = 0._DP - end if - - status = nf90_inq_varid(nciu%id, nciu%origin_xhy_varname, nciu%origin_xhy_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(nciu%id, nciu%origin_xhy_varid, rtemp_arr(2,:)), "netcdf_read_particle_info_system nf90_getvar origin_xhy_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(nciu%id, nciu%xhy_varid, rtemp_arr(2,:)), "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(2,:) = 0._DP - end if - - status = nf90_inq_varid(nciu%id, nciu%origin_xhz_varname, nciu%origin_xhz_varid) - if (status == nf90_noerr) then - call check( nf90_get_var(nciu%id, nciu%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(nciu%id, nciu%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(nciu%id, nciu%origin_vhx_varname, nciu%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(nciu%id, nciu%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(nciu%id, nciu%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(nciu%id, nciu%origin_vhy_varname, nciu%origin_vhy_varid) - if (status == nf90_noerr) then - call check( nf90_get_var(nciu%id, nciu%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(nciu%id, nciu%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(nciu%id, nciu%origin_vhz_varname, nciu%origin_vhz_varid) - if (status == nf90_noerr) then - call check( nf90_get_var(nciu%id, nciu%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(nciu%id, nciu%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(nciu%id, nciu%collision_id_varname, nciu%collision_id_varid) @@ -1102,60 +943,32 @@ module subroutine netcdf_read_particle_info_system(self, nciu, param, plmask, tp call tp%info(i)%set_value(discard_time=rtemp(tpind(i))) end do - status = nf90_inq_varid(nciu%id, nciu%discard_xhx_varname, nciu%discard_xhx_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(nciu%id, nciu%discard_xhx_varid, rtemp_arr(1,:)), "netcdf_read_particle_info_system nf90_getvar discard_xhx_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(1,:) = 0.0_DP - end if - - status = nf90_inq_varid(nciu%id, nciu%discard_xhy_varname, nciu%discard_xhy_varid) - if (status == nf90_noerr) then - call check( nf90_get_var(nciu%id, nciu%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(nciu%id, nciu%discard_xhz_varname, nciu%discard_xhz_varid) - if (status == nf90_noerr) then - call check( nf90_get_var(nciu%id, nciu%discard_xhz_varid, rtemp_arr(3,:)), "netcdf_read_particle_info_system nf90_getvar discard_xhz_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(nciu%id, nciu%discard_vhx_varname, nciu%discard_vhx_varid) - if (status == nf90_noerr) then - call check( nf90_get_var(nciu%id, nciu%discard_vhx_varid, rtemp_arr(1,:)), "netcdf_read_particle_info_system nf90_getvar discard_vhx_varid" ) - else - rtemp_arr(1,:) = 0.0_DP - end if - - status = nf90_inq_varid(nciu%id, nciu%discard_vhy_varname, nciu%discard_vhy_varid) - if (status == nf90_noerr) then - call check( nf90_get_var(nciu%id, nciu%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(nciu%id, nciu%discard_vhz_varname, nciu%discard_vhz_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(nciu%id, nciu%discard_vhz_varid, rtemp_arr(3,:)), "netcdf_read_particle_info_system nf90_getvar discard_vhz_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(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 @@ -1213,36 +1026,26 @@ module subroutine netcdf_write_frame_base(self, nciu, 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(nciu%id, nciu%rh_varid, self%xh(:, j), start=[1,idslot, tslot], count=[3,1,1]), "netcdf_write_frame_base nf90_put_var rh_varid" ) - call check( nf90_put_var(nciu%id, nciu%vh_varid, self%vh(:, j), start=[1,idslot, tslot], count=[3,1,1]), "netcdf_write_frame_base nf90_put_var vh_varid" ) - call check( nf90_put_var(nciu%id, nciu%xhx_varid, self%xh(1, j), start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var xhx_varid" ) - call check( nf90_put_var(nciu%id, nciu%xhy_varid, self%xh(2, j), start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var xhy_varid" ) - call check( nf90_put_var(nciu%id, nciu%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(nciu%id, nciu%vhx_varid, vh(1), start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var vhx_varid (gr case)" ) - call check( nf90_put_var(nciu%id, nciu%vhy_varid, vh(2), start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var vhy_varid (gr case)" ) - call check( nf90_put_var(nciu%id, nciu%vhz_varid, vh(3), start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var vhz_varid (gr case)" ) - call check( nf90_put_var(nciu%id, nciu%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(nciu%id, nciu%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(nciu%id, nciu%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(nciu%id, nciu%vhx_varid, self%vh(1, j), start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var vhx_varid" ) - call check( nf90_put_var(nciu%id, nciu%vhy_varid, self%vh(2, j), start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var vhy_varid" ) - call check( nf90_put_var(nciu%id, nciu%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) 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) end if @@ -1262,12 +1065,8 @@ module subroutine netcdf_write_frame_base(self, nciu, param) end if 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 radius_varid" ) if (param%lrotation) then - call check( nf90_put_var(nciu%id, nciu%Ip1_varid, self%Ip(1, j), start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var Ip1_varid" ) - call check( nf90_put_var(nciu%id, nciu%Ip2_varid, self%Ip(2, j), start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var Ip2_varid" ) - call check( nf90_put_var(nciu%id, nciu%Ip3_varid, self%Ip(3, j), start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var Ip3_varid" ) - call check( nf90_put_var(nciu%id, nciu%rotx_varid, self%rot(1, j), start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var rotx_varid" ) - call check( nf90_put_var(nciu%id, nciu%roty_varid, self%rot(2, j), start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var roty_varid" ) - call check( nf90_put_var(nciu%id, nciu%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 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 rotx_varid" ) end if ! if (param%ltides) then ! call check( nf90_put_var(nciu%id, nciu%k2_varid, self%k2(j), start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var k2_varid" ) @@ -1286,12 +1085,8 @@ module subroutine netcdf_write_frame_base(self, nciu, param) 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(nciu%id, nciu%Ip1_varid, self%Ip(1), start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var cb Ip1_varid" ) - call check( nf90_put_var(nciu%id, nciu%Ip2_varid, self%Ip(2), start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var cb Ip2_varid" ) - call check( nf90_put_var(nciu%id, nciu%Ip3_varid, self%Ip(3), start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var cb Ip3_varid" ) - call check( nf90_put_var(nciu%id, nciu%rotx_varid, self%rot(1), start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var cb rotx_varid" ) - call check( nf90_put_var(nciu%id, nciu%roty_varid, self%rot(2), start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var cb roty_varid" ) - call check( nf90_put_var(nciu%id, nciu%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(nciu%id, nciu%k2_varid, self%k2, start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var cb k2_varid" ) @@ -1365,21 +1160,13 @@ module subroutine netcdf_write_info_base(self, nciu, param) charstring = trim(adjustl(self%info(j)%origin_type)) 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_xhx_varid, self%info(j)%origin_xh(1), start=[idslot]), "netcdf_write_info_base nf90_put_var origin_xhx_varid" ) - call check( nf90_put_var(nciu%id, nciu%origin_xhy_varid, self%info(j)%origin_xh(2), start=[idslot]), "netcdf_write_info_base nf90_put_var origin_xhy_varid" ) - call check( nf90_put_var(nciu%id, nciu%origin_xhz_varid, self%info(j)%origin_xh(3), start=[idslot]), "netcdf_write_info_base nf90_put_var origin_xhz_varid" ) - call check( nf90_put_var(nciu%id, nciu%origin_vhx_varid, self%info(j)%origin_vh(1), start=[idslot]), "netcdf_write_info_base nf90_put_var origin_vhx_varid" ) - call check( nf90_put_var(nciu%id, nciu%origin_vhy_varid, self%info(j)%origin_vh(2), start=[idslot]), "netcdf_write_info_base nf90_put_var origin_vhy_varid" ) - call check( nf90_put_var(nciu%id, nciu%origin_vhz_varid, self%info(j)%origin_vh(3), start=[idslot]), "netcdf_write_info_base nf90_put_var origin_vhz_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(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_xhx_varid, self%info(j)%discard_xh(1), start=[idslot]), "netcdf_write_info_base nf90_put_var discard_xhx_varid" ) - call check( nf90_put_var(nciu%id, nciu%discard_xhy_varid, self%info(j)%discard_xh(2), start=[idslot]), "netcdf_write_info_base nf90_put_var discard_xhy_varid" ) - call check( nf90_put_var(nciu%id, nciu%discard_xhz_varid, self%info(j)%discard_xh(3), start=[idslot]), "netcdf_write_info_base nf90_put_var discard_xhz_varid" ) - call check( nf90_put_var(nciu%id, nciu%discard_vhx_varid, self%info(j)%discard_vh(1), start=[idslot]), "netcdf_write_info_base nf90_put_var discard_vhx_varid" ) - call check( nf90_put_var(nciu%id, nciu%discard_vhy_varid, self%info(j)%discard_vh(2), start=[idslot]), "netcdf_write_info_base nf90_put_var discard_vhy_varid" ) - call check( nf90_put_var(nciu%id, nciu%discard_vhz_varid, self%info(j)%discard_vh(3), start=[idslot]), "netcdf_write_info_base nf90_put_var discard_vhz_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 @@ -1403,21 +1190,13 @@ module subroutine netcdf_write_info_base(self, nciu, param) 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_xhx_varid, self%info%origin_xh(1), start=[idslot]), "netcdf_write_info_base nf90_put_var cb origin_xhx_varid" ) - call check( nf90_put_var(nciu%id, nciu%origin_xhy_varid, self%info%origin_xh(2), start=[idslot]), "netcdf_write_info_base nf90_put_var cb origin_xhy_varid" ) - call check( nf90_put_var(nciu%id, nciu%origin_xhz_varid, self%info%origin_xh(3), start=[idslot]), "netcdf_write_info_base nf90_put_var cb origin_xhz_varid" ) - call check( nf90_put_var(nciu%id, nciu%origin_vhx_varid, self%info%origin_vh(1), start=[idslot]), "netcdf_write_info_base nf90_put_var cb origin_vhx_varid" ) - call check( nf90_put_var(nciu%id, nciu%origin_vhy_varid, self%info%origin_vh(2), start=[idslot]), "netcdf_write_info_base nf90_put_var cb origin_vhy_varid" ) - call check( nf90_put_var(nciu%id, nciu%origin_vhz_varid, self%info%origin_vh(3), start=[idslot]), "netcdf_write_info_base nf90_put_var cb origin_vhz_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(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_xhx_varid, self%info%discard_xh(1), start=[idslot]), "netcdf_write_info_base nf90_put_var cb discard_xhx_varid" ) - call check( nf90_put_var(nciu%id, nciu%discard_xhy_varid, self%info%discard_xh(2), start=[idslot]), "netcdf_write_info_base nf90_put_var cb discard_xhy_varid" ) - call check( nf90_put_var(nciu%id, nciu%discard_xhz_varid, self%info%discard_xh(3), start=[idslot]), "netcdf_write_info_base nf90_put_var cb discard_xhz_varid" ) - call check( nf90_put_var(nciu%id, nciu%discard_vhx_varid, self%info%discard_vh(1), start=[idslot]), "netcdf_write_info_base nf90_put_var cb discard_vhx_varid" ) - call check( nf90_put_var(nciu%id, nciu%discard_vhy_varid, self%info%discard_vh(2), start=[idslot]), "netcdf_write_info_base nf90_put_var cb discard_vhy_varid" ) - call check( nf90_put_var(nciu%id, nciu%discard_vhz_varid, self%info%discard_vh(3), start=[idslot]), "netcdf_write_info_base nf90_put_var cb discard_vhz_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 @@ -1455,15 +1234,9 @@ module subroutine netcdf_write_hdr_system(self, nciu, param) 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_orbx_varid, self%Lorbit(1), start=[tslot]), "netcdf_write_hdr_system nf90_put_var L_orbx_varid" ) - call check( nf90_put_var(nciu%id, nciu%L_orby_varid, self%Lorbit(2), start=[tslot]), "netcdf_write_hdr_system nf90_put_var L_orby_varid" ) - call check( nf90_put_var(nciu%id, nciu%L_orbz_varid, self%Lorbit(3), start=[tslot]), "netcdf_write_hdr_system nf90_put_var L_orbz_varid" ) - call check( nf90_put_var(nciu%id, nciu%L_spinx_varid, self%Lspin(1), start=[tslot]), "netcdf_write_hdr_system nf90_put_var L_spinx_varid" ) - call check( nf90_put_var(nciu%id, nciu%L_spiny_varid, self%Lspin(2), start=[tslot]), "netcdf_write_hdr_system nf90_put_var L_spiny_varid" ) - call check( nf90_put_var(nciu%id, nciu%L_spinz_varid, self%Lspin(3), start=[tslot]), "netcdf_write_hdr_system nf90_put_var L_spinz_varid" ) - call check( nf90_put_var(nciu%id, nciu%L_escapex_varid, self%Lescape(1), start=[tslot]), "netcdf_write_hdr_system nf90_put_var L_escapex_varid" ) - call check( nf90_put_var(nciu%id, nciu%L_escapey_varid, self%Lescape(2), start=[tslot]), "netcdf_write_hdr_system nf90_put_var L_escapey_varid" ) - call check( nf90_put_var(nciu%id, nciu%L_escapez_varid, self%Lescape(3), start=[tslot]), "netcdf_write_hdr_system nf90_put_var L_escapez_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" ) 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..014fe9bae 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 @@ -885,7 +885,7 @@ 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)) 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 04ec18b46..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)) @@ -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%tcollision(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_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 1cfa81c88..b955d4998 100644 --- a/src/symba/symba_encounter_check.f90 +++ b/src/symba/symba_encounter_check.f90 @@ -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 @@ -65,8 +65,8 @@ 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%xh(:,i) - plplenc_list%x2(:,k) = pl%xh(:,j) + 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(:) plplenc_list%Gmass1(k) = pl%Gmass(i) @@ -151,7 +151,7 @@ module function symba_encounter_check(self, param, system, dt, irec) result(lany 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)) @@ -166,7 +166,7 @@ module function symba_encounter_check(self, param, system, dt, irec) result(lany 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)) @@ -229,7 +229,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_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_util.f90 b/src/symba/symba_util.f90 index b7cc9c915..621287433 100644 --- a/src/symba/symba_util.f90 +++ b/src/symba/symba_util.f90 @@ -534,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 @@ -558,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 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 6674cf431..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 & ) 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)) From 2afdbec23831233241949d459f68221252d75bed Mon Sep 17 00:00:00 2001 From: David A Minton Date: Sat, 3 Dec 2022 15:58:37 -0500 Subject: [PATCH 220/569] Started the process of converting Python code to the SPACE DIMENSION. Still a ways to go. --- python/swiftest/swiftest/init_cond.py | 7 +- python/swiftest/swiftest/io.py | 54 +++++++------- python/swiftest/swiftest/simulation_class.py | 74 +++++++++----------- 3 files changed, 64 insertions(+), 71 deletions(-) diff --git a/python/swiftest/swiftest/init_cond.py b/python/swiftest/swiftest/init_cond.py index fb7ae2fbd..147a954ce 100644 --- a/python/swiftest/swiftest/init_cond.py +++ b/python/swiftest/swiftest/init_cond.py @@ -192,6 +192,9 @@ def solar_system_horizons(plname: str, v4 = pldata[plname].vectors()['vx'][0] * VCONV v5 = pldata[plname].vectors()['vy'][0] * VCONV v6 = pldata[plname].vectors()['vz'][0] * VCONV + + rh = pldata[plname].vectors()[['x','y','z']][0] * DCONV + vh = pldata[plname].vectors()[['vx','vy','vz']][0] * VCONV elif param['IN_FORM'] == 'EL': v1 = pldata[plname].elements()['a'][0] * DCONV v2 = pldata[plname].elements()['e'][0] @@ -276,13 +279,13 @@ def vec2xr(param: Dict, namevals : v1 : array of floats - xh + rh v2 : array of floats yh v3 : array of floats zh v4 : array of floats - vhxh + vhrh v5 : array of floats vhyh v6 : array of floats diff --git a/python/swiftest/swiftest/io.py b/python/swiftest/swiftest/io.py index 7a67f9a8a..dc2899d16 100644 --- a/python/swiftest/swiftest/io.py +++ b/python/swiftest/swiftest/io.py @@ -529,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') @@ -577,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') @@ -619,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", @@ -1013,7 +1013,7 @@ def swiftest_particle_stream(f): ID of massive bodie origin_type : string The origin type for the body (Initial conditions, disruption, supercatastrophic, hit and run, etc) - origin_xh : float array + origin_rh : float array The origin heliocentric position vector origin_vh : float array The origin heliocentric velocity vector @@ -1043,7 +1043,7 @@ def swiftest_particle_2xr(param): ------- infoxr : xarray dataset """ - veclab = ['time_origin', 'xhx_origin', 'py_origin', 'pz_origin', 'vhx_origin', 'vhy_origin', 'vhz_origin'] + veclab = ['time_origin', 'rhx_origin', 'py_origin', 'pz_origin', 'vhx_origin', 'vhy_origin', 'vhz_origin'] id_list = [] origin_type_list = [] origin_vec_list = [] @@ -1100,7 +1100,7 @@ def select_active_from_frame(ds, param, framenum=-1): # Select only the active particles at this time step # Remove the inactive particles if param['OUT_FORM'] == 'XV' or param['OUT_FORM'] == 'XVEL': - iactive = iframe[count_dim].where((~np.isnan(iframe['Gmass'])) | (~np.isnan(iframe['xhx'])), drop=True)[count_dim] + iactive = iframe[count_dim].where((~np.isnan(iframe['Gmass'])) | (~np.isnan(iframe['rhx'])), drop=True)[count_dim] else: iactive = iframe[count_dim].where((~np.isnan(iframe['Gmass'])) | (~np.isnan(iframe['a'])), drop = True)[count_dim] if count_dim == "id": @@ -1197,7 +1197,7 @@ def swiftest_xr2infile(ds, param, in_type="NETCDF_DOUBLE", infile_name=None,fram if param['CHK_CLOSE']: print(pli['radius'].values[0], file=plfile) if param['IN_FORM'] == 'XV': - print(pli['xhx'].values[0], pli['xhy'].values[0], pli['xhz'].values[0], file=plfile) + print(pli['rhx'].values[0], pli['rhy'].values[0], pli['rhz'].values[0], file=plfile) print(pli['vhx'].values[0], pli['vhy'].values[0], pli['vhz'].values[0], file=plfile) elif param['IN_FORM'] == 'EL': print(pli['a'].values[0], pli['e'].values[0], pli['inc'].values[0], file=plfile) @@ -1216,7 +1216,7 @@ def swiftest_xr2infile(ds, param, in_type="NETCDF_DOUBLE", infile_name=None,fram tpi = tp.sel(id=i) print(tpi['name'].values[0], file=tpfile) if param['IN_FORM'] == 'XV': - print(tpi['xhx'].values[0], tpi['xhy'].values[0], tpi['xhz'].values[0], file=tpfile) + print(tpi['rhx'].values[0], tpi['rhy'].values[0], tpi['rhz'].values[0], file=tpfile) print(tpi['vhx'].values[0], tpi['vhy'].values[0], tpi['vhz'].values[0], file=tpfile) elif param['IN_FORM'] == 'EL': print(tpi['a'].values[0], tpi['e'].values[0], tpi['inc'].values[0], file=tpfile) @@ -1280,7 +1280,7 @@ def swifter_xr2infile(ds, param, framenum=-1): print(i.values, pli['Gmass'].values, file=plfile) if param['CHK_CLOSE']: print(pli['radius'].values, file=plfile) - print(pli['xhx'].values, pli['xhy'].values, pli['xhz'].values, file=plfile) + print(pli['rhx'].values, pli['rhy'].values, pli['rhz'].values, file=plfile) print(pli['vhx'].values, pli['vhy'].values, pli['vhz'].values, file=plfile) plfile.close() @@ -1290,7 +1290,7 @@ def swifter_xr2infile(ds, param, framenum=-1): for i in tp.id: tpi = tp.sel(id=i) print(i.values, file=tpfile) - print(tpi['xhx'].values, tpi['xhy'].values, tpi['xhz'].values, file=tpfile) + print(tpi['rhx'].values, tpi['rhy'].values, tpi['rhz'].values, file=tpfile) print(tpi['vhx'].values, tpi['vhy'].values, tpi['vhz'].values, file=tpfile) tpfile.close() else: @@ -1461,10 +1461,10 @@ def swift2swifter(swift_param, plname="", tpname="", conversion_questions={}): print(plrad, file=plnew) line = plold.readline() i_list = [i for i in re.split(' +|\t',line) if i.strip()] - xh = real2float(i_list[0]) + rh = real2float(i_list[0]) yh = real2float(i_list[1]) zh = real2float(i_list[2]) - print(xh, yh, zh, file=plnew) + print(rh, yh, zh, file=plnew) line = plold.readline() i_list = [i for i in re.split(' +|\t',line) if i.strip()] vhx = real2float(i_list[0]) @@ -1500,10 +1500,10 @@ def swift2swifter(swift_param, plname="", tpname="", conversion_questions={}): print(npl + n + 1, file=tpnew) line = tpold.readline() i_list = [i for i in re.split(' +|\t',line) if i.strip()] - xh = real2float(i_list[0]) + rh = real2float(i_list[0]) yh = real2float(i_list[1]) zh = real2float(i_list[2]) - print(xh, yh, zh, file=tpnew) + print(rh, yh, zh, file=tpnew) line = tpold.readline() i_list = [i for i in re.split(' +|\t',line) if i.strip()] vhx = real2float(i_list[0]) @@ -1589,10 +1589,10 @@ def swifter2swiftest(swifter_param, plname="", tpname="", cbname="", conversion_ print(plrad, file=plnew) line = plold.readline() i_list = [i for i in re.split(' +|\t',line) if i.strip()] - xh = real2float(i_list[0]) + rh = real2float(i_list[0]) yh = real2float(i_list[1]) zh = real2float(i_list[2]) - print(xh, yh, zh, file=plnew) + print(rh, yh, zh, file=plnew) line = plold.readline() i_list = [i for i in re.split(' +|\t',line) if i.strip()] vhx = real2float(i_list[0]) @@ -1633,10 +1633,10 @@ def swifter2swiftest(swifter_param, plname="", tpname="", cbname="", conversion_ print(name, file=tpnew) line = tpold.readline() i_list = [i for i in re.split(' +|\t',line) if i.strip()] - xh = real2float(i_list[0]) + rh = real2float(i_list[0]) yh = real2float(i_list[1]) zh = real2float(i_list[2]) - print(xh, yh, zh, file=tpnew) + print(rh, yh, zh, file=tpnew) line = tpold.readline() i_list = [i for i in re.split(' +|\t',line) if i.strip()] vhx = real2float(i_list[0]) diff --git a/python/swiftest/swiftest/simulation_class.py b/python/swiftest/swiftest/simulation_class.py index 9e1279a79..9e4840f78 100644 --- a/python/swiftest/swiftest/simulation_class.py +++ b/python/swiftest/swiftest/simulation_class.py @@ -2273,13 +2273,13 @@ 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, + 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, @@ -2308,19 +2308,19 @@ def add_body(self, idvals : 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 +2332,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 +2400,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) + 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(capm,"f",nbodies) + omega,nbodies = input_to_array(omega,"f",nbodies) + capm,nbodies = input_to_array(capm,"f",nbodies) idvals,nbodies = input_to_array(idvals,"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) @@ -2447,13 +2437,13 @@ def input_to_array_3d(val,n=None): t = self.param['TSTART'] - if xh is not None: + if rh 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!") + raise ValueError("Cannot use rh and v1,v2,v3 inputs simultaneously!") else: - v1 = xh.T[0] - v2 = xh.T[1] - v3 = xh.T[2] + v1 = rh.T[0] + v2 = rh.T[1] + v3 = rh.T[2] if vh is not None: if v4 is not None or v5 is not None or v6 is not None: From d1167535c88997bf78599db3e20f91543aeaee45 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Sat, 3 Dec 2022 16:49:45 -0500 Subject: [PATCH 221/569] Converted init.solar_system_horizons function to the SPACE DIMENSION --- python/swiftest/swiftest/init_cond.py | 92 +++++++++++---------------- 1 file changed, 37 insertions(+), 55 deletions(-) diff --git a/python/swiftest/swiftest/init_cond.py b/python/swiftest/swiftest/init_cond.py index 147a954ce..693c206d9 100644 --- a/python/swiftest/swiftest/init_cond.py +++ b/python/swiftest/swiftest/init_cond.py @@ -135,38 +135,37 @@ def solar_system_horizons(plname: str, solarpole = SkyCoord(ra=286.13 * u.degree, dec=63.87 * u.degree) solarrot = planetrot['Sun'] * param['TU2S'] rotcb = solarpole.cartesian * solarrot + rotcb = np.array([rotcb.x.value, rotcb.y.value, rotcb.z.value]) Ipsun = np.array([0.0, 0.0, planetIpz['Sun']]) param_tmp = param param_tmp['OUT_FORM'] = 'XVEL' + rh = None + vh = None + a = None + e = None + inc = None + capom = None + omega = None + capm = None + Ip = None + rot = None + rhill = None + GMpl = None + Rpl = None + J2 = None + J4 = None + if plname == "Sun" : # Create central body print("Creating the Sun as a central body") - v1 = None - v2 = None - v3 = None - v4 = None - v5 = None - v6 = None - rhill = None GMpl = GMcb Rpl = Rcb J2 = J2RP2 J4 = J4RP4 if param['ROTATION']: - Ip1 = Ipsun[0] - Ip2 = Ipsun[1] - Ip3 = Ipsun[2] - rotx = rotcb.x.value - roty = rotcb.y.value - rotz = rotcb.z.value - else: - Ip1 = None - Ip2 = None - Ip3 = None - rotx = None - roty = None - rotz = None + Ip = Ipsun + rot = rotcb else: # Fetch solar system ephemerides from Horizons print(f"Fetching ephemerides data for {plname} from JPL/Horizons") @@ -177,44 +176,38 @@ def solar_system_horizons(plname: str, ephemerides_end_date = tend.isoformat() ephemerides_step = '1d' - J2 = None - J4 = None - pldata = {} pldata[plname] = Horizons(id=idval, location='@sun', epochs={'start': ephemerides_start_date, 'stop': ephemerides_end_date, 'step': ephemerides_step}) if param['IN_FORM'] == 'XV': - v1 = pldata[plname].vectors()['x'][0] * DCONV - v2 = pldata[plname].vectors()['y'][0] * DCONV - v3 = pldata[plname].vectors()['z'][0] * DCONV - v4 = pldata[plname].vectors()['vx'][0] * VCONV - v5 = pldata[plname].vectors()['vy'][0] * VCONV - v6 = pldata[plname].vectors()['vz'][0] * VCONV + rx = pldata[plname].vectors()['x'][0] * DCONV + ry = pldata[plname].vectors()['y'][0] * DCONV + rz = pldata[plname].vectors()['z'][0] * DCONV + vx = pldata[plname].vectors()['vx'][0] * VCONV + vy = pldata[plname].vectors()['vy'][0] * VCONV + vz = pldata[plname].vectors()['vz'][0] * VCONV - rh = pldata[plname].vectors()[['x','y','z']][0] * DCONV - vh = pldata[plname].vectors()[['vx','vy','vz']][0] * VCONV + rh = np.array([rx,ry,rz]) + vh = np.array([vx,vy,vz]) elif param['IN_FORM'] == 'EL': - v1 = pldata[plname].elements()['a'][0] * DCONV - v2 = pldata[plname].elements()['e'][0] - v3 = pldata[plname].elements()['incl'][0] - v4 = pldata[plname].elements()['Omega'][0] - v5 = pldata[plname].elements()['w'][0] - v6 = pldata[plname].elements()['M'][0] + a = pldata[plname].elements()['a'][0] * DCONV + e = pldata[plname].elements()['e'][0] + inc = pldata[plname].elements()['incl'][0] + capom = pldata[plname].elements()['Omega'][0] + omega = pldata[plname].elements()['w'][0] + capm = pldata[plname].elements()['M'][0] if ispl: GMpl = GMcb / MSun_over_Mpl[plname] if param['CHK_CLOSE']: Rpl = planetradius[plname] * DCONV - else: - Rpl = None # Generate planet value vectors if (param['RHILL_PRESENT']): rhill = pldata[plname].elements()['a'][0] * DCONV * (3 * MSun_over_Mpl[plname]) ** (-THIRDLONG) - else: - rhill = None + if (param['ROTATION']): RA = pldata[plname].ephemerides()['NPole_RA'][0] DEC = pldata[plname].ephemerides()['NPole_DEC'][0] @@ -222,20 +215,9 @@ def solar_system_horizons(plname: str, rotpole = SkyCoord(ra=RA * u.degree, dec=DEC * u.degree) rotrate = planetrot[plname] * param['TU2S'] rot = rotpole.cartesian * rotrate + rot = np.array([rot.x.value, rot.y.value, rot.z.value]) Ip = np.array([0.0, 0.0, planetIpz[plname]]) - Ip1 = Ip[0] - Ip2 = Ip[1] - Ip3 = Ip[2] - rotx = rot.x.value - roty = rot.y.value - rotz = rot.z.value - else: - Ip1 = None - Ip2 = None - Ip3 = None - rotx = None - roty = None - rotz = None + else: GMpl = None @@ -244,7 +226,7 @@ def solar_system_horizons(plname: str, else: plid = idval - return plname,v1,v2,v3,v4,v5,v6,idval,GMpl,Rpl,rhill,Ip1,Ip2,Ip3,rotx,roty,rotz,J2,J4 + return plname,idval,a,e,inc,capom,omega,capm,rh,vh,GMpl,Rpl,rhill,Ip,rot,J2,J4 def vec2xr(param: Dict, namevals: npt.NDArray[np.str_], From 68b176afcede7e6a36789ba12532bd334d0479ad Mon Sep 17 00:00:00 2001 From: David A Minton Date: Sat, 3 Dec 2022 19:36:38 -0500 Subject: [PATCH 222/569] Continued my quest to bring the Python code into THE SPACE DIMENSION --- python/swiftest/swiftest/init_cond.py | 164 +++++++++---------- python/swiftest/swiftest/simulation_class.py | 91 +++------- 2 files changed, 102 insertions(+), 153 deletions(-) diff --git a/python/swiftest/swiftest/init_cond.py b/python/swiftest/swiftest/init_cond.py index 693c206d9..d2e6bd51f 100644 --- a/python/swiftest/swiftest/init_cond.py +++ b/python/swiftest/swiftest/init_cond.py @@ -141,25 +141,25 @@ def solar_system_horizons(plname: str, param_tmp = param param_tmp['OUT_FORM'] = 'XVEL' - rh = None - vh = None + rh = np.full(3,np.nan) + vh = np.full(3,np.nan) a = None e = None inc = None capom = None omega = None capm = None - Ip = None - rot = None + Ip = np.full(3,np.nan) + rot = np.full(3,np.nan) rhill = None - GMpl = None + Gmass = None Rpl = None J2 = None J4 = None if plname == "Sun" : # Create central body print("Creating the Sun as a central body") - GMpl = GMcb + Gmass = GMcb Rpl = Rcb J2 = J2RP2 J4 = J4RP4 @@ -200,7 +200,7 @@ def solar_system_horizons(plname: str, capm = pldata[plname].elements()['M'][0] if ispl: - GMpl = GMcb / MSun_over_Mpl[plname] + Gmass = GMcb / MSun_over_Mpl[plname] if param['CHK_CLOSE']: Rpl = planetradius[plname] * DCONV @@ -219,33 +219,31 @@ def solar_system_horizons(plname: str, Ip = np.array([0.0, 0.0, planetIpz[plname]]) else: - GMpl = None + Gmass = None if idval is None: plid = planetid[plname] else: plid = idval - return plname,idval,a,e,inc,capom,omega,capm,rh,vh,GMpl,Rpl,rhill,Ip,rot,J2,J4 + return plname,idval,a,e,inc,capom,omega,capm,rh,vh,Gmass,Rpl,rhill,Ip,rot,J2,J4 def vec2xr(param: Dict, - namevals: npt.NDArray[np.str_], - v1: npt.NDArray[np.float_], - v2: npt.NDArray[np.float_], - v3: npt.NDArray[np.float_], - v4: npt.NDArray[np.float_], - v5: npt.NDArray[np.float_], - v6: npt.NDArray[np.float_], - idvals: npt.NDArray[np.int_], - GMpl: npt.NDArray[np.float_] | None=None, - Rpl: npt.NDArray[np.float_] | None=None, + name: npt.NDArray[np.str_] | None=None, + id: npt.NDArray[np.int_] | None=None, + a: npt.NDArray[np.float_] | None=None, + e: npt.NDArray[np.float_] | None=None, + inc: npt.NDArray[np.float_] | None=None, + capom: npt.NDArray[np.float_] | None=None, + omega: npt.NDArray[np.float_] | None=None, + capm: npt.NDArray[np.float_] | None=None, + rh: npt.NDArray[np.int_] | None=None, + vh: npt.NDArray[np.int_] | None=None, + Gmass: npt.NDArray[np.float_] | None=None, + radius: npt.NDArray[np.float_] | None=None, rhill: npt.NDArray[np.float_] | None=None, - Ip1: npt.NDArray[np.float_] | None=None, - Ip2: npt.NDArray[np.float_] | None=None, - Ip3: npt.NDArray[np.float_] | None=None, - rotx: npt.NDArray[np.float_] | None=None, - roty: npt.NDArray[np.float_] | None=None, - rotz: npt.NDArray[np.float_] | None=None, + Ip: npt.NDArray[np.float_] | None=None, + rot: npt.NDArray[np.float_] | None=None, J2: npt.NDArray[np.float_] | None=None, J4: npt.NDArray[np.float_] | None=None, t: float=0.0): @@ -256,76 +254,66 @@ def vec2xr(param: Dict, ---------- param : dict Swiftest paramuration parameters. - idvals : integer - Array of body index values. - namevals : - - v1 : array of floats - rh - v2 : array of floats - yh - v3 : array of floats - zh - v4 : array of floats - vhrh - v5 : array of floats - vhyh - v6 : array of floats - vhzh - GMpl : array of floats - G*mass - Rpl : array of floats - radius - rhill : array of floats - Hill Radius - Ip1 : array of floats - Principal axes moments of inertia - Ip2 : array of floats - Principal axes moments of inertia - Ip3 : array of floats - Principal axes moments of inertia - rox : array of floats - Rotation rate vector - roty : array of floats - Rotation rate vector - rotz : array of floats - Rotation rate vector + name : str or array-like of str, optional + Name or names of Bodies. If none passed, name will be "Body" + id : int or array-like of int, optional + Unique id values. If not passed, an id will be assigned in ascending order starting from the pre-existing + Dataset ids. + a : float or array-like of float, optional + semimajor axis for param['IN_FORM'] == "EL" + e : float or array-like of float, optional + eccentricity for param['IN_FORM'] == "EL" + inc : float or array-like of float, optional + inclination for param['IN_FORM'] == "EL" + capom : float or array-like of float, optional + longitude of periapsis for param['IN_FORM'] == "EL" + omega : float or array-like of float, optional + argument of periapsis for param['IN_FORM'] == "EL" + capm : float or array-like of float, optional + mean anomaly for param['IN_FORM'] == "EL" + rh : (n,3) array-like of float, optional + Position vector array. This can be used instead of passing v1, v2, and v3 sepearately for "XV" input format + vh : (n,3) array-like of float, optional + Velocity vector array. This can be used instead of passing v4, v5, and v6 sepearately for "XV" input format + Gmass : float or array-like of float, optional + G*mass values if these are massive bodies (only one of mass or Gmass can be passed) + radius : float or array-like of float, optional + Radius values if these are massive bodies + rhill : float or array-like of float, optional + Hill's radius values if these are massive bodies + rot: (n,3) array-like of float, optional + Rotation rate vectors if these are massive bodies with rotation enabled. This can be used instead of passing + rotx, roty, and rotz separately + 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 t : array of floats Time at start of simulation Returns ------- ds : xarray dataset """ + 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) - + if Ip is None: + Ip = np.full_like(rot, 0.4) + dims = ['id', 'vec'] infodims = ['id', 'vec'] space_coords = np.array(["x","y","z"]) # 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) + if Gmass is not None: + icb = (~np.isnan(Gmass)) & (id == 0) + ipl = (~np.isnan(Gmass)) & (id != 0) + itp = (np.isnan(Gmass)) & (id != 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 + icb = np.full_like(id,False) + ipl = np.full_like(id,False) + itp = id != 0 iscb = False ispl = False istp = any(itp) @@ -342,25 +330,25 @@ def vec2xr(param: Dict, 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) + particle_type = np.empty_like(name) vec = np.vstack([v1,v2,v3,v4,v5,v6]) if iscb: particle_type[icb] = "Central Body" lab_cb = clab.copy() - vec_cb = np.vstack([GMpl[icb],Rpl[icb],J2[icb],J4[icb]]) + vec_cb = np.vstack([Gmass[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]]) - ds_cb = xr.DataArray(vec_cb.T, dims=dims, coords={'id': idvals[icb], 'vec': lab_cb}) + ds_cb = xr.DataArray(vec_cb.T, dims=dims, coords={'id': id[icb], 'vec': lab_cb}) ds_cb = ds_cb.expand_dims({"time":1}).assign_coords({"time": [t]}).to_dataset(dim='vec') else: ds_cb = None if ispl: - particle_type[ipl] = np.repeat("Massive Body",idvals[ipl].size) + particle_type[ipl] = np.repeat("Massive Body",id[ipl].size) lab_pl = plab.copy() - vec_pl = np.vstack([vec[:,ipl], GMpl[ipl]]) + vec_pl = np.vstack([vec[:,ipl], Gmass[ipl]]) if param['CHK_CLOSE']: vec_pl = np.vstack([vec_pl, Rpl[ipl]]) if param['RHILL_PRESENT']: @@ -368,21 +356,21 @@ def vec2xr(param: Dict, if param['ROTATION']: vec_pl = np.vstack([vec_pl, Ip1[ipl], Ip2[ipl], Ip3[ipl], rotx[ipl], roty[ipl], rotz[ipl]]) - ds_pl = xr.DataArray(vec_pl.T, dims=dims, coords={'id': idvals[ipl], 'vec': lab_pl}) + ds_pl = xr.DataArray(vec_pl.T, dims=dims, coords={'id': id[ipl], 'vec': lab_pl}) ds_pl = ds_pl.expand_dims({"time":1}).assign_coords({"time": [t]}).to_dataset(dim='vec') else: ds_pl = None if istp: - particle_type[itp] = np.repeat("Test Particle",idvals[itp].size) + particle_type[itp] = np.repeat("Test Particle",id[itp].size) lab_tp = tlab.copy() vec_tp = vec[:,itp] - ds_tp = xr.DataArray(vec_tp.T, dims=dims, coords={'id': idvals[itp], 'vec': lab_tp}) + ds_tp = xr.DataArray(vec_tp.T, dims=dims, coords={'id': id[itp], 'vec': lab_tp}) ds_tp = ds_tp.expand_dims({"time":1}).assign_coords({"time": [t]}).to_dataset(dim='vec') else: ds_tp = None - ds_info = xr.DataArray(np.vstack([namevals,particle_type]).T, dims=infodims, coords={'id': idvals, 'vec' : ["name", "particle_type"]}).to_dataset(dim='vec') + ds_info = xr.DataArray(np.vstack([name,particle_type]).T, dims=infodims, coords={'id': id, '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) diff --git a/python/swiftest/swiftest/simulation_class.py b/python/swiftest/swiftest/simulation_class.py index 9e4840f78..ac2136e5e 100644 --- a/python/swiftest/swiftest/simulation_class.py +++ b/python/swiftest/swiftest/simulation_class.py @@ -2085,61 +2085,28 @@ def add_solar_system_body(self, #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]),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),17))) + keys = ["name","id","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 in scalar_ints: + kwargs[k] = kwargs[k].astype(int) + for k in scalar_floats: + kwargs[k] = kwargs[k].astype(np.float64) + if all(np.isnan(kwargs[k])): + kwargs[k] = None + for k in vector_floats: + kwargs[k] = kwargs[k][0].astype(np.float64) + if all(np.isnan(kwargs[k])): + kwargs[k] = None + kwargs['t'] = 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: @@ -2272,7 +2239,7 @@ 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, + 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, @@ -2285,14 +2252,8 @@ def add_body(self, 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,7 +2266,7 @@ 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. a : float or array-like of float, optional @@ -2403,10 +2364,10 @@ def input_to_array_3d(val,n=None): 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(capm,"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) - idvals,nbodies = input_to_array(idvals,"i",nbodies) + idvals,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) From 8042a7cc7ea6ac9bf4a526c640c5b59a9a694c65 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Sun, 4 Dec 2022 00:03:13 -0500 Subject: [PATCH 223/569] Greatly simplified the vec2xr function and now it works in THE SPACE DIMENSION --- python/swiftest/swiftest/init_cond.py | 196 ++++++------------- python/swiftest/swiftest/simulation_class.py | 29 +-- 2 files changed, 79 insertions(+), 146 deletions(-) diff --git a/python/swiftest/swiftest/init_cond.py b/python/swiftest/swiftest/init_cond.py index d2e6bd51f..f93a89a8f 100644 --- a/python/swiftest/swiftest/init_cond.py +++ b/python/swiftest/swiftest/init_cond.py @@ -24,10 +24,10 @@ List, Any ) -def solar_system_horizons(plname: str, +def solar_system_horizons(name: str, param: Dict, ephemerides_start_date: str, - idval: int | None = None): + id: int | None = None): """ Initializes a Swiftest dataset containing the major planets of the Solar System at a particular data from JPL/Horizons @@ -56,14 +56,14 @@ def solar_system_horizons(plname: str, 'Pluto': '9' } - if plname in planetid: + if name in planetid: ispl = True - idval = planetid[plname] + id = planetid[name] else: ispl = False - print(f"\nMassive body {plname} not found or not yet supported") + print(f"\nMassive body {name} not found or not yet supported") print("This will be created as a massless test particle") - if idval is None: + if id is None: print("ID value required for this input type") return @@ -157,7 +157,7 @@ def solar_system_horizons(plname: str, J2 = None J4 = None - if plname == "Sun" : # Create central body + if name == "Sun" : # Create central body print("Creating the Sun as a central body") Gmass = GMcb Rpl = Rcb @@ -167,7 +167,7 @@ def solar_system_horizons(plname: str, Ip = Ipsun rot = rotcb else: # Fetch solar system ephemerides from Horizons - print(f"Fetching ephemerides data for {plname} from JPL/Horizons") + print(f"Fetching ephemerides data for {name} from JPL/Horizons") # Horizons date time internal variables tstart = datetime.date.fromisoformat(ephemerides_start_date) @@ -177,76 +177,56 @@ def solar_system_horizons(plname: str, ephemerides_step = '1d' pldata = {} - pldata[plname] = Horizons(id=idval, location='@sun', + pldata[name] = Horizons(id=id, location='@sun', epochs={'start': ephemerides_start_date, 'stop': ephemerides_end_date, 'step': ephemerides_step}) if param['IN_FORM'] == 'XV': - rx = pldata[plname].vectors()['x'][0] * DCONV - ry = pldata[plname].vectors()['y'][0] * DCONV - rz = pldata[plname].vectors()['z'][0] * DCONV - vx = pldata[plname].vectors()['vx'][0] * VCONV - vy = pldata[plname].vectors()['vy'][0] * VCONV - vz = pldata[plname].vectors()['vz'][0] * VCONV + rx = pldata[name].vectors()['x'][0] * DCONV + ry = pldata[name].vectors()['y'][0] * DCONV + rz = pldata[name].vectors()['z'][0] * DCONV + vx = pldata[name].vectors()['vx'][0] * VCONV + vy = pldata[name].vectors()['vy'][0] * VCONV + vz = pldata[name].vectors()['vz'][0] * VCONV rh = np.array([rx,ry,rz]) vh = np.array([vx,vy,vz]) elif param['IN_FORM'] == 'EL': - a = pldata[plname].elements()['a'][0] * DCONV - e = pldata[plname].elements()['e'][0] - inc = pldata[plname].elements()['incl'][0] - capom = pldata[plname].elements()['Omega'][0] - omega = pldata[plname].elements()['w'][0] - capm = pldata[plname].elements()['M'][0] + a = pldata[name].elements()['a'][0] * DCONV + e = pldata[name].elements()['e'][0] + inc = pldata[name].elements()['incl'][0] + capom = pldata[name].elements()['Omega'][0] + omega = pldata[name].elements()['w'][0] + capm = pldata[name].elements()['M'][0] if ispl: - Gmass = GMcb / MSun_over_Mpl[plname] + Gmass = GMcb / MSun_over_Mpl[name] if param['CHK_CLOSE']: - Rpl = planetradius[plname] * DCONV + Rpl = planetradius[name] * DCONV # Generate planet value vectors if (param['RHILL_PRESENT']): - rhill = pldata[plname].elements()['a'][0] * DCONV * (3 * MSun_over_Mpl[plname]) ** (-THIRDLONG) + rhill = pldata[name].elements()['a'][0] * DCONV * (3 * MSun_over_Mpl[name]) ** (-THIRDLONG) if (param['ROTATION']): - RA = pldata[plname].ephemerides()['NPole_RA'][0] - DEC = pldata[plname].ephemerides()['NPole_DEC'][0] + RA = pldata[name].ephemerides()['NPole_RA'][0] + DEC = pldata[name].ephemerides()['NPole_DEC'][0] rotpole = SkyCoord(ra=RA * u.degree, dec=DEC * u.degree) - rotrate = planetrot[plname] * param['TU2S'] + rotrate = planetrot[name] * param['TU2S'] rot = rotpole.cartesian * rotrate rot = np.array([rot.x.value, rot.y.value, rot.z.value]) - Ip = np.array([0.0, 0.0, planetIpz[plname]]) + Ip = np.array([0.0, 0.0, planetIpz[name]]) else: Gmass = None - if idval is None: - plid = planetid[plname] - else: - plid = idval + if id is None: + id = planetid[name] - return plname,idval,a,e,inc,capom,omega,capm,rh,vh,Gmass,Rpl,rhill,Ip,rot,J2,J4 + return id,name,a,e,inc,capom,omega,capm,rh,vh,Gmass,Rpl,rhill,Ip,rot,J2,J4 -def vec2xr(param: Dict, - name: npt.NDArray[np.str_] | None=None, - id: npt.NDArray[np.int_] | None=None, - a: npt.NDArray[np.float_] | None=None, - e: npt.NDArray[np.float_] | None=None, - inc: npt.NDArray[np.float_] | None=None, - capom: npt.NDArray[np.float_] | None=None, - omega: npt.NDArray[np.float_] | None=None, - capm: npt.NDArray[np.float_] | None=None, - rh: npt.NDArray[np.int_] | None=None, - vh: npt.NDArray[np.int_] | None=None, - Gmass: npt.NDArray[np.float_] | None=None, - radius: npt.NDArray[np.float_] | None=None, - rhill: npt.NDArray[np.float_] | None=None, - Ip: npt.NDArray[np.float_] | None=None, - rot: npt.NDArray[np.float_] | None=None, - J2: npt.NDArray[np.float_] | None=None, - J4: npt.NDArray[np.float_] | None=None, - t: float=0.0): +def vec2xr(param: Dict, **kwargs: Any): """ Converts and stores the variables of all bodies in an xarray dataset. @@ -255,7 +235,7 @@ def vec2xr(param: Dict, param : dict Swiftest paramuration parameters. name : str or array-like of str, optional - Name or names of Bodies. If none passed, name will be "Body" + Name or names of Bodies. If none passed, name will be "Body" id : int or array-like of int, optional Unique id values. If not passed, an id will be assigned in ascending order starting from the pre-existing Dataset ids. @@ -283,9 +263,8 @@ def vec2xr(param: Dict, 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 - rotx, roty, and rotz separately - 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 + 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 t : array of floats Time at start of simulation @@ -294,94 +273,45 @@ def vec2xr(param: Dict, ds : xarray dataset """ - if param['ROTATION']: - if Ip is None: - Ip = np.full_like(rot, 0.4) - - dims = ['id', 'vec'] - infodims = ['id', 'vec'] - space_coords = np.array(["x","y","z"]) - # The central body is always given id 0 - if Gmass is not None: - icb = (~np.isnan(Gmass)) & (id == 0) - ipl = (~np.isnan(Gmass)) & (id != 0) - itp = (np.isnan(Gmass)) & (id != 0) - iscb = any(icb) - ispl = any(ipl) - istp = any(itp) - else: - icb = np.full_like(id,False) - ipl = np.full_like(id,False) - itp = id != 0 - iscb = False - ispl = False - istp = any(itp) - 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(name) - vec = np.vstack([v1,v2,v3,v4,v5,v6]) + kwargs = {k:kwargs[k] for k,v in kwargs.items() if v is not None} - if iscb: - particle_type[icb] = "Central Body" - lab_cb = clab.copy() - vec_cb = np.vstack([Gmass[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]]) + if param['ROTATION']: + if "rot" not in kwargs: + warnings.warn("Rotation vectors must be given when rotation is enabled",stacklevel=2) + return + if "Ip" not in kwargs: + kwargs['Ip'] = np.full_like(rot, 0.4) - ds_cb = xr.DataArray(vec_cb.T, dims=dims, coords={'id': id[icb], 'vec': lab_cb}) - ds_cb = ds_cb.expand_dims({"time":1}).assign_coords({"time": [t]}).to_dataset(dim='vec') - else: - ds_cb = None + if "t" not in kwargs: + kwargs["t"] = np.array([0.0]) - if ispl: - particle_type[ipl] = np.repeat("Massive Body",id[ipl].size) - lab_pl = plab.copy() - vec_pl = np.vstack([vec[:,ipl], Gmass[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]]) + scalar_dims = ['id'] + vector_dims = ['id','space'] + time_dims =['time'] + space_coords = np.array(["x","y","z"]) - ds_pl = xr.DataArray(vec_pl.T, dims=dims, coords={'id': id[ipl], 'vec': lab_pl}) - ds_pl = ds_pl.expand_dims({"time":1}).assign_coords({"time": [t]}).to_dataset(dim='vec') - else: - ds_pl = None - if istp: - particle_type[itp] = np.repeat("Test Particle",id[itp].size) - lab_tp = tlab.copy() - vec_tp = vec[:,itp] - ds_tp = xr.DataArray(vec_tp.T, dims=dims, coords={'id': id[itp], 'vec': lab_tp}) - ds_tp = ds_tp.expand_dims({"time":1}).assign_coords({"time": [t]}).to_dataset(dim='vec') - else: - ds_tp = None + 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"] - ds_info = xr.DataArray(np.vstack([name,particle_type]).T, dims=infodims, coords={'id': id, '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]) - ds["space"] = xr.DataArray(space_coords,dims=["space"],coords={"space":space_coords}) + 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['t']}) # Re-order dimension coordinates so that they are in the same order as the Fortran side idx = ds.indexes - dim_order = ["time", "space", "id"] + dim_order = ["time", "id", "space"] idx = {index_name: idx[index_name] for index_name in dim_order} ds = ds.reindex(idx) diff --git a/python/swiftest/swiftest/simulation_class.py b/python/swiftest/swiftest/simulation_class.py index ac2136e5e..446ee0e3d 100644 --- a/python/swiftest/swiftest/simulation_class.py +++ b/python/swiftest/swiftest/simulation_class.py @@ -2081,30 +2081,33 @@ 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: values = list(np.hsplit(np.array(body_list[0]),17)) else: values = list(np.squeeze(np.hsplit(np.array(body_list),17))) - keys = ["name","id","a","e","inc","capom","omega","capm","rh","vh","Gmass","radius","rhill","Ip","rot","J2","J4"] + 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 in scalar_ints: - kwargs[k] = kwargs[k].astype(int) - for k in scalar_floats: - kwargs[k] = kwargs[k].astype(np.float64) - if all(np.isnan(kwargs[k])): - kwargs[k] = None - for k in vector_floats: - kwargs[k] = kwargs[k][0].astype(np.float64) - if all(np.isnan(kwargs[k])): - kwargs[k] = None - kwargs['t'] = self.param['TSTART'] + 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['t'] = np.array([self.param['TSTART']]) dsnew = init_cond.vec2xr(self.param,**kwargs) From a527bc3b4f29ac8e88b619a3bf10b825c2ccc277 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Sun, 4 Dec 2022 08:14:07 -0500 Subject: [PATCH 224/569] Cleaned up most of the add_body and add_solar_system_bodies methods for compatibility in THE SPACE DIMENSION. --- .../Basic_Simulation/initial_conditions.py | 14 ++--- python/swiftest/swiftest/init_cond.py | 39 +++++------- python/swiftest/swiftest/simulation_class.py | 59 ++++--------------- 3 files changed, 33 insertions(+), 79 deletions(-) diff --git a/examples/Basic_Simulation/initial_conditions.py b/examples/Basic_Simulation/initial_conditions.py index a577c6658..c69a5d26a 100644 --- a/examples/Basic_Simulation/initial_conditions.py +++ b/examples/Basic_Simulation/initial_conditions.py @@ -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(tstart=0.0, tstop=1.0e2, dt=0.01, tstep_out=1.0e0, dump_cadence=0, ) +#sim.run(tstart=0.0, tstop=1.0e2, dt=0.01, tstep_out=1.0e0, dump_cadence=0, ) diff --git a/python/swiftest/swiftest/init_cond.py b/python/swiftest/swiftest/init_cond.py index f93a89a8f..b24eff0d8 100644 --- a/python/swiftest/swiftest/init_cond.py +++ b/python/swiftest/swiftest/init_cond.py @@ -266,36 +266,35 @@ def vec2xr(param: Dict, **kwargs: Any): 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 - t : array of floats + 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 "rot" not in kwargs: - warnings.warn("Rotation vectors must be given when rotation is enabled",stacklevel=2) + 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: + if "Ip" not in kwargs and "rot" in kwargs: kwargs['Ip'] = np.full_like(rot, 0.4) - if "t" not in kwargs: - kwargs["t"] = np.array([0.0]) - - scalar_dims = ['id'] - vector_dims = ['id','space'] - time_dims =['time'] - space_coords = np.array(["x","y","z"]) + if "time" not in kwargs: + kwargs["time"] = np.array([0.0]) + valid_arguments = vector_vars + scalar_vars + ['time','id'] - 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"] + kwargs = {k:v for k,v in kwargs.items() if k in valid_arguments} data_vars = {k:(scalar_dims,v) for k,v in kwargs.items() if k in scalar_vars} data_vars.update({k:(vector_dims,v) for k,v in kwargs.items() if k in vector_vars}) @@ -307,12 +306,6 @@ def vec2xr(param: Dict, **kwargs: Any): ) 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['t']}) - - # Re-order dimension coordinates so that they are in the same order as the Fortran side - idx = ds.indexes - dim_order = ["time", "id", "space"] - idx = {index_name: idx[index_name] for index_name in dim_order} - ds = ds.reindex(idx) + 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/simulation_class.py b/python/swiftest/swiftest/simulation_class.py index 446ee0e3d..8394c5e44 100644 --- a/python/swiftest/swiftest/simulation_class.py +++ b/python/swiftest/swiftest/simulation_class.py @@ -2085,9 +2085,9 @@ def add_solar_system_body(self, #Convert the list receieved from the solar_system_horizons output and turn it into arguments to vec2xr if len(body_list) == 1: - values = list(np.hsplit(np.array(body_list[0]),17)) + values = list(np.hsplit(np.array(body_list[0],dtype=np.dtype(object)),17)) else: - values = list(np.squeeze(np.hsplit(np.array(body_list),17))) + 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"] @@ -2107,7 +2107,7 @@ def add_solar_system_body(self, if np.all(np.isnan(kwargs[k])): kwargs[k] = None - kwargs['t'] = np.array([self.param['TSTART']]) + kwargs['time'] = np.array([self.param['TSTART']]) dsnew = init_cond.vec2xr(self.param,**kwargs) @@ -2370,7 +2370,7 @@ def input_to_array_3d(val,n=None): capom,nbodies = input_to_array(capom,"f",nbodies) omega,nbodies = input_to_array(omega,"f",nbodies) capm,nbodies = input_to_array(capm,"f",nbodies) - idvals,nbodies = input_to_array(id,"i",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) @@ -2388,50 +2388,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 rh is not None: - if v1 is not None or v2 is not None or v3 is not None: - raise ValueError("Cannot use rh and v1,v2,v3 inputs simultaneously!") - else: - v1 = rh.T[0] - v2 = rh.T[1] - v3 = rh.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: @@ -2439,11 +2407,8 @@ 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) From 63877ff147eaefa1fcde0a703c7a1fff392552d8 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Sun, 4 Dec 2022 10:29:15 -0500 Subject: [PATCH 225/569] Fixed issues getting particle types when they aren't in the input file --- .../Basic_Simulation/initial_conditions.py | 2 +- src/netcdf/netcdf.f90 | 78 ++++++++++++------- 2 files changed, 53 insertions(+), 27 deletions(-) diff --git a/examples/Basic_Simulation/initial_conditions.py b/examples/Basic_Simulation/initial_conditions.py index c69a5d26a..824cccfb9 100644 --- a/examples/Basic_Simulation/initial_conditions.py +++ b/examples/Basic_Simulation/initial_conditions.py @@ -63,4 +63,4 @@ sim.get_parameter() # Run the simulation -#sim.run(tstart=0.0, tstop=1.0e2, dt=0.01, tstep_out=1.0e0, dump_cadence=0, ) +sim.run(tstart=0.0, tstop=1.0e2, dt=0.01, tstep_out=1.0e0, dump_cadence=0, ) diff --git a/src/netcdf/netcdf.f90 b/src/netcdf/netcdf.f90 index fd3bf2ec5..b5c44b00e 100644 --- a/src/netcdf/netcdf.f90 +++ b/src/netcdf/netcdf.f90 @@ -336,7 +336,6 @@ module subroutine netcdf_open(self, param, readonly) ! 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%ptype_varname, nciu%ptype_varid), "netcdf_open nf90_inq_varid ptype_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 @@ -389,6 +388,7 @@ module subroutine netcdf_open(self, param, readonly) 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) if (param%integrator == SYMBA) then status = nf90_inq_varid(nciu%id, nciu%nplm_varname, nciu%nplm_varid) @@ -472,8 +472,8 @@ module function netcdf_read_frame_system(self, nciu, param) result(ierr) end if ! Next, filter only bodies that don't have mass (test particles) - call check( nf90_get_var(nciu%id, nciu%Gmass_varid, vectemp(:,:), start=[1, 1, tslot]), "netcdf_read_frame_system nf90_getvar Gmass_varid" ) - plmask(:) = vectemp(1,:) == vectemp(1,:) .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 @@ -694,7 +694,7 @@ module subroutine netcdf_read_hdr_system(self, nciu, param) tslot = param%ioutput + 1 - call check( nf90_inquire_dimension(nciu%id, nciu%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_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)) @@ -702,7 +702,7 @@ module subroutine netcdf_read_hdr_system(self, nciu, param) allocate(plmask(idmax)) allocate(plmmask(idmax)) - call check( nf90_get_var(nciu%id, nciu%Gmass_varid, gmtemp, start=[1,1], count=[idmax,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(:) @@ -827,14 +827,40 @@ module subroutine netcdf_read_particle_info_system(self, nciu, param, plmask, tp call tp%info(i)%set_value(name=ctemp(tpind(i))) end do - call check( nf90_get_var(nciu%id, nciu%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(nciu%id, nciu%status_varname, nciu%status_varid) if (status == nf90_noerr) then @@ -1049,28 +1075,28 @@ module subroutine netcdf_write_frame_base(self, nciu, param) self%vh(1,j), self%vh(2,j), self%vh(3,j), & a, e, inc, capom, omega, capm) end if - call check( nf90_put_var(nciu%id, nciu%a_varid, a, start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var a_varid" ) - call check( nf90_put_var(nciu%id, nciu%e_varid, e, start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var e_varid" ) - call check( nf90_put_var(nciu%id, nciu%inc_varid, inc * RAD2DEG, start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var inc_varid" ) - call check( nf90_put_var(nciu%id, nciu%capom_varid, capom * RAD2DEG, start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var capom_varid" ) - call check( nf90_put_var(nciu%id, nciu%omega_varid, omega * RAD2DEG, start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var omega_varid" ) - call check( nf90_put_var(nciu%id, nciu%capm_varid, capm * RAD2DEG, start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var capm_varid" ) + 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" ) 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(nciu%id, nciu%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(nciu%id, nciu%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(nciu%id, nciu%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(nciu%id, nciu%Ip_varid, self%Ip(:, j), start=[1,idslot, tslot], count=[NDIM,1,1]), "netcdf_write_frame_base nf90_put_var 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 rotx_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(nciu%id, nciu%k2_varid, self%k2(j), start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var 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 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 From 8a066632443c70da9bd261d62ce1db74a59f33a5 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Sun, 4 Dec 2022 10:55:10 -0500 Subject: [PATCH 226/569] Created new .ic instance variable to keep a copy of the initial conditions that won't get altered by the running simulation --- python/swiftest/swiftest/simulation_class.py | 35 ++++++++++++++------ 1 file changed, 25 insertions(+), 10 deletions(-) diff --git a/python/swiftest/swiftest/simulation_class.py b/python/swiftest/swiftest/simulation_class.py index 8394c5e44..167d86e3b 100644 --- a/python/swiftest/swiftest/simulation_class.py +++ b/python/swiftest/swiftest/simulation_class.py @@ -302,6 +302,7 @@ def __init__(self,read_param: bool = False, read_old_output_file: bool = False, self.param = {} self.data = xr.Dataset() + self.ic = xr.Dataset() # Set the location of the parameter input file, choosing the default if it isn't specified. param_file = kwargs.pop("param_file",Path.cwd() / "simdata" / "param.in") @@ -322,8 +323,8 @@ def __init__(self,read_param: bool = False, read_old_output_file: bool = False, # If the user asks to read in an old parameter file or output file, override any default parameters with values from the file # If the file doesn't exist, flag it for now so we know to create it + param_file_found = False if read_param or read_old_output_file: - if self.read_param(read_init_cond = not read_old_output_file): # We will add the parameter file to the kwarg list. This will keep the set_parameter method from # overriding everything with defaults when there are no arguments passed to Simulation() @@ -347,7 +348,7 @@ def __init__(self,read_param: bool = False, read_old_output_file: bool = False, if read_old_output_file: binpath = os.path.join(self.sim_dir, self.param['BIN_OUT']) if os.path.exists(binpath): - self.bin2xr() + self.read_output_file() else: warnings.warn(f"BIN_OUT file {binpath} not found.",stacklevel=2) return @@ -470,7 +471,7 @@ def run(self,**kwargs): self._run_swiftest_driver() # Read in new data - self.bin2xr() + self.read_output_file() return @@ -2051,7 +2052,8 @@ def add_solar_system_body(self, >*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: @@ -2115,7 +2117,9 @@ def add_solar_system_body(self, 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, @@ -2412,8 +2416,9 @@ def input_to_array_3d(val,n=None): 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): """ @@ -2517,6 +2522,7 @@ def read_param(self, 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: @@ -2641,12 +2647,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 ------- @@ -2661,6 +2669,13 @@ def bin2xr(self): 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 param['IN_TYPE']: + param_tmp['BIN_OUT'] = os.path.join(self.sim_dir, 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') @@ -2684,11 +2699,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 From 01d8a1c55ee8061ceedf7e288e563ca18c4fbe56 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Sun, 4 Dec 2022 10:55:40 -0500 Subject: [PATCH 227/569] Updated Basic_Simulation initial conditions generators --- .../Basic_Simulation/initial_conditions.ipynb | 1485 +---------------- .../Basic_Simulation/initial_conditions.py | 2 +- 2 files changed, 24 insertions(+), 1463 deletions(-) diff --git a/examples/Basic_Simulation/initial_conditions.ipynb b/examples/Basic_Simulation/initial_conditions.ipynb index 17b85582f..f6a872061 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)" ] }, { diff --git a/examples/Basic_Simulation/initial_conditions.py b/examples/Basic_Simulation/initial_conditions.py index 824cccfb9..7e0218a03 100644 --- a/examples/Basic_Simulation/initial_conditions.py +++ b/examples/Basic_Simulation/initial_conditions.py @@ -63,4 +63,4 @@ sim.get_parameter() # Run the simulation -sim.run(tstart=0.0, tstop=1.0e2, dt=0.01, tstep_out=1.0e0, dump_cadence=0, ) +sim.run(tstart=0.0, tstop=1.0e3, dt=0.01, tstep_out=1.0e0, dump_cadence=0) From a1b6ca6b9e9aa10901bdcf0a12464e1be3e42b1e Mon Sep 17 00:00:00 2001 From: David A Minton Date: Sun, 4 Dec 2022 10:59:05 -0500 Subject: [PATCH 228/569] Removed the encounter list stuff that I won't actually use --- src/symba/symba_encounter_check.f90 | 12 ------------ 1 file changed, 12 deletions(-) diff --git a/src/symba/symba_encounter_check.f90 b/src/symba/symba_encounter_check.f90 index b955d4998..e58da2129 100644 --- a/src/symba/symba_encounter_check.f90 +++ b/src/symba/symba_encounter_check.f90 @@ -69,15 +69,6 @@ module function symba_encounter_check_pl(self, param, system, dt, irec) result(l 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(:) - plplenc_list%Gmass1(k) = pl%Gmass(i) - plplenc_list%Gmass2(k) = pl%Gmass(j) - if (param%lclose) then - plplenc_list%radius1(k) = pl%radius(i) - plplenc_list%radius2(k) = pl%radius(j) - end if - plplenc_list%name1(k) = pl%info(i)%name - plplenc_list%name2(k) = pl%info(j)%name - pl%lencounter(i) = .true. pl%lencounter(j) = .true. pl%levelg(i) = irec @@ -87,9 +78,6 @@ module function symba_encounter_check_pl(self, param, system, dt, irec) result(l pl%nplenc(i) = pl%nplenc(i) + 1 pl%nplenc(j) = pl%nplenc(j) + 1 end do - ienc_frame = ienc_frame + 1 - call system%resize_storage(ienc_frame) - system%encounter_history%frame(ienc_frame) = plplenc_list end if end associate From 5a0e0e797329438fc2681abe2c5616b02dc309cc Mon Sep 17 00:00:00 2001 From: David A Minton Date: Sun, 4 Dec 2022 11:00:54 -0500 Subject: [PATCH 229/569] Added missing self --- python/swiftest/swiftest/simulation_class.py | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/python/swiftest/swiftest/simulation_class.py b/python/swiftest/swiftest/simulation_class.py index 167d86e3b..5b9aef212 100644 --- a/python/swiftest/swiftest/simulation_class.py +++ b/python/swiftest/swiftest/simulation_class.py @@ -312,7 +312,7 @@ def __init__(self,read_param: bool = False, read_old_output_file: bool = False, # then using the arguments passed via **kwargs. #-------------------------- - # Lowest Priority: Defaults + # Lowest Priority: Defaults: #-------------------------- # Quietly set all parameters to their defaults. self.set_parameter(verbose=False,param_file=param_file) @@ -2670,7 +2670,7 @@ def read_output_file(self,read_init_cond : bool = True): 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 param['IN_TYPE']: + if "NETCDF" in self.param['IN_TYPE']: param_tmp['BIN_OUT'] = os.path.join(self.sim_dir, self.param['NC_IN']) self.ic = io.swiftest2xr(param_tmp, verbose=self.verbose) else: From 0d71424a445c838de54741fa094c3aed464ac667 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Sun, 4 Dec 2022 11:03:02 -0500 Subject: [PATCH 230/569] Minor fixes to initial conditions generator --- .../Basic_Simulation/initial_conditions.ipynb | 22 ++++++++++++++++++- 1 file changed, 21 insertions(+), 1 deletion(-) diff --git a/examples/Basic_Simulation/initial_conditions.ipynb b/examples/Basic_Simulation/initial_conditions.ipynb index f6a872061..60581d22a 100644 --- a/examples/Basic_Simulation/initial_conditions.ipynb +++ b/examples/Basic_Simulation/initial_conditions.ipynb @@ -123,7 +123,7 @@ "outputs": [], "source": [ "# Display the run configuration parameters\n", - "sim.get_parameter()" + "p = sim.get_parameter()" ] }, { @@ -143,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": [] } ], From 9f0294f87eb23c86dea21243b63de78dadf5d25e Mon Sep 17 00:00:00 2001 From: David A Minton Date: Sun, 4 Dec 2022 11:04:26 -0500 Subject: [PATCH 231/569] Changed argument from xh to rh --- examples/Fragmentation/Fragmentation_Movie.py | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) 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) From c509479c2bbb84707903b225b8d15330429ec8b9 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Sun, 4 Dec 2022 11:13:59 -0500 Subject: [PATCH 232/569] Added new simdir argument to make it easier to create individual simulations in specific directories without having to change the name of every file --- python/swiftest/swiftest/simulation_class.py | 28 +++++++++++--------- 1 file changed, 16 insertions(+), 12 deletions(-) diff --git a/python/swiftest/swiftest/simulation_class.py b/python/swiftest/swiftest/simulation_class.py index 5b9aef212..f4c99f5d8 100644 --- a/python/swiftest/swiftest/simulation_class.py +++ b/python/swiftest/swiftest/simulation_class.py @@ -41,7 +41,7 @@ class Simulation: This is a class that defines the basic Swift/Swifter/Swiftest simulation object """ - def __init__(self,read_param: bool = False, read_old_output_file: bool = False, **kwargs: Any): + def __init__(self,read_param: bool = False, read_old_output_file: bool = False, simdir: os.PathLike | str = "simdata",**kwargs: Any): """ Parameters @@ -66,6 +66,9 @@ def __init__(self,read_param: bool = False, read_old_output_file: bool = False, read_old_output_file : bool, default False If true, read in a pre-existing binary input file given by the argument `output_file_name` if it exists. Parameter input file equivalent: None + simdir : PathLike, default `"simdir"` + Directory where simulation data will be stored, including the parameter file, initial conditions file, output file, + dump files, and log files. **kwargs : See list of valid parameters and their defaults below @@ -308,6 +311,8 @@ def __init__(self,read_param: bool = False, read_old_output_file: bool = False, param_file = kwargs.pop("param_file",Path.cwd() / "simdata" / "param.in") self.verbose = kwargs.pop("verbose",True) + self.simdir = simdir + # Parameters are set in reverse priority order. First the defaults, then values from a pre-existing input file, # then using the arguments passed via **kwargs. @@ -346,7 +351,7 @@ def __init__(self,read_param: bool = False, read_old_output_file: bool = False, # Read in an old simulation file if requested if read_old_output_file: - binpath = os.path.join(self.sim_dir, self.param['BIN_OUT']) + binpath = os.path.join(self.simdir, self.param['BIN_OUT']) if os.path.exists(binpath): self.read_output_file() else: @@ -365,7 +370,7 @@ def _run_swiftest_driver(self): with open(driver_script, 'w') as f: f.write(f"#{self._shell_full} -l\n") f.write(f"source ~/.{self._shell}rc\n") - f.write(f"cd {self.sim_dir}\n") + f.write(f"cd {self.simdir}\n") f.write(f"{str(self.driver_executable)} {self.integrator} {str(self.param_file)} compact\n") cmd = f"{env['SHELL']} -l {driver_script}" @@ -767,14 +772,13 @@ def set_parameter(self, verbose: bool = True, **kwargs): # Extract the simulation directory and create it if it doesn't exist if param_file is not None: self.param_file = Path.cwd() / param_file - self.sim_dir = self.param_file.parent - if self.sim_dir.exists(): - if not self.sim_dir.is_dir(): - msg = f"Cannot create the {self.sim_dir} directory: File exists." + if self.simdir.exists(): + if not self.simdir.is_dir(): + msg = f"Cannot create the {self.simdir} directory: File exists." msg += "\nDelete the file or change the location of param_file" warnings.warn(msg,stacklevel=2) else: - self.sim_dir.mkdir(parents=True, exist_ok=False) + self.simdir.mkdir(parents=True, exist_ok=False) # If no arguments (other than, possibly, verbose) are requested, use defaults if len(kwargs) == 0: @@ -2517,7 +2521,7 @@ 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 @@ -2665,13 +2669,13 @@ def read_output_file(self,read_init_cond : bool = True): # 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.sim_dir, self.param['NC_IN']) + 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) @@ -2764,7 +2768,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": From 0d00f4b722a1fb59c59385799d923a09ba0b84d5 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Sun, 4 Dec 2022 11:24:56 -0500 Subject: [PATCH 233/569] Fixed bug that prevented parameter file from being saved in new simdir directory --- .../whm_gr_test/swiftest_relativity.ipynb | 893 +----------------- python/swiftest/swiftest/simulation_class.py | 24 +- 2 files changed, 23 insertions(+), 894 deletions(-) diff --git a/examples/whm_gr_test/swiftest_relativity.ipynb b/examples/whm_gr_test/swiftest_relativity.ipynb index 0e5f26360..4d44ca569 100644 --- a/examples/whm_gr_test/swiftest_relativity.ipynb +++ b/examples/whm_gr_test/swiftest_relativity.ipynb @@ -2,7 +2,7 @@ "cells": [ { "cell_type": "code", - "execution_count": 1, + "execution_count": null, "metadata": {}, "outputs": [], "source": [ @@ -10,906 +10,33 @@ "from astroquery.jplhorizons import Horizons\n", "import datetime\n", "import numpy as np\n", - "import matplotlib.pyplot as plt" + "import matplotlib.pyplot as plt\n", + "import os" ] }, { "cell_type": "code", - "execution_count": 2, + "execution_count": null, "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) Date: Sun, 4 Dec 2022 11:25:56 -0500 Subject: [PATCH 234/569] Updated whm_gr_test notebook --- examples/whm_gr_test/swiftest_relativity.ipynb | 16 +++++++++++----- 1 file changed, 11 insertions(+), 5 deletions(-) diff --git a/examples/whm_gr_test/swiftest_relativity.ipynb b/examples/whm_gr_test/swiftest_relativity.ipynb index 4d44ca569..ea91ed5a2 100644 --- a/examples/whm_gr_test/swiftest_relativity.ipynb +++ b/examples/whm_gr_test/swiftest_relativity.ipynb @@ -40,9 +40,7 @@ "metadata": {}, "outputs": [], "source": [ - "%%capture\n", - "tstep_out = 10.0\n", - "sim_gr.run(tstop=1000.0, dt=0.005, tstep_out=tstep_out, integrator=\"whm\",general_relativity=True)" + "run_args = {\"tstop\":1000.0, \"dt\":0.005, \"tstep_out\":10.0,\"integrator\":\"whm\"}" ] }, { @@ -51,8 +49,16 @@ "metadata": {}, "outputs": [], "source": [ - "%%capture\n", - "sim_nogr.run(tstop=1000.0, dt=0.005, tstep_out=tstep_out, integrator=\"whm\",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)" ] }, { From e2282dad1eed59b8ce343dd5d17b47d5dbf38b88 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Sun, 4 Dec 2022 11:35:40 -0500 Subject: [PATCH 235/569] More updates to notebook. WHM seems to have a problem where relativity isn't working. Will need to fix later --- examples/whm_gr_test/swiftest_relativity.ipynb | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/examples/whm_gr_test/swiftest_relativity.ipynb b/examples/whm_gr_test/swiftest_relativity.ipynb index ea91ed5a2..477963283 100644 --- a/examples/whm_gr_test/swiftest_relativity.ipynb +++ b/examples/whm_gr_test/swiftest_relativity.ipynb @@ -40,7 +40,7 @@ "metadata": {}, "outputs": [], "source": [ - "run_args = {\"tstop\":1000.0, \"dt\":0.005, \"tstep_out\":10.0,\"integrator\":\"whm\"}" + "run_args = {\"tstop\":1000.0, \"dt\":0.005, \"tstep_out\":10.0, \"dump_cadence\": 0,\"integrator\":\"whm\"}" ] }, { @@ -117,8 +117,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" ] }, @@ -150,7 +150,9 @@ "execution_count": null, "metadata": {}, "outputs": [], - "source": [] + "source": [ + "sim_nogr.param" + ] }, { "cell_type": "code", From d7357dacc9a496e9e2cada6c98dc8ad9d3c6cee1 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Sun, 4 Dec 2022 11:37:39 -0500 Subject: [PATCH 236/569] Updates to helio_gr_test notebook --- .../helio_gr_test/swiftest_relativity.ipynb | 26 ++++++++++++------- 1 file changed, 17 insertions(+), 9 deletions(-) diff --git a/examples/helio_gr_test/swiftest_relativity.ipynb b/examples/helio_gr_test/swiftest_relativity.ipynb index 4b6d13106..e7ae73b23 100644 --- a/examples/helio_gr_test/swiftest_relativity.ipynb +++ b/examples/helio_gr_test/swiftest_relativity.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)" ] }, { @@ -108,8 +116,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" ] }, @@ -146,9 +154,9 @@ ], "metadata": { "kernelspec": { - "display_name": "swiftest", + "display_name": "Python (My debug_env Kernel)", "language": "python", - "name": "swiftest" + "name": "debug_env" }, "language_info": { "codemirror_mode": { From 6bd8a9d0d536ade373f954628efc5d19f3852eb2 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Sun, 4 Dec 2022 15:47:09 -0500 Subject: [PATCH 237/569] Fixed some wonkiness with the name of the integrator that as a side effect turned off GR --- src/io/io.f90 | 48 ++++++++++++++++---------------- src/main/swiftest_driver.f90 | 7 +++-- src/modules/swiftest_classes.f90 | 4 +-- 3 files changed, 30 insertions(+), 29 deletions(-) diff --git a/src/io/io.f90 b/src/io/io.f90 index e0b381aec..81aca06d1 100644 --- a/src/io/io.f90 +++ b/src/io/io.f90 @@ -497,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 @@ -762,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") @@ -1444,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/main/swiftest_driver.f90 b/src/main/swiftest_driver.f90 index 3f9a36adc..846915444 100644 --- a/src/main/swiftest_driver.f90 +++ b/src/main/swiftest_driver.f90 @@ -49,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 @@ -93,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 *************** " @@ -102,7 +103,7 @@ 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 @@ -160,7 +161,7 @@ program swiftest_driver 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/swiftest_classes.f90 b/src/modules/swiftest_classes.f90 index 73ad063e6..b516a60a2 100644 --- a/src/modules/swiftest_classes.f90 +++ b/src/modules/swiftest_classes.f90 @@ -144,8 +144,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 From 30b00fca32cc7b2058eb2cde4ef407b8e106b3c1 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Sun, 4 Dec 2022 16:01:31 -0500 Subject: [PATCH 238/569] More changes to relativity examples --- examples/helio_gr_test/grsim/param.gr.in | 35 ---- examples/helio_gr_test/nogrsim/param.nogr.in | 35 ---- .../helio_gr_test/swiftest_relativity.ipynb | 176 ------------------ examples/helio_gr_test/swiftest_relativity.py | 60 ------ examples/whm_gr_test/swiftest_relativity.py | 4 +- 5 files changed, 2 insertions(+), 308 deletions(-) delete mode 100644 examples/helio_gr_test/grsim/param.gr.in delete mode 100644 examples/helio_gr_test/nogrsim/param.nogr.in delete mode 100644 examples/helio_gr_test/swiftest_relativity.ipynb delete mode 100644 examples/helio_gr_test/swiftest_relativity.py 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/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/helio_gr_test/swiftest_relativity.ipynb b/examples/helio_gr_test/swiftest_relativity.ipynb deleted file mode 100644 index e7ae73b23..000000000 --- a/examples/helio_gr_test/swiftest_relativity.ipynb +++ /dev/null @@ -1,176 +0,0 @@ -{ - "cells": [ - { - "cell_type": "code", - "execution_count": null, - "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": null, - "metadata": {}, - "outputs": [], - "source": [ - "sim_gr = swiftest.Simulation(simdir=\"gr\")\n", - "sim_gr.add_solar_system_body([\"Sun\",\"Mercury\",\"Venus\",\"Earth\",\"Mars\",\"Jupiter\",\"Saturn\",\"Uranus\",\"Neptune\"])" - ] - }, - { - "cell_type": "code", - "execution_count": null, - "metadata": {}, - "outputs": [], - "source": [ - "sim_nogr = swiftest.Simulation(simdir=\"nogr\")\n", - "sim_nogr.add_solar_system_body([\"Sun\",\"Mercury\",\"Venus\",\"Earth\",\"Mars\",\"Jupiter\",\"Saturn\",\"Uranus\",\"Neptune\"])" - ] - }, - { - "cell_type": "code", - "execution_count": null, - "metadata": {}, - "outputs": [], - "source": [ - "run_args = {\"tstop\":1000.0, \"dt\":0.005, \"tstep_out\":10.0, \"dump_cadence\": 0,\"integrator\":\"helio\"}" - ] - }, - { - "cell_type": "code", - "execution_count": null, - "metadata": {}, - "outputs": [], - "source": [ - "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)" - ] - }, - { - "cell_type": "code", - "execution_count": null, - "metadata": {}, - "outputs": [], - "source": [ - "# Get the start and end date of the simulation so we can compare with the real solar system\n", - "start_date = sim_gr.ephemeris_date\n", - "tstop_d = sim_gr.param['TSTOP'] * sim_gr.param['TU2S'] / swiftest.JD2S\n", - "\n", - "stop_date = (datetime.datetime.fromisoformat(start_date) + datetime.timedelta(days=tstop_d)).isoformat()" - ] - }, - { - "cell_type": "code", - "execution_count": null, - "metadata": {}, - "outputs": [], - "source": [ - "#Get the ephemerides of Mercury for the same timeframe as the simulation\n", - "obj = Horizons(id='1', location='@sun',\n", - " epochs={'start':start_date, 'stop':stop_date,\n", - " 'step':'10y'})\n", - "el = obj.elements()\n", - "t = (el['datetime_jd']-el['datetime_jd'][0]) / 365.25\n", - "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, - "metadata": {}, - "outputs": [], - "source": [ - "varpisim_gr= sim_gr.data['varpi'].sel(name=\"Mercury\")\n", - "varpisim_nogr= sim_nogr.data['varpi'].sel(name=\"Mercury\")\n", - "tsim = sim_gr.data['time']" - ] - }, - { - "cell_type": "code", - "execution_count": null, - "metadata": {}, - "outputs": [], - "source": [ - "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" - ] - }, - { - "cell_type": "code", - "execution_count": null, - "metadata": {}, - "outputs": [], - "source": [ - "fig, ax = plt.subplots()\n", - "\n", - "ax.plot(t, varpi_obs, label=\"JPL Horizons\",linewidth=2.5)\n", - "ax.plot(tsim, varpisim_gr, label=\"Swiftest helio GR\",linewidth=1.5)\n", - "ax.plot(tsim, varpisim_nogr, label=\"Swiftest helio No GR\",linewidth=1.5)\n", - "ax.set_xlabel('Time (y)')\n", - "ax.set_ylabel('Mercury $\\\\varpi$ (deg)')\n", - "ax.legend()\n", - "plt.savefig(\"helio_gr_mercury_precession.png\",dpi=300)\n", - "print('Mean precession rate for Mercury long. peri. (arcsec/100 y)')\n", - "print(f'JPL Horizons : {np.mean(dvarpi_obs)}')\n", - "print(f'Swiftest No GR : {np.mean(dvarpi_nogr)}')\n", - "print(f'Swiftest GR : {np.mean(dvarpi_gr)}')\n", - "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": "Python (My debug_env Kernel)", - "language": "python", - "name": "debug_env" - }, - "language_info": { - "codemirror_mode": { - "name": "ipython", - "version": 3 - }, - "file_extension": ".py", - "mimetype": "text/x-python", - "name": "python", - "nbconvert_exporter": "python", - "pygments_lexer": "ipython3", - "version": "3.8.5" - } - }, - "nbformat": 4, - "nbformat_minor": 4 -} diff --git a/examples/helio_gr_test/swiftest_relativity.py b/examples/helio_gr_test/swiftest_relativity.py deleted file mode 100644 index a5f4e4371..000000000 --- a/examples/helio_gr_test/swiftest_relativity.py +++ /dev/null @@ -1,60 +0,0 @@ -#!/usr/bin/env python -import swiftest -from astroquery.jplhorizons import Horizons -import datetime -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.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.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) - -# Get the start and end date of the simulation so we can compare with the real solar system -start_date = sim_gr.ephemeris_date -tstop_d = sim_gr.param['TSTOP'] * sim_gr.param['TU2S'] / swiftest.JD2S - -stop_date = (datetime.datetime.fromisoformat(start_date) + datetime.timedelta(days=tstop_d)).isoformat() - -#Get the ephemerides of Mercury for the same timeframe as the simulation -obj = Horizons(id='1', location='@sun', - epochs={'start':start_date, 'stop':stop_date, - 'step':'10y'}) -el = obj.elements() -t = (el['datetime_jd']-el['datetime_jd'][0]) / 365.25 -varpi_obs = el['w'] + el['Omega'] - -# 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_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) -ax.plot(tsim, varpisim_gr, label="Swiftest Helio GR",linewidth=1.5) -ax.plot(tsim, varpisim_nogr, label="Swiftest Helio No GR",linewidth=1.5) -ax.set_xlabel('Time (y)') -ax.set_ylabel('Mercury $\\varpi$ (deg)') -ax.legend() -plt.savefig("helio_gr_mercury_precession.png",dpi=300) - -print('Mean precession rate for Mercury long. peri. (arcsec/100 y)') -print(f'JPL Horizons : {np.mean(dvarpi_obs)}') -print(f'Swiftest No GR : {np.mean(dvarpi_nogr)}') -print(f'Swiftest GR : {np.mean(dvarpi_gr)}') -print(f'Obs - Swiftest GR : {np.mean(dvarpi_obs - dvarpi_gr)}') -print(f'Obs - Swiftest No GR : {np.mean(dvarpi_obs - dvarpi_nogr)}') diff --git a/examples/whm_gr_test/swiftest_relativity.py b/examples/whm_gr_test/swiftest_relativity.py index a4ea53c3b..d4b777fa1 100644 --- a/examples/whm_gr_test/swiftest_relativity.py +++ b/examples/whm_gr_test/swiftest_relativity.py @@ -5,10 +5,10 @@ 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 From 3b3b58e2f8c369b52af220148040a31c711972a1 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Sun, 4 Dec 2022 16:01:52 -0500 Subject: [PATCH 239/569] Renamed gr test python script and notebook --- examples/helio_gr_test/helio_gr_test.ipynb | 176 +++++++++++++++++++++ examples/helio_gr_test/helio_gr_test.py | 60 +++++++ 2 files changed, 236 insertions(+) create mode 100644 examples/helio_gr_test/helio_gr_test.ipynb create mode 100644 examples/helio_gr_test/helio_gr_test.py diff --git a/examples/helio_gr_test/helio_gr_test.ipynb b/examples/helio_gr_test/helio_gr_test.ipynb new file mode 100644 index 000000000..e7ae73b23 --- /dev/null +++ b/examples/helio_gr_test/helio_gr_test.ipynb @@ -0,0 +1,176 @@ +{ + "cells": [ + { + "cell_type": "code", + "execution_count": null, + "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": null, + "metadata": {}, + "outputs": [], + "source": [ + "sim_gr = swiftest.Simulation(simdir=\"gr\")\n", + "sim_gr.add_solar_system_body([\"Sun\",\"Mercury\",\"Venus\",\"Earth\",\"Mars\",\"Jupiter\",\"Saturn\",\"Uranus\",\"Neptune\"])" + ] + }, + { + "cell_type": "code", + "execution_count": null, + "metadata": {}, + "outputs": [], + "source": [ + "sim_nogr = swiftest.Simulation(simdir=\"nogr\")\n", + "sim_nogr.add_solar_system_body([\"Sun\",\"Mercury\",\"Venus\",\"Earth\",\"Mars\",\"Jupiter\",\"Saturn\",\"Uranus\",\"Neptune\"])" + ] + }, + { + "cell_type": "code", + "execution_count": null, + "metadata": {}, + "outputs": [], + "source": [ + "run_args = {\"tstop\":1000.0, \"dt\":0.005, \"tstep_out\":10.0, \"dump_cadence\": 0,\"integrator\":\"helio\"}" + ] + }, + { + "cell_type": "code", + "execution_count": null, + "metadata": {}, + "outputs": [], + "source": [ + "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)" + ] + }, + { + "cell_type": "code", + "execution_count": null, + "metadata": {}, + "outputs": [], + "source": [ + "# Get the start and end date of the simulation so we can compare with the real solar system\n", + "start_date = sim_gr.ephemeris_date\n", + "tstop_d = sim_gr.param['TSTOP'] * sim_gr.param['TU2S'] / swiftest.JD2S\n", + "\n", + "stop_date = (datetime.datetime.fromisoformat(start_date) + datetime.timedelta(days=tstop_d)).isoformat()" + ] + }, + { + "cell_type": "code", + "execution_count": null, + "metadata": {}, + "outputs": [], + "source": [ + "#Get the ephemerides of Mercury for the same timeframe as the simulation\n", + "obj = Horizons(id='1', location='@sun',\n", + " epochs={'start':start_date, 'stop':stop_date,\n", + " 'step':'10y'})\n", + "el = obj.elements()\n", + "t = (el['datetime_jd']-el['datetime_jd'][0]) / 365.25\n", + "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, + "metadata": {}, + "outputs": [], + "source": [ + "varpisim_gr= sim_gr.data['varpi'].sel(name=\"Mercury\")\n", + "varpisim_nogr= sim_nogr.data['varpi'].sel(name=\"Mercury\")\n", + "tsim = sim_gr.data['time']" + ] + }, + { + "cell_type": "code", + "execution_count": null, + "metadata": {}, + "outputs": [], + "source": [ + "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" + ] + }, + { + "cell_type": "code", + "execution_count": null, + "metadata": {}, + "outputs": [], + "source": [ + "fig, ax = plt.subplots()\n", + "\n", + "ax.plot(t, varpi_obs, label=\"JPL Horizons\",linewidth=2.5)\n", + "ax.plot(tsim, varpisim_gr, label=\"Swiftest helio GR\",linewidth=1.5)\n", + "ax.plot(tsim, varpisim_nogr, label=\"Swiftest helio No GR\",linewidth=1.5)\n", + "ax.set_xlabel('Time (y)')\n", + "ax.set_ylabel('Mercury $\\\\varpi$ (deg)')\n", + "ax.legend()\n", + "plt.savefig(\"helio_gr_mercury_precession.png\",dpi=300)\n", + "print('Mean precession rate for Mercury long. peri. (arcsec/100 y)')\n", + "print(f'JPL Horizons : {np.mean(dvarpi_obs)}')\n", + "print(f'Swiftest No GR : {np.mean(dvarpi_nogr)}')\n", + "print(f'Swiftest GR : {np.mean(dvarpi_gr)}')\n", + "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": "Python (My debug_env Kernel)", + "language": "python", + "name": "debug_env" + }, + "language_info": { + "codemirror_mode": { + "name": "ipython", + "version": 3 + }, + "file_extension": ".py", + "mimetype": "text/x-python", + "name": "python", + "nbconvert_exporter": "python", + "pygments_lexer": "ipython3", + "version": "3.8.5" + } + }, + "nbformat": 4, + "nbformat_minor": 4 +} diff --git a/examples/helio_gr_test/helio_gr_test.py b/examples/helio_gr_test/helio_gr_test.py new file mode 100644 index 000000000..8d78a861b --- /dev/null +++ b/examples/helio_gr_test/helio_gr_test.py @@ -0,0 +1,60 @@ +#!/usr/bin/env python +import swiftest +from astroquery.jplhorizons import Horizons +import datetime +import numpy as np +import matplotlib.pyplot as plt + +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(simdir="nogr") +sim_nogr.add_solar_system_body(["Sun","Mercury","Venus","Earth","Mars","Jupiter","Saturn","Uranus","Neptune"]) + +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 +tstop_d = sim_gr.param['TSTOP'] * sim_gr.param['TU2S'] / swiftest.JD2S + +stop_date = (datetime.datetime.fromisoformat(start_date) + datetime.timedelta(days=tstop_d)).isoformat() + +#Get the ephemerides of Mercury for the same timeframe as the simulation +obj = Horizons(id='1', location='@sun', + epochs={'start':start_date, 'stop':stop_date, + 'step':'10y'}) +el = obj.elements() +t = (el['datetime_jd']-el['datetime_jd'][0]) / 365.25 +varpi_obs = el['w'] + el['Omega'] + +# 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 / 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) +ax.plot(tsim, varpisim_gr, label="Swiftest Helio GR",linewidth=1.5) +ax.plot(tsim, varpisim_nogr, label="Swiftest Helio No GR",linewidth=1.5) +ax.set_xlabel('Time (y)') +ax.set_ylabel('Mercury $\\varpi$ (deg)') +ax.legend() +plt.savefig("helio_gr_mercury_precession.png",dpi=300) + +print('Mean precession rate for Mercury long. peri. (arcsec/100 y)') +print(f'JPL Horizons : {np.mean(dvarpi_obs)}') +print(f'Swiftest No GR : {np.mean(dvarpi_nogr)}') +print(f'Swiftest GR : {np.mean(dvarpi_gr)}') +print(f'Obs - Swiftest GR : {np.mean(dvarpi_obs - dvarpi_gr)}') +print(f'Obs - Swiftest No GR : {np.mean(dvarpi_obs - dvarpi_nogr)}') From cfcb505138a92e13f4511ebc3a626e20159acdb9 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Sun, 4 Dec 2022 16:57:27 -0500 Subject: [PATCH 240/569] Added extended set of orbital elements to output --- src/modules/swiftest_classes.f90 | 19 ++++++++++++++++--- src/netcdf/netcdf.f90 | 22 +++++++++++++++++++--- src/orbel/orbel.f90 | 26 ++++++++++++++++++++++---- 3 files changed, 57 insertions(+), 10 deletions(-) diff --git a/src/modules/swiftest_classes.f90 b/src/modules/swiftest_classes.f90 index b516a60a2..a09aca917 100644 --- a/src/modules/swiftest_classes.f90 +++ b/src/modules/swiftest_classes.f90 @@ -60,10 +60,18 @@ module swiftest_classes 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. periapsis variable - integer(I4B) :: omega_varid !! ID for the arg. periapsis 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 @@ -1127,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 @@ -1138,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) diff --git a/src/netcdf/netcdf.f90 b/src/netcdf/netcdf.f90 index b5c44b00e..20cccc8e5 100644 --- a/src/netcdf/netcdf.f90 +++ b/src/netcdf/netcdf.f90 @@ -220,6 +220,10 @@ module subroutine netcdf_initialize_output(self, param) 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 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" ) @@ -389,6 +393,10 @@ module subroutine netcdf_open(self, param, readonly) 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) @@ -1033,7 +1041,7 @@ module subroutine netcdf_write_frame_base(self, nciu, param) 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_info(nciu, param) @@ -1069,11 +1077,11 @@ module subroutine netcdf_write_frame_base(self, nciu, param) if (param%lgr) then !! For GR-enabled runs, use the true value of velocity computed above 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%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" ) @@ -1081,6 +1089,14 @@ module subroutine netcdf_write_frame_base(self, nciu, param) 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 end if select type(self) diff --git a/src/orbel/orbel.f90 b/src/orbel/orbel.f90 index 014fe9bae..9e7a571eb 100644 --- a/src/orbel/orbel.f90 +++ b/src/orbel/orbel.f90 @@ -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 @@ -887,15 +888,16 @@ module subroutine orbel_xv2el_vec(self, cb) do concurrent (i = 1:self%nbody) 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,17 @@ 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) + else + f = u + end if + return end subroutine orbel_xv2el From eb344152c11a6e0cd7b7427d584ada53aa9224e1 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Sun, 4 Dec 2022 17:00:54 -0500 Subject: [PATCH 241/569] Fixed it so true anomaly is put on the range 0..2pi --- src/orbel/orbel.f90 | 1 + 1 file changed, 1 insertion(+) diff --git a/src/orbel/orbel.f90 b/src/orbel/orbel.f90 index 9e7a571eb..0a4416160 100644 --- a/src/orbel/orbel.f90 +++ b/src/orbel/orbel.f90 @@ -1037,6 +1037,7 @@ pure module subroutine orbel_xv2el(mu, px, py, pz, vx, vy, vz, a, e, inc, capom, 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 From d972a21154da1984101cbc187da415d096473bbb Mon Sep 17 00:00:00 2001 From: David A Minton Date: Sun, 4 Dec 2022 17:02:29 -0500 Subject: [PATCH 242/569] Fixed up helio_gr_test scripts and notebooks --- examples/helio_gr_test/helio_gr_test.ipynb | 18 ------------------ examples/helio_gr_test/helio_gr_test.py | 4 ---- python/swiftest/swiftest/io.py | 1 - 3 files changed, 23 deletions(-) diff --git a/examples/helio_gr_test/helio_gr_test.ipynb b/examples/helio_gr_test/helio_gr_test.ipynb index e7ae73b23..c6b0c67ea 100644 --- a/examples/helio_gr_test/helio_gr_test.ipynb +++ b/examples/helio_gr_test/helio_gr_test.ipynb @@ -88,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, @@ -143,13 +132,6 @@ "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": { diff --git a/examples/helio_gr_test/helio_gr_test.py b/examples/helio_gr_test/helio_gr_test.py index 8d78a861b..0d9339dbe 100644 --- a/examples/helio_gr_test/helio_gr_test.py +++ b/examples/helio_gr_test/helio_gr_test.py @@ -30,10 +30,6 @@ 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'] diff --git a/python/swiftest/swiftest/io.py b/python/swiftest/swiftest/io.py index dc2899d16..dbcb7430d 100644 --- a/python/swiftest/swiftest/io.py +++ b/python/swiftest/swiftest/io.py @@ -847,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. From eadc6a6b3c2c377961048082c35a6775fd8b17ea Mon Sep 17 00:00:00 2001 From: David A Minton Date: Sun, 4 Dec 2022 17:05:33 -0500 Subject: [PATCH 243/569] updated whm_gr_test --- ...est_relativity.ipynb => whm_gr_test.ipynb} | 34 ++----------------- ...{swiftest_relativity.py => whm_gr_test.py} | 16 ++++----- 2 files changed, 9 insertions(+), 41 deletions(-) rename examples/whm_gr_test/{swiftest_relativity.ipynb => whm_gr_test.ipynb} (84%) rename examples/whm_gr_test/{swiftest_relativity.py => whm_gr_test.py} (78%) diff --git a/examples/whm_gr_test/swiftest_relativity.ipynb b/examples/whm_gr_test/whm_gr_test.ipynb similarity index 84% rename from examples/whm_gr_test/swiftest_relativity.ipynb rename to examples/whm_gr_test/whm_gr_test.ipynb index 477963283..a3dac65b2 100644 --- a/examples/whm_gr_test/swiftest_relativity.ipynb +++ b/examples/whm_gr_test/whm_gr_test.ipynb @@ -10,8 +10,7 @@ "from astroquery.jplhorizons import Horizons\n", "import datetime\n", "import numpy as np\n", - "import matplotlib.pyplot as plt\n", - "import os" + "import matplotlib.pyplot as plt" ] }, { @@ -89,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, @@ -131,8 +119,8 @@ "fig, ax = plt.subplots()\n", "\n", "ax.plot(t, varpi_obs, label=\"JPL Horizons\",linewidth=2.5)\n", - "ax.plot(tsim, varpisim_gr, label=\"Swiftest whm GR\",linewidth=1.5)\n", - "ax.plot(tsim, varpisim_nogr, label=\"Swiftest whm No GR\",linewidth=1.5)\n", + "ax.plot(tsim, varpisim_gr, label=\"Swiftest WHM GR\",linewidth=1.5)\n", + "ax.plot(tsim, varpisim_nogr, label=\"Swiftest WHM No GR\",linewidth=1.5)\n", "ax.set_xlabel('Time (y)')\n", "ax.set_ylabel('Mercury $\\\\varpi$ (deg)')\n", "ax.legend()\n", @@ -144,22 +132,6 @@ "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": [ - "sim_nogr.param" - ] - }, - { - "cell_type": "code", - "execution_count": null, - "metadata": {}, - "outputs": [], - "source": [] } ], "metadata": { diff --git a/examples/whm_gr_test/swiftest_relativity.py b/examples/whm_gr_test/whm_gr_test.py similarity index 78% rename from examples/whm_gr_test/swiftest_relativity.py rename to examples/whm_gr_test/whm_gr_test.py index d4b777fa1..2061e251b 100644 --- a/examples/whm_gr_test/swiftest_relativity.py +++ b/examples/whm_gr_test/whm_gr_test.py @@ -11,9 +11,10 @@ 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="whm",general_relativity=True) -sim_nogr.run(tstop=1000.0, dt=0.005, tstep_out=tstep_out, integrator="whm",general_relativity=False) +run_args = {"tstop":1000.0, "dt":0.005, "tstep_out":10.0, "dump_cadence": 0,"integrator":"whm"} + +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) From b29f153b91d14753fd1bd532b4aa096f41191430 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Sun, 4 Dec 2022 17:20:44 -0500 Subject: [PATCH 244/569] Got rid of the status variable from NetCDF. It is not terribly useful there. --- src/modules/swiftest_classes.f90 | 2 -- src/netcdf/netcdf.f90 | 22 +--------------------- 2 files changed, 1 insertion(+), 23 deletions(-) diff --git a/src/modules/swiftest_classes.f90 b/src/modules/swiftest_classes.f90 index a09aca917..0eb932079 100644 --- a/src/modules/swiftest_classes.f90 +++ b/src/modules/swiftest_classes.f90 @@ -114,8 +114,6 @@ module swiftest_classes 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 diff --git a/src/netcdf/netcdf.f90 b/src/netcdf/netcdf.f90 index 20cccc8e5..b790c7f75 100644 --- a/src/netcdf/netcdf.f90 +++ b/src/netcdf/netcdf.f90 @@ -198,7 +198,6 @@ module subroutine netcdf_initialize_output(self, param) 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" ) @@ -389,7 +388,6 @@ module subroutine netcdf_open(self, param, readonly) ! 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) @@ -870,19 +868,7 @@ module subroutine netcdf_read_particle_info_system(self, nciu, param, plmask, tp end do end if - status = nf90_inq_varid(nciu%id, nciu%status_varname, nciu%status_varid) - if (status == nf90_noerr) then - 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") - end if - do i = 1, npl - call pl%info(i)%set_value(status=ctemp(plind(i))) - end do - do i = 1, ntp - call tp%info(i)%set_value(status=ctemp(tpind(i))) - end do + call cb%info%set_value(status="ACTIVE") if (param%lclose) then @@ -1195,9 +1181,6 @@ module subroutine netcdf_write_info_base(self, nciu, param) charstring = trim(adjustl(self%info(j)%particle_type)) 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(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(nciu%id, nciu%origin_type_varid, charstring, start=[1, idslot], count=[NAMELEN, 1]), "netcdf_write_info_base nf90_put_var origin_type_varid" ) @@ -1224,9 +1207,6 @@ module subroutine netcdf_write_info_base(self, nciu, param) charstring = trim(adjustl(self%info%particle_type)) 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(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(nciu%id, nciu%origin_type_varid, charstring, start=[1, idslot], count=[NAMELEN, 1]), "netcdf_write_info_base nf90_put_var cb origin_type_varid" ) From 1c791aebd2645605d65b5f79d4c495fcb11d76f3 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Sun, 4 Dec 2022 17:25:40 -0500 Subject: [PATCH 245/569] Started creating the encounter output file definition --- src/encounter/encounter_io.f90 | 114 ++++++++++++++++++--------------- 1 file changed, 62 insertions(+), 52 deletions(-) diff --git a/src/encounter/encounter_io.f90 b/src/encounter/encounter_io.f90 index d28ecd1f5..c8cb2e077 100644 --- a/src/encounter/encounter_io.f90 +++ b/src/encounter/encounter_io.f90 @@ -44,56 +44,85 @@ 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. + !! Initialize a NetCDF encounter file system. This is a simplified version of the main simulation output NetCDF file, but with fewer variables. use, intrinsic :: ieee_arithmetic 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 + integer(I4B) :: nvar, varid, vartype real(DP) :: dfill real(SP) :: sfill logical :: fileExists character(len=STRMAX) :: errmsg - integer(I4B), dimension(2), parameter :: collider_dimension = [1,2] + integer(I4B) :: ndims - dfill = ieee_value(dfill, IEEE_QUIET_NAN) - sfill = ieee_value(sfill, IEEE_QUIET_NAN) - ! Check if the file exists, and if it does, delete it - inquire(file=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" ) + associate(nciu => self) + dfill = ieee_value(dfill, IEEE_QUIET_NAN) + sfill = ieee_value(sfill, IEEE_QUIET_NAN) - 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 - 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" ) + ! Check if the file exists, and if it does, delete it + inquire(file=nciu%enc_file, exist=fileExists) + if (fileExists) then + open(unit=LUN, file=nciu%enc_file, status="old", err=667, iomsg=errmsg) + close(unit=LUN, status="delete") + end if + call check( nf90_create(nciu%enc_file, NF90_NETCDF4, nciu%id), "encounter_io_initialize_output nf90_create" ) + + ! Dimensions + call check( nf90_def_dim(nciu%id, nciu%time_dimname, NF90_UNLIMITED, nciu%time_dimid), "encounter_io_initialize_output nf90_def_dim time_dimid" ) ! Simulation time dimension + call check( nf90_def_dim(nciu%id, nciu%space_dimname, NDIM, nciu%space_dimid), "encounter_io_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), "encounter_io_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), "encounter_io_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), "encounter_io_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), "encounter_io_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), "encounter_io_initialize_output nf90_def_var id_varid" ) + call check( nf90_def_var(nciu%id, nciu%name_varname, NF90_CHAR, [nciu%str_dimid, nciu%id_dimid], nciu%name_varid), "encounter_io_initialize_output nf90_def_var name_varid" ) + + ! Variables + call check( nf90_def_var(nciu%id, nciu%name_varname, NF90_CHAR, [nciu%str_dimid, nciu%id_dimid], nciu%name_varid), "encounter_io_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), "encounter_io_initialize_output nf90_def_var ptype_varid" ) + 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), "encounter_io_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), "encounter_io_initialize_output nf90_def_var vh_varid" ) + call check( nf90_def_var(nciu%id, nciu%gmass_varname, nciu%out_type, [nciu%id_dimid, nciu%time_dimid], nciu%Gmass_varid), "encounter_io_initialize_output nf90_def_var Gmass_varid" ) + 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), "encounter_io_initialize_output nf90_def_var radius_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), "encounter_io_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), "encounter_io_initialize_output nf90_def_var rot_varid" ) + end if + call check( nf90_inquire(nciu%id, nVariables=nvar), "encounter_io_initialize_output nf90_inquire nVariables" ) + do varid = 1, nvar + call check( nf90_inquire_variable(nciu%id, varid, xtype=vartype, ndims=ndims), "encounter_io_initialize_output nf90_inquire_variable" ) + select case(vartype) + case(NF90_INT) + call check( nf90_def_var_fill(nciu%id, varid, 0, NF90_FILL_INT), "encounter_io_initialize_output nf90_def_var_fill NF90_INT" ) + case(NF90_FLOAT) + call check( nf90_def_var_fill(nciu%id, varid, 0, sfill), "encounter_io_initialize_output nf90_def_var_fill NF90_FLOAT" ) + case(NF90_DOUBLE) + call check( nf90_def_var_fill(nciu%id, varid, 0, dfill), "encounter_io_initialize_output nf90_def_var_fill NF90_DOUBLE" ) + case(NF90_CHAR) + call check( nf90_def_var_fill(nciu%id, varid, 0, 0), "encounter_io_initialize_output nf90_def_var_fill NF90_CHAR" ) + end select + end do - ! Take the file out of define mode - call check( nf90_enddef(self%id), "encounter_io_initialize_output nf90_enddef" ) + ! Take the file out of define mode + call check( nf90_enddef(nciu%id), "encounter_io_initialize_output nf90_enddef" ) + end associate return @@ -124,25 +153,6 @@ module subroutine encounter_io_open_file(self, param, readonly) 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 From da70fc7cf561c0a7e78aa7a1bd6d9f7e51daaf51 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Sun, 4 Dec 2022 17:29:24 -0500 Subject: [PATCH 246/569] removed unnecessary enounter_io_open function as there is no real need to open old encounter files --- src/encounter/encounter_io.f90 | 47 ------------------------------- src/modules/encounter_classes.f90 | 8 ------ 2 files changed, 55 deletions(-) diff --git a/src/encounter/encounter_io.f90 b/src/encounter/encounter_io.f90 index c8cb2e077..8ed849ba2 100644 --- a/src/encounter/encounter_io.f90 +++ b/src/encounter/encounter_io.f90 @@ -132,30 +132,6 @@ module subroutine encounter_io_initialize_output(self, param) 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) - - return - end subroutine encounter_io_open_file - module subroutine encounter_io_write_frame(self, iu, param) !! author: David A. Minton !! @@ -173,29 +149,6 @@ module subroutine encounter_io_write_frame(self, iu, param) 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 diff --git a/src/modules/encounter_classes.f90 b/src/modules/encounter_classes.f90 index a7f2d72ac..ab8dd0f11 100644 --- a/src/modules/encounter_classes.f90 +++ b/src/modules/encounter_classes.f90 @@ -64,7 +64,6 @@ module encounter_classes 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 @@ -218,13 +217,6 @@ module subroutine encounter_io_initialize_output(self, param) 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 class(encounter_list), intent(in) :: self !! Swiftest encounter structure From 8bd3cdfb888f11321975f1d90b7775bddfe41d8c Mon Sep 17 00:00:00 2001 From: David A Minton Date: Sun, 4 Dec 2022 17:45:27 -0500 Subject: [PATCH 247/569] Started the process of writing the write method for encounter storage objects --- src/encounter/encounter_io.f90 | 28 ++++++++++++++++++++++------ 1 file changed, 22 insertions(+), 6 deletions(-) diff --git a/src/encounter/encounter_io.f90 b/src/encounter/encounter_io.f90 index 8ed849ba2..ac187d54f 100644 --- a/src/encounter/encounter_io.f90 +++ b/src/encounter/encounter_io.f90 @@ -105,6 +105,7 @@ module subroutine encounter_io_initialize_output(self, param) 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), "encounter_io_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), "encounter_io_initialize_output nf90_def_var rot_varid" ) end if + call check( nf90_inquire(nciu%id, nVariables=nvar), "encounter_io_initialize_output nf90_inquire nVariables" ) do varid = 1, nvar call check( nf90_inquire_variable(nciu%id, varid, xtype=vartype, ndims=ndims), "encounter_io_initialize_output nf90_inquire_variable" ) @@ -139,16 +140,31 @@ module subroutine encounter_io_write_frame(self, iu, param) 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(encounter_io_parameters), intent(inout) :: nciu !! 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 + integer(I4B) :: tslot,i,old_mode, n + character(len=NAMELEN) :: charstring + + tslot = nciu%ienc_frame + call check( nf90_set_fill(nciu%id, nf90_nofill, old_mode), "encounter_io_write_frame_base nf90_set_fill" ) + call check( nf90_put_var(nciu%id, nciu%time_varid, self%t, start=[tslot]), "encounter_io_write_frame nf90_put_var time_varid" ) + + ! charstring = trim(adjustl(self%info(j)%name)) + ! call check( nf90_put_var(nciu%id, nciu%name_varid, charstring, start=[1, idslot], count=[NAMELEN, 1]), "encounter_io_write_info_base nf90_put_var name_varid" ) + + ! charstring = trim(adjustl(self%info(j)%particle_type)) + ! call check( nf90_put_var(nciu%id, nciu%ptype_varid, charstring, start=[1, idslot], count=[NAMELEN, 1]), "encounter_io_write_info_base nf90_put_var particle_type_varid" ) - 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(nciu%id, nciu%rh_varid, self%rh(:, j), start=[1,idslot, tslot], count=[NDIM,1,1]), "encounter_io_write_frame_base nf90_put_var rh_varid" ) + ! call check( nf90_put_var(nciu%id, nciu%vh_varid, self%vh(:, j), start=[1,idslot, tslot], count=[NDIM,1,1]), "encounter_io_write_frame_base nf90_put_var vh_varid" ) + ! call check( nf90_put_var(nciu%id, nciu%Gmass_varid, self%Gmass(j), start=[idslot, tslot]), "encounter_io_write_frame_base nf90_put_var body Gmass_varid" ) + ! if (param%lclose) call check( nf90_put_var(nciu%id, nciu%radius_varid, self%radius(j), start=[idslot, tslot]), "encounter_io_write_frame_base nf90_put_var body radius_varid" ) + ! if (param%lrotation) then + ! call check( nf90_put_var(nciu%id, nciu%Ip_varid, self%Ip(:, j), start=[1,idslot, tslot], count=[NDIM,1,1]), "encounter_io_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]), "encounter_io_write_frame_base nf90_put_var body rotx_varid" ) + ! end if return end subroutine encounter_io_write_frame From c094acc315f854c820cd55a42fd48bb01709fc4f Mon Sep 17 00:00:00 2001 From: David A Minton Date: Sun, 4 Dec 2022 17:49:33 -0500 Subject: [PATCH 248/569] fixed argument list in encounter write interface and removed unnecessary encounter_list variables --- src/encounter/encounter_io.f90 | 2 +- src/encounter/encounter_setup.f90 | 20 -------------------- src/encounter/encounter_util.f90 | 24 ------------------------ src/modules/encounter_classes.f90 | 10 ++-------- src/symba/symba_util.f90 | 18 ------------------ 5 files changed, 3 insertions(+), 71 deletions(-) diff --git a/src/encounter/encounter_io.f90 b/src/encounter/encounter_io.f90 index ac187d54f..62920db7e 100644 --- a/src/encounter/encounter_io.f90 +++ b/src/encounter/encounter_io.f90 @@ -133,7 +133,7 @@ module subroutine encounter_io_initialize_output(self, param) end subroutine encounter_io_initialize_output - module subroutine encounter_io_write_frame(self, iu, param) + module subroutine encounter_io_write_frame(self, nciu, param) !! author: David A. Minton !! !! Write a frame of output of an encounter list structure. diff --git a/src/encounter/encounter_setup.f90 b/src/encounter/encounter_setup.f90 index c741cf0a7..22253b4e4 100644 --- a/src/encounter/encounter_setup.f90 +++ b/src/encounter/encounter_setup.f90 @@ -77,12 +77,6 @@ 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%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 @@ -98,12 +92,6 @@ module subroutine encounter_setup_list(self, n) allocate(self%x2(NDIM,n)) allocate(self%v1(NDIM,n)) allocate(self%v2(NDIM,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 @@ -115,14 +103,6 @@ module subroutine encounter_setup_list(self, n) self%x2(:,:) = 0.0_DP self%v1(:,:) = 0.0_DP self%v2(:,:) = 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 cf7dc3a71..d0c801ab4 100644 --- a/src/encounter/encounter_util.f90 +++ b/src/encounter/encounter_util.f90 @@ -36,12 +36,6 @@ 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%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 @@ -70,12 +64,6 @@ 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%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 @@ -115,12 +103,6 @@ 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%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 @@ -216,12 +198,6 @@ 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%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/modules/encounter_classes.f90 b/src/modules/encounter_classes.f90 index ab8dd0f11..3b775370e 100644 --- a/src/modules/encounter_classes.f90 +++ b/src/modules/encounter_classes.f90 @@ -31,12 +31,6 @@ module encounter_classes 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 @@ -217,10 +211,10 @@ module subroutine encounter_io_initialize_output(self, param) class(swiftest_parameters), intent(in) :: param end subroutine encounter_io_initialize_output - module subroutine encounter_io_write_frame(self, iu, param) + module subroutine encounter_io_write_frame(self, nciu, param) implicit none 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(encounter_io_parameters), intent(inout) :: nciu !! 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 diff --git a/src/symba/symba_util.f90 b/src/symba/symba_util.f90 index 621287433..e01392599 100644 --- a/src/symba/symba_util.f90 +++ b/src/symba/symba_util.f90 @@ -726,12 +726,6 @@ 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) @@ -742,12 +736,6 @@ module subroutine symba_util_rearray_pl(self, system, param) ! 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) @@ -775,12 +763,6 @@ 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%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 From c659ca1e7b4f17c1742a79abef5e827ea0090ad9 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Sun, 4 Dec 2022 18:12:03 -0500 Subject: [PATCH 249/569] Added new symba_system_snapshot object to track the system through encounters --- src/encounter/encounter_io.f90 | 2 +- src/modules/symba_classes.f90 | 21 +++++++++++++++++++++ 2 files changed, 22 insertions(+), 1 deletion(-) diff --git a/src/encounter/encounter_io.f90 b/src/encounter/encounter_io.f90 index 62920db7e..f41c25f85 100644 --- a/src/encounter/encounter_io.f90 +++ b/src/encounter/encounter_io.f90 @@ -140,7 +140,7 @@ module subroutine encounter_io_write_frame(self, nciu, param) implicit none ! Arguments class(encounter_list), intent(in) :: self !! Swiftest encounter structure - class(encounter_io_parameters), intent(inout) :: nciu !! Parameters used to identify a particular encounter io NetCDF dataset + class(encounter_io_parameters), intent(inout) :: nciu !! Parameters used to identify a particular encounter io NetCDF dataset class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters ! Internals integer(I4B) :: tslot,i,old_mode, n diff --git a/src/modules/symba_classes.f90 b/src/modules/symba_classes.f90 index cd97b74bd..d72097834 100644 --- a/src/modules/symba_classes.f90 +++ b/src/modules/symba_classes.f90 @@ -201,7 +201,14 @@ module symba_classes final :: symba_util_final_system !! Finalizes the SyMBA nbody system object - deallocates all allocatables end type symba_nbody_system + type, extends(helio_nbody_system) :: symba_system_snapshot + contains + procedure :: snapshot => symba_util_take_system_snapshot + final :: symba_util_final_snapshot + end type + interface + module function symba_collision_check_encounter(self, system, param, t, dt, irec) result(lany_collision) use swiftest_classes, only : swiftest_parameters implicit none @@ -374,6 +381,15 @@ module subroutine symba_util_set_renc(self, scale) integer(I4B), intent(in) :: scale !! Current recursion depth end subroutine symba_util_set_renc + module subroutine symba_util_take_system_snapshot(self, system, param, t) + use swiftest_classes, only : swiftest_parameters + implicit none + class(symba_system_snapshot), intent(inout) :: self !! SyMBA nbody system snapshot object + class(symba_nbody_system), intent(in) :: system !! SyMBA nbody system object + class(symba_parameters), intent(in) :: param !! Current run configuration parameters + real(DP), intent(in) :: t !! current time + end subroutine symba_util_take_system_snapshot + module subroutine symba_io_param_reader(self, unit, iotype, v_list, iostat, iomsg) implicit none class(symba_parameters), intent(inout) :: self !! Current run configuration parameters with SyMBA additionss @@ -648,6 +664,11 @@ module subroutine symba_util_final_pl(self) type(symba_pl), intent(inout) :: self !! SyMBA massive body object end subroutine symba_util_final_pl + module subroutine symba_util_final_snapshot(self) + implicit none + type(symba_system_snapshot), intent(inout) :: self !! SyMBA nbody system object + end subroutine symba_util_final_snapshot + module subroutine symba_util_final_system(self) implicit none type(symba_nbody_system), intent(inout) :: self !! SyMBA nbody system object From f1502c059f188c0f88ad1c47c715b0a7d3ab3308 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Sun, 4 Dec 2022 18:15:50 -0500 Subject: [PATCH 250/569] Added the symba_util_take_system_snapshot implementation interface --- src/symba/symba_util.f90 | 29 +++++++++++++++++++++++++++++ 1 file changed, 29 insertions(+) diff --git a/src/symba/symba_util.f90 b/src/symba/symba_util.f90 index e01392599..3fd00efc8 100644 --- a/src/symba/symba_util.f90 +++ b/src/symba/symba_util.f90 @@ -499,6 +499,20 @@ module subroutine symba_util_final_system(self) end subroutine symba_util_final_system + module subroutine symba_util_final_snapshot(self) + !! author: David A. Minton + !! + !! Finalize the SyMBA nbody system object - deallocates all allocatables + implicit none + ! Argument + type(symba_system_snapshot), intent(inout) :: self !! SyMBA nbody system object + + call self%dealloc() + + return + end subroutine symba_util_final_snapshot + + module subroutine symba_util_final_tp(self) !! author: David A. Minton !! @@ -1279,4 +1293,19 @@ module subroutine symba_util_spill_tp(self, discards, lspill_list, ldestructive) return end subroutine symba_util_spill_tp + + module subroutine symba_util_take_system_snapshot(self, system, param, t) + !! author: David A. Minton + !! + !! Takes a minimal snapshot of the state of the system during an encounter so that the trajectories + !! Can be played back through the encounter + implicit none + class(symba_system_snapshot), intent(inout) :: self !! SyMBA nbody system snapshot object + class(symba_nbody_system), intent(in) :: system !! SyMBA nbody system object + class(symba_parameters), intent(in) :: param !! Current run configuration parameters + real(DP), intent(in) :: t !! current time + + return + end subroutine symba_util_take_system_snapshot + end submodule s_symba_util From 71b7f9940fbf604d4adae0ddf6611f19f22cba7e Mon Sep 17 00:00:00 2001 From: David A Minton Date: Sun, 4 Dec 2022 21:02:24 -0500 Subject: [PATCH 251/569] Lingering issues with THE SPACE DIMENSION --- python/swiftest/swiftest/init_cond.py | 5 +- python/swiftest/swiftest/io.py | 84 +++++++------------- python/swiftest/swiftest/simulation_class.py | 1 + 3 files changed, 33 insertions(+), 57 deletions(-) diff --git a/python/swiftest/swiftest/init_cond.py b/python/swiftest/swiftest/init_cond.py index b24eff0d8..8dcf08cf2 100644 --- a/python/swiftest/swiftest/init_cond.py +++ b/python/swiftest/swiftest/init_cond.py @@ -284,10 +284,9 @@ def vec2xr(param: Dict, **kwargs: Any): kwargs = {k:kwargs[k] for k,v in kwargs.items() if v is not None} if param['ROTATION']: if "rot" not in kwargs and "Gmass" in kwargs: - warnings.warn("Rotation vectors must be given when rotation is enabled for massive bodies",stacklevel=2) - return + kwargs['rot'] = np.zeros((len(kwargs['Gmass']),3)) if "Ip" not in kwargs and "rot" in kwargs: - kwargs['Ip'] = np.full_like(rot, 0.4) + kwargs['Ip'] = np.full_like(kwargs['rot'], 0.4) if "time" not in kwargs: kwargs["time"] = np.array([0.0]) diff --git a/python/swiftest/swiftest/io.py b/python/swiftest/swiftest/io.py index dbcb7430d..40ce7ae33 100644 --- a/python/swiftest/swiftest/io.py +++ b/python/swiftest/swiftest/io.py @@ -529,12 +529,8 @@ def swifter_stream(f, param): tlab = [] if param['OUT_FORM'] == 'XV' or param['OUT_FORM'] == 'XVEL': - tlab.append('rhx') - tlab.append('rhy') - tlab.append('rhz') - tlab.append('vhx') - tlab.append('vhy') - tlab.append('vhz') + tlab.append('rh') + tlab.append('vh') if param['OUT_FORM'] == 'EL' or param['OUT_FORM'] == 'XVEL': tlab.append('a') tlab.append('e') @@ -577,12 +573,8 @@ def make_swiftest_labels(param): """ tlab = [] if param['OUT_FORM'] == 'XV' or param['OUT_FORM'] == 'XVEL': - tlab.append('rhx') - tlab.append('rhy') - tlab.append('rhz') - tlab.append('vhx') - tlab.append('vhy') - tlab.append('vhz') + tlab.append('rh') + tlab.append('vh') if param['OUT_FORM'] == 'EL' or param['OUT_FORM'] == 'XVEL': tlab.append('a') @@ -599,18 +591,10 @@ def make_swiftest_labels(param): plab.append('rhill') clab = ['Gmass', 'radius', 'j2rp2', 'j4rp4'] if param['ROTATION']: - clab.append('Ip1') - clab.append('Ip2') - clab.append('Ip3') - clab.append('rotx') - clab.append('roty') - clab.append('rotz') - plab.append('Ip1') - plab.append('Ip2') - plab.append('Ip3') - plab.append('rotx') - plab.append('roty') - plab.append('rotz') + clab.append('Ip') + clab.append('rot') + plab.append('Ip') + plab.append('rot') if param['TIDES']: clab.append('k2') clab.append('Q') @@ -619,19 +603,11 @@ def make_swiftest_labels(param): infolab_float = [ "origin_time", - "origin_rhx", - "origin_rhy", - "origin_rhz", - "origin_vhx", - "origin_vhy", - "origin_vhz", + "origin_rh", + "origin_vh", "discard_time", - "discard_rhx", - "discard_rhy", - "discard_rhz", - "discard_vhx", - "discard_vhy", - "discard_vhz", + "discard_rh", + "discard_vh", ] infolab_int = [ "collision_id", @@ -1042,7 +1018,7 @@ def swiftest_particle_2xr(param): ------- infoxr : xarray dataset """ - veclab = ['time_origin', 'rhx_origin', 'py_origin', 'pz_origin', 'vhx_origin', 'vhy_origin', 'vhz_origin'] + veclab = ['time_origin', 'rh_origin', 'vh_origin'] id_list = [] origin_type_list = [] origin_vec_list = [] @@ -1099,7 +1075,7 @@ def select_active_from_frame(ds, param, framenum=-1): # Select only the active particles at this time step # Remove the inactive particles if param['OUT_FORM'] == 'XV' or param['OUT_FORM'] == 'XVEL': - iactive = iframe[count_dim].where((~np.isnan(iframe['Gmass'])) | (~np.isnan(iframe['rhx'])), drop=True)[count_dim] + iactive = iframe[count_dim].where((~np.isnan(iframe['Gmass'])) | (~np.isnan(iframe['rh'].isel(space=0))), drop=True)[count_dim] else: iactive = iframe[count_dim].where((~np.isnan(iframe['Gmass'])) | (~np.isnan(iframe['a'])), drop = True)[count_dim] if count_dim == "id": @@ -1164,12 +1140,12 @@ def swiftest_xr2infile(ds, param, in_type="NETCDF_DOUBLE", infile_name=None,fram J4 = np.double(cb['j4rp4']) cbname = cb['name'].values[0] if param['ROTATION']: - Ip1cb = np.double(cb['Ip1']) - Ip2cb = np.double(cb['Ip2']) - Ip3cb = np.double(cb['Ip3']) - rotxcb = np.double(cb['rotx']) - rotycb = np.double(cb['roty']) - rotzcb = np.double(cb['rotz']) + Ip1cb = np.double(cb['Ip'].values[0]) + Ip2cb = np.double(cb['Ip'].values[1]) + Ip3cb = np.double(cb['Ip'].values[2]) + rotxcb = np.double(cb['rot'].values[0]) + rotycb = np.double(cb['rot'].values[1]) + rotzcb = np.double(cb['rot'].values[2]) cbid = int(0) if in_type == 'ASCII': @@ -1196,16 +1172,16 @@ def swiftest_xr2infile(ds, param, in_type="NETCDF_DOUBLE", infile_name=None,fram if param['CHK_CLOSE']: print(pli['radius'].values[0], file=plfile) if param['IN_FORM'] == 'XV': - print(pli['rhx'].values[0], pli['rhy'].values[0], pli['rhz'].values[0], file=plfile) - print(pli['vhx'].values[0], pli['vhy'].values[0], pli['vhz'].values[0], file=plfile) + print(pli['rh'].values[0,0], pli['rh'].values[0,1], pli['rh'].values[0,2], file=plfile) + print(pli['vh'].values[0,0], pli['vh'].values[0,1], pli['vh'].values[0,2], file=plfile) elif param['IN_FORM'] == 'EL': print(pli['a'].values[0], pli['e'].values[0], pli['inc'].values[0], file=plfile) print(pli['capom'].values[0], pli['omega'].values[0], pli['capm'].values[0], file=plfile) else: print(f"{param['IN_FORM']} is not a valid input format type.") if param['ROTATION']: - print(pli['Ip1'].values[0], pli['Ip2'].values[0], pli['Ip3'].values[0], file=plfile) - print(pli['rotx'].values[0], pli['roty'].values[0], pli['rotz'].values[0], file=plfile) + print(pli['Ip'].values[0,0], pli['Ip'].values[0,1], pli['Ip'].values[0,2], file=plfile) + print(pli['rot'].values[0,0], pli['rot'].values[0,1], pli['rot'].values[0,2], file=plfile) plfile.close() # TP file @@ -1215,8 +1191,8 @@ def swiftest_xr2infile(ds, param, in_type="NETCDF_DOUBLE", infile_name=None,fram tpi = tp.sel(id=i) print(tpi['name'].values[0], file=tpfile) if param['IN_FORM'] == 'XV': - print(tpi['rhx'].values[0], tpi['rhy'].values[0], tpi['rhz'].values[0], file=tpfile) - print(tpi['vhx'].values[0], tpi['vhy'].values[0], tpi['vhz'].values[0], file=tpfile) + print(tpi['rh'].values[0,0], tpi['rh'].values[0,1], tpi['rh'].values[0,2], file=tpfile) + print(tpi['vh'].values[0,0], tpi['vh'].values[0,1], tpi['vh'].values[0,2], file=tpfile) elif param['IN_FORM'] == 'EL': print(tpi['a'].values[0], tpi['e'].values[0], tpi['inc'].values[0], file=tpfile) print(tpi['capom'].values[0], tpi['omega'].values[0], tpi['capm'].values[0], file=tpfile) @@ -1279,8 +1255,8 @@ def swifter_xr2infile(ds, param, framenum=-1): print(i.values, pli['Gmass'].values, file=plfile) if param['CHK_CLOSE']: print(pli['radius'].values, file=plfile) - print(pli['rhx'].values, pli['rhy'].values, pli['rhz'].values, file=plfile) - print(pli['vhx'].values, pli['vhy'].values, pli['vhz'].values, file=plfile) + print(pli['rh'].values[0,0], pli['ry'].values[0,1], pli['rh'].values[0,2], file=plfile) + print(pli['vh'].values[0,0], pli['vh'].values[0,1], pli['vh'].values[0,2], file=plfile) plfile.close() # TP file @@ -1289,8 +1265,8 @@ def swifter_xr2infile(ds, param, framenum=-1): for i in tp.id: tpi = tp.sel(id=i) print(i.values, file=tpfile) - print(tpi['rhx'].values, tpi['rhy'].values, tpi['rhz'].values, file=tpfile) - print(tpi['vhx'].values, tpi['vhy'].values, tpi['vhz'].values, file=tpfile) + print(tpi['rh'].values[0,0], tpi['ry'].values[0,1], tpi['rh'].values[0,2], file=tpfile) + print(tpi['vh'].values[0,0], tpi['vh'].values[0,1], tpi['vh'].values[0,2], file=tpfile) tpfile.close() else: # Now make Swiftest files diff --git a/python/swiftest/swiftest/simulation_class.py b/python/swiftest/swiftest/simulation_class.py index 22f2001ac..6cd75a521 100644 --- a/python/swiftest/swiftest/simulation_class.py +++ b/python/swiftest/swiftest/simulation_class.py @@ -2811,6 +2811,7 @@ def initial_conditions_from_bin(self, framenum=-1, new_param=None, new_param_fil A dataset containing the extracted initial condition data. """ + frame = None if codename != "Swiftest": self.save(new_param_file, framenum, codename) return From 086872160622bbddb94422dc1e425e5022684488 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Sun, 4 Dec 2022 21:03:04 -0500 Subject: [PATCH 252/569] More updates for preparing to output encounter data --- examples/Fragmentation/Fragmentation_Movie.py | 13 ++++++------- src/modules/symba_classes.f90 | 12 +++++++----- src/setup/setup.f90 | 2 ++ src/symba/symba_step.f90 | 2 ++ src/symba/symba_util.f90 | 5 +++++ 5 files changed, 22 insertions(+), 12 deletions(-) diff --git a/examples/Fragmentation/Fragmentation_Movie.py b/examples/Fragmentation/Fragmentation_Movie.py index 24fc40e30..fc308687a 100644 --- a/examples/Fragmentation/Fragmentation_Movie.py +++ b/examples/Fragmentation/Fragmentation_Movie.py @@ -36,7 +36,7 @@ # Define the names and initial conditions of the various fragmentation simulation types # ---------------------------------------------------------------------------------------------------------------------- available_movie_styles = ["disruption_headon", "supercatastrophic_off_axis", "hitandrun"] -movie_title_list = ["Head-on Disrutption", "Off-axis Supercatastrophic", "Hit and Run"] +movie_title_list = ["Head-on Disruption", "Off-axis Supercatastrophic", "Hit and Run"] movie_titles = dict(zip(available_movie_styles, movie_title_list)) # These initial conditions were generated by trial and error @@ -135,8 +135,8 @@ def center(Gmass, x, y): y_com = np.sum(Gmass * y) / np.sum(Gmass) return x_com, y_com - Gmass, x, y, point_rad = next(self.data_stream(frame)) - x_com, y_com = center(Gmass, x, y) + Gmass, rh, point_rad = next(self.data_stream(frame)) + x_com, y_com = center(Gmass, rh[:,1], rh[:,2]) self.scatter_artist.set_offsets(np.c_[x - x_com, y - y_com]) self.scatter_artist.set_sizes(point_rad) return self.scatter_artist, @@ -147,10 +147,9 @@ def data_stream(self, frame=0): ds = ds.where(ds['name'] != "Sun", drop=True) radius = ds['radius'].values Gmass = ds['Gmass'].values - x = ds['xhx'].values - y = ds['xhy'].values + rh = ds['rh'].values point_rad = 2 * radius * self.ax_pt_size - yield Gmass, x, y, point_rad + yield Gmass, rh, point_rad if __name__ == "__main__": @@ -188,7 +187,7 @@ 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], rh=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 diff --git a/src/modules/symba_classes.f90 b/src/modules/symba_classes.f90 index d72097834..432126e4e 100644 --- a/src/modules/symba_classes.f90 +++ b/src/modules/symba_classes.f90 @@ -177,6 +177,12 @@ module symba_classes procedure :: resolve_collision => symba_collision_resolve_plplenc !! Process the pl-pl collision list, then modifiy the massive bodies based on the outcome of the c end type symba_plplenc + type, extends(helio_nbody_system) :: symba_system_snapshot + contains + procedure :: snapshot => symba_util_take_system_snapshot + final :: symba_util_final_snapshot + end type + !******************************************************************************************************************************** ! symba_nbody_system class definitions and method interfaces !******************************************************************************************************************************** @@ -188,6 +194,7 @@ module symba_classes 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 + type(symba_system_snapshot) :: snapshot 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 @@ -201,11 +208,6 @@ module symba_classes final :: symba_util_final_system !! Finalizes the SyMBA nbody system object - deallocates all allocatables end type symba_nbody_system - type, extends(helio_nbody_system) :: symba_system_snapshot - contains - procedure :: snapshot => symba_util_take_system_snapshot - final :: symba_util_final_snapshot - end type interface diff --git a/src/setup/setup.f90 b/src/setup/setup.f90 index 26aed237c..4a3d98aed 100644 --- a/src/setup/setup.f90 +++ b/src/setup/setup.f90 @@ -68,6 +68,8 @@ module subroutine setup_construct_system(system, param) allocate(symba_pltpenc :: system%pltpenc_list) allocate(symba_plplenc :: system%plplenc_list) allocate(symba_plplenc :: system%plplcollision_list) + allocate(symba_pl :: system%snapshot%pl) + allocate(symba_tp :: system%snapshot%tp) end select case (RINGMOONS) write(*,*) 'RINGMOONS-SyMBA integrator not yet enabled' diff --git a/src/symba/symba_step.f90 b/src/symba/symba_step.f90 index ecf1874f6..9e9d2de41 100644 --- a/src/symba/symba_step.f90 +++ b/src/symba/symba_step.f90 @@ -218,6 +218,8 @@ recursive module subroutine symba_step_recur_system(self, param, t, ireci) call pl%drift(system, param, dtl) call tp%drift(system, param, dtl) + !call system% + if (lencounter) call system%recursive_step(param, t+dth,irecp) system%irec = ireci diff --git a/src/symba/symba_util.f90 b/src/symba/symba_util.f90 index 3fd00efc8..63ba3224b 100644 --- a/src/symba/symba_util.f90 +++ b/src/symba/symba_util.f90 @@ -1300,10 +1300,15 @@ module subroutine symba_util_take_system_snapshot(self, system, param, t) !! Takes a minimal snapshot of the state of the system during an encounter so that the trajectories !! Can be played back through the encounter implicit none + ! Internals class(symba_system_snapshot), intent(inout) :: self !! SyMBA nbody system snapshot object class(symba_nbody_system), intent(in) :: system !! SyMBA nbody system object class(symba_parameters), intent(in) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! current time + ! Arguments + logical, dimension(:), allocatable :: lmask + + !if (system%pl) return end subroutine symba_util_take_system_snapshot From f4fba0e972ebdc9e358f362a66e7e5f006d0a15d Mon Sep 17 00:00:00 2001 From: David A Minton Date: Sun, 4 Dec 2022 21:07:15 -0500 Subject: [PATCH 253/569] Fixed input file for fragmentation movie --- examples/Fragmentation/Fragmentation_Movie.py | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/examples/Fragmentation/Fragmentation_Movie.py b/examples/Fragmentation/Fragmentation_Movie.py index fc308687a..5d660bcec 100644 --- a/examples/Fragmentation/Fragmentation_Movie.py +++ b/examples/Fragmentation/Fragmentation_Movie.py @@ -167,7 +167,6 @@ def data_stream(self, frame=0): movie_styles = available_movie_styles.copy() for style in movie_styles: - param_file = Path(style) / "param.in" bin_file = Path(style) / "bin.nc" if bin_file.exists(): user_selection = input(f"An older simulation of {movie_titles[style]} exists. Do you want to re-run it? [y/N] ") @@ -185,7 +184,7 @@ def data_stream(self, frame=0): # Pull in the Swiftest output data from the parameter file and store it as a Xarray dataset. if run_new: - sim = swiftest.Simulation(param_file=param_file, rotation=True, init_cond_format = "XV", compute_conservation_values=True) + sim = swiftest.Simulation(simdir=style, 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], rh=pos_vectors[style], vh=vel_vectors[style]) #, rot=rot_vectors[style]) From e8f01d59101710e67cd61db1c3c84594c545eec0 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Sun, 4 Dec 2022 22:46:00 -0500 Subject: [PATCH 254/569] Fixed some bad loop indexing --- src/io/io.f90 | 4 ++-- src/main/swiftest_driver.f90 | 2 +- src/modules/swiftest_classes.f90 | 2 +- src/netcdf/netcdf.f90 | 8 ++++---- 4 files changed, 8 insertions(+), 8 deletions(-) diff --git a/src/io/io.f90 b/src/io/io.f90 index 81aca06d1..69c32f5dc 100644 --- a/src/io/io.f90 +++ b/src/io/io.f90 @@ -256,7 +256,7 @@ module subroutine io_dump_system(self, param) dump_param%out_form = "XV" dump_param%outfile = trim(adjustl(DUMP_NC_FILE(idx))) - dump_param%ioutput = 0 + dump_param%ioutput = 1 call dump_param%nciu%initialize(dump_param) call self%write_frame(dump_param%nciu, dump_param) call dump_param%nciu%close() @@ -285,7 +285,7 @@ module subroutine io_dump_storage(self, param) integer(I4B) :: i integer(I8B) :: iloop_start - iloop_start = param%iloop - int(param%istep_out * param%dump_cadence + 1, kind=I8B) + iloop_start = max(param%iloop - int(param%istep_out * param%dump_cadence, kind=I8B),1) do i = 1, param%dump_cadence param%ioutput = int(iloop_start / param%istep_out, kind=I4B) + i if (allocated(self%frame(i)%item)) then diff --git a/src/main/swiftest_driver.f90 b/src/main/swiftest_driver.f90 index 846915444..528e0c73d 100644 --- a/src/main/swiftest_driver.f90 +++ b/src/main/swiftest_driver.f90 @@ -80,7 +80,7 @@ program swiftest_driver ! Set up loop and output cadence variables t = tstart nloops = ceiling((tstop - t0) / dt, kind=I8B) - istart = ceiling((tstart - t0) / dt + 1, kind=I8B) + istart = ceiling((tstart - t0) / dt + 1.0_DP, kind=I8B) ioutput = int(istart / istep_out, kind=I4B) ! Set up system storage for intermittent file dumps diff --git a/src/modules/swiftest_classes.f90 b/src/modules/swiftest_classes.f90 index 0eb932079..4f87b7707 100644 --- a/src/modules/swiftest_classes.f90 +++ b/src/modules/swiftest_classes.f90 @@ -159,7 +159,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(I4B) :: ioutput = 0 !! Output counter + integer(I4B) :: ioutput = 1 !! Output counter character(STRMAX) :: incbfile = CB_INFILE !! Name of input file for the central body character(STRMAX) :: inplfile = PL_INFILE !! Name of input file for massive bodies character(STRMAX) :: intpfile = TP_INFILE !! Name of input file for test particles diff --git a/src/netcdf/netcdf.f90 b/src/netcdf/netcdf.f90 index b790c7f75..261fa6355 100644 --- a/src/netcdf/netcdf.f90 +++ b/src/netcdf/netcdf.f90 @@ -456,7 +456,7 @@ module function netcdf_read_frame_system(self, nciu, param) result(ierr) call pl%setup(npl, param) call tp%setup(ntp, param) - tslot = param%ioutput + 1 + tslot = param%ioutput call check( nf90_inquire_dimension(nciu%id, nciu%id_dimid, len=idmax), "netcdf_read_frame_system nf90_inquire_dimension id_dimid" ) allocate(rtemp(idmax)) @@ -699,7 +699,7 @@ module subroutine netcdf_read_hdr_system(self, nciu, param) logical, dimension(:), allocatable :: plmask, tpmask, plmmask - tslot = param%ioutput + 1 + tslot = param%ioutput 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" ) @@ -1031,7 +1031,7 @@ module subroutine netcdf_write_frame_base(self, nciu, param) call self%write_info(nciu, param) - tslot = param%ioutput + 1 + tslot = param%ioutput call check( nf90_set_fill(nciu%id, nf90_nofill, old_mode), "netcdf_write_frame_base nf90_set_fill" ) select type(self) @@ -1242,7 +1242,7 @@ module subroutine netcdf_write_hdr_system(self, nciu, param) ! Internals integer(I4B) :: tslot - tslot = param%ioutput + 1 + tslot = param%ioutput 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" ) From 4fa874a3e3c16d464ce42eac844df0a6f961828d Mon Sep 17 00:00:00 2001 From: David A Minton Date: Mon, 5 Dec 2022 06:34:17 -0500 Subject: [PATCH 255/569] Restructured encounter storage objects and methods to put them in symba --- src/CMakeLists.txt | 1 - src/encounter/encounter_io.f90 | 172 ------------------------------ src/modules/encounter_classes.f90 | 45 -------- src/modules/symba_classes.f90 | 91 ++++++++++++---- src/setup/setup.f90 | 2 - src/symba/symba_io.f90 | 160 +++++++++++++++++++++++++++ src/symba/symba_util.f90 | 30 ++++-- 7 files changed, 249 insertions(+), 252 deletions(-) delete mode 100644 src/encounter/encounter_io.f90 diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index 668b07c47..63c89f2b3 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -28,7 +28,6 @@ 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/encounter/encounter_io.f90 b/src/encounter/encounter_io.f90 deleted file mode 100644 index f41c25f85..000000000 --- a/src/encounter/encounter_io.f90 +++ /dev/null @@ -1,172 +0,0 @@ -!! Copyright 2022 - David Minton, Carlisle Wishard, Jennifer Pouplin, Jake Elliott, & Dana Singh -!! This file is part of Swiftest. -!! Swiftest is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License -!! as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. -!! Swiftest is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty -!! of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. -!! You should have received a copy of the GNU General Public License along with Swiftest. -!! If not, see: https://www.gnu.org/licenses. - -submodule (encounter_classes) s_encounter_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. This is a simplified version of the main simulation output NetCDF file, but with fewer 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 - integer(I4B) :: nvar, varid, vartype - real(DP) :: dfill - real(SP) :: sfill - logical :: fileExists - character(len=STRMAX) :: errmsg - integer(I4B) :: ndims - - - associate(nciu => self) - dfill = ieee_value(dfill, IEEE_QUIET_NAN) - sfill = ieee_value(sfill, IEEE_QUIET_NAN) - - select case (param%out_type) - case("NETCDF_FLOAT") - self%out_type = NF90_FLOAT - case("NETCDF_DOUBLE") - self%out_type = NF90_DOUBLE - end select - - - ! Check if the file exists, and if it does, delete it - inquire(file=nciu%enc_file, exist=fileExists) - if (fileExists) then - open(unit=LUN, file=nciu%enc_file, status="old", err=667, iomsg=errmsg) - close(unit=LUN, status="delete") - end if - - call check( nf90_create(nciu%enc_file, NF90_NETCDF4, nciu%id), "encounter_io_initialize_output nf90_create" ) - - ! Dimensions - call check( nf90_def_dim(nciu%id, nciu%time_dimname, NF90_UNLIMITED, nciu%time_dimid), "encounter_io_initialize_output nf90_def_dim time_dimid" ) ! Simulation time dimension - call check( nf90_def_dim(nciu%id, nciu%space_dimname, NDIM, nciu%space_dimid), "encounter_io_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), "encounter_io_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), "encounter_io_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), "encounter_io_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), "encounter_io_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), "encounter_io_initialize_output nf90_def_var id_varid" ) - call check( nf90_def_var(nciu%id, nciu%name_varname, NF90_CHAR, [nciu%str_dimid, nciu%id_dimid], nciu%name_varid), "encounter_io_initialize_output nf90_def_var name_varid" ) - - ! Variables - call check( nf90_def_var(nciu%id, nciu%name_varname, NF90_CHAR, [nciu%str_dimid, nciu%id_dimid], nciu%name_varid), "encounter_io_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), "encounter_io_initialize_output nf90_def_var ptype_varid" ) - 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), "encounter_io_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), "encounter_io_initialize_output nf90_def_var vh_varid" ) - call check( nf90_def_var(nciu%id, nciu%gmass_varname, nciu%out_type, [nciu%id_dimid, nciu%time_dimid], nciu%Gmass_varid), "encounter_io_initialize_output nf90_def_var Gmass_varid" ) - 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), "encounter_io_initialize_output nf90_def_var radius_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), "encounter_io_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), "encounter_io_initialize_output nf90_def_var rot_varid" ) - end if - - call check( nf90_inquire(nciu%id, nVariables=nvar), "encounter_io_initialize_output nf90_inquire nVariables" ) - do varid = 1, nvar - call check( nf90_inquire_variable(nciu%id, varid, xtype=vartype, ndims=ndims), "encounter_io_initialize_output nf90_inquire_variable" ) - select case(vartype) - case(NF90_INT) - call check( nf90_def_var_fill(nciu%id, varid, 0, NF90_FILL_INT), "encounter_io_initialize_output nf90_def_var_fill NF90_INT" ) - case(NF90_FLOAT) - call check( nf90_def_var_fill(nciu%id, varid, 0, sfill), "encounter_io_initialize_output nf90_def_var_fill NF90_FLOAT" ) - case(NF90_DOUBLE) - call check( nf90_def_var_fill(nciu%id, varid, 0, dfill), "encounter_io_initialize_output nf90_def_var_fill NF90_DOUBLE" ) - case(NF90_CHAR) - call check( nf90_def_var_fill(nciu%id, varid, 0, 0), "encounter_io_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), "encounter_io_initialize_output nf90_enddef" ) - end associate - - 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_write_frame(self, nciu, 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) :: nciu !! Parameters used to identify a particular encounter io NetCDF dataset - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - ! Internals - integer(I4B) :: tslot,i,old_mode, n - character(len=NAMELEN) :: charstring - - tslot = nciu%ienc_frame - call check( nf90_set_fill(nciu%id, nf90_nofill, old_mode), "encounter_io_write_frame_base nf90_set_fill" ) - call check( nf90_put_var(nciu%id, nciu%time_varid, self%t, start=[tslot]), "encounter_io_write_frame nf90_put_var time_varid" ) - - ! charstring = trim(adjustl(self%info(j)%name)) - ! call check( nf90_put_var(nciu%id, nciu%name_varid, charstring, start=[1, idslot], count=[NAMELEN, 1]), "encounter_io_write_info_base nf90_put_var name_varid" ) - - ! charstring = trim(adjustl(self%info(j)%particle_type)) - ! call check( nf90_put_var(nciu%id, nciu%ptype_varid, charstring, start=[1, idslot], count=[NAMELEN, 1]), "encounter_io_write_info_base nf90_put_var particle_type_varid" ) - - - ! call check( nf90_put_var(nciu%id, nciu%rh_varid, self%rh(:, j), start=[1,idslot, tslot], count=[NDIM,1,1]), "encounter_io_write_frame_base nf90_put_var rh_varid" ) - ! call check( nf90_put_var(nciu%id, nciu%vh_varid, self%vh(:, j), start=[1,idslot, tslot], count=[NDIM,1,1]), "encounter_io_write_frame_base nf90_put_var vh_varid" ) - ! call check( nf90_put_var(nciu%id, nciu%Gmass_varid, self%Gmass(j), start=[idslot, tslot]), "encounter_io_write_frame_base nf90_put_var body Gmass_varid" ) - ! if (param%lclose) call check( nf90_put_var(nciu%id, nciu%radius_varid, self%radius(j), start=[idslot, tslot]), "encounter_io_write_frame_base nf90_put_var body radius_varid" ) - ! if (param%lrotation) then - ! call check( nf90_put_var(nciu%id, nciu%Ip_varid, self%Ip(:, j), start=[1,idslot, tslot], count=[NDIM,1,1]), "encounter_io_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]), "encounter_io_write_frame_base nf90_put_var body rotx_varid" ) - ! end if - - return - end subroutine encounter_io_write_frame - -end submodule s_encounter_io \ No newline at end of file diff --git a/src/modules/encounter_classes.f90 b/src/modules/encounter_classes.f90 index 3b775370e..b04fca1a1 100644 --- a/src/modules/encounter_classes.f90 +++ b/src/modules/encounter_classes.f90 @@ -38,35 +38,9 @@ module encounter_classes 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 - 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) @@ -199,25 +173,6 @@ 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_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_write_frame(self, nciu, param) - implicit none - class(encounter_list), intent(in) :: self !! Swiftest encounter structure - class(encounter_io_parameters), intent(inout) :: nciu !! 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) implicit none class(encounter_bounding_box), intent(inout) :: self !! Swiftest encounter structure diff --git a/src/modules/symba_classes.f90 b/src/modules/symba_classes.f90 index 432126e4e..f08ee4c00 100644 --- a/src/modules/symba_classes.f90 +++ b/src/modules/symba_classes.f90 @@ -13,10 +13,10 @@ module symba_classes !! Definition of classes and methods specific to the SyMBA integrator !! Adapted from David E. Kaufmann's Swifter routine: module_symba.f90 use swiftest_globals - use swiftest_classes, only : swiftest_parameters, swiftest_base, swiftest_particle_info, netcdf_parameters + use swiftest_classes, only : swiftest_parameters, swiftest_base, swiftest_particle_info, swiftest_storage, 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, encounter_storage + use encounter_classes, only : encounter_list implicit none public @@ -177,24 +177,39 @@ module symba_classes procedure :: resolve_collision => symba_collision_resolve_plplenc !! Process the pl-pl collision list, then modifiy the massive bodies based on the outcome of the c end type symba_plplenc - type, extends(helio_nbody_system) :: symba_system_snapshot + + !! NetCDF dimension and variable names for the enounter save object + type, extends(netcdf_parameters) :: symba_io_encounter_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) :: level_varname = "level" !! Recursion depth + integer(I4B) :: level_varid !! ID for the recursion level variable contains - procedure :: snapshot => symba_util_take_system_snapshot - final :: symba_util_final_snapshot - end type + procedure :: initialize => symba_io_encounter_initialize_output !! Initialize a set of parameters used to identify a NetCDF output object + end type symba_io_encounter_parameters + + type, extends(swiftest_storage) :: symba_encounter_storage + !! A class that that is used to store simulation history data between file output + type(symba_io_encounter_parameters) :: nciu + contains + procedure :: dump => symba_io_encounter_dump !! Dumps contents of encounter history to file + final :: symba_util_final_encounter_storage + end type symba_encounter_storage + !******************************************************************************************************************************** ! 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 - 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 - type(symba_system_snapshot) :: snapshot + 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(symba_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 @@ -209,6 +224,14 @@ module symba_classes end type symba_nbody_system + type, extends(symba_nbody_system) :: symba_encounter_snapshot + contains + procedure :: snapshot => symba_util_take_encounter_snapshot + procedure :: write_encounter_frame => symba_io_encounter_write_frame !! Writes a frame of encounter data to file + generic :: write_frame => write_encounter_frame + final :: symba_util_final_encounter_snapshot + end type symba_encounter_snapshot + interface module function symba_collision_check_encounter(self, system, param, t, dt, irec) result(lany_collision) @@ -383,14 +406,33 @@ module subroutine symba_util_set_renc(self, scale) integer(I4B), intent(in) :: scale !! Current recursion depth end subroutine symba_util_set_renc - module subroutine symba_util_take_system_snapshot(self, system, param, t) + module subroutine symba_util_take_encounter_snapshot(self, system, param, t) use swiftest_classes, only : swiftest_parameters implicit none - class(symba_system_snapshot), intent(inout) :: self !! SyMBA nbody system snapshot object + class(symba_encounter_snapshot), intent(inout) :: self !! SyMBA nbody system snapshot object class(symba_nbody_system), intent(in) :: system !! SyMBA nbody system object class(symba_parameters), intent(in) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! current time - end subroutine symba_util_take_system_snapshot + end subroutine symba_util_take_encounter_snapshot + + module subroutine symba_io_encounter_dump(self, param) + implicit none + class(symba_encounter_storage(*)), intent(inout) :: self !! Encounter storage object + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + end subroutine symba_io_encounter_dump + + module subroutine symba_io_encounter_initialize_output(self, param) + implicit none + class(symba_io_encounter_parameters), intent(inout) :: self !! Parameters used to identify a particular NetCDF dataset + class(swiftest_parameters), intent(in) :: param + end subroutine symba_io_encounter_initialize_output + + module subroutine symba_io_encounter_write_frame(self, nciu, param) + implicit none + class(symba_encounter_snapshot), intent(in) :: self !! Swiftest encounter structure + class(symba_io_encounter_parameters), intent(inout) :: nciu !! Parameters used to identify a particular encounter io NetCDF dataset + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + end subroutine symba_io_encounter_write_frame module subroutine symba_io_param_reader(self, unit, iotype, v_list, iostat, iomsg) implicit none @@ -651,6 +693,16 @@ module subroutine symba_util_final_encounter_list(self) type(symba_encounter), intent(inout) :: self !! SyMBA encounter list object end subroutine symba_util_final_encounter_list + module subroutine symba_util_final_encounter_snapshot(self) + implicit none + type(symba_encounter_snapshot), intent(inout) :: self !! SyMBA nbody system object + end subroutine symba_util_final_encounter_snapshot + + module subroutine symba_util_final_encounter_storage(self) + implicit none + type(symba_encounter_storage(*)), intent(inout) :: self !! SyMBA nbody system object + end subroutine symba_util_final_encounter_storage + module subroutine symba_util_final_kin(self) implicit none type(symba_kinship), intent(inout) :: self !! SyMBA kinship object @@ -666,11 +718,6 @@ module subroutine symba_util_final_pl(self) type(symba_pl), intent(inout) :: self !! SyMBA massive body object end subroutine symba_util_final_pl - module subroutine symba_util_final_snapshot(self) - implicit none - type(symba_system_snapshot), intent(inout) :: self !! SyMBA nbody system object - end subroutine symba_util_final_snapshot - module subroutine symba_util_final_system(self) implicit none type(symba_nbody_system), intent(inout) :: self !! SyMBA nbody system object diff --git a/src/setup/setup.f90 b/src/setup/setup.f90 index 4a3d98aed..26aed237c 100644 --- a/src/setup/setup.f90 +++ b/src/setup/setup.f90 @@ -68,8 +68,6 @@ module subroutine setup_construct_system(system, param) allocate(symba_pltpenc :: system%pltpenc_list) allocate(symba_plplenc :: system%plplenc_list) allocate(symba_plplenc :: system%plplcollision_list) - allocate(symba_pl :: system%snapshot%pl) - allocate(symba_tp :: system%snapshot%tp) end select case (RINGMOONS) write(*,*) 'RINGMOONS-SyMBA integrator not yet enabled' diff --git a/src/symba/symba_io.f90 b/src/symba/symba_io.f90 index 9cfd8ba9a..c80c72e0f 100644 --- a/src/symba/symba_io.f90 +++ b/src/symba/symba_io.f90 @@ -11,6 +11,166 @@ use swiftest contains + module subroutine symba_io_encounter_dump(self, param) + !! author: David A. Minton + !! + !! Dumps the time history of an encounter to file. + implicit none + ! Arguments + class(symba_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(snapshot => self%frame(i)%item) + class is (symba_encounter_snapshot) + self%nciu%ienc_frame = i + call snapshot%write_frame(self%nciu,param) + end select + end if + end do + call self%nciu%close() + + + return + end subroutine symba_io_encounter_dump + + + module subroutine symba_io_encounter_initialize_output(self, param) + !! author: David A. Minton + !! + !! Initialize a NetCDF encounter file system. This is a simplified version of the main simulation output NetCDF file, but with fewer variables. + use, intrinsic :: ieee_arithmetic + use netcdf + implicit none + ! Arguments + class(symba_io_encounter_parameters), intent(inout) :: self !! Parameters used to identify a particular NetCDF dataset + class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters + ! Internals + integer(I4B) :: nvar, varid, vartype + real(DP) :: dfill + real(SP) :: sfill + logical :: fileExists + character(len=STRMAX) :: errmsg + integer(I4B) :: ndims + + + associate(nciu => self) + dfill = ieee_value(dfill, IEEE_QUIET_NAN) + sfill = ieee_value(sfill, IEEE_QUIET_NAN) + + select case (param%out_type) + case("NETCDF_FLOAT") + self%out_type = NF90_FLOAT + case("NETCDF_DOUBLE") + self%out_type = NF90_DOUBLE + end select + + + ! Check if the file exists, and if it does, delete it + inquire(file=nciu%enc_file, exist=fileExists) + if (fileExists) then + open(unit=LUN, file=nciu%enc_file, status="old", err=667, iomsg=errmsg) + close(unit=LUN, status="delete") + end if + + call check( nf90_create(nciu%enc_file, NF90_NETCDF4, nciu%id), "symba_io_encounter_initialize_output nf90_create" ) + + ! Dimensions + call check( nf90_def_dim(nciu%id, nciu%time_dimname, NF90_UNLIMITED, nciu%time_dimid), "symba_io_encounter_initialize_output nf90_def_dim time_dimid" ) ! Simulation time dimension + call check( nf90_def_dim(nciu%id, nciu%space_dimname, NDIM, nciu%space_dimid), "symba_io_encounter_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), "symba_io_encounter_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), "symba_io_encounter_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), "symba_io_encounter_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), "symba_io_encounter_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), "symba_io_encounter_initialize_output nf90_def_var id_varid" ) + call check( nf90_def_var(nciu%id, nciu%name_varname, NF90_CHAR, [nciu%str_dimid, nciu%id_dimid], nciu%name_varid), "symba_io_encounter_initialize_output nf90_def_var name_varid" ) + + ! Variables + call check( nf90_def_var(nciu%id, nciu%name_varname, NF90_CHAR, [nciu%str_dimid, nciu%id_dimid], nciu%name_varid), "symba_io_encounter_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), "symba_io_encounter_initialize_output nf90_def_var ptype_varid" ) + 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), "symba_io_encounter_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), "symba_io_encounter_initialize_output nf90_def_var vh_varid" ) + call check( nf90_def_var(nciu%id, nciu%gmass_varname, nciu%out_type, [nciu%id_dimid, nciu%time_dimid], nciu%Gmass_varid), "symba_io_encounter_initialize_output nf90_def_var Gmass_varid" ) + 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), "symba_io_encounter_initialize_output nf90_def_var radius_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), "symba_io_encounter_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), "symba_io_encounter_initialize_output nf90_def_var rot_varid" ) + end if + + call check( nf90_inquire(nciu%id, nVariables=nvar), "symba_io_encounter_initialize_output nf90_inquire nVariables" ) + do varid = 1, nvar + call check( nf90_inquire_variable(nciu%id, varid, xtype=vartype, ndims=ndims), "symba_io_encounter_initialize_output nf90_inquire_variable" ) + select case(vartype) + case(NF90_INT) + call check( nf90_def_var_fill(nciu%id, varid, 0, NF90_FILL_INT), "symba_io_encounter_initialize_output nf90_def_var_fill NF90_INT" ) + case(NF90_FLOAT) + call check( nf90_def_var_fill(nciu%id, varid, 0, sfill), "symba_io_encounter_initialize_output nf90_def_var_fill NF90_FLOAT" ) + case(NF90_DOUBLE) + call check( nf90_def_var_fill(nciu%id, varid, 0, dfill), "symba_io_encounter_initialize_output nf90_def_var_fill NF90_DOUBLE" ) + case(NF90_CHAR) + call check( nf90_def_var_fill(nciu%id, varid, 0, 0), "symba_io_encounter_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), "symba_io_encounter_initialize_output nf90_enddef" ) + end associate + + return + + 667 continue + write(*,*) "Error creating encounter output file. " // trim(adjustl(errmsg)) + call util_exit(FAILURE) + end subroutine symba_io_encounter_initialize_output + + + module subroutine symba_io_encounter_write_frame(self, nciu, param) + !! author: David A. Minton + !! + !! Write a frame of output of an encounter list structure. + use netcdf + implicit none + ! Arguments + class(symba_encounter_snapshot), intent(in) :: self !! Swiftest encounter structure + class(symba_io_encounter_parameters), intent(inout) :: nciu !! Parameters used to identify a particular encounter io NetCDF dataset + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + ! Internals + integer(I4B) :: tslot,i,old_mode, n + character(len=NAMELEN) :: charstring + + tslot = nciu%ienc_frame + call check( nf90_set_fill(nciu%id, nf90_nofill, old_mode), "symba_io_encounter_write_frame_base nf90_set_fill" ) + call check( nf90_put_var(nciu%id, nciu%time_varid, self%t, start=[tslot]), "symba_io_encounter_write_frame nf90_put_var time_varid" ) + + ! charstring = trim(adjustl(self%info(j)%name)) + ! call check( nf90_put_var(nciu%id, nciu%name_varid, charstring, start=[1, idslot], count=[NAMELEN, 1]), "symba_io_encounter_write_info_base nf90_put_var name_varid" ) + + ! charstring = trim(adjustl(self%info(j)%particle_type)) + ! call check( nf90_put_var(nciu%id, nciu%ptype_varid, charstring, start=[1, idslot], count=[NAMELEN, 1]), "symba_io_encounter_write_info_base nf90_put_var particle_type_varid" ) + + + ! call check( nf90_put_var(nciu%id, nciu%rh_varid, self%rh(:, j), start=[1,idslot, tslot], count=[NDIM,1,1]), "symba_io_encounter_write_frame_base nf90_put_var rh_varid" ) + ! call check( nf90_put_var(nciu%id, nciu%vh_varid, self%vh(:, j), start=[1,idslot, tslot], count=[NDIM,1,1]), "symba_io_encounter_write_frame_base nf90_put_var vh_varid" ) + ! call check( nf90_put_var(nciu%id, nciu%Gmass_varid, self%Gmass(j), start=[idslot, tslot]), "symba_io_encounter_write_frame_base nf90_put_var body Gmass_varid" ) + ! if (param%lclose) call check( nf90_put_var(nciu%id, nciu%radius_varid, self%radius(j), start=[idslot, tslot]), "symba_io_encounter_write_frame_base nf90_put_var body radius_varid" ) + ! if (param%lrotation) then + ! call check( nf90_put_var(nciu%id, nciu%Ip_varid, self%Ip(:, j), start=[1,idslot, tslot], count=[NDIM,1,1]), "symba_io_encounter_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]), "symba_io_encounter_write_frame_base nf90_put_var body rotx_varid" ) + ! end if + + return + end subroutine symba_io_encounter_write_frame + + module subroutine symba_io_param_reader(self, unit, iotype, v_list, iostat, iomsg) !! author: The Purdue Swiftest Team - David A. Minton, Carlisle A. Wishard, Jennifer L.L. Pouplin, and Jacob R. Elliott !! diff --git a/src/symba/symba_util.f90 b/src/symba/symba_util.f90 index 63ba3224b..820ca4cf9 100644 --- a/src/symba/symba_util.f90 +++ b/src/symba/symba_util.f90 @@ -498,19 +498,29 @@ module subroutine symba_util_final_system(self) return end subroutine symba_util_final_system + module subroutine symba_util_final_encounter_snapshot(self) + !! author: David A. Minton + !! + !! Finalize the SyMBA encounter system snapshot object - deallocates all allocatables + implicit none + type(symba_encounter_snapshot), intent(inout) :: self !! SyMBA nbody system object + + call self%dealloc() - module subroutine symba_util_final_snapshot(self) + return + end subroutine symba_util_final_encounter_snapshot + + + module subroutine symba_util_final_encounter_storage(self) !! author: David A. Minton !! !! Finalize the SyMBA nbody system object - deallocates all allocatables implicit none ! Argument - type(symba_system_snapshot), intent(inout) :: self !! SyMBA nbody system object - - call self%dealloc() + type(symba_encounter_storage(*)), intent(inout) :: self !! SyMBA nbody system object return - end subroutine symba_util_final_snapshot + end subroutine symba_util_final_encounter_storage module subroutine symba_util_final_tp(self) @@ -908,7 +918,7 @@ module subroutine symba_util_resize_storage(self, nnew) 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 + type(symba_encounter_storage(nframes=:)), allocatable :: tmp integer(I4B) :: i, nold logical :: lmalloc @@ -921,7 +931,7 @@ module subroutine symba_util_resize_storage(self, nnew) end if if (nnew > nold) then - allocate(encounter_storage(8 * nnew) :: tmp) + allocate(symba_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 @@ -1294,14 +1304,14 @@ module subroutine symba_util_spill_tp(self, discards, lspill_list, ldestructive) end subroutine symba_util_spill_tp - module subroutine symba_util_take_system_snapshot(self, system, param, t) + module subroutine symba_util_take_encounter_snapshot(self, system, param, t) !! author: David A. Minton !! !! Takes a minimal snapshot of the state of the system during an encounter so that the trajectories !! Can be played back through the encounter implicit none ! Internals - class(symba_system_snapshot), intent(inout) :: self !! SyMBA nbody system snapshot object + class(symba_encounter_snapshot), intent(inout) :: self !! SyMBA nbody system snapshot object class(symba_nbody_system), intent(in) :: system !! SyMBA nbody system object class(symba_parameters), intent(in) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! current time @@ -1311,6 +1321,6 @@ module subroutine symba_util_take_system_snapshot(self, system, param, t) !if (system%pl) return - end subroutine symba_util_take_system_snapshot + end subroutine symba_util_take_encounter_snapshot end submodule s_symba_util From 539f1cde53b2fb1a976d17789545b1c4e4cf847c Mon Sep 17 00:00:00 2001 From: David A Minton Date: Mon, 5 Dec 2022 06:38:52 -0500 Subject: [PATCH 256/569] Moved snapshot method into symba_nbody_system --- src/modules/symba_classes.f90 | 7 +++---- src/symba/symba_util.f90 | 5 ++--- 2 files changed, 5 insertions(+), 7 deletions(-) diff --git a/src/modules/symba_classes.f90 b/src/modules/symba_classes.f90 index f08ee4c00..385a3a864 100644 --- a/src/modules/symba_classes.f90 +++ b/src/modules/symba_classes.f90 @@ -220,13 +220,13 @@ module symba_classes 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 + procedure :: snapshot => symba_util_take_encounter_snapshot final :: symba_util_final_system !! Finalizes the SyMBA nbody system object - deallocates all allocatables end type symba_nbody_system type, extends(symba_nbody_system) :: symba_encounter_snapshot contains - procedure :: snapshot => symba_util_take_encounter_snapshot procedure :: write_encounter_frame => symba_io_encounter_write_frame !! Writes a frame of encounter data to file generic :: write_frame => write_encounter_frame final :: symba_util_final_encounter_snapshot @@ -406,11 +406,10 @@ module subroutine symba_util_set_renc(self, scale) integer(I4B), intent(in) :: scale !! Current recursion depth end subroutine symba_util_set_renc - module subroutine symba_util_take_encounter_snapshot(self, system, param, t) + module subroutine symba_util_take_encounter_snapshot(self, param, t) use swiftest_classes, only : swiftest_parameters implicit none - class(symba_encounter_snapshot), intent(inout) :: self !! SyMBA nbody system snapshot object - class(symba_nbody_system), intent(in) :: system !! SyMBA nbody system object + class(symba_nbody_system), intent(in) :: self !! SyMBA nbody system object class(symba_parameters), intent(in) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! current time end subroutine symba_util_take_encounter_snapshot diff --git a/src/symba/symba_util.f90 b/src/symba/symba_util.f90 index 820ca4cf9..3eb2567f6 100644 --- a/src/symba/symba_util.f90 +++ b/src/symba/symba_util.f90 @@ -1304,15 +1304,14 @@ module subroutine symba_util_spill_tp(self, discards, lspill_list, ldestructive) end subroutine symba_util_spill_tp - module subroutine symba_util_take_encounter_snapshot(self, system, param, t) + module subroutine symba_util_take_encounter_snapshot(self, param, t) !! author: David A. Minton !! !! Takes a minimal snapshot of the state of the system during an encounter so that the trajectories !! Can be played back through the encounter implicit none ! Internals - class(symba_encounter_snapshot), intent(inout) :: self !! SyMBA nbody system snapshot object - class(symba_nbody_system), intent(in) :: system !! SyMBA nbody system object + class(symba_nbody_system), intent(in) :: self !! SyMBA nbody system object class(symba_parameters), intent(in) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! current time ! Arguments From e61cae0c11c5dd2c7b6e9902553e34fe43d757bf Mon Sep 17 00:00:00 2001 From: David A Minton Date: Mon, 5 Dec 2022 06:56:21 -0500 Subject: [PATCH 257/569] Added snapshot method implementation --- src/modules/symba_classes.f90 | 6 +++--- src/symba/symba_step.f90 | 2 +- src/symba/symba_util.f90 | 30 ++++++++++++++++++++++++++++-- 3 files changed, 32 insertions(+), 6 deletions(-) diff --git a/src/modules/symba_classes.f90 b/src/modules/symba_classes.f90 index 385a3a864..d1c604a89 100644 --- a/src/modules/symba_classes.f90 +++ b/src/modules/symba_classes.f90 @@ -219,8 +219,8 @@ 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 - procedure :: snapshot => symba_util_take_encounter_snapshot + procedure :: resize_storage => symba_util_resize_storage !! Resizes the encounter history storage object so that it contains enough spaces for the number of snapshots needed + procedure :: snapshot => symba_util_take_encounter_snapshot !! Take a minimal snapshot of the system through an encounter final :: symba_util_final_system !! Finalizes the SyMBA nbody system object - deallocates all allocatables end type symba_nbody_system @@ -410,7 +410,7 @@ module subroutine symba_util_take_encounter_snapshot(self, param, t) use swiftest_classes, only : swiftest_parameters implicit none class(symba_nbody_system), intent(in) :: self !! SyMBA nbody system object - class(symba_parameters), intent(in) :: param !! Current run configuration parameters + class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! current time end subroutine symba_util_take_encounter_snapshot diff --git a/src/symba/symba_step.f90 b/src/symba/symba_step.f90 index 9e9d2de41..824e47352 100644 --- a/src/symba/symba_step.f90 +++ b/src/symba/symba_step.f90 @@ -218,7 +218,7 @@ recursive module subroutine symba_step_recur_system(self, param, t, ireci) call pl%drift(system, param, dtl) call tp%drift(system, param, dtl) - !call system% + call system%snapshot(param, t+dtl) if (lencounter) call system%recursive_step(param, t+dth,irecp) system%irec = ireci diff --git a/src/symba/symba_util.f90 b/src/symba/symba_util.f90 index 3eb2567f6..c55766427 100644 --- a/src/symba/symba_util.f90 +++ b/src/symba/symba_util.f90 @@ -1312,12 +1312,38 @@ module subroutine symba_util_take_encounter_snapshot(self, param, t) implicit none ! Internals class(symba_nbody_system), intent(in) :: self !! SyMBA nbody system object - class(symba_parameters), intent(in) :: param !! Current run configuration parameters + class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! current time ! Arguments logical, dimension(:), allocatable :: lmask + type(symba_encounter_snapshot) :: snapshot + integer(I4B) :: i - !if (system%pl) + !allocate(symba_tp :: snapshot%tp) + associate(system => self, npl => self%pl%nbody, ntp => self%tp%nbody) + + if (npl > 0) then + allocate(symba_pl :: snapshot%pl) + select type(pl => system%pl) + class is (symba_pl) + lmask(:) = pl%status(1:npl) /= INACTIVE .and. pl%levelg(1:npl) == system%irec + snapshot%pl%id(:) = pack(pl%id(:), lmask) + snapshot%pl%info(:) = pack(pl%info(:), lmask) + snapshot%pl%Gmass(:) = pack(pl%Gmass(:), lmask) + if (allocated(pl%radius)) snapshot%pl%radius(:) = pack(pl%radius(:), lmask) + do i = 1, NDIM + snapshot%pl%rh(:,i) = pack(pl%rh(:,i), lmask) + snapshot%pl%vh(:,i) = pack(pl%vh(:,i), lmask) + end do + if (allocated(pl%Ip) .and. allocated(pl%rot)) then + do i = 1, NDIM + snapshot%pl%Ip(:,i) = pack(pl%Ip(:,i), lmask) + snapshot%pl%rot(:,i) = pack(pl%rot(:,i), lmask) + end do + end if + end select + end if + end associate return end subroutine symba_util_take_encounter_snapshot From 28186d81c26d75c303b2d6892aa306e9b18995b5 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Mon, 5 Dec 2022 07:05:40 -0500 Subject: [PATCH 258/569] Cleaned up array stuff in snapshot maker --- src/symba/symba_util.f90 | 41 ++++++++++++++++++++++++++-------------- 1 file changed, 27 insertions(+), 14 deletions(-) diff --git a/src/symba/symba_util.f90 b/src/symba/symba_util.f90 index c55766427..0c93873d0 100644 --- a/src/symba/symba_util.f90 +++ b/src/symba/symba_util.f90 @@ -1315,9 +1315,9 @@ module subroutine symba_util_take_encounter_snapshot(self, param, t) class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! current time ! Arguments - logical, dimension(:), allocatable :: lmask + logical, dimension(self%pl%nbody) :: lmask type(symba_encounter_snapshot) :: snapshot - integer(I4B) :: i + integer(I4B) :: i, n !allocate(symba_tp :: snapshot%tp) associate(system => self, npl => self%pl%nbody, ntp => self%tp%nbody) @@ -1326,20 +1326,33 @@ module subroutine symba_util_take_encounter_snapshot(self, param, t) allocate(symba_pl :: snapshot%pl) select type(pl => system%pl) class is (symba_pl) - lmask(:) = pl%status(1:npl) /= INACTIVE .and. pl%levelg(1:npl) == system%irec - snapshot%pl%id(:) = pack(pl%id(:), lmask) - snapshot%pl%info(:) = pack(pl%info(:), lmask) - snapshot%pl%Gmass(:) = pack(pl%Gmass(:), lmask) - if (allocated(pl%radius)) snapshot%pl%radius(:) = pack(pl%radius(:), lmask) - do i = 1, NDIM - snapshot%pl%rh(:,i) = pack(pl%rh(:,i), lmask) - snapshot%pl%vh(:,i) = pack(pl%vh(:,i), lmask) - end do - if (allocated(pl%Ip) .and. allocated(pl%rot)) then + lmask(1:npl) = pl%status(1:npl) /= INACTIVE .and. pl%levelg(1:npl) == system%irec + n = count(lmask) + if (n > 0) then + allocate(snapshot%pl%id(n)) + allocate(snapshot%pl%info(n)) + allocate(snapshot%pl%Gmass(n)) + snapshot%pl%id(:) = pack(pl%id(:), lmask) + snapshot%pl%info(:) = pack(pl%info(:), lmask) + snapshot%pl%Gmass(:) = pack(pl%Gmass(:), lmask) + if (allocated(pl%radius)) then + allocate(snapshot%pl%radius(n)) + snapshot%pl%radius(:) = pack(pl%radius(:), lmask) + end if + allocate(snapshot%pl%rh(NDIM,n)) + allocate(snapshot%pl%vh(NDIM,n)) do i = 1, NDIM - snapshot%pl%Ip(:,i) = pack(pl%Ip(:,i), lmask) - snapshot%pl%rot(:,i) = pack(pl%rot(:,i), lmask) + snapshot%pl%rh(i,:) = pack(pl%rh(i,:), lmask) + snapshot%pl%vh(i,:) = pack(pl%vh(i,:), lmask) end do + if (allocated(pl%Ip) .and. allocated(pl%rot)) then + allocate(snapshot%pl%Ip(NDIM,n)) + allocate(snapshot%pl%rot(NDIM,n)) + do i = 1, NDIM + snapshot%pl%Ip(i,:) = pack(pl%Ip(i,:), lmask) + snapshot%pl%rot(i,:) = pack(pl%rot(i,:), lmask) + end do + end if end if end select end if From b34ee1ca601f1da67d16083ce3fe9f8d666a1282 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Mon, 5 Dec 2022 08:11:29 -0500 Subject: [PATCH 259/569] Turned of pseudovelocity warning if the run is not a restart --- src/main/swiftest_driver.f90 | 40 ++++++++++++++--------------- src/modules/swiftest_classes.f90 | 7 ++--- src/modules/symba_classes.f90 | 1 - src/netcdf/netcdf.f90 | 2 +- src/symba/symba_encounter_check.f90 | 2 +- src/symba/symba_step.f90 | 1 - 6 files changed, 26 insertions(+), 27 deletions(-) diff --git a/src/main/swiftest_driver.f90 b/src/main/swiftest_driver.f90 index 528e0c73d..693ebecec 100644 --- a/src/main/swiftest_driver.f90 +++ b/src/main/swiftest_driver.f90 @@ -18,26 +18,26 @@ 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) :: 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 - character(*), parameter :: statusfmt = '("Time = ", ES12.5, "; fraction done = ", F6.3, ' // & - '"; Number of active pl, tp = ", I6, ", ", I6)' - character(*), parameter :: symbastatfmt = '("Time = ", ES12.5, "; fraction done = ", F6.3, ' // & - '"; Number of active plm, pl, tp = ", I6, ", ", I6, ", ", I6)' - character(*), parameter :: pbarfmt = '("Time = ", ES12.5," of ",ES12.5)' - character(len=64) :: pbarmessage - - character(*), parameter :: symbacompactfmt = '(";NPLM",ES22.15,$)' + 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 + character(*), parameter :: statusfmt = '("Time = ", ES12.5, "; fraction done = ", F6.3, ' // & + '"; Number of active pl, tp = ", I6, ", ", I6)' + character(*), parameter :: symbastatfmt = '("Time = ", ES12.5, "; fraction done = ", F6.3, ' // & + '"; Number of active plm, pl, tp = ", I6, ", ", I6, ", ", I6)' + character(*), parameter :: pbarfmt = '("Time = ", ES12.5," of ",ES12.5)' + character(len=64) :: pbarmessage + + character(*), parameter :: symbacompactfmt = '(";NPLM",ES22.15,$)' type(swiftest_storage(nframes=:)), allocatable :: system_history call io_get_args(integrator, param_file_name, display_style) diff --git a/src/modules/swiftest_classes.f90 b/src/modules/swiftest_classes.f90 index 4f87b7707..8d6c73f12 100644 --- a/src/modules/swiftest_classes.f90 +++ b/src/modules/swiftest_classes.f90 @@ -543,9 +543,10 @@ module swiftest_classes end type 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 + !! An class that establishes the pattern for various storage objects + integer(I4B), len :: nframes !! Total number of frames that can be stored + type(swiftest_storage_frame), dimension(nframes) :: frame !! Array of stored frames + integer(I4B) :: iframe = 0 !! The current frame number contains procedure :: dump => io_dump_storage end type swiftest_storage diff --git a/src/modules/symba_classes.f90 b/src/modules/symba_classes.f90 index d1c604a89..de87eef8e 100644 --- a/src/modules/symba_classes.f90 +++ b/src/modules/symba_classes.f90 @@ -209,7 +209,6 @@ module symba_classes class(symba_plplenc), allocatable :: plplcollision_list !! List of massive body-massive body collisions in a single step integer(I4B) :: irec !! System recursion level type(symba_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 diff --git a/src/netcdf/netcdf.f90 b/src/netcdf/netcdf.f90 index 261fa6355..a27f59a4d 100644 --- a/src/netcdf/netcdf.f90 +++ b/src/netcdf/netcdf.f90 @@ -349,7 +349,7 @@ module subroutine netcdf_open(self, param, readonly) !! 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 + if (param%lrestart .and. .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 diff --git a/src/symba/symba_encounter_check.f90 b/src/symba/symba_encounter_check.f90 index e58da2129..dd60f2e00 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, cb => system%cb, ienc_frame => system%ienc_frame) + associate(pl => self, plplenc_list => system%plplenc_list, cb => system%cb) npl = pl%nbody nplm = pl%nplm diff --git a/src/symba/symba_step.f90 b/src/symba/symba_step.f90 index 824e47352..9640456e3 100644 --- a/src/symba/symba_step.f90 +++ b/src/symba/symba_step.f90 @@ -278,7 +278,6 @@ 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. From 5c829b0b03e6b4039d33c2ce0784b39b7fa5bc25 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Mon, 5 Dec 2022 08:22:49 -0500 Subject: [PATCH 260/569] Improved the snapshot taking implementation to check for both planets and test particles --- src/modules/symba_classes.f90 | 6 +-- src/symba/symba_util.f90 | 85 ++++++++++++++++++++--------------- 2 files changed, 51 insertions(+), 40 deletions(-) diff --git a/src/modules/symba_classes.f90 b/src/modules/symba_classes.f90 index de87eef8e..ad78027b9 100644 --- a/src/modules/symba_classes.f90 +++ b/src/modules/symba_classes.f90 @@ -408,9 +408,9 @@ end subroutine symba_util_set_renc module subroutine symba_util_take_encounter_snapshot(self, param, t) use swiftest_classes, only : swiftest_parameters implicit none - class(symba_nbody_system), intent(in) :: self !! SyMBA nbody system object - class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters - real(DP), intent(in) :: t !! current time + class(symba_nbody_system), intent(inout) :: self !! SyMBA nbody system object + class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters + real(DP), intent(in) :: t !! current time end subroutine symba_util_take_encounter_snapshot module subroutine symba_io_encounter_dump(self, param) diff --git a/src/symba/symba_util.f90 b/src/symba/symba_util.f90 index 0c93873d0..101b2226f 100644 --- a/src/symba/symba_util.f90 +++ b/src/symba/symba_util.f90 @@ -1311,51 +1311,62 @@ module subroutine symba_util_take_encounter_snapshot(self, param, t) !! Can be played back through the encounter implicit none ! Internals - class(symba_nbody_system), intent(in) :: self !! SyMBA nbody system object - class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters - real(DP), intent(in) :: t !! current time + class(symba_nbody_system), intent(inout) :: self !! SyMBA nbody system object + class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters + real(DP), intent(in) :: t !! current time ! Arguments - logical, dimension(self%pl%nbody) :: lmask type(symba_encounter_snapshot) :: snapshot - integer(I4B) :: i, n - - !allocate(symba_tp :: snapshot%tp) - associate(system => self, npl => self%pl%nbody, ntp => self%tp%nbody) - - if (npl > 0) then - allocate(symba_pl :: snapshot%pl) - select type(pl => system%pl) - class is (symba_pl) - lmask(1:npl) = pl%status(1:npl) /= INACTIVE .and. pl%levelg(1:npl) == system%irec - n = count(lmask) - if (n > 0) then - allocate(snapshot%pl%id(n)) - allocate(snapshot%pl%info(n)) - allocate(snapshot%pl%Gmass(n)) - snapshot%pl%id(:) = pack(pl%id(:), lmask) - snapshot%pl%info(:) = pack(pl%info(:), lmask) - snapshot%pl%Gmass(:) = pack(pl%Gmass(:), lmask) - if (allocated(pl%radius)) then - allocate(snapshot%pl%radius(n)) - snapshot%pl%radius(:) = pack(pl%radius(:), lmask) - end if - allocate(snapshot%pl%rh(NDIM,n)) - allocate(snapshot%pl%vh(NDIM,n)) + integer(I4B) :: i, npl_snap, ntp_snap + + associate(npl => self%pl%nbody, ntp => self%tp%nbody) + + if (npl > 0) allocate(symba_pl :: snapshot%pl) + if (ntp > 0) allocate(symba_tp :: snapshot%tp) + if (npl + ntp == 0) return + + select type (pl => self%pl) + class is (symba_pl) + select type (tp => self%tp) + class is (symba_tp) + if (npl > 0) then + pl%lmask(1:npl) = pl%status(1:npl) /= INACTIVE .and. pl%levelg(1:npl) == self%irec + npl_snap = count(pl%lmask(1:npl)) + end if + if (ntp > 0) then + tp%lmask(1:ntp) = tp%status(1:ntp) /= INACTIVE .and. tp%levelg(1:ntp) == self%irec + ntp_snap = count(tp%lmask(1:ntp)) + end if + if (npl_snap + ntp_snap == 0) return + + if (npl_snap > 0) then + allocate(snapshot%pl%id(npl_snap)) + allocate(snapshot%pl%info(npl_snap)) + allocate(snapshot%pl%Gmass(npl_snap)) + snapshot%pl%id(:) = pack(pl%id(1:npl), pl%lmask(1:npl)) + snapshot%pl%info(:) = pack(pl%info(1:npl), pl%lmask(1:npl)) + snapshot%pl%Gmass(:) = pack(pl%Gmass(1:npl), pl%lmask(1:npl)) + allocate(snapshot%pl%rh(NDIM,npl_snap)) + allocate(snapshot%pl%vh(NDIM,npl_snap)) do i = 1, NDIM - snapshot%pl%rh(i,:) = pack(pl%rh(i,:), lmask) - snapshot%pl%vh(i,:) = pack(pl%vh(i,:), lmask) + snapshot%pl%rh(i,:) = pack(pl%rh(i,1:npl), pl%lmask(1:npl)) + snapshot%pl%vh(i,:) = pack(pl%vh(i,1:npl), pl%lmask(1:npl)) end do - if (allocated(pl%Ip) .and. allocated(pl%rot)) then - allocate(snapshot%pl%Ip(NDIM,n)) - allocate(snapshot%pl%rot(NDIM,n)) + if (param%lclose) then + allocate(snapshot%pl%radius(npl_snap)) + snapshot%pl%radius(:) = pack(pl%radius(1:npl), pl%lmask(1:npl)) + end if + + if (param%lrotation) then + allocate(snapshot%pl%Ip(NDIM,npl_snap)) + allocate(snapshot%pl%rot(NDIM,npl_snap)) do i = 1, NDIM - snapshot%pl%Ip(i,:) = pack(pl%Ip(i,:), lmask) - snapshot%pl%rot(i,:) = pack(pl%rot(i,:), lmask) + snapshot%pl%Ip(i,:) = pack(pl%Ip(i,1:npl), pl%lmask(1:npl)) + snapshot%pl%rot(i,:) = pack(pl%rot(i,1:npl), pl%lmask(1:npl)) end do end if end if - end select - end if + end select + end select end associate return From eacdf2026491381b6b1ceabbe2dce661a4fd39eb Mon Sep 17 00:00:00 2001 From: David A Minton Date: Mon, 5 Dec 2022 08:32:31 -0500 Subject: [PATCH 261/569] Added snapshot taking --- src/symba/symba_step.f90 | 3 +++ src/symba/symba_util.f90 | 22 +++++++++++++++++++++- 2 files changed, 24 insertions(+), 1 deletion(-) diff --git a/src/symba/symba_step.f90 b/src/symba/symba_step.f90 index 9640456e3..dc4ca0d41 100644 --- a/src/symba/symba_step.f90 +++ b/src/symba/symba_step.f90 @@ -312,6 +312,9 @@ module subroutine symba_step_reset_system(self, param) tp%lfirst = param%lfirstkick pl%lfirst = param%lfirstkick + + if (allocated(system%encounter_history)) deallocate(system%encounter_history) + allocate(symba_encounter_storage(8) :: system%encounter_history) end associate end select end select diff --git a/src/symba/symba_util.f90 b/src/symba/symba_util.f90 index 101b2226f..2d228f45f 100644 --- a/src/symba/symba_util.f90 +++ b/src/symba/symba_util.f90 @@ -1336,8 +1336,8 @@ module subroutine symba_util_take_encounter_snapshot(self, param, t) tp%lmask(1:ntp) = tp%status(1:ntp) /= INACTIVE .and. tp%levelg(1:ntp) == self%irec ntp_snap = count(tp%lmask(1:ntp)) end if - if (npl_snap + ntp_snap == 0) return + ! Take snapshot of the currently encountering massive bodies if (npl_snap > 0) then allocate(snapshot%pl%id(npl_snap)) allocate(snapshot%pl%info(npl_snap)) @@ -1365,6 +1365,26 @@ module subroutine symba_util_take_encounter_snapshot(self, param, t) end do end if end if + + ! Take snapshot of the currently encountering test particles + if (ntp_snap > 0) then + allocate(snapshot%tp%id(ntp_snap)) + allocate(snapshot%tp%info(ntp_snap)) + snapshot%tp%id(:) = pack(tp%id(1:ntp), tp%lmask(1:ntp)) + snapshot%tp%info(:) = pack(tp%info(1:ntp), tp%lmask(1:ntp)) + allocate(snapshot%tp%rh(NDIM,ntp_snap)) + allocate(snapshot%tp%vh(NDIM,ntp_snap)) + do i = 1, NDIM + snapshot%tp%rh(i,:) = pack(tp%rh(i,1:ntp), tp%lmask(1:ntp)) + snapshot%tp%vh(i,:) = pack(tp%vh(i,1:ntp), tp%lmask(1:ntp)) + end do + end if + + if (npl_snap + ntp_snap == 0) return + + ! Save the snapshot + self%encounter_history%iframe = self%encounter_history%iframe + 1 + self%encounter_history%frame(self%encounter_history%iframe) = snapshot end select end select end associate From 552db80e132b96f11d3ff0392a3ad4f3a025013f Mon Sep 17 00:00:00 2001 From: David A Minton Date: Mon, 5 Dec 2022 10:36:10 -0500 Subject: [PATCH 262/569] Updates to storage classes and methods --- src/CMakeLists.txt | 1 + src/modules/swiftest_classes.f90 | 23 +++++++++++++---- src/modules/symba_classes.f90 | 2 +- src/setup/setup.f90 | 1 + src/symba/symba_step.f90 | 5 ++-- src/symba/symba_util.f90 | 35 ++++++++++--------------- src/util/util_reset.f90 | 32 +++++++++++++++++++++++ src/util/util_resize.f90 | 44 ++++++++++++++++++++++++++++++++ 8 files changed, 112 insertions(+), 31 deletions(-) create mode 100644 src/util/util_reset.f90 diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index 63c89f2b3..7f45ddd5a 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -80,6 +80,7 @@ SET(FAST_MATH_FILES ${SRC}/util/util_minimize_bfgs.f90 ${SRC}/util/util_peri.f90 ${SRC}/util/util_rescale.f90 + ${SRC}/util/util_reset.f90 ${SRC}/util/util_resize.f90 ${SRC}/util/util_set.f90 ${SRC}/util/util_solve.f90 diff --git a/src/modules/swiftest_classes.f90 b/src/modules/swiftest_classes.f90 index 8d6c73f12..ba6ef183b 100644 --- a/src/modules/swiftest_classes.f90 +++ b/src/modules/swiftest_classes.f90 @@ -544,11 +544,13 @@ module swiftest_classes type :: swiftest_storage(nframes) !! An class that establishes the pattern for various storage objects - integer(I4B), len :: nframes !! Total number of frames that can be stored - type(swiftest_storage_frame), dimension(nframes) :: frame !! Array of stored frames - integer(I4B) :: iframe = 0 !! The current frame number + integer(I4B), len :: nframes = 10 !! Total number of frames that can be stored + type(swiftest_storage_frame), dimension(nframes) :: frame !! Array of stored frames + integer(I4B) :: iframe = 0 !! The current frame number contains - procedure :: dump => io_dump_storage + procedure :: dump => io_dump_storage !! Dumps storage object contents to file + procedure :: reset => util_reset_storage !! Resets a storage object by deallocating all items and resetting the frame counter to 0 + procedure :: resize => util_resize_storage end type swiftest_storage abstract interface @@ -1526,13 +1528,17 @@ module subroutine util_peri_tp(self, system, param) class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters end subroutine util_peri_tp - module subroutine util_rescale_system(self, param, mscale, dscale, tscale) implicit none class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nbody system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters. Returns with new values of the scale vactors and GU real(DP), intent(in) :: mscale, dscale, tscale !! Scale factors for mass, distance, and time units, respectively. end subroutine util_rescale_system + + module subroutine util_reset_storage(self) + implicit none + class(swiftest_storage(*)), intent(inout) :: self !! Swiftest storage object + end subroutine util_reset_storage end interface @@ -1587,6 +1593,13 @@ module subroutine util_resize_pl(self, nnew) integer(I4B), intent(in) :: nnew !! New size neded end subroutine util_resize_pl + module subroutine util_resize_storage(self, nnew, new_storage) + implicit none + class(swiftest_storage(*)), intent(in) :: self !! Swiftest storage object + integer(I4B), intent(in) :: nnew !! New size of list needed + class(swiftest_storage(*)), allocatable, intent(out) :: new_storage + end subroutine util_resize_storage + module subroutine util_resize_tp(self, nnew) implicit none class(swiftest_tp), intent(inout) :: self !! Swiftest test particle object diff --git a/src/modules/symba_classes.f90 b/src/modules/symba_classes.f90 index ad78027b9..638a7c002 100644 --- a/src/modules/symba_classes.f90 +++ b/src/modules/symba_classes.f90 @@ -208,7 +208,7 @@ module symba_classes 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(symba_encounter_storage(nframes=:)), allocatable :: encounter_history !! Stores encounter history for later retrieval and saving to file + class(symba_encounter_storage(nframes=:)), allocatable :: encounter_history !! Stores encounter history for later retrieval and saving to file 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 diff --git a/src/setup/setup.f90 b/src/setup/setup.f90 index 26aed237c..8f851f891 100644 --- a/src/setup/setup.f90 +++ b/src/setup/setup.f90 @@ -67,6 +67,7 @@ module subroutine setup_construct_system(system, param) allocate(symba_merger :: system%pl_discards) allocate(symba_pltpenc :: system%pltpenc_list) allocate(symba_plplenc :: system%plplenc_list) + allocate(symba_encounter_storage :: system%encounter_history) allocate(symba_plplenc :: system%plplcollision_list) end select case (RINGMOONS) diff --git a/src/symba/symba_step.f90 b/src/symba/symba_step.f90 index dc4ca0d41..e55a001ac 100644 --- a/src/symba/symba_step.f90 +++ b/src/symba/symba_step.f90 @@ -278,7 +278,6 @@ 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) - 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)]) @@ -313,8 +312,8 @@ module subroutine symba_step_reset_system(self, param) tp%lfirst = param%lfirstkick pl%lfirst = param%lfirstkick - if (allocated(system%encounter_history)) deallocate(system%encounter_history) - allocate(symba_encounter_storage(8) :: system%encounter_history) + call system%encounter_history%reset() + end associate end select end select diff --git a/src/symba/symba_util.f90 b/src/symba/symba_util.f90 index 2d228f45f..1604c33f7 100644 --- a/src/symba/symba_util.f90 +++ b/src/symba/symba_util.f90 @@ -918,34 +918,22 @@ module subroutine symba_util_resize_storage(self, nnew) class(symba_nbody_system), intent(inout) :: self !! Swiftest encounter list integer(I4B), intent(in) :: nnew !! New size of list needed ! Internals - type(symba_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(symba_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) + class(swiftest_storage), allocatable :: tmp + + if (nnew > self%encounter_history%nframes) then + call self%encounter_history%resize(nnew,tmp) + deallocate(self%encounter_history) + select type(tmp) + class is (symba_encounter_storage(*)) + allocate(self%encounter_history, source=tmp) + end select + deallocate(tmp) end if return end subroutine symba_util_resize_storage - module subroutine symba_util_resize_tp(self, nnew) !! author: David A. Minton !! @@ -1323,6 +1311,8 @@ module subroutine symba_util_take_encounter_snapshot(self, param, t) if (npl > 0) allocate(symba_pl :: snapshot%pl) if (ntp > 0) allocate(symba_tp :: snapshot%tp) if (npl + ntp == 0) return + npl_snap = npl + ntp_snap = ntp select type (pl => self%pl) class is (symba_pl) @@ -1384,6 +1374,7 @@ module subroutine symba_util_take_encounter_snapshot(self, param, t) ! Save the snapshot self%encounter_history%iframe = self%encounter_history%iframe + 1 + call self%resize_storage(self%encounter_history%iframe) self%encounter_history%frame(self%encounter_history%iframe) = snapshot end select end select diff --git a/src/util/util_reset.f90 b/src/util/util_reset.f90 new file mode 100644 index 000000000..569846a68 --- /dev/null +++ b/src/util/util_reset.f90 @@ -0,0 +1,32 @@ +!! Copyright 2022 - David Minton, Carlisle Wishard, Jennifer Pouplin, Jake Elliott, & Dana Singh +!! This file is part of Swiftest. +!! Swiftest is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License +!! as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. +!! Swiftest is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty +!! of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. +!! You should have received a copy of the GNU General Public License along with Swiftest. +!! If not, see: https://www.gnu.org/licenses. + +submodule (swiftest_classes) s_util_reset + use swiftest +contains + + module subroutine util_reset_storage(self) + !! author: David A. Minton + !! + !! Resets a storage object by deallocating all items and resetting the frame counter to 0 + implicit none + ! Arguments + class(swiftest_storage(*)), intent(inout) :: self !! Swiftest storage object + ! Internals + integer(I4B) :: i + + do i = 1, self%nframes + if (allocated(self%frame(i)%item)) deallocate(self%frame(i)%item) + end do + self%iframe = 0 + + return + end subroutine util_reset_storage + +end submodule s_util_reset \ No newline at end of file diff --git a/src/util/util_resize.f90 b/src/util/util_resize.f90 index eee6b0e4c..ce55ec965 100644 --- a/src/util/util_resize.f90 +++ b/src/util/util_resize.f90 @@ -350,6 +350,50 @@ module subroutine util_resize_pl(self, nnew) end subroutine util_resize_pl + module subroutine util_resize_storage(self, nnew, new_storage) + !! 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(swiftest_storage(*)), intent(in) :: self !! Swiftest storage_object + integer(I4B), intent(in) :: nnew !! New size of list needed + class(swiftest_storage), allocatable, intent(out) :: new_storage !! New, resized storage + ! Internals + !type(symba_encounter_storage(nframes=:)), allocatable :: tmp + integer(I4B) :: i, nold, iframe_old, nbig + + nold = self%nframes + iframe_old = self%iframe + + if (nnew > nold) then + nbig = nold + do while (nbig < nnew) + nbig = 2*nbig + end do + select type(self) + class is (symba_encounter_storage(*)) + allocate(symba_encounter_storage(nbig) :: new_storage) + class is (swiftest_storage(*)) + allocate(swiftest_storage(nbig) :: new_storage) + end select + do i = 1, nold + if (allocated(self%frame(i)%item)) new_storage%frame(i) = self%frame(i)%item + end do + else + allocate(new_storage, source=self) + end if + + new_storage%iframe = iframe_old + return + end subroutine util_resize_storage + + + + module subroutine util_resize_tp(self, nnew) !! author: David A. Minton !! From 06c772616bf96a8f9847350fbd49c7beead37441 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Mon, 5 Dec 2022 12:06:52 -0500 Subject: [PATCH 263/569] Revert "Updates to storage classes and methods" This reverts commit 552db80e132b96f11d3ff0392a3ad4f3a025013f. --- src/CMakeLists.txt | 1 - src/modules/swiftest_classes.f90 | 23 ++++------------- src/modules/symba_classes.f90 | 2 +- src/setup/setup.f90 | 1 - src/symba/symba_step.f90 | 5 ++-- src/symba/symba_util.f90 | 35 +++++++++++++++---------- src/util/util_reset.f90 | 32 ----------------------- src/util/util_resize.f90 | 44 -------------------------------- 8 files changed, 31 insertions(+), 112 deletions(-) delete mode 100644 src/util/util_reset.f90 diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index 7f45ddd5a..63c89f2b3 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -80,7 +80,6 @@ SET(FAST_MATH_FILES ${SRC}/util/util_minimize_bfgs.f90 ${SRC}/util/util_peri.f90 ${SRC}/util/util_rescale.f90 - ${SRC}/util/util_reset.f90 ${SRC}/util/util_resize.f90 ${SRC}/util/util_set.f90 ${SRC}/util/util_solve.f90 diff --git a/src/modules/swiftest_classes.f90 b/src/modules/swiftest_classes.f90 index ba6ef183b..8d6c73f12 100644 --- a/src/modules/swiftest_classes.f90 +++ b/src/modules/swiftest_classes.f90 @@ -544,13 +544,11 @@ module swiftest_classes type :: swiftest_storage(nframes) !! An class that establishes the pattern for various storage objects - integer(I4B), len :: nframes = 10 !! Total number of frames that can be stored - type(swiftest_storage_frame), dimension(nframes) :: frame !! Array of stored frames - integer(I4B) :: iframe = 0 !! The current frame number + integer(I4B), len :: nframes !! Total number of frames that can be stored + type(swiftest_storage_frame), dimension(nframes) :: frame !! Array of stored frames + integer(I4B) :: iframe = 0 !! The current frame number contains - procedure :: dump => io_dump_storage !! Dumps storage object contents to file - procedure :: reset => util_reset_storage !! Resets a storage object by deallocating all items and resetting the frame counter to 0 - procedure :: resize => util_resize_storage + procedure :: dump => io_dump_storage end type swiftest_storage abstract interface @@ -1528,17 +1526,13 @@ module subroutine util_peri_tp(self, system, param) class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters end subroutine util_peri_tp + module subroutine util_rescale_system(self, param, mscale, dscale, tscale) implicit none class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nbody system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters. Returns with new values of the scale vactors and GU real(DP), intent(in) :: mscale, dscale, tscale !! Scale factors for mass, distance, and time units, respectively. end subroutine util_rescale_system - - module subroutine util_reset_storage(self) - implicit none - class(swiftest_storage(*)), intent(inout) :: self !! Swiftest storage object - end subroutine util_reset_storage end interface @@ -1593,13 +1587,6 @@ module subroutine util_resize_pl(self, nnew) integer(I4B), intent(in) :: nnew !! New size neded end subroutine util_resize_pl - module subroutine util_resize_storage(self, nnew, new_storage) - implicit none - class(swiftest_storage(*)), intent(in) :: self !! Swiftest storage object - integer(I4B), intent(in) :: nnew !! New size of list needed - class(swiftest_storage(*)), allocatable, intent(out) :: new_storage - end subroutine util_resize_storage - module subroutine util_resize_tp(self, nnew) implicit none class(swiftest_tp), intent(inout) :: self !! Swiftest test particle object diff --git a/src/modules/symba_classes.f90 b/src/modules/symba_classes.f90 index 638a7c002..ad78027b9 100644 --- a/src/modules/symba_classes.f90 +++ b/src/modules/symba_classes.f90 @@ -208,7 +208,7 @@ module symba_classes 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_encounter_storage(nframes=:)), allocatable :: encounter_history !! Stores encounter history for later retrieval and saving to file + type(symba_encounter_storage(nframes=:)), allocatable :: encounter_history !! Stores encounter history for later retrieval and saving to file 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 diff --git a/src/setup/setup.f90 b/src/setup/setup.f90 index 8f851f891..26aed237c 100644 --- a/src/setup/setup.f90 +++ b/src/setup/setup.f90 @@ -67,7 +67,6 @@ module subroutine setup_construct_system(system, param) allocate(symba_merger :: system%pl_discards) allocate(symba_pltpenc :: system%pltpenc_list) allocate(symba_plplenc :: system%plplenc_list) - allocate(symba_encounter_storage :: system%encounter_history) allocate(symba_plplenc :: system%plplcollision_list) end select case (RINGMOONS) diff --git a/src/symba/symba_step.f90 b/src/symba/symba_step.f90 index e55a001ac..dc4ca0d41 100644 --- a/src/symba/symba_step.f90 +++ b/src/symba/symba_step.f90 @@ -278,6 +278,7 @@ 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) + 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)]) @@ -312,8 +313,8 @@ module subroutine symba_step_reset_system(self, param) tp%lfirst = param%lfirstkick pl%lfirst = param%lfirstkick - call system%encounter_history%reset() - + if (allocated(system%encounter_history)) deallocate(system%encounter_history) + allocate(symba_encounter_storage(8) :: system%encounter_history) end associate end select end select diff --git a/src/symba/symba_util.f90 b/src/symba/symba_util.f90 index 1604c33f7..2d228f45f 100644 --- a/src/symba/symba_util.f90 +++ b/src/symba/symba_util.f90 @@ -918,22 +918,34 @@ module subroutine symba_util_resize_storage(self, nnew) class(symba_nbody_system), intent(inout) :: self !! Swiftest encounter list integer(I4B), intent(in) :: nnew !! New size of list needed ! Internals - class(swiftest_storage), allocatable :: tmp - - if (nnew > self%encounter_history%nframes) then - call self%encounter_history%resize(nnew,tmp) - deallocate(self%encounter_history) - select type(tmp) - class is (symba_encounter_storage(*)) - allocate(self%encounter_history, source=tmp) - end select - deallocate(tmp) + type(symba_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(symba_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 !! @@ -1311,8 +1323,6 @@ module subroutine symba_util_take_encounter_snapshot(self, param, t) if (npl > 0) allocate(symba_pl :: snapshot%pl) if (ntp > 0) allocate(symba_tp :: snapshot%tp) if (npl + ntp == 0) return - npl_snap = npl - ntp_snap = ntp select type (pl => self%pl) class is (symba_pl) @@ -1374,7 +1384,6 @@ module subroutine symba_util_take_encounter_snapshot(self, param, t) ! Save the snapshot self%encounter_history%iframe = self%encounter_history%iframe + 1 - call self%resize_storage(self%encounter_history%iframe) self%encounter_history%frame(self%encounter_history%iframe) = snapshot end select end select diff --git a/src/util/util_reset.f90 b/src/util/util_reset.f90 deleted file mode 100644 index 569846a68..000000000 --- a/src/util/util_reset.f90 +++ /dev/null @@ -1,32 +0,0 @@ -!! Copyright 2022 - David Minton, Carlisle Wishard, Jennifer Pouplin, Jake Elliott, & Dana Singh -!! This file is part of Swiftest. -!! Swiftest is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License -!! as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. -!! Swiftest is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty -!! of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. -!! You should have received a copy of the GNU General Public License along with Swiftest. -!! If not, see: https://www.gnu.org/licenses. - -submodule (swiftest_classes) s_util_reset - use swiftest -contains - - module subroutine util_reset_storage(self) - !! author: David A. Minton - !! - !! Resets a storage object by deallocating all items and resetting the frame counter to 0 - implicit none - ! Arguments - class(swiftest_storage(*)), intent(inout) :: self !! Swiftest storage object - ! Internals - integer(I4B) :: i - - do i = 1, self%nframes - if (allocated(self%frame(i)%item)) deallocate(self%frame(i)%item) - end do - self%iframe = 0 - - return - end subroutine util_reset_storage - -end submodule s_util_reset \ No newline at end of file diff --git a/src/util/util_resize.f90 b/src/util/util_resize.f90 index ce55ec965..eee6b0e4c 100644 --- a/src/util/util_resize.f90 +++ b/src/util/util_resize.f90 @@ -350,50 +350,6 @@ module subroutine util_resize_pl(self, nnew) end subroutine util_resize_pl - module subroutine util_resize_storage(self, nnew, new_storage) - !! 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(swiftest_storage(*)), intent(in) :: self !! Swiftest storage_object - integer(I4B), intent(in) :: nnew !! New size of list needed - class(swiftest_storage), allocatable, intent(out) :: new_storage !! New, resized storage - ! Internals - !type(symba_encounter_storage(nframes=:)), allocatable :: tmp - integer(I4B) :: i, nold, iframe_old, nbig - - nold = self%nframes - iframe_old = self%iframe - - if (nnew > nold) then - nbig = nold - do while (nbig < nnew) - nbig = 2*nbig - end do - select type(self) - class is (symba_encounter_storage(*)) - allocate(symba_encounter_storage(nbig) :: new_storage) - class is (swiftest_storage(*)) - allocate(swiftest_storage(nbig) :: new_storage) - end select - do i = 1, nold - if (allocated(self%frame(i)%item)) new_storage%frame(i) = self%frame(i)%item - end do - else - allocate(new_storage, source=self) - end if - - new_storage%iframe = iframe_old - return - end subroutine util_resize_storage - - - - module subroutine util_resize_tp(self, nnew) !! author: David A. Minton !! From f707a464cbc50072aaaa45adb546ccb6b36d5760 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Mon, 5 Dec 2022 12:13:36 -0500 Subject: [PATCH 264/569] Minor cosmetic changes --- src/modules/swiftest_classes.f90 | 6 +++--- src/symba/symba_step.f90 | 3 --- src/symba/symba_util.f90 | 1 - 3 files changed, 3 insertions(+), 7 deletions(-) diff --git a/src/modules/swiftest_classes.f90 b/src/modules/swiftest_classes.f90 index 8d6c73f12..977aa2b15 100644 --- a/src/modules/swiftest_classes.f90 +++ b/src/modules/swiftest_classes.f90 @@ -544,9 +544,9 @@ module swiftest_classes type :: swiftest_storage(nframes) !! An class that establishes the pattern for various storage objects - integer(I4B), len :: nframes !! Total number of frames that can be stored - type(swiftest_storage_frame), dimension(nframes) :: frame !! Array of stored frames - integer(I4B) :: iframe = 0 !! The current frame number + integer(I4B), len :: nframes = 10 !! Total number of frames that can be stored + type(swiftest_storage_frame), dimension(nframes) :: frame !! Array of stored frames + integer(I4B) :: iframe = 0 !! The current frame number contains procedure :: dump => io_dump_storage end type swiftest_storage diff --git a/src/symba/symba_step.f90 b/src/symba/symba_step.f90 index dc4ca0d41..f5616510d 100644 --- a/src/symba/symba_step.f90 +++ b/src/symba/symba_step.f90 @@ -278,7 +278,6 @@ 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) - 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)]) @@ -313,8 +312,6 @@ module subroutine symba_step_reset_system(self, param) tp%lfirst = param%lfirstkick pl%lfirst = param%lfirstkick - if (allocated(system%encounter_history)) deallocate(system%encounter_history) - allocate(symba_encounter_storage(8) :: system%encounter_history) end associate end select end select diff --git a/src/symba/symba_util.f90 b/src/symba/symba_util.f90 index 2d228f45f..f3eaa5ef6 100644 --- a/src/symba/symba_util.f90 +++ b/src/symba/symba_util.f90 @@ -945,7 +945,6 @@ module subroutine symba_util_resize_storage(self, nnew) end subroutine symba_util_resize_storage - module subroutine symba_util_resize_tp(self, nnew) !! author: David A. Minton !! From 4dfa484a60e4fbda9be00cc959a20c4142920e17 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Mon, 5 Dec 2022 12:27:49 -0500 Subject: [PATCH 265/569] Fixed up resizing methods --- src/CMakeLists.txt | 1 + src/modules/swiftest_classes.f90 | 9 +++++++-- src/setup/setup.f90 | 1 + src/symba/symba_step.f90 | 2 ++ src/symba/symba_util.f90 | 11 +++++++++-- src/util/util_reset.f90 | 32 ++++++++++++++++++++++++++++++++ 6 files changed, 52 insertions(+), 4 deletions(-) create mode 100644 src/util/util_reset.f90 diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index 63c89f2b3..7f45ddd5a 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -80,6 +80,7 @@ SET(FAST_MATH_FILES ${SRC}/util/util_minimize_bfgs.f90 ${SRC}/util/util_peri.f90 ${SRC}/util/util_rescale.f90 + ${SRC}/util/util_reset.f90 ${SRC}/util/util_resize.f90 ${SRC}/util/util_set.f90 ${SRC}/util/util_solve.f90 diff --git a/src/modules/swiftest_classes.f90 b/src/modules/swiftest_classes.f90 index 977aa2b15..276750eb6 100644 --- a/src/modules/swiftest_classes.f90 +++ b/src/modules/swiftest_classes.f90 @@ -548,7 +548,8 @@ module swiftest_classes type(swiftest_storage_frame), dimension(nframes) :: frame !! Array of stored frames integer(I4B) :: iframe = 0 !! The current frame number contains - procedure :: dump => io_dump_storage + procedure :: dump => io_dump_storage !! Dumps storage object contents to file + procedure :: reset => util_reset_storage !! Resets a storage object by deallocating all items and resetting the frame counter to 0 end type swiftest_storage abstract interface @@ -1526,13 +1527,17 @@ module subroutine util_peri_tp(self, system, param) class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters end subroutine util_peri_tp - module subroutine util_rescale_system(self, param, mscale, dscale, tscale) implicit none class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nbody system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters. Returns with new values of the scale vactors and GU real(DP), intent(in) :: mscale, dscale, tscale !! Scale factors for mass, distance, and time units, respectively. end subroutine util_rescale_system + + module subroutine util_reset_storage(self) + implicit none + class(swiftest_storage(*)), intent(inout) :: self !! Swiftest storage object + end subroutine util_reset_storage end interface diff --git a/src/setup/setup.f90 b/src/setup/setup.f90 index 26aed237c..fe9b20572 100644 --- a/src/setup/setup.f90 +++ b/src/setup/setup.f90 @@ -68,6 +68,7 @@ module subroutine setup_construct_system(system, param) allocate(symba_pltpenc :: system%pltpenc_list) allocate(symba_plplenc :: system%plplenc_list) allocate(symba_plplenc :: system%plplcollision_list) + allocate(symba_encounter_storage :: system%encounter_history) end select case (RINGMOONS) write(*,*) 'RINGMOONS-SyMBA integrator not yet enabled' diff --git a/src/symba/symba_step.f90 b/src/symba/symba_step.f90 index f5616510d..e55a001ac 100644 --- a/src/symba/symba_step.f90 +++ b/src/symba/symba_step.f90 @@ -312,6 +312,8 @@ module subroutine symba_step_reset_system(self, param) tp%lfirst = param%lfirstkick pl%lfirst = param%lfirstkick + call system%encounter_history%reset() + end associate end select end select diff --git a/src/symba/symba_util.f90 b/src/symba/symba_util.f90 index f3eaa5ef6..919b11acb 100644 --- a/src/symba/symba_util.f90 +++ b/src/symba/symba_util.f90 @@ -919,19 +919,24 @@ module subroutine symba_util_resize_storage(self, nnew) integer(I4B), intent(in) :: nnew !! New size of list needed ! Internals type(symba_encounter_storage(nframes=:)), allocatable :: tmp - integer(I4B) :: i, nold + integer(I4B) :: i, nold, nbig, iframe_old = 0 logical :: lmalloc lmalloc = allocated(self%encounter_history) if (lmalloc) then nold = self%encounter_history%nframes + iframe_old = self%encounter_history%iframe else nold = 0 end if if (nnew > nold) then - allocate(symba_encounter_storage(8 * nnew) :: tmp) + nbig = nold + do while (nbig < nnew) + nbig = nbig * 2 + end do + allocate(symba_encounter_storage(nbig) :: 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 @@ -939,6 +944,7 @@ module subroutine symba_util_resize_storage(self, nnew) deallocate(self%encounter_history) end if call move_alloc(tmp,self%encounter_history) + self%encounter_history%iframe = iframe_old end if return @@ -1383,6 +1389,7 @@ module subroutine symba_util_take_encounter_snapshot(self, param, t) ! Save the snapshot self%encounter_history%iframe = self%encounter_history%iframe + 1 + call self%resize_storage(self%encounter_history%iframe) self%encounter_history%frame(self%encounter_history%iframe) = snapshot end select end select diff --git a/src/util/util_reset.f90 b/src/util/util_reset.f90 new file mode 100644 index 000000000..569846a68 --- /dev/null +++ b/src/util/util_reset.f90 @@ -0,0 +1,32 @@ +!! Copyright 2022 - David Minton, Carlisle Wishard, Jennifer Pouplin, Jake Elliott, & Dana Singh +!! This file is part of Swiftest. +!! Swiftest is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License +!! as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. +!! Swiftest is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty +!! of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. +!! You should have received a copy of the GNU General Public License along with Swiftest. +!! If not, see: https://www.gnu.org/licenses. + +submodule (swiftest_classes) s_util_reset + use swiftest +contains + + module subroutine util_reset_storage(self) + !! author: David A. Minton + !! + !! Resets a storage object by deallocating all items and resetting the frame counter to 0 + implicit none + ! Arguments + class(swiftest_storage(*)), intent(inout) :: self !! Swiftest storage object + ! Internals + integer(I4B) :: i + + do i = 1, self%nframes + if (allocated(self%frame(i)%item)) deallocate(self%frame(i)%item) + end do + self%iframe = 0 + + return + end subroutine util_reset_storage + +end submodule s_util_reset \ No newline at end of file From abe5ad877e9fe611340c76ee6270b488eb4c8d02 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Mon, 5 Dec 2022 13:16:46 -0500 Subject: [PATCH 266/569] fixed problem with indexing of output --- src/main/swiftest_driver.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/main/swiftest_driver.f90 b/src/main/swiftest_driver.f90 index 693ebecec..4ff06d4a8 100644 --- a/src/main/swiftest_driver.f90 +++ b/src/main/swiftest_driver.f90 @@ -81,7 +81,7 @@ program swiftest_driver t = tstart nloops = ceiling((tstop - t0) / dt, kind=I8B) istart = ceiling((tstart - t0) / dt + 1.0_DP, kind=I8B) - ioutput = int(istart / istep_out, kind=I4B) + ioutput = max(int(istart / istep_out, kind=I4B),1) ! Set up system storage for intermittent file dumps if (dump_cadence == 0) dump_cadence = ceiling(nloops / (1.0_DP * istep_out), kind=I8B) From 965d4e6cdf946e6ef3dfbaa7d42af9ab806e9311 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Mon, 5 Dec 2022 13:16:46 -0500 Subject: [PATCH 267/569] fixed problem with indexing of output --- src/main/swiftest_driver.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/main/swiftest_driver.f90 b/src/main/swiftest_driver.f90 index 528e0c73d..bc08a1a1b 100644 --- a/src/main/swiftest_driver.f90 +++ b/src/main/swiftest_driver.f90 @@ -81,7 +81,7 @@ program swiftest_driver t = tstart nloops = ceiling((tstop - t0) / dt, kind=I8B) istart = ceiling((tstart - t0) / dt + 1.0_DP, kind=I8B) - ioutput = int(istart / istep_out, kind=I4B) + ioutput = max(int(istart / istep_out, kind=I4B),1) ! Set up system storage for intermittent file dumps if (dump_cadence == 0) dump_cadence = ceiling(nloops / (1.0_DP * istep_out), kind=I8B) From 32b01ebfc91e5c916a1c0b4149f8dad26358bd9d Mon Sep 17 00:00:00 2001 From: David A Minton Date: Mon, 5 Dec 2022 13:33:07 -0500 Subject: [PATCH 268/569] More bugfixes for indexing the output files correctly --- src/io/io.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/io/io.f90 b/src/io/io.f90 index 69c32f5dc..0f8c6761c 100644 --- a/src/io/io.f90 +++ b/src/io/io.f90 @@ -287,7 +287,7 @@ module subroutine io_dump_storage(self, param) iloop_start = max(param%iloop - int(param%istep_out * param%dump_cadence, kind=I8B),1) do i = 1, param%dump_cadence - param%ioutput = int(iloop_start / param%istep_out, kind=I4B) + i + param%ioutput = max(int(iloop_start / param%istep_out, kind=I4B),1) + i if (allocated(self%frame(i)%item)) then select type(system => self%frame(i)%item) class is (swiftest_nbody_system) From 0dcc67327950d7b20a67dc814af23e54836da938 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Mon, 5 Dec 2022 13:33:07 -0500 Subject: [PATCH 269/569] More bugfixes for indexing the output files correctly --- src/io/io.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/io/io.f90 b/src/io/io.f90 index 69c32f5dc..0f8c6761c 100644 --- a/src/io/io.f90 +++ b/src/io/io.f90 @@ -287,7 +287,7 @@ module subroutine io_dump_storage(self, param) iloop_start = max(param%iloop - int(param%istep_out * param%dump_cadence, kind=I8B),1) do i = 1, param%dump_cadence - param%ioutput = int(iloop_start / param%istep_out, kind=I4B) + i + param%ioutput = max(int(iloop_start / param%istep_out, kind=I4B),1) + i if (allocated(self%frame(i)%item)) then select type(system => self%frame(i)%item) class is (swiftest_nbody_system) From c50f05a3f3ce35de09a89e156384434446470123 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Mon, 5 Dec 2022 13:47:24 -0500 Subject: [PATCH 270/569] Added write methods and fixed a a bug in symba_util --- src/symba/symba_io.f90 | 34 ++++++++++++++++++---------------- src/symba/symba_step.f90 | 7 ++++--- src/symba/symba_util.f90 | 2 ++ 3 files changed, 24 insertions(+), 19 deletions(-) diff --git a/src/symba/symba_io.f90 b/src/symba/symba_io.f90 index c80c72e0f..944ef921d 100644 --- a/src/symba/symba_io.f90 +++ b/src/symba/symba_io.f90 @@ -144,28 +144,30 @@ module subroutine symba_io_encounter_write_frame(self, nciu, param) class(symba_io_encounter_parameters), intent(inout) :: nciu !! Parameters used to identify a particular encounter io NetCDF dataset class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters ! Internals - integer(I4B) :: tslot,i,old_mode, n + integer(I4B) :: tslot,i,old_mode, n, idslot character(len=NAMELEN) :: charstring tslot = nciu%ienc_frame call check( nf90_set_fill(nciu%id, nf90_nofill, old_mode), "symba_io_encounter_write_frame_base nf90_set_fill" ) call check( nf90_put_var(nciu%id, nciu%time_varid, self%t, start=[tslot]), "symba_io_encounter_write_frame nf90_put_var time_varid" ) - ! charstring = trim(adjustl(self%info(j)%name)) - ! call check( nf90_put_var(nciu%id, nciu%name_varid, charstring, start=[1, idslot], count=[NAMELEN, 1]), "symba_io_encounter_write_info_base nf90_put_var name_varid" ) - - ! charstring = trim(adjustl(self%info(j)%particle_type)) - ! call check( nf90_put_var(nciu%id, nciu%ptype_varid, charstring, start=[1, idslot], count=[NAMELEN, 1]), "symba_io_encounter_write_info_base nf90_put_var particle_type_varid" ) - - - ! call check( nf90_put_var(nciu%id, nciu%rh_varid, self%rh(:, j), start=[1,idslot, tslot], count=[NDIM,1,1]), "symba_io_encounter_write_frame_base nf90_put_var rh_varid" ) - ! call check( nf90_put_var(nciu%id, nciu%vh_varid, self%vh(:, j), start=[1,idslot, tslot], count=[NDIM,1,1]), "symba_io_encounter_write_frame_base nf90_put_var vh_varid" ) - ! call check( nf90_put_var(nciu%id, nciu%Gmass_varid, self%Gmass(j), start=[idslot, tslot]), "symba_io_encounter_write_frame_base nf90_put_var body Gmass_varid" ) - ! if (param%lclose) call check( nf90_put_var(nciu%id, nciu%radius_varid, self%radius(j), start=[idslot, tslot]), "symba_io_encounter_write_frame_base nf90_put_var body radius_varid" ) - ! if (param%lrotation) then - ! call check( nf90_put_var(nciu%id, nciu%Ip_varid, self%Ip(:, j), start=[1,idslot, tslot], count=[NDIM,1,1]), "symba_io_encounter_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]), "symba_io_encounter_write_frame_base nf90_put_var body rotx_varid" ) - ! end if + n = size(self%pl%id(:)) + do i = 1, n + idslot = self%pl%id(i) + charstring = trim(adjustl(self%pl%info(i)%name)) + call check( nf90_put_var(nciu%id, nciu%name_varid, charstring, start=[1, idslot], count=[NAMELEN, 1]), "symba_io_encounter_write_frame nf90_put_var name_varid" ) + charstring = trim(adjustl(self%pl%info(i)%particle_type)) + call check( nf90_put_var(nciu%id, nciu%ptype_varid, charstring, start=[1, idslot], count=[NAMELEN, 1]), "symba_io_encounter_write_frame nf90_put_var particle_type_varid" ) + + call check( nf90_put_var(nciu%id, nciu%rh_varid, self%pl%rh(:, i), start=[1,idslot,tslot], count=[NDIM,1,1]), "symba_io_encounter_write_frame_base nf90_put_var rh_varid" ) + call check( nf90_put_var(nciu%id, nciu%vh_varid, self%pl%vh(:, i), start=[1,idslot,tslot], count=[NDIM,1,1]), "symba_io_encounter_write_frame_base nf90_put_var vh_varid" ) + call check( nf90_put_var(nciu%id, nciu%Gmass_varid, self%pl%Gmass(i), start=[idslot, tslot]), "symba_io_encounter_write_frame_base nf90_put_var body Gmass_varid" ) + if (param%lclose) call check( nf90_put_var(nciu%id, nciu%radius_varid, self%pl%radius(i), start=[idslot, tslot]), "symba_io_encounter_write_frame_base nf90_put_var body radius_varid" ) + if (param%lrotation) then + call check( nf90_put_var(nciu%id, nciu%Ip_varid, self%pl%Ip(:, i), start=[1, idslot, tslot], count=[NDIM,1,1]), "symba_io_encounter_write_frame_base nf90_put_var body Ip_varid" ) + call check( nf90_put_var(nciu%id, nciu%rot_varid, self%pl%rot(:, i), start=[1,idslot, tslot], count=[NDIM,1,1]), "symba_io_encounter_write_frame_base nf90_put_var body rotx_varid" ) + end if + end do return end subroutine symba_io_encounter_write_frame diff --git a/src/symba/symba_step.f90 b/src/symba/symba_step.f90 index e55a001ac..f8dca7ff7 100644 --- a/src/symba/symba_step.f90 +++ b/src/symba/symba_step.f90 @@ -37,8 +37,10 @@ module subroutine symba_step_system(self, param, t, dt) call self%reset(param) lencounter = pl%encounter_check(param, self, dt, 0) .or. tp%encounter_check(param, self, dt, 0) if (lencounter) then + call self%snapshot(param, t) call self%interp(param, t, dt) - !call self%encounter_history%dump(param) + call self%snapshot(param, t+dt) + call self%encounter_history%dump(param) else self%irec = -1 call helio_step_system(self, param, t, dt) @@ -218,8 +220,6 @@ recursive module subroutine symba_step_recur_system(self, param, t, ireci) call pl%drift(system, param, dtl) call tp%drift(system, param, dtl) - call system%snapshot(param, t+dtl) - if (lencounter) call system%recursive_step(param, t+dth,irecp) system%irec = ireci @@ -242,6 +242,7 @@ recursive module subroutine symba_step_recur_system(self, param, t, ireci) if (lplpl_collision) call plplenc_list%resolve_collision(system, param, t+dtl, dtl, ireci) if (lpltp_collision) call pltpenc_list%resolve_collision(system, param, t+dtl, dtl, ireci) end if + call system%snapshot(param, t+dtl) call self%set_recur_levels(ireci) diff --git a/src/symba/symba_util.f90 b/src/symba/symba_util.f90 index 919b11acb..6e0e46470 100644 --- a/src/symba/symba_util.f90 +++ b/src/symba/symba_util.f90 @@ -1328,6 +1328,8 @@ module subroutine symba_util_take_encounter_snapshot(self, param, t) if (npl > 0) allocate(symba_pl :: snapshot%pl) if (ntp > 0) allocate(symba_tp :: snapshot%tp) if (npl + ntp == 0) return + npl_snap = npl + ntp_snap = ntp select type (pl => self%pl) class is (symba_pl) From 3565093f80a8de7a4b466b1685599fd7c530557d Mon Sep 17 00:00:00 2001 From: David A Minton Date: Mon, 5 Dec 2022 13:51:19 -0500 Subject: [PATCH 271/569] Removed duplicate variable definition --- src/symba/symba_io.f90 | 1 - 1 file changed, 1 deletion(-) diff --git a/src/symba/symba_io.f90 b/src/symba/symba_io.f90 index 944ef921d..c70fbf94a 100644 --- a/src/symba/symba_io.f90 +++ b/src/symba/symba_io.f90 @@ -90,7 +90,6 @@ module subroutine symba_io_encounter_initialize_output(self, param) call check( nf90_def_var(nciu%id, nciu%time_dimname, nciu%out_type, nciu%time_dimid, nciu%time_varid), "symba_io_encounter_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), "symba_io_encounter_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), "symba_io_encounter_initialize_output nf90_def_var id_varid" ) - call check( nf90_def_var(nciu%id, nciu%name_varname, NF90_CHAR, [nciu%str_dimid, nciu%id_dimid], nciu%name_varid), "symba_io_encounter_initialize_output nf90_def_var name_varid" ) ! Variables call check( nf90_def_var(nciu%id, nciu%name_varname, NF90_CHAR, [nciu%str_dimid, nciu%id_dimid], nciu%name_varid), "symba_io_encounter_initialize_output nf90_def_var name_varid" ) From 14d2859211b60d99d300801418f144c8eb4b792c Mon Sep 17 00:00:00 2001 From: David A Minton Date: Mon, 5 Dec 2022 13:54:33 -0500 Subject: [PATCH 272/569] Added in time and space dimension coordinates to encounter dataset --- src/symba/symba_io.f90 | 3 +++ src/symba/symba_util.f90 | 2 ++ 2 files changed, 5 insertions(+) diff --git a/src/symba/symba_io.f90 b/src/symba/symba_io.f90 index c70fbf94a..92aafdb61 100644 --- a/src/symba/symba_io.f90 +++ b/src/symba/symba_io.f90 @@ -122,6 +122,9 @@ module subroutine symba_io_encounter_initialize_output(self, param) ! Take the file out of define mode call check( nf90_enddef(nciu%id), "symba_io_encounter_initialize_output nf90_enddef" ) + + ! Add in the space dimension coordinates + call check( nf90_put_var(nciu%id, nciu%space_varid, nciu%space_coords, start=[1], count=[NDIM]), "symba_io_encounter_initialize_output nf90_put_var space" ) end associate return diff --git a/src/symba/symba_util.f90 b/src/symba/symba_util.f90 index 6e0e46470..a7c4c6ae7 100644 --- a/src/symba/symba_util.f90 +++ b/src/symba/symba_util.f90 @@ -1389,6 +1389,8 @@ module subroutine symba_util_take_encounter_snapshot(self, param, t) if (npl_snap + ntp_snap == 0) return + snapshot%t = t + ! Save the snapshot self%encounter_history%iframe = self%encounter_history%iframe + 1 call self%resize_storage(self%encounter_history%iframe) From 73b72c8a2ee98bf7d5151fcdeafd630e81be83fb Mon Sep 17 00:00:00 2001 From: David A Minton Date: Mon, 5 Dec 2022 13:58:12 -0500 Subject: [PATCH 273/569] Added id to the encounter dataset --- src/symba/symba_io.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/symba/symba_io.f90 b/src/symba/symba_io.f90 index 92aafdb61..7c35e9ccb 100644 --- a/src/symba/symba_io.f90 +++ b/src/symba/symba_io.f90 @@ -160,7 +160,7 @@ module subroutine symba_io_encounter_write_frame(self, nciu, param) call check( nf90_put_var(nciu%id, nciu%name_varid, charstring, start=[1, idslot], count=[NAMELEN, 1]), "symba_io_encounter_write_frame nf90_put_var name_varid" ) charstring = trim(adjustl(self%pl%info(i)%particle_type)) call check( nf90_put_var(nciu%id, nciu%ptype_varid, charstring, start=[1, idslot], count=[NAMELEN, 1]), "symba_io_encounter_write_frame nf90_put_var particle_type_varid" ) - + call check( nf90_put_var(nciu%id, nciu%id_varid, self%pl%id(i), start=[idslot]), "symba_io_encounter_write_frame_base nf90_put_var id_varid" ) call check( nf90_put_var(nciu%id, nciu%rh_varid, self%pl%rh(:, i), start=[1,idslot,tslot], count=[NDIM,1,1]), "symba_io_encounter_write_frame_base nf90_put_var rh_varid" ) call check( nf90_put_var(nciu%id, nciu%vh_varid, self%pl%vh(:, i), start=[1,idslot,tslot], count=[NDIM,1,1]), "symba_io_encounter_write_frame_base nf90_put_var vh_varid" ) call check( nf90_put_var(nciu%id, nciu%Gmass_varid, self%pl%Gmass(i), start=[idslot, tslot]), "symba_io_encounter_write_frame_base nf90_put_var body Gmass_varid" ) From ae923265f1693b1b530aa43b6310f578b3be4476 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Mon, 5 Dec 2022 14:36:45 -0500 Subject: [PATCH 274/569] changed to barycentric velocity in encounter output --- src/symba/symba_util.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/symba/symba_util.f90 b/src/symba/symba_util.f90 index a7c4c6ae7..50521f7a8 100644 --- a/src/symba/symba_util.f90 +++ b/src/symba/symba_util.f90 @@ -1356,7 +1356,7 @@ module subroutine symba_util_take_encounter_snapshot(self, param, t) allocate(snapshot%pl%vh(NDIM,npl_snap)) do i = 1, NDIM snapshot%pl%rh(i,:) = pack(pl%rh(i,1:npl), pl%lmask(1:npl)) - snapshot%pl%vh(i,:) = pack(pl%vh(i,1:npl), pl%lmask(1:npl)) + snapshot%pl%vh(i,:) = pack(pl%vb(i,1:npl), pl%lmask(1:npl)) end do if (param%lclose) then allocate(snapshot%pl%radius(npl_snap)) From 3b38dd53d7ac5c6484cd47bff0d0690e4b6df056 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Mon, 5 Dec 2022 14:37:08 -0500 Subject: [PATCH 275/569] Fixed up fragementation movie for new encounter data (still experimental) --- examples/Fragmentation/Fragmentation_Movie.py | 52 +++++++------------ 1 file changed, 19 insertions(+), 33 deletions(-) diff --git a/examples/Fragmentation/Fragmentation_Movie.py b/examples/Fragmentation/Fragmentation_Movie.py index 5d660bcec..b909fac0c 100644 --- a/examples/Fragmentation/Fragmentation_Movie.py +++ b/examples/Fragmentation/Fragmentation_Movie.py @@ -84,7 +84,7 @@ class AnimatedScatter(object): """An animated scatter plot using matplotlib.animations.FuncAnimation.""" def __init__(self, sim, animfile, title, nskip=1): - nframes = int(sim.data['time'].size) + nframes = int(sim.enc['time'].size) self.sim = sim self.title = title self.body_color_list = {'Initial conditions': 'xkcd:windows blue', @@ -109,8 +109,10 @@ def setup_plot(self): # Calculate the distance along the y-axis between the colliding bodies at the start of the simulation. # This will be used to scale the axis limits on the movie. - scale_frame = abs(sim.data['xhy'].isel(time=0, name=1).values) \ - + abs( sim.data['xhy'].isel(time=0, name=2).values) + rhy1 = sim.enc['rh'].isel(time=0).sel(name="Body1",space='y').values[()] + rhy2 = sim.enc['rh'].isel(time=0).sel(name="Body2",space='y').values[()] + + scale_frame = abs(rhy1) + abs(rhy2) ax = plt.Axes(fig, [0.1, 0.1, 0.8, 0.8]) self.ax_pt_size = figsize[0] * 0.8 * 72 / scale_frame ax.set_xlim(-scale_frame, scale_frame) @@ -136,14 +138,14 @@ def center(Gmass, x, y): return x_com, y_com Gmass, rh, point_rad = next(self.data_stream(frame)) - x_com, y_com = center(Gmass, rh[:,1], rh[:,2]) - self.scatter_artist.set_offsets(np.c_[x - x_com, y - y_com]) + x_com, y_com = center(Gmass, rh[:,0], rh[:,1]) + self.scatter_artist.set_offsets(np.c_[rh[:,0] - x_com, rh[:,1] - y_com]) self.scatter_artist.set_sizes(point_rad) return self.scatter_artist, def data_stream(self, frame=0): while True: - ds = self.sim.data.isel(time=frame) + ds = self.sim.enc.isel(time=frame) ds = ds.where(ds['name'] != "Sun", drop=True) radius = ds['radius'].values Gmass = ds['Gmass'].values @@ -167,33 +169,17 @@ def data_stream(self, frame=0): movie_styles = available_movie_styles.copy() for style in movie_styles: - bin_file = Path(style) / "bin.nc" - if bin_file.exists(): - user_selection = input(f"An older simulation of {movie_titles[style]} exists. Do you want to re-run it? [y/N] ") - if user_selection == "": - run_new = False - else: - try: - run_new = swiftest.io.str2bool(user_selection) - except: - run_new = False - else: - run_new = True - movie_filename = f"{style}.mp4" # Pull in the Swiftest output data from the parameter file and store it as a Xarray dataset. - if run_new: - sim = swiftest.Simulation(simdir=style, 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], 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=2e-5, tstop=2.e-5) - else: - sim = swiftest.Simulation(param_file=param_file, read_old_output_file=True) - - anim = AnimatedScatter(sim,movie_filename,movie_titles[style],nskip=10) + sim = swiftest.Simulation(simdir=style, 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], 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-4, tstop=1.0e-2, tstep_out=1e-2, dump_cadence=0) + + anim = AnimatedScatter(sim,movie_filename,movie_titles[style],nskip=1) From 67b3a775f24824a5cbca207864d5fa566a16b0fc Mon Sep 17 00:00:00 2001 From: David Minton Date: Mon, 5 Dec 2022 15:43:00 -0500 Subject: [PATCH 276/569] Added helpful comment --- src/netcdf/netcdf.f90 | 1 + 1 file changed, 1 insertion(+) diff --git a/src/netcdf/netcdf.f90 b/src/netcdf/netcdf.f90 index a27f59a4d..00e18bb1c 100644 --- a/src/netcdf/netcdf.f90 +++ b/src/netcdf/netcdf.f90 @@ -292,6 +292,7 @@ module subroutine netcdf_initialize_output(self, param) ! Take the file out of define mode call check( nf90_enddef(nciu%id), "netcdf_initialize_output nf90_enddef" ) + ! Add in the space dimension coordinates 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 From efdd8e66ba1b17af2952d93cf0695a66c4d27674 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Mon, 5 Dec 2022 15:51:15 -0500 Subject: [PATCH 277/569] Fixed issue with encounter data not being saved --- examples/Fragmentation/Fragmentation_Movie.py | 4 ++-- python/swiftest/swiftest/simulation_class.py | 15 +++++++++++++-- 2 files changed, 15 insertions(+), 4 deletions(-) diff --git a/examples/Fragmentation/Fragmentation_Movie.py b/examples/Fragmentation/Fragmentation_Movie.py index b909fac0c..a4a925772 100644 --- a/examples/Fragmentation/Fragmentation_Movie.py +++ b/examples/Fragmentation/Fragmentation_Movie.py @@ -180,6 +180,6 @@ def data_stream(self, frame=0): 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-4, tstop=1.0e-2, tstep_out=1e-2, dump_cadence=0) + sim.run(dt=1e-3, tstop=1.0e-2, tstep_out=1e-2, dump_cadence=0) - anim = AnimatedScatter(sim,movie_filename,movie_titles[style],nskip=1) + anim = AnimatedScatter(sim,movie_filename,movie_titles[style],nskip=10) diff --git a/python/swiftest/swiftest/simulation_class.py b/python/swiftest/swiftest/simulation_class.py index 6cd75a521..727e47d07 100644 --- a/python/swiftest/swiftest/simulation_class.py +++ b/python/swiftest/swiftest/simulation_class.py @@ -306,7 +306,7 @@ def __init__(self,read_param: bool = False, read_old_output_file: bool = False, self.param = {} self.data = xr.Dataset() self.ic = xr.Dataset() - + self.enc = xr.Dataset() self.simdir = Path(simdir) if self.simdir.exists(): @@ -2670,17 +2670,28 @@ def read_output_file(self,read_init_cond : bool = True): # Make a temporary copy of the parameter dictionary so we can supply the absolute path of the binary file # This is done to handle cases where the method is called from a different working directory than the simulation # results + + # EXPERIMENTAL + read_encounter = True param_tmp = self.param.copy() 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 self.verbose: + print("Reading initial conditions file as .ic") if "NETCDF" in self.param['IN_TYPE']: - param_tmp['BIN_OUT'] = os.path.join(self.simdir, self.param['NC_IN']) + param_tmp['BIN_OUT'] = self.simdir / self.param['NC_IN'] + self.ic = io.swiftest2xr(param_tmp, verbose=self.verbose) else: self.ic = self.data.isel(time=0) + if read_encounter: + param_tmp['BIN_OUT'] = self.simdir / "encounter.nc" + if self.verbose: + print("Reading encounter history file as .enc") + self.enc = io.swiftest2xr(param_tmp, verbose=self.verbose) elif self.codename == "Swifter": self.data = io.swifter2xr(param_tmp, verbose=self.verbose) From 731a8f5fabc51e1475510ae517be55d1bebfa611 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Mon, 5 Dec 2022 16:38:23 -0500 Subject: [PATCH 278/569] Finally got the body radius correct in the movies (I think) --- examples/Fragmentation/Fragmentation_Movie.py | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/examples/Fragmentation/Fragmentation_Movie.py b/examples/Fragmentation/Fragmentation_Movie.py index a4a925772..1bb82c869 100644 --- a/examples/Fragmentation/Fragmentation_Movie.py +++ b/examples/Fragmentation/Fragmentation_Movie.py @@ -114,7 +114,7 @@ def setup_plot(self): scale_frame = abs(rhy1) + abs(rhy2) ax = plt.Axes(fig, [0.1, 0.1, 0.8, 0.8]) - self.ax_pt_size = figsize[0] * 0.8 * 72 / scale_frame + self.ax_pt_size = figsize[0] * 0.8 * 72 / (2 * scale_frame) ax.set_xlim(-scale_frame, scale_frame) ax.set_ylim(-scale_frame, scale_frame) ax.set_xticks([]) @@ -140,7 +140,7 @@ def center(Gmass, x, y): Gmass, rh, point_rad = next(self.data_stream(frame)) x_com, y_com = center(Gmass, rh[:,0], rh[:,1]) self.scatter_artist.set_offsets(np.c_[rh[:,0] - x_com, rh[:,1] - y_com]) - self.scatter_artist.set_sizes(point_rad) + self.scatter_artist.set_sizes(point_rad**2) return self.scatter_artist, def data_stream(self, frame=0): @@ -180,6 +180,6 @@ def data_stream(self, frame=0): 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-3, tstop=1.0e-2, tstep_out=1e-2, dump_cadence=0) + sim.run(dt=1e-2, tstop=2.0e-2, istep_out=1, dump_cadence=0) - anim = AnimatedScatter(sim,movie_filename,movie_titles[style],nskip=10) + anim = AnimatedScatter(sim,movie_filename,movie_titles[style],nskip=1) From cea82cb39c3aac78c74dd1f19d02b116b4afa34d Mon Sep 17 00:00:00 2001 From: David A Minton Date: Mon, 5 Dec 2022 16:54:16 -0500 Subject: [PATCH 279/569] Accidentally read in position vectors as velocity when using XV input --- src/netcdf/netcdf.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/netcdf/netcdf.f90 b/src/netcdf/netcdf.f90 index 00e18bb1c..aa8464227 100644 --- a/src/netcdf/netcdf.f90 +++ b/src/netcdf/netcdf.f90 @@ -525,7 +525,7 @@ module function netcdf_read_frame_system(self, nciu, param) result(ierr) 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" ) + call check( nf90_get_var(nciu%id, nciu%vh_varid, vectemp, start=[1, 1, tslot], count=[NDIM,idmax,1]), "netcdf_read_frame_system nf90_getvar vh_varid" ) do i = 1, NDIM if (npl > 0) pl%vh(i,:) = pack(vectemp(i,:), plmask(:)) if (ntp > 0) tp%vh(i,:) = pack(vectemp(i,:), tpmask(:)) From d4981a1e0a588eab465bd7f2a8470e7af02b1fc9 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Mon, 5 Dec 2022 16:54:16 -0500 Subject: [PATCH 280/569] Accidentally read in position vectors as velocity when using XV input --- src/netcdf/netcdf.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/netcdf/netcdf.f90 b/src/netcdf/netcdf.f90 index 261fa6355..c7bd9a256 100644 --- a/src/netcdf/netcdf.f90 +++ b/src/netcdf/netcdf.f90 @@ -524,7 +524,7 @@ module function netcdf_read_frame_system(self, nciu, param) result(ierr) 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" ) + call check( nf90_get_var(nciu%id, nciu%vh_varid, vectemp, start=[1, 1, tslot], count=[NDIM,idmax,1]), "netcdf_read_frame_system nf90_getvar vh_varid" ) do i = 1, NDIM if (npl > 0) pl%vh(i,:) = pack(vectemp(i,:), plmask(:)) if (ntp > 0) tp%vh(i,:) = pack(vectemp(i,:), tpmask(:)) From d945ea4cb7a6aaa62a1043cb19a6e4bee9ec1034 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Mon, 5 Dec 2022 20:20:21 -0500 Subject: [PATCH 281/569] More maintence on the netcdf output for encounters. Something corrupts it when paricles are added --- src/modules/swiftest_classes.f90 | 2 +- src/symba/symba_io.f90 | 46 +++++++++++++++++--------------- src/symba/symba_util.f90 | 4 ++- 3 files changed, 29 insertions(+), 23 deletions(-) diff --git a/src/modules/swiftest_classes.f90 b/src/modules/swiftest_classes.f90 index 276750eb6..32946a125 100644 --- a/src/modules/swiftest_classes.f90 +++ b/src/modules/swiftest_classes.f90 @@ -544,7 +544,7 @@ module swiftest_classes type :: swiftest_storage(nframes) !! An class that establishes the pattern for various storage objects - integer(I4B), len :: nframes = 10 !! Total number of frames that can be stored + integer(I4B), len :: nframes = 32768 !! Total number of frames that can be stored type(swiftest_storage_frame), dimension(nframes) :: frame !! Array of stored frames integer(I4B) :: iframe = 0 !! The current frame number contains diff --git a/src/symba/symba_io.f90 b/src/symba/symba_io.f90 index 7c35e9ccb..1a9aae0c4 100644 --- a/src/symba/symba_io.f90 +++ b/src/symba/symba_io.f90 @@ -146,30 +146,34 @@ module subroutine symba_io_encounter_write_frame(self, nciu, param) class(symba_io_encounter_parameters), intent(inout) :: nciu !! Parameters used to identify a particular encounter io NetCDF dataset class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters ! Internals - integer(I4B) :: tslot,i,old_mode, n, idslot + integer(I4B) :: i, tslot, idslot, old_mode, n character(len=NAMELEN) :: charstring tslot = nciu%ienc_frame - call check( nf90_set_fill(nciu%id, nf90_nofill, old_mode), "symba_io_encounter_write_frame_base nf90_set_fill" ) - call check( nf90_put_var(nciu%id, nciu%time_varid, self%t, start=[tslot]), "symba_io_encounter_write_frame nf90_put_var time_varid" ) - - n = size(self%pl%id(:)) - do i = 1, n - idslot = self%pl%id(i) - charstring = trim(adjustl(self%pl%info(i)%name)) - call check( nf90_put_var(nciu%id, nciu%name_varid, charstring, start=[1, idslot], count=[NAMELEN, 1]), "symba_io_encounter_write_frame nf90_put_var name_varid" ) - charstring = trim(adjustl(self%pl%info(i)%particle_type)) - call check( nf90_put_var(nciu%id, nciu%ptype_varid, charstring, start=[1, idslot], count=[NAMELEN, 1]), "symba_io_encounter_write_frame nf90_put_var particle_type_varid" ) - call check( nf90_put_var(nciu%id, nciu%id_varid, self%pl%id(i), start=[idslot]), "symba_io_encounter_write_frame_base nf90_put_var id_varid" ) - call check( nf90_put_var(nciu%id, nciu%rh_varid, self%pl%rh(:, i), start=[1,idslot,tslot], count=[NDIM,1,1]), "symba_io_encounter_write_frame_base nf90_put_var rh_varid" ) - call check( nf90_put_var(nciu%id, nciu%vh_varid, self%pl%vh(:, i), start=[1,idslot,tslot], count=[NDIM,1,1]), "symba_io_encounter_write_frame_base nf90_put_var vh_varid" ) - call check( nf90_put_var(nciu%id, nciu%Gmass_varid, self%pl%Gmass(i), start=[idslot, tslot]), "symba_io_encounter_write_frame_base nf90_put_var body Gmass_varid" ) - if (param%lclose) call check( nf90_put_var(nciu%id, nciu%radius_varid, self%pl%radius(i), start=[idslot, tslot]), "symba_io_encounter_write_frame_base nf90_put_var body radius_varid" ) - if (param%lrotation) then - call check( nf90_put_var(nciu%id, nciu%Ip_varid, self%pl%Ip(:, i), start=[1, idslot, tslot], count=[NDIM,1,1]), "symba_io_encounter_write_frame_base nf90_put_var body Ip_varid" ) - call check( nf90_put_var(nciu%id, nciu%rot_varid, self%pl%rot(:, i), start=[1,idslot, tslot], count=[NDIM,1,1]), "symba_io_encounter_write_frame_base nf90_put_var body rotx_varid" ) - end if - end do + select type(pl => self%pl) + class is (symba_pl) + n = size(pl%id(:)) + do i = 1, n + idslot = pl%id(i) + call check( nf90_set_fill(nciu%id, nf90_nofill, old_mode), "symba_io_encounter_write_frame_base nf90_set_fill" ) + call check( nf90_put_var(nciu%id, nciu%time_varid, self%t, start=[tslot]), "symba_io_encounter_write_frame nf90_put_var time_varid" ) + call check( nf90_put_var(nciu%id, nciu%id_varid, pl%id(i), start=[idslot]), "symba_io_encounter_write_frame_base nf90_put_var id_varid" ) + call check( nf90_put_var(nciu%id, nciu%rh_varid, pl%rh(:,i), start=[1,idslot,tslot], count=[NDIM,1,1]), "symba_io_encounter_write_frame_base nf90_put_var rh_varid" ) + call check( nf90_put_var(nciu%id, nciu%vh_varid, pl%vh(:,i), start=[1,idslot,tslot], count=[NDIM,1,1]), "symba_io_encounter_write_frame_base nf90_put_var vh_varid" ) + call check( nf90_put_var(nciu%id, nciu%Gmass_varid, pl%Gmass(i), start=[idslot, tslot]), "symba_io_encounter_write_frame_base nf90_put_var body Gmass_varid" ) + if (param%lclose) call check( nf90_put_var(nciu%id, nciu%radius_varid, pl%radius(i), start=[idslot, tslot]), "symba_io_encounter_write_frame_base nf90_put_var body radius_varid" ) + if (param%lrotation) then + call check( nf90_put_var(nciu%id, nciu%Ip_varid, pl%Ip(:,i), start=[1, idslot, tslot], count=[NDIM,1,1]), "symba_io_encounter_write_frame_base nf90_put_var body Ip_varid" ) + call check( nf90_put_var(nciu%id, nciu%rot_varid, pl%rot(:,i), start=[1,idslot, tslot], count=[NDIM,1,1]), "symba_io_encounter_write_frame_base nf90_put_var body rotx_varid" ) + end if + charstring = trim(adjustl(pl%info(i)%name)) + call check( nf90_put_var(nciu%id, nciu%ptype_varid, charstring, start=[1, idslot], count=[NAMELEN, 1]), "symba_io_encounter_write_frame nf90_put_var particle_type_varid" ) + charstring = trim(adjustl(pl%info(i)%particle_type)) + call check( nf90_put_var(nciu%id, nciu%name_varid, charstring, start=[1, idslot], count=[NAMELEN, 1]), "symba_io_encounter_write_frame nf90_put_var name_varid" ) + end do + end select + + call check( nf90_set_fill(nciu%id, old_mode, old_mode) ) return end subroutine symba_io_encounter_write_frame diff --git a/src/symba/symba_util.f90 b/src/symba/symba_util.f90 index 50521f7a8..6a0b337b2 100644 --- a/src/symba/symba_util.f90 +++ b/src/symba/symba_util.f90 @@ -939,7 +939,7 @@ module subroutine symba_util_resize_storage(self, nnew) allocate(symba_encounter_storage(nbig) :: 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 + if (allocated(self%encounter_history%frame(i)%item)) call move_alloc(self%encounter_history%frame(i)%item, tmp%frame(i)%item) end do deallocate(self%encounter_history) end if @@ -1371,6 +1371,7 @@ module subroutine symba_util_take_encounter_snapshot(self, param, t) snapshot%pl%rot(i,:) = pack(pl%rot(i,1:npl), pl%lmask(1:npl)) end do end if + call snapshot%pl%sort("id", ascending=.true.) end if ! Take snapshot of the currently encountering test particles @@ -1394,6 +1395,7 @@ module subroutine symba_util_take_encounter_snapshot(self, param, t) ! Save the snapshot self%encounter_history%iframe = self%encounter_history%iframe + 1 call self%resize_storage(self%encounter_history%iframe) + self%encounter_history%frame(self%encounter_history%iframe) = snapshot end select end select From b0a8b8ace44ea2688a5d2744338d51e51f4a75b0 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Mon, 5 Dec 2022 22:45:35 -0500 Subject: [PATCH 282/569] Some updates to the movie --- examples/Fragmentation/Fragmentation_Movie.py | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/examples/Fragmentation/Fragmentation_Movie.py b/examples/Fragmentation/Fragmentation_Movie.py index 1bb82c869..a43555f08 100644 --- a/examples/Fragmentation/Fragmentation_Movie.py +++ b/examples/Fragmentation/Fragmentation_Movie.py @@ -40,8 +40,8 @@ movie_titles = dict(zip(available_movie_styles, movie_title_list)) # These initial conditions were generated by trial and error -pos_vectors = {"disruption_headon" : [np.array([1.0, -1.807993e-05, 0.0]), - np.array([1.0, 1.807993e-05 ,0.0])], +pos_vectors = {"disruption_headon" : [np.array([1.0, -2.807993e-05, 0.0]), + np.array([1.0, 2.807993e-05 ,0.0])], "supercatastrophic_off_axis": [np.array([1.0, -4.2e-05, 0.0]), np.array([1.0, 4.2e-05, 0.0])], "hitandrun" : [np.array([1.0, -2.0e-05, 0.0]), @@ -180,6 +180,6 @@ def data_stream(self, frame=0): 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-2, tstop=2.0e-2, istep_out=1, dump_cadence=0) + sim.run(dt=1e-4, tstop=2.0e-3, istep_out=1, dump_cadence=0) anim = AnimatedScatter(sim,movie_filename,movie_titles[style],nskip=1) From b9a0570057e1665a629a3363fb52d4431cf2eea9 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Mon, 5 Dec 2022 22:45:55 -0500 Subject: [PATCH 283/569] Bug fixes that allows the movie to work --- src/symba/symba_io.f90 | 4 ++-- src/symba/symba_util.f90 | 4 +++- 2 files changed, 5 insertions(+), 3 deletions(-) diff --git a/src/symba/symba_io.f90 b/src/symba/symba_io.f90 index 1a9aae0c4..e95a4f042 100644 --- a/src/symba/symba_io.f90 +++ b/src/symba/symba_io.f90 @@ -167,9 +167,9 @@ module subroutine symba_io_encounter_write_frame(self, nciu, param) call check( nf90_put_var(nciu%id, nciu%rot_varid, pl%rot(:,i), start=[1,idslot, tslot], count=[NDIM,1,1]), "symba_io_encounter_write_frame_base nf90_put_var body rotx_varid" ) end if charstring = trim(adjustl(pl%info(i)%name)) - call check( nf90_put_var(nciu%id, nciu%ptype_varid, charstring, start=[1, idslot], count=[NAMELEN, 1]), "symba_io_encounter_write_frame nf90_put_var particle_type_varid" ) - charstring = trim(adjustl(pl%info(i)%particle_type)) call check( nf90_put_var(nciu%id, nciu%name_varid, charstring, start=[1, idslot], count=[NAMELEN, 1]), "symba_io_encounter_write_frame nf90_put_var name_varid" ) + charstring = trim(adjustl(pl%info(i)%particle_type)) + call check( nf90_put_var(nciu%id, nciu%ptype_varid, charstring, start=[1, idslot], count=[NAMELEN, 1]), "symba_io_encounter_write_frame nf90_put_var particle_type_varid" ) end do end select diff --git a/src/symba/symba_util.f90 b/src/symba/symba_util.f90 index 6a0b337b2..cfdf416b6 100644 --- a/src/symba/symba_util.f90 +++ b/src/symba/symba_util.f90 @@ -1320,11 +1320,13 @@ module subroutine symba_util_take_encounter_snapshot(self, param, t) class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! current time ! Arguments - type(symba_encounter_snapshot) :: snapshot + type(symba_encounter_snapshot), allocatable :: snapshot integer(I4B) :: i, npl_snap, ntp_snap associate(npl => self%pl%nbody, ntp => self%tp%nbody) + allocate(symba_encounter_snapshot :: snapshot) + if (npl > 0) allocate(symba_pl :: snapshot%pl) if (ntp > 0) allocate(symba_tp :: snapshot%tp) if (npl + ntp == 0) return From 77478cf50f0ac8fe8054cf194cefa0d2377a7bd9 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Tue, 6 Dec 2022 06:16:55 -0500 Subject: [PATCH 284/569] Refactored nciu to nc for simplicity --- src/discard/discard.f90 | 4 +- src/io/io.f90 | 28 +- src/modules/swiftest_classes.f90 | 34 +- src/modules/symba_classes.f90 | 8 +- src/netcdf/netcdf.f90 | 620 +++++++++++++++---------------- src/setup/setup.f90 | 2 +- src/symba/symba_io.f90 | 97 ++--- src/symba/symba_util.f90 | 2 +- 8 files changed, 398 insertions(+), 397 deletions(-) diff --git a/src/discard/discard.f90 b/src/discard/discard.f90 index 41ece554b..1e0be68bd 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_info(param%nciu, param) - if (lpl_discards) call pl_discards%write_info(param%nciu, param) + if (ltp_discards) call tp_discards%write_info(param%nc, param) + if (lpl_discards) call pl_discards%write_info(param%nc, param) if (lpl_discards .and. param%lenergy) call self%conservation_report(param, lterminal=.false.) if (lpl_check) call pl_discards%setup(0,param) if (ltp_check) call tp_discards%setup(0,param) diff --git a/src/io/io.f90 b/src/io/io.f90 index 0f8c6761c..2892d5336 100644 --- a/src/io/io.f90 +++ b/src/io/io.f90 @@ -179,8 +179,8 @@ module subroutine io_conservation_report(self, param, lterminal) write(*,*) "Severe error! Mass not conserved! Halting!" ! Save the frame of data to the bin file in the slot just after the present one for diagnostics param%ioutput = param%ioutput + 1 - call self%write_frame(param%nciu, param) - call param%nciu%close() + call self%write_frame(param%nc, param) + call param%nc%close() call util_exit(FAILURE) end if end if @@ -248,8 +248,8 @@ module subroutine io_dump_system(self, param) dump_param%out_stat = 'APPEND' dump_param%in_type = "NETCDF_DOUBLE" dump_param%in_netcdf = trim(adjustl(DUMP_NC_FILE(idx))) - dump_param%nciu%id_chunk = self%pl%nbody + self%tp%nbody - dump_param%nciu%time_chunk = 1 + dump_param%nc%id_chunk = self%pl%nbody + self%tp%nbody + dump_param%nc%time_chunk = 1 dump_param%tstart = self%t call dump_param%dump(param_file_name) @@ -257,11 +257,11 @@ module subroutine io_dump_system(self, param) dump_param%out_form = "XV" dump_param%outfile = trim(adjustl(DUMP_NC_FILE(idx))) dump_param%ioutput = 1 - call dump_param%nciu%initialize(dump_param) - call self%write_frame(dump_param%nciu, dump_param) - call dump_param%nciu%close() + call dump_param%nc%initialize(dump_param) + call self%write_frame(dump_param%nc, dump_param) + call dump_param%nc%close() ! Syncrhonize the disk and memory buffer of the NetCDF file (e.g. commit the frame files stored in memory to disk) - call param%nciu%flush(param) + call param%nc%flush(param) idx = idx + 1 if (idx > NDUMPFILES) idx = 1 @@ -1308,7 +1308,7 @@ module subroutine io_read_in_system(self, param) ! Turn off energy computation so we don't have to feed it into the initial conditions tmp_param%lenergy = .false. end if - ierr = self%read_frame(tmp_param%nciu, tmp_param) + ierr = self%read_frame(tmp_param%nc, tmp_param) deallocate(tmp_param) if (ierr /=0) call util_exit(FAILURE) end if @@ -1537,8 +1537,8 @@ module subroutine io_write_frame_system(self, param) character(len=STRMAX) :: errmsg logical :: fileExists - param%nciu%id_chunk = self%pl%nbody + self%tp%nbody - param%nciu%time_chunk = max(param%dump_cadence / param%istep_out, 1) + param%nc%id_chunk = self%pl%nbody + self%tp%nbody + param%nc%time_chunk = max(param%dump_cadence / param%istep_out, 1) if (lfirst) then inquire(file=param%outfile, exist=fileExists) @@ -1553,15 +1553,15 @@ module subroutine io_write_frame_system(self, param) errmsg = param%outfile // " Alread Exists! You must specify OUT_STAT = APPEND, REPLACE, or UNKNOWN" goto 667 end if - call param%nciu%initialize(param) + call param%nc%initialize(param) case('REPLACE', 'UNKNOWN') - call param%nciu%initialize(param) + call param%nc%initialize(param) end select lfirst = .false. end if - call self%write_frame(param%nciu, param) + call self%write_frame(param%nc, param) return diff --git a/src/modules/swiftest_classes.f90 b/src/modules/swiftest_classes.f90 index 32946a125..cfb8ad604 100644 --- a/src/modules/swiftest_classes.f90 +++ b/src/modules/swiftest_classes.f90 @@ -150,8 +150,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(len=:), allocatable :: integrator !! Symbolic name of the nbody integrator used - character(len=:), allocatable :: param_file_name !! The name of the parameter 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 @@ -229,7 +229,7 @@ module swiftest_classes logical :: lyarkovsky = .false. !! Turn on Yarkovsky effect logical :: lyorp = .false. !! Turn on YORP effect - type(netcdf_parameters) :: nciu !! Object containing NetCDF parameters + type(netcdf_parameters) :: nc !! Object containing NetCDF parameters contains procedure :: reader => io_param_reader procedure :: writer => io_param_writer @@ -1024,55 +1024,55 @@ 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, nciu, param) result(ierr) + module function netcdf_read_frame_system(self, nc, param) result(ierr) implicit none class(swiftest_nbody_system), intent(inout) :: self !! Swiftest system object - class(netcdf_parameters), intent(inout) :: nciu !! Parameters used to for reading a NetCDF dataset to file + class(netcdf_parameters), intent(inout) :: nc !! Parameters used to for reading a NetCDF dataset to file class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters integer(I4B) :: ierr !! Error code: returns 0 if the read is successful end function netcdf_read_frame_system - module subroutine netcdf_read_hdr_system(self, nciu, param) + module subroutine netcdf_read_hdr_system(self, nc, param) implicit none class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nbody system object - class(netcdf_parameters), intent(inout) :: nciu !! Parameters used to for reading a NetCDF dataset to file + class(netcdf_parameters), intent(inout) :: nc !! Parameters used to for reading a NetCDF dataset to file class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters end subroutine netcdf_read_hdr_system - module subroutine netcdf_read_particle_info_system(self, nciu, param, plmask, tpmask) + module subroutine netcdf_read_particle_info_system(self, nc, param, plmask, tpmask) implicit none class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nbody system object - class(netcdf_parameters), intent(inout) :: nciu !! Parameters used to identify a particular NetCDF dataset + class(netcdf_parameters), intent(inout) :: nc !! Parameters used to identify a particular NetCDF dataset class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters logical, dimension(:), intent(in) :: plmask !! Logical array indicating which index values belong to massive bodies logical, dimension(:), intent(in) :: tpmask !! Logical array indicating which index values belong to test particles end subroutine netcdf_read_particle_info_system - module subroutine netcdf_write_frame_base(self, nciu, param) + module subroutine netcdf_write_frame_base(self, nc, param) implicit none class(swiftest_base), intent(in) :: self !! Swiftest base object - class(netcdf_parameters), intent(inout) :: nciu !! Parameters used to for writing a NetCDF dataset to file + class(netcdf_parameters), intent(inout) :: nc !! Parameters used to for writing a NetCDF dataset to file class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters end subroutine netcdf_write_frame_base - module subroutine netcdf_write_frame_system(self, nciu, param) + module subroutine netcdf_write_frame_system(self, nc, param) implicit none class(swiftest_nbody_system), intent(inout) :: self !! Swiftest system object - class(netcdf_parameters), intent(inout) :: nciu !! Parameters used to for writing a NetCDF dataset to file + class(netcdf_parameters), intent(inout) :: nc !! Parameters used to for writing a NetCDF dataset to file class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters end subroutine netcdf_write_frame_system - module subroutine netcdf_write_hdr_system(self, nciu, param) + module subroutine netcdf_write_hdr_system(self, nc, param) implicit none class(swiftest_nbody_system), intent(in) :: self !! Swiftest nbody system object - class(netcdf_parameters), intent(inout) :: nciu !! Parameters used to for writing a NetCDF dataset to file + class(netcdf_parameters), intent(inout) :: nc !! Parameters used to for writing a NetCDF dataset to file class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters end subroutine netcdf_write_hdr_system - module subroutine netcdf_write_info_base(self, nciu, param) + module subroutine netcdf_write_info_base(self, nc, param) implicit none class(swiftest_base), intent(in) :: self !! Swiftest particle object - class(netcdf_parameters), intent(inout) :: nciu !! Parameters used to identify a particular NetCDF dataset + class(netcdf_parameters), intent(inout) :: nc !! Parameters used to identify a particular NetCDF dataset class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters end subroutine netcdf_write_info_base diff --git a/src/modules/symba_classes.f90 b/src/modules/symba_classes.f90 index ad78027b9..81665f049 100644 --- a/src/modules/symba_classes.f90 +++ b/src/modules/symba_classes.f90 @@ -181,7 +181,7 @@ module symba_classes !! NetCDF dimension and variable names for the enounter save object type, extends(netcdf_parameters) :: symba_io_encounter_parameters integer(I4B) :: COLLIDER_DIM_SIZE = 2 !! Size of collider dimension - integer(I4B) :: ienc_frame !! Current frame number for the encounter history + integer(I4B) :: ienc_frame = 1 !! Current frame number for the encounter history character(STRMAX) :: enc_file = "encounter.nc" !! Encounter output file name character(NAMELEN) :: level_varname = "level" !! Recursion depth @@ -192,7 +192,7 @@ module symba_classes type, extends(swiftest_storage) :: symba_encounter_storage !! A class that that is used to store simulation history data between file output - type(symba_io_encounter_parameters) :: nciu + type(symba_io_encounter_parameters) :: nc contains procedure :: dump => symba_io_encounter_dump !! Dumps contents of encounter history to file final :: symba_util_final_encounter_storage @@ -425,10 +425,10 @@ module subroutine symba_io_encounter_initialize_output(self, param) class(swiftest_parameters), intent(in) :: param end subroutine symba_io_encounter_initialize_output - module subroutine symba_io_encounter_write_frame(self, nciu, param) + module subroutine symba_io_encounter_write_frame(self, nc, param) implicit none class(symba_encounter_snapshot), intent(in) :: self !! Swiftest encounter structure - class(symba_io_encounter_parameters), intent(inout) :: nciu !! Parameters used to identify a particular encounter io NetCDF dataset + class(symba_io_encounter_parameters), intent(inout) :: nc !! Parameters used to identify a particular encounter io NetCDF dataset class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters end subroutine symba_io_encounter_write_frame diff --git a/src/netcdf/netcdf.f90 b/src/netcdf/netcdf.f90 index aa8464227..31de061de 100644 --- a/src/netcdf/netcdf.f90 +++ b/src/netcdf/netcdf.f90 @@ -80,38 +80,38 @@ module function netcdf_get_old_t_final_system(self, param) result(old_t_final) 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%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" ) + call param%nc%open(param) + call check( nf90_inquire_dimension(param%nc%id, param%nc%time_dimid, len=itmax), "netcdf_get_old_t_final_system time_dimid" ) + call check( nf90_inquire_dimension(param%nc%id, param%nc%id_dimid, len=idmax), "netcdf_get_old_t_final_system id_dimid" ) allocate(vals(idmax)) - 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" ) + call check( nf90_get_var(param%nc%id, param%nc%time_varid, rtemp, start=[1], count=[1]), "netcdf_get_old_t_final_system time_varid" ) !old_t_final = rtemp(1) old_t_final = param%t0 ! For NetCDF it is safe to overwrite the final t value on a restart if (param%lenergy) then - call 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" ) + call check( nf90_get_var(param%nc%id, param%nc%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%id, param%nciu%KE_spin_varid, rtemp, start=[1], count=[1]), "netcdf_get_old_t_final_system KE_spin_varid" ) + call check( nf90_get_var(param%nc%id, param%nc%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%id, param%nciu%PE_varid, rtemp, start=[1], count=[1]), "netcdf_get_old_t_final_system PE_varid" ) + call check( nf90_get_var(param%nc%id, param%nc%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%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" ) + call check( nf90_get_var(param%nc%id, param%nc%Ecollisions_varid, self%Ecollisions, start=[1]), "netcdf_get_old_t_final_system Ecollisions_varid" ) + call check( nf90_get_var(param%nc%id, param%nc%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%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" ) + call check( nf90_get_var(param%nc%id, param%nc%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%nc%id, param%nc%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%nc%id, param%nc%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%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" ) + call check( nf90_get_var(param%nc%id, param%nc%Gmass_varid, vals, start=[1,1], count=[idmax,1]), "netcdf_get_old_t_final_system Gmass_varid" ) + call check( nf90_get_var(param%nc%id, param%nc%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) @@ -119,13 +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%id, param%nciu%radius_varid, rtemp, start=[1,1], count=[1,1]), "netcdf_get_old_t_final_system radius_varid" ) + call check( nf90_get_var(param%nc%id, param%nc%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%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" ) + call check( nf90_get_var(param%nc%id, param%nc%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%nc%id, param%nc%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(:) @@ -159,16 +159,16 @@ module subroutine netcdf_initialize_output(self, param) character(len=STRMAX) :: errmsg integer(I4B) :: ndims - associate(nciu => self) + associate(nc => self) dfill = ieee_value(dfill, IEEE_QUIET_NAN) sfill = ieee_value(sfill, IEEE_QUIET_NAN) select case (param%out_type) case("NETCDF_FLOAT") - nciu%out_type = NF90_FLOAT + nc%out_type = NF90_FLOAT case("NETCDF_DOUBLE") - nciu%out_type = NF90_DOUBLE + nc%out_type = NF90_DOUBLE end select ! Check if the file exists, and if it does, delete it @@ -179,121 +179,121 @@ module subroutine netcdf_initialize_output(self, param) end if ! Create the file - call check( nf90_create(param%outfile, NF90_NETCDF4, nciu%id), "netcdf_initialize_output nf90_create" ) + call check( nf90_create(param%outfile, NF90_NETCDF4, nc%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) + call check( nf90_def_dim(nc%id, nc%time_dimname, NF90_UNLIMITED, nc%time_dimid), "netcdf_initialize_output nf90_def_dim time_dimid" ) ! Simulation time dimension + call check( nf90_def_dim(nc%id, nc%space_dimname, NDIM, nc%space_dimid), "netcdf_initialize_output nf90_def_dim space_dimid" ) ! 3D space dimension + call check( nf90_def_dim(nc%id, nc%id_dimname, NF90_UNLIMITED, nc%id_dimid), "netcdf_initialize_output nf90_def_dim id_dimid" ) ! dimension to store particle id numbers + call check( nf90_def_dim(nc%id, nc%str_dimname, NAMELEN, nc%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" ) + call check( nf90_def_var(nc%id, nc%time_dimname, nc%out_type, nc%time_dimid, nc%time_varid), "netcdf_initialize_output nf90_def_var time_varid" ) + call check( nf90_def_var(nc%id, nc%space_dimname, NF90_CHAR, nc%space_dimid, nc%space_varid), "netcdf_initialize_output nf90_def_var space_varid" ) + call check( nf90_def_var(nc%id, nc%id_dimname, NF90_INT, nc%id_dimid, nc%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(nc%id, nc%npl_varname, NF90_INT, nc%time_dimid, nc%npl_varid), "netcdf_initialize_output nf90_def_var npl_varid" ) + call check( nf90_def_var(nc%id, nc%ntp_varname, NF90_INT, nc%time_dimid, nc%ntp_varid), "netcdf_initialize_output nf90_def_var ntp_varid" ) + if (param%integrator == SYMBA) call check( nf90_def_var(nc%id, nc%nplm_varname, NF90_INT, nc%time_dimid, nc%nplm_varid), "netcdf_initialize_output nf90_def_var nplm_varid" ) + call check( nf90_def_var(nc%id, nc%name_varname, NF90_CHAR, [nc%str_dimid, nc%id_dimid], nc%name_varid), "netcdf_initialize_output nf90_def_var name_varid" ) + call check( nf90_def_var(nc%id, nc%ptype_varname, NF90_CHAR, [nc%str_dimid, nc%id_dimid], nc%ptype_varid), "netcdf_initialize_output nf90_def_var ptype_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" ) + call check( nf90_def_var(nc%id, nc%rh_varname, nc%out_type, [nc%space_dimid, nc%id_dimid, nc%time_dimid], nc%rh_varid), "netcdf_initialize_output nf90_def_var rh_varid" ) + call check( nf90_def_var(nc%id, nc%vh_varname, nc%out_type, [nc%space_dimid, nc%id_dimid, nc%time_dimid], nc%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. + call check( nf90_def_var(nc%id, nc%gr_pseudo_vh_varname, nc%out_type, [nc%space_dimid, nc%id_dimid, nc%time_dimid], nc%gr_pseudo_vh_varid), "netcdf_initialize_output nf90_def_var gr_psuedo_vh_varid" ) + nc%lpseudo_vel_exists = .true. end if end if if ((param%out_form == "EL") .or. (param%out_form == "XVEL")) then - call 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" ) + call check( nf90_def_var(nc%id, nc%a_varname, nc%out_type, [nc%id_dimid, nc%time_dimid], nc%a_varid), "netcdf_initialize_output nf90_def_var a_varid" ) + call check( nf90_def_var(nc%id, nc%e_varname, nc%out_type, [nc%id_dimid, nc%time_dimid], nc%e_varid), "netcdf_initialize_output nf90_def_var e_varid" ) + call check( nf90_def_var(nc%id, nc%inc_varname, nc%out_type, [nc%id_dimid, nc%time_dimid], nc%inc_varid), "netcdf_initialize_output nf90_def_var inc_varid" ) + call check( nf90_def_var(nc%id, nc%capom_varname, nc%out_type, [nc%id_dimid, nc%time_dimid], nc%capom_varid), "netcdf_initialize_output nf90_def_var capom_varid" ) + call check( nf90_def_var(nc%id, nc%omega_varname, nc%out_type, [nc%id_dimid, nc%time_dimid], nc%omega_varid), "netcdf_initialize_output nf90_def_var omega_varid" ) + call check( nf90_def_var(nc%id, nc%capm_varname, nc%out_type, [nc%id_dimid, nc%time_dimid], nc%capm_varid), "netcdf_initialize_output nf90_def_var capm_varid" ) + call check( nf90_def_var(nc%id, nc%varpi_varname, nc%out_type, [nc%id_dimid, nc%time_dimid], nc%varpi_varid), "netcdf_initialize_output nf90_def_var varpi_varid" ) + call check( nf90_def_var(nc%id, nc%lam_varname, nc%out_type, [nc%id_dimid, nc%time_dimid], nc%lam_varid), "netcdf_initialize_output nf90_def_var lam_varid" ) + call check( nf90_def_var(nc%id, nc%f_varname, nc%out_type, [nc%id_dimid, nc%time_dimid], nc%f_varid), "netcdf_initialize_output nf90_def_var f_varid" ) + call check( nf90_def_var(nc%id, nc%cape_varname, nc%out_type, [nc%id_dimid, nc%time_dimid], nc%cape_varid), "netcdf_initialize_output nf90_def_var cape_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(nc%id, nc%gmass_varname, nc%out_type, [nc%id_dimid, nc%time_dimid], nc%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" ) + call check( nf90_def_var(nc%id, nc%rhill_varname, nc%out_type, [nc%id_dimid, nc%time_dimid], nc%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" ) + call check( nf90_def_var(nc%id, nc%radius_varname, nc%out_type, [nc%id_dimid, nc%time_dimid], nc%radius_varid), "netcdf_initialize_output nf90_def_var radius_varid" ) + + call check( nf90_def_var(nc%id, nc%origin_time_varname, nc%out_type, nc%id_dimid, nc%origin_time_varid), "netcdf_initialize_output nf90_def_var origin_time_varid" ) + call check( nf90_def_var(nc%id, nc%origin_type_varname, NF90_CHAR, [nc%str_dimid, nc%id_dimid], & + nc%origin_type_varid), "netcdf_initialize_output nf90_create" ) + call check( nf90_def_var(nc%id, nc%origin_rh_varname, nc%out_type, [nc%space_dimid, nc%id_dimid], nc%origin_rh_varid), "netcdf_initialize_output nf90_def_var origin_rh_varid" ) + call check( nf90_def_var(nc%id, nc%origin_vh_varname, nc%out_type, [nc%space_dimid, nc%id_dimid], nc%origin_vh_varid), "netcdf_initialize_output nf90_def_var origin_vh_varid" ) + + call check( nf90_def_var(nc%id, nc%collision_id_varname, NF90_INT, nc%id_dimid, nc%collision_id_varid), "netcdf_initialize_output nf90_def_var collision_id_varid" ) + call check( nf90_def_var(nc%id, nc%discard_time_varname, nc%out_type, nc%id_dimid, nc%discard_time_varid), "netcdf_initialize_output nf90_def_var discard_time_varid" ) + call check( nf90_def_var(nc%id, nc%discard_rh_varname, nc%out_type, [nc%space_dimid, nc%id_dimid], nc%discard_rh_varid), "netcdf_initialize_output nf90_def_var discard_rh_varid" ) + call check( nf90_def_var(nc%id, nc%discard_vh_varname, nc%out_type, [nc%space_dimid, nc%id_dimid], nc%discard_vh_varid), "netcdf_initialize_output nf90_def_var discard_vh_varid" ) + call check( nf90_def_var(nc%id, nc%discard_body_id_varname, NF90_INT, nc%id_dimid, nc%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" ) + call check( nf90_def_var(nc%id, nc%Ip_varname, nc%out_type, [nc%space_dimid, nc%id_dimid, nc%time_dimid], nc%Ip_varid), "netcdf_initialize_output nf90_def_var Ip_varid" ) + call check( nf90_def_var(nc%id, nc%rot_varname, nc%out_type, [nc%space_dimid, nc%id_dimid, nc%time_dimid], nc%rot_varid), "netcdf_initialize_output nf90_def_var rot_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" ) + ! call check( nf90_def_var(nc%id, nc%k2_varname, nc%out_type, [nc%id_dimid, nc%time_dimid], nc%k2_varid), "netcdf_initialize_output nf90_def_var k2_varid" ) + ! call check( nf90_def_var(nc%id, nc%q_varname, nc%out_type, [nc%id_dimid, nc%time_dimid], nc%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" ) + call check( nf90_def_var(nc%id, nc%ke_orb_varname, nc%out_type, nc%time_dimid, nc%KE_orb_varid), "netcdf_initialize_output nf90_def_var KE_orb_varid" ) + call check( nf90_def_var(nc%id, nc%ke_spin_varname, nc%out_type, nc%time_dimid, nc%KE_spin_varid), "netcdf_initialize_output nf90_def_var KE_spin_varid" ) + call check( nf90_def_var(nc%id, nc%pe_varname, nc%out_type, nc%time_dimid, nc%PE_varid), "netcdf_initialize_output nf90_def_var PE_varid" ) + call check( nf90_def_var(nc%id, nc%L_orb_varname, nc%out_type, [nc%space_dimid, nc%time_dimid], nc%L_orb_varid), "netcdf_initialize_output nf90_def_var L_orb_varid" ) + call check( nf90_def_var(nc%id, nc%L_spin_varname, nc%out_type, [nc%space_dimid, nc%time_dimid], nc%L_spin_varid), "netcdf_initialize_output nf90_def_var L_spin_varid" ) + call check( nf90_def_var(nc%id, nc%L_escape_varname, nc%out_type, [nc%space_dimid, nc%time_dimid], nc%L_escape_varid), "netcdf_initialize_output nf90_def_var L_escape_varid" ) + call check( nf90_def_var(nc%id, nc%Ecollisions_varname, nc%out_type, nc%time_dimid, nc%Ecollisions_varid), "netcdf_initialize_output nf90_def_var Ecollisions_varid" ) + call check( nf90_def_var(nc%id, nc%Euntracked_varname, nc%out_type, nc%time_dimid, nc%Euntracked_varid), "netcdf_initialize_output nf90_def_var Euntracked_varid" ) + call check( nf90_def_var(nc%id, nc%GMescape_varname, nc%out_type, nc%time_dimid, nc%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" ) + call check( nf90_def_var(nc%id, nc%j2rp2_varname, nc%out_type, nc%time_dimid, nc%j2rp2_varid), "netcdf_initialize_output nf90_def_var j2rp2_varid" ) + call check( nf90_def_var(nc%id, nc%j4rp4_varname, nc%out_type, nc%time_dimid, nc%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" ) + call check( nf90_inquire(nc%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" ) + call check( nf90_inquire_variable(nc%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" ) + call check( nf90_def_var_fill(nc%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" ) + call check( nf90_def_var_fill(nc%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" ) + call check( nf90_def_var_fill(nc%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" ) + call check( nf90_def_var_fill(nc%id, 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" ) + call check( nf90_enddef(nc%id), "netcdf_initialize_output nf90_enddef" ) ! Add in the space dimension coordinates - call check( nf90_put_var(nciu%id, nciu%space_varid, nciu%space_coords, start=[1], count=[NDIM]), "netcdf_initialize_output nf90_put_var space" ) + call check( nf90_put_var(nc%id, nc%space_varid, nc%space_coords, start=[1], count=[NDIM]), "netcdf_initialize_output nf90_put_var space" ) end associate return @@ -322,35 +322,35 @@ module subroutine netcdf_open(self, param, readonly) if (readonly) mode = NF90_NOWRITE end if - associate(nciu => self) + associate(nc => self) write(errmsg,*) "netcdf_open nf90_open ",trim(adjustl(param%outfile)) - call check( nf90_open(param%outfile, mode, nciu%id), errmsg) + call check( nf90_open(param%outfile, mode, nc%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" ) + call check( nf90_inq_dimid(nc%id, nc%time_dimname, nc%time_dimid), "netcdf_open nf90_inq_dimid time_dimid" ) + call check( nf90_inq_dimid(nc%id, nc%space_dimname, nc%space_dimid), "netcdf_open nf90_inq_dimid space_dimid" ) + call check( nf90_inq_dimid(nc%id, nc%id_dimname, nc%id_dimid), "netcdf_open nf90_inq_dimid id_dimid" ) + call check( nf90_inq_dimid(nc%id, nc%str_dimname, nc%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" ) + call check( nf90_inq_varid(nc%id, nc%time_dimname, nc%time_varid), "netcdf_open nf90_inq_varid time_varid" ) + call check( nf90_inq_varid(nc%id, nc%space_dimname, nc%space_varid), "netcdf_open nf90_inq_varid space_varid" ) + call check( nf90_inq_varid(nc%id, nc%id_dimname, nc%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" ) + call check( nf90_inq_varid(nc%id, nc%name_varname, nc%name_varid), "netcdf_open nf90_inq_varid name_varid" ) + call check( nf90_inq_varid(nc%id, nc%gmass_varname, nc%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" ) + call check( nf90_inq_varid(nc%id, nc%rh_varname, nc%rh_varid), "netcdf_open nf90_inq_varid rh_varid" ) + call check( nf90_inq_varid(nc%id, nc%vh_varname, nc%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 (param%lrestart .and. .not.nciu%lpseudo_vel_exists) then + status = nf90_inq_varid(nc%id, nc%gr_pseudo_vh_varname, nc%gr_pseudo_vh_varid) + nc%lpseudo_vel_exists = (status == nf90_noerr) + if (param%lrestart .and. .not.nc%lpseudo_vel_exists) then write(*,*) "Warning! Pseudovelocity not found in input file for GR enabled run. If this is a restarted run, bit-identical trajectories are not guarunteed!" end if @@ -358,71 +358,71 @@ module subroutine netcdf_open(self, param, readonly) 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" ) + call check( nf90_inq_varid(nc%id, nc%a_varname, nc%a_varid), "netcdf_open nf90_inq_varid a_varid" ) + call check( nf90_inq_varid(nc%id, nc%e_varname, nc%e_varid), "netcdf_open nf90_inq_varid e_varid" ) + call check( nf90_inq_varid(nc%id, nc%inc_varname, nc%inc_varid), "netcdf_open nf90_inq_varid inc_varid" ) + call check( nf90_inq_varid(nc%id, nc%capom_varname, nc%capom_varid), "netcdf_open nf90_inq_varid capom_varid" ) + call check( nf90_inq_varid(nc%id, nc%omega_varname, nc%omega_varid), "netcdf_open nf90_inq_varid omega_varid" ) + call check( nf90_inq_varid(nc%id, nc%capm_varname, nc%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" ) + call check( nf90_inq_varid(nc%id, nc%radius_varname, nc%radius_varid), "netcdf_open nf90_inq_varid radius_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" ) + call check( nf90_inq_varid(nc%id, nc%Ip_varname, nc%Ip_varid), "netcdf_open nf90_inq_varid Ip_varid" ) + call check( nf90_inq_varid(nc%id, nc%rot_varname, nc%rot_varid), "netcdf_open nf90_inq_varid rot_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" ) + ! call check( nf90_inq_varid(nc%id, nc%k2_varname, nc%k2_varid), "netcdf_open nf90_inq_varid k2_varid" ) + ! call check( nf90_inq_varid(nc%id, nc%q_varname, nc%Q_varid), "netcdf_open nf90_inq_varid Q_varid" ) ! end if ! Optional Variables if (param%lrhill_present) then - status = nf90_inq_varid(nciu%id, nciu%rhill_varname, nciu%rhill_varid) + status = nf90_inq_varid(nc%id, nc%rhill_varname, nc%rhill_varid) if (status /= nf90_noerr) write(*,*) "Warning! RHILL variable not set in input file. Calculating." end if ! Optional variables The User Doesn't Need to Know About - status = nf90_inq_varid(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%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) + status = nf90_inq_varid(nc%id, nc%npl_varname, nc%npl_varid) + status = nf90_inq_varid(nc%id, nc%ntp_varname, nc%ntp_varid) + status = nf90_inq_varid(nc%id, nc%j2rp2_varname, nc%j2rp2_varid) + status = nf90_inq_varid(nc%id, nc%j4rp4_varname, nc%j4rp4_varid) + status = nf90_inq_varid(nc%id, nc%ptype_varname, nc%ptype_varid) + status = nf90_inq_varid(nc%id, nc%varpi_varname, nc%varpi_varid) + status = nf90_inq_varid(nc%id, nc%lam_varname, nc%lam_varid) + status = nf90_inq_varid(nc%id, nc%f_varname, nc%f_varid) + status = nf90_inq_varid(nc%id, nc%cape_varname, nc%cape_varid) if (param%integrator == SYMBA) then - status = nf90_inq_varid(nciu%id, nciu%nplm_varname, nciu%nplm_varid) + status = nf90_inq_varid(nc%id, nc%nplm_varname, nc%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) + status = nf90_inq_varid(nc%id, nc%origin_type_varname, nc%origin_type_varid) + status = nf90_inq_varid(nc%id, nc%origin_time_varname, nc%origin_time_varid) + status = nf90_inq_varid(nc%id, nc%origin_rh_varname, nc%origin_rh_varid) + status = nf90_inq_varid(nc%id, nc%origin_vh_varname, nc%origin_vh_varid) + status = nf90_inq_varid(nc%id, nc%collision_id_varname, nc%collision_id_varid) + status = nf90_inq_varid(nc%id, nc%discard_time_varname, nc%discard_time_varid) + status = nf90_inq_varid(nc%id, nc%discard_rh_varname, nc%discard_rh_varid) + status = nf90_inq_varid(nc%id, nc%discard_vh_varname, nc%discard_vh_varid) + status = nf90_inq_varid(nc%id, nc%discard_body_id_varname, nc%discard_body_id_varid) end if if (param%lenergy) then - status = nf90_inq_varid(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) + status = nf90_inq_varid(nc%id, nc%ke_orb_varname, nc%KE_orb_varid) + status = nf90_inq_varid(nc%id, nc%ke_spin_varname, nc%KE_spin_varid) + status = nf90_inq_varid(nc%id, nc%pe_varname, nc%PE_varid) + status = nf90_inq_varid(nc%id, nc%L_orb_varname, nc%L_orb_varid) + status = nf90_inq_varid(nc%id, nc%L_spin_varname, nc%L_spin_varid) + status = nf90_inq_varid(nc%id, nc%L_escape_varname, nc%L_escape_varid) + status = nf90_inq_varid(nc%id, nc%Ecollisions_varname, nc%Ecollisions_varid) + status = nf90_inq_varid(nc%id, nc%Euntracked_varname, nc%Euntracked_varid) + status = nf90_inq_varid(nc%id, nc%GMescape_varname, nc%GMescape_varid) end if end associate @@ -431,14 +431,14 @@ module subroutine netcdf_open(self, param, readonly) end subroutine netcdf_open - module function netcdf_read_frame_system(self, nciu, param) result(ierr) + module function netcdf_read_frame_system(self, nc, param) result(ierr) !! author: The Purdue Swiftest Team - David A. Minton, Carlisle A. Wishard, Jennifer L.L. Pouplin, and Jacob R. Elliott !! !! Read a frame (header plus records for each massive body and active test particle) from an output binary file implicit none ! Arguments class(swiftest_nbody_system), intent(inout) :: self !! Swiftest system object - class(netcdf_parameters), intent(inout) :: nciu !! Parameters used to identify a particular NetCDF dataset + class(netcdf_parameters), intent(inout) :: nc !! Parameters used to identify a particular NetCDF dataset class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters ! Return integer(I4B) :: ierr !! Error code: returns 0 if the read is successful @@ -449,8 +449,8 @@ module function netcdf_read_frame_system(self, nciu, param) result(ierr) integer(I4B), dimension(:), allocatable :: itemp logical, dimension(:), allocatable :: validmask, tpmask, plmask - call nciu%open(param, readonly=.true.) - call self%read_hdr(nciu, param) + call nc%open(param, readonly=.true.) + call self%read_hdr(nc, param) associate(cb => self%cb, pl => self%pl, tp => self%tp, npl => self%pl%nbody, ntp => self%tp%nbody) @@ -459,27 +459,27 @@ module function netcdf_read_frame_system(self, nciu, param) result(ierr) tslot = param%ioutput - call check( nf90_inquire_dimension(nciu%id, nciu%id_dimid, len=idmax), "netcdf_read_frame_system nf90_inquire_dimension id_dimid" ) + call check( nf90_inquire_dimension(nc%id, nc%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(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" ) + call check( nf90_inquire_dimension(nc%id, nc%time_dimid, len=t_max), "netcdf_read_frame_system nf90_inquire_dimension time_dimid" ) + call check( nf90_inquire_dimension(nc%id, nc%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(nciu%id, nciu%rh_varid, vectemp(:,:), start=[1, 1, tslot]), "netcdf_read_frame_system filter pass nf90_getvar rh_varid" ) + call check( nf90_get_var(nc%id, nc%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(nciu%id, nciu%a_varid, rtemp(:), start=[1, tslot]), "netcdf_read_frame_system filter pass nf90_getvar a_varid" ) + call check( nf90_get_var(nc%id, nc%a_varid, rtemp(:), start=[1, tslot]), "netcdf_read_frame_system filter pass nf90_getvar a_varid" ) validmask(:) = rtemp(:) == rtemp(:) end if ! Next, filter only bodies that don't have mass (test particles) - call check( nf90_get_var(nciu%id, nciu%Gmass_varid, rtemp(:), start=[1, tslot]), "netcdf_read_frame_system nf90_getvar tp finder Gmass_varid" ) + call check( nf90_get_var(nc%id, nc%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 @@ -512,20 +512,20 @@ module function netcdf_read_frame_system(self, nciu, 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(nciu%id, nciu%rh_varid, vectemp, start=[1, 1, tslot], count=[NDIM,idmax,1]), "netcdf_read_frame_system nf90_getvar rh_varid" ) + call check( nf90_get_var(nc%id, nc%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 - 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" ) + if (param%lgr .and. nc%lpseudo_vel_exists) then + call check( nf90_get_var(nc%id, nc%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, vectemp, start=[1, 1, tslot], count=[NDIM,idmax,1]), "netcdf_read_frame_system nf90_getvar vh_varid" ) + call check( nf90_get_var(nc%id, nc%vh_varid, vectemp, start=[1, 1, tslot], count=[NDIM,idmax,1]), "netcdf_read_frame_system nf90_getvar vh_varid" ) do i = 1, NDIM if (npl > 0) pl%vh(i,:) = pack(vectemp(i,:), plmask(:)) if (ntp > 0) tp%vh(i,:) = pack(vectemp(i,:), tpmask(:)) @@ -534,40 +534,40 @@ module function netcdf_read_frame_system(self, nciu, param) result(ierr) end if if ((param%in_form == "EL") .or. (param%in_form == "XVEL")) then - 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" ) + call check( nf90_get_var(nc%id, nc%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(nciu%id, nciu%e_varid, rtemp, start=[1, tslot], count=[idmax,1]), "netcdf_read_frame_system nf90_getvar e_varid" ) + call check( nf90_get_var(nc%id, nc%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(nciu%id, nciu%inc_varid, rtemp, start=[1, tslot], count=[idmax,1]), "netcdf_read_frame_system nf90_getvar inc_varid" ) + call check( nf90_get_var(nc%id, nc%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(nciu%id, nciu%capom_varid, rtemp, start=[1, tslot], count=[idmax,1]), "netcdf_read_frame_system nf90_getvar capom_varid" ) + call check( nf90_get_var(nc%id, nc%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(nciu%id, nciu%omega_varid, rtemp, start=[1, tslot], count=[idmax,1]), "netcdf_read_frame_system nf90_getvar omega_varid" ) + call check( nf90_get_var(nc%id, nc%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(nciu%id, nciu%capm_varid, rtemp, start=[1, tslot], count=[idmax,1]), "netcdf_read_frame_system nf90_getvar capm_varid" ) + call check( nf90_get_var(nc%id, nc%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)) @@ -576,7 +576,7 @@ module function netcdf_read_frame_system(self, nciu, param) result(ierr) end if - 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" ) + call check( nf90_get_var(nc%id, nc%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 @@ -592,13 +592,13 @@ module function netcdf_read_frame_system(self, nciu, param) result(ierr) pl%mass(:) = pl%Gmass(:) / param%GU if (param%lrhill_present) then - 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" ) + call check( nf90_get_var(nc%id, nc%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(nciu%id, nciu%radius_varid, rtemp, start=[1, tslot], count=[idmax,1]), "netcdf_read_frame_system nf90_getvar radius_varid" ) + call check( nf90_get_var(nc%id, nc%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 @@ -613,13 +613,13 @@ module function netcdf_read_frame_system(self, nciu, param) result(ierr) end if if (param%lrotation) then - 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" ) + call check( nf90_get_var(nc%id, nc%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(nciu%id, nciu%rot_varid, vectemp, start=[1, 1, tslot], count=[NDIM,idmax,1]), "netcdf_read_frame_system nf90_getvar rot_varid" ) + call check( nf90_get_var(nc%id, nc%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(:)) @@ -633,37 +633,37 @@ module function netcdf_read_frame_system(self, nciu, param) result(ierr) end if ! if (param%ltides) then - ! call check( nf90_get_var(nciu%id, nciu%k2_varid, rtemp, start=[1, tslot]), "netcdf_read_frame_system nf90_getvar k2_varid" ) + ! call check( nf90_get_var(nc%id, nc%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(nciu%id, nciu%Q_varid, rtemp, start=[1, tslot]), "netcdf_read_frame_system nf90_getvar Q_varid" ) + ! call check( nf90_get_var(nc%id, nc%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(nciu%id, nciu%j2rp2_varname, nciu%j2rp2_varid) + status = nf90_inq_varid(nc%id, nc%j2rp2_varname, nc%j2rp2_varid) if (status == nf90_noerr) then - call check( nf90_get_var(nciu%id, nciu%j2rp2_varid, cb%j2rp2, start=[tslot]), "netcdf_read_frame_system nf90_getvar j2rp2_varid" ) + call check( nf90_get_var(nc%id, nc%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(nciu%id, nciu%j4rp4_varname, nciu%j4rp4_varid) + status = nf90_inq_varid(nc%id, nc%j4rp4_varname, nc%j4rp4_varid) if (status == nf90_noerr) then - call check( nf90_get_var(nciu%id, nciu%j4rp4_varid, cb%j4rp4, start=[tslot]), "netcdf_read_frame_system nf90_getvar j4rp4_varid" ) + call check( nf90_get_var(nc%id, nc%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(nciu, param, plmask, tpmask) + call self%read_particle_info(nc, param, plmask, tpmask) if (param%in_form == "EL") then call pl%el2xv(cb) call tp%el2xv(cb) end if ! if this is a GR-enabled run, check to see if we got the pseudovelocities in. Otherwise, we'll need to generate them. - if (param%lgr .and. .not.(nciu%lpseudo_vel_exists)) then + if (param%lgr .and. .not.(nc%lpseudo_vel_exists)) then call pl%set_mu(cb) call tp%set_mu(cb) call pl%v2pv(param) @@ -672,7 +672,7 @@ module function netcdf_read_frame_system(self, nciu, param) result(ierr) end associate - call nciu%close() + call nc%close() ierr = 0 return @@ -683,7 +683,7 @@ module function netcdf_read_frame_system(self, nciu, param) result(ierr) end function netcdf_read_frame_system - module subroutine netcdf_read_hdr_system(self, nciu, param) + module subroutine netcdf_read_hdr_system(self, nc, param) !! author: David A. Minton !! !! Reads header information (variables that change with time, but not particle id). @@ -692,7 +692,7 @@ module subroutine netcdf_read_hdr_system(self, nciu, param) implicit none ! Arguments class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nbody system object - class(netcdf_parameters), intent(inout) :: nciu !! Parameters used to for writing a NetCDF dataset to file + class(netcdf_parameters), intent(inout) :: nc !! Parameters used to for writing a NetCDF dataset to file class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters ! Internals integer(I4B) :: tslot, status, idmax @@ -701,15 +701,15 @@ module subroutine netcdf_read_hdr_system(self, nciu, param) tslot = param%ioutput - 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" ) + call check( nf90_inquire_dimension(nc%id, nc%id_dimid, len=idmax), "netcdf_read_hdr_system nf90_inquire_dimension id_dimid" ) + call check( nf90_get_var(nc%id, nc%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(nciu%id, nciu%Gmass_varid, gmtemp, start=[1,1], count=[idmax,1]), "netcdf_read_hdr_system nf90_getvar Gmass_varid" ) + call check( nf90_get_var(nc%id, nc%Gmass_varid, gmtemp, start=[1,1], count=[idmax,1]), "netcdf_read_hdr_system nf90_getvar Gmass_varid" ) plmask(:) = gmtemp(:) == gmtemp(:) tpmask(:) = .not. plmask(:) @@ -722,26 +722,26 @@ module subroutine netcdf_read_hdr_system(self, nciu, param) endwhere end select - status = nf90_inq_varid(nciu%id, nciu%npl_varname, nciu%npl_varid) + status = nf90_inq_varid(nc%id, nc%npl_varname, nc%npl_varid) if (status == nf90_noerr) then - call check( nf90_get_var(nciu%id, nciu%npl_varid, self%pl%nbody, start=[tslot]), "netcdf_read_hdr_system nf90_getvar npl_varid" ) + call check( nf90_get_var(nc%id, nc%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(nciu%id, nciu%ntp_varname, nciu%ntp_varid) + status = nf90_inq_varid(nc%id, nc%ntp_varname, nc%ntp_varid) if (status == nf90_noerr) then - call check( nf90_get_var(nciu%id, nciu%ntp_varid, self%tp%nbody, start=[tslot]), "netcdf_read_hdr_system nf90_getvar ntp_varid" ) + call check( nf90_get_var(nc%id, nc%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(nciu%id, nciu%nplm_varname, nciu%nplm_varid) + status = nf90_inq_varid(nc%id, nc%nplm_varname, nc%nplm_varid) select type(pl => self%pl) class is (symba_pl) if (status == nf90_noerr) then - call check( nf90_get_var(nciu%id, nciu%nplm_varid, pl%nplm, start=[tslot]), "netcdf_read_hdr_system nf90_getvar nplm_varid" ) + call check( nf90_get_var(nc%id, nc%nplm_varid, pl%nplm, start=[tslot]), "netcdf_read_hdr_system nf90_getvar nplm_varid" ) else pl%nplm = count(plmmask(:)) end if @@ -749,38 +749,38 @@ module subroutine netcdf_read_hdr_system(self, nciu, param) end if if (param%lenergy) then - 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" ) + status = nf90_inq_varid(nc%id, nc%ke_orb_varname, nc%KE_orb_varid) + if (status == nf90_noerr) call check( nf90_get_var(nc%id, nc%KE_orb_varid, self%ke_orbit, start=[tslot]), "netcdf_read_hdr_system nf90_getvar KE_orb_varid" ) + status = nf90_inq_varid(nc%id, nc%ke_spin_varname, nc%KE_spin_varid) + if (status == nf90_noerr) call check( nf90_get_var(nc%id, nc%KE_spin_varid, self%ke_spin, start=[tslot]), "netcdf_read_hdr_system nf90_getvar KE_spin_varid" ) + status = nf90_inq_varid(nc%id, nc%pe_varname, nc%PE_varid) + if (status == nf90_noerr) call check( nf90_get_var(nc%id, nc%PE_varid, self%pe, start=[tslot]), "netcdf_read_hdr_system nf90_getvar PE_varid" ) + status = nf90_inq_varid(nc%id, nc%L_orb_varname, nc%L_orb_varid) + if (status == nf90_noerr) call check( nf90_get_var(nc%id, nc%L_orb_varid, self%Lorbit(:), start=[1,tslot], count=[NDIM,1]), "netcdf_read_hdr_system nf90_getvar L_orb_varid" ) + status = nf90_inq_varid(nc%id, nc%L_spin_varname, nc%L_spin_varid) + if (status == nf90_noerr) call check( nf90_get_var(nc%id, nc%L_spin_varid, self%Lspin(:), start=[1,tslot], count=[NDIM,1]), "netcdf_read_hdr_system nf90_getvar L_spin_varid" ) + status = nf90_inq_varid(nc%id, nc%L_escape_varname, nc%L_escape_varid) + if (status == nf90_noerr) call check( nf90_get_var(nc%id, nc%L_escape_varid, self%Lescape(:), start=[1, tslot], count=[NDIM,1]), "netcdf_read_hdr_system nf90_getvar L_escape_varid" ) + status = nf90_inq_varid(nc%id, nc%Ecollisions_varname, nc%Ecollisions_varid) + if (status == nf90_noerr) call check( nf90_get_var(nc%id, nc%Ecollisions_varid, self%Ecollisions, start=[tslot]), "netcdf_read_hdr_system nf90_getvar Ecollisions_varid" ) + status = nf90_inq_varid(nc%id, nc%Euntracked_varname, nc%Euntracked_varid) + if (status == nf90_noerr) call check( nf90_get_var(nc%id, nc%Euntracked_varid, self%Euntracked, start=[tslot]), "netcdf_read_hdr_system nf90_getvar Euntracked_varid" ) + status = nf90_inq_varid(nc%id, nc%GMescape_varname, nc%GMescape_varid) + if (status == nf90_noerr) call check( nf90_get_var(nc%id, nc%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, nciu, param, plmask, tpmask) + module subroutine netcdf_read_particle_info_system(self, nc, param, plmask, tpmask) !! author: Carlisle A. Wishard, Dana Singh, and David A. Minton !! !! Reads particle information metadata from file implicit none ! Arguments class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nbody system object - class(netcdf_parameters), intent(inout) :: nciu !! Parameters used to identify a particular NetCDF dataset + class(netcdf_parameters), intent(inout) :: nc !! Parameters used to identify a particular NetCDF dataset class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters logical, dimension(:), intent(in) :: plmask !! Logical array indicating which index values belong to massive bodies logical, dimension(:), intent(in) :: tpmask !! Logical array indicating which index values belong to test particles @@ -820,12 +820,12 @@ module subroutine netcdf_read_particle_info_system(self, nciu, param, plmask, tp tpind(:) = pack([(i, i = 1, idmax)], tpmask(:)) end if - call check( nf90_get_var(nciu%id, nciu%id_varid, itemp), "netcdf_read_particle_info_system nf90_getvar id_varid" ) + call check( nf90_get_var(nc%id, nc%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(nciu%id, nciu%name_varid, ctemp, count=[NAMELEN, idmax]), "netcdf_read_particle_info_system nf90_getvar name_varid" ) + call check( nf90_get_var(nc%id, nc%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))) @@ -834,7 +834,7 @@ module subroutine netcdf_read_particle_info_system(self, nciu, param, plmask, tp call tp%info(i)%set_value(name=ctemp(tpind(i))) end do - status = nf90_get_var(nciu%id, nciu%ptype_varid, ctemp, count=[NAMELEN, idmax]) + status = nf90_get_var(nc%id, nc%ptype_varid, ctemp, count=[NAMELEN, idmax]) if (status /= nf90_noerr) then ! Set default particle types call cb%info%set_value(particle_type=CB_TYPE_NAME) @@ -873,9 +873,9 @@ module subroutine netcdf_read_particle_info_system(self, nciu, param, plmask, tp if (param%lclose) then - status = nf90_inq_varid(nciu%id, nciu%origin_type_varname, nciu%origin_type_varid) + status = nf90_inq_varid(nc%id, nc%origin_type_varname, nc%origin_type_varid) if (status == nf90_noerr) then - 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" ) + call check( nf90_get_var(nc%id, nc%origin_type_varid, ctemp, count=[NAMELEN, idmax]), "netcdf_read_particle_info_system nf90_getvar origin_type_varid" ) else ctemp = "Initial Conditions" end if @@ -888,9 +888,9 @@ module subroutine netcdf_read_particle_info_system(self, nciu, param, plmask, tp call tp%info(i)%set_value(origin_type=ctemp(tpind(i))) end do - status = nf90_inq_varid(nciu%id, nciu%origin_time_varname, nciu%origin_time_varid) + status = nf90_inq_varid(nc%id, nc%origin_time_varname, nc%origin_time_varid) if (status == nf90_noerr) then - call check( nf90_get_var(nciu%id, nciu%origin_time_varid, rtemp), "netcdf_read_particle_info_system nf90_getvar origin_time_varid" ) + call check( nf90_get_var(nc%id, nc%origin_time_varid, rtemp), "netcdf_read_particle_info_system nf90_getvar origin_time_varid" ) else rtemp = param%t0 end if @@ -903,11 +903,11 @@ module subroutine netcdf_read_particle_info_system(self, nciu, param, plmask, tp call tp%info(i)%set_value(origin_time=rtemp(tpind(i))) end do - status = nf90_inq_varid(nciu%id, nciu%origin_rh_varname, nciu%origin_rh_varid) + status = nf90_inq_varid(nc%id, nc%origin_rh_varname, nc%origin_rh_varid) if (status == nf90_noerr) then - call check( nf90_get_var(nciu%id, nciu%origin_rh_varid, vectemp(:,:)), "netcdf_read_particle_info_system nf90_getvar origin_rh_varid" ) + call check( nf90_get_var(nc%id, nc%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(nciu%id, nciu%rh_varid, vectemp(:,:)), "netcdf_read_particle_info_system nf90_getvar rh_varid" ) + call check( nf90_get_var(nc%id, nc%rh_varid, vectemp(:,:)), "netcdf_read_particle_info_system nf90_getvar rh_varid" ) else vectemp(:,:) = 0._DP end if @@ -919,11 +919,11 @@ module subroutine netcdf_read_particle_info_system(self, nciu, param, plmask, tp call tp%info(i)%set_value(origin_rh=vectemp(:,tpind(i))) end do - status = nf90_inq_varid(nciu%id, nciu%origin_vh_varname, nciu%origin_vh_varid) + status = nf90_inq_varid(nc%id, nc%origin_vh_varname, nc%origin_vh_varid) if (status == nf90_noerr) then - call check( nf90_get_var(nciu%id, nciu%origin_vh_varid, vectemp(:,:)), "netcdf_read_particle_info_system nf90_getvar origin_vh_varid" ) + call check( nf90_get_var(nc%id, nc%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(nciu%id, nciu%vh_varid, vectemp(:,:)), "netcdf_read_particle_info_system nf90_getvar vh_varid" ) + call check( nf90_get_var(nc%id, nc%vh_varid, vectemp(:,:)), "netcdf_read_particle_info_system nf90_getvar vh_varid" ) else vectemp(:,:) = 0._DP end if @@ -935,9 +935,9 @@ module subroutine netcdf_read_particle_info_system(self, nciu, param, plmask, tp call tp%info(i)%set_value(origin_vh=vectemp(:,tpind(i))) end do - status = nf90_inq_varid(nciu%id, nciu%collision_id_varname, nciu%collision_id_varid) + status = nf90_inq_varid(nc%id, nc%collision_id_varname, nc%collision_id_varid) if (status == nf90_noerr) then - call check( nf90_get_var(nciu%id, nciu%collision_id_varid, itemp), "netcdf_read_particle_info_system nf90_getvar collision_id_varid" ) + call check( nf90_get_var(nc%id, nc%collision_id_varid, itemp), "netcdf_read_particle_info_system nf90_getvar collision_id_varid" ) else itemp = 0.0_DP end if @@ -949,9 +949,9 @@ module subroutine netcdf_read_particle_info_system(self, nciu, param, plmask, tp call tp%info(i)%set_value(collision_id=itemp(tpind(i))) end do - status = nf90_inq_varid(nciu%id, nciu%discard_time_varname, nciu%discard_time_varid) + status = nf90_inq_varid(nc%id, nc%discard_time_varname, nc%discard_time_varid) if (status == nf90_noerr) then - call check( nf90_get_var(nciu%id, nciu%discard_time_varid, rtemp), "netcdf_read_particle_info_system nf90_getvar discard_time_varid" ) + call check( nf90_get_var(nc%id, nc%discard_time_varid, rtemp), "netcdf_read_particle_info_system nf90_getvar discard_time_varid" ) else rtemp = 0.0_DP end if @@ -964,9 +964,9 @@ module subroutine netcdf_read_particle_info_system(self, nciu, param, plmask, tp call tp%info(i)%set_value(discard_time=rtemp(tpind(i))) end do - status = nf90_inq_varid(nciu%id, nciu%discard_rh_varname, nciu%discard_rh_varid) + status = nf90_inq_varid(nc%id, nc%discard_rh_varname, nc%discard_rh_varid) if (status == nf90_noerr) then - call check( nf90_get_var(nciu%id, nciu%discard_rh_varid, vectemp(:,:)), "netcdf_read_particle_info_system nf90_getvar discard_rh_varid" ) + call check( nf90_get_var(nc%id, nc%discard_rh_varid, vectemp(:,:)), "netcdf_read_particle_info_system nf90_getvar discard_rh_varid" ) else vectemp(:,:) = 0.0_DP end if @@ -978,9 +978,9 @@ module subroutine netcdf_read_particle_info_system(self, nciu, param, plmask, tp call tp%info(i)%set_value(discard_rh=vectemp(:,tpind(i))) end do - status = nf90_inq_varid(nciu%id, nciu%discard_vh_varname, nciu%discard_vh_varid) + status = nf90_inq_varid(nc%id, nc%discard_vh_varname, nc%discard_vh_varid) if (status == nf90_noerr) then - call check( nf90_get_var(nciu%id, nciu%discard_vh_varid, vectemp(:,:)), "netcdf_read_particle_info_system nf90_getvar discard_vh_varid" ) + call check( nf90_get_var(nc%id, nc%discard_vh_varid, vectemp(:,:)), "netcdf_read_particle_info_system nf90_getvar discard_vh_varid" ) else vectemp(:,:) = 0.0_DP end if @@ -1014,7 +1014,7 @@ module subroutine netcdf_sync(self) end subroutine netcdf_sync - module subroutine netcdf_write_frame_base(self, nciu, param) + module subroutine netcdf_write_frame_base(self, nc, param) !! author: Carlisle A. Wishard, Dana Singh, and David A. Minton !! !! Write a frame of output of either test particle or massive body data to the binary output file @@ -1022,7 +1022,7 @@ module subroutine netcdf_write_frame_base(self, nciu, param) implicit none ! Arguments class(swiftest_base), intent(in) :: self !! Swiftest particle object - class(netcdf_parameters), intent(inout) :: nciu !! Parameters used to identify a particular NetCDF dataset + class(netcdf_parameters), intent(inout) :: nc !! Parameters used to identify a particular NetCDF dataset class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters ! Internals integer(I4B) :: i, j, tslot, idslot, old_mode @@ -1030,11 +1030,11 @@ module subroutine netcdf_write_frame_base(self, nciu, param) real(DP), dimension(NDIM) :: vh !! Temporary variable to store heliocentric velocity values when converting from pseudovelocity in GR-enabled runs real(DP) :: a, e, inc, omega, capom, capm, varpi, lam, f, cape, capf - call self%write_info(nciu, param) + call self%write_info(nc, param) tslot = param%ioutput - call check( nf90_set_fill(nciu%id, nf90_nofill, old_mode), "netcdf_write_frame_base nf90_set_fill" ) + call check( nf90_set_fill(nc%id, nf90_nofill, old_mode), "netcdf_write_frame_base nf90_set_fill" ) select type(self) class is (swiftest_body) associate(n => self%nbody) @@ -1050,13 +1050,13 @@ module subroutine netcdf_write_frame_base(self, nciu, param) 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(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" ) + call check( nf90_put_var(nc%id, nc%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(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" ) + call check( nf90_put_var(nc%id, nc%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(nc%id, nc%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(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" ) + call check( nf90_put_var(nc%id, nc%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 @@ -1070,36 +1070,36 @@ module subroutine netcdf_write_frame_base(self, nciu, param) self%vh(1,j), self%vh(2,j), self%vh(3,j), & a, e, inc, capom, omega, capm, varpi, lam, f, cape, capf) end if - call 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" ) + call check( nf90_put_var(nc%id, nc%a_varid, a, start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var body a_varid" ) + call check( nf90_put_var(nc%id, nc%e_varid, e, start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var body e_varid" ) + call check( nf90_put_var(nc%id, nc%inc_varid, inc * RAD2DEG, start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var body inc_varid" ) + call check( nf90_put_var(nc%id, nc%capom_varid, capom * RAD2DEG, start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var body capom_varid" ) + call check( nf90_put_var(nc%id, nc%omega_varid, omega * RAD2DEG, start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var body omega_varid" ) + call check( nf90_put_var(nc%id, nc%capm_varid, capm * RAD2DEG, start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var body capm_varid" ) + call check( nf90_put_var(nc%id, nc%varpi_varid, varpi * RAD2DEG, start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var body varpi_varid" ) + call check( nf90_put_var(nc%id, nc%lam_varid, lam * RAD2DEG, start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var body lam_varid" ) + call check( nf90_put_var(nc%id, nc%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" ) + call check( nf90_put_var(nc%id, nc%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" ) + call check( nf90_put_var(nc%id, nc%cape_varid, capf * RAD2DEG, start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var body (capf) cape_varid" ) end if end if select type(self) class is (swiftest_pl) ! Additional output if the passed polymorphic object is a massive body - call 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" ) + call check( nf90_put_var(nc%id, nc%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(nciu%id, nciu%rhill_varid, self%rhill(j), start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var body rhill_varid" ) + call check( nf90_put_var(nc%id, nc%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(nciu%id, nciu%radius_varid, self%radius(j), start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var body radius_varid" ) + if (param%lclose) call check( nf90_put_var(nc%id, nc%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(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" ) + call check( nf90_put_var(nc%id, nc%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(nc%id, nc%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(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" ) + ! call check( nf90_put_var(nc%id, nc%k2_varid, self%k2(j), start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var body k2_varid" ) + ! call check( nf90_put_var(nc%id, nc%Q_varid, self%Q(j), start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var body Q_varid" ) ! end if end select @@ -1107,55 +1107,55 @@ module subroutine netcdf_write_frame_base(self, nciu, param) end associate class is (swiftest_cb) idslot = self%id + 1 - 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(nc%id, nc%id_varid, self%id, start=[idslot]), "netcdf_write_frame_base nf90_put_var cb id_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" ) + call check( nf90_put_var(nc%id, nc%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(nc%id, nc%radius_varid, self%radius, start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var cb radius_varid" ) + call check( nf90_put_var(nc%id, nc%j2rp2_varid, self%j2rp2, start=[tslot]), "netcdf_write_frame_base nf90_put_var cb j2rp2_varid" ) + call check( nf90_put_var(nc%id, nc%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(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" ) + call check( nf90_put_var(nc%id, nc%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(nc%id, nc%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(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" ) + ! call check( nf90_put_var(nc%id, nc%k2_varid, self%k2, start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var cb k2_varid" ) + ! call check( nf90_put_var(nc%id, nc%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(nciu%id, old_mode, old_mode), "netcdf_write_frame_base nf90_set_fill old_mode" ) + call check( nf90_set_fill(nc%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, nciu, param) + module subroutine netcdf_write_frame_system(self, nc, param) !! author: The Purdue Swiftest Team - David A. Minton, Carlisle A. Wishard, Jennifer L.L. Pouplin, and Jacob R. Elliott !! !! Write a frame (header plus records for each massive body and active test particle) to a output binary file implicit none ! Arguments class(swiftest_nbody_system), intent(inout) :: self !! Swiftest system object - class(netcdf_parameters), intent(inout) :: nciu !! Parameters used to identify a particular NetCDF dataset + class(netcdf_parameters), intent(inout) :: nc !! Parameters used to identify a particular NetCDF dataset class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - 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) + call self%write_hdr(nc, param) + call self%cb%write_frame(nc, param) + call self%pl%write_frame(nc, param) + call self%tp%write_frame(nc, param) return end subroutine netcdf_write_frame_system - module subroutine netcdf_write_info_base(self, nciu, param) + module subroutine netcdf_write_info_base(self, nc, 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) :: nciu !! Parameters used to identify a particular NetCDF dataset + class(netcdf_parameters), intent(inout) :: nc !! Parameters used to identify a particular NetCDF dataset class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters ! Internals integer(I4B) :: i, j, idslot, old_mode @@ -1163,7 +1163,7 @@ module subroutine netcdf_write_info_base(self, nciu, 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(nciu%id, nf90_nofill, old_mode), "netcdf_write_info_base nf90_set_fill nf90_nofill" ) + call check( nf90_set_fill(nc%id, nf90_nofill, old_mode), "netcdf_write_info_base nf90_set_fill nf90_nofill" ) select type(self) class is (swiftest_body) @@ -1174,25 +1174,25 @@ module subroutine netcdf_write_info_base(self, nciu, param) do i = 1, n j = ind(i) idslot = self%id(j) + 1 - call check( nf90_put_var(nciu%id, nciu%id_varid, self%id(j), start=[idslot]), "netcdf_write_info_base nf90_put_var id_varid" ) + call check( nf90_put_var(nc%id, nc%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(nciu%id, nciu%name_varid, charstring, start=[1, idslot], count=[NAMELEN, 1]), "netcdf_write_info_base nf90_put_var name_varid" ) + call check( nf90_put_var(nc%id, nc%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(nciu%id, nciu%ptype_varid, charstring, start=[1, idslot], count=[NAMELEN, 1]), "netcdf_write_info_base nf90_put_var particle_type_varid" ) + call check( nf90_put_var(nc%id, nc%ptype_varid, charstring, start=[1, idslot], count=[NAMELEN, 1]), "netcdf_write_info_base nf90_put_var particle_type_varid" ) if (param%lclose) then charstring = trim(adjustl(self%info(j)%origin_type)) - 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(nc%id, nc%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(nc%id, nc%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(nc%id, nc%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(nc%id, nc%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(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" ) + call check( nf90_put_var(nc%id, nc%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(nc%id, nc%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(nc%id, nc%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(nc%id, nc%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 @@ -1200,36 +1200,36 @@ module subroutine netcdf_write_info_base(self, nciu, param) class is (swiftest_cb) idslot = self%id + 1 - call check( nf90_put_var(nciu%id, nciu%id_varid, self%id, start=[idslot]), "netcdf_write_info_base nf90_put_var cb id_varid" ) + call check( nf90_put_var(nc%id, nc%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(nciu%id, nciu%name_varid, charstring, start=[1, idslot], count=[NAMELEN, 1]), "netcdf_write_info_base nf90_put_var cb name_varid" ) + call check( nf90_put_var(nc%id, nc%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(nciu%id, nciu%ptype_varid, charstring, start=[1, idslot], count=[NAMELEN, 1]), "netcdf_write_info_base nf90_put_var cb ptype_varid" ) + call check( nf90_put_var(nc%id, nc%ptype_varid, charstring, start=[1, idslot], count=[NAMELEN, 1]), "netcdf_write_info_base nf90_put_var cb ptype_varid" ) if (param%lclose) then charstring = trim(adjustl(self%info%origin_type)) - 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(nc%id, nc%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(nc%id, nc%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(nc%id, nc%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(nc%id, nc%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(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" ) + call check( nf90_put_var(nc%id, nc%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(nc%id, nc%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(nc%id, nc%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(nc%id, nc%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(nciu%id, old_mode, old_mode) ) + call check( nf90_set_fill(nc%id, old_mode, old_mode) ) return end subroutine netcdf_write_info_base - module subroutine netcdf_write_hdr_system(self, nciu, param) + module subroutine netcdf_write_hdr_system(self, nc, param) !! author: David A. Minton !! !! Writes header information (variables that change with time, but not particle id). @@ -1238,31 +1238,31 @@ module subroutine netcdf_write_hdr_system(self, nciu, param) implicit none ! Arguments class(swiftest_nbody_system), intent(in) :: self !! Swiftest nbody system object - class(netcdf_parameters), intent(inout) :: nciu !! Parameters used to for writing a NetCDF dataset to file + class(netcdf_parameters), intent(inout) :: nc !! Parameters used to for writing a NetCDF dataset to file class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters ! Internals integer(I4B) :: tslot tslot = param%ioutput - call 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" ) + call check( nf90_put_var(nc%id, nc%time_varid, self%t, start=[tslot]), "netcdf_write_hdr_system nf90_put_var time_varid" ) + call check( nf90_put_var(nc%id, nc%npl_varid, self%pl%nbody, start=[tslot]), "netcdf_write_hdr_system nf90_put_var npl_varid" ) + call check( nf90_put_var(nc%id, nc%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(nciu%id, nciu%nplm_varid, pl%nplm, start=[tslot]), "netcdf_write_hdr_system nf90_put_var nplm_varid" ) + call check( nf90_put_var(nc%id, nc%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(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" ) + call check( nf90_put_var(nc%id, nc%KE_orb_varid, self%ke_orbit, start=[tslot]), "netcdf_write_hdr_system nf90_put_var KE_orb_varid" ) + call check( nf90_put_var(nc%id, nc%KE_spin_varid, self%ke_spin, start=[tslot]), "netcdf_write_hdr_system nf90_put_var KE_spin_varid" ) + call check( nf90_put_var(nc%id, nc%PE_varid, self%pe, start=[tslot]), "netcdf_write_hdr_system nf90_put_var PE_varid" ) + call check( nf90_put_var(nc%id, nc%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(nc%id, nc%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(nc%id, nc%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(nc%id, nc%Ecollisions_varid, self%Ecollisions, start=[tslot]), "netcdf_write_hdr_system nf90_put_var Ecollisions_varid" ) + call check( nf90_put_var(nc%id, nc%Euntracked_varid, self%Euntracked, start=[tslot]), "netcdf_write_hdr_system nf90_put_var Euntracked_varid" ) + call check( nf90_put_var(nc%id, nc%GMescape_varid, self%GMescape, start=[tslot]), "netcdf_write_hdr_system nf90_put_var GMescape_varid" ) end if return diff --git a/src/setup/setup.f90 b/src/setup/setup.f90 index fe9b20572..ea6d3db23 100644 --- a/src/setup/setup.f90 +++ b/src/setup/setup.f90 @@ -92,7 +92,7 @@ module subroutine setup_finalize_system(self, param) class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters associate(system => self) - call param%nciu%close() + call param%nc%close() end associate return diff --git a/src/symba/symba_io.f90 b/src/symba/symba_io.f90 index e95a4f042..4cb557162 100644 --- a/src/symba/symba_io.f90 +++ b/src/symba/symba_io.f90 @@ -23,17 +23,17 @@ module subroutine symba_io_encounter_dump(self, param) 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) + call self%nc%initialize(param) do i = 1, self%nframes if (allocated(self%frame(i)%item)) then select type(snapshot => self%frame(i)%item) class is (symba_encounter_snapshot) - self%nciu%ienc_frame = i - call snapshot%write_frame(self%nciu,param) + self%nc%ienc_frame = self%nc%ienc_frame + 1 + call snapshot%write_frame(self%nc,param) end select end if end do - call self%nciu%close() + !call self%nc%close() return @@ -59,7 +59,7 @@ module subroutine symba_io_encounter_initialize_output(self, param) integer(I4B) :: ndims - associate(nciu => self) + associate(nc => self) dfill = ieee_value(dfill, IEEE_QUIET_NAN) sfill = ieee_value(sfill, IEEE_QUIET_NAN) @@ -72,59 +72,60 @@ module subroutine symba_io_encounter_initialize_output(self, param) ! Check if the file exists, and if it does, delete it - inquire(file=nciu%enc_file, exist=fileExists) + inquire(file=nc%enc_file, exist=fileExists) if (fileExists) then - open(unit=LUN, file=nciu%enc_file, status="old", err=667, iomsg=errmsg) + return + open(unit=LUN, file=nc%enc_file, status="old", err=667, iomsg=errmsg) close(unit=LUN, status="delete") end if - call check( nf90_create(nciu%enc_file, NF90_NETCDF4, nciu%id), "symba_io_encounter_initialize_output nf90_create" ) + call check( nf90_create(nc%enc_file, NF90_NETCDF4, nc%id), "symba_io_encounter_initialize_output nf90_create" ) ! Dimensions - call check( nf90_def_dim(nciu%id, nciu%time_dimname, NF90_UNLIMITED, nciu%time_dimid), "symba_io_encounter_initialize_output nf90_def_dim time_dimid" ) ! Simulation time dimension - call check( nf90_def_dim(nciu%id, nciu%space_dimname, NDIM, nciu%space_dimid), "symba_io_encounter_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), "symba_io_encounter_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), "symba_io_encounter_initialize_output nf90_def_dim str_dimid" ) ! Dimension for string variables (aka character arrays) + call check( nf90_def_dim(nc%id, nc%time_dimname, NF90_UNLIMITED, nc%time_dimid), "symba_io_encounter_initialize_output nf90_def_dim time_dimid" ) ! Simulation time dimension + call check( nf90_def_dim(nc%id, nc%space_dimname, NDIM, nc%space_dimid), "symba_io_encounter_initialize_output nf90_def_dim space_dimid" ) ! 3D space dimension + call check( nf90_def_dim(nc%id, nc%id_dimname, NF90_UNLIMITED, nc%id_dimid), "symba_io_encounter_initialize_output nf90_def_dim id_dimid" ) ! dimension to store particle id numbers + call check( nf90_def_dim(nc%id, nc%str_dimname, NAMELEN, nc%str_dimid), "symba_io_encounter_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), "symba_io_encounter_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), "symba_io_encounter_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), "symba_io_encounter_initialize_output nf90_def_var id_varid" ) + call check( nf90_def_var(nc%id, nc%time_dimname, nc%out_type, nc%time_dimid, nc%time_varid), "symba_io_encounter_initialize_output nf90_def_var time_varid" ) + call check( nf90_def_var(nc%id, nc%space_dimname, NF90_CHAR, nc%space_dimid, nc%space_varid), "symba_io_encounter_initialize_output nf90_def_var space_varid" ) + call check( nf90_def_var(nc%id, nc%id_dimname, NF90_INT, nc%id_dimid, nc%id_varid), "symba_io_encounter_initialize_output nf90_def_var id_varid" ) ! Variables - call check( nf90_def_var(nciu%id, nciu%name_varname, NF90_CHAR, [nciu%str_dimid, nciu%id_dimid], nciu%name_varid), "symba_io_encounter_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), "symba_io_encounter_initialize_output nf90_def_var ptype_varid" ) - 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), "symba_io_encounter_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), "symba_io_encounter_initialize_output nf90_def_var vh_varid" ) - call check( nf90_def_var(nciu%id, nciu%gmass_varname, nciu%out_type, [nciu%id_dimid, nciu%time_dimid], nciu%Gmass_varid), "symba_io_encounter_initialize_output nf90_def_var Gmass_varid" ) + call check( nf90_def_var(nc%id, nc%name_varname, NF90_CHAR, [nc%str_dimid, nc%id_dimid], nc%name_varid), "symba_io_encounter_initialize_output nf90_def_var name_varid" ) + call check( nf90_def_var(nc%id, nc%ptype_varname, NF90_CHAR, [nc%str_dimid, nc%id_dimid], nc%ptype_varid), "symba_io_encounter_initialize_output nf90_def_var ptype_varid" ) + call check( nf90_def_var(nc%id, nc%rh_varname, nc%out_type, [nc%space_dimid, nc%id_dimid, nc%time_dimid], nc%rh_varid), "symba_io_encounter_initialize_output nf90_def_var rh_varid" ) + call check( nf90_def_var(nc%id, nc%vh_varname, nc%out_type, [nc%space_dimid, nc%id_dimid, nc%time_dimid], nc%vh_varid), "symba_io_encounter_initialize_output nf90_def_var vh_varid" ) + call check( nf90_def_var(nc%id, nc%gmass_varname, nc%out_type, [nc%id_dimid, nc%time_dimid], nc%Gmass_varid), "symba_io_encounter_initialize_output nf90_def_var Gmass_varid" ) 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), "symba_io_encounter_initialize_output nf90_def_var radius_varid" ) + call check( nf90_def_var(nc%id, nc%radius_varname, nc%out_type, [nc%id_dimid, nc%time_dimid], nc%radius_varid), "symba_io_encounter_initialize_output nf90_def_var radius_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), "symba_io_encounter_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), "symba_io_encounter_initialize_output nf90_def_var rot_varid" ) + call check( nf90_def_var(nc%id, nc%Ip_varname, nc%out_type, [nc%space_dimid, nc%id_dimid, nc%time_dimid], nc%Ip_varid), "symba_io_encounter_initialize_output nf90_def_var Ip_varid" ) + call check( nf90_def_var(nc%id, nc%rot_varname, nc%out_type, [nc%space_dimid, nc%id_dimid, nc%time_dimid], nc%rot_varid), "symba_io_encounter_initialize_output nf90_def_var rot_varid" ) end if - call check( nf90_inquire(nciu%id, nVariables=nvar), "symba_io_encounter_initialize_output nf90_inquire nVariables" ) + call check( nf90_inquire(nc%id, nVariables=nvar), "symba_io_encounter_initialize_output nf90_inquire nVariables" ) do varid = 1, nvar - call check( nf90_inquire_variable(nciu%id, varid, xtype=vartype, ndims=ndims), "symba_io_encounter_initialize_output nf90_inquire_variable" ) + call check( nf90_inquire_variable(nc%id, varid, xtype=vartype, ndims=ndims), "symba_io_encounter_initialize_output nf90_inquire_variable" ) select case(vartype) case(NF90_INT) - call check( nf90_def_var_fill(nciu%id, varid, 0, NF90_FILL_INT), "symba_io_encounter_initialize_output nf90_def_var_fill NF90_INT" ) + call check( nf90_def_var_fill(nc%id, varid, 0, NF90_FILL_INT), "symba_io_encounter_initialize_output nf90_def_var_fill NF90_INT" ) case(NF90_FLOAT) - call check( nf90_def_var_fill(nciu%id, varid, 0, sfill), "symba_io_encounter_initialize_output nf90_def_var_fill NF90_FLOAT" ) + call check( nf90_def_var_fill(nc%id, varid, 0, sfill), "symba_io_encounter_initialize_output nf90_def_var_fill NF90_FLOAT" ) case(NF90_DOUBLE) - call check( nf90_def_var_fill(nciu%id, varid, 0, dfill), "symba_io_encounter_initialize_output nf90_def_var_fill NF90_DOUBLE" ) + call check( nf90_def_var_fill(nc%id, varid, 0, dfill), "symba_io_encounter_initialize_output nf90_def_var_fill NF90_DOUBLE" ) case(NF90_CHAR) - call check( nf90_def_var_fill(nciu%id, varid, 0, 0), "symba_io_encounter_initialize_output nf90_def_var_fill NF90_CHAR" ) + call check( nf90_def_var_fill(nc%id, varid, 0, 0), "symba_io_encounter_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), "symba_io_encounter_initialize_output nf90_enddef" ) + call check( nf90_enddef(nc%id), "symba_io_encounter_initialize_output nf90_enddef" ) ! Add in the space dimension coordinates - call check( nf90_put_var(nciu%id, nciu%space_varid, nciu%space_coords, start=[1], count=[NDIM]), "symba_io_encounter_initialize_output nf90_put_var space" ) + call check( nf90_put_var(nc%id, nc%space_varid, nc%space_coords, start=[1], count=[NDIM]), "symba_io_encounter_initialize_output nf90_put_var space" ) end associate return @@ -135,7 +136,7 @@ module subroutine symba_io_encounter_initialize_output(self, param) end subroutine symba_io_encounter_initialize_output - module subroutine symba_io_encounter_write_frame(self, nciu, param) + module subroutine symba_io_encounter_write_frame(self, nc, param) !! author: David A. Minton !! !! Write a frame of output of an encounter list structure. @@ -143,37 +144,37 @@ module subroutine symba_io_encounter_write_frame(self, nciu, param) implicit none ! Arguments class(symba_encounter_snapshot), intent(in) :: self !! Swiftest encounter structure - class(symba_io_encounter_parameters), intent(inout) :: nciu !! Parameters used to identify a particular encounter io NetCDF dataset + class(symba_io_encounter_parameters), intent(inout) :: nc !! Parameters used to identify a particular encounter io NetCDF dataset class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters ! Internals integer(I4B) :: i, tslot, idslot, old_mode, n character(len=NAMELEN) :: charstring - tslot = nciu%ienc_frame + tslot = nc%ienc_frame select type(pl => self%pl) class is (symba_pl) n = size(pl%id(:)) do i = 1, n idslot = pl%id(i) - call check( nf90_set_fill(nciu%id, nf90_nofill, old_mode), "symba_io_encounter_write_frame_base nf90_set_fill" ) - call check( nf90_put_var(nciu%id, nciu%time_varid, self%t, start=[tslot]), "symba_io_encounter_write_frame nf90_put_var time_varid" ) - call check( nf90_put_var(nciu%id, nciu%id_varid, pl%id(i), start=[idslot]), "symba_io_encounter_write_frame_base nf90_put_var id_varid" ) - call check( nf90_put_var(nciu%id, nciu%rh_varid, pl%rh(:,i), start=[1,idslot,tslot], count=[NDIM,1,1]), "symba_io_encounter_write_frame_base nf90_put_var rh_varid" ) - call check( nf90_put_var(nciu%id, nciu%vh_varid, pl%vh(:,i), start=[1,idslot,tslot], count=[NDIM,1,1]), "symba_io_encounter_write_frame_base nf90_put_var vh_varid" ) - call check( nf90_put_var(nciu%id, nciu%Gmass_varid, pl%Gmass(i), start=[idslot, tslot]), "symba_io_encounter_write_frame_base nf90_put_var body Gmass_varid" ) - if (param%lclose) call check( nf90_put_var(nciu%id, nciu%radius_varid, pl%radius(i), start=[idslot, tslot]), "symba_io_encounter_write_frame_base nf90_put_var body radius_varid" ) + call check( nf90_set_fill(nc%id, nf90_nofill, old_mode), "symba_io_encounter_write_frame_base nf90_set_fill" ) + call check( nf90_put_var(nc%id, nc%time_varid, self%t, start=[tslot]), "symba_io_encounter_write_frame nf90_put_var time_varid" ) + call check( nf90_put_var(nc%id, nc%id_varid, pl%id(i), start=[idslot]), "symba_io_encounter_write_frame_base nf90_put_var id_varid" ) + call check( nf90_put_var(nc%id, nc%rh_varid, pl%rh(:,i), start=[1,idslot,tslot], count=[NDIM,1,1]), "symba_io_encounter_write_frame_base nf90_put_var rh_varid" ) + call check( nf90_put_var(nc%id, nc%vh_varid, pl%vh(:,i), start=[1,idslot,tslot], count=[NDIM,1,1]), "symba_io_encounter_write_frame_base nf90_put_var vh_varid" ) + call check( nf90_put_var(nc%id, nc%Gmass_varid, pl%Gmass(i), start=[idslot, tslot]), "symba_io_encounter_write_frame_base nf90_put_var body Gmass_varid" ) + if (param%lclose) call check( nf90_put_var(nc%id, nc%radius_varid, pl%radius(i), start=[idslot, tslot]), "symba_io_encounter_write_frame_base nf90_put_var body radius_varid" ) if (param%lrotation) then - call check( nf90_put_var(nciu%id, nciu%Ip_varid, pl%Ip(:,i), start=[1, idslot, tslot], count=[NDIM,1,1]), "symba_io_encounter_write_frame_base nf90_put_var body Ip_varid" ) - call check( nf90_put_var(nciu%id, nciu%rot_varid, pl%rot(:,i), start=[1,idslot, tslot], count=[NDIM,1,1]), "symba_io_encounter_write_frame_base nf90_put_var body rotx_varid" ) + call check( nf90_put_var(nc%id, nc%Ip_varid, pl%Ip(:,i), start=[1, idslot, tslot], count=[NDIM,1,1]), "symba_io_encounter_write_frame_base nf90_put_var body Ip_varid" ) + call check( nf90_put_var(nc%id, nc%rot_varid, pl%rot(:,i), start=[1,idslot, tslot], count=[NDIM,1,1]), "symba_io_encounter_write_frame_base nf90_put_var body rotx_varid" ) end if charstring = trim(adjustl(pl%info(i)%name)) - call check( nf90_put_var(nciu%id, nciu%name_varid, charstring, start=[1, idslot], count=[NAMELEN, 1]), "symba_io_encounter_write_frame nf90_put_var name_varid" ) + call check( nf90_put_var(nc%id, nc%name_varid, charstring, start=[1, idslot], count=[NAMELEN, 1]), "symba_io_encounter_write_frame nf90_put_var name_varid" ) charstring = trim(adjustl(pl%info(i)%particle_type)) - call check( nf90_put_var(nciu%id, nciu%ptype_varid, charstring, start=[1, idslot], count=[NAMELEN, 1]), "symba_io_encounter_write_frame nf90_put_var particle_type_varid" ) + call check( nf90_put_var(nc%id, nc%ptype_varid, charstring, start=[1, idslot], count=[NAMELEN, 1]), "symba_io_encounter_write_frame nf90_put_var particle_type_varid" ) end do end select - call check( nf90_set_fill(nciu%id, old_mode, old_mode) ) + call check( nf90_set_fill(nc%id, old_mode, old_mode) ) return end subroutine symba_io_encounter_write_frame @@ -355,12 +356,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_info(param%nciu, param) + if (self%tp_discards%nbody > 0) call self%tp_discards%write_info(param%nc, param) select type(pl_discards => self%pl_discards) class is (symba_merger) if (pl_discards%nbody == 0) return - call pl_discards%write_info(param%nciu, param) + call pl_discards%write_info(param%nc, param) end select end associate diff --git a/src/symba/symba_util.f90 b/src/symba/symba_util.f90 index cfdf416b6..672ab1aed 100644 --- a/src/symba/symba_util.f90 +++ b/src/symba/symba_util.f90 @@ -704,7 +704,7 @@ module subroutine symba_util_rearray_pl(self, system, param) end where end select - call pl%write_info(param%nciu, param) + call pl%write_info(param%nc, param) deallocate(ldump_mask) ! Reindex the new list of bodies From 3425a4261c41cf41fd125958a98c2df3d3341bae Mon Sep 17 00:00:00 2001 From: David A Minton Date: Tue, 6 Dec 2022 10:03:08 -0500 Subject: [PATCH 285/569] Added new parameters for controlling encounter and fragmentation output --- examples/Fragmentation/Fragmentation_Movie.py | 4 +- python/swiftest/swiftest/io.py | 53 ++++--------- python/swiftest/swiftest/simulation_class.py | 78 +++++++++++++++++++ 3 files changed, 96 insertions(+), 39 deletions(-) diff --git a/examples/Fragmentation/Fragmentation_Movie.py b/examples/Fragmentation/Fragmentation_Movie.py index a43555f08..ba98c6900 100644 --- a/examples/Fragmentation/Fragmentation_Movie.py +++ b/examples/Fragmentation/Fragmentation_Movie.py @@ -179,7 +179,7 @@ def data_stream(self, frame=0): # 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-4, tstop=2.0e-3, istep_out=1, dump_cadence=0) + sim.set_parameter(fragmentation=True, fragmentation_save="TRAJECTORY", gmtiny=gmtiny, minimum_fragment_gmass=minimum_fragment_gmass, verbose=False) + sim.run(dt=1e-5, tstop=2.0e-3, istep_out=1, dump_cadence=0) anim = AnimatedScatter(sim,movie_filename,movie_titles[style],nskip=1) diff --git a/python/swiftest/swiftest/io.py b/python/swiftest/swiftest/io.py index 40ce7ae33..e315cd244 100644 --- a/python/swiftest/swiftest/io.py +++ b/python/swiftest/swiftest/io.py @@ -31,7 +31,11 @@ "INTERACTION_LOOPS", "ENCOUNTER_CHECK", "TSTART", - "DUMP_CADENCE") + "DUMP_CADENCE", + "ENCOUNTER_SAVE", + "FRAGMENTATION_SAVE") + + # This list defines features that are booleans, so must be converted to/from string when writing/reading from file bool_param = ["RESTART", @@ -51,7 +55,10 @@ float_param = ["T0", "TSTART", "TSTOP", "DT", "CHK_RMIN", "CHK_RMAX", "CHK_EJECT", "CHK_QMIN", "DU2M", "MU2KG", "TU2S", "MIN_GMFRAG", "GMTINY"] -upper_str_param = ["OUT_TYPE","OUT_FORM","OUT_STAT","IN_TYPE","IN_FORM"] +upper_str_param = ["OUT_TYPE","OUT_FORM","OUT_STAT","IN_TYPE","IN_FORM","ENCOUNTER_SAVE","FRAGMENTATION_SAVE", "CHK_QMIN_COORD"] +lower_str_param = ["NC_IN", "PL_IN", "TP_IN", "CB_IN", "CHK_QMIN_RANGE"] + +param_keys = ['! VERSION'] + int_param + float_param + upper_str_param + lower_str_param+ bool_param # This defines Xarray Dataset variables that are strings, which must be processed due to quirks in how NetCDF-Fortran # handles strings differently than Python's Xarray. @@ -417,52 +424,22 @@ def write_labeled_param(param, param_file_name): Prints a text file containing the parameter information. """ outfile = open(param_file_name, 'w') - keylist = ['! VERSION', - 'T0', - 'TSTART', - 'TSTOP', - 'DT', - 'ISTEP_OUT', - 'DUMP_CADENCE', - 'NC_IN', - 'PL_IN', - 'TP_IN', - 'CB_IN', - 'IN_TYPE', - 'IN_FORM', - 'BIN_OUT', - 'OUT_FORM', - 'OUT_TYPE', - 'OUT_STAT', - 'CHK_QMIN', - 'CHK_RMIN', - 'CHK_RMAX', - 'CHK_EJECT', - 'CHK_QMIN_COORD', - 'CHK_QMIN_RANGE', - 'MU2KG', - 'TU2S', - 'DU2M', - 'GMTINY', - 'FRAGMENTATION', - 'MIN_GMFRAG', - 'RESTART'] ptmp = param.copy() # Print the list of key/value pairs in the preferred order - for key in keylist: + for key in param_keys: val = ptmp.pop(key, None) if val is not None: if type(val) is bool: - print(f"{key:<16} {bool2yesno(val)}", file=outfile) + print(f"{key:<32} {bool2yesno(val)}", file=outfile) else: - print(f"{key:<16} {val}", file=outfile) + print(f"{key:<32} {val}", file=outfile) # Print the remaining key/value pairs in whatever order for key, val in ptmp.items(): if val != "": if type(val) is bool: - print(f"{key:<16} {bool2yesno(val)}", file=outfile) + print(f"{key:<32} {bool2yesno(val)}", file=outfile) else: - print(f"{key:<16} {val}", file=outfile) + print(f"{key:<32} {val}", file=outfile) outfile.close() return @@ -840,10 +817,12 @@ def swiftest2xr(param, verbose=True): if ((param['OUT_TYPE'] == 'NETCDF_DOUBLE') or (param['OUT_TYPE'] == 'NETCDF_FLOAT')): if verbose: print('\nCreating Dataset from NetCDF file') ds = xr.open_dataset(param['BIN_OUT'], mask_and_scale=False) + if param['OUT_TYPE'] == "NETCDF_DOUBLE": ds = fix_types(ds,ftype=np.float64) elif param['OUT_TYPE'] == "NETCDF_FLOAT": ds = fix_types(ds,ftype=np.float32) + ds = ds.where(ds.id >=0 ,drop=True) # Check if the name variable contains unique values. If so, make name the dimension instead of id if len(np.unique(ds['name'])) == len(ds['name']): ds = ds.swap_dims({"id" : "name"}) diff --git a/python/swiftest/swiftest/simulation_class.py b/python/swiftest/swiftest/simulation_class.py index 727e47d07..a3723553d 100644 --- a/python/swiftest/swiftest/simulation_class.py +++ b/python/swiftest/swiftest/simulation_class.py @@ -213,6 +213,11 @@ def __init__(self,read_param: bool = False, read_old_output_file: bool = False, Check for close encounters between bodies. If set to True, then the radii of massive bodies must be included in initial conditions. Parameter input file equivalent: `CHK_CLOSE` + encounter_save : {"NONE","TRAJECTORY","CLOSEST"}, default "NONE" + Indicate if and how encounter data should be saved. If set to "TRAJECTORY" the full close encounter + trajectories are saved to file. If set to "CLOSEST" only the trajectories at the time of closest approach + are saved. If set to "NONE" no trajectory information is saved. + *WARNING*: Enabling this feature could lead to very large files. general_relativity : bool, default True Include the post-Newtonian correction in acceleration calculations. Parameter input file equivalent: `GR` @@ -220,6 +225,12 @@ def __init__(self,read_param: bool = False, read_old_output_file: bool = False, If set to True, this turns on the Fraggle fragment generation code and `rotation` must also be True. This argument only applies to Swiftest-SyMBA simulations. It will be ignored otherwise. Parameter input file equivalent: `FRAGMENTATION` + fragmentation_save : {"NONE","TRAJECTORY","CLOSEST"}, default "NONE" + Indicate if and how fragmentation data should be saved. If set to "TRAJECTORY" the full close encounter + trajectories associated with each collision are saved to file. If set to "CLOSEST" only the trajectories + at a the time the collision occurs are saved. If set to "NONE" no trajectory information is saved (collision + details are still logged fraggle.log). + *WARNING*: Enabling this feature could lead to very large files. minimum_fragment_gmass : float, optional If fragmentation is turned on, this sets the mimimum G*mass of a collisional fragment that can be generated. *Note.* Only set one of minimum_fragment_gmass or minimum_fragment_mass @@ -480,6 +491,9 @@ def run(self,**kwargs): warnings.warn(msg,stacklevel=2) return + if not self.restart: + self.clean() + print(f"Running a {self.codename} {self.integrator} run from tstart={self.param['TSTART']} {self.TU_name} to tstop={self.param['TSTOP']} {self.TU_name}") self._run_swiftest_driver() @@ -1010,6 +1024,8 @@ def set_feature(self, tides: bool | None = None, interaction_loops: Literal["TRIANGULAR", "FLAT", "ADAPTIVE"] | None = None, encounter_check_loops: Literal["TRIANGULAR", "SORTSWEEP", "ADAPTIVE"] | None = None, + encounter_save: Literal["NONE", "TRAJECTORY", "CLOSEST"] | None = None, + fragmentation_save: Literal["NONE", "TRAJECTORY", "CLOSEST"] | None = None, verbose: bool | None = None, **kwargs: Any ): @@ -1021,11 +1037,22 @@ def set_feature(self, close_encounter_check : bool, optional Check for close encounters between bodies. If set to True, then the radii of massive bodies must be included in initial conditions. + encounter_save : {"NONE","TRAJECTORY","CLOSEST"}, default "NONE" + Indicate if and how encounter data should be saved. If set to "TRAJECTORY" the full close encounter + trajectories are saved to file. If set to "CLOSEST" only the trajectories at the time of closest approach + are saved. If set to "NONE" no trajectory information is saved. + *WARNING*: Enabling this feature could lead to very large files. general_relativity : bool, optional Include the post-Newtonian correction in acceleration calculations. fragmentation : bool, optional If set to True, this turns on the Fraggle fragment generation code and `rotation` must also be True. This argument only applies to Swiftest-SyMBA simulations. It will be ignored otherwise. + fragmentation_save : {"NONE","TRAJECTORY","CLOSEST"}, default "NONE" + Indicate if and how fragmentation data should be saved. If set to "TRAJECTORY" the full close encounter + trajectories associated with each collision are saved to file. If set to "CLOSEST" only the trajectories + at a the time the collision occurs are saved. If set to "NONE" no trajectory information is saved (collision + details are still logged fraggle.log). + *WARNING*: Enabling this feature could lead to very large files. minimum_fragment_gmass : float, optional If fragmentation is turned on, this sets the mimimum G*mass of a collisional fragment that can be generated. *Note.* Only set one of minimum_fragment_gmass or minimum_fragment_mass @@ -1179,6 +1206,33 @@ def set_feature(self, self.param["ENCOUNTER_CHECK"] = encounter_check_loops update_list.append("encounter_check_loops") + if encounter_save is not None: + valid_vals = ["NONE", "TRAJECTORY", "CLOSEST"] + encounter_save = encounter_save.upper() + if encounter_save not in valid_vals: + msg = f"{encounter_save} is not a valid option for encounter_save." + msg += f"\nMust be one of {valid_vals}" + warnings.warn(msg,stacklevel=2) + if "ENCOUNTER_SAVE" not in self.param: + self.param["ENCOUNTER_SAVE"] = valid_vals[0] + else: + self.param["ENCOUNTER_SAVE"] = encounter_save + update_list.append("encounter_save") + + + if fragmentation_save is not None: + fragmentation_save = fragmentation_save.upper() + valid_vals = ["NONE", "TRAJECTORY", "CLOSEST"] + if fragmentation_save not in valid_vals: + msg = f"{fragmentation_save} is not a valid option for fragmentation_save." + msg += f"\nMust be one of {valid_vals}" + warnings.warn(msg,stacklevel=2) + if "FRAGMENTATION_SAVE" not in self.param: + self.param["FRAGMENTATION_SAVE"] = valid_vals[0] + else: + self.param["FRAGMENTATION_SAVE"] = fragmentation_save + update_list.append("fragmentation_save") + self.param["TIDES"] = False feature_dict = self.get_feature(update_list, verbose) @@ -1210,6 +1264,8 @@ def get_feature(self, arg_list: str | List[str] | None = None, verbose: bool | N valid_var = {"close_encounter_check": "CHK_CLOSE", "fragmentation": "FRAGMENTATION", + "encounter_save": "ENCOUNTER_SAVE", + "fragmentation_save": "FRAGMENTATION_SAVE", "minimum_fragment_gmass": "MIN_GMFRAG", "rotation": "ROTATION", "general_relativity": "GR", @@ -2860,3 +2916,25 @@ def initial_conditions_from_bin(self, framenum=-1, new_param=None, new_param_fil self.write_param(new_param_file, param=new_param) return frame + + def clean(self): + """ + Cleans up simulation directory by deleting old files (dump, logs, and output files). + """ + old_files = [self.simdir / self.param['BIN_OUT'], + self.simdir / "fraggle.log", + self.simdir / "swiftest.log", + ] + glob_files = [self.simdir.glob("**/dump_param?.in")] \ + + [self.simdir.glob("**/dump_bin?.nc")] \ + + [self.simdir.glob("**/enc*.nc")] \ + + [self.simdir.glob("**/frag*.nc")] + + for f in old_files: + if f.exists(): + os.remove(f) + for g in glob_files: + for f in g: + if f.exists(): + os.remove(f) + return From 8616c1ff707bc66828d98f29b6b231d1cc327741 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Tue, 6 Dec 2022 10:03:59 -0500 Subject: [PATCH 286/569] New parameter parsing --- src/modules/symba_classes.f90 | 13 +++++++------ src/symba/symba_io.f90 | 14 ++++++++++++-- 2 files changed, 19 insertions(+), 8 deletions(-) diff --git a/src/modules/symba_classes.f90 b/src/modules/symba_classes.f90 index 81665f049..e95c28a73 100644 --- a/src/modules/symba_classes.f90 +++ b/src/modules/symba_classes.f90 @@ -26,11 +26,12 @@ module symba_classes 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. - character(STRMAX) :: encounter_save = "NONE" !! Indicate how encounter and/or fragmentation data should be saved + 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 if and how encounter data should be saved + character(STRMAX) :: fragmentation_save = "NONE" !! Indicate if and how fragmentation data should be saved contains procedure :: reader => symba_io_param_reader procedure :: writer => symba_io_param_writer @@ -428,7 +429,7 @@ end subroutine symba_io_encounter_initialize_output module subroutine symba_io_encounter_write_frame(self, nc, param) implicit none class(symba_encounter_snapshot), intent(in) :: self !! Swiftest encounter structure - class(symba_io_encounter_parameters), intent(inout) :: nc !! Parameters used to identify a particular encounter io NetCDF dataset + class(symba_io_encounter_parameters), intent(inout) :: nc !! Parameters used to identify a particular encounter io NetCDF dataset class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters end subroutine symba_io_encounter_write_frame diff --git a/src/symba/symba_io.f90 b/src/symba/symba_io.f90 index 4cb557162..59553a11b 100644 --- a/src/symba/symba_io.f90 +++ b/src/symba/symba_io.f90 @@ -235,6 +235,9 @@ module subroutine symba_io_param_reader(self, unit, iotype, v_list, iostat, ioms case ("ENCOUNTER_SAVE") call io_toupper(param_value) read(param_value, *) param%encounter_save + case ("FRAGMENTATION_SAVE") + call io_toupper(param_value) + read(param_value, *) param%fragmentation_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 @@ -285,9 +288,16 @@ 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 + if ((param%encounter_save /= "NONE") .and. (param%encounter_save /= "TRAJECTORY") .and. (param%encounter_save /= "CLOSEST")) then write(iomsg,*) 'Invalid encounter_save parameter: ',trim(adjustl(param%out_type)) - write(iomsg,*) 'Valid options are NONE, ALL, or FRAGMENTATION' + write(iomsg,*) 'Valid options are NONE, TRAJECTORY, or CLOSEST' + iostat = -1 + return + end if + + if ((param%fragmentation_save /= "NONE") .and. (param%fragmentation_save /= "TRAJECTORY") .and. (param%fragmentation_save /= "CLOSEST")) then + write(iomsg,*) 'Invalid fragmentation_save parameter: ',trim(adjustl(param%out_type)) + write(iomsg,*) 'Valid options are NONE, TRAJECTORY, or CLOSEST' iostat = -1 return end if From 25b3e0e7585543becf1c9a93173718e8fd6124e7 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Tue, 6 Dec 2022 10:09:29 -0500 Subject: [PATCH 287/569] Updated ignore files --- .gitignore | 2 +- examples/.gitignore | 4 +--- 2 files changed, 2 insertions(+), 4 deletions(-) diff --git a/.gitignore b/.gitignore index da1f14c2a..aaa38aec2 100644 --- a/.gitignore +++ b/.gitignore @@ -21,7 +21,7 @@ dump* src/*/Makefile !Makefile.Defines src/*/Makefile.Defines -!.gitignore +!**/.gitignore !*.py !*.ipynb *ipynb_checkpoints diff --git a/examples/.gitignore b/examples/.gitignore index 4aceee79f..9b92350e2 100644 --- a/examples/.gitignore +++ b/examples/.gitignore @@ -1,4 +1,2 @@ -*/param.* -*/simdata/* -*/*/simdata/* +**/simdata/* From 5995943df47d7912e4896a9ce9a0a71e92b1c6a5 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Tue, 6 Dec 2022 10:10:00 -0500 Subject: [PATCH 288/569] Removed notebook --- .../Basic_Simulation/initial_conditions.ipynb | 190 ------------------ 1 file changed, 190 deletions(-) delete mode 100644 examples/Basic_Simulation/initial_conditions.ipynb diff --git a/examples/Basic_Simulation/initial_conditions.ipynb b/examples/Basic_Simulation/initial_conditions.ipynb deleted file mode 100644 index 60581d22a..000000000 --- a/examples/Basic_Simulation/initial_conditions.ipynb +++ /dev/null @@ -1,190 +0,0 @@ -{ - "cells": [ - { - "cell_type": "code", - "execution_count": null, - "id": "2c4f59ea-1251-49f6-af1e-5695d7e25500", - "metadata": {}, - "outputs": [], - "source": [ - "import swiftest\n", - "import numpy as np\n", - "from numpy.random import default_rng\n", - "%env OMP_NUM_THREADS=4" - ] - }, - { - "cell_type": "code", - "execution_count": null, - "id": "6054c7ab-c748-4b39-9fee-d8b27326f497", - "metadata": {}, - "outputs": [], - "source": [ - "# Initialize the simulation object as a variable\n", - "sim = swiftest.Simulation(fragmentation=True, minimum_fragment_mass = 2.5e-11, mtiny=2.5e-8)" - ] - }, - { - "cell_type": "code", - "execution_count": null, - "id": "1c122676-bacb-447c-bc37-5ef8019be0d0", - "metadata": {}, - "outputs": [], - "source": [ - "# Add the modern planets and the Sun using the JPL Horizons Database\n", - "sim.add_solar_system_body([\"Sun\",\"Mercury\",\"Venus\",\"Earth\",\"Mars\",\"Jupiter\",\"Saturn\",\"Uranus\",\"Neptune\",\"Pluto\"])" - ] - }, - { - "cell_type": "code", - "execution_count": null, - "id": "97fe9f16-bc2e-443c-856b-7dacb1267f2d", - "metadata": {}, - "outputs": [], - "source": [ - "# Add 5 user-defined massive bodies\n", - "npl = 5\n", - "density_pl = 3000.0 / (sim.param['MU2KG'] / sim.param['DU2M'] ** 3)" - ] - }, - { - "cell_type": "code", - "execution_count": null, - "id": "566a742e-3935-484d-9c7a-87310b6aaa3a", - "metadata": {}, - "outputs": [], - "source": [ - "name_pl = [\"MassiveBody_01\", \"MassiveBody_02\", \"MassiveBody_03\", \"MassiveBody_04\", \"MassiveBody_05\"]\n", - "a_pl = default_rng().uniform(0.3, 1.5, npl)\n", - "e_pl = default_rng().uniform(0.0, 0.3, npl)\n", - "inc_pl = default_rng().uniform(0.0, 90, npl)\n", - "capom_pl = default_rng().uniform(0.0, 360.0, npl)\n", - "omega_pl = default_rng().uniform(0.0, 360.0, npl)\n", - "capm_pl = default_rng().uniform(0.0, 360.0, npl)\n", - "GM_pl = (np.array([6e23, 8e23, 1e24, 3e24, 5e24]) / sim.param['MU2KG']) * sim.GU\n", - "R_pl = np.full(npl, (3 * (GM_pl / sim.GU) / (4 * np.pi * density_pl)) ** (1.0 / 3.0))\n", - "Rh_pl = a_pl * ((GM_pl) / (3 * sim.GU)) ** (1.0 / 3.0)\n", - "Ip_pl = np.full((npl,3),0.4,)\n", - "rot_pl = np.zeros((npl,3))" - ] - }, - { - "cell_type": "code", - "execution_count": null, - "id": "d2c14121-e5b4-45bd-99a7-acde0ee77955", - "metadata": {}, - "outputs": [], - "source": [ - "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)" - ] - }, - { - "cell_type": "code", - "execution_count": null, - "id": "b3f979b3-5238-492f-8589-0cf5d9a3c2bc", - "metadata": {}, - "outputs": [], - "source": [ - "# Add 10 user-defined test particles\n", - "ntp = 10" - ] - }, - { - "cell_type": "code", - "execution_count": null, - "id": "5777c1bb-8c91-452a-8869-ce6f951b33a3", - "metadata": {}, - "outputs": [], - "source": [ - "name_tp = [\"TestParticle_01\", \"TestParticle_02\", \"TestParticle_03\", \"TestParticle_04\", \"TestParticle_05\", \"TestParticle_06\", \"TestParticle_07\", \"TestParticle_08\", \"TestParticle_09\", \"TestParticle_10\"]\n", - "a_tp = default_rng().uniform(0.3, 1.5, ntp)\n", - "e_tp = default_rng().uniform(0.0, 0.3, ntp)\n", - "inc_tp = default_rng().uniform(0.0, 90, ntp)\n", - "capom_tp = default_rng().uniform(0.0, 360.0, ntp)\n", - "omega_tp = default_rng().uniform(0.0, 360.0, ntp)\n", - "capm_tp = default_rng().uniform(0.0, 360.0, ntp)" - ] - }, - { - "cell_type": "code", - "execution_count": null, - "id": "8df4bcb7-46a6-402a-b10f-f37c55a0fdee", - "metadata": {}, - "outputs": [], - "source": [ - "sim.add_body(name=name_tp, a=a_tp, e=e_tp, inc=inc_tp, capom=capom_tp, omega=omega_tp, capm=capm_tp)" - ] - }, - { - "cell_type": "code", - "execution_count": null, - "id": "135bd3f8-0a56-4d62-b728-f150debc1a76", - "metadata": {}, - "outputs": [], - "source": [ - "# Display the run configuration parameters\n", - "p = sim.get_parameter()" - ] - }, - { - "cell_type": "code", - "execution_count": null, - "id": "fd30638b-6868-4162-bc05-1011bb255968", - "metadata": {}, - "outputs": [], - "source": [ - "# Run the simulation\n", - "sim.run(tstart=0.0, tstop=1.0e3, dt=0.01, tstep_out=1.0e0, dump_cadence=0)" - ] - }, - { - "cell_type": "code", - "execution_count": null, - "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": [] - } - ], - "metadata": { - "kernelspec": { - "display_name": "Python (My debug_env Kernel)", - "language": "python", - "name": "debug_env" - }, - "language_info": { - "codemirror_mode": { - "name": "ipython", - "version": 3 - }, - "file_extension": ".py", - "mimetype": "text/x-python", - "name": "python", - "nbconvert_exporter": "python", - "pygments_lexer": "ipython3", - "version": "3.8.5" - } - }, - "nbformat": 4, - "nbformat_minor": 5 -} From 4a5a999312c7edf7b093c5af1fa1ccbdefd7747b Mon Sep 17 00:00:00 2001 From: David A Minton Date: Tue, 6 Dec 2022 10:20:08 -0500 Subject: [PATCH 289/569] More updates to .gitignore files to try to get control of what files to keep int the repo --- .gitignore | 59 ++------------------------------------------- examples/.gitignore | 2 +- 2 files changed, 3 insertions(+), 58 deletions(-) diff --git a/.gitignore b/.gitignore index aaa38aec2..702fd48c4 100644 --- a/.gitignore +++ b/.gitignore @@ -2,7 +2,6 @@ * # Now, whitelist anything that's a directory !*/ -!*/python # whitelist only the files that ever need to be tracked !*.f90 !*.sh @@ -13,72 +12,18 @@ !paper/paper.md !paper/paper.bib !README.swifter -!*.in dump* -!example/cleanup -!example/swifter_symba_omp -!Makefile -src/*/Makefile -!Makefile.Defines -src/*/Makefile.Defines -!**/.gitignore +!.gitignore !*.py !*.ipynb +!examples/** *ipynb_checkpoints -#fxdr library -!fxdr*/*.c -!fxdr*/*.F -!fxdr*/*.3f -!fxdr*/*.h -!fxdr*/*.inc -!fxdr*/cxdrreal64 -!fxdr*/test.orig.xdr -!fxdr*/test_read_only.xdr -!fxdr*/configure/ -!fxdr*/README* -!fxdr*/Makefile.bak -!fxdr*/Makefile.fxdr -!fxdr*/Makefile.tmpl -!fxdr*/Defines.* - -#collresolve -!collresolve/*.c -!collresolve/*.h -!collresolve/*.py -!collresolve/Makefile.am -!collresolve/configure.ac -!collresolve/cambioni2019/*.h -!collresolve/cambioni2019/*.c -collresolve/config.h - - - #Documentation !docs/* !docs/*/* !docs/*/*/* !README_figs/* -python/swiftest/tests/convert_code_type/swift2swifter/pl.swift2swifter.in - -python/swiftest/tests/convert_code_type/swift2swifter/tp.swift2swifter.in - -python/swiftest/tests/convert_code_type/swift2swiftest/cb.swift2swiftest.in - -python/swiftest/tests/convert_code_type/swift2swiftest/pl.swift2swiftest.in - -python/swiftest/tests/convert_code_type/swift2swiftest/tp.swift2swiftest.in - -python/swiftest/tests/convert_code_type/swifter2swiftest/cb.swifter2swiftest.in - -python/swiftest/tests/convert_code_type/cb.swifter2swiftest.in - -python/swiftest/tests/convert_code_type/swifter2swiftest/pl.swifter2swiftest.in - -python/swiftest/tests/convert_code_type/swifter2swiftest/tp.swifter2swiftest.in - -!python/swiftest/requirements.txt - bin/ build/* diff --git a/examples/.gitignore b/examples/.gitignore index 9b92350e2..139597f9c 100644 --- a/examples/.gitignore +++ b/examples/.gitignore @@ -1,2 +1,2 @@ -**/simdata/* + From 7e8b751f77cf45a592142b5ac50ecd29dcb3694f Mon Sep 17 00:00:00 2001 From: Carlisle Wishard Date: Tue, 6 Dec 2022 10:29:52 -0500 Subject: [PATCH 290/569] updated to use sim.data instead of ds --- examples/Basic_Simulation/output_reader.py | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/examples/Basic_Simulation/output_reader.py b/examples/Basic_Simulation/output_reader.py index b171eb402..611e85a36 100644 --- a/examples/Basic_Simulation/output_reader.py +++ b/examples/Basic_Simulation/output_reader.py @@ -29,18 +29,18 @@ import matplotlib.pyplot as plt # Read in the simulation output and store it as an Xarray dataset -ds = swiftest.Simulation(param_file="simdata/param.in", read_old_output_file=True).data +sim = swiftest.Simulation(read_old_output_file=True) # Plot of the data and save the output plot -colors = ['white' if x == 'Massive Body' else 'black' for x in ds['particle_type']] -sizes = [100 if x == 'Massive Body' else 10 for x in ds['particle_type']] +colors = ['white' if x == 'Massive Body' else 'black' for x in sim.data['particle_type']] +sizes = [100 if x == 'Massive Body' else 10 for x in sim.data['particle_type']] fig, ax = plt.subplots(nrows=1, ncols=1, figsize=(5,3)) -ax.set(xlabel="Semimajor Axis (AU)", ylabel="Eccentricity", title="Simulation Start") -ax.scatter(ds['a'].isel(time=0), ds['e'].isel(time=0), c=colors, s=sizes, edgecolor='black') +ax.set(xlabel="Semimajor Axis (AU)", ylabel="Eccentricity", title="Simulation Initial Conditions (t=0)") +ax.scatter(sim.data['a'].isel(time=0), sim.data['e'].isel(time=0), c=colors, s=sizes, edgecolor='black') ax.set_xlim(0, 2.0) ax.set_ylim(0, 0.4) -ax.text(1.5, 0.35, f"t = {ds['time'].isel(time=0).values} years", size=10, ha="left") +ax.text(1.5, 0.35, f"t = {sim.data['time'].isel(time=0).values} years", size=10, ha="left") plt.tight_layout() plt.show() -fig.savefig("output.eps", dpi=300, facecolor='white', transparent=False, bbox_inches="tight") \ No newline at end of file +fig.savefig("output.eps", dpi=300, facecolor='white', transparent=False, bbox_inches="tight") From 44ab293832b4e224d4adea0aa978374735b93ea8 Mon Sep 17 00:00:00 2001 From: Carlisle Wishard Date: Tue, 6 Dec 2022 10:36:12 -0500 Subject: [PATCH 291/569] cleaned up Basic_Simulation directory --- examples/Basic_Simulation/cb.in | 7 - .../Basic_Simulation/initial_conditions.ipynb | 190 ---- examples/Basic_Simulation/pl.in | 85 -- examples/Basic_Simulation/read_old_run.ipynb | 853 ------------------ examples/Basic_Simulation/read_old_run.py | 2 - examples/Basic_Simulation/run_from_file.ipynb | 119 --- .../Basic_Simulation/run_simulation.ipynb | 67 -- examples/Basic_Simulation/tp.in | 31 - 8 files changed, 1354 deletions(-) delete mode 100644 examples/Basic_Simulation/cb.in delete mode 100644 examples/Basic_Simulation/initial_conditions.ipynb delete mode 100644 examples/Basic_Simulation/pl.in delete mode 100644 examples/Basic_Simulation/read_old_run.ipynb delete mode 100644 examples/Basic_Simulation/read_old_run.py delete mode 100644 examples/Basic_Simulation/run_from_file.ipynb delete mode 100644 examples/Basic_Simulation/run_simulation.ipynb delete mode 100644 examples/Basic_Simulation/tp.in diff --git a/examples/Basic_Simulation/cb.in b/examples/Basic_Simulation/cb.in deleted file mode 100644 index b2cb85c35..000000000 --- a/examples/Basic_Simulation/cb.in +++ /dev/null @@ -1,7 +0,0 @@ -Sun -39.476926408897626 -0.004650467260962157 -4.7535806948127355e-12 --2.2473967953572827e-18 -0.0 0.0 0.07 -11.209306302144773 -38.759372036774764 82.25088158389266 diff --git a/examples/Basic_Simulation/initial_conditions.ipynb b/examples/Basic_Simulation/initial_conditions.ipynb deleted file mode 100644 index 60581d22a..000000000 --- a/examples/Basic_Simulation/initial_conditions.ipynb +++ /dev/null @@ -1,190 +0,0 @@ -{ - "cells": [ - { - "cell_type": "code", - "execution_count": null, - "id": "2c4f59ea-1251-49f6-af1e-5695d7e25500", - "metadata": {}, - "outputs": [], - "source": [ - "import swiftest\n", - "import numpy as np\n", - "from numpy.random import default_rng\n", - "%env OMP_NUM_THREADS=4" - ] - }, - { - "cell_type": "code", - "execution_count": null, - "id": "6054c7ab-c748-4b39-9fee-d8b27326f497", - "metadata": {}, - "outputs": [], - "source": [ - "# Initialize the simulation object as a variable\n", - "sim = swiftest.Simulation(fragmentation=True, minimum_fragment_mass = 2.5e-11, mtiny=2.5e-8)" - ] - }, - { - "cell_type": "code", - "execution_count": null, - "id": "1c122676-bacb-447c-bc37-5ef8019be0d0", - "metadata": {}, - "outputs": [], - "source": [ - "# Add the modern planets and the Sun using the JPL Horizons Database\n", - "sim.add_solar_system_body([\"Sun\",\"Mercury\",\"Venus\",\"Earth\",\"Mars\",\"Jupiter\",\"Saturn\",\"Uranus\",\"Neptune\",\"Pluto\"])" - ] - }, - { - "cell_type": "code", - "execution_count": null, - "id": "97fe9f16-bc2e-443c-856b-7dacb1267f2d", - "metadata": {}, - "outputs": [], - "source": [ - "# Add 5 user-defined massive bodies\n", - "npl = 5\n", - "density_pl = 3000.0 / (sim.param['MU2KG'] / sim.param['DU2M'] ** 3)" - ] - }, - { - "cell_type": "code", - "execution_count": null, - "id": "566a742e-3935-484d-9c7a-87310b6aaa3a", - "metadata": {}, - "outputs": [], - "source": [ - "name_pl = [\"MassiveBody_01\", \"MassiveBody_02\", \"MassiveBody_03\", \"MassiveBody_04\", \"MassiveBody_05\"]\n", - "a_pl = default_rng().uniform(0.3, 1.5, npl)\n", - "e_pl = default_rng().uniform(0.0, 0.3, npl)\n", - "inc_pl = default_rng().uniform(0.0, 90, npl)\n", - "capom_pl = default_rng().uniform(0.0, 360.0, npl)\n", - "omega_pl = default_rng().uniform(0.0, 360.0, npl)\n", - "capm_pl = default_rng().uniform(0.0, 360.0, npl)\n", - "GM_pl = (np.array([6e23, 8e23, 1e24, 3e24, 5e24]) / sim.param['MU2KG']) * sim.GU\n", - "R_pl = np.full(npl, (3 * (GM_pl / sim.GU) / (4 * np.pi * density_pl)) ** (1.0 / 3.0))\n", - "Rh_pl = a_pl * ((GM_pl) / (3 * sim.GU)) ** (1.0 / 3.0)\n", - "Ip_pl = np.full((npl,3),0.4,)\n", - "rot_pl = np.zeros((npl,3))" - ] - }, - { - "cell_type": "code", - "execution_count": null, - "id": "d2c14121-e5b4-45bd-99a7-acde0ee77955", - "metadata": {}, - "outputs": [], - "source": [ - "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)" - ] - }, - { - "cell_type": "code", - "execution_count": null, - "id": "b3f979b3-5238-492f-8589-0cf5d9a3c2bc", - "metadata": {}, - "outputs": [], - "source": [ - "# Add 10 user-defined test particles\n", - "ntp = 10" - ] - }, - { - "cell_type": "code", - "execution_count": null, - "id": "5777c1bb-8c91-452a-8869-ce6f951b33a3", - "metadata": {}, - "outputs": [], - "source": [ - "name_tp = [\"TestParticle_01\", \"TestParticle_02\", \"TestParticle_03\", \"TestParticle_04\", \"TestParticle_05\", \"TestParticle_06\", \"TestParticle_07\", \"TestParticle_08\", \"TestParticle_09\", \"TestParticle_10\"]\n", - "a_tp = default_rng().uniform(0.3, 1.5, ntp)\n", - "e_tp = default_rng().uniform(0.0, 0.3, ntp)\n", - "inc_tp = default_rng().uniform(0.0, 90, ntp)\n", - "capom_tp = default_rng().uniform(0.0, 360.0, ntp)\n", - "omega_tp = default_rng().uniform(0.0, 360.0, ntp)\n", - "capm_tp = default_rng().uniform(0.0, 360.0, ntp)" - ] - }, - { - "cell_type": "code", - "execution_count": null, - "id": "8df4bcb7-46a6-402a-b10f-f37c55a0fdee", - "metadata": {}, - "outputs": [], - "source": [ - "sim.add_body(name=name_tp, a=a_tp, e=e_tp, inc=inc_tp, capom=capom_tp, omega=omega_tp, capm=capm_tp)" - ] - }, - { - "cell_type": "code", - "execution_count": null, - "id": "135bd3f8-0a56-4d62-b728-f150debc1a76", - "metadata": {}, - "outputs": [], - "source": [ - "# Display the run configuration parameters\n", - "p = sim.get_parameter()" - ] - }, - { - "cell_type": "code", - "execution_count": null, - "id": "fd30638b-6868-4162-bc05-1011bb255968", - "metadata": {}, - "outputs": [], - "source": [ - "# Run the simulation\n", - "sim.run(tstart=0.0, tstop=1.0e3, dt=0.01, tstep_out=1.0e0, dump_cadence=0)" - ] - }, - { - "cell_type": "code", - "execution_count": null, - "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": [] - } - ], - "metadata": { - "kernelspec": { - "display_name": "Python (My debug_env Kernel)", - "language": "python", - "name": "debug_env" - }, - "language_info": { - "codemirror_mode": { - "name": "ipython", - "version": 3 - }, - "file_extension": ".py", - "mimetype": "text/x-python", - "name": "python", - "nbconvert_exporter": "python", - "pygments_lexer": "ipython3", - "version": "3.8.5" - } - }, - "nbformat": 4, - "nbformat_minor": 5 -} diff --git a/examples/Basic_Simulation/pl.in b/examples/Basic_Simulation/pl.in deleted file mode 100644 index 215b91f1d..000000000 --- a/examples/Basic_Simulation/pl.in +++ /dev/null @@ -1,85 +0,0 @@ -14 -Mercury 6.553709809565314e-06 -1.6306381826061646e-05 -0.3870985843095394 0.2056234010897001 7.003302508001384 -48.29611837378607 29.20442403952454 338.3394874682879 -0.0 0.0 0.346 -3.573018077015318 -18.380317085416586 34.36143850429876 -Venus 9.663313399581537e-05 -4.0453784346544176e-05 -0.7233297579736101 0.006717605698865438 3.394439273342282 -76.60235891771119 54.96037946082961 200.4789339550648 -0.0 0.0 0.4 -0.17650282045605922 -3.6612475825356214 8.702866268072764 -Earth 0.00012002693582795245 -4.25875607065041e-05 -0.9999904874543223 0.01671400376545858 0.003637862608863003 -175.025172600231 287.9619628812575 114.3482934042427 -0.0 0.0 0.3307 -6.157239621449141 0.057224133705898524 2301.2082528350797 -Mars 1.2739802010675942e-05 -2.2657408050928896e-05 -1.523711925589535 0.09344151133508208 1.847441673557901 -49.4728572124747 286.7379771285891 209.3396773477138 -0.0 0.0 0.3644 -997.9224351226384 -909.5549030011778 1783.3823046046184 -Jupiter 0.037692251088985676 -0.0004673261703049093 -5.2027278008516 0.04824497711637968 1.303631134570075 -100.5192588433081 273.5898402882514 129.5536700659942 -0.0 0.0 0.2756 --80.9864396731672 -2388.0246092955053 5008.722318533006 -Saturn 0.011285899820091273 -0.00038925687730393614 -9.532011952667288 0.05486329870433341 2.487906363280301 -113.6305781676206 339.5467356402391 290.8995806568904 -0.0 0.0 0.22 -441.95954822014636 378.52638822638795 5135.909115928892 -Uranus 0.001723658947826773 -0.00016953449859497232 -19.24498838290236 0.04796174942301296 0.7730102596086205 -74.0125809801658 93.59554912280227 262.8658637277515 -0.0 0.0 0.23 --677.3000258209181 -3008.1099071905787 -836.3013266185699 -Neptune 0.0020336100526728304 -0.00016458790412449367 -30.03895991152209 0.008955570138096731 1.771119354296142 -131.8221159748827 284.4748429674216 308.4513720536233 -0.0 0.0 0.23 -1232.224106980634 -2177.3040821077648 2329.8227878119233 -Pluto 2.924216771029454e-07 -7.943294877391593e-06 -39.36791814672583 0.2487178537481577 17.1705505990969 -110.3314332962701 113.0826635900664 55.11416408345664 -0.0 0.0 0.4 --243.59404988903637 261.28663002814227 -38.57352022187049 -MassiveBody_01 1.1912109366578089e-05 -2.425055692051245e-05 -0.7452368716298337 0.0633011418780484 0.11151363780595558 -203.01823417718037 284.9353898127118 266.79344592519305 -0.4 0.4 0.4 -0.0 0.0 0.0 -MassiveBody_02 1.5882812488770783e-05 -2.6691191565570074e-05 -0.7671203280602826 0.10149029388964753 53.46706656938751 -61.74738152068808 68.20565593722856 271.3352706902475 -0.4 0.4 0.4 -0.0 0.0 0.0 -MassiveBody_03 1.985351561096348e-05 -2.8752214513575297e-05 -1.4698824276418418 0.13621250684495437 23.635498327264845 -38.071905339231236 283.134612455057 250.67457601578352 -0.4 0.4 0.4 -0.0 0.0 0.0 -MassiveBody_04 5.9560546832890444e-05 -4.14678690275904e-05 -0.9741731590760117 0.1519713326893784 20.51335588582416 -350.53780805624825 304.05941264938997 142.62713592644738 -0.4 0.4 0.4 -0.0 0.0 0.0 -MassiveBody_05 9.926757805481742e-05 -4.916559523190238e-05 -0.6633500122731075 0.13550930562584215 10.680323453316653 -328.45970148163457 49.93948991697533 316.2109831817007 -0.4 0.4 0.4 -0.0 0.0 0.0 diff --git a/examples/Basic_Simulation/read_old_run.ipynb b/examples/Basic_Simulation/read_old_run.ipynb deleted file mode 100644 index 0a7459084..000000000 --- a/examples/Basic_Simulation/read_old_run.ipynb +++ /dev/null @@ -1,853 +0,0 @@ -{ - "cells": [ - { - "cell_type": "code", - "execution_count": 1, - "id": "86b309f3-d400-4164-88fc-cf56b6cfcf5f", - "metadata": {}, - "outputs": [], - "source": [ - "import swiftest" - ] - }, - { - "cell_type": "code", - "execution_count": 2, - "id": "353b2559-83a2-496f-8648-60f6121333a5", - "metadata": {}, - "outputs": [ - { - "name": "stdout", - "output_type": "stream", - "text": [ - "Reading Swiftest file /home/daminton/git_debug/swiftest/examples/Basic_Simulation/simdata/param.in\n", - "\n", - "Creating Dataset from NetCDF file\n", - "Successfully converted 78 output frames.\n", - "Swiftest simulation data stored as xarray DataSet .data\n" - ] - } - ], - "source": [ - "sim = swiftest.Simulation(read_old_output_file=True)" - ] - }, - { - "cell_type": "code", - "execution_count": 3, - "id": "c7bceca2-678d-469d-a3a7-06cfa9f29fc0", - "metadata": {}, - "outputs": [ - { - "data": { - "text/html": [ - "
    \n", - "\n", - "\n", - "\n", - "\n", - "\n", - "\n", - "\n", - "\n", - "\n", - "\n", - "\n", - "\n", - "\n", - "\n", - "
    <xarray.Dataset>\n",
-       "Dimensions:          (time: 78, name: 25)\n",
-       "Coordinates:\n",
-       "  * time             (time) float64 0.0 2.0 nan 4.0 nan ... nan 76.0 nan 78.0\n",
-       "  * name             (name) <U32 'Sun' 'Mercury' ... 'TestParticle_10'\n",
-       "Data variables: (12/45)\n",
-       "    id               (name) int64 0 1 2 3 4 5 6 7 8 ... 17 18 19 20 21 22 23 24\n",
-       "    npl              (time) int64 14 14 -2147483647 14 ... 14 -2147483647 14\n",
-       "    ntp              (time) int64 10 10 -2147483647 10 ... 10 -2147483647 10\n",
-       "    nplm             (time) int64 13 13 -2147483647 13 ... 13 -2147483647 13\n",
-       "    particle_type    (name) <U32 'Central Body' ... 'Test Particle'\n",
-       "    status           (name) <U32 'ACTIVE' 'ACTIVE' ... 'ACTIVE' 'ACTIVE'\n",
-       "    ...               ...\n",
-       "    Ip3              (time, name) float64 0.07 0.346 0.4 0.3307 ... nan nan nan\n",
-       "    rotx             (time, name) float64 11.21 3.573 0.1765 ... nan nan nan\n",
-       "    roty             (time, name) float64 -38.76 -18.38 -3.661 ... nan nan nan\n",
-       "    rotz             (time, name) float64 82.25 34.36 8.703 ... nan nan nan\n",
-       "    j2rp2            (time) float64 4.754e-12 4.754e-12 nan ... nan 4.754e-12\n",
-       "    j4rp4            (time) float64 -2.247e-18 -2.247e-18 nan ... nan -2.247e-18
    " - ], - "text/plain": [ - "\n", - "Dimensions: (time: 78, name: 25)\n", - "Coordinates:\n", - " * time (time) float64 0.0 2.0 nan 4.0 nan ... nan 76.0 nan 78.0\n", - " * name (name) Date: Tue, 6 Dec 2022 10:37:41 -0500 Subject: [PATCH 292/569] Added new methods for starting and stopping encounter and fragmentation files --- src/modules/symba_classes.f90 | 21 +++++++++++++++++++-- src/symba/symba_io.f90 | 2 ++ src/symba/symba_step.f90 | 5 ++--- 3 files changed, 23 insertions(+), 5 deletions(-) diff --git a/src/modules/symba_classes.f90 b/src/modules/symba_classes.f90 index e95c28a73..e059bb33b 100644 --- a/src/modules/symba_classes.f90 +++ b/src/modules/symba_classes.f90 @@ -32,6 +32,7 @@ module symba_classes logical :: lfragmentation = .false. !! Do fragmentation modeling instead of simple merger. character(STRMAX) :: encounter_save = "NONE" !! Indicate if and how encounter data should be saved character(STRMAX) :: fragmentation_save = "NONE" !! Indicate if and how fragmentation data should be saved + logical :: lencounter_save = .false. !! Turns on encounter saving contains procedure :: reader => symba_io_param_reader procedure :: writer => symba_io_param_writer @@ -221,6 +222,8 @@ module symba_classes procedure :: dealloc => symba_util_dealloc_system !! Deallocates all allocatable arrays procedure :: resize_storage => symba_util_resize_storage !! Resizes the encounter history storage object so that it contains enough spaces for the number of snapshots needed procedure :: snapshot => symba_util_take_encounter_snapshot !! Take a minimal snapshot of the system through an encounter + procedure :: start_encounter => symba_io_start_encounter !! Initializes the new encounter and/or fragmentation save file(s) + procedure :: stop_encounter => symba_io_stop_encounter !! Saves the encounter and/or fragmentation data to file(s) final :: symba_util_final_system !! Finalizes the SyMBA nbody system object - deallocates all allocatables end type symba_nbody_system @@ -455,6 +458,20 @@ module subroutine symba_io_param_writer(self, unit, iotype, v_list, iostat, ioms character(len=*), intent(inout) :: iomsg !! Message to pass if iostat /= 0 end subroutine symba_io_param_writer + module subroutine symba_io_start_encounter(self, param, t) + implicit none + class(symba_nbody_system), intent(inout) :: self !! SyMBA nbody system object + class(symba_parameters), intent(inout) :: param !! Current run configuration parameters + real(DP), intent(in) :: t !! Current simulation time + end subroutine symba_io_start_encounter + + module subroutine symba_io_stop_encounter(self, param, t) + implicit none + class(symba_nbody_system), intent(inout) :: self !! SyMBA nbody system object + class(symba_parameters), intent(inout) :: param !! Current run configuration parameters + real(DP), intent(in) :: t !! Current simulation time + end subroutine symba_io_stop_encounter + module subroutine symba_io_write_discard(self, param) use swiftest_classes, only : swiftest_parameters implicit none @@ -563,8 +580,8 @@ recursive module subroutine symba_step_recur_system(self, param, t, ireci) implicit none class(symba_nbody_system), intent(inout) :: self !! SyMBA nbody system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - real(DP), intent(in) :: t - integer(I4B), intent(in) :: ireci !! input recursion level + real(DP), intent(in) :: t !! Current simulation time + integer(I4B), intent(in) :: ireci !! input recursion level end subroutine symba_step_recur_system module subroutine symba_step_reset_system(self, param) diff --git a/src/symba/symba_io.f90 b/src/symba/symba_io.f90 index 59553a11b..641ab7d54 100644 --- a/src/symba/symba_io.f90 +++ b/src/symba/symba_io.f90 @@ -301,6 +301,8 @@ module subroutine symba_io_param_reader(self, unit, iotype, v_list, iostat, ioms iostat = -1 return end if + param%lencounter_save = (param%encounter_save /= "TRAJECTORY") .or. (param%encounter_save /= "CLOSEST") .or. & + (param%fragmentation_save /= "TRAJECTORY") .or. (param%fragmentation_save /= "CLOSEST") ! Call the base method (which also prints the contents to screen) call io_param_reader(param, unit, iotype, v_list, iostat, iomsg) diff --git a/src/symba/symba_step.f90 b/src/symba/symba_step.f90 index f8dca7ff7..7b26f80af 100644 --- a/src/symba/symba_step.f90 +++ b/src/symba/symba_step.f90 @@ -37,10 +37,9 @@ module subroutine symba_step_system(self, param, t, dt) call self%reset(param) lencounter = pl%encounter_check(param, self, dt, 0) .or. tp%encounter_check(param, self, dt, 0) if (lencounter) then - call self%snapshot(param, t) + if (param%lencounter_save) call self%start_encounter(param, t) call self%interp(param, t, dt) - call self%snapshot(param, t+dt) - call self%encounter_history%dump(param) + if (param%lencounter_save) call self%stop_encounter(param, t+dt) else self%irec = -1 call helio_step_system(self, param, t, dt) From ad504bd5f243ca0adf2846ad1a48086d944f04cc Mon Sep 17 00:00:00 2001 From: Carlisle Wishard Date: Tue, 6 Dec 2022 10:38:04 -0500 Subject: [PATCH 293/569] deleted notebook --- examples/helio_gr_test/helio_gr_test.ipynb | 158 --------------------- 1 file changed, 158 deletions(-) delete mode 100644 examples/helio_gr_test/helio_gr_test.ipynb diff --git a/examples/helio_gr_test/helio_gr_test.ipynb b/examples/helio_gr_test/helio_gr_test.ipynb deleted file mode 100644 index c6b0c67ea..000000000 --- a/examples/helio_gr_test/helio_gr_test.ipynb +++ /dev/null @@ -1,158 +0,0 @@ -{ - "cells": [ - { - "cell_type": "code", - "execution_count": null, - "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": null, - "metadata": {}, - "outputs": [], - "source": [ - "sim_gr = swiftest.Simulation(simdir=\"gr\")\n", - "sim_gr.add_solar_system_body([\"Sun\",\"Mercury\",\"Venus\",\"Earth\",\"Mars\",\"Jupiter\",\"Saturn\",\"Uranus\",\"Neptune\"])" - ] - }, - { - "cell_type": "code", - "execution_count": null, - "metadata": {}, - "outputs": [], - "source": [ - "sim_nogr = swiftest.Simulation(simdir=\"nogr\")\n", - "sim_nogr.add_solar_system_body([\"Sun\",\"Mercury\",\"Venus\",\"Earth\",\"Mars\",\"Jupiter\",\"Saturn\",\"Uranus\",\"Neptune\"])" - ] - }, - { - "cell_type": "code", - "execution_count": null, - "metadata": {}, - "outputs": [], - "source": [ - "run_args = {\"tstop\":1000.0, \"dt\":0.005, \"tstep_out\":10.0, \"dump_cadence\": 0,\"integrator\":\"helio\"}" - ] - }, - { - "cell_type": "code", - "execution_count": null, - "metadata": {}, - "outputs": [], - "source": [ - "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)" - ] - }, - { - "cell_type": "code", - "execution_count": null, - "metadata": {}, - "outputs": [], - "source": [ - "# Get the start and end date of the simulation so we can compare with the real solar system\n", - "start_date = sim_gr.ephemeris_date\n", - "tstop_d = sim_gr.param['TSTOP'] * sim_gr.param['TU2S'] / swiftest.JD2S\n", - "\n", - "stop_date = (datetime.datetime.fromisoformat(start_date) + datetime.timedelta(days=tstop_d)).isoformat()" - ] - }, - { - "cell_type": "code", - "execution_count": null, - "metadata": {}, - "outputs": [], - "source": [ - "#Get the ephemerides of Mercury for the same timeframe as the simulation\n", - "obj = Horizons(id='1', location='@sun',\n", - " epochs={'start':start_date, 'stop':stop_date,\n", - " 'step':'10y'})\n", - "el = obj.elements()\n", - "t = (el['datetime_jd']-el['datetime_jd'][0]) / 365.25\n", - "varpi_obs = el['w'] + el['Omega']" - ] - }, - { - "cell_type": "code", - "execution_count": null, - "metadata": {}, - "outputs": [], - "source": [ - "varpisim_gr= sim_gr.data['varpi'].sel(name=\"Mercury\")\n", - "varpisim_nogr= sim_nogr.data['varpi'].sel(name=\"Mercury\")\n", - "tsim = sim_gr.data['time']" - ] - }, - { - "cell_type": "code", - "execution_count": null, - "metadata": {}, - "outputs": [], - "source": [ - "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" - ] - }, - { - "cell_type": "code", - "execution_count": null, - "metadata": {}, - "outputs": [], - "source": [ - "fig, ax = plt.subplots()\n", - "\n", - "ax.plot(t, varpi_obs, label=\"JPL Horizons\",linewidth=2.5)\n", - "ax.plot(tsim, varpisim_gr, label=\"Swiftest helio GR\",linewidth=1.5)\n", - "ax.plot(tsim, varpisim_nogr, label=\"Swiftest helio No GR\",linewidth=1.5)\n", - "ax.set_xlabel('Time (y)')\n", - "ax.set_ylabel('Mercury $\\\\varpi$ (deg)')\n", - "ax.legend()\n", - "plt.savefig(\"helio_gr_mercury_precession.png\",dpi=300)\n", - "print('Mean precession rate for Mercury long. peri. (arcsec/100 y)')\n", - "print(f'JPL Horizons : {np.mean(dvarpi_obs)}')\n", - "print(f'Swiftest No GR : {np.mean(dvarpi_nogr)}')\n", - "print(f'Swiftest GR : {np.mean(dvarpi_gr)}')\n", - "print(f'Obs - Swiftest GR : {np.mean(dvarpi_obs - dvarpi_gr)}')\n", - "print(f'Obs - Swiftest No GR : {np.mean(dvarpi_obs - dvarpi_nogr)}')" - ] - } - ], - "metadata": { - "kernelspec": { - "display_name": "Python (My debug_env Kernel)", - "language": "python", - "name": "debug_env" - }, - "language_info": { - "codemirror_mode": { - "name": "ipython", - "version": 3 - }, - "file_extension": ".py", - "mimetype": "text/x-python", - "name": "python", - "nbconvert_exporter": "python", - "pygments_lexer": "ipython3", - "version": "3.8.5" - } - }, - "nbformat": 4, - "nbformat_minor": 4 -} From b917da8c77f9889a927a2290b45381e4f4ef1ced Mon Sep 17 00:00:00 2001 From: Carlisle Wishard Date: Tue, 6 Dec 2022 10:39:09 -0500 Subject: [PATCH 294/569] deleted symba_hungarias example --- .../hungarias_5pl_500tp_17_param.in | 38 - .../hungarias_5pl_500tp_17_pl.in | 49 - .../hungarias_5pl_500tp_17_sun_MsunAUYR.in | 7 - .../hungarias_5pl_500tp_17_tp.in | 1 - .../swifter/control_planets/param.swifter.in | 26 - .../hungarias_5pl_500tp_17_param.in | 38 - .../control_tp/hungarias_5pl_500tp_17_pl.in | 49 - .../hungarias_5pl_500tp_17_sun_MsunAUYR.in | 7 - .../control_tp/hungarias_5pl_500tp_17_tp.in | 1501 ----------------- .../hungarias_5pl_500tp_17_param.in | 38 - .../control_pl/hungarias_5pl_500tp_17_pl.in | 79 - .../hungarias_5pl_500tp_17_sun_MsunAUYR.in | 7 - .../control_pl/hungarias_5pl_500tp_17_tp.in | 1 - .../hungarias_5pl_500tp_17_param.in | 38 - .../hungarias_5pl_500tp_17_pl.in | 49 - .../hungarias_5pl_500tp_17_sun_MsunAUYR.in | 7 - .../hungarias_5pl_500tp_17_tp.in | 1 - .../hungarias_5pl_500tp_17_param.in | 38 - .../control_tp/hungarias_5pl_500tp_17_pl.in | 49 - .../hungarias_5pl_500tp_17_sun_MsunAUYR.in | 7 - .../control_tp/hungarias_5pl_500tp_17_tp.in | 1501 ----------------- 21 files changed, 3531 deletions(-) delete mode 100644 examples/symba_hungarias/swifter/control_planets/hungarias_5pl_500tp_17_param.in delete mode 100644 examples/symba_hungarias/swifter/control_planets/hungarias_5pl_500tp_17_pl.in delete mode 100644 examples/symba_hungarias/swifter/control_planets/hungarias_5pl_500tp_17_sun_MsunAUYR.in delete mode 100644 examples/symba_hungarias/swifter/control_planets/hungarias_5pl_500tp_17_tp.in delete mode 100644 examples/symba_hungarias/swifter/control_planets/param.swifter.in delete mode 100644 examples/symba_hungarias/swifter/control_tp/hungarias_5pl_500tp_17_param.in delete mode 100644 examples/symba_hungarias/swifter/control_tp/hungarias_5pl_500tp_17_pl.in delete mode 100644 examples/symba_hungarias/swifter/control_tp/hungarias_5pl_500tp_17_sun_MsunAUYR.in delete mode 100644 examples/symba_hungarias/swifter/control_tp/hungarias_5pl_500tp_17_tp.in delete mode 100644 examples/symba_hungarias/swiftest/control_pl/hungarias_5pl_500tp_17_param.in delete mode 100644 examples/symba_hungarias/swiftest/control_pl/hungarias_5pl_500tp_17_pl.in delete mode 100644 examples/symba_hungarias/swiftest/control_pl/hungarias_5pl_500tp_17_sun_MsunAUYR.in delete mode 100644 examples/symba_hungarias/swiftest/control_pl/hungarias_5pl_500tp_17_tp.in delete mode 100644 examples/symba_hungarias/swiftest/control_planets/hungarias_5pl_500tp_17_param.in delete mode 100644 examples/symba_hungarias/swiftest/control_planets/hungarias_5pl_500tp_17_pl.in delete mode 100644 examples/symba_hungarias/swiftest/control_planets/hungarias_5pl_500tp_17_sun_MsunAUYR.in delete mode 100644 examples/symba_hungarias/swiftest/control_planets/hungarias_5pl_500tp_17_tp.in delete mode 100644 examples/symba_hungarias/swiftest/control_tp/hungarias_5pl_500tp_17_param.in delete mode 100644 examples/symba_hungarias/swiftest/control_tp/hungarias_5pl_500tp_17_pl.in delete mode 100644 examples/symba_hungarias/swiftest/control_tp/hungarias_5pl_500tp_17_sun_MsunAUYR.in delete mode 100644 examples/symba_hungarias/swiftest/control_tp/hungarias_5pl_500tp_17_tp.in diff --git a/examples/symba_hungarias/swifter/control_planets/hungarias_5pl_500tp_17_param.in b/examples/symba_hungarias/swifter/control_planets/hungarias_5pl_500tp_17_param.in deleted file mode 100644 index ba1fb3c2b..000000000 --- a/examples/symba_hungarias/swifter/control_planets/hungarias_5pl_500tp_17_param.in +++ /dev/null @@ -1,38 +0,0 @@ -! VERSION Swiftest parameter input -T0 0.0 -TSTOP 200000000.0 -DT 0.005 -ISTEP_OUT 200000 -ISTEP_DUMP 200000 -OUT_FORM XVEL -OUT_TYPE NETCDF_DOUBLE -OUT_STAT REPLACE -IN_TYPE ASCII -PL_IN hungarias_5pl_500tp_17_pl.in -TP_IN hungarias_5pl_500tp_17_tp.in -CB_IN hungarias_5pl_500tp_17_sun_MsunAUYR.in -BIN_OUT hungarias_5pl_500tp_17_out.nc -CHK_QMIN -1.0 -CHK_RMIN -1.0 -CHK_RMAX 1000.0 -CHK_EJECT 1000.0 -CHK_QMIN_COORD HELIO -CHK_QMIN_RANGE -1.0 -1.0 -MU2KG 1.988409870698051e+30 -TU2S 31557600.0 -DU2M 149597870700.0 -IN_FORM EL -EXTRA_FORCE NO -PARTICLE_OUT hungarias_5pl_500tp_17_particle.dat -BIG_DISCARD NO -CHK_CLOSE YES -RHILL_PRESENT YES -FRAGMENTATION NO -ROTATION YES -TIDES NO -ENERGY YES -GR YES -INTERACTION_LOOPS ADAPTIVE -ENCOUNTER_CHECK ADAPTIVE -ENERGY_OUT hungarias_5pl_500tp_17_energy.dat -GMTINY 3.646098141953443043e-08 diff --git a/examples/symba_hungarias/swifter/control_planets/hungarias_5pl_500tp_17_pl.in b/examples/symba_hungarias/swifter/control_planets/hungarias_5pl_500tp_17_pl.in deleted file mode 100644 index cd9d16020..000000000 --- a/examples/symba_hungarias/swifter/control_planets/hungarias_5pl_500tp_17_pl.in +++ /dev/null @@ -1,49 +0,0 @@ -8 -Mercury 6.553709809565314146e-06 0.0014751274117575772341 -1.6306381826061645943e-05 -0.38709894990924181846 0.20562369687869339052 7.0036069691825035832 -48.302897646473702764 29.190213908309409874 163.69992642152809026 -0.0 0.0 0.34599999999999997424 -3.5735549824428292985 -18.380047749494480457 34.361526740492798437 -Venus 9.6633133995815381836e-05 0.006759122875155079725 -4.0453784346544178454e-05 -0.7233300630551103838 0.006773384545514573099 3.394505355540899938 -76.62090440289564697 55.183156101464518883 271.2285045598760007 -0.0 0.0 0.4000000000000000222 -0.17650282045605921225 -3.6612475825356215592 8.702866268072763821 -Earth 0.000120026935827952456416 0.010044657392872289059 -4.25875607065040958e-05 -0.99999328599172943033 0.01668004783869252855 0.0027793940989077428085 -175.84932558359508903 287.2227751976308241 324.72725799674782365 -0.0 0.0 0.33069999999999999396 -4.827962479462605839 0.034731626640621778608 2301.2114260455621944 -Mars 1.2739802010675941808e-05 0.007246146587933918669 -2.265740805092889601e-05 -1.5236121180553410248 0.093387475645674775104 1.8479297186242829021 -49.490271729763087194 286.7387645553690163 252.78317601821959215 -0.0 0.0 0.3644000000000000017 -997.9376283354346323 -909.38573894978675416 1783.4600697011568969 -Jupiter 0.03769225108898567778 0.35525381666404283465 -0.00046732617030490929307 -5.203268729924161562 0.04848413524543258163 1.3035624911873560094 -100.51639734596980702 273.421918018626684 325.351028522703416 -0.0 0.0 0.27560000000000001164 --80.967241888586720104 -2387.9998942634933492 5008.7344122962876782 -Saturn 0.01128589982009127331 0.43764770913411007376 -0.00038925687730393611812 -9.581513697274186114 0.05248801962394190196 2.4862838811768979141 -113.59546767797320399 335.45662431368151601 228.84653123700309152 -0.0 0.0 0.22000000000000000111 -441.9323685947327233 378.52918410105413535 5135.911248678291292 -Uranus 0.001723658947826773068 0.4699394560146697986 -0.00016953449859497231466 -19.24773626798451076 0.04408736292912442123 0.7704474968533898682 -74.09072726634606454 95.12631113857929677 237.66915583105441101 -0.0 0.0 0.23000000000000000999 --677.3000258209181323 -3008.109907190578637 -836.301326618569835 -Neptune 0.0020336100526728302882 0.7816500366521773358 -0.000164587904124493665 -30.297815841143489024 0.013873050398302080172 1.7688477929856469828 -131.74107055888509876 246.83916166351488641 334.07963351871291025 -0.0 0.0 0.23000000000000000999 -1231.0256802954641403 -2178.2009371051150557 2329.6179923847095223 diff --git a/examples/symba_hungarias/swifter/control_planets/hungarias_5pl_500tp_17_sun_MsunAUYR.in b/examples/symba_hungarias/swifter/control_planets/hungarias_5pl_500tp_17_sun_MsunAUYR.in deleted file mode 100644 index b2cb85c35..000000000 --- a/examples/symba_hungarias/swifter/control_planets/hungarias_5pl_500tp_17_sun_MsunAUYR.in +++ /dev/null @@ -1,7 +0,0 @@ -Sun -39.476926408897626 -0.004650467260962157 -4.7535806948127355e-12 --2.2473967953572827e-18 -0.0 0.0 0.07 -11.209306302144773 -38.759372036774764 82.25088158389266 diff --git a/examples/symba_hungarias/swifter/control_planets/hungarias_5pl_500tp_17_tp.in b/examples/symba_hungarias/swifter/control_planets/hungarias_5pl_500tp_17_tp.in deleted file mode 100644 index 573541ac9..000000000 --- a/examples/symba_hungarias/swifter/control_planets/hungarias_5pl_500tp_17_tp.in +++ /dev/null @@ -1 +0,0 @@ -0 diff --git a/examples/symba_hungarias/swifter/control_planets/param.swifter.in b/examples/symba_hungarias/swifter/control_planets/param.swifter.in deleted file mode 100644 index b39e5a947..000000000 --- a/examples/symba_hungarias/swifter/control_planets/param.swifter.in +++ /dev/null @@ -1,26 +0,0 @@ -! VERSION Swifter parameter file converted from Swiftest -T0 0.0 -TSTOP 200000000.0 -DT 0.005 -ISTEP_OUT 200000 -ISTEP_DUMP 200000 -OUT_FORM XV -OUT_TYPE REAL8 -OUT_STAT UNKNOWN -IN_TYPE ASCII -PL_IN hungarias_5pl_500tp_17_pl.in -TP_IN hungarias_5pl_500tp_17_tp.in -BIN_OUT hungarias_5pl_500tp_17_out.dat -CHK_QMIN -1.0 -CHK_RMIN -1.0 -CHK_RMAX 1000.0 -CHK_EJECT 1000.0 -CHK_QMIN_COORD HELIO -CHK_QMIN_RANGE -1.0 -1.0 -EXTRA_FORCE NO -PARTICLE_OUT hungarias_5pl_500tp_17_particle.dat -BIG_DISCARD NO -CHK_CLOSE YES -RHILL_PRESENT YES -J2 0.0 -J4 0.0 diff --git a/examples/symba_hungarias/swifter/control_tp/hungarias_5pl_500tp_17_param.in b/examples/symba_hungarias/swifter/control_tp/hungarias_5pl_500tp_17_param.in deleted file mode 100644 index ba1fb3c2b..000000000 --- a/examples/symba_hungarias/swifter/control_tp/hungarias_5pl_500tp_17_param.in +++ /dev/null @@ -1,38 +0,0 @@ -! VERSION Swiftest parameter input -T0 0.0 -TSTOP 200000000.0 -DT 0.005 -ISTEP_OUT 200000 -ISTEP_DUMP 200000 -OUT_FORM XVEL -OUT_TYPE NETCDF_DOUBLE -OUT_STAT REPLACE -IN_TYPE ASCII -PL_IN hungarias_5pl_500tp_17_pl.in -TP_IN hungarias_5pl_500tp_17_tp.in -CB_IN hungarias_5pl_500tp_17_sun_MsunAUYR.in -BIN_OUT hungarias_5pl_500tp_17_out.nc -CHK_QMIN -1.0 -CHK_RMIN -1.0 -CHK_RMAX 1000.0 -CHK_EJECT 1000.0 -CHK_QMIN_COORD HELIO -CHK_QMIN_RANGE -1.0 -1.0 -MU2KG 1.988409870698051e+30 -TU2S 31557600.0 -DU2M 149597870700.0 -IN_FORM EL -EXTRA_FORCE NO -PARTICLE_OUT hungarias_5pl_500tp_17_particle.dat -BIG_DISCARD NO -CHK_CLOSE YES -RHILL_PRESENT YES -FRAGMENTATION NO -ROTATION YES -TIDES NO -ENERGY YES -GR YES -INTERACTION_LOOPS ADAPTIVE -ENCOUNTER_CHECK ADAPTIVE -ENERGY_OUT hungarias_5pl_500tp_17_energy.dat -GMTINY 3.646098141953443043e-08 diff --git a/examples/symba_hungarias/swifter/control_tp/hungarias_5pl_500tp_17_pl.in b/examples/symba_hungarias/swifter/control_tp/hungarias_5pl_500tp_17_pl.in deleted file mode 100644 index cd9d16020..000000000 --- a/examples/symba_hungarias/swifter/control_tp/hungarias_5pl_500tp_17_pl.in +++ /dev/null @@ -1,49 +0,0 @@ -8 -Mercury 6.553709809565314146e-06 0.0014751274117575772341 -1.6306381826061645943e-05 -0.38709894990924181846 0.20562369687869339052 7.0036069691825035832 -48.302897646473702764 29.190213908309409874 163.69992642152809026 -0.0 0.0 0.34599999999999997424 -3.5735549824428292985 -18.380047749494480457 34.361526740492798437 -Venus 9.6633133995815381836e-05 0.006759122875155079725 -4.0453784346544178454e-05 -0.7233300630551103838 0.006773384545514573099 3.394505355540899938 -76.62090440289564697 55.183156101464518883 271.2285045598760007 -0.0 0.0 0.4000000000000000222 -0.17650282045605921225 -3.6612475825356215592 8.702866268072763821 -Earth 0.000120026935827952456416 0.010044657392872289059 -4.25875607065040958e-05 -0.99999328599172943033 0.01668004783869252855 0.0027793940989077428085 -175.84932558359508903 287.2227751976308241 324.72725799674782365 -0.0 0.0 0.33069999999999999396 -4.827962479462605839 0.034731626640621778608 2301.2114260455621944 -Mars 1.2739802010675941808e-05 0.007246146587933918669 -2.265740805092889601e-05 -1.5236121180553410248 0.093387475645674775104 1.8479297186242829021 -49.490271729763087194 286.7387645553690163 252.78317601821959215 -0.0 0.0 0.3644000000000000017 -997.9376283354346323 -909.38573894978675416 1783.4600697011568969 -Jupiter 0.03769225108898567778 0.35525381666404283465 -0.00046732617030490929307 -5.203268729924161562 0.04848413524543258163 1.3035624911873560094 -100.51639734596980702 273.421918018626684 325.351028522703416 -0.0 0.0 0.27560000000000001164 --80.967241888586720104 -2387.9998942634933492 5008.7344122962876782 -Saturn 0.01128589982009127331 0.43764770913411007376 -0.00038925687730393611812 -9.581513697274186114 0.05248801962394190196 2.4862838811768979141 -113.59546767797320399 335.45662431368151601 228.84653123700309152 -0.0 0.0 0.22000000000000000111 -441.9323685947327233 378.52918410105413535 5135.911248678291292 -Uranus 0.001723658947826773068 0.4699394560146697986 -0.00016953449859497231466 -19.24773626798451076 0.04408736292912442123 0.7704474968533898682 -74.09072726634606454 95.12631113857929677 237.66915583105441101 -0.0 0.0 0.23000000000000000999 --677.3000258209181323 -3008.109907190578637 -836.301326618569835 -Neptune 0.0020336100526728302882 0.7816500366521773358 -0.000164587904124493665 -30.297815841143489024 0.013873050398302080172 1.7688477929856469828 -131.74107055888509876 246.83916166351488641 334.07963351871291025 -0.0 0.0 0.23000000000000000999 -1231.0256802954641403 -2178.2009371051150557 2329.6179923847095223 diff --git a/examples/symba_hungarias/swifter/control_tp/hungarias_5pl_500tp_17_sun_MsunAUYR.in b/examples/symba_hungarias/swifter/control_tp/hungarias_5pl_500tp_17_sun_MsunAUYR.in deleted file mode 100644 index b2cb85c35..000000000 --- a/examples/symba_hungarias/swifter/control_tp/hungarias_5pl_500tp_17_sun_MsunAUYR.in +++ /dev/null @@ -1,7 +0,0 @@ -Sun -39.476926408897626 -0.004650467260962157 -4.7535806948127355e-12 --2.2473967953572827e-18 -0.0 0.0 0.07 -11.209306302144773 -38.759372036774764 82.25088158389266 diff --git a/examples/symba_hungarias/swifter/control_tp/hungarias_5pl_500tp_17_tp.in b/examples/symba_hungarias/swifter/control_tp/hungarias_5pl_500tp_17_tp.in deleted file mode 100644 index f4ba244e1..000000000 --- a/examples/symba_hungarias/swifter/control_tp/hungarias_5pl_500tp_17_tp.in +++ /dev/null @@ -1,1501 +0,0 @@ -500 -TestParticle -1.8454769027014339411 0.13951119042459186881 25.837798047275626345 -328.17117785206306735 237.2860880034895672 64.23008023926446697 -TestParticle -1.8948047399930760815 0.39253684339890981825 30.57401904357708844 -171.8160167926455415 74.67067835186652758 346.82539114732162489 -TestParticle -1.4322956873029448754 0.26682998123758877584 36.888797433998760766 -135.67836179139501951 49.89780708941236753 50.12940813296061293 -TestParticle -1.5422738860284694873 0.37685139101297421282 19.245291067203744717 -242.6056203622448777 190.34039186776647057 265.5775848896740854 -TestParticle -1.4000225346968613316 0.29255853399659431657 19.890767084525684538 -119.10518346196536754 348.49038108835299 47.293501598324468205 -TestParticle -1.456396703278512561 0.21606816556140612251 29.008692147879436618 -108.30731953608933793 221.35606614343436149 135.6522448644592771 -TestParticle -1.4991966146428574724 0.2669401594934397437 30.077755049056197123 -191.15663442447419129 222.38194219090249248 69.087779756302211354 -TestParticle -1.2976220185588704936 0.2964166811906516763 17.074990789432430205 -304.33208099940674174 258.6470139846816778 322.57928297363247339 -TestParticle -1.2284058459883253622 0.02114032275754222992 21.48034199376179032 -253.91897753388707315 121.66008318006832667 48.90451689677965419 -TestParticle -1.3491703154567693534 0.12631152383406446527 12.08570156851411781 -94.79536576066179521 143.49729046755351192 208.82266091055907964 -TestParticle -1.354548306636307764 0.30813073753578051894 26.385704559503864175 -9.340695923175923454 140.9062990975310754 128.60525944669927867 -TestParticle -1.4726763914941964906 0.051608113984077212677 23.16805302210511286 -60.87571895315940651 37.85205814142705094 334.24673224972650587 -TestParticle -1.5463324166991267994 0.049680078831149866725 2.1376306166210978787 -220.16008032774595904 11.76294270807032305 189.70726088424217437 -TestParticle -1.8424848789863070841 0.22250945291262835823 31.15994606422547264 -200.26190393952850854 90.472365503047569746 91.504582635979360816 -TestParticle -1.3344201535197020014 0.22773738327276721316 26.57752464191161934 -153.96142537752339763 186.86606427694519539 35.556703962561442722 -TestParticle -1.9184874234026485507 0.023481756935774280443 35.397883111232822273 -271.86866710708176242 55.05965672749781703 149.58202579969920976 -TestParticle -1.5321856218987717213 0.3979302949006976453 2.3033304058957959626 -1.0080751214383187886 229.5039187263292888 149.08850733126683963 -TestParticle -1.8579680598185155382 0.22191671822921349433 4.132202808256058013 -84.407322217061448555 105.02111083305797479 146.60404199861849861 -TestParticle -1.8191335218869923995 0.081164276322499742666 2.5841250683973493452 -159.5912052269758874 90.717444711181698835 52.736155424681527393 -TestParticle -1.3667350901122115037 0.040168371245059432406 21.275121073210776501 -354.85336821525999085 78.43154031841972085 317.9997578721723812 -TestParticle -1.211310325452651826 0.22495050228658303171 6.171244471860548586 -261.19666701924728613 72.22571277624209074 188.79752520382470493 -TestParticle -1.5325985395295633751 0.31279786859050073833 20.80765006283890628 -318.17303457104600284 237.18051290105893258 171.10337432510698363 -TestParticle -1.8680074840187885776 0.2359667145186353232 3.4681761306941005785 -200.43760942249792834 358.90361110235892284 209.24526446322295214 -TestParticle -1.8902919155434694254 0.083578216274719355217 21.112558775866592242 -196.8514015184809125 347.4309841941474133 73.29619835953663198 -TestParticle -1.3627905330289311614 0.099888583939379896326 10.927033380075510394 -304.94152566655765213 199.55238917120914266 66.700355986912740036 -TestParticle -1.6040569601728904559 0.0037929451167165065088 35.906866500389931218 -99.48570161019421221 264.107310263435636 196.91578900528253371 -TestParticle -1.5861188083181421149 0.12827049258664038889 4.433072269138715882 -250.35776905499878353 45.94314631274010452 78.766936071707490896 -TestParticle -1.8085832921727800215 0.38738844761580382148 38.482814871600758977 -59.61087191956130482 302.66582104517908647 337.43444136948141931 -TestParticle -1.4784945066780474932 0.02330664972959981679 24.805661482861435019 -161.3343149737517308 260.74004269183234328 332.58410511792851594 -TestParticle -1.2147867771614853094 0.16512447645289687892 26.704102750300808822 -342.71215159236965064 303.68316149292064665 267.30686157877283904 -TestParticle -1.2201597354758311198 0.29779565538112623413 9.5137682254248456815 -191.53033272117548336 279.0125127827463416 212.78518850631689929 -TestParticle -1.6306412809893466864 0.17831015307074157827 3.1250419675817919796 -35.17124037365346112 108.44038602029890228 289.87991262900078482 -TestParticle -1.2151606182820764435 0.030818630012030868992 15.255139624036321067 -18.872922094318155928 231.7787216922804987 114.00766773514217789 -TestParticle -1.263893046608108861 0.2365742775318666613 11.945519016269416923 -42.860493283933593034 103.96603523733477914 283.38829024952065083 -TestParticle -1.6208609899851271763 0.084237547629803233296 12.70952077968544458 -283.22127471251508268 16.774057774443846824 300.16022765529646676 -TestParticle -1.369439844040318377 0.02479558882423171795 12.8318676295292597445 -301.63112212878189666 317.34595898371384237 30.617048625074787083 -TestParticle -1.5997694540834734855 0.09458558350377295476 19.448014834633401193 -12.1917196597836952066 3.3679767469261356894 154.78568082871979072 -TestParticle -1.7665402755717471983 0.30325026057285930925 27.633560559304825688 -101.32565005973741279 173.42784439679959974 37.232060344515574002 -TestParticle -1.9955375108845494481 0.36780600821797326816 31.984293078717442427 -282.80116122029363623 340.83055441100248117 39.611552110590793063 -TestParticle -1.8068990906750328485 0.21026617244057629885 1.0616116239923245601 -148.12562556977400163 298.30253571723386585 39.94475612648128049 -TestParticle -1.6630081107132843599 0.2735942970781838346 20.393789507385111648 -186.34515293922132173 65.17268953054855274 249.5770342523899501 -TestParticle -1.7985429554004617181 0.32088199656574384333 3.421215620948947489 -16.760921442599428843 74.095210179753522084 131.64141600391005227 -TestParticle -1.4370805125444752193 0.33325879590334600566 29.297209939601689399 -179.87886700027897291 9.64820682838999133 185.83130754139918395 -TestParticle -1.4655739620290153535 0.017666725980597774298 15.194095015809558902 -272.98954032167330297 58.084307572382229523 205.40990717491945361 -TestParticle -1.8476543863511110111 0.38915614646375812358 11.917542586934226634 -134.42337723208845546 335.9708646376130332 1.2971084841705504687 -TestParticle -1.4590877868615714785 0.00229625206779173743 3.1321552894228821273 -234.02046406252858901 255.12979045887780671 16.475368403924544936 -TestParticle -1.3888300055647480047 0.04773585409741545882 20.980957411518524225 -232.75615771007392141 269.83840631297238133 128.91250646333895702 -TestParticle -1.9931456375147125204 0.36812801925517474322 8.575906190939374341 -75.54998759463583724 336.19060016425089543 128.81172294803698719 -TestParticle -1.8774492133690419138 0.3438244675687084917 23.038981078440741612 -9.8914055387747712444 56.58764160659445963 274.986529163730836 -TestParticle -1.3204375538736723428 0.08737144541036796774 29.974540925371840672 -221.62895491427303796 180.74872085610940076 337.40135640751742585 -TestParticle -1.7927656300808507694 0.117314349174642992835 19.184850306121404628 -206.67799209022632567 27.751086824061687253 298.02149638567931333 -TestParticle -1.7770751091671890265 0.19250351376309945972 9.172954305563960631 -43.26806500508915576 40.25028641050728595 238.70170337404292127 -TestParticle -1.974616589119178478 0.34407442172588997842 9.802858566374489158 -297.25364573770326615 87.77531802870282718 75.66951173963438748 -TestParticle -1.3863166307158814039 0.076685155941225657816 27.402627668756696977 -65.08259549484182571 164.8638775674021133 100.45589134667613962 -TestParticle -1.865440866859517488 0.1196471086364425257 11.945324988836505398 -268.187594819792821 223.64720186520361267 29.40940210460087556 -TestParticle -1.924611171111724417 0.20112445232693854091 27.71898676703103348 -318.34445645026778493 191.25112555799532288 349.89422766228875616 -TestParticle -1.5993892099645203864 0.10968442780595713537 9.326690310948993812 -31.533935713187357663 310.02898225335894722 210.51997485541662058 -TestParticle -1.2359382488484538243 0.32658357473851062913 38.707976308555153366 -144.00217869231852319 119.06805794770258444 79.384200277529473055 -TestParticle -1.6109049166063780234 0.038297945827820673026 19.543826335927839466 -187.13697315293387646 257.17832502585736165 137.87766714187893058 -TestParticle -1.4314628393318562516 0.06605107757031168647 34.48524969280026653 -261.32336202719972107 132.91845049023550018 38.845354985336733478 -TestParticle -1.6270574875899108669 0.34703206127568098083 15.7198484814636287865 -347.55110983950402215 301.80674145531685326 112.25474179150697296 -TestParticle -1.2336395323546296421 0.09729394203067305569 5.1016432554912771735 -233.12366663108903708 146.38256752560837981 198.90738568911748985 -TestParticle -1.3456767380773657639 0.0037474665741684012703 39.938234490697439583 -256.57759604724572 75.054619437472723575 358.3650510442133168 -TestParticle -1.5755427111046413913 0.26176654357687628716 8.3705428253832359076 -37.517264866504824283 65.328654571322900324 91.55626866074713632 -TestParticle -1.6755570822166401257 0.13402717291758836637 24.063895956419415256 -13.799270685071709508 72.62055343894668624 87.31894896673983908 -TestParticle -1.5559490988866435668 0.15176826381840774483 38.48111346610262018 -256.2333379875098558 75.97800331031197629 59.41813313856062706 -TestParticle -1.44994652075586683 0.33986546456988747655 24.751134550954795088 -232.18945993885864709 196.68218102285592863 134.45246030705607154 -TestParticle -1.8429185809905443971 0.017095748280579449452 37.139787427802218645 -161.43471520401584485 307.27501647662722917 355.50902004252696997 -TestParticle -1.8754638534803846905 0.012020551314167439438 25.689663713162978809 -190.79044364156195002 199.61943428385487209 354.13757823278496062 -TestParticle -1.6785085343609076336 0.092751885821403062815 9.210612929641403213 -285.5852225501039925 151.86743084166838003 284.55869958326974256 -TestParticle -1.6543220378661067649 0.21134650270613800083 33.840207882222927083 -304.1335703446064258 326.82908020011677763 324.19035648687139428 -TestParticle -1.532142838634183768 0.38007507167758092237 0.41347334753230935434 -67.05133558163640828 34.399290053628249098 34.840294234675972973 -TestParticle -1.5607062121608026306 0.33781855969656376937 8.967843423326943508 -299.3643723824862377 200.63715648972143413 68.959909224159687824 -TestParticle -1.4493452438508076519 0.0685471748773834183 8.6320194163908645635 -72.080624314054560386 115.122237950328312195 0.4079154529894424286 -TestParticle -1.6460340581063395149 0.39668168452346741493 20.981074587513283802 -204.3451792276263177 201.37614636656564926 213.30860176845612841 -TestParticle -1.5920263567710581931 0.25848484530126630832 37.015946260712674132 -127.874562568991194667 65.19741011690945243 94.70447850395582634 -TestParticle -1.7336512363309442009 0.07029270812373322741 2.7619103909209741232 -186.8230602145383159 227.39378660430725176 98.630627655617857386 -TestParticle -1.2180382444813300236 0.3142235003505371993 28.081856084101627147 -111.345098722858793394 55.920002664921518942 282.87486367297071865 -TestParticle -1.6485319714902004762 0.3152277024193525512 9.613333711481617527 -294.21829832085342105 286.30105207001298595 128.67843292368630159 -TestParticle -1.4661249318513216444 0.05768902442216044396 0.40134055259916312508 -131.60830524837382427 243.75402215940340511 207.34266824752899083 -TestParticle -1.9808876352137643195 0.14308188258148502037 1.4378912336896432222 -80.646845170624999355 231.53252144735679963 232.24754717746816368 -TestParticle -1.2317104124445219515 0.2601604050852836525 0.45344055155487783537 -196.60019387641727917 281.28440095008312483 247.80040663000707468 -TestParticle -1.9766606334273690848 0.34561610666945052905 23.435434834980789276 -34.473035596172188377 271.1594424183512615 48.466138898201464258 -TestParticle -1.902283887520531902 0.11209856668107276434 36.03239655947709963 -294.40684092368923075 270.02199923071918874 114.382104661423511516 -TestParticle -1.6492323095244016962 0.15893979864294510707 37.659784271934086064 -104.66474319501168111 339.31942052690538958 216.02473301930888283 -TestParticle -1.3484148267391067311 0.21111072648635398341 10.89667366492733791 -291.56591682201212734 76.70162083026228572 312.33817224861377326 -TestParticle -1.4294351818194139803 0.088023727454350997323 39.975651469559892348 -198.68831704157523177 24.599669214308292453 112.67218982565516683 -TestParticle -1.7462490440076519072 0.37071438804152889723 21.870120107958371136 -306.73669065023256053 227.86908802150850306 221.53115484665687518 -TestParticle -1.2326287663421375829 0.38251042858385364553 15.802748366587309192 -199.40278420565533679 149.69869717845381274 315.67560896416114247 -TestParticle -1.8450862453370659999 0.35823810152470403345 0.24296995062495163609 -231.11355647090658749 268.36408970924156847 247.20131497380242536 -TestParticle -1.3463306194321635889 0.054152156717265725883 19.291673537548810202 -161.87111271376406307 110.46662751206984865 211.17562619004070257 -TestParticle -1.7304729990392044847 0.0060363382745066036794 4.5425988088905189244 -83.83165898233737323 161.12905358043980186 286.6647995328502816 -TestParticle -1.272415258736352639 0.34812105948963872892 35.045494396081245725 -14.574000729875393745 353.3713665259786012 131.5433867402096837 -TestParticle -1.6439273487752854574 0.36545065070539850538 6.353634441759323792 -208.14453818563018217 10.813063425795590433 206.06730287545840952 -TestParticle -1.6763079933342956984 0.094138501830316120844 9.085159707293687603 -80.58871476637817466 314.0368013316636393 100.690960685859835166 -TestParticle -1.4877140448295171904 0.16166761889883485281 34.241465691047999087 -79.8410863542756033 83.93580251433438377 326.42504725591442138 -TestParticle -1.2162284372972316238 0.0041396912261435492297 18.10971019209766908 -119.24015567046335207 329.67281909144981 104.828869567280364095 -TestParticle -1.8047735542382463692 0.33749016396948239294 0.52972364011479644574 -178.94392698813351217 299.23756071934496958 162.62104380151879468 -TestParticle -1.5839648306862472715 0.10066137160625268643 33.26828317225646714 -263.27920251880794922 68.67162164080139064 57.290691877799474696 -TestParticle -1.782207613297600135 0.28298109588186182162 35.127393670730072017 -210.15608294480230711 329.15212439443854464 156.34171670624388639 -TestParticle -1.3155167265331972892 0.3723026355627080397 31.9899066241260428 -91.31036979040656831 223.20537501312867334 55.827047719351739374 -TestParticle -1.5449962589928503132 0.042895131418722920458 19.621615335811604552 -53.274917868286941314 105.38186162729587636 323.020751462690896 -TestParticle -1.5754411317280814231 0.34816180369684263107 4.7678217298113434452 -120.95128002085144203 157.00930158977180895 240.29746717057042815 -TestParticle -1.5907469291141598244 0.1964357827791012312 32.411571541856559975 -170.61499094134663324 242.1650203501031342 17.501615221478704854 -TestParticle -1.830089894183755117 0.1183426089423230132 39.644525581214999477 -294.65378437812546508 109.07115594302160844 324.16241183209581322 -TestParticle -1.4367780052388956502 0.36401192064177911867 30.631206179017613778 -68.80265368578432117 273.93063220366155974 24.29554655983004352 -TestParticle -1.2142291174104986595 0.26599477562223389215 38.323418486729934784 -308.15266716976327643 181.95454939706644382 25.317934141736472498 -TestParticle -1.3097560558867786806 0.27086655670790987793 26.727111485760552512 -202.01817831967753136 111.97198753257944759 220.9572217341067244 -TestParticle -1.7068002319397266309 0.13225077417056724238 27.615823462695185952 -285.91192474987235528 163.31636137404424858 93.38394269951035653 -TestParticle -1.2055264990732839081 0.30786309414395046646 1.0578708063967390274 -10.359167032075170312 91.437369236993205845 199.49137469503560283 -TestParticle -1.507944679481377559 0.24354603379899894544 13.546984987329334871 -57.02677054315793015 348.2783664994595938 271.03255123935065285 -TestParticle -1.2000480949162781741 0.37393642722973008397 23.203234027939288353 -10.544426197782676979 54.256441116884829512 254.63780531903708493 -TestParticle -1.7449420987438828412 0.24948442565304040919 27.500692921539069857 -95.99564887831238025 273.51317842100650068 326.03984845413532412 -TestParticle -1.3765488182504534986 0.030416876982825514358 31.70464034258963082 -275.78595003182448409 133.87458225546748736 226.00553898246667472 -TestParticle -1.2429016633522536051 0.20958324622273286075 37.67591956683881449 -291.1872246516109044 179.51252843010638571 313.71221570905379394 -TestParticle -1.350836711566139936 0.37146863516149991602 10.648022816293165604 -303.44796444885918163 189.14789607745939293 51.43707686446851568 -TestParticle -1.3606071504125110128 0.33726059408562408803 29.623948782469774699 -174.22516541583135563 294.25596249059782394 95.41136217835122579 -TestParticle -1.2613426667283003102 0.28493782233230641188 2.8418286626483357793 -28.660785941482401995 87.50329638280636857 62.24419865756345871 -TestParticle -1.7174163570319429528 0.3032422501079781174 15.67069716211129915 -199.70972264612359481 32.767912430781642286 213.64123907162533555 -TestParticle -1.7458843970753306074 0.11283265730661723447 31.014841487303186796 -100.348702433335944306 70.42890181497725166 181.6379350423849246 -TestParticle -1.5856984450767472872 0.12800000166780992061 31.429108868252029652 -51.353858554652823898 23.612627758947475343 267.08391560632128403 -TestParticle -1.7153544980924069208 0.009492334383937130193 23.973160269033186864 -225.8121095708202688 166.53019043018878165 111.264606624241494615 -TestParticle -1.5026214783945404108 0.0060590469509819834884 26.922409196875427995 -295.19858318066900438 267.2316600455114326 164.01625566186100968 -TestParticle -1.9160661225785111661 0.2687972938601586037 36.621056515844763624 -334.838998311582543 64.064850181025448705 189.01682882741042135 -TestParticle -1.2176400162982947695 0.34785736514134202313 33.268864900617138858 -225.50438622677125977 227.27950095352301219 349.3797741235012495 -TestParticle -1.2273892818311689101 0.2816869543044054902 29.30501713210593806 -5.1819190308878404494 2.980732803128396391 210.95489861072306326 -TestParticle -1.3751089556704734207 0.2405885452138842584 36.06217993351511808 -199.72275209903938276 20.656954375719962513 63.697518910616103938 -TestParticle -1.5607369467841181176 0.07255978851264624496 7.9579329131271947517 -171.37467949380453547 212.58991825508687157 339.50383959100975062 -TestParticle -1.9532502979079398031 0.32689490765476852951 28.253212569212344363 -181.63986801834479934 358.1359989621613522 109.388744074059957256 -TestParticle -1.6386262719092012929 0.3843259001434648492 30.427684580834899464 -231.68744967547161195 57.857403700081057707 50.909305856223930675 -TestParticle -1.9782962700915884824 0.107957633562424437645 12.967168829872832703 -304.82496750248236594 137.36222813798312359 43.932431234771847528 -TestParticle -1.456906303967715921 0.14977091087281488302 11.183659205458482688 -73.40451433078203536 248.31190118288742497 75.220198402857562314 -TestParticle -1.2534896538060293913 0.32164641810767541363 3.6905727779895203255 -113.638768774667383354 40.160334282501267467 312.87037322501493009 -TestParticle -1.3014118589240171175 0.2335136721159586648 25.377666434917763638 -52.35427893272325406 9.000303326532378634 144.16353907228875642 -TestParticle -1.349118336295686893 0.043025081648941171375 4.3612305774961734883 -243.8860202407295219 2.8265136490351139287 103.60819968189791496 -TestParticle -1.3275933491849711832 0.30130671835155509175 9.869222679372882112 -140.91605869565009357 6.9406462242691979725 239.80228459696834875 -TestParticle -1.6818942627306852078 0.31620420657586079116 20.559233470145720446 -58.349404997197098055 117.22724335851061994 205.33268031856118796 -TestParticle -1.9852083696659352796 0.013418902816453127241 34.384158548277603984 -115.09964166928982365 93.38072290721305535 50.024657651717582496 -TestParticle -1.5693995761001753309 0.16001215059117473993 34.5933607052273544 -148.74442398288778122 35.382707682911650693 307.9784638941427488 -TestParticle -1.5266059802597138351 0.017927011927562432753 36.548915878020643788 -210.40292925773331945 201.71103729618005218 224.16233740901310512 -TestParticle -1.728092867591788595 0.17808919848065529745 20.998516569906101381 -308.92264952207932538 127.645229747456198766 161.89916144859373048 -TestParticle -1.6194915162303571421 0.12309065176675240694 11.294533006684988052 -54.678975810373955824 126.54242973288489793 198.90789595722705485 -TestParticle -1.3289490961949892434 0.29324085207912647943 30.6374181063208475 -269.87631534747202977 37.841881250480767562 348.01538484590025746 -TestParticle -1.992893537374311741 0.18673594337410803767 16.540817363482574365 -17.388276030638827763 78.86833627776049127 145.80382488854473877 -TestParticle -1.222299452110788831 0.30906300615816389987 12.345442063899700003 -306.8123712805751211 180.92912639536746155 259.40768755027107773 -TestParticle -1.4975645450575401085 0.33347394063389190766 1.5908406722909917974 -21.190900575813813589 29.47013297848204516 102.16591862721205075 -TestParticle -1.7529928369432026258 0.37348208125904397425 34.962456206016206295 -93.100816365900570304 51.110432866675402863 102.57164314281175166 -TestParticle -1.2425425262626379475 0.33615312037358630048 13.5646379554957707825 -178.52596605015196474 153.15866826328647221 144.53495382113527512 -TestParticle -1.6649955177303406018 0.2774227948724269921 0.19107601744351665474 -63.095836643914225306 354.85824120341573007 264.91047609564412824 -TestParticle -1.6484772171416994802 0.30267580759790019274 20.681865450161470932 -178.44791810461956061 236.1847171609527436 98.36374690667254583 -TestParticle -1.9932276245336744136 0.28313215139520719887 18.707112367987669188 -219.87647284127007197 126.12068590426943615 215.87266615210091913 -TestParticle -1.7032561164628601258 0.16397636271323282053 25.251751880173408438 -216.40546882883455737 157.48365299675131723 4.688955472432070337 -TestParticle -1.6688736346909214259 0.20206175633607201259 6.8253656041650678787 -216.49653061411731869 167.29352654167502124 264.9681676707442648 -TestParticle -1.8685421164356719181 0.017115665378235479788 37.702745220955684147 -341.22511657108503869 114.98911860271485352 180.97443389686239357 -TestParticle -1.2789089584183417347 0.38311485210375972876 34.310997435004189526 -320.3337196375490521 323.3381621809996318 259.21085923985185673 -TestParticle -1.6140662295704462093 0.22523087980360034788 31.289184028405010451 -342.24508460858135095 15.680010847649224814 231.38490121660879595 -TestParticle -1.9392715602121850527 0.15801671085680726869 28.474643946647489656 -130.88611486656463967 107.8187080577375383 123.51635573428578141 -TestParticle -1.2967745250719693306 0.06567169524305174755 33.95229338812422526 -290.63873117229752552 79.02208966627722475 232.82648238779003691 -TestParticle -1.5129927102068225775 0.035355940722157398748 39.88868697475624714 -192.95122284146495417 161.94702337269632153 136.8613631323482025 -TestParticle -1.6829217923833816872 0.25345881856811941502 11.3639096364677563145 -97.75123136727515316 45.772970150424697522 122.47944569483230737 -TestParticle -1.8496796135868087685 0.13179006688881342302 13.3337440463942780156 -265.13170996725159512 228.43295285296423458 86.46213418755671398 -TestParticle -1.3358066112403499393 0.14376027444378572384 39.375717961581145232 -157.40058260425848857 311.2848447975355839 331.54934076273463006 -TestParticle -1.4724981157763801232 0.09732120033570890172 28.321058818578286775 -59.894734856092107123 278.76518901350408441 80.89976806352470362 -TestParticle -1.2021644761475605012 0.31023967350442599455 28.526439154406524779 -141.17072146741031702 348.00301966689602295 345.1342457342993839 -TestParticle -1.5593994326172748721 0.1667781483451987734 33.654370780663562357 -266.88153921797828616 15.430552831803581171 331.4077165346525362 -TestParticle -1.2450357937715832435 0.028817230992748132934 35.27994061369459189 -170.88739535567884786 353.3811233168729018 235.24134924372253863 -TestParticle -1.9317961733915889333 0.3664316651845210826 24.216703033341396178 -53.371442738369651693 125.538665606108594375 100.18756180685251422 -TestParticle -1.6396980067944455506 0.35320738196817447196 38.908475459351436143 -246.96073709218802605 107.071264330560637745 337.8304256083255268 -TestParticle -1.7122870680368271756 0.33138468975426782492 22.34571124430782163 -41.625350595521808827 260.11274001626304653 319.5586433718779631 -TestParticle -1.7758391618474895779 0.055654577054355419685 14.384020683089943304 -218.7045008460380302 129.23569045343450057 314.73455478475153768 -TestParticle -1.8362854949156799389 0.17009562329070515574 9.220110348963054037 -5.6249185474454588274 94.48961934631255133 267.2078794777070243 -TestParticle -1.7334953226477165522 0.049544865778679184065 1.209613515173937337 -190.91534544660109418 64.56511824447872527 53.933623678817561142 -TestParticle -1.2066506827151026737 0.27307016461379868266 16.286012208431877468 -210.72290400454269843 4.9513407455376867716 217.19883427837939394 -TestParticle -1.9341836813541077866 0.31275777164344914505 21.744449246528134267 -16.671280260299788267 359.76195227232665275 224.80650775703034583 -TestParticle -1.2301271999661356205 0.031548406830605689455 39.849035058731047343 -90.34650036320888944 228.990784368342986 250.85529561169511226 -TestParticle -1.3410010761068889007 0.095083624572690483845 16.924908171363043152 -283.45379909314135602 86.752474366828209895 159.59709647132103782 -TestParticle -1.7698211243948773763 0.31273331984328978095 32.406541703763409146 -142.47083941877434654 108.934565017581746815 272.0311071315450704 -TestParticle -1.2184663095396561783 0.03812658809257066239 19.774618927626171683 -209.47233898474567582 217.91859195187419118 328.76297389338390076 -TestParticle -1.7206223471221142596 0.34602085721486458558 1.7719525390753965155 -165.06371680688690162 58.713339280074663407 131.55475352151159996 -TestParticle -1.3109621100006574324 0.1200549161067526599 35.241813901823853428 -280.10060451829298245 304.5154307276658301 258.67615548166588724 -TestParticle -1.890762195590066419 0.37035990280942132635 39.30878687557294171 -331.52556729751103148 337.10887406621617401 291.2002557551665518 -TestParticle -1.9459727148429868393 0.38159291851530796613 17.491010561827589953 -58.69944071533900143 205.64445683266583842 15.007877403052006571 -TestParticle -1.932411276121311472 0.04777930483056436195 25.073992516822389831 -121.57030712562516328 70.74439140769348455 289.9542940845957446 -TestParticle -1.5709963526669437073 0.10007382494413469276 31.19225199749002897 -25.663181434794644531 158.74882487098793149 349.24010777437848674 -TestParticle -1.335652850395929736 0.2682557203404010715 35.328293558121892204 -297.5826541744638689 60.254502441132032686 46.73892963602791184 -TestParticle -1.2957464098764572835 0.3440291712383192757 7.1735736922541004645 -59.24135447472242788 112.00172550339377153 63.553063734303997023 -TestParticle -1.3376569963037119315 0.3060189431378071423 33.029029350979975277 -152.73585490781837848 358.84231030107730476 37.635854669405638617 -TestParticle -1.771988403745682561 0.3418762364008507415 23.489318587551395012 -127.772934823946343386 203.78581662446330824 143.76143168311298837 -TestParticle -1.5956560402916708519 0.10759642083325884898 23.037334274387120558 -89.123439540602518605 335.80537435903943333 224.2944293252393777 -TestParticle -1.2213248137275627414 0.33273129495412528955 31.736197966218284705 -5.8113766822153190006 136.8878783815157476 64.522354495354704795 -TestParticle -1.5939091087487726739 0.18821654046060146137 30.731370977849337578 -266.58533763467028166 61.609425727717933796 18.235581197999763958 -TestParticle -1.7396585716134431721 0.33855494953671660951 29.449893101775622029 -180.02468739427200717 242.14518561194594781 286.10286226317128921 -TestParticle -1.282393302513987976 0.18117160916878405352 22.308223599873976184 -94.69043575838269078 120.90458523599184559 161.88428102391287666 -TestParticle -1.6814135190699217581 0.06566827687818244108 23.327233678731047917 -13.505074850212492876 48.75637107914376145 337.4546628636448986 -TestParticle -1.7657157709814490509 0.1428403447023711692 17.528150255810068359 -344.59038571613109525 139.36370104693307326 48.933862071120714177 -TestParticle -1.6903656227398606848 0.1881104051902828811 4.8333955434429443088 -225.1651227652955356 185.18882646555431393 132.21080070182574673 -TestParticle -1.994803202974419154 0.07010640681945860819 10.335500705227271823 -49.13850067137512667 6.4534592639328725028 80.823883651112907955 -TestParticle -1.3332640591247215678 0.06033190012542344327 21.035357456357957062 -97.733488288704805314 80.36567051536489714 46.55202086502264791 -TestParticle -1.6243595893431250765 0.19184864274731788791 3.8955991274805690239 -177.92659068814418788 143.40326100313114921 22.678654943892524898 -TestParticle -1.6823664970435372457 0.2224783311899178051 28.355960754425314718 -38.26291967170601538 109.90023925961423856 198.84047030132839495 -TestParticle -1.7191941261517613704 0.33174274738319786682 12.850948299491872007 -119.00419547116645447 97.60779700546201809 294.77008528831782996 -TestParticle -1.8572892923802768461 0.35111820477995814294 13.9604529367616514435 -90.00276864094306006 148.95323888923235245 105.97452396122218943 -TestParticle -1.3153721536816338489 0.19649899863576869574 15.0714118102473335625 -114.91054594701827796 42.412124805715073705 238.87013655434262205 -TestParticle -1.2329176043622995795 0.016982564457388795581 30.243701002322488591 -82.65191789811144929 330.6979385476704465 45.054558348890076047 -TestParticle -1.5821710473264454233 0.3143035815568485103 26.914241767154372553 -284.2538985550680195 218.88177874336824402 323.40347760377426312 -TestParticle -1.9040784761593252394 0.24428308876647972236 7.2140984856285061966 -36.905471182196343705 235.01221091601564694 318.38458893259758042 -TestParticle -1.65303582473123023 0.15480622128373774937 30.612597160930445028 -176.14307295689886246 344.8917806440758227 46.391668294041863874 -TestParticle -1.9906869462994456477 0.08417977136701382257 32.071163809129458855 -190.08888099464044785 12.337459747731131188 44.2017470332212028 -TestParticle -1.8765384210009301569 0.18365454827241262103 21.70846970886060845 -357.147106806575664 129.14807435709019501 12.280707552849744246 -TestParticle -1.4155101547192867617 0.04021447505437234643 9.344979114904226947 -15.0079117011066429654 104.10136849327774655 23.129488238006107537 -TestParticle -1.8212138878170127665 0.08047272581333581032 4.0968495722748254906 -174.58882187338159042 279.87646692565357398 23.324854698976157152 -TestParticle -1.7644240552946159895 0.028115303133601266677 37.495056810553286653 -118.13225365926875554 167.45393279647143459 34.012411764895496447 -TestParticle -1.4525677350618968475 0.30250405555180709394 17.82996354610970613 -220.00796720803919015 344.15563445760545846 123.14676507835467589 -TestParticle -1.548841766197246228 0.09540860671062662002 22.684926251185043355 -218.60911597389889494 90.33458573673138403 102.992143880334552364 -TestParticle -1.2079296534119159379 0.32769989355099571338 38.675927266126485904 -200.13361220962531206 158.78840734969233495 279.3835775172844933 -TestParticle -1.377134208847530239 0.24021816899861267447 9.0547885117482262984 -307.8373588937357681 250.70142057430294358 309.94009295835280682 -TestParticle -1.9686740753046718666 0.039229853667286734842 27.8754113045622951 -44.123357114694904624 256.01312835054108064 261.81824327677321662 -TestParticle -1.5814217806739057082 0.17335298748077404563 11.896107065940920933 -11.863952502714919746 24.317879056812333971 281.83737446678952665 -TestParticle -1.3875566874932281358 0.04186652452005912295 8.374003796839994962 -110.23215119957482955 294.56036703267886878 295.56595853737684365 -TestParticle -1.3902402383167473676 0.19593968424019078678 29.315181048510574158 -282.62385234829253022 324.77635841333739108 19.922520312932118003 -TestParticle -1.2840096543928043449 0.29990999639214999117 38.008971094948456937 -277.38971452757238012 208.06148201248271334 255.09629766073103951 -TestParticle -1.5591506829846155657 0.37436941724804151388 28.992037551395654305 -349.16296285001351407 325.2167596752620966 272.84514086043867565 -TestParticle -1.6470838643939573753 0.08288833139777805614 14.577369178129217175 -285.2260666698484215 331.09186078156602662 265.88764593799055547 -TestParticle -1.4078732644616405167 0.12168143435803764618 12.108634490395427719 -108.46688890223232704 161.29947110408681965 275.03585750375651742 -TestParticle -1.3806299194725459856 0.004926651150672434372 4.619034071475587311 -124.92525284958901466 247.86360149925218366 213.62866269117026263 -TestParticle -1.3192455632849615643 0.2895763215200138352 26.694213488950907731 -156.54596065699396945 129.81140517153278324 134.60446380394492394 -TestParticle -1.4439912056109245331 0.3898931766577775071 8.96508289894697441 -244.87528934455733065 193.64710431202621521 293.37512055758975293 -TestParticle -1.8635206283775769265 0.2795056553246003106 32.898054005194971694 -137.04912054787823195 287.93791057659291255 10.142083183616289688 -TestParticle -1.9812056783962854745 0.2247292940884803858 25.532351672534726816 -201.33822039314060248 254.90475216060337971 359.59652623258176618 -TestParticle -1.9116361511506723136 0.34944272223947114853 5.3334830645261233073 -165.89953551606566862 87.00762822041266986 286.54555713608760925 -TestParticle -1.2300510950958833956 0.09272681808089294764 6.1108306263088341126 -60.392041334648261852 166.06618730050502108 214.40030029409305712 -TestParticle -1.6587060971893274886 0.35283027123356813792 31.860313399205129059 -249.71240866151026694 222.43577149272385896 31.641338378167219503 -TestParticle -1.6042337378433173534 0.37025740688655151 17.202399535173533707 -87.81318396148407146 2.5620013176806422095 357.37399955588330158 -TestParticle -1.6471345300326571959 0.13620174045721983314 22.615216955031499424 -80.62529682810802001 69.592694813600971315 105.76774944494903252 -TestParticle -1.9072984229216274343 0.01501546063666405785 8.290907351796761304 -169.80316939963415734 18.043578597928426888 349.8451486157899808 -TestParticle -1.6906614679737514972 0.18058500638001656613 35.641943093270654686 -155.08172745880321486 318.8449035930426021 193.87642754894059749 -TestParticle -1.5896626347240321309 0.08039921506021037445 26.884736251329634626 -93.207751799271306936 291.57502433845007772 164.72382015911426834 -TestParticle -1.6992934898451703685 0.065201137301299824656 14.269610927403233447 -236.09727012824436088 254.53147047225508004 263.77965229044838225 -TestParticle -1.8538533648632840034 0.04766458860664664343 32.873078543951940844 -204.22879507518445052 106.636047257291238566 249.48280450502983285 -TestParticle -1.4212096807741136928 0.07499446462853280593 23.101996292119086007 -275.60817514452082833 213.13272785623379946 230.30352647630064666 -TestParticle -1.7510124795524912855 0.057099861992605485672 26.912262589245482758 -293.1635508220617794 35.9907631662996792 141.04718451469835827 -TestParticle -1.6563019761734052437 0.025865878674105769602 36.786210320613299984 -182.00701529286254754 302.4937526698793704 324.59294681664295013 -TestParticle -1.729605636071602337 0.11527751871838157194 8.269004569267789151 -347.6614584046645291 246.54991472345386683 257.4460526186617244 -TestParticle -1.5759605048363587443 0.11372511990649024349 2.1138568479458896832 -32.388292718466615838 301.59398434276658918 321.32099521949635346 -TestParticle -1.8344051151510727404 0.26899383835918777574 3.9802801398091425256 -84.71344253866337226 168.80695388443507454 259.706671920307258 -TestParticle -1.9193495257732000603 0.3433984358229728029 11.27141574019314163 -62.069125737912351326 344.62614387614092948 49.455425729806016477 -TestParticle -1.7910635325425254827 0.044197943689674758228 33.673496401958495028 -49.096060175323778196 333.20352819343492 344.1647888658290526 -TestParticle -1.3951416310339623816 0.25049231139019290104 13.926920554033479505 -24.468782285640848784 283.9433213127680915 38.716618949049291132 -TestParticle -1.4774439717601555166 0.34321703341922732422 34.23200733980726085 -253.1569295809615312 208.55072402648170282 142.78123543474748658 -TestParticle -1.8035383416573496085 0.31178214061844072846 38.848219271007792486 -163.78980370879801853 27.192135308956363104 240.49835213590739613 -TestParticle -1.8523952866624258107 0.2010708076570819347 22.034325231090594599 -124.711476085711595374 323.0644792551414639 138.10178915634389796 -TestParticle -1.9173340778250498317 0.2780025712872400967 25.973495130250071838 -193.9471251677579744 256.51445549034934857 68.5799795393802043 -TestParticle -1.2039954656193134763 0.32062119894339707882 11.801770668367792538 -261.58407010163364248 130.72550628237604542 295.22935271302458204 -TestParticle -1.3539793779063435952 0.05619140956045583224 0.39149769265351963554 -54.55272735280637164 335.83544373800691574 89.36258771851326799 -TestParticle -1.9516074079116982887 0.1921645005309346732 35.371640156848229708 -152.55319109406485723 247.31165449235123788 278.83909188690222436 -TestParticle -1.9301130006872968536 0.047382794904003239234 3.296738006904260665 -186.93636419954495409 38.829849755176162773 177.44532754290727894 -TestParticle -1.2580985637358546025 0.21204965723905899733 16.1659140062293325 -3.289189867948967283 190.84482276807500511 67.97050011468211039 -TestParticle -1.5295225293999865634 0.17172263806479373671 39.618093381378386653 -332.6463231490124599 278.70254383892529404 12.693771958962534185 -TestParticle -1.3231257344221201144 0.2573419902802399073 38.0841373767418645 -20.119441148442565037 244.32686028253979771 48.572638095274754733 -TestParticle -1.2390492871187110957 0.23798618359691314783 30.645766685864785472 -87.001950267678836326 278.12670273948640443 330.89492423249123476 -TestParticle -1.3993417216526349289 0.031843494342214208326 14.144935673919892594 -72.465298766095699534 334.2534597720372176 30.48791433958904662 -TestParticle -1.5347486253277040635 0.04338458251454313519 12.0921328741059639356 -120.79694902396420275 355.45117743828626544 160.7907173842522468 -TestParticle -1.2904906197620742425 0.28414011519071485923 33.037713210604835012 -289.81253890944515206 83.576357577029270374 220.09709176383933027 -TestParticle -1.6058032451228929638 0.36018141227094635504 17.994372902660266789 -3.7010845253058599624 141.54942979100397338 198.05616798418643043 -TestParticle -1.7714414500542230435 0.0035609242707668187222 22.050030319794334588 -264.59185760489833683 10.605770272399395182 215.25949766508875882 -TestParticle -1.81709217161712 0.27368429441007163794 17.149545687672187455 -35.988324614781888044 81.77856120500719328 10.201466538617181001 -TestParticle -1.9507969820486321666 0.104826252022570107214 21.570178232673107743 -110.11799658110533073 203.10615346805144554 174.54637699366600145 -TestParticle -1.5513016726876260876 0.0649073896097557973 28.406030811013923909 -294.40827400152136306 308.45384003953444108 250.69412013121518612 -TestParticle -1.6081730286462514457 0.0904772003540942199 8.756397654381963491 -95.30241023766843966 310.97856820924152998 78.51553642084900275 -TestParticle -1.9445060562513780678 0.34581412562291430346 38.93528925234138427 -322.18458452998703478 206.50871262487711988 171.6753679893202218 -TestParticle -1.2867830568980889172 0.23805020747269362014 30.605085071406584518 -107.834941188806425316 172.69897682961376972 231.64156285513004718 -TestParticle -1.5570299212666793842 0.34247490116827700168 25.701729758850273555 -57.759342054473357564 275.21368529820330195 0.5189093555138457603 -TestParticle -1.8297728730942826036 0.0059327247000139143526 26.27006410810665571 -351.91597475003959516 332.46172667657117472 193.83113607968971337 -TestParticle -1.4663451402621732189 0.019337346272064428326 0.491698998445047053 -336.79769240394642793 248.96724280968578569 175.15811073921727825 -TestParticle -1.724576194857081024 0.052697296256256631608 5.7447084496883027427 -66.182723011463494345 29.130322702617217345 339.9870439485365523 -TestParticle -1.3696669727225077029 0.33229023795273532338 39.64244722837145929 -133.49050184888841386 162.12402403598608203 293.04583577859932575 -TestParticle -1.3783417053600715008 0.2855227081254033128 11.873396199324094624 -181.03404330551020962 111.58079564001488393 50.497053185226064898 -TestParticle -1.8637392080726669086 0.0156183905360887560765 26.799919264480482894 -101.416124536033450454 141.64824974137857794 87.10767556818554169 -TestParticle -1.3990411255817394309 0.016424027824586850954 34.17231113580791657 -351.25674680067004374 51.410447621435544363 109.4743571087562799 -TestParticle -1.7113078627771947104 0.087396542572623220346 21.48366722009397023 -331.26077825265491583 87.597172428811916234 351.11237329056922363 -TestParticle -1.6537452602438895699 0.19076978286361276349 30.899468439263419128 -338.97921655361312787 354.2717007607652704 88.459659106615376345 -TestParticle -1.8713204845226436568 0.34948347966477527615 26.694021521206035885 -22.640920338079904894 267.1658484538838252 91.263466282262129425 -TestParticle -1.7800499814903345541 0.21591168642547953205 4.15893255030611364 -284.8692985786169629 273.15026927162216452 163.62920354405895296 -TestParticle -1.2770584465418410858 0.11704921307575957834 23.561299361007908004 -208.69763432291699701 114.84562071374233483 106.557589971007203644 -TestParticle -1.7789101924514278963 0.21089404756926086182 26.446391287965887784 -166.38039683220225129 280.94687192438289003 156.1732356226829097 -TestParticle -1.5095803628848272204 0.37888764670309865723 23.739638145042558648 -147.5462561757028368 320.06107890549310468 221.66365612858550094 -TestParticle -1.431320096709388201 0.090307147024224890264 8.768204975989792871 -86.741239636344801056 122.03132838806067184 343.580887072082362 -TestParticle -1.6349437899113876682 0.14387102541744481443 11.841216176535350968 -51.14042919054931957 69.171034829460595006 213.79008663660533784 -TestParticle -1.689003605562497734 0.13061345081474304286 24.749487065465949343 -180.96919715736157741 204.68845725307318162 260.67277137781871943 -TestParticle -1.3035444430147782313 0.19990048901013623972 15.958381821114077326 -24.968896817823825529 197.33820599380237581 119.001287940231961215 -TestParticle -1.6620625944290643439 0.2734543708115155236 30.556744105988030924 -323.42922129424488276 115.879900714354221236 18.69101695694187626 -TestParticle -1.9572874068027543704 0.3982637334300366816 23.395690692151514867 -282.1199835387070607 264.2819579212129497 226.80637570406867098 -TestParticle -1.7711614884940887205 0.16471476857196881705 34.541413045241888824 -209.78439563147685476 330.68687123431953978 302.79975669488345602 -TestParticle -1.2768346788945352799 0.2680189005217827325 2.3664781607185281231 -4.5230625737162633015 309.27315231219478164 35.64300138830596154 -TestParticle -1.7331467818212080712 0.08199012177664927181 2.5002689592511995187 -16.248296777956340975 8.818474849161844986 133.32825103025075464 -TestParticle -1.5824962842528258467 0.1664685697946028109 39.01047834163395578 -294.62170247515587107 5.127126749923851534 323.21555884047671725 -TestParticle -1.3065419938771187791 0.062752012732249048965 8.378519051225520542 -254.48399542766591708 227.28662992761130113 215.88914339840525258 -TestParticle -1.2803200151108913296 0.39024438031771679913 26.21206496548343523 -86.2004800657045962 86.508225331489853716 295.03587464294588472 -TestParticle -1.9599644739977994945 0.18082768987187250453 26.76260832548297941 -347.08076935823510212 187.06487585242066984 78.43547038210139988 -TestParticle -1.5504457817332411018 0.058138854268877486475 8.311304083318722391 -250.45953202370188251 51.58641776614162211 321.91182873943205323 -TestParticle -1.4030770961210228265 0.2255632436620616521 8.257376872662526068 -110.66653646497886143 331.8743125077128866 326.8827542847423615 -TestParticle -1.3330653778054313285 0.23576894818100968543 16.555280374134500931 -201.04570271621727784 304.9737571038722308 129.38177632189641031 -TestParticle -1.4676189305416613706 0.15334509742223720319 29.730324421851861416 -93.28877448580836074 98.24809064509591394 318.26221325804715434 -TestParticle -1.4959613849179316247 0.26490707510895572518 8.435591899110246317 -121.44478123997235741 352.46125426578402084 269.21443204906552182 -TestParticle -1.2410245922213516412 0.16484650483123386433 29.036807003172221187 -234.59702065989810649 212.29149699166657683 309.02229933747048563 -TestParticle -1.2104445735427551423 0.27493160452164350227 31.472614096909531156 -172.8652728002631136 303.96742459461654562 8.009940254088059319 -TestParticle -1.8791733750261010449 0.2587599416761243165 30.401845910812088647 -330.1151954343364423 190.20401433347646503 104.67843668270934643 -TestParticle -1.3013630074517779089 0.22413535954031660324 32.01650674239483152 -63.549710245898353378 35.89931403059021875 158.56811223007159128 -TestParticle -1.9547724398089645348 0.0786294356900830993 10.0598953139010802715 -69.4839845505388638 123.32244013516246639 31.421777442531322322 -TestParticle -1.6120256585797529958 0.19985700875898035345 13.999189942348966298 -78.857222386685961624 349.6556927780835622 58.475688092723309808 -TestParticle -1.7578912848822172421 0.27207852440462437782 21.16570903311817986 -204.48739950618715966 68.64871257741852162 227.95088374477833781 -TestParticle -1.8170356771723037426 0.24230078833019122464 19.368483713748780417 -184.73419610737784069 272.32723488431577152 126.891658495766833425 -TestParticle -1.8561231261283124283 0.19157748016708203709 1.1886704509024781373 -254.2676067727032887 317.6217024209003057 224.34445674903426493 -TestParticle -1.9710622679246994071 0.14623926742902368381 6.640292860769481109 -190.41063402021279671 187.773358994985756 328.47417804669458974 -TestParticle -1.8390376809348407683 0.39004880820775639227 20.066519467297950996 -211.93199248227401199 289.47815944254944043 137.15839269809171697 -TestParticle -1.6111502808558577637 0.22394676788626455277 20.061937046580968769 -92.54520491825057604 92.01310424807805077 13.375630065565452753 -TestParticle -1.7289359898596003973 0.029780688540387692531 26.014739049810341243 -312.66680607544742543 228.17665637399315415 125.22825394003517374 -TestParticle -1.2705682146072982963 0.029404610289824398284 5.561963728286389852 -84.16555574179947996 331.08838136349748993 315.88331119433712502 -TestParticle -1.8573347647002547145 0.36089888274309028793 33.45261607330014897 -108.58851164869084016 217.00073148209528995 139.41678117547121474 -TestParticle -1.5119662840275136517 0.035019622195022657996 10.463315222301648788 -152.85193304965602579 42.895445465204801394 38.742869188454783114 -TestParticle -1.7622884149632529471 0.03162410217369809179 3.1822974384423297067 -37.26277315140376345 107.89474442992022318 186.6015285726906825 -TestParticle -1.3516643515537363207 0.00042846679844568138443 14.013484979190140578 -216.76556913128737847 329.5425274371341402 157.99664633404185565 -TestParticle -1.3725976866577220825 0.30646538230027742244 11.329739671767651288 -198.97848141965863533 44.651190190469009167 28.049566579775078168 -TestParticle -1.4591070353626824918 0.08119659950059535114 34.28551752565069677 -306.99758279574081143 104.56005980026995417 24.491183217056139654 -TestParticle -1.6809883631745992094 0.12405907090243922797 23.088918298866115464 -81.89324756024211638 45.486408290411304733 5.9086829848113620045 -TestParticle -1.3535618238311779571 0.11072994226846155641 6.1365791065780417313 -96.5917090856876257 125.77992141224173395 180.26956152431557712 -TestParticle -1.5024996182012646528 0.2601294541852439135 20.11839589454453403 -270.4000045350792334 353.011762488246859 34.641037025004784766 -TestParticle -1.5996488376502526751 0.37889391086596613256 18.528995245881297649 -215.86591794372824893 196.33677334782890966 20.482598606365485239 -TestParticle -1.7931356901400370418 0.025945290910749509855 26.661454696830183764 -188.02499061598265939 217.74613305793528184 352.64512058062791766 -TestParticle -1.6808120166727305023 0.26627765088552390882 4.4798421923713638293 -12.471177251742290082 9.432555892002669751 336.72507040011447543 -TestParticle -1.6313081817828176678 0.0086570580622717507174 3.9083339029362873518 -54.248103250365730332 318.7038881970888724 331.85368591582181352 -TestParticle -1.2884450142579531029 0.1681046156164187344 35.34871223758726444 -240.5583121923978922 135.24748641897326706 301.64571007267852565 -TestParticle -1.9196539088974737819 0.055293464951134657648 39.174420254686374676 -13.003093109260595028 224.19261478871260351 272.9340647583842383 -TestParticle -1.3704960962475472019 0.11179773250371188853 23.81208520955706831 -261.70166394043076252 10.650163480395606896 96.095112534597603826 -TestParticle -1.9516781167723931123 0.20402034023295062548 32.535249468476067136 -340.51354688545097815 329.0040653030519593 109.98356406041511946 -TestParticle -1.8140222569343318337 0.12613518245266175377 1.4950171510413001741 -234.61793333937521311 320.05130111528796988 172.88154495883503614 -TestParticle -1.8102010682471065817 0.14811926068150899072 0.47152065059882453113 -231.56413706767099825 205.2503541540525589 214.7508917825621495 -TestParticle -1.3323729215149744398 0.19959213905409678436 1.3073421511548932727 -151.66443112411295147 341.31892085633529632 144.25232896171203834 -TestParticle -1.2204541150545651362 0.068668187712776870835 4.014281498324958619 -174.08147891950491726 47.939506002741296697 254.99017431971773817 -TestParticle -1.2181192459350491664 0.025059093817326606735 7.204862413525972009 -48.60770716273837877 329.11947000106135874 217.6643233891191187 -TestParticle -1.6039675062130638317 0.35797604454305875787 16.056969103103426733 -87.92417372221831329 49.76521958624503128 164.99398402032807098 -TestParticle -1.8725342069546249135 0.106279250804296898636 0.45718402173144045975 -119.596726134790174 107.86697924451233632 232.81352842822093407 -TestParticle -1.7853111973976689697 0.12193477571081268174 3.680789884957089697 -205.60326749430927862 40.207082764860338386 289.2290546833312419 -TestParticle -1.417950447978111761 0.24357413812980258094 1.910476157584461987 -252.61262373556786542 355.48333419302929315 151.32407206005677835 -TestParticle -1.2280461512973894767 0.15278421763439650749 26.714312283832946093 -142.72673485719965925 232.69712275301176874 346.3375478502677538 -TestParticle -1.61151127031616892 0.3744225370958842447 36.56793088861800811 -328.09520081336302155 25.920977978027824662 288.72452391776596414 -TestParticle -1.2239475600090146123 0.24714055634484358159 30.304522847333871027 -52.68180217169934565 356.99734588216864495 56.617981510557434888 -TestParticle -1.2496667763539286433 0.29747468986797759305 21.37154433932160913 -209.20331717962355356 22.663460638340339415 243.0475686976612053 -TestParticle -1.3767605238800932899 0.16005520292207792155 6.1854407103408437507 -301.0924331535983356 324.9040368073589775 194.17256664039328484 -TestParticle -1.2487797979186712194 0.16488755850697139893 27.605925256805747381 -173.22312758245544728 239.01695963206066153 175.97057379774636843 -TestParticle -1.2254722592225348876 0.36803675574552041638 17.169692704564543106 -198.47031096951334916 278.36167082537872375 125.492714298233096315 -TestParticle -1.6464965033862297705 0.1517233377674910566 13.532163365202411143 -147.08019388518567894 177.40254091222027455 340.04568453953692142 -TestParticle -1.2241673144222895431 0.1378443050280294957 35.034429639418924296 -279.5154571951889011 236.88366494050367805 224.20218590463449004 -TestParticle -1.7054405098540872388 0.3610118405579151868 11.466405393735001894 -354.5918155292421261 347.1596768668937898 219.93975816420154956 -TestParticle -1.7400094098497860262 0.11768201787113397039 3.0207223829180174235 -344.79550555000747636 295.17286383856117027 107.65817940211057646 -TestParticle -1.4518563888365596526 0.034369934761878086216 5.703231914559241389 -123.995036213356954136 112.321809800044363215 96.308678475290903975 -TestParticle -1.2222379634093671896 0.14278765376770935491 35.361595327244465636 -315.14729198154049072 321.37175810105372875 262.59992588280709924 -TestParticle -1.2388409450815878188 0.29191544705043231955 14.574148472908646568 -354.52890314367516567 301.2116870378684439 101.6607227628783221 -TestParticle -1.2004854536116522645 0.31759418786438237126 35.64893550976294989 -150.1713542262849046 263.81583006909363576 352.70617164487305217 -TestParticle -1.9942890442362894987 0.19536136516905414084 35.02451517807598691 -125.959361711604387324 266.3424034858336995 225.8398826035477498 -TestParticle -1.5915447637460526931 0.0895260552791858899 24.02901618574255238 -322.40268348510250007 115.71588659763698104 232.13880147735969217 -TestParticle -1.8790673483459361393 0.17433764017862168894 13.878215826572342095 -302.39495868122469346 259.03939837677381774 176.29569985086394013 -TestParticle -1.9699962554990502195 0.38438649317544010264 36.886012906803621547 -71.57770428256088735 76.46325818263683516 152.99488881347215852 -TestParticle -1.9815372834826587845 0.17262153411198999375 2.83353778898145503 -239.37167896200179484 354.1664112035709877 298.12866718881934958 -TestParticle -1.8155595191765212526 0.00946228278143057544 38.64106328673518931 -83.00268912398927057 67.39652732514183242 195.80213873516331091 -TestParticle -1.8868581896910789908 0.10440835820682173307 15.007174114646065988 -3.363490125056509683 163.21113577536885941 277.4874262071848534 -TestParticle -1.5619200947925855338 0.0059432103700412857936 28.417160713316764742 -199.61588156187738718 146.61610611302111806 239.63331133984317489 -TestParticle -1.5212478213877396183 0.39927753429172280208 20.482036387314252579 -328.51885419136107203 7.1256709736876455707 220.89114467811927511 -TestParticle -1.8571870020289564795 0.091291230530104086616 5.8118062401183578913 -90.75198382995706936 192.24228564818409382 97.133874093047666065 -TestParticle -1.9171289936627273764 0.15261088480197210204 38.10675746822411014 -307.07749448841616413 355.13520879558041088 42.711583491490678455 -TestParticle -1.7364144307839262105 0.212129283201967056 18.744823342299753222 -23.928680492317099038 37.437700592246308418 64.10777424122947821 -TestParticle -1.615801582218067356 0.15507189040762445198 5.289237911360147315 -2.9760090649453463385 170.77756092233224194 126.74171547116436898 -TestParticle -1.3071905708698117188 0.34127930871062794882 17.996264880013068677 -181.87012353589301483 211.32152679731703415 284.19737442691894103 -TestParticle -1.2265401930807908748 0.25798059801133454982 34.025699672304931198 -87.484085061199664324 233.26336671618474838 310.39211945198593412 -TestParticle -1.2051260378681512009 0.3069049294618042545 37.351493484362229935 -114.521127203859620636 225.6531083956228656 323.1220799515929798 -TestParticle -1.8334732437656884318 0.37979115889431414033 14.226342594064389502 -331.7883640504541063 109.06927231695421199 144.65450510058425948 -TestParticle -1.757300956926634683 0.03414936250768385584 23.912004140762192606 -322.3724083824729405 134.91275424426311247 171.32647169967813738 -TestParticle -1.8972253261023601656 0.35656552318718498507 28.47629514891832514 -321.29937216619140372 70.71608626545858556 213.57910706058532924 -TestParticle -1.9917616839747163127 0.32376104104249381344 8.91181936527569718 -200.88415597368361887 23.513470382909822831 100.72835347725671795 -TestParticle -1.6165777777920147251 0.32043762073249004718 16.726392824188689445 -319.72153811597894446 76.78830327849077264 138.42254101919101572 -TestParticle -1.8908331674281746437 0.045197492899151252288 1.3383682043347544521 -312.10875470237436957 307.494732749847401 43.074246036675127414 -TestParticle -1.2145287335503922588 0.18257617394552527745 31.629727041908243024 -3.7714421582542145828 327.9557064611080932 329.9790680610109348 -TestParticle -1.8625485962061800738 0.24850308301344462003 2.0061095060140976543 -276.90239618431269264 350.88215248164351578 348.2932770314767481 -TestParticle -1.7953658240966166026 0.23860504712104810277 30.564301023692120651 -268.6736542028508552 254.54176920249031468 269.62615941325310587 -TestParticle -1.8519636256102920413 0.13630536382454808142 25.429742406638986552 -78.06201903944463538 183.89412111638756642 25.670444097748280399 -TestParticle -1.9912586036233026476 0.0062934836627138949355 3.9866901191125192483 -353.92558378078365422 121.86076402069599567 272.13181013382109086 -TestParticle -1.2352461280314077641 0.13108872108404742707 2.4473753819670784893 -223.0667681463768588 134.42147854096177184 161.85468044136672461 -TestParticle -1.3431819133091436047 0.28681705477285673878 22.82513974594832007 -232.7183120134940566 120.199688171678360504 89.77367022064561297 -TestParticle -1.8403545873570172908 0.24879279733973019839 4.0287923881425502515 -15.018525270146003692 85.179302481017629134 62.783331763645470858 -TestParticle -1.381867054141263651 0.041622600218831219687 20.582798332241445394 -16.94221565894110526 117.67293863884100347 301.82514806956680786 -TestParticle -1.8641683600359446604 0.24640721081737218534 5.9107924107914655565 -193.20103651885807494 44.2323469313580091 26.743437036080784708 -TestParticle -1.966054790276180464 0.2690464178872462031 14.878455955491389773 -190.60763663869553852 31.588470897177995056 100.366806653161106055 -TestParticle -1.6058040413293108717 0.29951736276665757996 32.261171438174280013 -128.57574732488706104 32.785220122308132318 5.815690987139072732 -TestParticle -1.6218958057245982385 0.20051601410731448305 35.228407716619500434 -275.05072744657877593 300.36353903970075407 137.58872709072204543 -TestParticle -1.9766063717976680714 0.39029116187457174592 35.936563690886423217 -276.4677919812604614 334.4193480382128314 74.17428380404710708 -TestParticle -1.4924898153539933876 0.12959279079593266637 39.497773315041648345 -306.13052013355064673 297.98869981653200512 134.11781736074624405 -TestParticle -1.8353633188339963933 0.019510947086492525654 35.474352018859882207 -260.37806171878622763 151.50200809864463736 309.73656114784841975 -TestParticle -1.6024488136145134121 0.027272421536337843745 28.531535673798313013 -11.154644928392061232 313.60248630627489774 220.0912732804740699 -TestParticle -1.4120513432815475774 0.29969768596351453738 17.02938110092897972 -269.20328072337844105 42.08893931076963213 126.58679602124011865 -TestParticle -1.7381168022087705172 0.29181610891675680008 0.578376627518526476 -102.38820556898792802 176.55332025897169501 164.93491360823296077 -TestParticle -1.651697945678905155 0.10215579780054198644 29.466376982324295142 -118.66030632495935038 355.77634853151920424 138.86820482744579408 -TestParticle -1.8964095997568284346 0.14855799694311630499 39.315092089557069244 -66.7203702634703717 109.12901978076088483 150.07738642659984407 -TestParticle -1.5884778821144036609 0.34804404474317385265 8.230716828452404599 -238.65003666711348274 19.561503330036060788 172.3300970659766449 -TestParticle -1.4852533118509871901 0.14921150930008680868 19.72836045372870828 -214.04378603222667721 162.09311096493223658 74.70412564882457218 -TestParticle -1.3995786109265431207 0.2170751900351963748 5.6353499706781517986 -136.77890520256397622 41.74190372493747958 352.76491235469808316 -TestParticle -1.9228837399064100389 0.20666458127164555325 31.918474396874408683 -25.57157805855647581 146.61033704579944015 124.85803020390667939 -TestParticle -1.5491200767868975596 0.37703244317878858993 5.088593545490081027 -38.820500192778638393 121.37946795513649079 24.303500272632902579 -TestParticle -1.6942853977776144436 0.090260172320617615416 25.30769952267446854 -161.30886094388631591 116.98046667590497805 38.286029141363265182 -TestParticle -1.6090251866675413517 0.330322662148613444 9.770748848728519675 -263.0814719840412863 130.26024091675910199 286.9327501208536546 -TestParticle -1.9761336997553433648 0.2926123710566602143 11.274914096097191418 -332.1701813530870595 307.94382558508260672 353.807211256272808 -TestParticle -1.9968906969927759931 0.3233230682542853618 26.00314542561351061 -79.80693890771757992 308.2283099476609891 243.34005704939397674 -TestParticle -1.8031947344086236562 0.14995127116151910074 1.730342239053141995 -348.6351290160268377 154.3487630625562872 28.463371915640660603 -TestParticle -1.8395166633814701296 0.3354540599588180516 22.093131712634573205 -86.610640388957989444 239.4548535151652402 312.24619268529380633 -TestParticle -1.3629305527230259898 0.2099232743767838194 30.216497531918712127 -102.43196923936434928 291.32106047341460453 2.1370626980559981334 -TestParticle -1.7455726368986721475 0.026854653926422458743 3.5759919284920771432 -354.23018906949636175 218.20031690429203763 328.7114242710409826 -TestParticle -1.8154807930100198554 0.38785895954054117052 30.190244155261783732 -84.158791911543673336 145.33493614486761203 216.44848876198116727 -TestParticle -1.6499702946012431148 0.38233820338992924315 13.614607279413908358 -33.87451574095803153 90.770300669062208954 180.38849672518907141 -TestParticle -1.607515534627930176 0.059816004314718410062 35.188867073591850954 -58.61309722228839547 253.79649442362003242 91.30583916434224534 -TestParticle -1.9899983350379286673 0.30667218968608733753 39.83983478820580615 -209.92012615445401025 242.81573248914770602 7.221381167673248669 -TestParticle -1.5778501251334575706 0.11118331397677137795 37.590979480700937643 -345.16243909883007746 9.645072368649788785 50.426633047687808187 -TestParticle -1.8837383001263663385 0.20673789324487820696 21.972954461156501083 -78.99100998693006659 24.805859834858065227 136.69965104577451598 -TestParticle -1.8299552552499931402 0.18024309648678646378 33.71418287836082328 -287.1584786318022111 76.47733005592756683 216.63675723929046057 -TestParticle -1.8307526657330810416 0.27679256938591745296 14.42019596286409211 -147.28115682985833246 236.20842913390856666 70.36203841533576053 -TestParticle -1.7619978997528076281 0.014257923627121950327 18.454020582426768016 -275.7628626446463045 152.24331061485040095 103.04339508992384822 -TestParticle -1.2611641121223651218 0.2092199031608525106 17.779518579686019564 -102.7504319389703511 6.548313747168017507 140.31125376249352144 -TestParticle -1.7663975820756958601 0.25859601590736014387 19.29766354922654159 -228.43411110252168328 129.52408847472079856 44.31277736443019677 -TestParticle -1.3455298896696588073 0.051640741433284009787 36.190409530870716992 -63.492703118667094486 178.32472671129730202 219.22272979662204762 -TestParticle -1.8502619397752217978 0.016055258128672856427 24.72292322260771158 -280.24156788062276746 1.0103622910431475646 89.91460784296667441 -TestParticle -1.7394822607661057923 0.13625236700994178274 8.773342269773106494 -131.40116141700701746 79.224373058834927974 282.8109557650995498 -TestParticle -1.6325195629104731765 0.16262358056449152666 8.946438635142083484 -196.95655091099223455 13.582007343579313385 258.10561033792743046 -TestParticle -1.7657479077259037314 0.21823895457628741945 26.194016006374575056 -307.4759621278849977 98.40357006941655982 64.08127327032266862 -TestParticle -1.3184659717472237972 0.20902078438144011674 11.194180638539418027 -209.8144125213535176 233.63319375255508703 171.85375675646986338 -TestParticle -1.6265974791221389228 0.3412246124964996019 31.920108006714791316 -47.471005836654683208 293.97130420183299293 294.00277926085681202 -TestParticle -1.544562457381803755 0.26456236803106419897 16.966290843319804083 -53.617851002077699718 23.906897211735604003 172.46215455198040445 -TestParticle -1.8302658298265410686 0.016558573352333152279 23.88277176507106958 -160.31985284355113208 24.957240748542652398 126.6630513998358083 -TestParticle -1.6333356556090419254 0.25338625439533907224 11.051395862722980468 -182.26698944663951352 1.9926145156870767039 206.81766326774084064 -TestParticle -1.2674061997735568408 0.09083958911004344494 16.414033820600888447 -209.7777498397578313 350.73333597951523188 247.44407246182404947 -TestParticle -1.400118114272113079 0.16683948053104513676 27.357400210939808005 -107.57418681944162131 96.46599300991492498 351.137614793950263 -TestParticle -1.542911801971112773 0.22704910395233757203 35.542775761322914718 -183.89056710921508397 326.93869125935344755 108.004775809479497184 -TestParticle -1.8076126800363871983 0.3514591336111956288 31.06364189291468847 -32.09942049648420692 328.34181095498098557 23.785841162187210784 -TestParticle -1.7657364621109161718 0.22171357606490707526 37.37986273837123008 -76.229451450918475075 186.15095789038804241 272.82850857627113328 -TestParticle -1.5339591135633763308 0.14194102156165430695 16.888317976342129612 -130.44976850069960506 252.36020783978619875 120.456187175611859175 -TestParticle -1.9547780848567972711 0.20899592311387996113 28.868044731219395516 -228.48529363010104021 342.5481929867736426 287.9707078087696459 -TestParticle -1.2418423098941544502 0.2626072565929837288 2.1074243271891202056 -38.080338719023941962 119.27817821310316049 12.056891938029119515 -TestParticle -1.2210546528534078625 0.3775561742151631872 22.111051712315155982 -338.55211294801040367 12.980519500186410653 332.2853401701941607 -TestParticle -1.5963937431999124517 0.23239324239635986147 13.194381854516867847 -58.007673822576016676 88.15306827351753327 155.81366075873469867 -TestParticle -1.5786275082915319778 0.025562551186680871479 4.998454237047265103 -250.39244849302215812 165.61747690949906087 149.37807874408460407 -TestParticle -1.6098684422151645634 0.21941479472017652586 38.283886043658093 -237.71100658433758213 47.01387761056833625 340.9146849041053997 -TestParticle -1.294274143429140933 0.3692138815235402327 37.966030890732696434 -203.45477640609851733 296.29180039237496658 44.323085276308532343 -TestParticle -1.5889819356899443914 0.084869830381732264124 1.0823445911213003257 -301.3291216497269147 146.81272157061789585 2.2993592847625343722 -TestParticle -1.495972566018333838 0.2617122471497527747 13.094048981160977263 -112.72021003020111607 127.77611875010921949 296.87288781423353612 -TestParticle -1.9818950278621338956 0.30723187525460954328 2.2340086246482782073 -253.14761844363803789 165.37409022827591798 191.3408807414710111 -TestParticle -1.7869956116636900312 0.045787597413756889186 8.90426427671208387 -227.8168631112827427 149.58799389390406986 24.858909708161100127 -TestParticle -1.9448897771198014883 0.05694944930378804948 36.311102677736613487 -84.3756745725393813 14.735521995724774058 314.16923571788140634 -TestParticle -1.5778886440600849994 0.054612245238724765883 16.72994958727242576 -293.0541083071825028 260.48271034952341552 308.15802194547808313 -TestParticle -1.3022587146281570103 0.26839233124203137892 18.02838057643581493 -293.20763835009915965 312.4703557364094877 106.58503108046902241 -TestParticle -1.8428500612922003032 0.23594727253001890332 11.315478566151577766 -9.262284156503813648 11.174441070760416039 331.91331034768620611 -TestParticle -1.2400313949450130213 0.37422492957960290516 16.60903446615966672 -240.33042266148279964 153.97322107823731585 191.41559045744850209 -TestParticle -1.9829274684920319416 0.3634611481375451536 25.819601695264427832 -140.99742244780588862 341.49734482956387183 8.731842495851447339 -TestParticle -1.9975413987753882772 0.06592938413948253029 39.49276861893206103 -67.714562888696974596 98.14914061512281762 45.19626721853934015 -TestParticle -1.2436383625451867818 0.3204615517738288455 26.461603913930925813 -266.5125426106603186 127.50909218237357834 0.3132830361456928614 -TestParticle -1.4113215699552892346 0.009827894395237192146 37.858626352737367426 -253.23691224458718807 108.52674294880429784 352.47828245113328194 -TestParticle -1.8148473149676069838 0.017705697189401049807 27.03434752366788274 -244.97100671505916125 96.848173936006702434 232.97923224763914618 -TestParticle -1.8212512693609279602 0.27211932176121911287 4.7578666520375545446 -347.57353058021692505 254.19838041200335965 6.6604121361125034895 -TestParticle -1.6430443076417013959 0.042365150738876616865 28.313700526240026534 -178.6338948507659552 287.94750707892865194 146.775946581025039 -TestParticle -1.2047662238103988841 0.23251833898522478172 17.70944339203029827 -282.07165060128687628 43.193800331112015556 189.58232124886598058 -TestParticle -1.2467705317577537638 0.29356902400030004952 2.8706191725519047964 -242.4004033144470327 28.806681869090574821 296.21360336099968436 -TestParticle -1.3162696178512978129 0.30749173225083181737 9.346008763094072691 -322.38053647407821245 112.34526406313270286 132.09084683753127365 -TestParticle -1.2971409174950825349 0.3376994788613812415 24.652899562822732094 -299.7803539105363484 271.40817959188655095 266.8572235615602608 -TestParticle -1.7684747977650516759 0.02661749740193952718 10.096507324045376208 -3.7221406213358587678 125.36494422546940086 238.11022628505401144 -TestParticle -1.8562458518793771844 0.077017667000931988586 8.7143363020037831745 -136.69548804548151111 320.94977656886021578 128.10172157330882214 -TestParticle -1.5044816034257817439 0.21762930629061374987 27.505997823490588416 -123.58136898241176027 187.9229325893226985 113.043904522795230605 -TestParticle -1.7868133877825629341 0.008087932404090647162 23.413784625415864582 -218.89711766597091014 88.56442540385896223 208.43834176513581724 -TestParticle -1.9402143213090712326 0.14949494785208861103 26.511808095563488052 -107.604663311176523166 130.69889435502176411 346.87469017336604793 -TestParticle -1.5966683044291980487 0.087101617604941061757 35.919427778579809285 -212.8714684966646189 289.47277777746671745 150.30140968266374557 -TestParticle -1.5311077130660335488 0.006686025386596972271 2.6738949911861054076 -164.51009812173990099 316.04513748492058767 258.44750388729431734 -TestParticle -1.327174430660648996 0.16386649979480424899 29.516591637239059764 -42.47034129892313814 297.69030488053482486 179.48650722792217493 -TestParticle -1.3309285665414212207 0.31056216374123679635 33.20416058697580297 -182.12327311281021025 179.4712707903883313 47.404071121072391293 -TestParticle -1.2695626979113197041 0.028739588397623319627 34.7510196296938787 -156.66911337647667324 15.489917584647256987 137.9360720619328049 -TestParticle -1.961564416777008768 0.38198101311209609054 20.407128195470789933 -116.450533784431996764 317.3401517067230202 183.14633665136960872 -TestParticle -1.5940513845582582331 0.25613384894831064953 29.533539385317940429 -118.85654306899444066 250.92868906503659332 22.448371873007765487 -TestParticle -1.8442908242187292522 0.19455300058304564326 38.64468812151265098 -327.51192512776293597 261.15575066638751878 220.98151223015130995 -TestParticle -1.9551136736888132805 0.05881060116092867024 0.025983316883650964257 -229.51441899139550173 217.59860795663826138 108.775137355673251705 -TestParticle -1.3586578999851930405 0.34983150673028151623 31.522812174550345787 -105.68138198042714748 123.58623362447058014 40.330126317320825535 -TestParticle -1.902888826244875764 0.13683561730200419215 16.275257623666469442 -105.98161437435868493 148.2954616585051042 301.45848496238744474 -TestParticle -1.4388714351119729074 0.12902603848379340379 21.287394563627660915 -197.02123109899764586 352.44807359808243064 351.33034912544712824 -TestParticle -1.6931112006676685144 0.013916379702603532201 0.7871365555378062595 -188.64764325380838272 181.38199447667832942 29.813972851285797105 -TestParticle -1.6449616174898105125 0.0310490777007133463 9.657476944838542465 -333.95122687579464582 342.1511167418379955 160.69927097810261785 -TestParticle -1.432310913839848876 0.006987746683723328363 32.61241995358341228 -207.28809337462874396 169.31652720575732474 255.68956575096319739 -TestParticle -1.7327468488118134005 0.03857017036911090241 17.468015575192744393 -143.82903277012908916 99.60548209763706495 166.68173997089294858 -TestParticle -1.5512315858530165702 0.17035757433763087931 28.229428870918749084 -211.42236583345217582 136.37631347760083145 126.78807511085641124 -TestParticle -1.5128716646861577466 0.25892751799964647264 10.396770119409808331 -251.02700694813202631 225.21225462676682127 190.02303419914397864 -TestParticle -1.3509296764855895923 0.19460583033279599263 25.473407765343523579 -153.07999025709941066 160.34541100643662048 39.661129674485906094 -TestParticle -1.6995982689149604639 0.3683946534553529384 13.407331577384432819 -340.26004127001408506 272.0620153240722061 254.6289696923701058 -TestParticle -1.4262589721598459835 0.39380044551624404647 22.273999686412832233 -126.6676609334621304 343.6417878124360641 356.69746962842407356 -TestParticle -1.3261721625529891977 0.39678878113200655164 4.2056417606931040254 -238.10434769519417841 155.06469638647084253 44.875703119243368633 -TestParticle -1.9576977154420573957 0.26084185228864192885 4.55948470669549355 -190.48438127706978662 33.209683105017965943 111.270270586090106235 -TestParticle -1.8552016088932457016 0.13548857795579999364 39.778098090381654117 -36.82048012699509343 277.63542496441021967 284.2017295471840157 -TestParticle -1.6904488396185337606 0.10545628795963413182 32.08178306599211993 -75.246216623590498784 230.69409080017558722 202.52540071832260082 -TestParticle -1.8262524413841534354 0.33415074562628183097 12.176323543258451565 -135.12569593248673527 273.69848190668875532 306.5447498396289916 diff --git a/examples/symba_hungarias/swiftest/control_pl/hungarias_5pl_500tp_17_param.in b/examples/symba_hungarias/swiftest/control_pl/hungarias_5pl_500tp_17_param.in deleted file mode 100644 index ba1fb3c2b..000000000 --- a/examples/symba_hungarias/swiftest/control_pl/hungarias_5pl_500tp_17_param.in +++ /dev/null @@ -1,38 +0,0 @@ -! VERSION Swiftest parameter input -T0 0.0 -TSTOP 200000000.0 -DT 0.005 -ISTEP_OUT 200000 -ISTEP_DUMP 200000 -OUT_FORM XVEL -OUT_TYPE NETCDF_DOUBLE -OUT_STAT REPLACE -IN_TYPE ASCII -PL_IN hungarias_5pl_500tp_17_pl.in -TP_IN hungarias_5pl_500tp_17_tp.in -CB_IN hungarias_5pl_500tp_17_sun_MsunAUYR.in -BIN_OUT hungarias_5pl_500tp_17_out.nc -CHK_QMIN -1.0 -CHK_RMIN -1.0 -CHK_RMAX 1000.0 -CHK_EJECT 1000.0 -CHK_QMIN_COORD HELIO -CHK_QMIN_RANGE -1.0 -1.0 -MU2KG 1.988409870698051e+30 -TU2S 31557600.0 -DU2M 149597870700.0 -IN_FORM EL -EXTRA_FORCE NO -PARTICLE_OUT hungarias_5pl_500tp_17_particle.dat -BIG_DISCARD NO -CHK_CLOSE YES -RHILL_PRESENT YES -FRAGMENTATION NO -ROTATION YES -TIDES NO -ENERGY YES -GR YES -INTERACTION_LOOPS ADAPTIVE -ENCOUNTER_CHECK ADAPTIVE -ENERGY_OUT hungarias_5pl_500tp_17_energy.dat -GMTINY 3.646098141953443043e-08 diff --git a/examples/symba_hungarias/swiftest/control_pl/hungarias_5pl_500tp_17_pl.in b/examples/symba_hungarias/swiftest/control_pl/hungarias_5pl_500tp_17_pl.in deleted file mode 100644 index 8f4ffd063..000000000 --- a/examples/symba_hungarias/swiftest/control_pl/hungarias_5pl_500tp_17_pl.in +++ /dev/null @@ -1,79 +0,0 @@ -13 -Mercury 6.553709809565314146e-06 0.0014751274117575772341 -1.6306381826061645943e-05 -0.38709894990924181846 0.20562369687869339052 7.0036069691825035832 -48.302897646473702764 29.190213908309409874 163.69992642152809026 -0.0 0.0 0.34599999999999997424 -3.5735549824428292985 -18.380047749494480457 34.361526740492798437 -Venus 9.6633133995815381836e-05 0.006759122875155079725 -4.0453784346544178454e-05 -0.7233300630551103838 0.006773384545514573099 3.394505355540899938 -76.62090440289564697 55.183156101464518883 271.2285045598760007 -0.0 0.0 0.4000000000000000222 -0.17650282045605921225 -3.6612475825356215592 8.702866268072763821 -Earth 0.000120026935827952456416 0.010044657392872289059 -4.25875607065040958e-05 -0.99999328599172943033 0.01668004783869252855 0.0027793940989077428085 -175.84932558359508903 287.2227751976308241 324.72725799674782365 -0.0 0.0 0.33069999999999999396 -4.827962479462605839 0.034731626640621778608 2301.2114260455621944 -Mars 1.2739802010675941808e-05 0.007246146587933918669 -2.265740805092889601e-05 -1.5236121180553410248 0.093387475645674775104 1.8479297186242829021 -49.490271729763087194 286.7387645553690163 252.78317601821959215 -0.0 0.0 0.3644000000000000017 -997.9376283354346323 -909.38573894978675416 1783.4600697011568969 -Jupiter 0.03769225108898567778 0.35525381666404283465 -0.00046732617030490929307 -5.203268729924161562 0.04848413524543258163 1.3035624911873560094 -100.51639734596980702 273.421918018626684 325.351028522703416 -0.0 0.0 0.27560000000000001164 --80.967241888586720104 -2387.9998942634933492 5008.7344122962876782 -Saturn 0.01128589982009127331 0.43764770913411007376 -0.00038925687730393611812 -9.581513697274186114 0.05248801962394190196 2.4862838811768979141 -113.59546767797320399 335.45662431368151601 228.84653123700309152 -0.0 0.0 0.22000000000000000111 -441.9323685947327233 378.52918410105413535 5135.911248678291292 -Uranus 0.001723658947826773068 0.4699394560146697986 -0.00016953449859497231466 -19.24773626798451076 0.04408736292912442123 0.7704474968533898682 -74.09072726634606454 95.12631113857929677 237.66915583105441101 -0.0 0.0 0.23000000000000000999 --677.3000258209181323 -3008.109907190578637 -836.301326618569835 -Neptune 0.0020336100526728302882 0.7816500366521773358 -0.000164587904124493665 -30.297815841143489024 0.013873050398302080172 1.7688477929856469828 -131.74107055888509876 246.83916166351488641 334.07963351871291025 -0.0 0.0 0.23000000000000000999 -1231.0256802954641403 -2178.2009371051150557 2329.6179923847095223 -Planetesimal 3.646098141953443043e-07 0.0021579178542993813182 -7.585803886728505278e-06 -1.4833614415692299993 0.22741315975763076729 31.813233836229972695 -353.17976431207927135 140.04791609627329763 276.36980676609317698 -0.4000000000000000222 0.4000000000000000222 0.4000000000000000222 -0.0 0.0 0.0 -Planetesimal 3.646098141953443043e-07 0.0023146091557723819966 -7.585803886728505278e-06 -1.591071674547404724 0.20226306525263618163 1.0591008596928608299 -174.06697724512676473 335.3163306230074454 223.56527105994337035 -0.4000000000000000222 0.4000000000000000222 0.4000000000000000222 -0.0 0.0 0.0 -Planetesimal 3.646098141953443043e-07 0.0022981274462569030274 -7.585803886728505278e-06 -1.5797420809126441199 0.24741174618562222776 29.534567106616030685 -344.82468258123401483 161.14487195055056645 152.5251306953267374 -0.4000000000000000222 0.4000000000000000222 0.4000000000000000222 -0.0 0.0 0.0 -Planetesimal 3.646098141953443043e-07 0.0023375315639560956954 -7.585803886728505278e-06 -1.6068286304388843533 0.28919101512899575424 7.37565965800404566 -336.92026211210111342 206.23395515463789707 358.94392598114910697 -0.4000000000000000222 0.4000000000000000222 0.4000000000000000222 -0.0 0.0 0.0 -Planetesimal 3.646098141953443043e-07 0.0021752159010438748034 -7.585803886728505278e-06 -1.4952521887096372755 0.07630357603197107652 15.560677329970133087 -226.73360615217720238 40.68010911926434403 329.55798685742456655 -0.4000000000000000222 0.4000000000000000222 0.4000000000000000222 -0.0 0.0 0.0 diff --git a/examples/symba_hungarias/swiftest/control_pl/hungarias_5pl_500tp_17_sun_MsunAUYR.in b/examples/symba_hungarias/swiftest/control_pl/hungarias_5pl_500tp_17_sun_MsunAUYR.in deleted file mode 100644 index b2cb85c35..000000000 --- a/examples/symba_hungarias/swiftest/control_pl/hungarias_5pl_500tp_17_sun_MsunAUYR.in +++ /dev/null @@ -1,7 +0,0 @@ -Sun -39.476926408897626 -0.004650467260962157 -4.7535806948127355e-12 --2.2473967953572827e-18 -0.0 0.0 0.07 -11.209306302144773 -38.759372036774764 82.25088158389266 diff --git a/examples/symba_hungarias/swiftest/control_pl/hungarias_5pl_500tp_17_tp.in b/examples/symba_hungarias/swiftest/control_pl/hungarias_5pl_500tp_17_tp.in deleted file mode 100644 index 573541ac9..000000000 --- a/examples/symba_hungarias/swiftest/control_pl/hungarias_5pl_500tp_17_tp.in +++ /dev/null @@ -1 +0,0 @@ -0 diff --git a/examples/symba_hungarias/swiftest/control_planets/hungarias_5pl_500tp_17_param.in b/examples/symba_hungarias/swiftest/control_planets/hungarias_5pl_500tp_17_param.in deleted file mode 100644 index ba1fb3c2b..000000000 --- a/examples/symba_hungarias/swiftest/control_planets/hungarias_5pl_500tp_17_param.in +++ /dev/null @@ -1,38 +0,0 @@ -! VERSION Swiftest parameter input -T0 0.0 -TSTOP 200000000.0 -DT 0.005 -ISTEP_OUT 200000 -ISTEP_DUMP 200000 -OUT_FORM XVEL -OUT_TYPE NETCDF_DOUBLE -OUT_STAT REPLACE -IN_TYPE ASCII -PL_IN hungarias_5pl_500tp_17_pl.in -TP_IN hungarias_5pl_500tp_17_tp.in -CB_IN hungarias_5pl_500tp_17_sun_MsunAUYR.in -BIN_OUT hungarias_5pl_500tp_17_out.nc -CHK_QMIN -1.0 -CHK_RMIN -1.0 -CHK_RMAX 1000.0 -CHK_EJECT 1000.0 -CHK_QMIN_COORD HELIO -CHK_QMIN_RANGE -1.0 -1.0 -MU2KG 1.988409870698051e+30 -TU2S 31557600.0 -DU2M 149597870700.0 -IN_FORM EL -EXTRA_FORCE NO -PARTICLE_OUT hungarias_5pl_500tp_17_particle.dat -BIG_DISCARD NO -CHK_CLOSE YES -RHILL_PRESENT YES -FRAGMENTATION NO -ROTATION YES -TIDES NO -ENERGY YES -GR YES -INTERACTION_LOOPS ADAPTIVE -ENCOUNTER_CHECK ADAPTIVE -ENERGY_OUT hungarias_5pl_500tp_17_energy.dat -GMTINY 3.646098141953443043e-08 diff --git a/examples/symba_hungarias/swiftest/control_planets/hungarias_5pl_500tp_17_pl.in b/examples/symba_hungarias/swiftest/control_planets/hungarias_5pl_500tp_17_pl.in deleted file mode 100644 index cd9d16020..000000000 --- a/examples/symba_hungarias/swiftest/control_planets/hungarias_5pl_500tp_17_pl.in +++ /dev/null @@ -1,49 +0,0 @@ -8 -Mercury 6.553709809565314146e-06 0.0014751274117575772341 -1.6306381826061645943e-05 -0.38709894990924181846 0.20562369687869339052 7.0036069691825035832 -48.302897646473702764 29.190213908309409874 163.69992642152809026 -0.0 0.0 0.34599999999999997424 -3.5735549824428292985 -18.380047749494480457 34.361526740492798437 -Venus 9.6633133995815381836e-05 0.006759122875155079725 -4.0453784346544178454e-05 -0.7233300630551103838 0.006773384545514573099 3.394505355540899938 -76.62090440289564697 55.183156101464518883 271.2285045598760007 -0.0 0.0 0.4000000000000000222 -0.17650282045605921225 -3.6612475825356215592 8.702866268072763821 -Earth 0.000120026935827952456416 0.010044657392872289059 -4.25875607065040958e-05 -0.99999328599172943033 0.01668004783869252855 0.0027793940989077428085 -175.84932558359508903 287.2227751976308241 324.72725799674782365 -0.0 0.0 0.33069999999999999396 -4.827962479462605839 0.034731626640621778608 2301.2114260455621944 -Mars 1.2739802010675941808e-05 0.007246146587933918669 -2.265740805092889601e-05 -1.5236121180553410248 0.093387475645674775104 1.8479297186242829021 -49.490271729763087194 286.7387645553690163 252.78317601821959215 -0.0 0.0 0.3644000000000000017 -997.9376283354346323 -909.38573894978675416 1783.4600697011568969 -Jupiter 0.03769225108898567778 0.35525381666404283465 -0.00046732617030490929307 -5.203268729924161562 0.04848413524543258163 1.3035624911873560094 -100.51639734596980702 273.421918018626684 325.351028522703416 -0.0 0.0 0.27560000000000001164 --80.967241888586720104 -2387.9998942634933492 5008.7344122962876782 -Saturn 0.01128589982009127331 0.43764770913411007376 -0.00038925687730393611812 -9.581513697274186114 0.05248801962394190196 2.4862838811768979141 -113.59546767797320399 335.45662431368151601 228.84653123700309152 -0.0 0.0 0.22000000000000000111 -441.9323685947327233 378.52918410105413535 5135.911248678291292 -Uranus 0.001723658947826773068 0.4699394560146697986 -0.00016953449859497231466 -19.24773626798451076 0.04408736292912442123 0.7704474968533898682 -74.09072726634606454 95.12631113857929677 237.66915583105441101 -0.0 0.0 0.23000000000000000999 --677.3000258209181323 -3008.109907190578637 -836.301326618569835 -Neptune 0.0020336100526728302882 0.7816500366521773358 -0.000164587904124493665 -30.297815841143489024 0.013873050398302080172 1.7688477929856469828 -131.74107055888509876 246.83916166351488641 334.07963351871291025 -0.0 0.0 0.23000000000000000999 -1231.0256802954641403 -2178.2009371051150557 2329.6179923847095223 diff --git a/examples/symba_hungarias/swiftest/control_planets/hungarias_5pl_500tp_17_sun_MsunAUYR.in b/examples/symba_hungarias/swiftest/control_planets/hungarias_5pl_500tp_17_sun_MsunAUYR.in deleted file mode 100644 index b2cb85c35..000000000 --- a/examples/symba_hungarias/swiftest/control_planets/hungarias_5pl_500tp_17_sun_MsunAUYR.in +++ /dev/null @@ -1,7 +0,0 @@ -Sun -39.476926408897626 -0.004650467260962157 -4.7535806948127355e-12 --2.2473967953572827e-18 -0.0 0.0 0.07 -11.209306302144773 -38.759372036774764 82.25088158389266 diff --git a/examples/symba_hungarias/swiftest/control_planets/hungarias_5pl_500tp_17_tp.in b/examples/symba_hungarias/swiftest/control_planets/hungarias_5pl_500tp_17_tp.in deleted file mode 100644 index 573541ac9..000000000 --- a/examples/symba_hungarias/swiftest/control_planets/hungarias_5pl_500tp_17_tp.in +++ /dev/null @@ -1 +0,0 @@ -0 diff --git a/examples/symba_hungarias/swiftest/control_tp/hungarias_5pl_500tp_17_param.in b/examples/symba_hungarias/swiftest/control_tp/hungarias_5pl_500tp_17_param.in deleted file mode 100644 index ba1fb3c2b..000000000 --- a/examples/symba_hungarias/swiftest/control_tp/hungarias_5pl_500tp_17_param.in +++ /dev/null @@ -1,38 +0,0 @@ -! VERSION Swiftest parameter input -T0 0.0 -TSTOP 200000000.0 -DT 0.005 -ISTEP_OUT 200000 -ISTEP_DUMP 200000 -OUT_FORM XVEL -OUT_TYPE NETCDF_DOUBLE -OUT_STAT REPLACE -IN_TYPE ASCII -PL_IN hungarias_5pl_500tp_17_pl.in -TP_IN hungarias_5pl_500tp_17_tp.in -CB_IN hungarias_5pl_500tp_17_sun_MsunAUYR.in -BIN_OUT hungarias_5pl_500tp_17_out.nc -CHK_QMIN -1.0 -CHK_RMIN -1.0 -CHK_RMAX 1000.0 -CHK_EJECT 1000.0 -CHK_QMIN_COORD HELIO -CHK_QMIN_RANGE -1.0 -1.0 -MU2KG 1.988409870698051e+30 -TU2S 31557600.0 -DU2M 149597870700.0 -IN_FORM EL -EXTRA_FORCE NO -PARTICLE_OUT hungarias_5pl_500tp_17_particle.dat -BIG_DISCARD NO -CHK_CLOSE YES -RHILL_PRESENT YES -FRAGMENTATION NO -ROTATION YES -TIDES NO -ENERGY YES -GR YES -INTERACTION_LOOPS ADAPTIVE -ENCOUNTER_CHECK ADAPTIVE -ENERGY_OUT hungarias_5pl_500tp_17_energy.dat -GMTINY 3.646098141953443043e-08 diff --git a/examples/symba_hungarias/swiftest/control_tp/hungarias_5pl_500tp_17_pl.in b/examples/symba_hungarias/swiftest/control_tp/hungarias_5pl_500tp_17_pl.in deleted file mode 100644 index cd9d16020..000000000 --- a/examples/symba_hungarias/swiftest/control_tp/hungarias_5pl_500tp_17_pl.in +++ /dev/null @@ -1,49 +0,0 @@ -8 -Mercury 6.553709809565314146e-06 0.0014751274117575772341 -1.6306381826061645943e-05 -0.38709894990924181846 0.20562369687869339052 7.0036069691825035832 -48.302897646473702764 29.190213908309409874 163.69992642152809026 -0.0 0.0 0.34599999999999997424 -3.5735549824428292985 -18.380047749494480457 34.361526740492798437 -Venus 9.6633133995815381836e-05 0.006759122875155079725 -4.0453784346544178454e-05 -0.7233300630551103838 0.006773384545514573099 3.394505355540899938 -76.62090440289564697 55.183156101464518883 271.2285045598760007 -0.0 0.0 0.4000000000000000222 -0.17650282045605921225 -3.6612475825356215592 8.702866268072763821 -Earth 0.000120026935827952456416 0.010044657392872289059 -4.25875607065040958e-05 -0.99999328599172943033 0.01668004783869252855 0.0027793940989077428085 -175.84932558359508903 287.2227751976308241 324.72725799674782365 -0.0 0.0 0.33069999999999999396 -4.827962479462605839 0.034731626640621778608 2301.2114260455621944 -Mars 1.2739802010675941808e-05 0.007246146587933918669 -2.265740805092889601e-05 -1.5236121180553410248 0.093387475645674775104 1.8479297186242829021 -49.490271729763087194 286.7387645553690163 252.78317601821959215 -0.0 0.0 0.3644000000000000017 -997.9376283354346323 -909.38573894978675416 1783.4600697011568969 -Jupiter 0.03769225108898567778 0.35525381666404283465 -0.00046732617030490929307 -5.203268729924161562 0.04848413524543258163 1.3035624911873560094 -100.51639734596980702 273.421918018626684 325.351028522703416 -0.0 0.0 0.27560000000000001164 --80.967241888586720104 -2387.9998942634933492 5008.7344122962876782 -Saturn 0.01128589982009127331 0.43764770913411007376 -0.00038925687730393611812 -9.581513697274186114 0.05248801962394190196 2.4862838811768979141 -113.59546767797320399 335.45662431368151601 228.84653123700309152 -0.0 0.0 0.22000000000000000111 -441.9323685947327233 378.52918410105413535 5135.911248678291292 -Uranus 0.001723658947826773068 0.4699394560146697986 -0.00016953449859497231466 -19.24773626798451076 0.04408736292912442123 0.7704474968533898682 -74.09072726634606454 95.12631113857929677 237.66915583105441101 -0.0 0.0 0.23000000000000000999 --677.3000258209181323 -3008.109907190578637 -836.301326618569835 -Neptune 0.0020336100526728302882 0.7816500366521773358 -0.000164587904124493665 -30.297815841143489024 0.013873050398302080172 1.7688477929856469828 -131.74107055888509876 246.83916166351488641 334.07963351871291025 -0.0 0.0 0.23000000000000000999 -1231.0256802954641403 -2178.2009371051150557 2329.6179923847095223 diff --git a/examples/symba_hungarias/swiftest/control_tp/hungarias_5pl_500tp_17_sun_MsunAUYR.in b/examples/symba_hungarias/swiftest/control_tp/hungarias_5pl_500tp_17_sun_MsunAUYR.in deleted file mode 100644 index b2cb85c35..000000000 --- a/examples/symba_hungarias/swiftest/control_tp/hungarias_5pl_500tp_17_sun_MsunAUYR.in +++ /dev/null @@ -1,7 +0,0 @@ -Sun -39.476926408897626 -0.004650467260962157 -4.7535806948127355e-12 --2.2473967953572827e-18 -0.0 0.0 0.07 -11.209306302144773 -38.759372036774764 82.25088158389266 diff --git a/examples/symba_hungarias/swiftest/control_tp/hungarias_5pl_500tp_17_tp.in b/examples/symba_hungarias/swiftest/control_tp/hungarias_5pl_500tp_17_tp.in deleted file mode 100644 index f4ba244e1..000000000 --- a/examples/symba_hungarias/swiftest/control_tp/hungarias_5pl_500tp_17_tp.in +++ /dev/null @@ -1,1501 +0,0 @@ -500 -TestParticle -1.8454769027014339411 0.13951119042459186881 25.837798047275626345 -328.17117785206306735 237.2860880034895672 64.23008023926446697 -TestParticle -1.8948047399930760815 0.39253684339890981825 30.57401904357708844 -171.8160167926455415 74.67067835186652758 346.82539114732162489 -TestParticle -1.4322956873029448754 0.26682998123758877584 36.888797433998760766 -135.67836179139501951 49.89780708941236753 50.12940813296061293 -TestParticle -1.5422738860284694873 0.37685139101297421282 19.245291067203744717 -242.6056203622448777 190.34039186776647057 265.5775848896740854 -TestParticle -1.4000225346968613316 0.29255853399659431657 19.890767084525684538 -119.10518346196536754 348.49038108835299 47.293501598324468205 -TestParticle -1.456396703278512561 0.21606816556140612251 29.008692147879436618 -108.30731953608933793 221.35606614343436149 135.6522448644592771 -TestParticle -1.4991966146428574724 0.2669401594934397437 30.077755049056197123 -191.15663442447419129 222.38194219090249248 69.087779756302211354 -TestParticle -1.2976220185588704936 0.2964166811906516763 17.074990789432430205 -304.33208099940674174 258.6470139846816778 322.57928297363247339 -TestParticle -1.2284058459883253622 0.02114032275754222992 21.48034199376179032 -253.91897753388707315 121.66008318006832667 48.90451689677965419 -TestParticle -1.3491703154567693534 0.12631152383406446527 12.08570156851411781 -94.79536576066179521 143.49729046755351192 208.82266091055907964 -TestParticle -1.354548306636307764 0.30813073753578051894 26.385704559503864175 -9.340695923175923454 140.9062990975310754 128.60525944669927867 -TestParticle -1.4726763914941964906 0.051608113984077212677 23.16805302210511286 -60.87571895315940651 37.85205814142705094 334.24673224972650587 -TestParticle -1.5463324166991267994 0.049680078831149866725 2.1376306166210978787 -220.16008032774595904 11.76294270807032305 189.70726088424217437 -TestParticle -1.8424848789863070841 0.22250945291262835823 31.15994606422547264 -200.26190393952850854 90.472365503047569746 91.504582635979360816 -TestParticle -1.3344201535197020014 0.22773738327276721316 26.57752464191161934 -153.96142537752339763 186.86606427694519539 35.556703962561442722 -TestParticle -1.9184874234026485507 0.023481756935774280443 35.397883111232822273 -271.86866710708176242 55.05965672749781703 149.58202579969920976 -TestParticle -1.5321856218987717213 0.3979302949006976453 2.3033304058957959626 -1.0080751214383187886 229.5039187263292888 149.08850733126683963 -TestParticle -1.8579680598185155382 0.22191671822921349433 4.132202808256058013 -84.407322217061448555 105.02111083305797479 146.60404199861849861 -TestParticle -1.8191335218869923995 0.081164276322499742666 2.5841250683973493452 -159.5912052269758874 90.717444711181698835 52.736155424681527393 -TestParticle -1.3667350901122115037 0.040168371245059432406 21.275121073210776501 -354.85336821525999085 78.43154031841972085 317.9997578721723812 -TestParticle -1.211310325452651826 0.22495050228658303171 6.171244471860548586 -261.19666701924728613 72.22571277624209074 188.79752520382470493 -TestParticle -1.5325985395295633751 0.31279786859050073833 20.80765006283890628 -318.17303457104600284 237.18051290105893258 171.10337432510698363 -TestParticle -1.8680074840187885776 0.2359667145186353232 3.4681761306941005785 -200.43760942249792834 358.90361110235892284 209.24526446322295214 -TestParticle -1.8902919155434694254 0.083578216274719355217 21.112558775866592242 -196.8514015184809125 347.4309841941474133 73.29619835953663198 -TestParticle -1.3627905330289311614 0.099888583939379896326 10.927033380075510394 -304.94152566655765213 199.55238917120914266 66.700355986912740036 -TestParticle -1.6040569601728904559 0.0037929451167165065088 35.906866500389931218 -99.48570161019421221 264.107310263435636 196.91578900528253371 -TestParticle -1.5861188083181421149 0.12827049258664038889 4.433072269138715882 -250.35776905499878353 45.94314631274010452 78.766936071707490896 -TestParticle -1.8085832921727800215 0.38738844761580382148 38.482814871600758977 -59.61087191956130482 302.66582104517908647 337.43444136948141931 -TestParticle -1.4784945066780474932 0.02330664972959981679 24.805661482861435019 -161.3343149737517308 260.74004269183234328 332.58410511792851594 -TestParticle -1.2147867771614853094 0.16512447645289687892 26.704102750300808822 -342.71215159236965064 303.68316149292064665 267.30686157877283904 -TestParticle -1.2201597354758311198 0.29779565538112623413 9.5137682254248456815 -191.53033272117548336 279.0125127827463416 212.78518850631689929 -TestParticle -1.6306412809893466864 0.17831015307074157827 3.1250419675817919796 -35.17124037365346112 108.44038602029890228 289.87991262900078482 -TestParticle -1.2151606182820764435 0.030818630012030868992 15.255139624036321067 -18.872922094318155928 231.7787216922804987 114.00766773514217789 -TestParticle -1.263893046608108861 0.2365742775318666613 11.945519016269416923 -42.860493283933593034 103.96603523733477914 283.38829024952065083 -TestParticle -1.6208609899851271763 0.084237547629803233296 12.70952077968544458 -283.22127471251508268 16.774057774443846824 300.16022765529646676 -TestParticle -1.369439844040318377 0.02479558882423171795 12.8318676295292597445 -301.63112212878189666 317.34595898371384237 30.617048625074787083 -TestParticle -1.5997694540834734855 0.09458558350377295476 19.448014834633401193 -12.1917196597836952066 3.3679767469261356894 154.78568082871979072 -TestParticle -1.7665402755717471983 0.30325026057285930925 27.633560559304825688 -101.32565005973741279 173.42784439679959974 37.232060344515574002 -TestParticle -1.9955375108845494481 0.36780600821797326816 31.984293078717442427 -282.80116122029363623 340.83055441100248117 39.611552110590793063 -TestParticle -1.8068990906750328485 0.21026617244057629885 1.0616116239923245601 -148.12562556977400163 298.30253571723386585 39.94475612648128049 -TestParticle -1.6630081107132843599 0.2735942970781838346 20.393789507385111648 -186.34515293922132173 65.17268953054855274 249.5770342523899501 -TestParticle -1.7985429554004617181 0.32088199656574384333 3.421215620948947489 -16.760921442599428843 74.095210179753522084 131.64141600391005227 -TestParticle -1.4370805125444752193 0.33325879590334600566 29.297209939601689399 -179.87886700027897291 9.64820682838999133 185.83130754139918395 -TestParticle -1.4655739620290153535 0.017666725980597774298 15.194095015809558902 -272.98954032167330297 58.084307572382229523 205.40990717491945361 -TestParticle -1.8476543863511110111 0.38915614646375812358 11.917542586934226634 -134.42337723208845546 335.9708646376130332 1.2971084841705504687 -TestParticle -1.4590877868615714785 0.00229625206779173743 3.1321552894228821273 -234.02046406252858901 255.12979045887780671 16.475368403924544936 -TestParticle -1.3888300055647480047 0.04773585409741545882 20.980957411518524225 -232.75615771007392141 269.83840631297238133 128.91250646333895702 -TestParticle -1.9931456375147125204 0.36812801925517474322 8.575906190939374341 -75.54998759463583724 336.19060016425089543 128.81172294803698719 -TestParticle -1.8774492133690419138 0.3438244675687084917 23.038981078440741612 -9.8914055387747712444 56.58764160659445963 274.986529163730836 -TestParticle -1.3204375538736723428 0.08737144541036796774 29.974540925371840672 -221.62895491427303796 180.74872085610940076 337.40135640751742585 -TestParticle -1.7927656300808507694 0.117314349174642992835 19.184850306121404628 -206.67799209022632567 27.751086824061687253 298.02149638567931333 -TestParticle -1.7770751091671890265 0.19250351376309945972 9.172954305563960631 -43.26806500508915576 40.25028641050728595 238.70170337404292127 -TestParticle -1.974616589119178478 0.34407442172588997842 9.802858566374489158 -297.25364573770326615 87.77531802870282718 75.66951173963438748 -TestParticle -1.3863166307158814039 0.076685155941225657816 27.402627668756696977 -65.08259549484182571 164.8638775674021133 100.45589134667613962 -TestParticle -1.865440866859517488 0.1196471086364425257 11.945324988836505398 -268.187594819792821 223.64720186520361267 29.40940210460087556 -TestParticle -1.924611171111724417 0.20112445232693854091 27.71898676703103348 -318.34445645026778493 191.25112555799532288 349.89422766228875616 -TestParticle -1.5993892099645203864 0.10968442780595713537 9.326690310948993812 -31.533935713187357663 310.02898225335894722 210.51997485541662058 -TestParticle -1.2359382488484538243 0.32658357473851062913 38.707976308555153366 -144.00217869231852319 119.06805794770258444 79.384200277529473055 -TestParticle -1.6109049166063780234 0.038297945827820673026 19.543826335927839466 -187.13697315293387646 257.17832502585736165 137.87766714187893058 -TestParticle -1.4314628393318562516 0.06605107757031168647 34.48524969280026653 -261.32336202719972107 132.91845049023550018 38.845354985336733478 -TestParticle -1.6270574875899108669 0.34703206127568098083 15.7198484814636287865 -347.55110983950402215 301.80674145531685326 112.25474179150697296 -TestParticle -1.2336395323546296421 0.09729394203067305569 5.1016432554912771735 -233.12366663108903708 146.38256752560837981 198.90738568911748985 -TestParticle -1.3456767380773657639 0.0037474665741684012703 39.938234490697439583 -256.57759604724572 75.054619437472723575 358.3650510442133168 -TestParticle -1.5755427111046413913 0.26176654357687628716 8.3705428253832359076 -37.517264866504824283 65.328654571322900324 91.55626866074713632 -TestParticle -1.6755570822166401257 0.13402717291758836637 24.063895956419415256 -13.799270685071709508 72.62055343894668624 87.31894896673983908 -TestParticle -1.5559490988866435668 0.15176826381840774483 38.48111346610262018 -256.2333379875098558 75.97800331031197629 59.41813313856062706 -TestParticle -1.44994652075586683 0.33986546456988747655 24.751134550954795088 -232.18945993885864709 196.68218102285592863 134.45246030705607154 -TestParticle -1.8429185809905443971 0.017095748280579449452 37.139787427802218645 -161.43471520401584485 307.27501647662722917 355.50902004252696997 -TestParticle -1.8754638534803846905 0.012020551314167439438 25.689663713162978809 -190.79044364156195002 199.61943428385487209 354.13757823278496062 -TestParticle -1.6785085343609076336 0.092751885821403062815 9.210612929641403213 -285.5852225501039925 151.86743084166838003 284.55869958326974256 -TestParticle -1.6543220378661067649 0.21134650270613800083 33.840207882222927083 -304.1335703446064258 326.82908020011677763 324.19035648687139428 -TestParticle -1.532142838634183768 0.38007507167758092237 0.41347334753230935434 -67.05133558163640828 34.399290053628249098 34.840294234675972973 -TestParticle -1.5607062121608026306 0.33781855969656376937 8.967843423326943508 -299.3643723824862377 200.63715648972143413 68.959909224159687824 -TestParticle -1.4493452438508076519 0.0685471748773834183 8.6320194163908645635 -72.080624314054560386 115.122237950328312195 0.4079154529894424286 -TestParticle -1.6460340581063395149 0.39668168452346741493 20.981074587513283802 -204.3451792276263177 201.37614636656564926 213.30860176845612841 -TestParticle -1.5920263567710581931 0.25848484530126630832 37.015946260712674132 -127.874562568991194667 65.19741011690945243 94.70447850395582634 -TestParticle -1.7336512363309442009 0.07029270812373322741 2.7619103909209741232 -186.8230602145383159 227.39378660430725176 98.630627655617857386 -TestParticle -1.2180382444813300236 0.3142235003505371993 28.081856084101627147 -111.345098722858793394 55.920002664921518942 282.87486367297071865 -TestParticle -1.6485319714902004762 0.3152277024193525512 9.613333711481617527 -294.21829832085342105 286.30105207001298595 128.67843292368630159 -TestParticle -1.4661249318513216444 0.05768902442216044396 0.40134055259916312508 -131.60830524837382427 243.75402215940340511 207.34266824752899083 -TestParticle -1.9808876352137643195 0.14308188258148502037 1.4378912336896432222 -80.646845170624999355 231.53252144735679963 232.24754717746816368 -TestParticle -1.2317104124445219515 0.2601604050852836525 0.45344055155487783537 -196.60019387641727917 281.28440095008312483 247.80040663000707468 -TestParticle -1.9766606334273690848 0.34561610666945052905 23.435434834980789276 -34.473035596172188377 271.1594424183512615 48.466138898201464258 -TestParticle -1.902283887520531902 0.11209856668107276434 36.03239655947709963 -294.40684092368923075 270.02199923071918874 114.382104661423511516 -TestParticle -1.6492323095244016962 0.15893979864294510707 37.659784271934086064 -104.66474319501168111 339.31942052690538958 216.02473301930888283 -TestParticle -1.3484148267391067311 0.21111072648635398341 10.89667366492733791 -291.56591682201212734 76.70162083026228572 312.33817224861377326 -TestParticle -1.4294351818194139803 0.088023727454350997323 39.975651469559892348 -198.68831704157523177 24.599669214308292453 112.67218982565516683 -TestParticle -1.7462490440076519072 0.37071438804152889723 21.870120107958371136 -306.73669065023256053 227.86908802150850306 221.53115484665687518 -TestParticle -1.2326287663421375829 0.38251042858385364553 15.802748366587309192 -199.40278420565533679 149.69869717845381274 315.67560896416114247 -TestParticle -1.8450862453370659999 0.35823810152470403345 0.24296995062495163609 -231.11355647090658749 268.36408970924156847 247.20131497380242536 -TestParticle -1.3463306194321635889 0.054152156717265725883 19.291673537548810202 -161.87111271376406307 110.46662751206984865 211.17562619004070257 -TestParticle -1.7304729990392044847 0.0060363382745066036794 4.5425988088905189244 -83.83165898233737323 161.12905358043980186 286.6647995328502816 -TestParticle -1.272415258736352639 0.34812105948963872892 35.045494396081245725 -14.574000729875393745 353.3713665259786012 131.5433867402096837 -TestParticle -1.6439273487752854574 0.36545065070539850538 6.353634441759323792 -208.14453818563018217 10.813063425795590433 206.06730287545840952 -TestParticle -1.6763079933342956984 0.094138501830316120844 9.085159707293687603 -80.58871476637817466 314.0368013316636393 100.690960685859835166 -TestParticle -1.4877140448295171904 0.16166761889883485281 34.241465691047999087 -79.8410863542756033 83.93580251433438377 326.42504725591442138 -TestParticle -1.2162284372972316238 0.0041396912261435492297 18.10971019209766908 -119.24015567046335207 329.67281909144981 104.828869567280364095 -TestParticle -1.8047735542382463692 0.33749016396948239294 0.52972364011479644574 -178.94392698813351217 299.23756071934496958 162.62104380151879468 -TestParticle -1.5839648306862472715 0.10066137160625268643 33.26828317225646714 -263.27920251880794922 68.67162164080139064 57.290691877799474696 -TestParticle -1.782207613297600135 0.28298109588186182162 35.127393670730072017 -210.15608294480230711 329.15212439443854464 156.34171670624388639 -TestParticle -1.3155167265331972892 0.3723026355627080397 31.9899066241260428 -91.31036979040656831 223.20537501312867334 55.827047719351739374 -TestParticle -1.5449962589928503132 0.042895131418722920458 19.621615335811604552 -53.274917868286941314 105.38186162729587636 323.020751462690896 -TestParticle -1.5754411317280814231 0.34816180369684263107 4.7678217298113434452 -120.95128002085144203 157.00930158977180895 240.29746717057042815 -TestParticle -1.5907469291141598244 0.1964357827791012312 32.411571541856559975 -170.61499094134663324 242.1650203501031342 17.501615221478704854 -TestParticle -1.830089894183755117 0.1183426089423230132 39.644525581214999477 -294.65378437812546508 109.07115594302160844 324.16241183209581322 -TestParticle -1.4367780052388956502 0.36401192064177911867 30.631206179017613778 -68.80265368578432117 273.93063220366155974 24.29554655983004352 -TestParticle -1.2142291174104986595 0.26599477562223389215 38.323418486729934784 -308.15266716976327643 181.95454939706644382 25.317934141736472498 -TestParticle -1.3097560558867786806 0.27086655670790987793 26.727111485760552512 -202.01817831967753136 111.97198753257944759 220.9572217341067244 -TestParticle -1.7068002319397266309 0.13225077417056724238 27.615823462695185952 -285.91192474987235528 163.31636137404424858 93.38394269951035653 -TestParticle -1.2055264990732839081 0.30786309414395046646 1.0578708063967390274 -10.359167032075170312 91.437369236993205845 199.49137469503560283 -TestParticle -1.507944679481377559 0.24354603379899894544 13.546984987329334871 -57.02677054315793015 348.2783664994595938 271.03255123935065285 -TestParticle -1.2000480949162781741 0.37393642722973008397 23.203234027939288353 -10.544426197782676979 54.256441116884829512 254.63780531903708493 -TestParticle -1.7449420987438828412 0.24948442565304040919 27.500692921539069857 -95.99564887831238025 273.51317842100650068 326.03984845413532412 -TestParticle -1.3765488182504534986 0.030416876982825514358 31.70464034258963082 -275.78595003182448409 133.87458225546748736 226.00553898246667472 -TestParticle -1.2429016633522536051 0.20958324622273286075 37.67591956683881449 -291.1872246516109044 179.51252843010638571 313.71221570905379394 -TestParticle -1.350836711566139936 0.37146863516149991602 10.648022816293165604 -303.44796444885918163 189.14789607745939293 51.43707686446851568 -TestParticle -1.3606071504125110128 0.33726059408562408803 29.623948782469774699 -174.22516541583135563 294.25596249059782394 95.41136217835122579 -TestParticle -1.2613426667283003102 0.28493782233230641188 2.8418286626483357793 -28.660785941482401995 87.50329638280636857 62.24419865756345871 -TestParticle -1.7174163570319429528 0.3032422501079781174 15.67069716211129915 -199.70972264612359481 32.767912430781642286 213.64123907162533555 -TestParticle -1.7458843970753306074 0.11283265730661723447 31.014841487303186796 -100.348702433335944306 70.42890181497725166 181.6379350423849246 -TestParticle -1.5856984450767472872 0.12800000166780992061 31.429108868252029652 -51.353858554652823898 23.612627758947475343 267.08391560632128403 -TestParticle -1.7153544980924069208 0.009492334383937130193 23.973160269033186864 -225.8121095708202688 166.53019043018878165 111.264606624241494615 -TestParticle -1.5026214783945404108 0.0060590469509819834884 26.922409196875427995 -295.19858318066900438 267.2316600455114326 164.01625566186100968 -TestParticle -1.9160661225785111661 0.2687972938601586037 36.621056515844763624 -334.838998311582543 64.064850181025448705 189.01682882741042135 -TestParticle -1.2176400162982947695 0.34785736514134202313 33.268864900617138858 -225.50438622677125977 227.27950095352301219 349.3797741235012495 -TestParticle -1.2273892818311689101 0.2816869543044054902 29.30501713210593806 -5.1819190308878404494 2.980732803128396391 210.95489861072306326 -TestParticle -1.3751089556704734207 0.2405885452138842584 36.06217993351511808 -199.72275209903938276 20.656954375719962513 63.697518910616103938 -TestParticle -1.5607369467841181176 0.07255978851264624496 7.9579329131271947517 -171.37467949380453547 212.58991825508687157 339.50383959100975062 -TestParticle -1.9532502979079398031 0.32689490765476852951 28.253212569212344363 -181.63986801834479934 358.1359989621613522 109.388744074059957256 -TestParticle -1.6386262719092012929 0.3843259001434648492 30.427684580834899464 -231.68744967547161195 57.857403700081057707 50.909305856223930675 -TestParticle -1.9782962700915884824 0.107957633562424437645 12.967168829872832703 -304.82496750248236594 137.36222813798312359 43.932431234771847528 -TestParticle -1.456906303967715921 0.14977091087281488302 11.183659205458482688 -73.40451433078203536 248.31190118288742497 75.220198402857562314 -TestParticle -1.2534896538060293913 0.32164641810767541363 3.6905727779895203255 -113.638768774667383354 40.160334282501267467 312.87037322501493009 -TestParticle -1.3014118589240171175 0.2335136721159586648 25.377666434917763638 -52.35427893272325406 9.000303326532378634 144.16353907228875642 -TestParticle -1.349118336295686893 0.043025081648941171375 4.3612305774961734883 -243.8860202407295219 2.8265136490351139287 103.60819968189791496 -TestParticle -1.3275933491849711832 0.30130671835155509175 9.869222679372882112 -140.91605869565009357 6.9406462242691979725 239.80228459696834875 -TestParticle -1.6818942627306852078 0.31620420657586079116 20.559233470145720446 -58.349404997197098055 117.22724335851061994 205.33268031856118796 -TestParticle -1.9852083696659352796 0.013418902816453127241 34.384158548277603984 -115.09964166928982365 93.38072290721305535 50.024657651717582496 -TestParticle -1.5693995761001753309 0.16001215059117473993 34.5933607052273544 -148.74442398288778122 35.382707682911650693 307.9784638941427488 -TestParticle -1.5266059802597138351 0.017927011927562432753 36.548915878020643788 -210.40292925773331945 201.71103729618005218 224.16233740901310512 -TestParticle -1.728092867591788595 0.17808919848065529745 20.998516569906101381 -308.92264952207932538 127.645229747456198766 161.89916144859373048 -TestParticle -1.6194915162303571421 0.12309065176675240694 11.294533006684988052 -54.678975810373955824 126.54242973288489793 198.90789595722705485 -TestParticle -1.3289490961949892434 0.29324085207912647943 30.6374181063208475 -269.87631534747202977 37.841881250480767562 348.01538484590025746 -TestParticle -1.992893537374311741 0.18673594337410803767 16.540817363482574365 -17.388276030638827763 78.86833627776049127 145.80382488854473877 -TestParticle -1.222299452110788831 0.30906300615816389987 12.345442063899700003 -306.8123712805751211 180.92912639536746155 259.40768755027107773 -TestParticle -1.4975645450575401085 0.33347394063389190766 1.5908406722909917974 -21.190900575813813589 29.47013297848204516 102.16591862721205075 -TestParticle -1.7529928369432026258 0.37348208125904397425 34.962456206016206295 -93.100816365900570304 51.110432866675402863 102.57164314281175166 -TestParticle -1.2425425262626379475 0.33615312037358630048 13.5646379554957707825 -178.52596605015196474 153.15866826328647221 144.53495382113527512 -TestParticle -1.6649955177303406018 0.2774227948724269921 0.19107601744351665474 -63.095836643914225306 354.85824120341573007 264.91047609564412824 -TestParticle -1.6484772171416994802 0.30267580759790019274 20.681865450161470932 -178.44791810461956061 236.1847171609527436 98.36374690667254583 -TestParticle -1.9932276245336744136 0.28313215139520719887 18.707112367987669188 -219.87647284127007197 126.12068590426943615 215.87266615210091913 -TestParticle -1.7032561164628601258 0.16397636271323282053 25.251751880173408438 -216.40546882883455737 157.48365299675131723 4.688955472432070337 -TestParticle -1.6688736346909214259 0.20206175633607201259 6.8253656041650678787 -216.49653061411731869 167.29352654167502124 264.9681676707442648 -TestParticle -1.8685421164356719181 0.017115665378235479788 37.702745220955684147 -341.22511657108503869 114.98911860271485352 180.97443389686239357 -TestParticle -1.2789089584183417347 0.38311485210375972876 34.310997435004189526 -320.3337196375490521 323.3381621809996318 259.21085923985185673 -TestParticle -1.6140662295704462093 0.22523087980360034788 31.289184028405010451 -342.24508460858135095 15.680010847649224814 231.38490121660879595 -TestParticle -1.9392715602121850527 0.15801671085680726869 28.474643946647489656 -130.88611486656463967 107.8187080577375383 123.51635573428578141 -TestParticle -1.2967745250719693306 0.06567169524305174755 33.95229338812422526 -290.63873117229752552 79.02208966627722475 232.82648238779003691 -TestParticle -1.5129927102068225775 0.035355940722157398748 39.88868697475624714 -192.95122284146495417 161.94702337269632153 136.8613631323482025 -TestParticle -1.6829217923833816872 0.25345881856811941502 11.3639096364677563145 -97.75123136727515316 45.772970150424697522 122.47944569483230737 -TestParticle -1.8496796135868087685 0.13179006688881342302 13.3337440463942780156 -265.13170996725159512 228.43295285296423458 86.46213418755671398 -TestParticle -1.3358066112403499393 0.14376027444378572384 39.375717961581145232 -157.40058260425848857 311.2848447975355839 331.54934076273463006 -TestParticle -1.4724981157763801232 0.09732120033570890172 28.321058818578286775 -59.894734856092107123 278.76518901350408441 80.89976806352470362 -TestParticle -1.2021644761475605012 0.31023967350442599455 28.526439154406524779 -141.17072146741031702 348.00301966689602295 345.1342457342993839 -TestParticle -1.5593994326172748721 0.1667781483451987734 33.654370780663562357 -266.88153921797828616 15.430552831803581171 331.4077165346525362 -TestParticle -1.2450357937715832435 0.028817230992748132934 35.27994061369459189 -170.88739535567884786 353.3811233168729018 235.24134924372253863 -TestParticle -1.9317961733915889333 0.3664316651845210826 24.216703033341396178 -53.371442738369651693 125.538665606108594375 100.18756180685251422 -TestParticle -1.6396980067944455506 0.35320738196817447196 38.908475459351436143 -246.96073709218802605 107.071264330560637745 337.8304256083255268 -TestParticle -1.7122870680368271756 0.33138468975426782492 22.34571124430782163 -41.625350595521808827 260.11274001626304653 319.5586433718779631 -TestParticle -1.7758391618474895779 0.055654577054355419685 14.384020683089943304 -218.7045008460380302 129.23569045343450057 314.73455478475153768 -TestParticle -1.8362854949156799389 0.17009562329070515574 9.220110348963054037 -5.6249185474454588274 94.48961934631255133 267.2078794777070243 -TestParticle -1.7334953226477165522 0.049544865778679184065 1.209613515173937337 -190.91534544660109418 64.56511824447872527 53.933623678817561142 -TestParticle -1.2066506827151026737 0.27307016461379868266 16.286012208431877468 -210.72290400454269843 4.9513407455376867716 217.19883427837939394 -TestParticle -1.9341836813541077866 0.31275777164344914505 21.744449246528134267 -16.671280260299788267 359.76195227232665275 224.80650775703034583 -TestParticle -1.2301271999661356205 0.031548406830605689455 39.849035058731047343 -90.34650036320888944 228.990784368342986 250.85529561169511226 -TestParticle -1.3410010761068889007 0.095083624572690483845 16.924908171363043152 -283.45379909314135602 86.752474366828209895 159.59709647132103782 -TestParticle -1.7698211243948773763 0.31273331984328978095 32.406541703763409146 -142.47083941877434654 108.934565017581746815 272.0311071315450704 -TestParticle -1.2184663095396561783 0.03812658809257066239 19.774618927626171683 -209.47233898474567582 217.91859195187419118 328.76297389338390076 -TestParticle -1.7206223471221142596 0.34602085721486458558 1.7719525390753965155 -165.06371680688690162 58.713339280074663407 131.55475352151159996 -TestParticle -1.3109621100006574324 0.1200549161067526599 35.241813901823853428 -280.10060451829298245 304.5154307276658301 258.67615548166588724 -TestParticle -1.890762195590066419 0.37035990280942132635 39.30878687557294171 -331.52556729751103148 337.10887406621617401 291.2002557551665518 -TestParticle -1.9459727148429868393 0.38159291851530796613 17.491010561827589953 -58.69944071533900143 205.64445683266583842 15.007877403052006571 -TestParticle -1.932411276121311472 0.04777930483056436195 25.073992516822389831 -121.57030712562516328 70.74439140769348455 289.9542940845957446 -TestParticle -1.5709963526669437073 0.10007382494413469276 31.19225199749002897 -25.663181434794644531 158.74882487098793149 349.24010777437848674 -TestParticle -1.335652850395929736 0.2682557203404010715 35.328293558121892204 -297.5826541744638689 60.254502441132032686 46.73892963602791184 -TestParticle -1.2957464098764572835 0.3440291712383192757 7.1735736922541004645 -59.24135447472242788 112.00172550339377153 63.553063734303997023 -TestParticle -1.3376569963037119315 0.3060189431378071423 33.029029350979975277 -152.73585490781837848 358.84231030107730476 37.635854669405638617 -TestParticle -1.771988403745682561 0.3418762364008507415 23.489318587551395012 -127.772934823946343386 203.78581662446330824 143.76143168311298837 -TestParticle -1.5956560402916708519 0.10759642083325884898 23.037334274387120558 -89.123439540602518605 335.80537435903943333 224.2944293252393777 -TestParticle -1.2213248137275627414 0.33273129495412528955 31.736197966218284705 -5.8113766822153190006 136.8878783815157476 64.522354495354704795 -TestParticle -1.5939091087487726739 0.18821654046060146137 30.731370977849337578 -266.58533763467028166 61.609425727717933796 18.235581197999763958 -TestParticle -1.7396585716134431721 0.33855494953671660951 29.449893101775622029 -180.02468739427200717 242.14518561194594781 286.10286226317128921 -TestParticle -1.282393302513987976 0.18117160916878405352 22.308223599873976184 -94.69043575838269078 120.90458523599184559 161.88428102391287666 -TestParticle -1.6814135190699217581 0.06566827687818244108 23.327233678731047917 -13.505074850212492876 48.75637107914376145 337.4546628636448986 -TestParticle -1.7657157709814490509 0.1428403447023711692 17.528150255810068359 -344.59038571613109525 139.36370104693307326 48.933862071120714177 -TestParticle -1.6903656227398606848 0.1881104051902828811 4.8333955434429443088 -225.1651227652955356 185.18882646555431393 132.21080070182574673 -TestParticle -1.994803202974419154 0.07010640681945860819 10.335500705227271823 -49.13850067137512667 6.4534592639328725028 80.823883651112907955 -TestParticle -1.3332640591247215678 0.06033190012542344327 21.035357456357957062 -97.733488288704805314 80.36567051536489714 46.55202086502264791 -TestParticle -1.6243595893431250765 0.19184864274731788791 3.8955991274805690239 -177.92659068814418788 143.40326100313114921 22.678654943892524898 -TestParticle -1.6823664970435372457 0.2224783311899178051 28.355960754425314718 -38.26291967170601538 109.90023925961423856 198.84047030132839495 -TestParticle -1.7191941261517613704 0.33174274738319786682 12.850948299491872007 -119.00419547116645447 97.60779700546201809 294.77008528831782996 -TestParticle -1.8572892923802768461 0.35111820477995814294 13.9604529367616514435 -90.00276864094306006 148.95323888923235245 105.97452396122218943 -TestParticle -1.3153721536816338489 0.19649899863576869574 15.0714118102473335625 -114.91054594701827796 42.412124805715073705 238.87013655434262205 -TestParticle -1.2329176043622995795 0.016982564457388795581 30.243701002322488591 -82.65191789811144929 330.6979385476704465 45.054558348890076047 -TestParticle -1.5821710473264454233 0.3143035815568485103 26.914241767154372553 -284.2538985550680195 218.88177874336824402 323.40347760377426312 -TestParticle -1.9040784761593252394 0.24428308876647972236 7.2140984856285061966 -36.905471182196343705 235.01221091601564694 318.38458893259758042 -TestParticle -1.65303582473123023 0.15480622128373774937 30.612597160930445028 -176.14307295689886246 344.8917806440758227 46.391668294041863874 -TestParticle -1.9906869462994456477 0.08417977136701382257 32.071163809129458855 -190.08888099464044785 12.337459747731131188 44.2017470332212028 -TestParticle -1.8765384210009301569 0.18365454827241262103 21.70846970886060845 -357.147106806575664 129.14807435709019501 12.280707552849744246 -TestParticle -1.4155101547192867617 0.04021447505437234643 9.344979114904226947 -15.0079117011066429654 104.10136849327774655 23.129488238006107537 -TestParticle -1.8212138878170127665 0.08047272581333581032 4.0968495722748254906 -174.58882187338159042 279.87646692565357398 23.324854698976157152 -TestParticle -1.7644240552946159895 0.028115303133601266677 37.495056810553286653 -118.13225365926875554 167.45393279647143459 34.012411764895496447 -TestParticle -1.4525677350618968475 0.30250405555180709394 17.82996354610970613 -220.00796720803919015 344.15563445760545846 123.14676507835467589 -TestParticle -1.548841766197246228 0.09540860671062662002 22.684926251185043355 -218.60911597389889494 90.33458573673138403 102.992143880334552364 -TestParticle -1.2079296534119159379 0.32769989355099571338 38.675927266126485904 -200.13361220962531206 158.78840734969233495 279.3835775172844933 -TestParticle -1.377134208847530239 0.24021816899861267447 9.0547885117482262984 -307.8373588937357681 250.70142057430294358 309.94009295835280682 -TestParticle -1.9686740753046718666 0.039229853667286734842 27.8754113045622951 -44.123357114694904624 256.01312835054108064 261.81824327677321662 -TestParticle -1.5814217806739057082 0.17335298748077404563 11.896107065940920933 -11.863952502714919746 24.317879056812333971 281.83737446678952665 -TestParticle -1.3875566874932281358 0.04186652452005912295 8.374003796839994962 -110.23215119957482955 294.56036703267886878 295.56595853737684365 -TestParticle -1.3902402383167473676 0.19593968424019078678 29.315181048510574158 -282.62385234829253022 324.77635841333739108 19.922520312932118003 -TestParticle -1.2840096543928043449 0.29990999639214999117 38.008971094948456937 -277.38971452757238012 208.06148201248271334 255.09629766073103951 -TestParticle -1.5591506829846155657 0.37436941724804151388 28.992037551395654305 -349.16296285001351407 325.2167596752620966 272.84514086043867565 -TestParticle -1.6470838643939573753 0.08288833139777805614 14.577369178129217175 -285.2260666698484215 331.09186078156602662 265.88764593799055547 -TestParticle -1.4078732644616405167 0.12168143435803764618 12.108634490395427719 -108.46688890223232704 161.29947110408681965 275.03585750375651742 -TestParticle -1.3806299194725459856 0.004926651150672434372 4.619034071475587311 -124.92525284958901466 247.86360149925218366 213.62866269117026263 -TestParticle -1.3192455632849615643 0.2895763215200138352 26.694213488950907731 -156.54596065699396945 129.81140517153278324 134.60446380394492394 -TestParticle -1.4439912056109245331 0.3898931766577775071 8.96508289894697441 -244.87528934455733065 193.64710431202621521 293.37512055758975293 -TestParticle -1.8635206283775769265 0.2795056553246003106 32.898054005194971694 -137.04912054787823195 287.93791057659291255 10.142083183616289688 -TestParticle -1.9812056783962854745 0.2247292940884803858 25.532351672534726816 -201.33822039314060248 254.90475216060337971 359.59652623258176618 -TestParticle -1.9116361511506723136 0.34944272223947114853 5.3334830645261233073 -165.89953551606566862 87.00762822041266986 286.54555713608760925 -TestParticle -1.2300510950958833956 0.09272681808089294764 6.1108306263088341126 -60.392041334648261852 166.06618730050502108 214.40030029409305712 -TestParticle -1.6587060971893274886 0.35283027123356813792 31.860313399205129059 -249.71240866151026694 222.43577149272385896 31.641338378167219503 -TestParticle -1.6042337378433173534 0.37025740688655151 17.202399535173533707 -87.81318396148407146 2.5620013176806422095 357.37399955588330158 -TestParticle -1.6471345300326571959 0.13620174045721983314 22.615216955031499424 -80.62529682810802001 69.592694813600971315 105.76774944494903252 -TestParticle -1.9072984229216274343 0.01501546063666405785 8.290907351796761304 -169.80316939963415734 18.043578597928426888 349.8451486157899808 -TestParticle -1.6906614679737514972 0.18058500638001656613 35.641943093270654686 -155.08172745880321486 318.8449035930426021 193.87642754894059749 -TestParticle -1.5896626347240321309 0.08039921506021037445 26.884736251329634626 -93.207751799271306936 291.57502433845007772 164.72382015911426834 -TestParticle -1.6992934898451703685 0.065201137301299824656 14.269610927403233447 -236.09727012824436088 254.53147047225508004 263.77965229044838225 -TestParticle -1.8538533648632840034 0.04766458860664664343 32.873078543951940844 -204.22879507518445052 106.636047257291238566 249.48280450502983285 -TestParticle -1.4212096807741136928 0.07499446462853280593 23.101996292119086007 -275.60817514452082833 213.13272785623379946 230.30352647630064666 -TestParticle -1.7510124795524912855 0.057099861992605485672 26.912262589245482758 -293.1635508220617794 35.9907631662996792 141.04718451469835827 -TestParticle -1.6563019761734052437 0.025865878674105769602 36.786210320613299984 -182.00701529286254754 302.4937526698793704 324.59294681664295013 -TestParticle -1.729605636071602337 0.11527751871838157194 8.269004569267789151 -347.6614584046645291 246.54991472345386683 257.4460526186617244 -TestParticle -1.5759605048363587443 0.11372511990649024349 2.1138568479458896832 -32.388292718466615838 301.59398434276658918 321.32099521949635346 -TestParticle -1.8344051151510727404 0.26899383835918777574 3.9802801398091425256 -84.71344253866337226 168.80695388443507454 259.706671920307258 -TestParticle -1.9193495257732000603 0.3433984358229728029 11.27141574019314163 -62.069125737912351326 344.62614387614092948 49.455425729806016477 -TestParticle -1.7910635325425254827 0.044197943689674758228 33.673496401958495028 -49.096060175323778196 333.20352819343492 344.1647888658290526 -TestParticle -1.3951416310339623816 0.25049231139019290104 13.926920554033479505 -24.468782285640848784 283.9433213127680915 38.716618949049291132 -TestParticle -1.4774439717601555166 0.34321703341922732422 34.23200733980726085 -253.1569295809615312 208.55072402648170282 142.78123543474748658 -TestParticle -1.8035383416573496085 0.31178214061844072846 38.848219271007792486 -163.78980370879801853 27.192135308956363104 240.49835213590739613 -TestParticle -1.8523952866624258107 0.2010708076570819347 22.034325231090594599 -124.711476085711595374 323.0644792551414639 138.10178915634389796 -TestParticle -1.9173340778250498317 0.2780025712872400967 25.973495130250071838 -193.9471251677579744 256.51445549034934857 68.5799795393802043 -TestParticle -1.2039954656193134763 0.32062119894339707882 11.801770668367792538 -261.58407010163364248 130.72550628237604542 295.22935271302458204 -TestParticle -1.3539793779063435952 0.05619140956045583224 0.39149769265351963554 -54.55272735280637164 335.83544373800691574 89.36258771851326799 -TestParticle -1.9516074079116982887 0.1921645005309346732 35.371640156848229708 -152.55319109406485723 247.31165449235123788 278.83909188690222436 -TestParticle -1.9301130006872968536 0.047382794904003239234 3.296738006904260665 -186.93636419954495409 38.829849755176162773 177.44532754290727894 -TestParticle -1.2580985637358546025 0.21204965723905899733 16.1659140062293325 -3.289189867948967283 190.84482276807500511 67.97050011468211039 -TestParticle -1.5295225293999865634 0.17172263806479373671 39.618093381378386653 -332.6463231490124599 278.70254383892529404 12.693771958962534185 -TestParticle -1.3231257344221201144 0.2573419902802399073 38.0841373767418645 -20.119441148442565037 244.32686028253979771 48.572638095274754733 -TestParticle -1.2390492871187110957 0.23798618359691314783 30.645766685864785472 -87.001950267678836326 278.12670273948640443 330.89492423249123476 -TestParticle -1.3993417216526349289 0.031843494342214208326 14.144935673919892594 -72.465298766095699534 334.2534597720372176 30.48791433958904662 -TestParticle -1.5347486253277040635 0.04338458251454313519 12.0921328741059639356 -120.79694902396420275 355.45117743828626544 160.7907173842522468 -TestParticle -1.2904906197620742425 0.28414011519071485923 33.037713210604835012 -289.81253890944515206 83.576357577029270374 220.09709176383933027 -TestParticle -1.6058032451228929638 0.36018141227094635504 17.994372902660266789 -3.7010845253058599624 141.54942979100397338 198.05616798418643043 -TestParticle -1.7714414500542230435 0.0035609242707668187222 22.050030319794334588 -264.59185760489833683 10.605770272399395182 215.25949766508875882 -TestParticle -1.81709217161712 0.27368429441007163794 17.149545687672187455 -35.988324614781888044 81.77856120500719328 10.201466538617181001 -TestParticle -1.9507969820486321666 0.104826252022570107214 21.570178232673107743 -110.11799658110533073 203.10615346805144554 174.54637699366600145 -TestParticle -1.5513016726876260876 0.0649073896097557973 28.406030811013923909 -294.40827400152136306 308.45384003953444108 250.69412013121518612 -TestParticle -1.6081730286462514457 0.0904772003540942199 8.756397654381963491 -95.30241023766843966 310.97856820924152998 78.51553642084900275 -TestParticle -1.9445060562513780678 0.34581412562291430346 38.93528925234138427 -322.18458452998703478 206.50871262487711988 171.6753679893202218 -TestParticle -1.2867830568980889172 0.23805020747269362014 30.605085071406584518 -107.834941188806425316 172.69897682961376972 231.64156285513004718 -TestParticle -1.5570299212666793842 0.34247490116827700168 25.701729758850273555 -57.759342054473357564 275.21368529820330195 0.5189093555138457603 -TestParticle -1.8297728730942826036 0.0059327247000139143526 26.27006410810665571 -351.91597475003959516 332.46172667657117472 193.83113607968971337 -TestParticle -1.4663451402621732189 0.019337346272064428326 0.491698998445047053 -336.79769240394642793 248.96724280968578569 175.15811073921727825 -TestParticle -1.724576194857081024 0.052697296256256631608 5.7447084496883027427 -66.182723011463494345 29.130322702617217345 339.9870439485365523 -TestParticle -1.3696669727225077029 0.33229023795273532338 39.64244722837145929 -133.49050184888841386 162.12402403598608203 293.04583577859932575 -TestParticle -1.3783417053600715008 0.2855227081254033128 11.873396199324094624 -181.03404330551020962 111.58079564001488393 50.497053185226064898 -TestParticle -1.8637392080726669086 0.0156183905360887560765 26.799919264480482894 -101.416124536033450454 141.64824974137857794 87.10767556818554169 -TestParticle -1.3990411255817394309 0.016424027824586850954 34.17231113580791657 -351.25674680067004374 51.410447621435544363 109.4743571087562799 -TestParticle -1.7113078627771947104 0.087396542572623220346 21.48366722009397023 -331.26077825265491583 87.597172428811916234 351.11237329056922363 -TestParticle -1.6537452602438895699 0.19076978286361276349 30.899468439263419128 -338.97921655361312787 354.2717007607652704 88.459659106615376345 -TestParticle -1.8713204845226436568 0.34948347966477527615 26.694021521206035885 -22.640920338079904894 267.1658484538838252 91.263466282262129425 -TestParticle -1.7800499814903345541 0.21591168642547953205 4.15893255030611364 -284.8692985786169629 273.15026927162216452 163.62920354405895296 -TestParticle -1.2770584465418410858 0.11704921307575957834 23.561299361007908004 -208.69763432291699701 114.84562071374233483 106.557589971007203644 -TestParticle -1.7789101924514278963 0.21089404756926086182 26.446391287965887784 -166.38039683220225129 280.94687192438289003 156.1732356226829097 -TestParticle -1.5095803628848272204 0.37888764670309865723 23.739638145042558648 -147.5462561757028368 320.06107890549310468 221.66365612858550094 -TestParticle -1.431320096709388201 0.090307147024224890264 8.768204975989792871 -86.741239636344801056 122.03132838806067184 343.580887072082362 -TestParticle -1.6349437899113876682 0.14387102541744481443 11.841216176535350968 -51.14042919054931957 69.171034829460595006 213.79008663660533784 -TestParticle -1.689003605562497734 0.13061345081474304286 24.749487065465949343 -180.96919715736157741 204.68845725307318162 260.67277137781871943 -TestParticle -1.3035444430147782313 0.19990048901013623972 15.958381821114077326 -24.968896817823825529 197.33820599380237581 119.001287940231961215 -TestParticle -1.6620625944290643439 0.2734543708115155236 30.556744105988030924 -323.42922129424488276 115.879900714354221236 18.69101695694187626 -TestParticle -1.9572874068027543704 0.3982637334300366816 23.395690692151514867 -282.1199835387070607 264.2819579212129497 226.80637570406867098 -TestParticle -1.7711614884940887205 0.16471476857196881705 34.541413045241888824 -209.78439563147685476 330.68687123431953978 302.79975669488345602 -TestParticle -1.2768346788945352799 0.2680189005217827325 2.3664781607185281231 -4.5230625737162633015 309.27315231219478164 35.64300138830596154 -TestParticle -1.7331467818212080712 0.08199012177664927181 2.5002689592511995187 -16.248296777956340975 8.818474849161844986 133.32825103025075464 -TestParticle -1.5824962842528258467 0.1664685697946028109 39.01047834163395578 -294.62170247515587107 5.127126749923851534 323.21555884047671725 -TestParticle -1.3065419938771187791 0.062752012732249048965 8.378519051225520542 -254.48399542766591708 227.28662992761130113 215.88914339840525258 -TestParticle -1.2803200151108913296 0.39024438031771679913 26.21206496548343523 -86.2004800657045962 86.508225331489853716 295.03587464294588472 -TestParticle -1.9599644739977994945 0.18082768987187250453 26.76260832548297941 -347.08076935823510212 187.06487585242066984 78.43547038210139988 -TestParticle -1.5504457817332411018 0.058138854268877486475 8.311304083318722391 -250.45953202370188251 51.58641776614162211 321.91182873943205323 -TestParticle -1.4030770961210228265 0.2255632436620616521 8.257376872662526068 -110.66653646497886143 331.8743125077128866 326.8827542847423615 -TestParticle -1.3330653778054313285 0.23576894818100968543 16.555280374134500931 -201.04570271621727784 304.9737571038722308 129.38177632189641031 -TestParticle -1.4676189305416613706 0.15334509742223720319 29.730324421851861416 -93.28877448580836074 98.24809064509591394 318.26221325804715434 -TestParticle -1.4959613849179316247 0.26490707510895572518 8.435591899110246317 -121.44478123997235741 352.46125426578402084 269.21443204906552182 -TestParticle -1.2410245922213516412 0.16484650483123386433 29.036807003172221187 -234.59702065989810649 212.29149699166657683 309.02229933747048563 -TestParticle -1.2104445735427551423 0.27493160452164350227 31.472614096909531156 -172.8652728002631136 303.96742459461654562 8.009940254088059319 -TestParticle -1.8791733750261010449 0.2587599416761243165 30.401845910812088647 -330.1151954343364423 190.20401433347646503 104.67843668270934643 -TestParticle -1.3013630074517779089 0.22413535954031660324 32.01650674239483152 -63.549710245898353378 35.89931403059021875 158.56811223007159128 -TestParticle -1.9547724398089645348 0.0786294356900830993 10.0598953139010802715 -69.4839845505388638 123.32244013516246639 31.421777442531322322 -TestParticle -1.6120256585797529958 0.19985700875898035345 13.999189942348966298 -78.857222386685961624 349.6556927780835622 58.475688092723309808 -TestParticle -1.7578912848822172421 0.27207852440462437782 21.16570903311817986 -204.48739950618715966 68.64871257741852162 227.95088374477833781 -TestParticle -1.8170356771723037426 0.24230078833019122464 19.368483713748780417 -184.73419610737784069 272.32723488431577152 126.891658495766833425 -TestParticle -1.8561231261283124283 0.19157748016708203709 1.1886704509024781373 -254.2676067727032887 317.6217024209003057 224.34445674903426493 -TestParticle -1.9710622679246994071 0.14623926742902368381 6.640292860769481109 -190.41063402021279671 187.773358994985756 328.47417804669458974 -TestParticle -1.8390376809348407683 0.39004880820775639227 20.066519467297950996 -211.93199248227401199 289.47815944254944043 137.15839269809171697 -TestParticle -1.6111502808558577637 0.22394676788626455277 20.061937046580968769 -92.54520491825057604 92.01310424807805077 13.375630065565452753 -TestParticle -1.7289359898596003973 0.029780688540387692531 26.014739049810341243 -312.66680607544742543 228.17665637399315415 125.22825394003517374 -TestParticle -1.2705682146072982963 0.029404610289824398284 5.561963728286389852 -84.16555574179947996 331.08838136349748993 315.88331119433712502 -TestParticle -1.8573347647002547145 0.36089888274309028793 33.45261607330014897 -108.58851164869084016 217.00073148209528995 139.41678117547121474 -TestParticle -1.5119662840275136517 0.035019622195022657996 10.463315222301648788 -152.85193304965602579 42.895445465204801394 38.742869188454783114 -TestParticle -1.7622884149632529471 0.03162410217369809179 3.1822974384423297067 -37.26277315140376345 107.89474442992022318 186.6015285726906825 -TestParticle -1.3516643515537363207 0.00042846679844568138443 14.013484979190140578 -216.76556913128737847 329.5425274371341402 157.99664633404185565 -TestParticle -1.3725976866577220825 0.30646538230027742244 11.329739671767651288 -198.97848141965863533 44.651190190469009167 28.049566579775078168 -TestParticle -1.4591070353626824918 0.08119659950059535114 34.28551752565069677 -306.99758279574081143 104.56005980026995417 24.491183217056139654 -TestParticle -1.6809883631745992094 0.12405907090243922797 23.088918298866115464 -81.89324756024211638 45.486408290411304733 5.9086829848113620045 -TestParticle -1.3535618238311779571 0.11072994226846155641 6.1365791065780417313 -96.5917090856876257 125.77992141224173395 180.26956152431557712 -TestParticle -1.5024996182012646528 0.2601294541852439135 20.11839589454453403 -270.4000045350792334 353.011762488246859 34.641037025004784766 -TestParticle -1.5996488376502526751 0.37889391086596613256 18.528995245881297649 -215.86591794372824893 196.33677334782890966 20.482598606365485239 -TestParticle -1.7931356901400370418 0.025945290910749509855 26.661454696830183764 -188.02499061598265939 217.74613305793528184 352.64512058062791766 -TestParticle -1.6808120166727305023 0.26627765088552390882 4.4798421923713638293 -12.471177251742290082 9.432555892002669751 336.72507040011447543 -TestParticle -1.6313081817828176678 0.0086570580622717507174 3.9083339029362873518 -54.248103250365730332 318.7038881970888724 331.85368591582181352 -TestParticle -1.2884450142579531029 0.1681046156164187344 35.34871223758726444 -240.5583121923978922 135.24748641897326706 301.64571007267852565 -TestParticle -1.9196539088974737819 0.055293464951134657648 39.174420254686374676 -13.003093109260595028 224.19261478871260351 272.9340647583842383 -TestParticle -1.3704960962475472019 0.11179773250371188853 23.81208520955706831 -261.70166394043076252 10.650163480395606896 96.095112534597603826 -TestParticle -1.9516781167723931123 0.20402034023295062548 32.535249468476067136 -340.51354688545097815 329.0040653030519593 109.98356406041511946 -TestParticle -1.8140222569343318337 0.12613518245266175377 1.4950171510413001741 -234.61793333937521311 320.05130111528796988 172.88154495883503614 -TestParticle -1.8102010682471065817 0.14811926068150899072 0.47152065059882453113 -231.56413706767099825 205.2503541540525589 214.7508917825621495 -TestParticle -1.3323729215149744398 0.19959213905409678436 1.3073421511548932727 -151.66443112411295147 341.31892085633529632 144.25232896171203834 -TestParticle -1.2204541150545651362 0.068668187712776870835 4.014281498324958619 -174.08147891950491726 47.939506002741296697 254.99017431971773817 -TestParticle -1.2181192459350491664 0.025059093817326606735 7.204862413525972009 -48.60770716273837877 329.11947000106135874 217.6643233891191187 -TestParticle -1.6039675062130638317 0.35797604454305875787 16.056969103103426733 -87.92417372221831329 49.76521958624503128 164.99398402032807098 -TestParticle -1.8725342069546249135 0.106279250804296898636 0.45718402173144045975 -119.596726134790174 107.86697924451233632 232.81352842822093407 -TestParticle -1.7853111973976689697 0.12193477571081268174 3.680789884957089697 -205.60326749430927862 40.207082764860338386 289.2290546833312419 -TestParticle -1.417950447978111761 0.24357413812980258094 1.910476157584461987 -252.61262373556786542 355.48333419302929315 151.32407206005677835 -TestParticle -1.2280461512973894767 0.15278421763439650749 26.714312283832946093 -142.72673485719965925 232.69712275301176874 346.3375478502677538 -TestParticle -1.61151127031616892 0.3744225370958842447 36.56793088861800811 -328.09520081336302155 25.920977978027824662 288.72452391776596414 -TestParticle -1.2239475600090146123 0.24714055634484358159 30.304522847333871027 -52.68180217169934565 356.99734588216864495 56.617981510557434888 -TestParticle -1.2496667763539286433 0.29747468986797759305 21.37154433932160913 -209.20331717962355356 22.663460638340339415 243.0475686976612053 -TestParticle -1.3767605238800932899 0.16005520292207792155 6.1854407103408437507 -301.0924331535983356 324.9040368073589775 194.17256664039328484 -TestParticle -1.2487797979186712194 0.16488755850697139893 27.605925256805747381 -173.22312758245544728 239.01695963206066153 175.97057379774636843 -TestParticle -1.2254722592225348876 0.36803675574552041638 17.169692704564543106 -198.47031096951334916 278.36167082537872375 125.492714298233096315 -TestParticle -1.6464965033862297705 0.1517233377674910566 13.532163365202411143 -147.08019388518567894 177.40254091222027455 340.04568453953692142 -TestParticle -1.2241673144222895431 0.1378443050280294957 35.034429639418924296 -279.5154571951889011 236.88366494050367805 224.20218590463449004 -TestParticle -1.7054405098540872388 0.3610118405579151868 11.466405393735001894 -354.5918155292421261 347.1596768668937898 219.93975816420154956 -TestParticle -1.7400094098497860262 0.11768201787113397039 3.0207223829180174235 -344.79550555000747636 295.17286383856117027 107.65817940211057646 -TestParticle -1.4518563888365596526 0.034369934761878086216 5.703231914559241389 -123.995036213356954136 112.321809800044363215 96.308678475290903975 -TestParticle -1.2222379634093671896 0.14278765376770935491 35.361595327244465636 -315.14729198154049072 321.37175810105372875 262.59992588280709924 -TestParticle -1.2388409450815878188 0.29191544705043231955 14.574148472908646568 -354.52890314367516567 301.2116870378684439 101.6607227628783221 -TestParticle -1.2004854536116522645 0.31759418786438237126 35.64893550976294989 -150.1713542262849046 263.81583006909363576 352.70617164487305217 -TestParticle -1.9942890442362894987 0.19536136516905414084 35.02451517807598691 -125.959361711604387324 266.3424034858336995 225.8398826035477498 -TestParticle -1.5915447637460526931 0.0895260552791858899 24.02901618574255238 -322.40268348510250007 115.71588659763698104 232.13880147735969217 -TestParticle -1.8790673483459361393 0.17433764017862168894 13.878215826572342095 -302.39495868122469346 259.03939837677381774 176.29569985086394013 -TestParticle -1.9699962554990502195 0.38438649317544010264 36.886012906803621547 -71.57770428256088735 76.46325818263683516 152.99488881347215852 -TestParticle -1.9815372834826587845 0.17262153411198999375 2.83353778898145503 -239.37167896200179484 354.1664112035709877 298.12866718881934958 -TestParticle -1.8155595191765212526 0.00946228278143057544 38.64106328673518931 -83.00268912398927057 67.39652732514183242 195.80213873516331091 -TestParticle -1.8868581896910789908 0.10440835820682173307 15.007174114646065988 -3.363490125056509683 163.21113577536885941 277.4874262071848534 -TestParticle -1.5619200947925855338 0.0059432103700412857936 28.417160713316764742 -199.61588156187738718 146.61610611302111806 239.63331133984317489 -TestParticle -1.5212478213877396183 0.39927753429172280208 20.482036387314252579 -328.51885419136107203 7.1256709736876455707 220.89114467811927511 -TestParticle -1.8571870020289564795 0.091291230530104086616 5.8118062401183578913 -90.75198382995706936 192.24228564818409382 97.133874093047666065 -TestParticle -1.9171289936627273764 0.15261088480197210204 38.10675746822411014 -307.07749448841616413 355.13520879558041088 42.711583491490678455 -TestParticle -1.7364144307839262105 0.212129283201967056 18.744823342299753222 -23.928680492317099038 37.437700592246308418 64.10777424122947821 -TestParticle -1.615801582218067356 0.15507189040762445198 5.289237911360147315 -2.9760090649453463385 170.77756092233224194 126.74171547116436898 -TestParticle -1.3071905708698117188 0.34127930871062794882 17.996264880013068677 -181.87012353589301483 211.32152679731703415 284.19737442691894103 -TestParticle -1.2265401930807908748 0.25798059801133454982 34.025699672304931198 -87.484085061199664324 233.26336671618474838 310.39211945198593412 -TestParticle -1.2051260378681512009 0.3069049294618042545 37.351493484362229935 -114.521127203859620636 225.6531083956228656 323.1220799515929798 -TestParticle -1.8334732437656884318 0.37979115889431414033 14.226342594064389502 -331.7883640504541063 109.06927231695421199 144.65450510058425948 -TestParticle -1.757300956926634683 0.03414936250768385584 23.912004140762192606 -322.3724083824729405 134.91275424426311247 171.32647169967813738 -TestParticle -1.8972253261023601656 0.35656552318718498507 28.47629514891832514 -321.29937216619140372 70.71608626545858556 213.57910706058532924 -TestParticle -1.9917616839747163127 0.32376104104249381344 8.91181936527569718 -200.88415597368361887 23.513470382909822831 100.72835347725671795 -TestParticle -1.6165777777920147251 0.32043762073249004718 16.726392824188689445 -319.72153811597894446 76.78830327849077264 138.42254101919101572 -TestParticle -1.8908331674281746437 0.045197492899151252288 1.3383682043347544521 -312.10875470237436957 307.494732749847401 43.074246036675127414 -TestParticle -1.2145287335503922588 0.18257617394552527745 31.629727041908243024 -3.7714421582542145828 327.9557064611080932 329.9790680610109348 -TestParticle -1.8625485962061800738 0.24850308301344462003 2.0061095060140976543 -276.90239618431269264 350.88215248164351578 348.2932770314767481 -TestParticle -1.7953658240966166026 0.23860504712104810277 30.564301023692120651 -268.6736542028508552 254.54176920249031468 269.62615941325310587 -TestParticle -1.8519636256102920413 0.13630536382454808142 25.429742406638986552 -78.06201903944463538 183.89412111638756642 25.670444097748280399 -TestParticle -1.9912586036233026476 0.0062934836627138949355 3.9866901191125192483 -353.92558378078365422 121.86076402069599567 272.13181013382109086 -TestParticle -1.2352461280314077641 0.13108872108404742707 2.4473753819670784893 -223.0667681463768588 134.42147854096177184 161.85468044136672461 -TestParticle -1.3431819133091436047 0.28681705477285673878 22.82513974594832007 -232.7183120134940566 120.199688171678360504 89.77367022064561297 -TestParticle -1.8403545873570172908 0.24879279733973019839 4.0287923881425502515 -15.018525270146003692 85.179302481017629134 62.783331763645470858 -TestParticle -1.381867054141263651 0.041622600218831219687 20.582798332241445394 -16.94221565894110526 117.67293863884100347 301.82514806956680786 -TestParticle -1.8641683600359446604 0.24640721081737218534 5.9107924107914655565 -193.20103651885807494 44.2323469313580091 26.743437036080784708 -TestParticle -1.966054790276180464 0.2690464178872462031 14.878455955491389773 -190.60763663869553852 31.588470897177995056 100.366806653161106055 -TestParticle -1.6058040413293108717 0.29951736276665757996 32.261171438174280013 -128.57574732488706104 32.785220122308132318 5.815690987139072732 -TestParticle -1.6218958057245982385 0.20051601410731448305 35.228407716619500434 -275.05072744657877593 300.36353903970075407 137.58872709072204543 -TestParticle -1.9766063717976680714 0.39029116187457174592 35.936563690886423217 -276.4677919812604614 334.4193480382128314 74.17428380404710708 -TestParticle -1.4924898153539933876 0.12959279079593266637 39.497773315041648345 -306.13052013355064673 297.98869981653200512 134.11781736074624405 -TestParticle -1.8353633188339963933 0.019510947086492525654 35.474352018859882207 -260.37806171878622763 151.50200809864463736 309.73656114784841975 -TestParticle -1.6024488136145134121 0.027272421536337843745 28.531535673798313013 -11.154644928392061232 313.60248630627489774 220.0912732804740699 -TestParticle -1.4120513432815475774 0.29969768596351453738 17.02938110092897972 -269.20328072337844105 42.08893931076963213 126.58679602124011865 -TestParticle -1.7381168022087705172 0.29181610891675680008 0.578376627518526476 -102.38820556898792802 176.55332025897169501 164.93491360823296077 -TestParticle -1.651697945678905155 0.10215579780054198644 29.466376982324295142 -118.66030632495935038 355.77634853151920424 138.86820482744579408 -TestParticle -1.8964095997568284346 0.14855799694311630499 39.315092089557069244 -66.7203702634703717 109.12901978076088483 150.07738642659984407 -TestParticle -1.5884778821144036609 0.34804404474317385265 8.230716828452404599 -238.65003666711348274 19.561503330036060788 172.3300970659766449 -TestParticle -1.4852533118509871901 0.14921150930008680868 19.72836045372870828 -214.04378603222667721 162.09311096493223658 74.70412564882457218 -TestParticle -1.3995786109265431207 0.2170751900351963748 5.6353499706781517986 -136.77890520256397622 41.74190372493747958 352.76491235469808316 -TestParticle -1.9228837399064100389 0.20666458127164555325 31.918474396874408683 -25.57157805855647581 146.61033704579944015 124.85803020390667939 -TestParticle -1.5491200767868975596 0.37703244317878858993 5.088593545490081027 -38.820500192778638393 121.37946795513649079 24.303500272632902579 -TestParticle -1.6942853977776144436 0.090260172320617615416 25.30769952267446854 -161.30886094388631591 116.98046667590497805 38.286029141363265182 -TestParticle -1.6090251866675413517 0.330322662148613444 9.770748848728519675 -263.0814719840412863 130.26024091675910199 286.9327501208536546 -TestParticle -1.9761336997553433648 0.2926123710566602143 11.274914096097191418 -332.1701813530870595 307.94382558508260672 353.807211256272808 -TestParticle -1.9968906969927759931 0.3233230682542853618 26.00314542561351061 -79.80693890771757992 308.2283099476609891 243.34005704939397674 -TestParticle -1.8031947344086236562 0.14995127116151910074 1.730342239053141995 -348.6351290160268377 154.3487630625562872 28.463371915640660603 -TestParticle -1.8395166633814701296 0.3354540599588180516 22.093131712634573205 -86.610640388957989444 239.4548535151652402 312.24619268529380633 -TestParticle -1.3629305527230259898 0.2099232743767838194 30.216497531918712127 -102.43196923936434928 291.32106047341460453 2.1370626980559981334 -TestParticle -1.7455726368986721475 0.026854653926422458743 3.5759919284920771432 -354.23018906949636175 218.20031690429203763 328.7114242710409826 -TestParticle -1.8154807930100198554 0.38785895954054117052 30.190244155261783732 -84.158791911543673336 145.33493614486761203 216.44848876198116727 -TestParticle -1.6499702946012431148 0.38233820338992924315 13.614607279413908358 -33.87451574095803153 90.770300669062208954 180.38849672518907141 -TestParticle -1.607515534627930176 0.059816004314718410062 35.188867073591850954 -58.61309722228839547 253.79649442362003242 91.30583916434224534 -TestParticle -1.9899983350379286673 0.30667218968608733753 39.83983478820580615 -209.92012615445401025 242.81573248914770602 7.221381167673248669 -TestParticle -1.5778501251334575706 0.11118331397677137795 37.590979480700937643 -345.16243909883007746 9.645072368649788785 50.426633047687808187 -TestParticle -1.8837383001263663385 0.20673789324487820696 21.972954461156501083 -78.99100998693006659 24.805859834858065227 136.69965104577451598 -TestParticle -1.8299552552499931402 0.18024309648678646378 33.71418287836082328 -287.1584786318022111 76.47733005592756683 216.63675723929046057 -TestParticle -1.8307526657330810416 0.27679256938591745296 14.42019596286409211 -147.28115682985833246 236.20842913390856666 70.36203841533576053 -TestParticle -1.7619978997528076281 0.014257923627121950327 18.454020582426768016 -275.7628626446463045 152.24331061485040095 103.04339508992384822 -TestParticle -1.2611641121223651218 0.2092199031608525106 17.779518579686019564 -102.7504319389703511 6.548313747168017507 140.31125376249352144 -TestParticle -1.7663975820756958601 0.25859601590736014387 19.29766354922654159 -228.43411110252168328 129.52408847472079856 44.31277736443019677 -TestParticle -1.3455298896696588073 0.051640741433284009787 36.190409530870716992 -63.492703118667094486 178.32472671129730202 219.22272979662204762 -TestParticle -1.8502619397752217978 0.016055258128672856427 24.72292322260771158 -280.24156788062276746 1.0103622910431475646 89.91460784296667441 -TestParticle -1.7394822607661057923 0.13625236700994178274 8.773342269773106494 -131.40116141700701746 79.224373058834927974 282.8109557650995498 -TestParticle -1.6325195629104731765 0.16262358056449152666 8.946438635142083484 -196.95655091099223455 13.582007343579313385 258.10561033792743046 -TestParticle -1.7657479077259037314 0.21823895457628741945 26.194016006374575056 -307.4759621278849977 98.40357006941655982 64.08127327032266862 -TestParticle -1.3184659717472237972 0.20902078438144011674 11.194180638539418027 -209.8144125213535176 233.63319375255508703 171.85375675646986338 -TestParticle -1.6265974791221389228 0.3412246124964996019 31.920108006714791316 -47.471005836654683208 293.97130420183299293 294.00277926085681202 -TestParticle -1.544562457381803755 0.26456236803106419897 16.966290843319804083 -53.617851002077699718 23.906897211735604003 172.46215455198040445 -TestParticle -1.8302658298265410686 0.016558573352333152279 23.88277176507106958 -160.31985284355113208 24.957240748542652398 126.6630513998358083 -TestParticle -1.6333356556090419254 0.25338625439533907224 11.051395862722980468 -182.26698944663951352 1.9926145156870767039 206.81766326774084064 -TestParticle -1.2674061997735568408 0.09083958911004344494 16.414033820600888447 -209.7777498397578313 350.73333597951523188 247.44407246182404947 -TestParticle -1.400118114272113079 0.16683948053104513676 27.357400210939808005 -107.57418681944162131 96.46599300991492498 351.137614793950263 -TestParticle -1.542911801971112773 0.22704910395233757203 35.542775761322914718 -183.89056710921508397 326.93869125935344755 108.004775809479497184 -TestParticle -1.8076126800363871983 0.3514591336111956288 31.06364189291468847 -32.09942049648420692 328.34181095498098557 23.785841162187210784 -TestParticle -1.7657364621109161718 0.22171357606490707526 37.37986273837123008 -76.229451450918475075 186.15095789038804241 272.82850857627113328 -TestParticle -1.5339591135633763308 0.14194102156165430695 16.888317976342129612 -130.44976850069960506 252.36020783978619875 120.456187175611859175 -TestParticle -1.9547780848567972711 0.20899592311387996113 28.868044731219395516 -228.48529363010104021 342.5481929867736426 287.9707078087696459 -TestParticle -1.2418423098941544502 0.2626072565929837288 2.1074243271891202056 -38.080338719023941962 119.27817821310316049 12.056891938029119515 -TestParticle -1.2210546528534078625 0.3775561742151631872 22.111051712315155982 -338.55211294801040367 12.980519500186410653 332.2853401701941607 -TestParticle -1.5963937431999124517 0.23239324239635986147 13.194381854516867847 -58.007673822576016676 88.15306827351753327 155.81366075873469867 -TestParticle -1.5786275082915319778 0.025562551186680871479 4.998454237047265103 -250.39244849302215812 165.61747690949906087 149.37807874408460407 -TestParticle -1.6098684422151645634 0.21941479472017652586 38.283886043658093 -237.71100658433758213 47.01387761056833625 340.9146849041053997 -TestParticle -1.294274143429140933 0.3692138815235402327 37.966030890732696434 -203.45477640609851733 296.29180039237496658 44.323085276308532343 -TestParticle -1.5889819356899443914 0.084869830381732264124 1.0823445911213003257 -301.3291216497269147 146.81272157061789585 2.2993592847625343722 -TestParticle -1.495972566018333838 0.2617122471497527747 13.094048981160977263 -112.72021003020111607 127.77611875010921949 296.87288781423353612 -TestParticle -1.9818950278621338956 0.30723187525460954328 2.2340086246482782073 -253.14761844363803789 165.37409022827591798 191.3408807414710111 -TestParticle -1.7869956116636900312 0.045787597413756889186 8.90426427671208387 -227.8168631112827427 149.58799389390406986 24.858909708161100127 -TestParticle -1.9448897771198014883 0.05694944930378804948 36.311102677736613487 -84.3756745725393813 14.735521995724774058 314.16923571788140634 -TestParticle -1.5778886440600849994 0.054612245238724765883 16.72994958727242576 -293.0541083071825028 260.48271034952341552 308.15802194547808313 -TestParticle -1.3022587146281570103 0.26839233124203137892 18.02838057643581493 -293.20763835009915965 312.4703557364094877 106.58503108046902241 -TestParticle -1.8428500612922003032 0.23594727253001890332 11.315478566151577766 -9.262284156503813648 11.174441070760416039 331.91331034768620611 -TestParticle -1.2400313949450130213 0.37422492957960290516 16.60903446615966672 -240.33042266148279964 153.97322107823731585 191.41559045744850209 -TestParticle -1.9829274684920319416 0.3634611481375451536 25.819601695264427832 -140.99742244780588862 341.49734482956387183 8.731842495851447339 -TestParticle -1.9975413987753882772 0.06592938413948253029 39.49276861893206103 -67.714562888696974596 98.14914061512281762 45.19626721853934015 -TestParticle -1.2436383625451867818 0.3204615517738288455 26.461603913930925813 -266.5125426106603186 127.50909218237357834 0.3132830361456928614 -TestParticle -1.4113215699552892346 0.009827894395237192146 37.858626352737367426 -253.23691224458718807 108.52674294880429784 352.47828245113328194 -TestParticle -1.8148473149676069838 0.017705697189401049807 27.03434752366788274 -244.97100671505916125 96.848173936006702434 232.97923224763914618 -TestParticle -1.8212512693609279602 0.27211932176121911287 4.7578666520375545446 -347.57353058021692505 254.19838041200335965 6.6604121361125034895 -TestParticle -1.6430443076417013959 0.042365150738876616865 28.313700526240026534 -178.6338948507659552 287.94750707892865194 146.775946581025039 -TestParticle -1.2047662238103988841 0.23251833898522478172 17.70944339203029827 -282.07165060128687628 43.193800331112015556 189.58232124886598058 -TestParticle -1.2467705317577537638 0.29356902400030004952 2.8706191725519047964 -242.4004033144470327 28.806681869090574821 296.21360336099968436 -TestParticle -1.3162696178512978129 0.30749173225083181737 9.346008763094072691 -322.38053647407821245 112.34526406313270286 132.09084683753127365 -TestParticle -1.2971409174950825349 0.3376994788613812415 24.652899562822732094 -299.7803539105363484 271.40817959188655095 266.8572235615602608 -TestParticle -1.7684747977650516759 0.02661749740193952718 10.096507324045376208 -3.7221406213358587678 125.36494422546940086 238.11022628505401144 -TestParticle -1.8562458518793771844 0.077017667000931988586 8.7143363020037831745 -136.69548804548151111 320.94977656886021578 128.10172157330882214 -TestParticle -1.5044816034257817439 0.21762930629061374987 27.505997823490588416 -123.58136898241176027 187.9229325893226985 113.043904522795230605 -TestParticle -1.7868133877825629341 0.008087932404090647162 23.413784625415864582 -218.89711766597091014 88.56442540385896223 208.43834176513581724 -TestParticle -1.9402143213090712326 0.14949494785208861103 26.511808095563488052 -107.604663311176523166 130.69889435502176411 346.87469017336604793 -TestParticle -1.5966683044291980487 0.087101617604941061757 35.919427778579809285 -212.8714684966646189 289.47277777746671745 150.30140968266374557 -TestParticle -1.5311077130660335488 0.006686025386596972271 2.6738949911861054076 -164.51009812173990099 316.04513748492058767 258.44750388729431734 -TestParticle -1.327174430660648996 0.16386649979480424899 29.516591637239059764 -42.47034129892313814 297.69030488053482486 179.48650722792217493 -TestParticle -1.3309285665414212207 0.31056216374123679635 33.20416058697580297 -182.12327311281021025 179.4712707903883313 47.404071121072391293 -TestParticle -1.2695626979113197041 0.028739588397623319627 34.7510196296938787 -156.66911337647667324 15.489917584647256987 137.9360720619328049 -TestParticle -1.961564416777008768 0.38198101311209609054 20.407128195470789933 -116.450533784431996764 317.3401517067230202 183.14633665136960872 -TestParticle -1.5940513845582582331 0.25613384894831064953 29.533539385317940429 -118.85654306899444066 250.92868906503659332 22.448371873007765487 -TestParticle -1.8442908242187292522 0.19455300058304564326 38.64468812151265098 -327.51192512776293597 261.15575066638751878 220.98151223015130995 -TestParticle -1.9551136736888132805 0.05881060116092867024 0.025983316883650964257 -229.51441899139550173 217.59860795663826138 108.775137355673251705 -TestParticle -1.3586578999851930405 0.34983150673028151623 31.522812174550345787 -105.68138198042714748 123.58623362447058014 40.330126317320825535 -TestParticle -1.902888826244875764 0.13683561730200419215 16.275257623666469442 -105.98161437435868493 148.2954616585051042 301.45848496238744474 -TestParticle -1.4388714351119729074 0.12902603848379340379 21.287394563627660915 -197.02123109899764586 352.44807359808243064 351.33034912544712824 -TestParticle -1.6931112006676685144 0.013916379702603532201 0.7871365555378062595 -188.64764325380838272 181.38199447667832942 29.813972851285797105 -TestParticle -1.6449616174898105125 0.0310490777007133463 9.657476944838542465 -333.95122687579464582 342.1511167418379955 160.69927097810261785 -TestParticle -1.432310913839848876 0.006987746683723328363 32.61241995358341228 -207.28809337462874396 169.31652720575732474 255.68956575096319739 -TestParticle -1.7327468488118134005 0.03857017036911090241 17.468015575192744393 -143.82903277012908916 99.60548209763706495 166.68173997089294858 -TestParticle -1.5512315858530165702 0.17035757433763087931 28.229428870918749084 -211.42236583345217582 136.37631347760083145 126.78807511085641124 -TestParticle -1.5128716646861577466 0.25892751799964647264 10.396770119409808331 -251.02700694813202631 225.21225462676682127 190.02303419914397864 -TestParticle -1.3509296764855895923 0.19460583033279599263 25.473407765343523579 -153.07999025709941066 160.34541100643662048 39.661129674485906094 -TestParticle -1.6995982689149604639 0.3683946534553529384 13.407331577384432819 -340.26004127001408506 272.0620153240722061 254.6289696923701058 -TestParticle -1.4262589721598459835 0.39380044551624404647 22.273999686412832233 -126.6676609334621304 343.6417878124360641 356.69746962842407356 -TestParticle -1.3261721625529891977 0.39678878113200655164 4.2056417606931040254 -238.10434769519417841 155.06469638647084253 44.875703119243368633 -TestParticle -1.9576977154420573957 0.26084185228864192885 4.55948470669549355 -190.48438127706978662 33.209683105017965943 111.270270586090106235 -TestParticle -1.8552016088932457016 0.13548857795579999364 39.778098090381654117 -36.82048012699509343 277.63542496441021967 284.2017295471840157 -TestParticle -1.6904488396185337606 0.10545628795963413182 32.08178306599211993 -75.246216623590498784 230.69409080017558722 202.52540071832260082 -TestParticle -1.8262524413841534354 0.33415074562628183097 12.176323543258451565 -135.12569593248673527 273.69848190668875532 306.5447498396289916 From f8c4c22d53f0cb71baa73067267a4f44b8e118e0 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Tue, 6 Dec 2022 10:40:43 -0500 Subject: [PATCH 295/569] added start_encounter and stop_encounter implementation templates --- src/modules/symba_classes.f90 | 8 ++++---- src/symba/symba_io.f90 | 26 ++++++++++++++++++++++++++ 2 files changed, 30 insertions(+), 4 deletions(-) diff --git a/src/modules/symba_classes.f90 b/src/modules/symba_classes.f90 index e059bb33b..871637c3d 100644 --- a/src/modules/symba_classes.f90 +++ b/src/modules/symba_classes.f90 @@ -419,20 +419,20 @@ end subroutine symba_util_take_encounter_snapshot module subroutine symba_io_encounter_dump(self, param) implicit none - class(symba_encounter_storage(*)), intent(inout) :: self !! Encounter storage object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + class(symba_encounter_storage(*)), intent(inout) :: self !! Encounter storage object + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters end subroutine symba_io_encounter_dump module subroutine symba_io_encounter_initialize_output(self, param) implicit none class(symba_io_encounter_parameters), intent(inout) :: self !! Parameters used to identify a particular NetCDF dataset - class(swiftest_parameters), intent(in) :: param + class(swiftest_parameters), intent(in) :: param end subroutine symba_io_encounter_initialize_output module subroutine symba_io_encounter_write_frame(self, nc, param) implicit none class(symba_encounter_snapshot), intent(in) :: self !! Swiftest encounter structure - class(symba_io_encounter_parameters), intent(inout) :: nc !! Parameters used to identify a particular encounter io NetCDF dataset + class(symba_io_encounter_parameters), intent(inout) :: nc !! Parameters used to identify a particular encounter io NetCDF dataset class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters end subroutine symba_io_encounter_write_frame diff --git a/src/symba/symba_io.f90 b/src/symba/symba_io.f90 index 641ab7d54..f531d992e 100644 --- a/src/symba/symba_io.f90 +++ b/src/symba/symba_io.f90 @@ -356,6 +356,32 @@ module subroutine symba_io_param_writer(self, unit, iotype, v_list, iostat, ioms write(*,*) "Error writing parameter file for SyMBA: " // trim(adjustl(iomsg)) end subroutine symba_io_param_writer + module subroutine symba_io_start_encounter(self, param, t) + !! author: David A. Minton + !! + !! Initializes the new encounter and/or fragmentation save file(s) + implicit none + ! Arguments + class(symba_nbody_system), intent(inout) :: self !! SyMBA nbody system object + class(symba_parameters), intent(inout) :: param !! Current run configuration parameters + real(DP), intent(in) :: t !! Current simulation time + + return + end subroutine symba_io_start_encounter + + module subroutine symba_io_stop_encounter(self, param, t) + !! author: David A. Minton + !! + !! Saves the encounter and/or fragmentation data to file(s) + implicit none + ! Arguments + class(symba_nbody_system), intent(inout) :: self !! SyMBA nbody system object + class(symba_parameters), intent(inout) :: param !! Current run configuration parameters + real(DP), intent(in) :: t !! Current simulation time + + return + end subroutine symba_io_stop_encounter + module subroutine symba_io_write_discard(self, param) !! author: David A. Minton From 155dc899f6ce98486e93fd53dbe299cc6a36e7d6 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Tue, 6 Dec 2022 10:49:42 -0500 Subject: [PATCH 296/569] Started implementing the encounter saving with user inputs --- src/modules/symba_classes.f90 | 2 +- src/setup/setup.f90 | 1 - src/symba/symba_io.f90 | 15 +++- src/symba/symba_step.f90 | 129 +++++++++++++++++----------------- 4 files changed, 81 insertions(+), 66 deletions(-) diff --git a/src/modules/symba_classes.f90 b/src/modules/symba_classes.f90 index 871637c3d..c715e70da 100644 --- a/src/modules/symba_classes.f90 +++ b/src/modules/symba_classes.f90 @@ -222,7 +222,7 @@ module symba_classes procedure :: dealloc => symba_util_dealloc_system !! Deallocates all allocatable arrays procedure :: resize_storage => symba_util_resize_storage !! Resizes the encounter history storage object so that it contains enough spaces for the number of snapshots needed procedure :: snapshot => symba_util_take_encounter_snapshot !! Take a minimal snapshot of the system through an encounter - procedure :: start_encounter => symba_io_start_encounter !! Initializes the new encounter and/or fragmentation save file(s) + procedure :: start_encounter => symba_io_start_encounter !! Initializes the new encounter history procedure :: stop_encounter => symba_io_stop_encounter !! Saves the encounter and/or fragmentation data to file(s) final :: symba_util_final_system !! Finalizes the SyMBA nbody system object - deallocates all allocatables end type symba_nbody_system diff --git a/src/setup/setup.f90 b/src/setup/setup.f90 index ea6d3db23..e95505b9b 100644 --- a/src/setup/setup.f90 +++ b/src/setup/setup.f90 @@ -68,7 +68,6 @@ module subroutine setup_construct_system(system, param) allocate(symba_pltpenc :: system%pltpenc_list) allocate(symba_plplenc :: system%plplenc_list) allocate(symba_plplenc :: system%plplcollision_list) - allocate(symba_encounter_storage :: system%encounter_history) end select case (RINGMOONS) write(*,*) 'RINGMOONS-SyMBA integrator not yet enabled' diff --git a/src/symba/symba_io.f90 b/src/symba/symba_io.f90 index f531d992e..0300c6dc5 100644 --- a/src/symba/symba_io.f90 +++ b/src/symba/symba_io.f90 @@ -356,19 +356,27 @@ module subroutine symba_io_param_writer(self, unit, iotype, v_list, iostat, ioms write(*,*) "Error writing parameter file for SyMBA: " // trim(adjustl(iomsg)) end subroutine symba_io_param_writer + module subroutine symba_io_start_encounter(self, param, t) !! author: David A. Minton !! - !! Initializes the new encounter and/or fragmentation save file(s) + !! Initializes the new encounter and/or fragmentation history implicit none ! Arguments class(symba_nbody_system), intent(inout) :: self !! SyMBA nbody system object class(symba_parameters), intent(inout) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! Current simulation time + if (allocated(self%encounter_history)) deallocate(self%encounter_history) + allocate(symba_encounter_storage :: self%encounter_history) + + ! Take the snapshot at the start of the encounter + call self%snapshot(param, t) + return end subroutine symba_io_start_encounter + module subroutine symba_io_stop_encounter(self, param, t) !! author: David A. Minton !! @@ -379,6 +387,11 @@ module subroutine symba_io_stop_encounter(self, param, t) class(symba_parameters), intent(inout) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! Current simulation time + ! Take the final snapshot + call self%snapshot(param, t) + call self%encounter_history%dump(param) + deallocate(self%encounter_history) + return end subroutine symba_io_stop_encounter diff --git a/src/symba/symba_step.f90 b/src/symba/symba_step.f90 index 7b26f80af..bdf73309b 100644 --- a/src/symba/symba_step.f90 +++ b/src/symba/symba_step.f90 @@ -181,71 +181,74 @@ recursive module subroutine symba_step_recur_system(self, param, t, ireci) logical :: lencounter, lplpl_collision, lpltp_collision associate(system => self, plplenc_list => self%plplenc_list, pltpenc_list => self%pltpenc_list) - select type(pl => self%pl) - class is (symba_pl) - select type(tp => self%tp) - class is (symba_tp) - system%irec = ireci - dtl = param%dt / (NTENC**ireci) - dth = 0.5_DP * dtl - IF (dtl / param%dt < VSMALL) THEN - write(*, *) "SWIFTEST Warning:" - write(*, *) " In symba_step_recur_system, local time step is too small" - write(*, *) " Roundoff error will be important!" - call util_exit(FAILURE) - END IF - irecp = ireci + 1 - if (ireci == 0) then - nloops = 1 - else - nloops = NTENC - end if - do j = 1, nloops - lencounter = plplenc_list%encounter_check(param, system, dtl, irecp) & - .or. pltpenc_list%encounter_check(param, system, dtl, irecp) - - call plplenc_list%kick(system, dth, irecp, 1) - call pltpenc_list%kick(system, dth, irecp, 1) - if (ireci /= 0) then - call plplenc_list%kick(system, dth, irecp, -1) - call pltpenc_list%kick(system, dth, irecp, -1) - end if - - if (param%lgr) then - call pl%gr_pos_kick(system, param, dth) - call tp%gr_pos_kick(system, param, dth) - end if - - call pl%drift(system, param, dtl) - call tp%drift(system, param, dtl) - - if (lencounter) call system%recursive_step(param, t+dth,irecp) + select type(param) + class is (symba_parameters) + select type(pl => self%pl) + class is (symba_pl) + select type(tp => self%tp) + class is (symba_tp) system%irec = ireci - - if (param%lgr) then - call pl%gr_pos_kick(system, param, dth) - call tp%gr_pos_kick(system, param, dth) + dtl = param%dt / (NTENC**ireci) + dth = 0.5_DP * dtl + IF (dtl / param%dt < VSMALL) THEN + write(*, *) "SWIFTEST Warning:" + write(*, *) " In symba_step_recur_system, local time step is too small" + write(*, *) " Roundoff error will be important!" + call util_exit(FAILURE) + END IF + irecp = ireci + 1 + if (ireci == 0) then + nloops = 1 + else + nloops = NTENC end if - - call plplenc_list%kick(system, dth, irecp, 1) - call pltpenc_list%kick(system, dth, irecp, 1) - if (ireci /= 0) then - call plplenc_list%kick(system, dth, irecp, -1) - call pltpenc_list%kick(system, dth, irecp, -1) - end if - - if (param%lclose) then - lplpl_collision = plplenc_list%collision_check(system, param, t+dtl, dtl, ireci) - lpltp_collision = pltpenc_list%collision_check(system, param, t+dtl, dtl, ireci) - - if (lplpl_collision) call plplenc_list%resolve_collision(system, param, t+dtl, dtl, ireci) - if (lpltp_collision) call pltpenc_list%resolve_collision(system, param, t+dtl, dtl, ireci) - end if - call system%snapshot(param, t+dtl) - - call self%set_recur_levels(ireci) - - end do + do j = 1, nloops + lencounter = plplenc_list%encounter_check(param, system, dtl, irecp) & + .or. pltpenc_list%encounter_check(param, system, dtl, irecp) + + call plplenc_list%kick(system, dth, irecp, 1) + call pltpenc_list%kick(system, dth, irecp, 1) + if (ireci /= 0) then + call plplenc_list%kick(system, dth, irecp, -1) + call pltpenc_list%kick(system, dth, irecp, -1) + end if + + if (param%lgr) then + call pl%gr_pos_kick(system, param, dth) + call tp%gr_pos_kick(system, param, dth) + end if + + call pl%drift(system, param, dtl) + call tp%drift(system, param, dtl) + + if (lencounter) call system%recursive_step(param, t+dth,irecp) + system%irec = ireci + + if (param%lgr) then + call pl%gr_pos_kick(system, param, dth) + call tp%gr_pos_kick(system, param, dth) + end if + + call plplenc_list%kick(system, dth, irecp, 1) + call pltpenc_list%kick(system, dth, irecp, 1) + if (ireci /= 0) then + call plplenc_list%kick(system, dth, irecp, -1) + call pltpenc_list%kick(system, dth, irecp, -1) + end if + + if (param%lclose) then + lplpl_collision = plplenc_list%collision_check(system, param, t+dtl, dtl, ireci) + lpltp_collision = pltpenc_list%collision_check(system, param, t+dtl, dtl, ireci) + + if (lplpl_collision) call plplenc_list%resolve_collision(system, param, t+dtl, dtl, ireci) + if (lpltp_collision) call pltpenc_list%resolve_collision(system, param, t+dtl, dtl, ireci) + end if + if (param%lencounter_save) call system%snapshot(param, t+dtl) + + call self%set_recur_levels(ireci) + + end do + end select end select end select end associate From 64c61fa1421100e1852ee078e2b4a222dcda9f66 Mon Sep 17 00:00:00 2001 From: Carlisle Wishard Date: Tue, 6 Dec 2022 11:06:33 -0500 Subject: [PATCH 297/569] deleted notebook --- examples/whm_gr_test/whm_gr_test.ipynb | 158 ------------------------- 1 file changed, 158 deletions(-) delete mode 100644 examples/whm_gr_test/whm_gr_test.ipynb diff --git a/examples/whm_gr_test/whm_gr_test.ipynb b/examples/whm_gr_test/whm_gr_test.ipynb deleted file mode 100644 index a3dac65b2..000000000 --- a/examples/whm_gr_test/whm_gr_test.ipynb +++ /dev/null @@ -1,158 +0,0 @@ -{ - "cells": [ - { - "cell_type": "code", - "execution_count": null, - "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": null, - "metadata": {}, - "outputs": [], - "source": [ - "sim_gr = swiftest.Simulation(simdir=\"gr\")\n", - "sim_gr.add_solar_system_body([\"Sun\",\"Mercury\",\"Venus\",\"Earth\",\"Mars\",\"Jupiter\",\"Saturn\",\"Uranus\",\"Neptune\"])" - ] - }, - { - "cell_type": "code", - "execution_count": null, - "metadata": {}, - "outputs": [], - "source": [ - "sim_nogr = swiftest.Simulation(simdir=\"nogr\")\n", - "sim_nogr.add_solar_system_body([\"Sun\",\"Mercury\",\"Venus\",\"Earth\",\"Mars\",\"Jupiter\",\"Saturn\",\"Uranus\",\"Neptune\"])" - ] - }, - { - "cell_type": "code", - "execution_count": null, - "metadata": {}, - "outputs": [], - "source": [ - "run_args = {\"tstop\":1000.0, \"dt\":0.005, \"tstep_out\":10.0, \"dump_cadence\": 0,\"integrator\":\"whm\"}" - ] - }, - { - "cell_type": "code", - "execution_count": null, - "metadata": {}, - "outputs": [], - "source": [ - "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)" - ] - }, - { - "cell_type": "code", - "execution_count": null, - "metadata": {}, - "outputs": [], - "source": [ - "# Get the start and end date of the simulation so we can compare with the real solar system\n", - "start_date = sim_gr.ephemeris_date\n", - "tstop_d = sim_gr.param['TSTOP'] * sim_gr.param['TU2S'] / swiftest.JD2S\n", - "\n", - "stop_date = (datetime.datetime.fromisoformat(start_date) + datetime.timedelta(days=tstop_d)).isoformat()" - ] - }, - { - "cell_type": "code", - "execution_count": null, - "metadata": {}, - "outputs": [], - "source": [ - "#Get the ephemerides of Mercury for the same timeframe as the simulation\n", - "obj = Horizons(id='1', location='@sun',\n", - " epochs={'start':start_date, 'stop':stop_date,\n", - " 'step':'10y'})\n", - "el = obj.elements()\n", - "t = (el['datetime_jd']-el['datetime_jd'][0]) / 365.25\n", - "varpi_obs = el['w'] + el['Omega']" - ] - }, - { - "cell_type": "code", - "execution_count": null, - "metadata": {}, - "outputs": [], - "source": [ - "varpisim_gr= sim_gr.data['varpi'].sel(name=\"Mercury\")\n", - "varpisim_nogr= sim_nogr.data['varpi'].sel(name=\"Mercury\")\n", - "tsim = sim_gr.data['time']" - ] - }, - { - "cell_type": "code", - "execution_count": null, - "metadata": {}, - "outputs": [], - "source": [ - "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" - ] - }, - { - "cell_type": "code", - "execution_count": null, - "metadata": {}, - "outputs": [], - "source": [ - "fig, ax = plt.subplots()\n", - "\n", - "ax.plot(t, varpi_obs, label=\"JPL Horizons\",linewidth=2.5)\n", - "ax.plot(tsim, varpisim_gr, label=\"Swiftest WHM GR\",linewidth=1.5)\n", - "ax.plot(tsim, varpisim_nogr, label=\"Swiftest WHM No GR\",linewidth=1.5)\n", - "ax.set_xlabel('Time (y)')\n", - "ax.set_ylabel('Mercury $\\\\varpi$ (deg)')\n", - "ax.legend()\n", - "plt.savefig(\"whm_gr_mercury_precession.png\",dpi=300)\n", - "print('Mean precession rate for Mercury long. peri. (arcsec/100 y)')\n", - "print(f'JPL Horizons : {np.mean(dvarpi_obs)}')\n", - "print(f'Swiftest No GR : {np.mean(dvarpi_nogr)}')\n", - "print(f'Swiftest GR : {np.mean(dvarpi_gr)}')\n", - "print(f'Obs - Swiftest GR : {np.mean(dvarpi_obs - dvarpi_gr)}')\n", - "print(f'Obs - Swiftest No GR : {np.mean(dvarpi_obs - dvarpi_nogr)}')" - ] - } - ], - "metadata": { - "kernelspec": { - "display_name": "Python (My debug_env Kernel)", - "language": "python", - "name": "debug_env" - }, - "language_info": { - "codemirror_mode": { - "name": "ipython", - "version": 3 - }, - "file_extension": ".py", - "mimetype": "text/x-python", - "name": "python", - "nbconvert_exporter": "python", - "pygments_lexer": "ipython3", - "version": "3.8.5" - } - }, - "nbformat": 4, - "nbformat_minor": 4 -} From 8980de840b37565e6c2f15026aba289c42776117 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Tue, 6 Dec 2022 11:10:33 -0500 Subject: [PATCH 298/569] Finished restructring the encounter output parsing --- src/io/io.f90 | 3 ++- src/setup/setup.f90 | 1 + src/symba/symba_io.f90 | 9 ++++----- src/symba/symba_step.f90 | 2 -- 4 files changed, 7 insertions(+), 8 deletions(-) diff --git a/src/io/io.f90 b/src/io/io.f90 index 2892d5336..92924d458 100644 --- a/src/io/io.f90 +++ b/src/io/io.f90 @@ -671,7 +671,8 @@ module subroutine io_param_reader(self, unit, iotype, v_list, iostat, iomsg) else if (param_value == "YES" .or. param_value == 'T') then param%lrestart = .true. end if - case ("NPLMAX", "NTPMAX", "GMTINY", "MIN_GMFRAG", "FRAGMENTATION", "SEED", "YARKOVSKY", "YORP") ! Ignore SyMBA-specific, not-yet-implemented, or obsolete input parameters + ! Ignore SyMBA-specific, not-yet-implemented, or obsolete input parameters + case ("NPLMAX", "NTPMAX", "GMTINY", "MIN_GMFRAG", "FRAGMENTATION", "SEED", "YARKOVSKY", "YORP", "ENCOUNTER_SAVE", "FRAGMENTATION_SAVE") case default write(*,*) "Ignoring unknown parameter -> ",param_name end select diff --git a/src/setup/setup.f90 b/src/setup/setup.f90 index e95505b9b..ea6d3db23 100644 --- a/src/setup/setup.f90 +++ b/src/setup/setup.f90 @@ -68,6 +68,7 @@ module subroutine setup_construct_system(system, param) allocate(symba_pltpenc :: system%pltpenc_list) allocate(symba_plplenc :: system%plplenc_list) allocate(symba_plplenc :: system%plplcollision_list) + allocate(symba_encounter_storage :: system%encounter_history) end select case (RINGMOONS) write(*,*) 'RINGMOONS-SyMBA integrator not yet enabled' diff --git a/src/symba/symba_io.f90 b/src/symba/symba_io.f90 index 0300c6dc5..f11863059 100644 --- a/src/symba/symba_io.f90 +++ b/src/symba/symba_io.f90 @@ -301,8 +301,8 @@ module subroutine symba_io_param_reader(self, unit, iotype, v_list, iostat, ioms iostat = -1 return end if - param%lencounter_save = (param%encounter_save /= "TRAJECTORY") .or. (param%encounter_save /= "CLOSEST") .or. & - (param%fragmentation_save /= "TRAJECTORY") .or. (param%fragmentation_save /= "CLOSEST") + param%lencounter_save = (param%encounter_save == "TRAJECTORY") .or. (param%encounter_save == "CLOSEST") .or. & + (param%fragmentation_save == "TRAJECTORY") .or. (param%fragmentation_save == "CLOSEST") ! Call the base method (which also prints the contents to screen) call io_param_reader(param, unit, iotype, v_list, iostat, iomsg) @@ -367,8 +367,8 @@ module subroutine symba_io_start_encounter(self, param, t) class(symba_parameters), intent(inout) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! Current simulation time - if (allocated(self%encounter_history)) deallocate(self%encounter_history) - allocate(symba_encounter_storage :: self%encounter_history) + if (.not. allocated(self%encounter_history)) allocate(symba_encounter_storage :: self%encounter_history) + call self%encounter_history%reset() ! Take the snapshot at the start of the encounter call self%snapshot(param, t) @@ -390,7 +390,6 @@ module subroutine symba_io_stop_encounter(self, param, t) ! Take the final snapshot call self%snapshot(param, t) call self%encounter_history%dump(param) - deallocate(self%encounter_history) return end subroutine symba_io_stop_encounter diff --git a/src/symba/symba_step.f90 b/src/symba/symba_step.f90 index bdf73309b..e727ed9f3 100644 --- a/src/symba/symba_step.f90 +++ b/src/symba/symba_step.f90 @@ -315,8 +315,6 @@ module subroutine symba_step_reset_system(self, param) tp%lfirst = param%lfirstkick pl%lfirst = param%lfirstkick - call system%encounter_history%reset() - end associate end select end select From bd347e30d6ff737afb4f0b2f807b347ced9405ae Mon Sep 17 00:00:00 2001 From: David A Minton Date: Tue, 6 Dec 2022 11:16:36 -0500 Subject: [PATCH 299/569] More maintenence on .gitignore --- .gitignore | 2 +- examples/.gitignore | 2 -- 2 files changed, 1 insertion(+), 3 deletions(-) delete mode 100644 examples/.gitignore diff --git a/.gitignore b/.gitignore index 702fd48c4..ba4f0c843 100644 --- a/.gitignore +++ b/.gitignore @@ -13,7 +13,7 @@ !paper/paper.bib !README.swifter dump* -!.gitignore +!**/.gitignore !*.py !*.ipynb !examples/** diff --git a/examples/.gitignore b/examples/.gitignore deleted file mode 100644 index 139597f9c..000000000 --- a/examples/.gitignore +++ /dev/null @@ -1,2 +0,0 @@ - - From 4b494eba5e0225d1a6905b33d311a0a5a9b83664 Mon Sep 17 00:00:00 2001 From: David Minton Date: Tue, 6 Dec 2022 11:19:01 -0500 Subject: [PATCH 300/569] More changes to .gitignore --- .gitignore | 1 + 1 file changed, 1 insertion(+) diff --git a/.gitignore b/.gitignore index ba4f0c843..2d50953b7 100644 --- a/.gitignore +++ b/.gitignore @@ -18,6 +18,7 @@ dump* !*.ipynb !examples/** *ipynb_checkpoints +**/.DS_Store #Documentation !docs/* From 7df49fa39d45a02dd3b1fcebe083e10a9064772f Mon Sep 17 00:00:00 2001 From: David A Minton Date: Tue, 6 Dec 2022 11:20:38 -0500 Subject: [PATCH 301/569] Getting .gitignore under control in examples --- examples/Basic_Simulation/.gitignore | 6 ++++++ examples/Fragmentation/.gitignore | 3 +++ examples/helio_gr_test/.gitignore | 3 +++ examples/whm_gr_test/.gitignore | 3 +++ 4 files changed, 15 insertions(+) create mode 100644 examples/Basic_Simulation/.gitignore create mode 100644 examples/Fragmentation/.gitignore create mode 100644 examples/helio_gr_test/.gitignore create mode 100644 examples/whm_gr_test/.gitignore diff --git a/examples/Basic_Simulation/.gitignore b/examples/Basic_Simulation/.gitignore new file mode 100644 index 000000000..0a4af3872 --- /dev/null +++ b/examples/Basic_Simulation/.gitignore @@ -0,0 +1,6 @@ +* +!.gitignore +!initial_conditions.py +!output_reader.py +!run_from_file.py +!read_old_run.py diff --git a/examples/Fragmentation/.gitignore b/examples/Fragmentation/.gitignore new file mode 100644 index 000000000..ff09bd225 --- /dev/null +++ b/examples/Fragmentation/.gitignore @@ -0,0 +1,3 @@ +* +!.gitignore +!Fragmentation_Movie.py diff --git a/examples/helio_gr_test/.gitignore b/examples/helio_gr_test/.gitignore new file mode 100644 index 000000000..8968b5dd7 --- /dev/null +++ b/examples/helio_gr_test/.gitignore @@ -0,0 +1,3 @@ +* +!.gitignore +!helio_gr_test.py \ No newline at end of file diff --git a/examples/whm_gr_test/.gitignore b/examples/whm_gr_test/.gitignore new file mode 100644 index 000000000..1463c046c --- /dev/null +++ b/examples/whm_gr_test/.gitignore @@ -0,0 +1,3 @@ +* +!.gitignore +!whm_gr_test.py \ No newline at end of file From 444f7d6ed3cdbe4db997cfdea51e2e661ce149e2 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Tue, 6 Dec 2022 11:24:05 -0500 Subject: [PATCH 302/569] Made an example whitelist .gitignore. --- examples/.gitignore | 6 ++++++ 1 file changed, 6 insertions(+) create mode 100644 examples/.gitignore diff --git a/examples/.gitignore b/examples/.gitignore new file mode 100644 index 000000000..7c5c72692 --- /dev/null +++ b/examples/.gitignore @@ -0,0 +1,6 @@ +* +!.gitignore +!Basic_Simulation/* +!Fragmentation/* +!helio_gr_test/* +!whm_gr_test/* \ No newline at end of file From 8af097644eb034696d1ec128372a3062339e18b7 Mon Sep 17 00:00:00 2001 From: Carlisle Wishard Date: Tue, 6 Dec 2022 11:31:01 -0500 Subject: [PATCH 303/569] updated fragmentation script to new syntax --- .../Fragmentation/swiftest_fragmentation.py | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) diff --git a/examples/Fragmentation/swiftest_fragmentation.py b/examples/Fragmentation/swiftest_fragmentation.py index 241391104..9557c144f 100644 --- a/examples/Fragmentation/swiftest_fragmentation.py +++ b/examples/Fragmentation/swiftest_fragmentation.py @@ -19,23 +19,23 @@ import numpy as np from numpy.random import default_rng -sim_disruption = swiftest.Simulation(param_file="param.disruption.in", output_file_name="disruption.nc", tstart=0.0, tstop=1.0e-5, dt=1.0e-8, istep_out=1.0, fragmentation=True, minimum_fragment_gmass=1.0e-11, gmtiny=1.0e-11, output_file_format="XVEL", init_cond_format="XV") +sim_disruption = swiftest.Simulation(simdir="disruption", tstart=0.0, tstop=1.0e-5, dt=1.0e-8, istep_out=1.0, fragmentation=True, minimum_fragment_gmass=1.0e-11, gmtiny=1.0e-11, output_file_format="XVEL", init_cond_format="XV") sim_disruption.add_solar_system_body(["Sun"]) -sim_disruption.add_body(name="Target", v1=1.0, v2=-1.807993e-05, v3=0.0, v4=-2.562596e-04, v5=6.280005, v6=0.0, idvals=1, Gmass=1e-7, radius=7e-6, rhill=9e-4, Ip1=0.4, Ip2=0.4, Ip3=0.4, rotx=0.0, roty=0.0, rotz=0.0) -sim_disruption.add_body(name="Projectile", v1=1.0, v2=1.807993e-05, v3=0.0, v4=-2.562596e-04, v5=-6.280005, v6=0.0, idvals=2, Gmass=7e-10, radius=3.25e-6, rhill=4e-4, Ip1=0.4, Ip2=0.4, Ip3=0.4, rotx=0.0, roty=0.0, rotz=0.0) +sim_disruption.add_body(name="Target", rh=[[1.0, -1.807993e-05, 0.0]], vh=[[-2.562596e-04, 6.280005, 0.0]], Gmass=1e-7, radius=7e-6, rhill=9e-4, Ip=[[0.4, 0.4, 0.4]], rot=[[0.0, 0.0, 0.0]]) +sim_disruption.add_body(name="Projectile", rh=[[1.0, 1.807993e-05, 0.0]], vh=[[-2.562596e-04, -6.280005, 0.0]], Gmass=7e-10, radius=3.25e-6, rhill=4e-4, Ip=[[0.4, 0.4, 0.4]], rot=[[0.0, 0.0, 0.0]]) sim_disruption.get_parameter() sim_disruption.run() -sim_hitandrun = swiftest.Simulation(param_file="param.hitandrun.in", output_file_name="hitandrun.nc", tstart=0.0, tstop=1.0e-5, dt=1.0e-8, istep_out=1.0, fragmentation=True, minimum_fragment_gmass=1.0e-11, gmtiny=1.0e-11, output_file_format="XVEL", init_cond_format="XV") +sim_hitandrun = swiftest.Simulation(simdir="hitandrun", tstart=0.0, tstop=1.0e-5, dt=1.0e-8, istep_out=1.0, fragmentation=True, minimum_fragment_gmass=1.0e-11, gmtiny=1.0e-11, output_file_format="XVEL", init_cond_format="XV") sim_hitandrun.add_solar_system_body(["Sun"]) -sim_hitandrun.add_body(name="Target", v1=1.0, v2=-4.2e-05, v3=0.0, v4=0.0, v5=6.28, v6=0.0, idvals=1, Gmass=1e-7, radius=7e-6, rhill=9e-4, Ip1=0.4, Ip2=0.4, Ip3=0.4, rotx=0.0, roty=0.0, rotz=6.0e4) -sim_hitandrun.add_body(name="Projectile", v1=1.0, v2=4.2e-05, v3=0.0, v4=-1.5, v5=-6.28, v6=0.0, idvals=2, Gmass=7e-10, radius=3.25e-6, rhill=4e-4, Ip1=0.4, Ip2=0.4, Ip3=0.4, rotx=0.0, roty=0.0, rotz=1.0e5) +sim_hitandrun.add_body(name="Target", rh=[[1.0, -4.2e-05, 0.0]], vh=[[0.0, 6.28, 0.0]], Gmass=1e-7, radius=7e-6, rhill=9e-4, Ip=[[0.4, 0.4, 0.4]], rot=[[0.0, 0.0, 6.0e4]]) +sim_hitandrun.add_body(name="Projectile", rh=[[1.0, 4.2e-05, 0.0]], vh=[[-1.5, -6.28, 0.0]], Gmass=7e-10, radius=3.25e-6, rhill=4e-4, Ip=[[0.4, 0.4, 0.4]], rot=[[0.0, 0.0, 1.0e5]]) sim_hitandrun.get_parameter() sim_hitandrun.run() -sim_supercat = swiftest.Simulation(param_file="param.supercat.in", output_file_name="supercat.nc", tstart=0.0, tstop=1.0e-5, dt=1.0e-8, istep_out=1.0, fragmentation=True, minimum_fragment_gmass=1.0e-11, gmtiny=1.0e-11, output_file_format="XVEL", init_cond_format="XV") +sim_supercat = swiftest.Simulation(simdir="supercat", tstart=0.0, tstop=1.0e-5, dt=1.0e-8, istep_out=1.0, fragmentation=True, minimum_fragment_gmass=1.0e-11, gmtiny=1.0e-11, output_file_format="XVEL", init_cond_format="XV") sim_supercat.add_solar_system_body(["Sun"]) -sim_supercat.add_body(name="Target", v1=1.0, v2=-4.2e-05, v3=0.0, v4=0.0, v5=6.28, v6=0.0, idvals=1, Gmass=1e-7, radius=7e-6, rhill=9e-4, Ip1=0.4, Ip2=0.4, Ip3=0.4, rotx=0.0, roty=0.0, rotz=-6.0e4) -sim_supercat.add_body(name="Projectile", v1=1.0, v2=4.2e-05, v3=0.0, v4=1.0, v5=-6.28, v6=0.0, idvals=2, Gmass=1e-8, radius=3.25e-6, rhill=4e-4, Ip1=0.4, Ip2=0.4, Ip3=0.4, rotx=0.0, roty=0.0, rotz=1.0e5) +sim_supercat.add_body(name="Target", rh=[[1.0, -4.2e-05, 0.0]], vh=[[0.0, 6.28, 0.0]], Gmass=1e-7, radius=7e-6, rhill=9e-4, Ip=[[0.4, 0.4, 0.4]], rot=[[0.0, 0.0, -6.0e4]]) +sim_supercat.add_body(name="Projectile", rh=[[1.0, 4.2e-05, 0.0]], vh=[[1.0, -6.28, 0.0]], Gmass=1e-8, radius=3.25e-6, rhill=4e-4, Ip=[[0.4, 0.4, 0.4]], rot=[[0.0, 0.0, 1.0e5]]) sim_supercat.get_parameter() sim_supercat.run() From 4a6e1ddffc7c5380e1251d2306146900941d7f4b Mon Sep 17 00:00:00 2001 From: David A Minton Date: Tue, 6 Dec 2022 11:32:59 -0500 Subject: [PATCH 304/569] Updates to encounter writing methods --- src/symba/symba_io.f90 | 28 +++++++++++++++++----------- 1 file changed, 17 insertions(+), 11 deletions(-) diff --git a/src/symba/symba_io.f90 b/src/symba/symba_io.f90 index f11863059..bb84af1c3 100644 --- a/src/symba/symba_io.f90 +++ b/src/symba/symba_io.f90 @@ -23,17 +23,16 @@ module subroutine symba_io_encounter_dump(self, param) integer(I4B) :: i ! Most of this is just temporary test code just to get something working. Eventually this should get cleaned up. - call self%nc%initialize(param) + do i = 1, self%nframes if (allocated(self%frame(i)%item)) then select type(snapshot => self%frame(i)%item) class is (symba_encounter_snapshot) - self%nc%ienc_frame = self%nc%ienc_frame + 1 + self%nc%ienc_frame = i call snapshot%write_frame(self%nc,param) end select end if end do - !call self%nc%close() return @@ -156,16 +155,16 @@ module subroutine symba_io_encounter_write_frame(self, nc, param) n = size(pl%id(:)) do i = 1, n idslot = pl%id(i) - call check( nf90_set_fill(nc%id, nf90_nofill, old_mode), "symba_io_encounter_write_frame_base nf90_set_fill" ) + call check( nf90_set_fill(nc%id, nf90_nofill, old_mode), "symba_io_encounter_write_frame nf90_set_fill" ) call check( nf90_put_var(nc%id, nc%time_varid, self%t, start=[tslot]), "symba_io_encounter_write_frame nf90_put_var time_varid" ) - call check( nf90_put_var(nc%id, nc%id_varid, pl%id(i), start=[idslot]), "symba_io_encounter_write_frame_base nf90_put_var id_varid" ) - call check( nf90_put_var(nc%id, nc%rh_varid, pl%rh(:,i), start=[1,idslot,tslot], count=[NDIM,1,1]), "symba_io_encounter_write_frame_base nf90_put_var rh_varid" ) - call check( nf90_put_var(nc%id, nc%vh_varid, pl%vh(:,i), start=[1,idslot,tslot], count=[NDIM,1,1]), "symba_io_encounter_write_frame_base nf90_put_var vh_varid" ) - call check( nf90_put_var(nc%id, nc%Gmass_varid, pl%Gmass(i), start=[idslot, tslot]), "symba_io_encounter_write_frame_base nf90_put_var body Gmass_varid" ) - if (param%lclose) call check( nf90_put_var(nc%id, nc%radius_varid, pl%radius(i), start=[idslot, tslot]), "symba_io_encounter_write_frame_base nf90_put_var body radius_varid" ) + call check( nf90_put_var(nc%id, nc%id_varid, pl%id(i), start=[idslot]), "symba_io_encounter_write_frame nf90_put_var id_varid" ) + call check( nf90_put_var(nc%id, nc%rh_varid, pl%rh(:,i), start=[1,idslot,tslot], count=[NDIM,1,1]), "symba_io_encounter_write_frame nf90_put_var rh_varid" ) + call check( nf90_put_var(nc%id, nc%vh_varid, pl%vh(:,i), start=[1,idslot,tslot], count=[NDIM,1,1]), "symba_io_encounter_write_frame nf90_put_var vh_varid" ) + call check( nf90_put_var(nc%id, nc%Gmass_varid, pl%Gmass(i), start=[idslot, tslot]), "symba_io_encounter_write_frame nf90_put_var body Gmass_varid" ) + if (param%lclose) call check( nf90_put_var(nc%id, nc%radius_varid, pl%radius(i), start=[idslot, tslot]), "symba_io_encounter_write_frame nf90_put_var body radius_varid" ) if (param%lrotation) then - call check( nf90_put_var(nc%id, nc%Ip_varid, pl%Ip(:,i), start=[1, idslot, tslot], count=[NDIM,1,1]), "symba_io_encounter_write_frame_base nf90_put_var body Ip_varid" ) - call check( nf90_put_var(nc%id, nc%rot_varid, pl%rot(:,i), start=[1,idslot, tslot], count=[NDIM,1,1]), "symba_io_encounter_write_frame_base nf90_put_var body rotx_varid" ) + call check( nf90_put_var(nc%id, nc%Ip_varid, pl%Ip(:,i), start=[1, idslot, tslot], count=[NDIM,1,1]), "symba_io_encounter_write_frame nf90_put_var body Ip_varid" ) + call check( nf90_put_var(nc%id, nc%rot_varid, pl%rot(:,i), start=[1,idslot, tslot], count=[NDIM,1,1]), "symba_io_encounter_write_frame nf90_put_var body rotx_varid" ) end if charstring = trim(adjustl(pl%info(i)%name)) call check( nf90_put_var(nc%id, nc%name_varid, charstring, start=[1, idslot], count=[NAMELEN, 1]), "symba_io_encounter_write_frame nf90_put_var name_varid" ) @@ -386,10 +385,17 @@ module subroutine symba_io_stop_encounter(self, param, t) class(symba_nbody_system), intent(inout) :: self !! SyMBA nbody system object class(symba_parameters), intent(inout) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! Current simulation time + ! Internals + !character(STRMAX) ! Take the final snapshot call self%snapshot(param, t) + + ! Create and save the output file for this encounter + write(self%encounter_history%nc%enc_file, '("encounter_",I0.6,".nc")') param%iloop + call self%encounter_history%nc%initialize(param) call self%encounter_history%dump(param) + call self%encounter_history%nc%close() return end subroutine symba_io_stop_encounter From c40683ed8511eeed4145c364b8817381ab19bcb3 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Tue, 6 Dec 2022 11:33:45 -0500 Subject: [PATCH 305/569] Moved the set_fill command out of the loop --- src/symba/symba_io.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/symba/symba_io.f90 b/src/symba/symba_io.f90 index bb84af1c3..2bec44ffb 100644 --- a/src/symba/symba_io.f90 +++ b/src/symba/symba_io.f90 @@ -150,12 +150,12 @@ module subroutine symba_io_encounter_write_frame(self, nc, param) character(len=NAMELEN) :: charstring tslot = nc%ienc_frame + call check( nf90_set_fill(nc%id, nf90_nofill, old_mode), "symba_io_encounter_write_frame nf90_set_fill" ) select type(pl => self%pl) class is (symba_pl) n = size(pl%id(:)) do i = 1, n idslot = pl%id(i) - call check( nf90_set_fill(nc%id, nf90_nofill, old_mode), "symba_io_encounter_write_frame nf90_set_fill" ) call check( nf90_put_var(nc%id, nc%time_varid, self%t, start=[tslot]), "symba_io_encounter_write_frame nf90_put_var time_varid" ) call check( nf90_put_var(nc%id, nc%id_varid, pl%id(i), start=[idslot]), "symba_io_encounter_write_frame nf90_put_var id_varid" ) call check( nf90_put_var(nc%id, nc%rh_varid, pl%rh(:,i), start=[1,idslot,tslot], count=[NDIM,1,1]), "symba_io_encounter_write_frame nf90_put_var rh_varid" ) From 7dadfa6e0fc7d61070275cefd56039a28ddc8e6c Mon Sep 17 00:00:00 2001 From: David A Minton Date: Tue, 6 Dec 2022 11:38:04 -0500 Subject: [PATCH 306/569] Got rid of return statement that was only there because of previous testing --- src/symba/symba_io.f90 | 1 - 1 file changed, 1 deletion(-) diff --git a/src/symba/symba_io.f90 b/src/symba/symba_io.f90 index 2bec44ffb..5c4069a26 100644 --- a/src/symba/symba_io.f90 +++ b/src/symba/symba_io.f90 @@ -73,7 +73,6 @@ module subroutine symba_io_encounter_initialize_output(self, param) ! Check if the file exists, and if it does, delete it inquire(file=nc%enc_file, exist=fileExists) if (fileExists) then - return open(unit=LUN, file=nc%enc_file, status="old", err=667, iomsg=errmsg) close(unit=LUN, status="delete") end if From 0a71ee77a9ad25d15ac06923e5a044700d808ac5 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Tue, 6 Dec 2022 11:41:20 -0500 Subject: [PATCH 307/569] Added new parameters to defaults --- python/swiftest/swiftest/simulation_class.py | 2 ++ 1 file changed, 2 insertions(+) diff --git a/python/swiftest/swiftest/simulation_class.py b/python/swiftest/swiftest/simulation_class.py index a3723553d..7afc72b76 100644 --- a/python/swiftest/swiftest/simulation_class.py +++ b/python/swiftest/swiftest/simulation_class.py @@ -789,6 +789,8 @@ def set_parameter(self, verbose: bool = True, **kwargs): "encounter_check_loops": "TRIANGULAR", "ephemeris_date": "MBCL", "restart": False, + "encounter_save" : "NONE", + "fragmentation_save" : "NONE" } param_file = kwargs.pop("param_file",None) From d5c1c5a08daa7960822b6a6299711bcd085d7eba Mon Sep 17 00:00:00 2001 From: David A Minton Date: Tue, 6 Dec 2022 12:08:14 -0500 Subject: [PATCH 308/569] Added new ability to process multiple encounter files on the Python side --- examples/Fragmentation/Fragmentation_Movie.py | 2 +- python/swiftest/swiftest/io.py | 41 ++++++++++++++----- python/swiftest/swiftest/simulation_class.py | 29 +++++++++---- 3 files changed, 54 insertions(+), 18 deletions(-) diff --git a/examples/Fragmentation/Fragmentation_Movie.py b/examples/Fragmentation/Fragmentation_Movie.py index ba98c6900..f5f9cd792 100644 --- a/examples/Fragmentation/Fragmentation_Movie.py +++ b/examples/Fragmentation/Fragmentation_Movie.py @@ -180,6 +180,6 @@ def data_stream(self, frame=0): 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, fragmentation_save="TRAJECTORY", gmtiny=gmtiny, minimum_fragment_gmass=minimum_fragment_gmass, verbose=False) - sim.run(dt=1e-5, tstop=2.0e-3, istep_out=1, dump_cadence=0) + sim.run(dt=1e-4, tstop=2.0e-3, istep_out=1, dump_cadence=0) anim = AnimatedScatter(sim,movie_filename,movie_titles[style],nskip=1) diff --git a/python/swiftest/swiftest/io.py b/python/swiftest/swiftest/io.py index e315cd244..78d71c820 100644 --- a/python/swiftest/swiftest/io.py +++ b/python/swiftest/swiftest/io.py @@ -800,6 +800,35 @@ def swifter2xr(param, verbose=True): if verbose: print(f"Successfully converted {ds.sizes['time']} output frames.") return ds +def process_netcdf_intput(ds, param): + """ + Performs several tasks to convert raw NetCDF files output by the Fortran program into a form that + is used by the Python side. These include: + - Ensuring all types are correct + - Removing any bad id values (empty id slots) + - Swapping the id and name dimension if the names are unique + + Parameters + ---------- + ds : Xarray dataset + + Returns + ------- + ds : xarray dataset + """ + + if param['OUT_TYPE'] == "NETCDF_DOUBLE": + ds = fix_types(ds,ftype=np.float64) + elif param['OUT_TYPE'] == "NETCDF_FLOAT": + ds = fix_types(ds,ftype=np.float32) + ds = ds.where(ds.id >=0 ,drop=True) + # Check if the name variable contains unique values. If so, make name the dimension instead of id + if len(np.unique(ds['name'])) == len(ds['name']): + ds = ds.swap_dims({"id" : "name"}) + ds = ds.reset_coords("id") + + return ds + def swiftest2xr(param, verbose=True): """ Converts a Swiftest binary data file into an xarray DataSet. @@ -814,19 +843,11 @@ def swiftest2xr(param, verbose=True): xarray dataset """ + if ((param['OUT_TYPE'] == 'NETCDF_DOUBLE') or (param['OUT_TYPE'] == 'NETCDF_FLOAT')): if verbose: print('\nCreating Dataset from NetCDF file') ds = xr.open_dataset(param['BIN_OUT'], mask_and_scale=False) - - if param['OUT_TYPE'] == "NETCDF_DOUBLE": - ds = fix_types(ds,ftype=np.float64) - elif param['OUT_TYPE'] == "NETCDF_FLOAT": - ds = fix_types(ds,ftype=np.float32) - ds = ds.where(ds.id >=0 ,drop=True) - # Check if the name variable contains unique values. If so, make name the dimension instead of id - if len(np.unique(ds['name'])) == len(ds['name']): - ds = ds.swap_dims({"id" : "name"}) - ds = ds.reset_coords("id") + ds = process_netcdf_intput(ds, param) else: print(f"Error encountered. OUT_TYPE {param['OUT_TYPE']} not recognized.") return None diff --git a/python/swiftest/swiftest/simulation_class.py b/python/swiftest/swiftest/simulation_class.py index 7afc72b76..3c9105554 100644 --- a/python/swiftest/swiftest/simulation_class.py +++ b/python/swiftest/swiftest/simulation_class.py @@ -21,6 +21,7 @@ import datetime import xarray as xr import numpy as np +from functools import partial import numpy.typing as npt import shutil import subprocess @@ -355,7 +356,6 @@ def __init__(self,read_param: bool = False, read_old_output_file: bool = False, # overriding everything with defaults when there are no arguments passed to Simulation() kwargs['param_file'] = self.param_file param_file_found = True - else: param_file_found = False @@ -2729,8 +2729,10 @@ def read_output_file(self,read_init_cond : bool = True): # This is done to handle cases where the method is called from a different working directory than the simulation # results - # EXPERIMENTAL - read_encounter = True + if "ENCOUNTER_SAVE" in self.param or "FRAGMENTATION_SAVE" in self.param: + read_encounter = self.param["ENCOUNTER_SAVE"] != "NONE" or self.param["FRAGMENTATION_SAVE"] != "NONE" + else: + read_encounter = False param_tmp = self.param.copy() param_tmp['BIN_OUT'] = os.path.join(self.simdir, self.param['BIN_OUT']) if self.codename == "Swiftest": @@ -2746,10 +2748,7 @@ def read_output_file(self,read_init_cond : bool = True): else: self.ic = self.data.isel(time=0) if read_encounter: - param_tmp['BIN_OUT'] = self.simdir / "encounter.nc" - if self.verbose: - print("Reading encounter history file as .enc") - self.enc = io.swiftest2xr(param_tmp, verbose=self.verbose) + self.read_encounter() elif self.codename == "Swifter": self.data = io.swifter2xr(param_tmp, verbose=self.verbose) @@ -2760,6 +2759,22 @@ def read_output_file(self,read_init_cond : bool = True): warnings.warn('Cannot process unknown code type. Call the read_param method with a valid code name. Valid options are "Swiftest", "Swifter", or "Swift".',stacklevel=2) return + def read_encounter(self): + if self.verbose: + print("Reading encounter history file as .enc") + enc_files = self.simdir.glob("**/enc_*.nc") + + # This is needed in order to pass the param argument down to the io.process_netcdf_input function + def _preprocess(ds, param): + return io.process_netcdf_input(ds,param) + partial_func = partial(_precprocess, param=self.param) + + self.enc = xr.open_mfdataset(enc_files,parallel=True,combine="nested", concat_dim="encounter",preprocess=partial_func) + + return + + + def follow(self, codestyle="Swifter"): """ An implementation of the Swift tool_follow algorithm. Under development. Currently only for Swift simulations. From 223d24c57145e4dd530d6cc9fc3bd38fc824faef Mon Sep 17 00:00:00 2001 From: David A Minton Date: Tue, 6 Dec 2022 12:08:53 -0500 Subject: [PATCH 309/569] Fixed typo --- python/swiftest/swiftest/simulation_class.py | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/python/swiftest/swiftest/simulation_class.py b/python/swiftest/swiftest/simulation_class.py index 3c9105554..1bcd59ac8 100644 --- a/python/swiftest/swiftest/simulation_class.py +++ b/python/swiftest/swiftest/simulation_class.py @@ -2767,7 +2767,7 @@ def read_encounter(self): # This is needed in order to pass the param argument down to the io.process_netcdf_input function def _preprocess(ds, param): return io.process_netcdf_input(ds,param) - partial_func = partial(_precprocess, param=self.param) + partial_func = partial(_preprocess, param=self.param) self.enc = xr.open_mfdataset(enc_files,parallel=True,combine="nested", concat_dim="encounter",preprocess=partial_func) From 0d4c21592deeb595c14b82ffc8d400b77b49d219 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Tue, 6 Dec 2022 12:10:36 -0500 Subject: [PATCH 310/569] Fixed typo --- python/swiftest/swiftest/simulation_class.py | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/python/swiftest/swiftest/simulation_class.py b/python/swiftest/swiftest/simulation_class.py index 1bcd59ac8..ea35bae91 100644 --- a/python/swiftest/swiftest/simulation_class.py +++ b/python/swiftest/swiftest/simulation_class.py @@ -2762,7 +2762,7 @@ def read_output_file(self,read_init_cond : bool = True): def read_encounter(self): if self.verbose: print("Reading encounter history file as .enc") - enc_files = self.simdir.glob("**/enc_*.nc") + enc_files = self.simdir.glob("**/encounter_*.nc") # This is needed in order to pass the param argument down to the io.process_netcdf_input function def _preprocess(ds, param): From 0fdf1972df81945bb893fa7eddbee980b42e62cb Mon Sep 17 00:00:00 2001 From: David A Minton Date: Tue, 6 Dec 2022 12:12:50 -0500 Subject: [PATCH 311/569] Made sure to reset the encounter_history after a file dump --- python/swiftest/swiftest/simulation_class.py | 1 - src/symba/symba_io.f90 | 1 + 2 files changed, 1 insertion(+), 1 deletion(-) diff --git a/python/swiftest/swiftest/simulation_class.py b/python/swiftest/swiftest/simulation_class.py index ea35bae91..e5e71a943 100644 --- a/python/swiftest/swiftest/simulation_class.py +++ b/python/swiftest/swiftest/simulation_class.py @@ -2774,7 +2774,6 @@ def _preprocess(ds, param): return - def follow(self, codestyle="Swifter"): """ An implementation of the Swift tool_follow algorithm. Under development. Currently only for Swift simulations. diff --git a/src/symba/symba_io.f90 b/src/symba/symba_io.f90 index 5c4069a26..93c4556e5 100644 --- a/src/symba/symba_io.f90 +++ b/src/symba/symba_io.f90 @@ -395,6 +395,7 @@ module subroutine symba_io_stop_encounter(self, param, t) call self%encounter_history%nc%initialize(param) call self%encounter_history%dump(param) call self%encounter_history%nc%close() + call self%encounter_history%reset() return end subroutine symba_io_stop_encounter From d64e121faf6ecc9dc2d724620a319551060b779a Mon Sep 17 00:00:00 2001 From: David A Minton Date: Tue, 6 Dec 2022 12:13:52 -0500 Subject: [PATCH 312/569] Fixed another stupid typo. I need lunch. --- python/swiftest/swiftest/io.py | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/python/swiftest/swiftest/io.py b/python/swiftest/swiftest/io.py index 78d71c820..6621f8c19 100644 --- a/python/swiftest/swiftest/io.py +++ b/python/swiftest/swiftest/io.py @@ -800,7 +800,7 @@ def swifter2xr(param, verbose=True): if verbose: print(f"Successfully converted {ds.sizes['time']} output frames.") return ds -def process_netcdf_intput(ds, param): +def process_netcdf_input(ds, param): """ Performs several tasks to convert raw NetCDF files output by the Fortran program into a form that is used by the Python side. These include: @@ -847,7 +847,7 @@ def swiftest2xr(param, verbose=True): if ((param['OUT_TYPE'] == 'NETCDF_DOUBLE') or (param['OUT_TYPE'] == 'NETCDF_FLOAT')): if verbose: print('\nCreating Dataset from NetCDF file') ds = xr.open_dataset(param['BIN_OUT'], mask_and_scale=False) - ds = process_netcdf_intput(ds, param) + ds = process_netcdf_input(ds, param) else: print(f"Error encountered. OUT_TYPE {param['OUT_TYPE']} not recognized.") return None From 6ae67f0f0bbfa8d8ff0d28d5c379badcbb80aab5 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Tue, 6 Dec 2022 12:16:56 -0500 Subject: [PATCH 313/569] Removed final snapshot to prevent duplicate time entries --- src/symba/symba_io.f90 | 3 --- 1 file changed, 3 deletions(-) diff --git a/src/symba/symba_io.f90 b/src/symba/symba_io.f90 index 93c4556e5..34885acc3 100644 --- a/src/symba/symba_io.f90 +++ b/src/symba/symba_io.f90 @@ -387,9 +387,6 @@ module subroutine symba_io_stop_encounter(self, param, t) ! Internals !character(STRMAX) - ! Take the final snapshot - call self%snapshot(param, t) - ! Create and save the output file for this encounter write(self%encounter_history%nc%enc_file, '("encounter_",I0.6,".nc")') param%iloop call self%encounter_history%nc%initialize(param) From 54f68790db91da713f515f90206343c0e5dec611 Mon Sep 17 00:00:00 2001 From: Carlisle Wishard Date: Tue, 6 Dec 2022 13:08:42 -0500 Subject: [PATCH 314/569] updated headers of python scripts --- .../Basic_Simulation/initial_conditions.py | 25 ++++++++++++++----- examples/Basic_Simulation/output_reader.py | 13 +++++----- 2 files changed, 25 insertions(+), 13 deletions(-) diff --git a/examples/Basic_Simulation/initial_conditions.py b/examples/Basic_Simulation/initial_conditions.py index 7e0218a03..33ee65110 100644 --- a/examples/Basic_Simulation/initial_conditions.py +++ b/examples/Basic_Simulation/initial_conditions.py @@ -11,18 +11,31 @@ #!/usr/bin/env python3 """ -Generates a set of Swiftest input files from initial conditions. +Generates and runs a set of Swiftest input files from initial conditions. All simulation outputs are stored in the +/simdata subdirectory. -Returns -------- -Updates sim.data with the simulation data +Input +------ +None + +Output +------ +bin.nc : A NetCDF file containing the simulation output. +dump_bin1.nc : A NetCDF file containing the necessary inputs to restart a simulation from t!=0. +dump_bin2.nc : A NetCDF file containing the necessary inputs to restart a simulation from t!=0. +dump_param1.nc : A NetCDF file containing the necessary parameters to restart a simulation. +dump_param2.nc : A NetCDF file containing the necessary parameters to restart a simulation. +fraggle.log : An ASCII file containing the information of any collisional events that occured. +init_cond.nc : A NetCDF file containing the initial conditions for the simulation. +param.in : An ASCII file containing the parameters for the simulation. +swiftest.log : An ASCII file containing the information on the status of the simulation as it runs. """ import swiftest import numpy as np from numpy.random import default_rng -# Initialize the simulation object as a variable +# Initialize the simulation object as a variable. Arguments may be defined here or through the sim.run() method. sim = swiftest.Simulation(fragmentation=True, minimum_fragment_mass = 2.5e-11, mtiny=2.5e-8) # Add the modern planets and the Sun using the JPL Horizons Database @@ -62,5 +75,5 @@ # Display the run configuration parameters sim.get_parameter() -# Run the simulation +# Run the simulation. Arguments may be defined here or thorugh the swiftest.Simulation() method. sim.run(tstart=0.0, tstop=1.0e3, dt=0.01, tstep_out=1.0e0, dump_cadence=0) diff --git a/examples/Basic_Simulation/output_reader.py b/examples/Basic_Simulation/output_reader.py index 611e85a36..5d7f496b7 100644 --- a/examples/Basic_Simulation/output_reader.py +++ b/examples/Basic_Simulation/output_reader.py @@ -14,14 +14,13 @@ Reads and processes a Swiftest output file. Input -------- -out.nc : NetCDF file - Swiftest output file. +------ +bin.nc : A NetCDF file containing the simulation output. -Returns -------- -output.eps : Encapsulated PostScript file. - A figure containing the eccentricity vs. semi-major axis for all bodies at the start of the simulation. +Output +------ +output.eps : Encapsulated PostScript file depicting the eccentricity vs. semi-major axis for all bodies at the start + of the simulation. """ import swiftest From 2e6ad63eb05b59abe2ed0250c3c1743e87f54b20 Mon Sep 17 00:00:00 2001 From: Carlisle Wishard Date: Tue, 6 Dec 2022 13:19:46 -0500 Subject: [PATCH 315/569] updated headers --- examples/Basic_Simulation/initial_conditions.py | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/examples/Basic_Simulation/initial_conditions.py b/examples/Basic_Simulation/initial_conditions.py index 33ee65110..6ac43c7fd 100644 --- a/examples/Basic_Simulation/initial_conditions.py +++ b/examples/Basic_Simulation/initial_conditions.py @@ -11,8 +11,8 @@ #!/usr/bin/env python3 """ -Generates and runs a set of Swiftest input files from initial conditions. All simulation outputs are stored in the -/simdata subdirectory. +Generates and runs a set of Swiftest input files from initial conditions with the SyMBA integrator. All simulation +outputs are stored in the /simdata subdirectory. Input ------ @@ -23,8 +23,8 @@ bin.nc : A NetCDF file containing the simulation output. dump_bin1.nc : A NetCDF file containing the necessary inputs to restart a simulation from t!=0. dump_bin2.nc : A NetCDF file containing the necessary inputs to restart a simulation from t!=0. -dump_param1.nc : A NetCDF file containing the necessary parameters to restart a simulation. -dump_param2.nc : A NetCDF file containing the necessary parameters to restart a simulation. +dump_param1.in : An ASCII file containing the necessary parameters to restart a simulation. +dump_param2.in : An ASCII file containing the necessary parameters to restart a simulation. fraggle.log : An ASCII file containing the information of any collisional events that occured. init_cond.nc : A NetCDF file containing the initial conditions for the simulation. param.in : An ASCII file containing the parameters for the simulation. From 2eca27f1593ea6392e093f5ea9857e742949117e Mon Sep 17 00:00:00 2001 From: Carlisle Wishard Date: Tue, 6 Dec 2022 13:25:41 -0500 Subject: [PATCH 316/569] added a header and some comments to the helio_gr_test example --- examples/helio_gr_test/helio_gr_test.py | 53 ++++++++++++++++++++++++- 1 file changed, 52 insertions(+), 1 deletion(-) diff --git a/examples/helio_gr_test/helio_gr_test.py b/examples/helio_gr_test/helio_gr_test.py index 0d9339dbe..1b0033ab1 100644 --- a/examples/helio_gr_test/helio_gr_test.py +++ b/examples/helio_gr_test/helio_gr_test.py @@ -1,18 +1,67 @@ -#!/usr/bin/env python +""" + Copyright 2022 - David Minton, Carlisle Wishard, Jennifer Pouplin, Jake Elliott, & Dana Singh + This file is part of Swiftest. + Swiftest is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License + as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. + Swiftest is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty + of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. + You should have received a copy of the GNU General Public License along with Swiftest. + If not, see: https://www.gnu.org/licenses. +""" + +#!/usr/bin/env python3 +""" +Generates and runs two sets of Swiftest input files from initial conditions with the helio integrator. All simulation +outputs for the general relativity run are stored in the /gr subdirectory while all simulation outputs for the run +without general reelativity are stored in the /nogr subdirectory. + +Input +------ +None + +Output +------ +helio_gr_mercury_precession.png : Portable Network Graphic file depicting the precession of Mercury's perihelion over time + with data sourced from the JPL Horizons database, Swiftest run with general relativity, + and Swiftest run without general relativity. +gr/bin.nc : A NetCDF file containing the simulation output. +gr/dump_bin1.nc : A NetCDF file containing the necessary inputs to restart a simulation from t!=0. +gr/dump_bin2.nc : A NetCDF file containing the necessary inputs to restart a simulation from t!=0. +gr/dump_param1.in : An ASCII file containing the necessary parameters to restart a simulation. +gr/dump_param2.in : An ASCII file containing the necessary parameters to restart a simulation. +gr/init_cond.nc : A NetCDF file containing the initial conditions for the simulation. +gr/param.in : An ASCII file containing the parameters for the simulation. +gr/swiftest.log : An ASCII file containing the information on the status of the simulation as it runs. +nogr/bin.nc : A NetCDF file containing the simulation output. +nogr/dump_bin1.nc : A NetCDF file containing the necessary inputs to restart a simulation from t!=0. +nogr/dump_bin2.nc : A NetCDF file containing the necessary inputs to restart a simulation from t!=0. +nogr/dump_param1.in : An ASCII file containing the necessary parameters to restart a simulation. +nogr/dump_param2.in : An ASCII file containing the necessary parameters to restart a simulation. +nogr/init_cond.nc : A NetCDF file containing the initial conditions for the simulation. +nogr/param.in : An ASCII file containing the parameters for the simulation. +nogr/swiftest.log : An ASCII file containing the information on the status of the simulation as it runs. +""" + import swiftest from astroquery.jplhorizons import Horizons import datetime import numpy as np import matplotlib.pyplot as plt +# Initialize the simulation object as a variable. Define the directory in which the output will be placed. sim_gr = swiftest.Simulation(simdir="gr") +# Add the modern planets and the Sun using the JPL Horizons Database sim_gr.add_solar_system_body(["Sun","Mercury","Venus","Earth","Mars","Jupiter","Saturn","Uranus","Neptune"]) +# Initialize the simulation object as a variable. Define the directory in which the output will be placed. sim_nogr = swiftest.Simulation(simdir="nogr") +# Add the modern planets and the Sun using the JPL Horizons Database sim_nogr.add_solar_system_body(["Sun","Mercury","Venus","Earth","Mars","Jupiter","Saturn","Uranus","Neptune"]) +# Define a set of arguments that apply to both runs. For a list of possible arguments, see the User Manual. run_args = {"tstop":1000.0, "dt":0.005, "tstep_out":10.0, "dump_cadence": 0,"integrator":"helio"} +# Run both simulations. sim_gr.run(**run_args,general_relativity=True) sim_nogr.run(**run_args,general_relativity=False) @@ -38,6 +87,7 @@ dvarpi_nogr = np.diff(varpisim_nogr) * 3600 * 100 / run_args['tstep_out'] dvarpi_obs = np.diff(varpi_obs) / np.diff(t) * 3600 * 100 +# Plot of the data and save the output plot fig, ax = plt.subplots() ax.plot(t, varpi_obs, label="JPL Horizons",linewidth=2.5) @@ -48,6 +98,7 @@ ax.legend() plt.savefig("helio_gr_mercury_precession.png",dpi=300) +# Print the data to the terminal. print('Mean precession rate for Mercury long. peri. (arcsec/100 y)') print(f'JPL Horizons : {np.mean(dvarpi_obs)}') print(f'Swiftest No GR : {np.mean(dvarpi_nogr)}') From 1ddd2a0f7ad869043c5fdf8c32a0eb1c78abe220 Mon Sep 17 00:00:00 2001 From: Carlisle Wishard Date: Tue, 6 Dec 2022 13:25:57 -0500 Subject: [PATCH 317/569] deleted run_from_file.py --- examples/Basic_Simulation/run_from_file.py | 3 --- 1 file changed, 3 deletions(-) delete mode 100644 examples/Basic_Simulation/run_from_file.py diff --git a/examples/Basic_Simulation/run_from_file.py b/examples/Basic_Simulation/run_from_file.py deleted file mode 100644 index 146286814..000000000 --- a/examples/Basic_Simulation/run_from_file.py +++ /dev/null @@ -1,3 +0,0 @@ -import swiftest -sim = swiftest.Simulation(read_param=True) -sim.run() \ No newline at end of file From 189abeb4ce209c7f17e4553f1f64caec058bdf76 Mon Sep 17 00:00:00 2001 From: Carlisle Wishard Date: Tue, 6 Dec 2022 13:29:58 -0500 Subject: [PATCH 318/569] added a header and some comments to the whm_gr_test example --- examples/whm_gr_test/whm_gr_test.py | 51 ++++++++++++++++++++++++++++- 1 file changed, 50 insertions(+), 1 deletion(-) diff --git a/examples/whm_gr_test/whm_gr_test.py b/examples/whm_gr_test/whm_gr_test.py index 2061e251b..ab397c464 100644 --- a/examples/whm_gr_test/whm_gr_test.py +++ b/examples/whm_gr_test/whm_gr_test.py @@ -1,18 +1,65 @@ -#!/usr/bin/env python +""" + Copyright 2022 - David Minton, Carlisle Wishard, Jennifer Pouplin, Jake Elliott, & Dana Singh + This file is part of Swiftest. + Swiftest is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License + as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. + Swiftest is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty + of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. + You should have received a copy of the GNU General Public License along with Swiftest. + If not, see: https://www.gnu.org/licenses. +""" + +#!/usr/bin/env python3 +""" +Generates and runs two sets of Swiftest input files from initial conditions with the WHM integrator. All simulation +outputs for the general relativity run are stored in the /gr subdirectory while all simulation outputs for the run +without general reelativity are stored in the /nogr subdirectory. + +Input +------ +None + +Output +------ +whm_gr_mercury_precession.png : Portable Network Graphic file depicting the precession of Mercury's perihelion over time + with data sourced from the JPL Horizons database, Swiftest run with general relativity, + and Swiftest run without general relativity. +gr/bin.nc : A NetCDF file containing the simulation output. +gr/dump_bin1.nc : A NetCDF file containing the necessary inputs to restart a simulation from t!=0. +gr/dump_bin2.nc : A NetCDF file containing the necessary inputs to restart a simulation from t!=0. +gr/dump_param1.in : An ASCII file containing the necessary parameters to restart a simulation. +gr/dump_param2.in : An ASCII file containing the necessary parameters to restart a simulation. +gr/init_cond.nc : A NetCDF file containing the initial conditions for the simulation. +gr/param.in : An ASCII file containing the parameters for the simulation. +gr/swiftest.log : An ASCII file containing the information on the status of the simulation as it runs. +nogr/bin.nc : A NetCDF file containing the simulation output. +nogr/dump_bin1.nc : A NetCDF file containing the necessary inputs to restart a simulation from t!=0. +nogr/dump_bin2.nc : A NetCDF file containing the necessary inputs to restart a simulation from t!=0. +nogr/dump_param1.in : An ASCII file containing the necessary parameters to restart a simulation. +nogr/dump_param2.in : An ASCII file containing the necessary parameters to restart a simulation. +nogr/init_cond.nc : A NetCDF file containing the initial conditions for the simulation. +nogr/param.in : An ASCII file containing the parameters for the simulation. +nogr/swiftest.log : An ASCII file containing the information on the status of the simulation as it runs. +""" + import swiftest from astroquery.jplhorizons import Horizons import datetime import numpy as np import matplotlib.pyplot as plt +# Initialize the simulation object as a variable. Define the directory in which the output will be placed. sim_gr = swiftest.Simulation(simdir="gr") sim_gr.add_solar_system_body(["Sun","Mercury","Venus","Earth","Mars","Jupiter","Saturn","Uranus","Neptune"]) +# Initialize the simulation object as a variable. Define the directory in which the output will be placed. sim_nogr = swiftest.Simulation(simdir="nogr") sim_nogr.add_solar_system_body(["Sun","Mercury","Venus","Earth","Mars","Jupiter","Saturn","Uranus","Neptune"]) +# Define a set of arguments that apply to both runs. For a list of possible arguments, see the User Manual. run_args = {"tstop":1000.0, "dt":0.005, "tstep_out":10.0, "dump_cadence": 0,"integrator":"whm"} +# Run both simulations. sim_gr.run(**run_args,general_relativity=True) sim_nogr.run(**run_args,general_relativity=False) @@ -38,6 +85,7 @@ dvarpi_nogr = np.diff(varpisim_nogr) * 3600 * 100 / run_args['tstep_out'] dvarpi_obs = np.diff(varpi_obs) / np.diff(t) * 3600 * 100 +# Plot of the data and save the output plot fig, ax = plt.subplots() ax.plot(t, varpi_obs, label="JPL Horizons",linewidth=2.5) @@ -48,6 +96,7 @@ ax.legend() plt.savefig("whm_gr_mercury_precession.png",dpi=300) +# Print the data to the terminal. print('Mean precession rate for Mercury long. peri. (arcsec/100 y)') print(f'JPL Horizons : {np.mean(dvarpi_obs)}') print(f'Swiftest No GR : {np.mean(dvarpi_nogr)}') From f046b6aa41fcacafbb4a00db20160e7ca001b063 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Tue, 6 Dec 2022 13:34:21 -0500 Subject: [PATCH 319/569] Now only save encounters at unique time slots --- src/modules/swiftest_classes.f90 | 6 +++--- src/modules/symba_classes.f90 | 6 ++++-- src/symba/symba_io.f90 | 5 ++++- src/symba/symba_util.f90 | 19 +++++++++++++++---- 4 files changed, 26 insertions(+), 10 deletions(-) diff --git a/src/modules/swiftest_classes.f90 b/src/modules/swiftest_classes.f90 index cfb8ad604..a3e109bb5 100644 --- a/src/modules/swiftest_classes.f90 +++ b/src/modules/swiftest_classes.f90 @@ -544,9 +544,9 @@ module swiftest_classes type :: swiftest_storage(nframes) !! An class that establishes the pattern for various storage objects - integer(I4B), len :: nframes = 32768 !! Total number of frames that can be stored - type(swiftest_storage_frame), dimension(nframes) :: frame !! Array of stored frames - integer(I4B) :: iframe = 0 !! The current frame number + integer(I4B), len :: nframes = 2048 !! Total number of frames that can be stored + type(swiftest_storage_frame), dimension(nframes) :: frame !! Array of stored frames + integer(I4B) :: iframe = 0 !! The current frame number contains procedure :: dump => io_dump_storage !! Dumps storage object contents to file procedure :: reset => util_reset_storage !! Resets a storage object by deallocating all items and resetting the frame counter to 0 diff --git a/src/modules/symba_classes.f90 b/src/modules/symba_classes.f90 index c715e70da..68b94c373 100644 --- a/src/modules/symba_classes.f90 +++ b/src/modules/symba_classes.f90 @@ -182,7 +182,7 @@ module symba_classes !! NetCDF dimension and variable names for the enounter save object type, extends(netcdf_parameters) :: symba_io_encounter_parameters - integer(I4B) :: COLLIDER_DIM_SIZE = 2 !! Size of collider dimension + integer(I4B) :: COLLIDER_DIM_SIZE = 2 !! Size of collider dimension integer(I4B) :: ienc_frame = 1 !! Current frame number for the encounter history character(STRMAX) :: enc_file = "encounter.nc" !! Encounter output file name @@ -194,7 +194,8 @@ module symba_classes type, extends(swiftest_storage) :: symba_encounter_storage !! A class that that is used to store simulation history data between file output - type(symba_io_encounter_parameters) :: nc + type(symba_io_encounter_parameters) :: nc !! NetCDF parameter object + real(DP), dimension(nframes) :: tvals !! Stored time values for snapshots contains procedure :: dump => symba_io_encounter_dump !! Dumps contents of encounter history to file final :: symba_util_final_encounter_storage @@ -229,6 +230,7 @@ module symba_classes type, extends(symba_nbody_system) :: symba_encounter_snapshot + integer(I4B) :: tslot !! The index for the time array in the final NetCDF file contains procedure :: write_encounter_frame => symba_io_encounter_write_frame !! Writes a frame of encounter data to file generic :: write_frame => write_encounter_frame diff --git a/src/symba/symba_io.f90 b/src/symba/symba_io.f90 index 34885acc3..ae330898a 100644 --- a/src/symba/symba_io.f90 +++ b/src/symba/symba_io.f90 @@ -148,7 +148,7 @@ module subroutine symba_io_encounter_write_frame(self, nc, param) integer(I4B) :: i, tslot, idslot, old_mode, n character(len=NAMELEN) :: charstring - tslot = nc%ienc_frame + tslot = self%tslot call check( nf90_set_fill(nc%id, nf90_nofill, old_mode), "symba_io_encounter_write_frame nf90_set_fill" ) select type(pl => self%pl) class is (symba_pl) @@ -368,6 +368,9 @@ module subroutine symba_io_start_encounter(self, param, t) if (.not. allocated(self%encounter_history)) allocate(symba_encounter_storage :: self%encounter_history) call self%encounter_history%reset() + ! Empty out the time slot array for the next pass + self%encounter_history%tvals(:) = -huge(1.0_DP) + ! Take the snapshot at the start of the encounter call self%snapshot(param, t) diff --git a/src/symba/symba_util.f90 b/src/symba/symba_util.f90 index 672ab1aed..65cd64989 100644 --- a/src/symba/symba_util.f90 +++ b/src/symba/symba_util.f90 @@ -1257,10 +1257,10 @@ module subroutine symba_util_spill_encounter_list(self, discards, lspill_list, l !! Note: Because the symba_plplenc currently does not contain any additional variable components, this method can recieve it as an input as well. implicit none ! Arguments - class(symba_encounter), intent(inout) :: self !! SyMBA pl-tp encounter list - class(encounter_list), intent(inout) :: discards !! Discarded object - logical, dimension(:), intent(in) :: lspill_list !! Logical array of bodies to spill into the discards - logical, intent(in) :: ldestructive !! Logical flag indicating whether or not this operation should alter body by removing the discard list + class(symba_encounter), intent(inout) :: self !! SyMBA pl-tp encounter list + class(encounter_list), intent(inout) :: discards !! Discarded object + logical, dimension(:), intent(in) :: lspill_list !! Logical array of bodies to spill into the discards + logical, intent(in) :: ldestructive !! Logical flag indicating whether or not this operation should alter body by removing the discard list associate(keeps => self) select type(discards) @@ -1397,8 +1397,19 @@ module subroutine symba_util_take_encounter_snapshot(self, param, t) ! Save the snapshot self%encounter_history%iframe = self%encounter_history%iframe + 1 call self%resize_storage(self%encounter_history%iframe) + + ! Find out which time slot this belongs in by searching for an existing slot + ! with the same value of time or the first available one + do i = 1, self%encounter_history%nframes + if (t >= self%encounter_history%tvals(i)) then + snapshot%tslot = i + self%encounter_history%tvals(i) = t + exit + end if + end do self%encounter_history%frame(self%encounter_history%iframe) = snapshot + end select end select end associate From d7651a533159bbddbb22bdc4aec091b9977957c5 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Tue, 6 Dec 2022 13:35:00 -0500 Subject: [PATCH 320/569] Fixed issue where file parameters were being overridden by defaults --- examples/Fragmentation/Fragmentation_Movie.py | 56 +++++++++---------- python/swiftest/swiftest/simulation_class.py | 3 +- 2 files changed, 30 insertions(+), 29 deletions(-) diff --git a/examples/Fragmentation/Fragmentation_Movie.py b/examples/Fragmentation/Fragmentation_Movie.py index f5f9cd792..07211cc76 100644 --- a/examples/Fragmentation/Fragmentation_Movie.py +++ b/examples/Fragmentation/Fragmentation_Movie.py @@ -155,31 +155,31 @@ def data_stream(self, frame=0): if __name__ == "__main__": - print("Select a fragmentation movie to generate.") - print("1. Head-on disruption") - print("2. Off-axis supercatastrophic") - print("3. Hit and run") - print("4. All of the above") - user_selection = int(input("? ")) - - if user_selection > 0 and user_selection < 4: - movie_styles = [available_movie_styles[user_selection-1]] - else: - print("Generating all movie styles") - movie_styles = available_movie_styles.copy() - - for style in movie_styles: - movie_filename = f"{style}.mp4" - - # Pull in the Swiftest output data from the parameter file and store it as a Xarray dataset. - sim = swiftest.Simulation(simdir=style, rotation=True, init_cond_format = "XV", compute_conservation_values=True) - sim.add_solar_system_body("Sun") - sim.add_body(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, fragmentation_save="TRAJECTORY", gmtiny=gmtiny, minimum_fragment_gmass=minimum_fragment_gmass, verbose=False) - sim.run(dt=1e-4, tstop=2.0e-3, istep_out=1, dump_cadence=0) - - anim = AnimatedScatter(sim,movie_filename,movie_titles[style],nskip=1) + print("Select a fragmentation movie to generate.") + print("1. Head-on disruption") + print("2. Off-axis supercatastrophic") + print("3. Hit and run") + print("4. All of the above") + user_selection = int(input("? ")) + + if user_selection > 0 and user_selection < 4: + movie_styles = [available_movie_styles[user_selection-1]] + else: + print("Generating all movie styles") + movie_styles = available_movie_styles.copy() + + for style in movie_styles: + movie_filename = f"{style}.mp4" + sim = swiftest.Simulation(simdir=style, read_old_output_file=True) + # Pull in the Swiftest output data from the parameter file and store it as a Xarray dataset. + # sim = swiftest.Simulation(simdir=style, rotation=True, init_cond_format = "XV", compute_conservation_values=True) + # sim.add_solar_system_body("Sun") + # sim.add_body(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, fragmentation_save="TRAJECTORY", gmtiny=gmtiny, minimum_fragment_gmass=minimum_fragment_gmass, verbose=False) + # sim.run(dt=1e-4, tstop=2.0e-3, istep_out=1, dump_cadence=0) + # + # anim = AnimatedScatter(sim,movie_filename,movie_titles[style],nskip=1) diff --git a/python/swiftest/swiftest/simulation_class.py b/python/swiftest/swiftest/simulation_class.py index e5e71a943..25b83a0f3 100644 --- a/python/swiftest/swiftest/simulation_class.py +++ b/python/swiftest/swiftest/simulation_class.py @@ -362,7 +362,8 @@ def __init__(self,read_param: bool = False, read_old_output_file: bool = False, # ----------------------------------------------------------------- # Highest Priority: Values from arguments passed to Simulation() # ----------------------------------------------------------------- - self.set_parameter(verbose=False, **kwargs) + if len(kwargs) > 0 and "param_file" not in kwargs or len(kwargs) > 1 and "param_file" in kwargs: + self.set_parameter(verbose=False, **kwargs) # Let the user know that there was a problem reading an old parameter file and we're going to create a new one if read_param and not param_file_found: From c7472ee9b9e454b211ecce30fe676d3ccf2c62e9 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Tue, 6 Dec 2022 13:36:00 -0500 Subject: [PATCH 321/569] Put the commented out code back from testing --- examples/Fragmentation/Fragmentation_Movie.py | 21 +++++++++---------- 1 file changed, 10 insertions(+), 11 deletions(-) diff --git a/examples/Fragmentation/Fragmentation_Movie.py b/examples/Fragmentation/Fragmentation_Movie.py index 07211cc76..68cdab59b 100644 --- a/examples/Fragmentation/Fragmentation_Movie.py +++ b/examples/Fragmentation/Fragmentation_Movie.py @@ -170,16 +170,15 @@ def data_stream(self, frame=0): for style in movie_styles: movie_filename = f"{style}.mp4" - sim = swiftest.Simulation(simdir=style, read_old_output_file=True) # Pull in the Swiftest output data from the parameter file and store it as a Xarray dataset. - # sim = swiftest.Simulation(simdir=style, rotation=True, init_cond_format = "XV", compute_conservation_values=True) - # sim.add_solar_system_body("Sun") - # sim.add_body(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, fragmentation_save="TRAJECTORY", gmtiny=gmtiny, minimum_fragment_gmass=minimum_fragment_gmass, verbose=False) - # sim.run(dt=1e-4, tstop=2.0e-3, istep_out=1, dump_cadence=0) + sim = swiftest.Simulation(simdir=style, 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], rh=pos_vectors[style], vh=vel_vectors[style]) #, rot=rot_vectors[style]) # - # anim = AnimatedScatter(sim,movie_filename,movie_titles[style],nskip=1) + # 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, fragmentation_save="TRAJECTORY", gmtiny=gmtiny, minimum_fragment_gmass=minimum_fragment_gmass, verbose=False) + sim.run(dt=1e-4, tstop=2.0e-3, istep_out=1, dump_cadence=0) + + anim = AnimatedScatter(sim,movie_filename,movie_titles[style],nskip=1) From ee33e274a37edadc135e500f8dfce5f7e37bbf37 Mon Sep 17 00:00:00 2001 From: Carlisle Wishard Date: Tue, 6 Dec 2022 13:38:41 -0500 Subject: [PATCH 322/569] added a header and some comments to the fragmentation example --- .../Fragmentation/swiftest_fragmentation.py | 50 +++++++++++++++++-- 1 file changed, 46 insertions(+), 4 deletions(-) diff --git a/examples/Fragmentation/swiftest_fragmentation.py b/examples/Fragmentation/swiftest_fragmentation.py index 9557c144f..1b6aed2aa 100644 --- a/examples/Fragmentation/swiftest_fragmentation.py +++ b/examples/Fragmentation/swiftest_fragmentation.py @@ -10,22 +10,63 @@ """ #!/usr/bin/env python3 """ -Generates a set of Swiftest input files from initial conditions, runs Swiftest, and generates fragmentation movies. -Returns -------- -Updates sim.data with the simulation data, produces fragmentation movies. +Generates and runs a set of Swiftest input files from initial conditions with the SyMBA integrator. All simulation +outputs for the disruption case are stored in the /disruption subdirectory. All simulation outputs for the hit and run +case are stored in the /hitandrun subdirectory. All simulation outputs for the super-catastrophic disruption case are +stored in the /supercat subdirectory. + +Input +------ +None + +Output +------ +disruption/bin.nc : A NetCDF file containing the simulation output. +disruption/dump_bin1.nc : A NetCDF file containing the necessary inputs to restart a simulation from t!=0. +disruption/dump_bin2.nc : A NetCDF file containing the necessary inputs to restart a simulation from t!=0. +disruption/dump_param1.in : An ASCII file containing the necessary parameters to restart a simulation. +disruption/dump_param2.in : An ASCII file containing the necessary parameters to restart a simulation. +disruption/fraggle.log : An ASCII file containing the information of any collisional events that occured. +disruption/init_cond.nc : A NetCDF file containing the initial conditions for the simulation. +disruption/param.in : An ASCII file containing the parameters for the simulation. +disruption/swiftest.log : An ASCII file containing the information on the status of the simulation as it runs. +hitandrun/bin.nc : A NetCDF file containing the simulation output. +hitandrun/dump_bin1.nc : A NetCDF file containing the necessary inputs to restart a simulation from t!=0. +hitandrun/dump_bin2.nc : A NetCDF file containing the necessary inputs to restart a simulation from t!=0. +hitandrun/dump_param1.in : An ASCII file containing the necessary parameters to restart a simulation. +hitandrun/dump_param2.in : An ASCII file containing the necessary parameters to restart a simulation. +hitandrun/fraggle.log : An ASCII file containing the information of any collisional events that occured. +hitandrun/init_cond.nc : A NetCDF file containing the initial conditions for the simulation. +hitandrun/param.in : An ASCII file containing the parameters for the simulation. +hitandrun/swiftest.log : An ASCII file containing the information on the status of the simulation as it runs. +supercat/bin.nc : A NetCDF file containing the simulation output. +supercat/dump_bin1.nc : A NetCDF file containing the necessary inputs to restart a simulation from t!=0. +supercat/dump_bin2.nc : A NetCDF file containing the necessary inputs to restart a simulation from t!=0. +supercat/dump_param1.in : An ASCII file containing the necessary parameters to restart a simulation. +supercat/dump_param2.in : An ASCII file containing the necessary parameters to restart a simulation. +supercat/fraggle.log : An ASCII file containing the information of any collisional events that occured. +supercat/init_cond.nc : A NetCDF file containing the initial conditions for the simulation. +supercat/param.in : An ASCII file containing the parameters for the simulation. +supercat/swiftest.log : An ASCII file containing the information on the status of the simulation as it runs. """ import swiftest import numpy as np from numpy.random import default_rng +# Initialize the simulation object as a variable with arguments. sim_disruption = swiftest.Simulation(simdir="disruption", tstart=0.0, tstop=1.0e-5, dt=1.0e-8, istep_out=1.0, fragmentation=True, minimum_fragment_gmass=1.0e-11, gmtiny=1.0e-11, output_file_format="XVEL", init_cond_format="XV") +# Add the Sun using the JPL Horizons Database. sim_disruption.add_solar_system_body(["Sun"]) +# Add a user-defined target body. sim_disruption.add_body(name="Target", rh=[[1.0, -1.807993e-05, 0.0]], vh=[[-2.562596e-04, 6.280005, 0.0]], Gmass=1e-7, radius=7e-6, rhill=9e-4, Ip=[[0.4, 0.4, 0.4]], rot=[[0.0, 0.0, 0.0]]) +# Add a user-defined projectile body. sim_disruption.add_body(name="Projectile", rh=[[1.0, 1.807993e-05, 0.0]], vh=[[-2.562596e-04, -6.280005, 0.0]], Gmass=7e-10, radius=3.25e-6, rhill=4e-4, Ip=[[0.4, 0.4, 0.4]], rot=[[0.0, 0.0, 0.0]]) +# Display the run configuration parameters. sim_disruption.get_parameter() +# Run the simulation. sim_disruption.run() +# Do the same as above for the hit and run case. sim_hitandrun = swiftest.Simulation(simdir="hitandrun", tstart=0.0, tstop=1.0e-5, dt=1.0e-8, istep_out=1.0, fragmentation=True, minimum_fragment_gmass=1.0e-11, gmtiny=1.0e-11, output_file_format="XVEL", init_cond_format="XV") sim_hitandrun.add_solar_system_body(["Sun"]) sim_hitandrun.add_body(name="Target", rh=[[1.0, -4.2e-05, 0.0]], vh=[[0.0, 6.28, 0.0]], Gmass=1e-7, radius=7e-6, rhill=9e-4, Ip=[[0.4, 0.4, 0.4]], rot=[[0.0, 0.0, 6.0e4]]) @@ -33,6 +74,7 @@ sim_hitandrun.get_parameter() sim_hitandrun.run() +# Do the same as above for the super-catastrophic disruption case. sim_supercat = swiftest.Simulation(simdir="supercat", tstart=0.0, tstop=1.0e-5, dt=1.0e-8, istep_out=1.0, fragmentation=True, minimum_fragment_gmass=1.0e-11, gmtiny=1.0e-11, output_file_format="XVEL", init_cond_format="XV") sim_supercat.add_solar_system_body(["Sun"]) sim_supercat.add_body(name="Target", rh=[[1.0, -4.2e-05, 0.0]], vh=[[0.0, 6.28, 0.0]], Gmass=1e-7, radius=7e-6, rhill=9e-4, Ip=[[0.4, 0.4, 0.4]], rot=[[0.0, 0.0, -6.0e4]]) From 3b1127e68e01c4d7923da0e1ea6464f02e5bd8f8 Mon Sep 17 00:00:00 2001 From: Carlisle Wishard Date: Tue, 6 Dec 2022 13:40:51 -0500 Subject: [PATCH 323/569] added "." to the end of comments because it was bugging me --- examples/Basic_Simulation/initial_conditions.py | 10 +++++----- examples/Basic_Simulation/output_reader.py | 4 ++-- examples/Fragmentation/swiftest_fragmentation.py | 2 +- examples/helio_gr_test/helio_gr_test.py | 12 ++++++------ examples/whm_gr_test/whm_gr_test.py | 8 ++++---- 5 files changed, 18 insertions(+), 18 deletions(-) diff --git a/examples/Basic_Simulation/initial_conditions.py b/examples/Basic_Simulation/initial_conditions.py index 6ac43c7fd..861556958 100644 --- a/examples/Basic_Simulation/initial_conditions.py +++ b/examples/Basic_Simulation/initial_conditions.py @@ -16,7 +16,7 @@ Input ------ -None +None. Output ------ @@ -38,10 +38,10 @@ # Initialize the simulation object as a variable. Arguments may be defined here or through the sim.run() method. sim = swiftest.Simulation(fragmentation=True, minimum_fragment_mass = 2.5e-11, mtiny=2.5e-8) -# Add the modern planets and the Sun using the JPL Horizons Database +# Add the modern planets and the Sun using the JPL Horizons Database. sim.add_solar_system_body(["Sun","Mercury","Venus","Earth","Mars","Jupiter","Saturn","Uranus","Neptune","Pluto"]) -# Add 5 user-defined massive bodies +# Add 5 user-defined massive bodies. npl = 5 density_pl = 3000.0 / (sim.param['MU2KG'] / sim.param['DU2M'] ** 3) @@ -60,7 +60,7 @@ sim.add_body(name=name_pl, a=a_pl, e=e_pl, inc=inc_pl, capom=capom_pl, omega=omega_pl, capm=capm_pl, Gmass=GM_pl, radius=R_pl, rhill=Rh_pl, Ip=Ip_pl, rot=rot_pl) -# Add 10 user-defined test particles +# Add 10 user-defined test particles. ntp = 10 name_tp = ["TestParticle_01", "TestParticle_02", "TestParticle_03", "TestParticle_04", "TestParticle_05", "TestParticle_06", "TestParticle_07", "TestParticle_08", "TestParticle_09", "TestParticle_10"] @@ -72,7 +72,7 @@ capm_tp = default_rng().uniform(0.0, 360.0, ntp) sim.add_body(name=name_tp, a=a_tp, e=e_tp, inc=inc_tp, capom=capom_tp, omega=omega_tp, capm=capm_tp) -# Display the run configuration parameters +# Display the run configuration parameters. sim.get_parameter() # Run the simulation. Arguments may be defined here or thorugh the swiftest.Simulation() method. diff --git a/examples/Basic_Simulation/output_reader.py b/examples/Basic_Simulation/output_reader.py index 5d7f496b7..a41103ccd 100644 --- a/examples/Basic_Simulation/output_reader.py +++ b/examples/Basic_Simulation/output_reader.py @@ -27,10 +27,10 @@ import xarray as xr import matplotlib.pyplot as plt -# Read in the simulation output and store it as an Xarray dataset +# Read in the simulation output and store it as an Xarray dataset. sim = swiftest.Simulation(read_old_output_file=True) -# Plot of the data and save the output plot +# Plot of the data and save the output plot. colors = ['white' if x == 'Massive Body' else 'black' for x in sim.data['particle_type']] sizes = [100 if x == 'Massive Body' else 10 for x in sim.data['particle_type']] diff --git a/examples/Fragmentation/swiftest_fragmentation.py b/examples/Fragmentation/swiftest_fragmentation.py index 1b6aed2aa..de4e9ba2c 100644 --- a/examples/Fragmentation/swiftest_fragmentation.py +++ b/examples/Fragmentation/swiftest_fragmentation.py @@ -17,7 +17,7 @@ Input ------ -None +None. Output ------ diff --git a/examples/helio_gr_test/helio_gr_test.py b/examples/helio_gr_test/helio_gr_test.py index 1b0033ab1..c627be7f4 100644 --- a/examples/helio_gr_test/helio_gr_test.py +++ b/examples/helio_gr_test/helio_gr_test.py @@ -17,7 +17,7 @@ Input ------ -None +None. Output ------ @@ -50,12 +50,12 @@ # Initialize the simulation object as a variable. Define the directory in which the output will be placed. sim_gr = swiftest.Simulation(simdir="gr") -# Add the modern planets and the Sun using the JPL Horizons Database +# Add the modern planets and the Sun using the JPL Horizons Database. sim_gr.add_solar_system_body(["Sun","Mercury","Venus","Earth","Mars","Jupiter","Saturn","Uranus","Neptune"]) # Initialize the simulation object as a variable. Define the directory in which the output will be placed. sim_nogr = swiftest.Simulation(simdir="nogr") -# Add the modern planets and the Sun using the JPL Horizons Database +# Add the modern planets and the Sun using the JPL Horizons Database. sim_nogr.add_solar_system_body(["Sun","Mercury","Venus","Earth","Mars","Jupiter","Saturn","Uranus","Neptune"]) # Define a set of arguments that apply to both runs. For a list of possible arguments, see the User Manual. @@ -65,13 +65,13 @@ 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 +# Get the start and end date of the simulation so we can compare with the real solar system. start_date = sim_gr.ephemeris_date tstop_d = sim_gr.param['TSTOP'] * sim_gr.param['TU2S'] / swiftest.JD2S stop_date = (datetime.datetime.fromisoformat(start_date) + datetime.timedelta(days=tstop_d)).isoformat() -#Get the ephemerides of Mercury for the same timeframe as the simulation +#Get the ephemerides of Mercury for the same timeframe as the simulation. obj = Horizons(id='1', location='@sun', epochs={'start':start_date, 'stop':stop_date, 'step':'10y'}) @@ -87,7 +87,7 @@ dvarpi_nogr = np.diff(varpisim_nogr) * 3600 * 100 / run_args['tstep_out'] dvarpi_obs = np.diff(varpi_obs) / np.diff(t) * 3600 * 100 -# Plot of the data and save the output plot +# Plot of the data and save the output plot. fig, ax = plt.subplots() ax.plot(t, varpi_obs, label="JPL Horizons",linewidth=2.5) diff --git a/examples/whm_gr_test/whm_gr_test.py b/examples/whm_gr_test/whm_gr_test.py index ab397c464..d0d2ade69 100644 --- a/examples/whm_gr_test/whm_gr_test.py +++ b/examples/whm_gr_test/whm_gr_test.py @@ -17,7 +17,7 @@ Input ------ -None +None. Output ------ @@ -63,13 +63,13 @@ 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 +# Get the start and end date of the simulation so we can compare with the real solar system. start_date = sim_gr.ephemeris_date tstop_d = sim_gr.param['TSTOP'] * sim_gr.param['TU2S'] / swiftest.JD2S stop_date = (datetime.datetime.fromisoformat(start_date) + datetime.timedelta(days=tstop_d)).isoformat() -#Get the ephemerides of Mercury for the same timeframe as the simulation +#Get the ephemerides of Mercury for the same timeframe as the simulation. obj = Horizons(id='1', location='@sun', epochs={'start':start_date, 'stop':stop_date, 'step':'10y'}) @@ -85,7 +85,7 @@ dvarpi_nogr = np.diff(varpisim_nogr) * 3600 * 100 / run_args['tstep_out'] dvarpi_obs = np.diff(varpi_obs) / np.diff(t) * 3600 * 100 -# Plot of the data and save the output plot +# Plot of the data and save the output plot. fig, ax = plt.subplots() ax.plot(t, varpi_obs, label="JPL Horizons",linewidth=2.5) From c25423da6b5a91350353cbc9d4e3c26f5d7f03ac Mon Sep 17 00:00:00 2001 From: David A Minton Date: Tue, 6 Dec 2022 13:42:12 -0500 Subject: [PATCH 324/569] Fixed some of the typing issues with encounter data --- python/swiftest/swiftest/io.py | 2 +- python/swiftest/swiftest/simulation_class.py | 1 + 2 files changed, 2 insertions(+), 1 deletion(-) diff --git a/python/swiftest/swiftest/io.py b/python/swiftest/swiftest/io.py index 6621f8c19..f4be8a56a 100644 --- a/python/swiftest/swiftest/io.py +++ b/python/swiftest/swiftest/io.py @@ -823,7 +823,7 @@ def process_netcdf_input(ds, param): ds = fix_types(ds,ftype=np.float32) ds = ds.where(ds.id >=0 ,drop=True) # Check if the name variable contains unique values. If so, make name the dimension instead of id - if len(np.unique(ds['name'])) == len(ds['name']): + if "name" not in ds.dims and len(np.unique(ds['name'])) == len(ds['name']): ds = ds.swap_dims({"id" : "name"}) ds = ds.reset_coords("id") diff --git a/python/swiftest/swiftest/simulation_class.py b/python/swiftest/swiftest/simulation_class.py index 25b83a0f3..16629f08c 100644 --- a/python/swiftest/swiftest/simulation_class.py +++ b/python/swiftest/swiftest/simulation_class.py @@ -2771,6 +2771,7 @@ def _preprocess(ds, param): partial_func = partial(_preprocess, param=self.param) self.enc = xr.open_mfdataset(enc_files,parallel=True,combine="nested", concat_dim="encounter",preprocess=partial_func) + self.enc = io.process_netcdf_input(self.enc, self.param) return From d34d36ee933360df3693b55df75696b650f7049c Mon Sep 17 00:00:00 2001 From: David A Minton Date: Tue, 6 Dec 2022 14:42:13 -0500 Subject: [PATCH 325/569] More clean up of encounter data --- examples/Fragmentation/Fragmentation_Movie.py | 12 +++---- python/swiftest/swiftest/io.py | 34 ++++++++++++++----- 2 files changed, 32 insertions(+), 14 deletions(-) diff --git a/examples/Fragmentation/Fragmentation_Movie.py b/examples/Fragmentation/Fragmentation_Movie.py index 68cdab59b..ee19cf886 100644 --- a/examples/Fragmentation/Fragmentation_Movie.py +++ b/examples/Fragmentation/Fragmentation_Movie.py @@ -84,7 +84,8 @@ class AnimatedScatter(object): """An animated scatter plot using matplotlib.animations.FuncAnimation.""" def __init__(self, sim, animfile, title, nskip=1): - nframes = int(sim.enc['time'].size) + self.ds = sim.enc.mean(dim="encounter") # Reduce out the encounter dimension + nframes = int(self.ds['time'].size) self.sim = sim self.title = title self.body_color_list = {'Initial conditions': 'xkcd:windows blue', @@ -106,11 +107,10 @@ def setup_plot(self): fig = plt.figure(figsize=figsize, dpi=300) plt.tight_layout(pad=0) - # Calculate the distance along the y-axis between the colliding bodies at the start of the simulation. # This will be used to scale the axis limits on the movie. - rhy1 = sim.enc['rh'].isel(time=0).sel(name="Body1",space='y').values[()] - rhy2 = sim.enc['rh'].isel(time=0).sel(name="Body2",space='y').values[()] + rhy1 = self.ds['rh'].isel(time=0).sel(name="Body1",space='y').values[()] + rhy2 = self.ds['rh'].isel(time=0).sel(name="Body2",space='y').values[()] scale_frame = abs(rhy1) + abs(rhy2) ax = plt.Axes(fig, [0.1, 0.1, 0.8, 0.8]) @@ -145,7 +145,7 @@ def center(Gmass, x, y): def data_stream(self, frame=0): while True: - ds = self.sim.enc.isel(time=frame) + ds = self.ds.isel(time=frame) ds = ds.where(ds['name'] != "Sun", drop=True) radius = ds['radius'].values Gmass = ds['Gmass'].values @@ -181,4 +181,4 @@ def data_stream(self, frame=0): sim.set_parameter(fragmentation=True, fragmentation_save="TRAJECTORY", gmtiny=gmtiny, minimum_fragment_gmass=minimum_fragment_gmass, verbose=False) sim.run(dt=1e-4, tstop=2.0e-3, istep_out=1, dump_cadence=0) - anim = AnimatedScatter(sim,movie_filename,movie_titles[style],nskip=1) + anim = AnimatedScatter(sim,movie_filename,movie_titles[style],nskip=1) \ No newline at end of file diff --git a/python/swiftest/swiftest/io.py b/python/swiftest/swiftest/io.py index f4be8a56a..f03fb622f 100644 --- a/python/swiftest/swiftest/io.py +++ b/python/swiftest/swiftest/io.py @@ -823,9 +823,10 @@ def process_netcdf_input(ds, param): ds = fix_types(ds,ftype=np.float32) ds = ds.where(ds.id >=0 ,drop=True) # Check if the name variable contains unique values. If so, make name the dimension instead of id - if "name" not in ds.dims and len(np.unique(ds['name'])) == len(ds['name']): - ds = ds.swap_dims({"id" : "name"}) - ds = ds.reset_coords("id") + if "id" in ds.dims: + if len(np.unique(ds['name'])) == len(ds['name']): + ds = ds.swap_dims({"id" : "name"}) + ds = ds.reset_coords("id") return ds @@ -855,14 +856,14 @@ def swiftest2xr(param, verbose=True): return ds -def xstrip(a): +def xstrip_nonstr(a): """ Cleans up the string values in the DataSet to remove extra white space Parameters ---------- a : xarray dataset - + Returns ------- da : xarray dataset with the strings cleaned up @@ -870,6 +871,22 @@ def xstrip(a): func = lambda x: np.char.strip(x) return xr.apply_ufunc(func, a.str.decode(encoding='utf-8'),dask='parallelized') +def xstrip_str(a): + """ + Cleans up the string values in the DataSet to remove extra white space + + Parameters + ---------- + a : xarray dataset + + Returns + ------- + da : xarray dataset with the strings cleaned up + """ + func = lambda x: np.char.strip(x) + return xr.apply_ufunc(func, a,dask='parallelized') + + def string_converter(da): """ Converts a string to a unicode string @@ -883,9 +900,10 @@ def string_converter(da): da : xarray dataset with the strings cleaned up """ if da.dtype == np.dtype(object): - da = da.astype(' Date: Tue, 6 Dec 2022 15:56:18 -0500 Subject: [PATCH 326/569] renamed key word argument --- examples/Fragmentation/swiftest_fragmentation.py | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/examples/Fragmentation/swiftest_fragmentation.py b/examples/Fragmentation/swiftest_fragmentation.py index de4e9ba2c..067c53710 100644 --- a/examples/Fragmentation/swiftest_fragmentation.py +++ b/examples/Fragmentation/swiftest_fragmentation.py @@ -54,7 +54,7 @@ from numpy.random import default_rng # Initialize the simulation object as a variable with arguments. -sim_disruption = swiftest.Simulation(simdir="disruption", tstart=0.0, tstop=1.0e-5, dt=1.0e-8, istep_out=1.0, fragmentation=True, minimum_fragment_gmass=1.0e-11, gmtiny=1.0e-11, output_file_format="XVEL", init_cond_format="XV") +sim_disruption = swiftest.Simulation(simdir="disruption", tstart=0.0, tstop=1.0e-5, dt=1.0e-8, istep_out=1.0, fragmentation=True, minimum_fragment_gmass=1.0e-11, gmtiny=1.0e-11, output_format="XVEL", init_cond_format="XV") # Add the Sun using the JPL Horizons Database. sim_disruption.add_solar_system_body(["Sun"]) # Add a user-defined target body. @@ -67,7 +67,7 @@ sim_disruption.run() # Do the same as above for the hit and run case. -sim_hitandrun = swiftest.Simulation(simdir="hitandrun", tstart=0.0, tstop=1.0e-5, dt=1.0e-8, istep_out=1.0, fragmentation=True, minimum_fragment_gmass=1.0e-11, gmtiny=1.0e-11, output_file_format="XVEL", init_cond_format="XV") +sim_hitandrun = swiftest.Simulation(simdir="hitandrun", tstart=0.0, tstop=1.0e-5, dt=1.0e-8, istep_out=1.0, fragmentation=True, minimum_fragment_gmass=1.0e-11, gmtiny=1.0e-11, output_format="XVEL", init_cond_format="XV") sim_hitandrun.add_solar_system_body(["Sun"]) sim_hitandrun.add_body(name="Target", rh=[[1.0, -4.2e-05, 0.0]], vh=[[0.0, 6.28, 0.0]], Gmass=1e-7, radius=7e-6, rhill=9e-4, Ip=[[0.4, 0.4, 0.4]], rot=[[0.0, 0.0, 6.0e4]]) sim_hitandrun.add_body(name="Projectile", rh=[[1.0, 4.2e-05, 0.0]], vh=[[-1.5, -6.28, 0.0]], Gmass=7e-10, radius=3.25e-6, rhill=4e-4, Ip=[[0.4, 0.4, 0.4]], rot=[[0.0, 0.0, 1.0e5]]) @@ -75,7 +75,7 @@ sim_hitandrun.run() # Do the same as above for the super-catastrophic disruption case. -sim_supercat = swiftest.Simulation(simdir="supercat", tstart=0.0, tstop=1.0e-5, dt=1.0e-8, istep_out=1.0, fragmentation=True, minimum_fragment_gmass=1.0e-11, gmtiny=1.0e-11, output_file_format="XVEL", init_cond_format="XV") +sim_supercat = swiftest.Simulation(simdir="supercat", tstart=0.0, tstop=1.0e-5, dt=1.0e-8, istep_out=1.0, fragmentation=True, minimum_fragment_gmass=1.0e-11, gmtiny=1.0e-11, output_format="XVEL", init_cond_format="XV") sim_supercat.add_solar_system_body(["Sun"]) sim_supercat.add_body(name="Target", rh=[[1.0, -4.2e-05, 0.0]], vh=[[0.0, 6.28, 0.0]], Gmass=1e-7, radius=7e-6, rhill=9e-4, Ip=[[0.4, 0.4, 0.4]], rot=[[0.0, 0.0, -6.0e4]]) sim_supercat.add_body(name="Projectile", rh=[[1.0, 4.2e-05, 0.0]], vh=[[1.0, -6.28, 0.0]], Gmass=1e-8, radius=3.25e-6, rhill=4e-4, Ip=[[0.4, 0.4, 0.4]], rot=[[0.0, 0.0, 1.0e5]]) From dd307916540abb62d83688f9f604ce76418f1eb4 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Tue, 6 Dec 2022 17:01:23 -0500 Subject: [PATCH 327/569] The encounter output files are now merged properly into the .enc instance variable --- examples/Fragmentation/Fragmentation_Movie.py | 12 +++++++----- python/swiftest/swiftest/simulation_class.py | 2 +- src/symba/symba_io.f90 | 4 ++-- src/symba/symba_util.f90 | 4 ++-- 4 files changed, 12 insertions(+), 10 deletions(-) diff --git a/examples/Fragmentation/Fragmentation_Movie.py b/examples/Fragmentation/Fragmentation_Movie.py index ee19cf886..80f75a86a 100644 --- a/examples/Fragmentation/Fragmentation_Movie.py +++ b/examples/Fragmentation/Fragmentation_Movie.py @@ -84,7 +84,8 @@ class AnimatedScatter(object): """An animated scatter plot using matplotlib.animations.FuncAnimation.""" def __init__(self, sim, animfile, title, nskip=1): - self.ds = sim.enc.mean(dim="encounter") # Reduce out the encounter dimension + tgood = sim.enc.where(sim.enc['Gmass'] > 9e-8).time + self.ds = sim.enc.sel(time=tgood) nframes = int(self.ds['time'].size) self.sim = sim self.title = title @@ -109,8 +110,8 @@ def setup_plot(self): # Calculate the distance along the y-axis between the colliding bodies at the start of the simulation. # This will be used to scale the axis limits on the movie. - rhy1 = self.ds['rh'].isel(time=0).sel(name="Body1",space='y').values[()] - rhy2 = self.ds['rh'].isel(time=0).sel(name="Body2",space='y').values[()] + rhy1 = self.ds['rh'].sel(name="Body1",space='y').isel(time=0).values[()] + rhy2 = self.ds['rh'].sel(name="Body2",space='y').isel(time=0).values[()] scale_frame = abs(rhy1) + abs(rhy2) ax = plt.Axes(fig, [0.1, 0.1, 0.8, 0.8]) @@ -133,12 +134,13 @@ def center(Gmass, x, y): x = x[~np.isnan(x)] y = y[~np.isnan(y)] Gmass = Gmass[~np.isnan(Gmass)] + x = x[Gmass] x_com = np.sum(Gmass * x) / np.sum(Gmass) - y_com = np.sum(Gmass * y) / np.sum(Gmass) + y_com = #np.sum(Gmass * y) / np.sum(Gmass) return x_com, y_com Gmass, rh, point_rad = next(self.data_stream(frame)) - x_com, y_com = center(Gmass, rh[:,0], rh[:,1]) + #x_com, y_com = center(Gmass, rh[:,0], rh[:,1]) self.scatter_artist.set_offsets(np.c_[rh[:,0] - x_com, rh[:,1] - y_com]) self.scatter_artist.set_sizes(point_rad**2) return self.scatter_artist, diff --git a/python/swiftest/swiftest/simulation_class.py b/python/swiftest/swiftest/simulation_class.py index 16629f08c..4ac07386c 100644 --- a/python/swiftest/swiftest/simulation_class.py +++ b/python/swiftest/swiftest/simulation_class.py @@ -2770,7 +2770,7 @@ def _preprocess(ds, param): return io.process_netcdf_input(ds,param) partial_func = partial(_preprocess, param=self.param) - self.enc = xr.open_mfdataset(enc_files,parallel=True,combine="nested", concat_dim="encounter",preprocess=partial_func) + self.enc = xr.open_mfdataset(enc_files,parallel=True,preprocess=partial_func,mask_and_scale=True) self.enc = io.process_netcdf_input(self.enc, self.param) return diff --git a/src/symba/symba_io.f90 b/src/symba/symba_io.f90 index ae330898a..0fceaa724 100644 --- a/src/symba/symba_io.f90 +++ b/src/symba/symba_io.f90 @@ -137,7 +137,7 @@ end subroutine symba_io_encounter_initialize_output module subroutine symba_io_encounter_write_frame(self, nc, param) !! author: David A. Minton !! - !! Write a frame of output of an encounter list structure. + !! Write a frame of output of an encounter trajectory. use netcdf implicit none ! Arguments @@ -369,7 +369,7 @@ module subroutine symba_io_start_encounter(self, param, t) call self%encounter_history%reset() ! Empty out the time slot array for the next pass - self%encounter_history%tvals(:) = -huge(1.0_DP) + self%encounter_history%tvals(:) = huge(1.0_DP) ! Take the snapshot at the start of the encounter call self%snapshot(param, t) diff --git a/src/symba/symba_util.f90 b/src/symba/symba_util.f90 index 65cd64989..20d295b9c 100644 --- a/src/symba/symba_util.f90 +++ b/src/symba/symba_util.f90 @@ -1313,7 +1313,7 @@ module subroutine symba_util_take_encounter_snapshot(self, param, t) !! author: David A. Minton !! !! Takes a minimal snapshot of the state of the system during an encounter so that the trajectories - !! Can be played back through the encounter + !! can be played back through the encounter implicit none ! Internals class(symba_nbody_system), intent(inout) :: self !! SyMBA nbody system object @@ -1401,7 +1401,7 @@ module subroutine symba_util_take_encounter_snapshot(self, param, t) ! Find out which time slot this belongs in by searching for an existing slot ! with the same value of time or the first available one do i = 1, self%encounter_history%nframes - if (t >= self%encounter_history%tvals(i)) then + if (t <= self%encounter_history%tvals(i)) then snapshot%tslot = i self%encounter_history%tvals(i) = t exit From 173da1bb359d0cf9a2a39ca991f33292210b4b84 Mon Sep 17 00:00:00 2001 From: Carlisle Wishard Date: Tue, 6 Dec 2022 17:02:36 -0500 Subject: [PATCH 328/569] updates to the README in progress --- README.md | 302 +++++++++++++++++++++++++++++++++--------------------- 1 file changed, 187 insertions(+), 115 deletions(-) diff --git a/README.md b/README.md index 5e935af08..41f5ecea4 100644 --- a/README.md +++ b/README.md @@ -19,25 +19,24 @@ Swiftest also includes the collisional fragmentation algorithm **Fraggle**, an a **System Requirements** -Swiftest is designed to be downloaded, compiled, and run on a Linux based system. It is untested on Windows systems, however it should be possible to successfully install Swiftest on a Windows machine with only a few minor tweaks. +Swiftest is designed to be downloaded, compiled, and run on a Linux based system. It is untested on Windows systems. It is possible to download, compile, and run Swiftest on a machine with at least 400 MB of free disk space and 8 GB of RAM. To take full advantage of the parallelization and performance updates included in Swiftest, it is highly recommended that Swiftest be installed on a high-performance computing cluster. For reference, Swiftest is maintained on the Purdue University [Bell Community Cluster](https://www.rcac.purdue.edu/compute/bell). -Swiftest is written in Modern Fortran and must be compiled using an appropriate compiler. We recommend the Intel Fortran Compiler Classic (ifort) version 19.0 or higher. For details on installing ifort and the required Intel Math Kernel Library (intel-mkl), see the [Intel installation documentation](https://www.intel.com/content/www/us/en/developer/tools/oneapi/fortran-compiler.html#gs.6xhjgy). The GCC/GNU Fortran Compiler (gfortran) version 9 or higher is also compatible. For details on installing gfortran, see the [GNU Fortran documentation](https://gcc.gnu.org/wiki/GFortran). +Swiftest is written in Modern Fortran and must be compiled using an appropriate compiler. We recommend the Intel Fortran Compiler Classic (ifort) version 19.0 or higher. For details on installing ifort, see the [Intel installation documentation](https://www.intel.com/content/www/us/en/developer/tools/oneapi/fortran-compiler.html#gs.6xhjgy). The GCC/GNU Fortran Compiler (gfortran) version 9 or higher is also compatible. For details on installing gfortran, see the [GNU Fortran documentation](https://gcc.gnu.org/wiki/GFortran). -Swiftest output files are stored in the NetCDF file format. This takes the place of the flat binary output file included in Swifter (and its predecessor [Swift](https://www.boulder.swri.edu/~hal/swift.html)). The NetCDF output format is compatible with Python, Java, and other languages that can be used to process and analyze data. Details on installing NetCDF and the NetCDF Fortran Library can be found on the [Unidata website](https://docs.unidata.ucar.edu/netcdf-fortran/current/). NetCDF is built on HDF5 and it is necessary to install HDF and HDF5 as well. Details on installing HDF and HDF5 can be found on the [HDF Group website](https://www.hdfgroup.org/solutions/hdf5). +Swiftest output files are stored in the NetCDF file format. This takes the place of the flat binary output file included in Swifter (and its predecessor [Swift](https://www.boulder.swri.edu/~hal/swift.html)). The NetCDF output format is compatible with Python, Java, and other languages that can be used to process and analyze simulation data. Details on installing NetCDF and the NetCDF Fortran Library can be found on the [Unidata website](https://docs.unidata.ucar.edu/netcdf-fortran/current/). NetCDF is built on HDF5 and it is necessary to install HDF and HDF5 as well. Details on installing HDF and HDF5 can be found on the [HDF Group website](https://www.hdfgroup.org/solutions/hdf5). Parallelization in Swiftest is done with OpenMP. Version 3.1.4 or higher is necessary to make use of parallelization in Swiftest. If Swiftest is only to be run in serial, this package is not necessary. See the [OpenMP website](https://www.openmp.org/resources/openmp-compilers-tools/) for more details and installation instructions. *Example of a module configuration that is necessary for compiling and running Swiftest:* ``` 1. intel/19.0.5.281 -2. intel-mkl/2019.5.281 -3. openmpi/3.1.4 -4. netcdf/4.7.4 -5. netcdf-fortran/4.5.3 -6. hdf/4.2.15 -7. hdf5/1.10.6 +2. openmpi/3.1.4 +3. netcdf/4.7.4 +4. netcdf-fortran/4.5.3 +5. hdf/4.2.15 +6. hdf5/1.10.6 ``` **Downloading Swiftest** @@ -80,9 +79,9 @@ As mentioned in the **System Requirements** section, Swiftest requires the NetCD 1. Create an environment variable called ```NETCDF_FORTRAN_HOME``` that contains the path to the location where the libraries are installed 2. Set the path at the time of compilation using ```-CMAKE_PREFIX_PATH=/path/to/netcdf/``` -CMake allows the user to specify a set of compiler flags to use during compilation. We define three sets of compiler flags: release, testing, and debug. To view and/or edit the flags included in each set, see ```swiftest/cmake/Modules/SetFortranFlags.cmake```. +CMake allows the user to specify a set of compiler flags to use during compilation. We define five sets of compiler flags: release, testing, profile, math, and debug. To view and/or edit the flags included in each set, see ```swiftest/cmake/Modules/SetFortranFlags.cmake```. -As a general rule, the release flags are fully optimized and best used when running Swiftest with the goal of generating results. This is the default set of flags. When making changes to the Swiftest source code, it is best to compile Swiftest using the debug set of flags. To create your own set of compiler flags, edit the testing flags. +As a general rule, the release flags are fully optimized and best used when running Swiftest with the goal of generating results. This is the default set of flags. When making changes to the Swiftest source code, it is best to compile Swiftest using the debug set of flags. You may also define your own set of compiler flags. To build Swiftest with the release flags (default), type the following: ``` @@ -92,14 +91,7 @@ To build with the debug flags, type: ``` $ cmake .. -DCMAKE_BUILD_TYPE=DEBUG ``` -To build with profiling flags, type: -``` -$ cmake .. -DCMAKE_BUILD_TYPE=PROFILE -``` -Finally, to build with the testing flags, type: -``` -$ cmake .. -DCMAKE_BUILD_TYPE=TESTING -``` +To build with another set of flags, simply replace ```DEBUG``` in the above line with the name of the flags you wish to use. Add ```-CMAKE_PREFIX_PATH=/path/to/netcdf/``` to these commands as needed. @@ -111,81 +103,90 @@ $ make The Swiftest executable, called ```swiftest_driver```, should now be created in the ```/swiftest/bin/``` directory. ---- +**Swiftest Python Package** -#### Usage +Included with Swiftest, in the ```/swiftest/python/swiftest/``` directory, is a Python package designed to fascilitate seamless data processing and analysis. The Python package, also called Swiftest, can be used to generate input files, run Swiftest simulations, and process output files in the NetCDF file format. -When creating a new Swiftest simulation, ensure that all required input files exist in a unique directory. A symbolic link to the Swiftest driver should also exist in the simulation directory. To create a symbolic link to the Swiftest driver from your current directory, type: +To begin, Swiftest can be added to an existing conda environment, or a new conda environment may be created, so long as the required pacakges are installed. To create and activate a new conda environment with the prerequisite packages, open a terminal and navigate to the ```/swiftest/python/swiftest/``` directory. Type the following: ``` -$ ln -s ~/PATH/TO/swiftest/bin/swiftest_driver . +$ conda create --name EnvName pip scipy numpy matplotlib pandas xarray jupyter astropy -y +$ conda activate EnvName ``` -To run Swiftest, simply type the following command into the terminal: +Next, we will install further required pacakges. Using the ```-e``` flag imports all packages in ```/swiftest/python/swiftest/requirements.txt```, including Swiftest. If the Swiftest Python package is updated in the future, using the ```-e``` flag should ensure that the user does not have to reinstall the pacakge to use the updated verison. ``` -$ ./swiftest_driver INTEGRATOR param.in +$ pip install pySLALIB +$ pip install -e . ``` -Where ```INTEGRATOR``` is your integrator of choice, either ```whm```, ```rmvs```, ```helio```, or ```symba```. +The Swiftest Python package should now be installed in the conda environment and is ready to use. If you would like to take the further step to add Swiftest to a Jupyter Notebook kernel, type the following: -**Inputs** +``` +$ ipython kernel install --user --name EnvName --display-name "Swiftest Kernel" +``` -Swiftest takes four input files. All four input files are necessary, however the structure of each input file varies slightly depending on the features and capabilities of the integrator selected. For examples of Swiftest input files, see the examples section. The four input files are as follows: +--- + +#### Usage + +Swiftest is built to make running a Swiftest simulation a streamlined and user friendly experience, even for a new user. As a result, Swiftest is highly flexible and a simulation can be created, run, and processed in a number of different ways. The first choice the user must make is if they would prefer ASCII input files or NetCDF input files. We recommend NetCDF input files, however we include documentation for ASCII input files for completeness. + +**ASCII Input Files** +Swiftest accepts 4 ASCII input files. All four input files are necessary, however the structure of each input file varies slightly depending on the features and capabilities of the integrator selected. For examples of Swiftest input files, see the examples section. The four input files are as follows: - **param.in** - The parameter input file. - **cb.in** - The central body input file. - **pl.in** - The massive body input file. - **tp.in** - The test particle input file. -The **param.in** includes all user parameters available for the integrator selected. The parameter options are as follows: - -| Parameter Name | Parameter Description | Input Format | Compatible Integrators | -|-------------------------|---------------------------------------|--------------------------------------------------------------------------------------|------------------------| -| ```T0``` | Simulation start time in time units | floating point (ex. ```0.0```) | all -| ```TSTOP``` | Simulation end time in time units | floating point (ex. ```100.0```) | all -| ```DT``` | Simulation timestep in time units | floating point (ex. ```0.005```) | all -| ```ISTEP_OUT``` | Output cadence in number of timesteps | integer (ex. ```200```) | all -| ```ISTEP_DUMP``` | Dump cadence in number of timesteps | integer (ex. ```200```) | all -| ```OUT_FORM``` | Output format | ```XV```, ```EL```, ```XVEL``` | all -| ```OUT_TYPE``` | Output file format | ```NETCDF_FLOAT```, ```NETCDF_DOUBLE``` | all -| ```OUT_STAT``` | Output status | ```NEW```, ```APPEND```, ```REPLACE```, ```UNKNOWN``` | all -| ```IN_FORM``` | Input format | ```EL```, ```XV``` | all -| ```IN_TYPE``` | Input file format | ```ASCII``` (```NETCDF_FLOAT```, and ```NETCDF_DOUBLE``` *under development*) | all -| ```NC_IN``` | NetCDF input file name | string (ex. ```nc.in```) | only if ```IN_TYPE``` is set to a NetCDF type, *under development* -| ```PL_IN``` | Massive body input file name | string (ex. ```pl.in```) | all -| ```TP_IN``` | Test particle input file name | string (ex. ```tp.in```) | all -| ```CB_IN ``` | Central body input file name | string (ex. ```cb.in```) | all -| ```BIN_OUT``` | Output file name | string (ex. ```out.nc```, ```bin.dat```) | all -| ```CHK_QMIN``` | Pericenter distance at which a test particle is too close to the pericenter of the system in distance units | floating point, turn off using ```-1.0``` | all -| ```CHK_RMIN``` | Heliocentric distance at which a test particle is considered merged with the central body in distance units | floating point, turn off using ```-1.0``` | all -| ```CHK_RMAX``` | Heliocentric distance at which a test particle is too distant from the central body in distance units | floating point (ex. ```1000.0```) | all -| ```CHK_EJECT``` | Heliocentric distance at which an unbound test particle is too distant from the central body in distance units | floating point (ex. ```1000.0```) | all -| ```CHK_QMIN_COORD``` | Coordinate frame used to check for pericenter distance | ```HELIO```, ```BARY``` | all -| ```CHK_QMIN_RANGE``` | Upper and lower bounds of the semimajor axis range used to check the pericenter distance | two floating points, turn off using ```-1.0 -1.0``` | all -| ```MU2KG``` | Mass units to kilogram conversion | floating point (ex. ```1.988409870698051e+30```) | all -| ```TU2S``` | Time units to seconds conversion | floating point (ex. ```31557600.0```) | all -| ```DU2M``` | Distance units to meters conversion | floating point (ex. ```149597870700.0```) | all -| ```EXTRA_FORCE``` | Additional user defined force routines provided | ```YES```, ```NO``` | all -| ```PARTICLE_OUT``` | Particle output file name | string (ex. ```particle.out```) | all -| ```BIG_DISCARD``` | Include data for all fully-interacting bodies (above GMTINY) in each discard | ```YES```, ```NO``` | all -| ```CHK_CLOSE``` | Check for close encounters | ```YES```, ```NO``` | all -| ```GR``` | General relativity | ```YES```, ```NO``` | all -| ```INTERACTION_LOOPS``` | Method for checking for interactions between bodies | ```TRIANGULAR```, ```FLAT```, ```ADAPTIVE``` | all -| ```ENCOUNTER_CHECK``` | Method for checking for close encounters between bodies | ```TRIANGULAR```, ```SORTSWEEP```, ```ADAPTIVE``` | all -| ```RHILL_PRESENT``` | Hill Radius present in massive body input file | ```YES```, ```NO``` | SyMBA -| ```FRAGMENTATION``` | Resolve collisions with fragmentation | ```YES```, ```NO``` | SyMBA -| ```ROTATION``` | Rotational vectors present in massive body input file | ```YES```, ```NO``` | SyMBA -| ```ENERGY``` | Track the total energy of the system | ```YES```, ```NO``` | SyMBA -| ```ENERGY_OUT ``` | Energy output file name | string (ex. ```energy.out```) | SyMBA -| ```ENC_OUT ``` | Encounter output file name | string (ex. ```enc.out```) | all -| ```GMTINY``` | Mass cutoff between fully and semi-interacting massive bodies in gravitational mass units | floating point (ex. ```4e-06```) | SyMBA -| ```MIN_GMFRAG``` | Minimum fragment mass in gravitational mass units | floating point (ex. ```1e-09```) | SyMBA -| ```TIDES``` | Tidal dissipation model | ```YES```, ```NO``` | *(under development)* -| ```YORP``` | YORP effect | ```YES```, ```NO``` | *(under development)* -| ```YARKOVSKY``` | Yarkovsky effect | ```YES```, ```NO``` | *(under development)* - -In the above **param.in**, the following are defined as: +The parameter options used in the **param.in** are as follows: + +| Parameter Name | Parameter Description | Input Format | Compatible Integrators | +|-------------------------|------------------------------------------------------------------------------------------------------------------------------|---------------------------------------------------------------------------------------------------------|------------------------| +| ```T0``` | The reference time for the start of the simulation in time units. | floating point (ex. ```0.0```) | all +| ```TSTART``` | Simulation start time for a restarted run in time units. | floating point (ex. ```0.0```) | all +| ```TSTOP``` | Simulation end time in time units. Must be greater than ```TSTART```. | floating point (ex. ```100.0```) | all +| ```DT``` | Simulation step size in time units. Must be less than or equal to ```TSTOP```-```TSTART```. | floating point (ex. ```0.005```) | all +| ```ISTEP_OUT``` | The number of time steps (```DT```) between output saves to memory. | integer (ex. ```200```) | all +| ```DUMP_CADENCE``` | The number of output steps between when data saved to memory is written to file. Setting to ```0``` results in writing data to file only at the completion of the simulation. | integer (ex. ```100```) | all +| ```IN_TYPE``` | Input file format. | ```ASCII```, ```NETCDF_FLOAT```, and ```NETCDF_DOUBLE``` | all +| ```NC_IN``` | NetCDF input file name. Only if ```IN_TYPE``` is set to ```NETCDF_FLOAT``` or ```NETCDF_DOUBLE```. | string (ex. ```init_cond.nc```) | all +| ```PL_IN``` | Massive body input file name. Only if ```IN_TYPE``` is set to ```ASCII```. | string (ex. ```pl.in```) | all +| ```TP_IN``` | Test particle input file name. Only if ```IN_TYPE``` is set to ```ASCII```. | string (ex. ```tp.in```) | all +| ```CB_IN ``` | Central body input file name. Only if ```IN_TYPE``` is set to ```ASCII```. | string (ex. ```cb.in```) | all +| ```IN_FORM``` | Input format. | ```EL```, ```XV``` | all +| ```OUT_TYPE``` | Output file format. | ```NETCDF_FLOAT```, ```NETCDF_DOUBLE``` | all +| ```BIN_OUT``` | Output file name. | string (ex. ```bin.nc```) | all +| ```OUT_FORM``` | Output format. | ```XV```, ```XVEL``` | all +| ```OUT_STAT``` | Output status. | ```NEW```, ```APPEND```, ```REPLACE```, ```UNKNOWN``` | all +| ```CHK_QMIN``` | Pericenter distance at which a test particle is too close to the pericenter of the system in distance units. | floating point, turn off using ```-1.0``` | all +| ```CHK_RMIN``` | Heliocentric distance at which a test particle is considered merged with the central body in distance units. | floating point, turn off using ```-1.0``` | all +| ```CHK_RMAX``` | Heliocentric distance at which a test particle is too distant from the central body in distance units. | floating point (ex. ```1000.0```) | all +| ```CHK_EJECT``` | Heliocentric distance at which an unbound test particle is too distant from the central body in distance units. | floating point (ex. ```1000.0```) | all +| ```CHK_QMIN_COORD``` | Coordinate frame used to check for pericenter distance. | ```HELIO```, ```BARY``` | all +| ```CHK_QMIN_RANGE``` | Upper and lower bounds of the semimajor axis range used to check the pericenter distance. | two floating points, turn off using ```-1.0 -1.0``` | all +| ```EXTRA_FORCE``` | Additional user defined force routines provided. | ```YES```, ```NO``` | all +| ```CHK_CLOSE``` | Check for close encounters. | ```YES```, ```NO``` | all +| ```INTERACTION_LOOPS``` | Method for checking for interactions between bodies. | ```TRIANGULAR```, ```FLAT```, ```ADAPTIVE``` | all +| ```ENCOUNTER_CHECK``` | Method for checking for close encounters between bodies. | ```TRIANGULAR```, ```SORTSWEEP```, ```ADAPTIVE``` | all +| ```MU2KG``` | Mass units to kilogram conversion. | floating point (ex. ```1.988409870698051e+30```) | all +| ```TU2S``` | Time units to seconds conversion. | floating point (ex. ```31557600.0```) | all +| ```DU2M``` | Distance units to meters conversion. | floating point (ex. ```149597870700.0```) | all +| ```BIG_DISCARD``` | Include data for all fully-interacting bodies (above GMTINY) in each discard. | ```YES```, ```NO``` | all +| ```GR``` | General relativity. | ```YES```, ```NO``` | all +| ```RHILL_PRESENT``` | Hill Radius present in massive body input file. | ```YES```, ```NO``` | SyMBA +| ```ENERGY``` | Track the total energy of the system. | ```YES```, ```NO``` | SyMBA +| ```FRAGMENTATION``` | Resolve collisions with fragmentation. | ```YES```, ```NO``` | SyMBA +| ```ROTATION``` | Rotational vectors present in massive body input file. | ```YES```, ```NO``` | SyMBA +| ```GMTINY``` | Mass cutoff between fully and semi-interacting massive bodies in gravitational mass units. | floating point (ex. ```4e-06```) | SyMBA +| ```MIN_GMFRAG``` | Minimum fragment mass in gravitational mass units. | floating point (ex. ```1e-09```) | SyMBA +| ```TIDES``` | Tidal dissipation model. | ```YES```, ```NO``` | *(under development)* +| ```YORP``` | YORP effect. | ```YES```, ```NO``` | *(under development)* +| ```YARKOVSKY``` | Yarkovsky effect. | ```YES```, ```NO``` | *(under development)* + +In the above list, the following are defined as: - ```HELIO``` - Use the heliocentric coordinate frame for ```CHK_QMIN``` - ```BARY``` - Use the barycentric coordinate frame for ```CHK_QMIN``` - ```XV``` - Heliocentric position and velocity components for ```IN_FORM``` and/or ```OUT_FORM``` @@ -240,11 +241,117 @@ The **tp.in** includes all test particle initial conditions. In the Note that the ID numbers of the test particles are a continuation of the ID numbers of the massive bodies. No two bodies in the system can have the same ID number. +**NetCDF Input Files (Recommended)** + +Swiftest accepts a single NetCDF input file. This file can be created using the Swiftest Python Package through a few simple steps. + +To begin, simply create a new Python script in the directory you would like to store your simulation. Open the new script and import the Swiftest Python package. + +``` +import swiftest +``` + +Next, we initialize the Swiftest simulation object. Various parameters can be provided to the simulation via key word arguments at this stage. + +``` +sim = swiftest.Simulation() +``` + +The key word arguments available to the user, along with the default values for these arguments, are as follows: + +| Key Word Name | Key Word Description | Options | Compatible Integrators | +|---------------------------------|----------------------------------------------------------------------------------------------------|----------------------------------------------------------------------------------------------------|------------------------| +|```simdir``` | Path to subdirectory in which to store data. Default is ```/simdir```. | pathlike string (ex. ```path/to/directory```) +|```read_param``` | Read in a pre-existing parameter input file. Default is ```False```. | ```True```, ```False``` +|```param_file``` | Name of the pre-existing parameter input file. Only used if ```param_file``` is set to ```True```. | string (ex. ```param.in```) +|```read_old_output_file``` | Read in a pre-existing simulation output file. Default is ```False```. | ```True```, ```False``` +|```codename``` | Name of the N-body code to use. Default is ```Swiftest```. | ```Swiftest```, ```Swifter```, ```Swift``` +|```integrator``` | Name of the N-body integrator to use. Default is ```symba```. | ```symba```, ```helio```, ```rmvs```, ```whm``` +|```t0``` | The reference time for the start of the simulation in time units. Default is ```0.0```. | floating point (ex. ```0.0```) +|```tstart``` | Simulation start time for a restarted run in time units. Default is ```0.0```. | floating point (ex. ```0.0```) +|```tstop``` | Simulation end time in time units. Must be greater than ```tstart```. | floating point (ex. ```100.0```) +|```dt``` | Simulation step size in time units. Must be less than or equal to ```tstop```-```tstart```. | floating point (ex. ```0.005```) +|```istep_out``` | The number of time steps (```dt```) between output saves to memory. Either ```istep_out``` **OR** ```tstep_out``` may be set. | integer (ex. ```200```) +|```dump_cadence``` | The number of output steps between when data saved to memory is written to file. Setting to ```0``` results in writing data to file only at the completion of the simulation. Default is ```10```. | integer (ex. ```10```) +|```tstep_out``` | The approximate time between when outputs saved in memory are written to file in time units. Either ```istep_out``` **OR** ```tstep_out``` may be set. | floating point (ex. ```10.0```) that calculates ```istep_out = floor(tstep_out / dt)``` +|```init_cond_file_type``` | Input file format. Default is ```NETCDF_DOUBLE```. | ```NETCDF_DOUBLE```, ```NETCDF_FLOAT```, ```ASCII``` +|```init_cond_file_name``` | Input file name(s). If ```init_cond_file_type``` is set to ```NETCDF_DOUBLE``` or ```NETCDF_FLOAT```, default is ```init_cond.nc```. If ```init_cond_file_type``` is set to ```ASCII```, default is a dictionary: ```{"CB" : "cb.in", "PL" : "pl.in", "TP" : "tp.in"}```. | string (ex. ```my_init_cond.nc```) or dictionary ```{"CB" : "mycb.in", "PL" : "mypl.in", "TP" : "mytp.in"}``` +|```init_cond_format``` | Input format. Default is ```EL```. | ```EL```, ```XV``` +|```output_file_type``` | Output file format. Default is ```NETCDF_DOUBLE```. | ```NETCDF_DOUBLE```, ```NETCDF_FLOAT```, ```REAL4```, ```REAL8```, ```XDR4```, ```XDR8``` +|```output_file_name``` | Output file name. Default is ```bin.nc```. | string (ex. ```mydata.nc```) +|```output_format``` | Output format. Default is ```XVEL```. | ```XV```, ```XVEL``` +|```MU``` | Mass unit system to use in the simulation. Default is ```Msun```. | ```Msun```, ```Mearth```, ```kg```, ```g``` (case-insensitive) +|```DU``` | Distance unit system to use in the simulation. +|```TU``` | +|```MU2KG``` | +|```DU2M``` | +|```TU2S``` | +|```MU_NAME``` | +|```DU_NAME``` | +|```TU_NAME``` | +|```rmin``` | +|```rmax``` | +|```qmin_coord``` | +|```mtiny``` | +|```gmtiny``` | +|```close_encounter_check``` | +|```general_relativity``` | +|```fragmentation``` | +|```minimum_fragment_gmass``` | +|```minimum_fragment_mass``` | +|```rotation``` | +|```compute_conservation_values```| +|```extra_force``` | +|```big_discard``` | +|```rhill_present``` | +|```restart``` | +|```interaction_loops``` | +|```encounter_check_loops``` | +|```verbose``` | + + +**NOTHING IS CHECKED BELOW HERE** + +The Swiftest Python package also interfaces with the [NASA JPL Horizons database](https://ssd.jpl.nasa.gov/horizons/), allowing a user to easily import the initial conditions of known solar system bodies using the ```add``` function. + +``` +sim.add("Mercury") # An example of how to add a known body from the JPL Horizons database to a Swiftest simulation. +``` + +User defined bodies can also be added to a Swiftest simulation through the Python package. To add massive bodies using the ```addp``` function, define an ```IN_FORM``` and then add all desired initial conditions. The first 8 arguments (the id, the name, and either the cartesian state vectors or the orbital elements, depending on the value of ```IN_FORM```) are required, while the last 9 arguments (the gravitational mass, the radius, the Hill Radius, the principal moments of inertia, and the rotation vector) are optional. The ```addp``` function accepts single values or arrays of values. + +``` +sim.param['IN_FORM'] = "EL" # Set the in form to be orbital elements. Can also set to cartesian state vectors using XV. +sim.addp(id, name, a, e, inc, capom, omega, capm, GMpl=GMpl, Rpl=Rpl, rhill=rhill, Ip1=Ip1, Ip2=Ip2, Ip3=Ip3, rotx=rotx, roty=roty, rotz=rotz) # An example of how to add a user defined body to a Swiftest simulation. +``` + +Once all desired bodies and parameters are added to the simulation object, the information is saved to a set of initial condition files (**param.in**, **cb.in**, **pl.in**, **tp.in**) using the following line: + +``` +sim.save('param.in') # Saving the Swiftest input files. +``` + +The input files necessary to successfully run Swiftest should now be generated in the simulation directory. + +When creating a new Swiftest simulation, ensure that all required input files exist in a unique directory. A symbolic link to the Swiftest driver should also exist in the simulation directory. To create a symbolic link to the Swiftest driver from your current directory, type: + +``` +$ ln -s ~/PATH/TO/swiftest/bin/swiftest_driver . +``` + +To run Swiftest, simply type the following command into the terminal: + +``` +$ ./swiftest_driver INTEGRATOR param.in +``` + +Where ```INTEGRATOR``` is your integrator of choice, either ```whm```, ```rmvs```, ```helio```, or ```symba```. + + **Outputs** Swiftest generates between 1 and 6 output files, depending on the parameters defined in the **param.in**. The output files are as follows: -- **out.nc** - Always generated, the output file containing the information for every body in the system, written every ```ISTEP_OUT``` timesteps, NetCDF file format only -- **discard.out** - The output file containing the information for every body in the system and all discarded bodies, only if ```BIG_DISCARD``` is ```YES```, ASCII file format only +- **out.nc** - Always generated, the output file containing the information for every body in the system, written every ```ISTEP_OUT``` timesteps. - **fraggle.log** - The log containing the record of each fragmentation event, including the properties of the colliding bodies, the collisional regime, and the properties of the fragments created, only if ```FRAGMENTATION``` is ```YES```, SyMBA only, ASCII file format only - **encounter_check_plpl_timer.log** - The log containing the encounter check timer for each massive body/massive body encounter, only if ```ENCOUNTER_CHECK``` is ```ADAPTIVE```, ASCII file format only - **encounter_check_pltp_time.log** - The log containing the encounter check timer for each massive body/test particle encounter, only if ```ENCOUNTER_CHECK``` is ```ADAPTIVE```, ASCII file format only @@ -487,60 +594,25 @@ The NetCDF (Network Common Data Form) file format is a cross-platform method of In Swifter SyMBA, simulation outputs were stored in a flat binary file. These binary files could only be easily accessed through [SwiftVis](https://cs.trinity.edu/~mlewis/SwiftVis/), a data analysis and visualization software package designed to process Swifter data. In accordance with modern data management practices and industry standards, Swiftest incorporates a NetCDF output file format for all simulation types. NetCDF is compatible with many of today's most widely-used programming languages including Fortran, Python, Java, C++, and more. By writing simulation data to a NetCDF output file, Swiftest provides the user with the flexibility to analyze and visualize data in any language they choose. The NetCDF file format is also adaptable such that any future additions to Swiftest can be seamlessly incorporated into the output file. -**Swiftest Python Package** -Included with Swiftest, in the ```/swiftest/python/swiftest/``` directory, is a Python package designed to fascilitate seamless data processing and analysis. The Python package, also called Swiftest, can be used to generate input files and process output files in the NetCDF file format. -To begin, Swiftest can be added to an existing conda environment, or a new conda environment may be created, so long as the required pacakges are installed. To create and activate a new conda environment with the prerequisite packages, open a terminal and navigate to the ```/swiftest/python/swiftest/``` directory. Type the following: -``` -$ conda create --name EnvName pip scipy numpy matplotlib pandas xarray jupyter astropy -y -$ conda activate EnvName -``` -Next, we will install further required pacakges. Using the ```-e``` flag imports all packages in ```/swiftest/python/swiftest/requirements.txt```, including Swiftest. If the Swiftest Python package is updated in the future, using the ```-e``` flag should ensure that the user does not have to reinstall the pacakge to use the updated verison. -``` -$ pip install pySLALIB -$ pip install -e . -``` -The Swiftest Python package should now be installed in the conda environment and is ready to use. If you would like to take the further step to add Swiftest to a Jupyter Notebook kernel, type the following: -``` -$ ipython kernel install --user --name EnvName --display-name "Swiftest Kernel" -``` -Now that Swiftest has been added to your Python environment, generating an initial conditions file is relatively straightforward. To begin, simply create a new Python script in the simulation directory. The initial conditions script must contain all information for the **param.in** and all initial condition information for the bodies added to the simulation. All of this information can be changed later by directly editing the input files. -Open the new script, import the Swiftest Python package, and initialize the Swiftest simulation as an object. Various attributes can be attached to the simulation object, including all parameter information. -``` -import swiftest # Importing Swiftest -sim = swiftest.Simulation() # Initializing the simulation object -sim.param['T0'] = 0.0 # An example of how to attach a parameter to the simulation object. This parameter will be added to the param.in -``` -The Swiftest Python package also interfaces with the [NASA JPL Horizons database](https://ssd.jpl.nasa.gov/horizons/), allowing a user to easily import the initial conditions of known solar system bodies using the ```add``` function. -``` -sim.add("Mercury") # An example of how to add a known body from the JPL Horizons database to a Swiftest simulation. -``` -User defined bodies can also be added to a Swiftest simulation through the Python package. To add massive bodies using the ```addp``` function, define an ```IN_FORM``` and then add all desired initial conditions. The first 8 arguments (the id, the name, and either the cartesian state vectors or the orbital elements, depending on the value of ```IN_FORM```) are required, while the last 9 arguments (the gravitational mass, the radius, the Hill Radius, the principal moments of inertia, and the rotation vector) are optional. The ```addp``` function accepts single values or arrays of values. -``` -sim.param['IN_FORM'] = "EL" # Set the in form to be orbital elements. Can also set to cartesian state vectors using XV. -sim.addp(id, name, a, e, inc, capom, omega, capm, GMpl=GMpl, Rpl=Rpl, rhill=rhill, Ip1=Ip1, Ip2=Ip2, Ip3=Ip3, rotx=rotx, roty=roty, rotz=rotz) # An example of how to add a user defined body to a Swiftest simulation. -``` -Once all desired bodies and parameters are added to the simulation object, the information is saved to a set of initial condition files (**param.in**, **cb.in**, **pl.in**, **tp.in**) using the following line: -``` -sim.save('param.in') # Saving the Swiftest input files. -``` -The input files necessary to successfully run Swiftest should now be generated in the simulation directory. + + To read in a Swiftest output file, create a new Python script in the simulation directory. We recommend using [Xarray](https://docs.xarray.dev/en/stable/index.html) to manage and process output files. From d06b7da85f3b9b32a1c2de6067b4f68ad5ed8c98 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Tue, 6 Dec 2022 17:56:58 -0500 Subject: [PATCH 329/569] More updates to movie. Now interpolate across missing data in recursion step data --- examples/Fragmentation/Fragmentation_Movie.py | 18 +++++++++++------- 1 file changed, 11 insertions(+), 7 deletions(-) diff --git a/examples/Fragmentation/Fragmentation_Movie.py b/examples/Fragmentation/Fragmentation_Movie.py index 80f75a86a..0bff9416a 100644 --- a/examples/Fragmentation/Fragmentation_Movie.py +++ b/examples/Fragmentation/Fragmentation_Movie.py @@ -83,9 +83,14 @@ class AnimatedScatter(object): """An animated scatter plot using matplotlib.animations.FuncAnimation.""" - def __init__(self, sim, animfile, title, nskip=1): - tgood = sim.enc.where(sim.enc['Gmass'] > 9e-8).time - self.ds = sim.enc.sel(time=tgood) + def __init__(self, sim, animfile, title, style, nskip=1): + if style == "disruption_headon" or style == "hitandrun": + tgood = sim.enc.where(sim.enc['Gmass'] > 0.8 * body_Gmass[style][0]).time + else: + tgood = sim.enc.where(sim.enc['Gmass'] > 0.01 * body_Gmass[style][1]).time + + self.ds = sim.enc[['rh','vh','Gmass','radius']].sel(time=tgood).load().interpolate_na(dim="time") + nframes = int(self.ds['time'].size) self.sim = sim self.title = title @@ -134,13 +139,12 @@ def center(Gmass, x, y): x = x[~np.isnan(x)] y = y[~np.isnan(y)] Gmass = Gmass[~np.isnan(Gmass)] - x = x[Gmass] x_com = np.sum(Gmass * x) / np.sum(Gmass) - y_com = #np.sum(Gmass * y) / np.sum(Gmass) + y_com = np.sum(Gmass * y) / np.sum(Gmass) return x_com, y_com Gmass, rh, point_rad = next(self.data_stream(frame)) - #x_com, y_com = center(Gmass, rh[:,0], rh[:,1]) + x_com, y_com = center(Gmass, rh[:,0], rh[:,1]) self.scatter_artist.set_offsets(np.c_[rh[:,0] - x_com, rh[:,1] - y_com]) self.scatter_artist.set_sizes(point_rad**2) return self.scatter_artist, @@ -183,4 +187,4 @@ def data_stream(self, frame=0): sim.set_parameter(fragmentation=True, fragmentation_save="TRAJECTORY", gmtiny=gmtiny, minimum_fragment_gmass=minimum_fragment_gmass, verbose=False) sim.run(dt=1e-4, tstop=2.0e-3, istep_out=1, dump_cadence=0) - anim = AnimatedScatter(sim,movie_filename,movie_titles[style],nskip=1) \ No newline at end of file + anim = AnimatedScatter(sim,movie_filename,movie_titles[style],style,nskip=1) \ No newline at end of file From 3145e098043ce9dfc14d0617450d9612b07df758 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Wed, 7 Dec 2022 08:28:12 -0500 Subject: [PATCH 330/569] Fixed issues related to joining all the encounter data files --- python/swiftest/swiftest/io.py | 3 ++- python/swiftest/swiftest/simulation_class.py | 14 ++++++++------ 2 files changed, 10 insertions(+), 7 deletions(-) diff --git a/python/swiftest/swiftest/io.py b/python/swiftest/swiftest/io.py index f03fb622f..a4f370773 100644 --- a/python/swiftest/swiftest/io.py +++ b/python/swiftest/swiftest/io.py @@ -817,11 +817,12 @@ def process_netcdf_input(ds, param): ds : xarray dataset """ + ds = ds.where(~np.isnan(ds.id) ,drop=True) if param['OUT_TYPE'] == "NETCDF_DOUBLE": ds = fix_types(ds,ftype=np.float64) elif param['OUT_TYPE'] == "NETCDF_FLOAT": ds = fix_types(ds,ftype=np.float32) - ds = ds.where(ds.id >=0 ,drop=True) + # Check if the name variable contains unique values. If so, make name the dimension instead of id if "id" in ds.dims: if len(np.unique(ds['name'])) == len(ds['name']): diff --git a/python/swiftest/swiftest/simulation_class.py b/python/swiftest/swiftest/simulation_class.py index 4ac07386c..9e18a8ff8 100644 --- a/python/swiftest/swiftest/simulation_class.py +++ b/python/swiftest/swiftest/simulation_class.py @@ -323,12 +323,14 @@ def __init__(self,read_param: bool = False, read_old_output_file: bool = False, self.simdir = Path(simdir) if self.simdir.exists(): if not self.simdir.is_dir(): - msg = f"Cannot create the {self.simdir} directory: File exists." + msg = f"Cannot create the {self.simdir.resolve()} directory: File exists." msg += "\nDelete the file or change the location of param_file" - warnings.warn(msg,stacklevel=2) + raise NotADirectoryError(msg) else: - self.simdir.mkdir(parents=True, exist_ok=False) - + if read_old_output_file or read_param: + raise NotADirectoryError(f"Cannot find directory {self.simdir.resolve()} ") + else: + self.simdir.mkdir(parents=True, exist_ok=False) # Set the location of the parameter input file, choosing the default if it isn't specified. param_file = kwargs.pop("param_file",Path.cwd() / self.simdir / "param.in") @@ -376,7 +378,7 @@ def __init__(self,read_param: bool = False, read_old_output_file: bool = False, if os.path.exists(binpath): self.read_output_file() else: - warnings.warn(f"BIN_OUT file {binpath} not found.",stacklevel=2) + raise FileNotFoundError(f"BIN_OUT file {binpath} not found.") return def _run_swiftest_driver(self): @@ -2770,7 +2772,7 @@ def _preprocess(ds, param): return io.process_netcdf_input(ds,param) partial_func = partial(_preprocess, param=self.param) - self.enc = xr.open_mfdataset(enc_files,parallel=True,preprocess=partial_func,mask_and_scale=True) + self.enc = xr.open_mfdataset(enc_files,parallel=True,combine="nested",concat_dim="time",join="left",preprocess=partial_func,mask_and_scale=True) self.enc = io.process_netcdf_input(self.enc, self.param) return From f4fec1e02d447399afe8c2ca560ef3315bac0b3a Mon Sep 17 00:00:00 2001 From: David A Minton Date: Wed, 7 Dec 2022 09:06:48 -0500 Subject: [PATCH 331/569] Fixed more bugs in encounter data processing --- examples/.gitignore | 8 ++-- examples/Fragmentation/Fragmentation_Movie.py | 6 +-- python/swiftest/swiftest/simulation_class.py | 41 +++++++++++-------- 3 files changed, 30 insertions(+), 25 deletions(-) diff --git a/examples/.gitignore b/examples/.gitignore index 7c5c72692..ad990dfcb 100644 --- a/examples/.gitignore +++ b/examples/.gitignore @@ -1,6 +1,6 @@ * !.gitignore -!Basic_Simulation/* -!Fragmentation/* -!helio_gr_test/* -!whm_gr_test/* \ No newline at end of file +!Basic_Simulation +!Fragmentation +!helio_gr_test +!whm_gr_test \ No newline at end of file diff --git a/examples/Fragmentation/Fragmentation_Movie.py b/examples/Fragmentation/Fragmentation_Movie.py index 0bff9416a..fa1203a8e 100644 --- a/examples/Fragmentation/Fragmentation_Movie.py +++ b/examples/Fragmentation/Fragmentation_Movie.py @@ -40,8 +40,8 @@ movie_titles = dict(zip(available_movie_styles, movie_title_list)) # These initial conditions were generated by trial and error -pos_vectors = {"disruption_headon" : [np.array([1.0, -2.807993e-05, 0.0]), - np.array([1.0, 2.807993e-05 ,0.0])], +pos_vectors = {"disruption_headon" : [np.array([1.0, -5.0e-05, 0.0]), + np.array([1.0, 5.0e-05 ,0.0])], "supercatastrophic_off_axis": [np.array([1.0, -4.2e-05, 0.0]), np.array([1.0, 4.2e-05, 0.0])], "hitandrun" : [np.array([1.0, -2.0e-05, 0.0]), @@ -185,6 +185,6 @@ def data_stream(self, frame=0): 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, fragmentation_save="TRAJECTORY", gmtiny=gmtiny, minimum_fragment_gmass=minimum_fragment_gmass, verbose=False) - sim.run(dt=1e-4, tstop=2.0e-3, istep_out=1, dump_cadence=0) + sim.run(dt=1e-4, tstop=4.0e-3, istep_out=1, dump_cadence=0) anim = AnimatedScatter(sim,movie_filename,movie_titles[style],style,nskip=1) \ No newline at end of file diff --git a/python/swiftest/swiftest/simulation_class.py b/python/swiftest/swiftest/simulation_class.py index 9e18a8ff8..9b9bd02dc 100644 --- a/python/swiftest/swiftest/simulation_class.py +++ b/python/swiftest/swiftest/simulation_class.py @@ -17,6 +17,7 @@ from swiftest import __file__ as _pyfile import json import os +from glob import glob from pathlib import Path import datetime import xarray as xr @@ -2667,23 +2668,23 @@ def convert(self, param_file, newcodename="Swiftest", plname="pl.swiftest.in", t Parameters ---------- - param_file : string - File name of the input parameter file - newcodename : string - Name of the desired format (Swift/Swifter/Swiftest) - plname : string - File name of the massive body input file - tpname : string - File name of the test particle input file - cbname : string - File name of the central body input file - conversion_questions : dictronary - Dictionary of additional parameters required to convert between formats + param_file : string + File name of the input parameter file + newcodename : string + Name of the desired format (Swift/Swifter/Swiftest) + plname : string + File name of the massive body input file + tpname : string + File name of the test particle input file + cbname : string + File name of the central body input file + conversion_questions : dictronary + Dictionary of additional parameters required to convert between formats Returns ------- - oldparam : xarray dataset - The old parameter configuration. + oldparam : xarray dataset + The old parameter configuration. """ oldparam = self.param if self.codename == newcodename: @@ -2720,12 +2721,12 @@ def read_output_file(self,read_init_cond : bool = True): Parameters ---------- - read_init_cond : bool - Read in an initial conditions file along with the output file. Default is True + read_init_cond : bool + Read in an initial conditions file along with the output file. Default is True Returns ------- - self.data : xarray dataset + self.data : xarray dataset """ # Make a temporary copy of the parameter dictionary so we can supply the absolute path of the binary file @@ -2765,7 +2766,8 @@ def read_output_file(self,read_init_cond : bool = True): def read_encounter(self): if self.verbose: print("Reading encounter history file as .enc") - enc_files = self.simdir.glob("**/encounter_*.nc") + enc_files = glob(f"{self.simdir}{os.path.sep}encounter_*.nc") + enc_files.sort() # This is needed in order to pass the param argument down to the io.process_netcdf_input function def _preprocess(ds, param): @@ -2774,6 +2776,9 @@ def _preprocess(ds, param): self.enc = xr.open_mfdataset(enc_files,parallel=True,combine="nested",concat_dim="time",join="left",preprocess=partial_func,mask_and_scale=True) self.enc = io.process_netcdf_input(self.enc, self.param) + # Remove any overlapping time values + tgood,tid = np.unique(self.enc.time,return_index=True) + self.enc = self.enc.isel(time=tid) return From d09d8c5e90b68a85e041fe72334a0292736ca076 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Wed, 7 Dec 2022 11:46:09 -0500 Subject: [PATCH 332/569] Made a number of improvements to the handling of encounters. time and id dimensions are now limited, which significantly reduces the file sizes of the individual encounter data files --- src/modules/symba_classes.f90 | 12 +++--- src/symba/symba_io.f90 | 79 ++++++++++++++++++++++++----------- src/symba/symba_util.f90 | 11 +++-- 3 files changed, 66 insertions(+), 36 deletions(-) diff --git a/src/modules/symba_classes.f90 b/src/modules/symba_classes.f90 index 68b94c373..6c3aaae12 100644 --- a/src/modules/symba_classes.f90 +++ b/src/modules/symba_classes.f90 @@ -182,12 +182,12 @@ module symba_classes !! NetCDF dimension and variable names for the enounter save object type, extends(netcdf_parameters) :: symba_io_encounter_parameters - integer(I4B) :: COLLIDER_DIM_SIZE = 2 !! Size of collider dimension - integer(I4B) :: ienc_frame = 1 !! Current frame number for the encounter history - character(STRMAX) :: enc_file = "encounter.nc" !! Encounter output file name - - character(NAMELEN) :: level_varname = "level" !! Recursion depth + integer(I4B) :: ienc_frame = 1 !! Current frame number for the encounter history + character(STRMAX) :: enc_file = "encounter.nc" !! Encounter output file name + character(NAMELEN) :: level_varname = "level" !! Recursion depth integer(I4B) :: level_varid !! ID for the recursion level variable + integer(I4B) :: time_dimsize = 0 !! Number of time values in snapshot + integer(I4B) :: id_dimsize = 0 !! Number of potential id values in snapshot contains procedure :: initialize => symba_io_encounter_initialize_output !! Initialize a set of parameters used to identify a NetCDF output object end type symba_io_encounter_parameters @@ -230,7 +230,7 @@ module symba_classes type, extends(symba_nbody_system) :: symba_encounter_snapshot - integer(I4B) :: tslot !! The index for the time array in the final NetCDF file + integer(I4B) :: tslot !! The index for the time array in the final NetCDF file contains procedure :: write_encounter_frame => symba_io_encounter_write_frame !! Writes a frame of encounter data to file generic :: write_frame => write_encounter_frame diff --git a/src/symba/symba_io.f90 b/src/symba/symba_io.f90 index 0fceaa724..bc0f1b985 100644 --- a/src/symba/symba_io.f90 +++ b/src/symba/symba_io.f90 @@ -31,6 +31,8 @@ module subroutine symba_io_encounter_dump(self, param) self%nc%ienc_frame = i call snapshot%write_frame(self%nc,param) end select + else + exit end if end do @@ -57,7 +59,6 @@ module subroutine symba_io_encounter_initialize_output(self, param) character(len=STRMAX) :: errmsg integer(I4B) :: ndims - associate(nc => self) dfill = ieee_value(dfill, IEEE_QUIET_NAN) sfill = ieee_value(sfill, IEEE_QUIET_NAN) @@ -69,7 +70,6 @@ module subroutine symba_io_encounter_initialize_output(self, param) self%out_type = NF90_DOUBLE end select - ! Check if the file exists, and if it does, delete it inquire(file=nc%enc_file, exist=fileExists) if (fileExists) then @@ -80,9 +80,9 @@ module subroutine symba_io_encounter_initialize_output(self, param) call check( nf90_create(nc%enc_file, NF90_NETCDF4, nc%id), "symba_io_encounter_initialize_output nf90_create" ) ! Dimensions - call check( nf90_def_dim(nc%id, nc%time_dimname, NF90_UNLIMITED, nc%time_dimid), "symba_io_encounter_initialize_output nf90_def_dim time_dimid" ) ! Simulation time dimension - call check( nf90_def_dim(nc%id, nc%space_dimname, NDIM, nc%space_dimid), "symba_io_encounter_initialize_output nf90_def_dim space_dimid" ) ! 3D space dimension - call check( nf90_def_dim(nc%id, nc%id_dimname, NF90_UNLIMITED, nc%id_dimid), "symba_io_encounter_initialize_output nf90_def_dim id_dimid" ) ! dimension to store particle id numbers + call check( nf90_def_dim(nc%id, nc%time_dimname, nc%time_dimsize, nc%time_dimid), "symba_io_encounter_initialize_output nf90_def_dim time_dimid" ) ! Simulation time dimension + call check( nf90_def_dim(nc%id, nc%space_dimname, NDIM , nc%space_dimid), "symba_io_encounter_initialize_output nf90_def_dim space_dimid" ) ! 3D space dimension + call check( nf90_def_dim(nc%id, nc%id_dimname, param%maxid, nc%id_dimid), "symba_io_encounter_initialize_output nf90_def_dim id_dimid" ) ! dimension to store particle id numbers call check( nf90_def_dim(nc%id, nc%str_dimname, NAMELEN, nc%str_dimid), "symba_io_encounter_initialize_output nf90_def_dim str_dimid" ) ! Dimension for string variables (aka character arrays) ! Dimension coordinates @@ -141,37 +141,58 @@ module subroutine symba_io_encounter_write_frame(self, nc, param) use netcdf implicit none ! Arguments - class(symba_encounter_snapshot), intent(in) :: self !! Swiftest encounter structure - class(symba_io_encounter_parameters), intent(inout) :: nc !! Parameters used to identify a particular encounter io NetCDF dataset - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + class(symba_encounter_snapshot), intent(in) :: self !! Swiftest encounter structure + class(symba_io_encounter_parameters), intent(inout) :: nc !! Parameters used to identify a particular encounter io NetCDF dataset + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters ! Internals - integer(I4B) :: i, tslot, idslot, old_mode, n - character(len=NAMELEN) :: charstring + integer(I4B) :: i, tslot, idslot, old_mode, npl, ntp + character(len=NAMELEN) :: charstring - tslot = self%tslot call check( nf90_set_fill(nc%id, nf90_nofill, old_mode), "symba_io_encounter_write_frame nf90_set_fill" ) + + tslot = self%tslot + call check( nf90_put_var(nc%id, nc%time_varid, self%t, start=[tslot]), "symba_io_encounter_write_frame nf90_put_var time_varid" ) + select type(pl => self%pl) class is (symba_pl) - n = size(pl%id(:)) - do i = 1, n + npl = pl%nbody + do i = 1, npl idslot = pl%id(i) - call check( nf90_put_var(nc%id, nc%time_varid, self%t, start=[tslot]), "symba_io_encounter_write_frame nf90_put_var time_varid" ) - call check( nf90_put_var(nc%id, nc%id_varid, pl%id(i), start=[idslot]), "symba_io_encounter_write_frame nf90_put_var id_varid" ) - call check( nf90_put_var(nc%id, nc%rh_varid, pl%rh(:,i), start=[1,idslot,tslot], count=[NDIM,1,1]), "symba_io_encounter_write_frame nf90_put_var rh_varid" ) - call check( nf90_put_var(nc%id, nc%vh_varid, pl%vh(:,i), start=[1,idslot,tslot], count=[NDIM,1,1]), "symba_io_encounter_write_frame nf90_put_var vh_varid" ) - call check( nf90_put_var(nc%id, nc%Gmass_varid, pl%Gmass(i), start=[idslot, tslot]), "symba_io_encounter_write_frame nf90_put_var body Gmass_varid" ) - if (param%lclose) call check( nf90_put_var(nc%id, nc%radius_varid, pl%radius(i), start=[idslot, tslot]), "symba_io_encounter_write_frame nf90_put_var body radius_varid" ) + call check( nf90_put_var(nc%id, nc%id_varid, pl%id(i), start=[idslot]), "symba_io_encounter_write_frame nf90_put_var pl id_varid" ) + call check( nf90_put_var(nc%id, nc%rh_varid, pl%rh(:,i), start=[1,idslot,tslot], count=[NDIM,1,1]), "symba_io_encounter_write_frame nf90_put_var pl rh_varid" ) + call check( nf90_put_var(nc%id, nc%vh_varid, pl%vh(:,i), start=[1,idslot,tslot], count=[NDIM,1,1]), "symba_io_encounter_write_frame nf90_put_var pl vh_varid" ) + call check( nf90_put_var(nc%id, nc%Gmass_varid, pl%Gmass(i), start=[idslot, tslot]), "symba_io_encounter_write_frame nf90_put_var pl Gmass_varid" ) + + if (param%lclose) call check( nf90_put_var(nc%id, nc%radius_varid, pl%radius(i), start=[idslot, tslot]), "symba_io_encounter_write_frame nf90_put_var pl radius_varid" ) + if (param%lrotation) then - call check( nf90_put_var(nc%id, nc%Ip_varid, pl%Ip(:,i), start=[1, idslot, tslot], count=[NDIM,1,1]), "symba_io_encounter_write_frame nf90_put_var body Ip_varid" ) - call check( nf90_put_var(nc%id, nc%rot_varid, pl%rot(:,i), start=[1,idslot, tslot], count=[NDIM,1,1]), "symba_io_encounter_write_frame nf90_put_var body rotx_varid" ) + call check( nf90_put_var(nc%id, nc%Ip_varid, pl%Ip(:,i), start=[1, idslot, tslot], count=[NDIM,1,1]), "symba_io_encounter_write_frame nf90_put_var pl Ip_varid" ) + call check( nf90_put_var(nc%id, nc%rot_varid, pl%rot(:,i), start=[1,idslot, tslot], count=[NDIM,1,1]), "symba_io_encounter_write_frame nf90_put_var pl rotx_varid" ) end if + charstring = trim(adjustl(pl%info(i)%name)) - call check( nf90_put_var(nc%id, nc%name_varid, charstring, start=[1, idslot], count=[NAMELEN, 1]), "symba_io_encounter_write_frame nf90_put_var name_varid" ) + call check( nf90_put_var(nc%id, nc%name_varid, charstring, start=[1, idslot], count=[NAMELEN, 1]), "symba_io_encounter_write_frame nf90_put_var pl name_varid" ) charstring = trim(adjustl(pl%info(i)%particle_type)) - call check( nf90_put_var(nc%id, nc%ptype_varid, charstring, start=[1, idslot], count=[NAMELEN, 1]), "symba_io_encounter_write_frame nf90_put_var particle_type_varid" ) + call check( nf90_put_var(nc%id, nc%ptype_varid, charstring, start=[1, idslot], count=[NAMELEN, 1]), "symba_io_encounter_write_frame nf90_put_var pl particle_type_varid" ) end do + end select + associate(tp => self%tp) + ntp = tp%nbody + do i = 1, ntp + idslot = tp%id(i) + call check( nf90_put_var(nc%id, nc%id_varid, tp%id(i), start=[idslot]), "symba_io_encounter_write_frame nf90_put_var tp id_varid" ) + call check( nf90_put_var(nc%id, nc%rh_varid, tp%rh(:,i), start=[1,idslot,tslot], count=[NDIM,1,1]), "symba_io_encounter_write_frame nf90_put_var tp rh_varid" ) + call check( nf90_put_var(nc%id, nc%vh_varid, tp%vh(:,i), start=[1,idslot,tslot], count=[NDIM,1,1]), "symba_io_encounter_write_frame nf90_put_var tp vh_varid" ) + + charstring = trim(adjustl(tp%info(i)%name)) + call check( nf90_put_var(nc%id, nc%name_varid, charstring, start=[1, idslot], count=[NAMELEN, 1]), "symba_io_encounter_write_frame nf90_put_var tp name_varid" ) + charstring = trim(adjustl(tp%info(i)%particle_type)) + call check( nf90_put_var(nc%id, nc%ptype_varid, charstring, start=[1, idslot], count=[NAMELEN, 1]), "symba_io_encounter_write_frame nf90_put_var tp particle_type_varid" ) + end do + end associate + call check( nf90_set_fill(nc%id, old_mode, old_mode) ) return @@ -388,10 +409,20 @@ module subroutine symba_io_stop_encounter(self, param, t) class(symba_parameters), intent(inout) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! Current simulation time ! Internals - !character(STRMAX) + integer(I4B) :: i ! Create and save the output file for this encounter + + ! Figure out how many time slots we need + do i = 1, self%encounter_history%nframes + if (self%t + param%dt <= self%encounter_history%tvals(i)) then + self%encounter_history%nc%time_dimsize = i + exit + end if + end do + write(self%encounter_history%nc%enc_file, '("encounter_",I0.6,".nc")') param%iloop + call self%encounter_history%nc%initialize(param) call self%encounter_history%dump(param) call self%encounter_history%nc%close() diff --git a/src/symba/symba_util.f90 b/src/symba/symba_util.f90 index 20d295b9c..b96270fc9 100644 --- a/src/symba/symba_util.f90 +++ b/src/symba/symba_util.f90 @@ -1326,9 +1326,10 @@ module subroutine symba_util_take_encounter_snapshot(self, param, t) associate(npl => self%pl%nbody, ntp => self%tp%nbody) allocate(symba_encounter_snapshot :: snapshot) + snapshot%t = t - if (npl > 0) allocate(symba_pl :: snapshot%pl) - if (ntp > 0) allocate(symba_tp :: snapshot%tp) + allocate(symba_pl :: snapshot%pl) + allocate(symba_tp :: snapshot%tp) if (npl + ntp == 0) return npl_snap = npl ntp_snap = ntp @@ -1345,6 +1346,7 @@ module subroutine symba_util_take_encounter_snapshot(self, param, t) tp%lmask(1:ntp) = tp%status(1:ntp) /= INACTIVE .and. tp%levelg(1:ntp) == self%irec ntp_snap = count(tp%lmask(1:ntp)) end if + snapshot%pl%nbody = npl_snap ! Take snapshot of the currently encountering massive bodies if (npl_snap > 0) then @@ -1377,6 +1379,7 @@ module subroutine symba_util_take_encounter_snapshot(self, param, t) end if ! Take snapshot of the currently encountering test particles + snapshot%tp%nbody = ntp_snap if (ntp_snap > 0) then allocate(snapshot%tp%id(ntp_snap)) allocate(snapshot%tp%info(ntp_snap)) @@ -1390,10 +1393,6 @@ module subroutine symba_util_take_encounter_snapshot(self, param, t) end do end if - if (npl_snap + ntp_snap == 0) return - - snapshot%t = t - ! Save the snapshot self%encounter_history%iframe = self%encounter_history%iframe + 1 call self%resize_storage(self%encounter_history%iframe) From be401c7f95ddb3b4bdef112c5e0f97566cdb9bde Mon Sep 17 00:00:00 2001 From: David A Minton Date: Wed, 7 Dec 2022 12:12:50 -0500 Subject: [PATCH 333/569] Removed weird duplicate file --- src/setup/symba_collision.f90 | 1090 --------------------------------- 1 file changed, 1090 deletions(-) delete mode 100644 src/setup/symba_collision.f90 diff --git a/src/setup/symba_collision.f90 b/src/setup/symba_collision.f90 deleted file mode 100644 index c4d04ee75..000000000 --- a/src/setup/symba_collision.f90 +++ /dev/null @@ -1,1090 +0,0 @@ -!! Copyright 2022 - David Minton, Carlisle Wishard, Jennifer Pouplin, Jake Elliott, & Dana Singh -!! This file is part of Swiftest. -!! Swiftest is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License -!! as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. -!! Swiftest is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty -!! of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. -!! You should have received a copy of the GNU General Public License along with Swiftest. -!! If not, see: https://www.gnu.org/licenses. - -submodule (symba_classes) s_symba_collision - use swiftest - -contains - - module function symba_collision_casedisruption(system, param, colliders, frag) result(status) - !! author: Jennifer L.L. Pouplin, Carlisle A. Wishard, and David A. Minton - !! - !! Create the fragments resulting from a non-catastrophic disruption collision - !! - implicit none - ! Arguments - class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object - class(symba_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions - class(fraggle_colliders), intent(inout) :: colliders !! Fraggle colliders object - class(fraggle_fragments), intent(inout) :: frag !! Fraggle fragmentation system object - ! Result - integer(I4B) :: status !! Status flag assigned to this outcome - ! Internals - integer(I4B) :: i, nfrag - logical :: lfailure - character(len=STRMAX) :: message - - select case(frag%regime) - case(COLLRESOLVE_REGIME_DISRUPTION) - message = "Disruption between" - case(COLLRESOLVE_REGIME_SUPERCATASTROPHIC) - message = "Supercatastrophic disruption between" - end select - call symba_collision_collider_message(system%pl, colliders%idx, message) - call io_log_one_message(FRAGGLE_LOG_OUT, message) - - ! Collisional fragments will be uniformly distributed around the pre-impact barycenter - call frag%set_mass_dist(colliders, param) - - ! Generate the position and velocity distributions of the fragments - call frag%generate_fragments(colliders, system, param, lfailure) - - if (lfailure) then - call io_log_one_message(FRAGGLE_LOG_OUT, "No fragment solution found, so treat as a pure hit-and-run") - status = ACTIVE - nfrag = 0 - select type(pl => system%pl) - class is (symba_pl) - pl%status(colliders%idx(:)) = status - pl%ldiscard(colliders%idx(:)) = .false. - pl%lcollision(colliders%idx(:)) = .false. - end select - else - ! Populate the list of new bodies - nfrag = frag%nbody - write(message, *) nfrag - call io_log_one_message(FRAGGLE_LOG_OUT, "Generating " // trim(adjustl(message)) // " fragments") - select case(frag%regime) - case(COLLRESOLVE_REGIME_DISRUPTION) - status = DISRUPTION - case(COLLRESOLVE_REGIME_SUPERCATASTROPHIC) - status = SUPERCATASTROPHIC - end select - frag%id(1:nfrag) = [(i, i = param%maxid + 1, param%maxid + nfrag)] - param%maxid = frag%id(nfrag) - call symba_collision_mergeaddsub(system, param, colliders, frag, status) - end if - - return - end function symba_collision_casedisruption - - - module function symba_collision_casehitandrun(system, param, colliders, frag) result(status) - !! author: Jennifer L.L. Pouplin, Carlisle A. Wishard, and David A. Minton - !! - !! Create the fragments resulting from a non-catastrophic hit-and-run collision - !! - implicit none - ! Arguments - class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object - class(symba_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions - class(fraggle_colliders), intent(inout) :: colliders !! Fraggle colliders object - class(fraggle_fragments), intent(inout) :: frag !! Fraggle fragmentation system object - ! Result - integer(I4B) :: status !! Status flag assigned to this outcom - ! Internals - integer(I4B) :: i, ibiggest, nfrag, jtarg, jproj - logical :: lpure - character(len=STRMAX) :: message - - message = "Hit and run between" - call symba_collision_collider_message(system%pl, colliders%idx, message) - call io_log_one_message(FRAGGLE_LOG_OUT, trim(adjustl(message))) - - if (colliders%mass(1) > colliders%mass(2)) then - jtarg = 1 - jproj = 2 - else - jtarg = 2 - jproj = 1 - end if - - if (frag%mass_dist(2) > 0.9_DP * colliders%mass(jproj)) then ! Pure hit and run, so we'll just keep the two bodies untouched - call io_log_one_message(FRAGGLE_LOG_OUT, "Pure hit and run. No new fragments generated.") - nfrag = 0 - lpure = .true. - else ! Imperfect hit and run, so we'll keep the largest body and destroy the other - lpure = .false. - call frag%set_mass_dist(colliders, param) - - ! Generate the position and velocity distributions of the fragments - call frag%generate_fragments(colliders, system, param, lpure) - - if (lpure) then - call io_log_one_message(FRAGGLE_LOG_OUT, "Should have been a pure hit and run instead") - nfrag = 0 - else - nfrag = frag%nbody - write(message, *) nfrag - call io_log_one_message(FRAGGLE_LOG_OUT, "Generating " // trim(adjustl(message)) // " fragments") - end if - end if - if (lpure) then ! Reset these bodies back to being active so that nothing further is done to them - status = HIT_AND_RUN_PURE - select type(pl => system%pl) - class is (symba_pl) - pl%status(colliders%idx(:)) = ACTIVE - pl%ldiscard(colliders%idx(:)) = .false. - pl%lcollision(colliders%idx(:)) = .false. - end select - else - ibiggest = colliders%idx(maxloc(system%pl%Gmass(colliders%idx(:)), dim=1)) - frag%id(1) = system%pl%id(ibiggest) - frag%id(2:nfrag) = [(i, i = param%maxid + 1, param%maxid + nfrag - 1)] - param%maxid = frag%id(nfrag) - status = HIT_AND_RUN_DISRUPT - call symba_collision_mergeaddsub(system, param, colliders, frag, status) - end if - - return - end function symba_collision_casehitandrun - - - module function symba_collision_casemerge(system, param, colliders, frag) result(status) - !! author: Jennifer L.L. Pouplin, Carlisle A. Wishard, and David A. Minton - !! - !! Merge massive bodies. - !! - !! Adapted from David E. Kaufmann's Swifter routines symba_merge_pl.f90 and symba_discard_merge_pl.f90 - !! - !! Adapted from Hal Levison's Swift routines symba5_merge.f and discard_mass_merge.f - implicit none - ! Arguments - class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object - class(symba_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions - class(fraggle_colliders), intent(inout) :: colliders !! Fraggle colliders object - class(fraggle_fragments), intent(inout) :: frag !! Fraggle fragmentation system object - ! Result - integer(I4B) :: status !! Status flag assigned to this outcome - ! Internals - integer(I4B) :: i, j, k, ibiggest - real(DP) :: pe - real(DP), dimension(NDIM) :: L_spin_new - character(len=STRMAX) :: message - - message = "Merging" - call symba_collision_collider_message(system%pl, colliders%idx, message) - call io_log_one_message(FRAGGLE_LOG_OUT, message) - - select type(pl => system%pl) - class is (symba_pl) - - call frag%set_mass_dist(colliders, param) - ibiggest = colliders%idx(maxloc(pl%Gmass(colliders%idx(:)), dim=1)) - frag%id(1) = pl%id(ibiggest) - frag%xb(:,1) = frag%xbcom(:) - frag%vb(:,1) = frag%vbcom(:) - - if (param%lrotation) then - ! Conserve angular momentum by putting pre-impact orbital momentum into spin of the new body - L_spin_new(:) = colliders%L_orbit(:,1) + colliders%L_orbit(:,2) + colliders%L_spin(:,1) + colliders%L_spin(:,2) - - ! Assume prinicpal axis rotation on 3rd Ip axis - frag%rot(:,1) = L_spin_new(:) / (frag%Ip(3,1) * frag%mass(1) * frag%radius(1)**2) - else ! If spin is not enabled, we will consider the lost pre-collision angular momentum as "escaped" and add it to our bookkeeping variable - param%Lescape(:) = param%Lescape(:) + colliders%L_orbit(:,1) + colliders%L_orbit(:,2) - end if - - ! Keep track of the component of potential energy due to the pre-impact colliders%idx for book-keeping - pe = 0.0_DP - do j = 1, colliders%ncoll - do i = j + 1, colliders%ncoll - pe = pe - pl%Gmass(i) * pl%mass(j) / norm2(pl%xb(:, i) - pl%xb(:, j)) - end do - end do - system%Ecollisions = system%Ecollisions + pe - system%Euntracked = system%Euntracked - pe - - ! Update any encounter lists that have the removed bodies in them so that they instead point to the new - do k = 1, system%plplenc_list%nenc - do j = 1, colliders%ncoll - i = colliders%idx(j) - if (i == ibiggest) cycle - if (system%plplenc_list%id1(k) == pl%id(i)) then - system%plplenc_list%id1(k) = pl%id(ibiggest) - system%plplenc_list%index1(k) = i - end if - if (system%plplenc_list%id2(k) == pl%id(i)) then - system%plplenc_list%id2(k) = pl%id(ibiggest) - system%plplenc_list%index2(k) = i - end if - if (system%plplenc_list%id1(k) == system%plplenc_list%id2(k)) system%plplenc_list%status(k) = INACTIVE - end do - end do - - status = MERGED - - call symba_collision_mergeaddsub(system, param, colliders, frag, status) - - end select - - return - end function symba_collision_casemerge - - - subroutine symba_collision_collider_message(pl, collidx, collider_message) - !! author: David A. Minton - !! - !! Prints a nicely formatted message about which bodies collided, including their names and ids. - !! This subroutine appends the body names and ids to an input message. - implicit none - ! Arguments - class(swiftest_pl), intent(in) :: pl !! Swiftest massive body object - integer(I4B), dimension(:), intent(in) :: collidx !! Index of collisional colliders%idx members - character(*), intent(inout) :: collider_message !! The message to print to the screen. - ! Internals - integer(I4B) :: i, n - character(len=STRMAX) :: idstr - - n = size(collidx) - if (n == 0) return - - do i = 1, n - if (i > 1) collider_message = trim(adjustl(collider_message)) // " and " - collider_message = " " // trim(adjustl(collider_message)) // " " // trim(adjustl(pl%info(collidx(i))%name)) - write(idstr, '(I10)') pl%id(collidx(i)) - collider_message = trim(adjustl(collider_message)) // " (" // trim(adjustl(idstr)) // ") " - end do - - return - end subroutine symba_collision_collider_message - - - module function symba_collision_check_encounter(self, system, param, t, dt, irec) result(lany_collision) - !! author: David A. Minton - !! - !! Check for merger between massive bodies and test particles in SyMBA - !! - !! Adapted from David E. Kaufmann's Swifter routine symba_merge.f90 and symba_merge_tp.f90 - !! - !! Adapted from Hal Levison's Swift routine symba5_merge.f - implicit none - ! Arguments - class(symba_encounter), intent(inout) :: self !! SyMBA pl-tp encounter list object - class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object - class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters - real(DP), intent(in) :: t !! current time - real(DP), intent(in) :: dt !! step size - integer(I4B), intent(in) :: irec !! Current recursion level - ! Result - logical :: lany_collision !! Returns true if cany pair of encounters resulted in a collision - ! Internals - logical, dimension(:), allocatable :: lcollision, lmask - real(DP), dimension(NDIM) :: xr, vr - integer(I4B) :: i, j, k, nenc - real(DP) :: rlim, Gmtot - logical :: isplpl - character(len=STRMAX) :: timestr, idstri, idstrj, message - class(symba_encounter), allocatable :: tmp - - lany_collision = .false. - if (self%nenc == 0) return - - select type(self) - class is (symba_plplenc) - isplpl = .true. - class default - isplpl = .false. - end select - - select type(pl => system%pl) - class is (symba_pl) - select type(tp => system%tp) - class is (symba_tp) - nenc = self%nenc - allocate(lmask(nenc)) - lmask(:) = ((self%status(1:nenc) == ACTIVE) .and. (pl%levelg(self%index1(1:nenc)) >= irec)) - if (isplpl) then - lmask(:) = lmask(:) .and. (pl%levelg(self%index2(1:nenc)) >= irec) - else - lmask(:) = lmask(:) .and. (tp%levelg(self%index2(1:nenc)) >= irec) - end if - if (.not.any(lmask(:))) return - - allocate(lcollision(nenc)) - lcollision(:) = .false. - - if (isplpl) then - do concurrent(k = 1:nenc, lmask(k)) - i = self%index1(k) - j = self%index2(k) - xr(:) = pl%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) - lcollision(k) = symba_collision_check_one(xr(1), xr(2), xr(3), vr(1), vr(2), vr(3), & - Gmtot, rlim, dt, self%lvdotr(k)) - end do - else - do concurrent(k = 1:nenc, lmask(k)) - i = self%index1(k) - j = self%index2(k) - xr(:) = pl%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)) - end do - end if - - lany_collision = any(lcollision(:)) - if (lany_collision) then - call pl%xh2xb(system%cb) ! Update the central body barycenteric position vector to get us out of DH and into bary - do k = 1, nenc - i = self%index1(k) - j = self%index2(k) - if (lcollision(k)) self%status(k) = COLLISION - self%t(k) = t - self%x1(:,k) = pl%rh(:,i) + system%cb%xb(:) - self%v1(:,k) = pl%vb(:,i) - if (isplpl) then - 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 - if (pl%lcollision(i) .or. pl%lcollision(j)) call pl%make_colliders([i,j]) - - ! Set the collision flag for these to bodies to true in case they become involved in another collision later in the step - pl%lcollision([i, j]) = .true. - pl%status([i, j]) = COLLISION - call pl%info(i)%set_value(status="COLLISION", discard_time=t, discard_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%rh(:,j) + system%cb%xb(:) - self%v2(:,k) = tp%vb(:,j) - if (lcollision(k)) then - tp%status(j) = DISCARDED_PLR - tp%ldiscard(j) = .true. - write(idstri, *) pl%id(i) - write(idstrj, *) tp%id(j) - write(timestr, *) t - call tp%info(j)%set_value(status="DISCARDED_PLR", discard_time=t, discard_rh=tp%rh(:,j), discard_vh=tp%vh(:,j)) - write(message, *) "Particle " // trim(adjustl(tp%info(j)%name)) // " (" // trim(adjustl(idstrj)) // ")" & - // " collided with massive body " // trim(adjustl(pl%info(i)%name)) // " (" // trim(adjustl(idstri)) // ")" & - // " at t = " // trim(adjustl(timestr)) - call io_log_one_message(FRAGGLE_LOG_OUT, message) - end if - end if - end do - end if - end select - end select - - ! Extract the pl-pl or pl-tp encounter list and return the pl-pl or pl-tp collision_list - if (lany_collision) then - select type(self) - class is (symba_plplenc) - call self%extract_collisions(system, param) - class default - allocate(tmp, mold=self) - call self%spill(tmp, lcollision, ldestructive=.true.) ! Remove this encounter pair from the encounter list - end select - end if - - return - end function symba_collision_check_encounter - - - pure elemental function symba_collision_check_one(xr, yr, zr, vxr, vyr, vzr, Gmtot, rlim, dt, lvdotr) result(lcollision) - !! author: David A. Minton - !! - !! Check for a merger between a single pair of particles - !! - !! Adapted from David E. Kaufmann's Swifter routines symba_merge_tp.f90 and symba_merge_pl.f90 - !! - !! Adapted from Hal Levison's Swift routine symba5_merge.f - implicit none - ! Arguments - real(DP), intent(in) :: xr, yr, zr !! Relative position vector components - real(DP), intent(in) :: vxr, vyr, vzr !! Relative velocity vector components - real(DP), intent(in) :: Gmtot !! Sum of G*mass of colliding bodies - real(DP), intent(in) :: rlim !! Collision limit - Typically the sum of the radii of colliding bodies - real(DP), intent(in) :: dt !! Step size - logical, intent(in) :: lvdotr !! Logical flag indicating that these two bodies are approaching in the current substep - ! Result - logical :: lcollision !! Logical flag indicating whether these two bodies will collide or not - ! Internals - real(DP) :: r2, rlim2, a, e, q, vdotr, tcr2, dt2 - - r2 = xr**2 + yr**2 + zr**2 - rlim2 = rlim**2 - - if (r2 <= rlim2) then ! checks if bodies are actively colliding in this time step - lcollision = .true. - else ! if they are not actively colliding in this time step, checks if they are going to collide next time step based on velocities and q - lcollision = .false. - vdotr = xr * vxr + yr * vyr + zr * vzr - if (lvdotr .and. (vdotr > 0.0_DP)) then - tcr2 = r2 / (vxr**2 + vyr**2 + vzr**2) - dt2 = dt**2 - if (tcr2 <= dt2) then - call orbel_xv2aeq(Gmtot, xr, yr, zr, vxr, vyr, vzr, a, e, q) - lcollision = (q < rlim) - end if - end if - end if - - return - end function symba_collision_check_one - - - function symba_collision_consolidate_colliders(pl, cb, param, idx_parent, colliders) result(lflag) - !! author: David A. Minton - !! - !! Loops through the pl-pl collision list and groups families together by index. Outputs the indices of all colliders%idx members, - !! and pairs of quantities (x and v vectors, mass, radius, L_spin, and Ip) that can be used to resolve the collisional outcome. - implicit none - ! Arguments - class(symba_pl), intent(inout) :: pl !! SyMBA massive body object - class(symba_cb), intent(inout) :: cb !! SyMBA central body object - class(symba_parameters), intent(in) :: param !! Current run configuration parameters with SyMBA additions - integer(I4B), dimension(2), intent(inout) :: idx_parent !! Index of the two bodies considered the "parents" of the collision - class(fraggle_colliders), intent(out) :: colliders - ! Result - logical :: lflag !! Logical flag indicating whether a colliders%idx was successfully created or not - ! Internals - type collidx_array - integer(I4B), dimension(:), allocatable :: id - integer(I4B), dimension(:), allocatable :: idx - end type collidx_array - type(collidx_array), dimension(2) :: parent_child_index_array - integer(I4B), dimension(2) :: nchild - integer(I4B) :: i, j, ncolliders, idx_child - real(DP), dimension(2) :: volume, density - real(DP) :: mchild, volchild - real(DP), dimension(NDIM) :: xc, vc, xcom, vcom, xchild, vchild, xcrossv - real(DP), dimension(NDIM,2) :: mxc, vcc - - nchild(:) = pl%kin(idx_parent(:))%nchild - ! If all of these bodies share a parent, but this is still a unique collision, move the last child - ! out of the parent's position and make it the secondary body - if (idx_parent(1) == idx_parent(2)) then - if (nchild(1) == 0) then ! There is only one valid body recorded in this pair (this could happen due to restructuring of the kinship relationships, though it should be rare) - lflag = .false. - call pl%reset_kinship([idx_parent(1)]) - return - end if - idx_parent(2) = pl%kin(idx_parent(1))%child(nchild(1)) - nchild(1) = nchild(1) - 1 - nchild(2) = 0 - pl%kin(idx_parent(:))%nchild = nchild(:) - pl%kin(idx_parent(2))%parent = idx_parent(1) - end if - - colliders%mass(:) = pl%mass(idx_parent(:)) ! Note: This is meant to mass, not G*mass, as the collisional regime determination uses mass values that will be converted to Si - colliders%radius(:) = pl%radius(idx_parent(:)) - volume(:) = (4.0_DP / 3.0_DP) * PI * colliders%radius(:)**3 - - ! Group together the ids and indexes of each collisional parent and its children - do j = 1, 2 - allocate(parent_child_index_array(j)%idx(nchild(j)+ 1)) - allocate(parent_child_index_array(j)%id(nchild(j)+ 1)) - associate(idx_arr => parent_child_index_array(j)%idx, & - id_arr => parent_child_index_array(j)%id, & - ncj => nchild(j), & - pl => pl, & - plkinj => pl%kin(idx_parent(j))) - idx_arr(1) = idx_parent(j) - if (ncj > 0) idx_arr(2:ncj + 1) = plkinj%child(1:ncj) - id_arr(:) = pl%id(idx_arr(:)) - end associate - end do - - ! Consolidate the groups of collsional parents with any children they may have into a single "colliders%idx" index array - ncolliders = 2 + sum(nchild(:)) - allocate(colliders%idx(ncolliders)) - colliders%idx = [parent_child_index_array(1)%idx(:),parent_child_index_array(2)%idx(:)] - - colliders%ncoll = count(pl%lcollision(colliders%idx(:))) - colliders%idx = pack(colliders%idx(:), pl%lcollision(colliders%idx(:))) - colliders%L_spin(:,:) = 0.0_DP - colliders%Ip(:,:) = 0.0_DP - - ! Find the barycenter of each body along with its children, if it has any - do j = 1, 2 - colliders%xb(:, j) = pl%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 - colliders%Ip(:, j) = colliders%mass(j) * pl%Ip(:, idx_parent(j)) - colliders%L_spin(:, j) = colliders%Ip(3, j) * colliders%radius(j)**2 * pl%rot(:, idx_parent(j)) - end if - - if (nchild(j) > 0) then - do i = 1, nchild(j) ! Loop over all children and take the mass weighted mean of the properties - idx_child = parent_child_index_array(j)%idx(i + 1) - if (.not. pl%lcollision(idx_child)) cycle - mchild = pl%mass(idx_child) - xchild(:) = pl%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 - ! Get angular momentum of the child-parent pair and add that to the spin - ! Add the child's spin - if (param%lrotation) then - xcom(:) = (colliders%mass(j) * colliders%xb(:,j) + mchild * xchild(:)) / (colliders%mass(j) + mchild) - vcom(:) = (colliders%mass(j) * colliders%vb(:,j) + mchild * vchild(:)) / (colliders%mass(j) + mchild) - xc(:) = colliders%xb(:, j) - xcom(:) - vc(:) = colliders%vb(:, j) - vcom(:) - xcrossv(:) = xc(:) .cross. vc(:) - colliders%L_spin(:, j) = colliders%L_spin(:, j) + colliders%mass(j) * xcrossv(:) - - xc(:) = xchild(:) - xcom(:) - vc(:) = vchild(:) - vcom(:) - xcrossv(:) = xc(:) .cross. vc(:) - colliders%L_spin(:, j) = colliders%L_spin(:, j) + mchild * xcrossv(:) - - colliders%L_spin(:, j) = colliders%L_spin(:, j) + mchild * pl%Ip(3, idx_child) & - * pl%radius(idx_child)**2 & - * pl%rot(:, idx_child) - colliders%Ip(:, j) = colliders%Ip(:, j) + mchild * pl%Ip(:, idx_child) - end if - - ! Merge the child and parent - colliders%mass(j) = colliders%mass(j) + mchild - colliders%xb(:, j) = xcom(:) - colliders%vb(:, j) = vcom(:) - end do - end if - density(j) = colliders%mass(j) / volume(j) - colliders%radius(j) = (3 * volume(j) / (4 * PI))**(1.0_DP / 3.0_DP) - if (param%lrotation) colliders%Ip(:, j) = colliders%Ip(:, j) / colliders%mass(j) - end do - lflag = .true. - - xcom(:) = (colliders%mass(1) * colliders%xb(:, 1) + colliders%mass(2) * colliders%xb(:, 2)) / sum(colliders%mass(:)) - vcom(:) = (colliders%mass(1) * colliders%vb(:, 1) + colliders%mass(2) * colliders%vb(:, 2)) / sum(colliders%mass(:)) - mxc(:, 1) = colliders%mass(1) * (colliders%xb(:, 1) - xcom(:)) - mxc(:, 2) = colliders%mass(2) * (colliders%xb(:, 2) - xcom(:)) - vcc(:, 1) = colliders%vb(:, 1) - vcom(:) - vcc(:, 2) = colliders%vb(:, 2) - vcom(:) - colliders%L_orbit(:,:) = mxc(:,:) .cross. vcc(:,:) - - ! Destroy the kinship relationships for all members of this colliders%idx - call pl%reset_kinship(colliders%idx(:)) - - return - end function symba_collision_consolidate_colliders - - - module subroutine symba_collision_encounter_extract_collisions(self, system, param) - !! author: David A. Minton - !! - !! Processes the pl-pl encounter list remove only those encounters that led to a collision - !! - implicit none - ! Arguments - class(symba_plplenc), intent(inout) :: self !! SyMBA pl-pl encounter list - class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object - class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters - ! Internals - logical, dimension(:), allocatable :: lplpl_collision - logical, dimension(:), allocatable :: lplpl_unique_parent - integer(I4B), dimension(:), pointer :: plparent - integer(I4B), dimension(:), allocatable :: collision_idx, unique_parent_idx - integer(I4B) :: i, index_coll, ncollisions, nunique_parent, nplplenc - - select type (pl => system%pl) - class is (symba_pl) - associate(plplenc_list => self, idx1 => self%index1, idx2 => self%index2, plparent => pl%kin%parent) - nplplenc = plplenc_list%nenc - allocate(lplpl_collision(nplplenc)) - lplpl_collision(:) = plplenc_list%status(1:nplplenc) == COLLISION - if (.not.any(lplpl_collision)) return - ! Collisions have been detected in this step. So we need to determine which of them are between unique bodies. - - ! Get the subset of pl-pl encounters that lead to a collision - ncollisions = count(lplpl_collision(:)) - allocate(collision_idx(ncollisions)) - collision_idx = pack([(i, i=1, nplplenc)], lplpl_collision) - - ! Get the subset of collisions that involve a unique pair of parents - allocate(lplpl_unique_parent(ncollisions)) - - lplpl_unique_parent(:) = plparent(idx1(collision_idx(:))) /= plparent(idx2(collision_idx(:))) - nunique_parent = count(lplpl_unique_parent(:)) - allocate(unique_parent_idx(nunique_parent)) - unique_parent_idx = pack(collision_idx(:), lplpl_unique_parent(:)) - - ! Scrub all pl-pl collisions involving unique pairs of parents, which will remove all duplicates and leave behind - ! all pairs that have themselves as parents but are not part of the unique parent list. This can hapepn in rare cases - ! due to restructuring of parent/child relationships when there are large numbers of multi-body collisions in a single - ! step - lplpl_unique_parent(:) = .true. - do index_coll = 1, ncollisions - associate(ip1 => plparent(idx1(collision_idx(index_coll))), ip2 => plparent(idx2(collision_idx(index_coll)))) - lplpl_unique_parent(:) = .not. ( any(plparent(idx1(unique_parent_idx(:))) == ip1) .or. & - any(plparent(idx2(unique_parent_idx(:))) == ip1) .or. & - any(plparent(idx1(unique_parent_idx(:))) == ip2) .or. & - any(plparent(idx2(unique_parent_idx(:))) == ip2) ) - end associate - end do - - ! Reassemble collision index list to include only those containing the unique pairs of parents, plus all the non-unique pairs that don't - ! contain a parent body on the unique parent list. - ncollisions = nunique_parent + count(lplpl_unique_parent) - collision_idx = [unique_parent_idx(:), pack(collision_idx(:), lplpl_unique_parent(:))] - - ! Create a mask that contains only the pl-pl encounters that did not result in a collision, and then discard them - lplpl_collision(:) = .false. - lplpl_collision(collision_idx(:)) = .true. - call plplenc_list%spill(system%plplcollision_list, lplpl_collision, ldestructive=.true.) ! Extract any encounters that are not collisions from the list. - end associate - end select - - return - end subroutine symba_collision_encounter_extract_collisions - - - module subroutine symba_collision_make_colliders_pl(self, idx) - !! author: Jennifer L.L. Pouplin, Carlisle A. wishard, and David A. Minton - !! - !! When a single body is involved in more than one collision in a single step, it becomes part of a colliders%idx. - !! The largest body involved in a multi-body collision is the "parent" and all bodies that collide with it are its "children," - !! including those that collide with the children. - !! - !! Adapted from David E. Kaufmann's Swifter routine symba_merge_pl.f90 - !! - !! Adapted from Hal Levison's Swift routine symba5_merge.f - implicit none - ! Arguments - class(symba_pl), intent(inout) :: self !! SyMBA massive body object - integer(I4B), dimension(2), intent(in) :: idx !! Array holding the indices of the two bodies involved in the collision - ! Internals - integer(I4B) :: i, j, index_parent, index_child, p1, p2 - integer(I4B) :: nchild_inherit, nchild_orig, nchild_new - integer(I4B), dimension(:), allocatable :: temp - - associate(pl => self) - p1 = pl%kin(idx(1))%parent - p2 = pl%kin(idx(2))%parent - if (p1 == p2) return ! This is a collision between to children of a shared parent. We will ignore it. - - if (pl%mass(p1) > pl%mass(p2)) then - index_parent = p1 - index_child = p2 - else - index_parent = p2 - index_child = p1 - end if - - ! Expand the child array (or create it if necessary) and copy over the previous lists of children - nchild_orig = pl%kin(index_parent)%nchild - nchild_inherit = pl%kin(index_child)%nchild - nchild_new = nchild_orig + nchild_inherit + 1 - allocate(temp(nchild_new)) - - if (nchild_orig > 0) temp(1:nchild_orig) = pl%kin(index_parent)%child(1:nchild_orig) - ! Find out if the child body has any children of its own. The new parent wil inherit these children - if (nchild_inherit > 0) then - temp(nchild_orig+1:nchild_orig+nchild_inherit) = pl%kin(index_child)%child(1:nchild_inherit) - do i = 1, nchild_inherit - j = pl%kin(index_child)%child(i) - ! Set the childrens' parent to the new parent - pl%kin(j)%parent = index_parent - end do - end if - call pl%reset_kinship([index_child]) - ! Add the new child to its parent - pl%kin(index_child)%parent = index_parent - temp(nchild_new) = index_child - ! Save the new child array to the parent - pl%kin(index_parent)%nchild = nchild_new - call move_alloc(from=temp, to=pl%kin(index_parent)%child) - end associate - - return - end subroutine symba_collision_make_colliders_pl - - - subroutine symba_collision_mergeaddsub(system, param, colliders, frag, status) - !! author: David A. Minton - !! - !! Fills the pl_discards and pl_adds with removed and added bodies - !! - implicit none - ! Arguments - class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object - class(symba_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions - class(fraggle_colliders), intent(inout) :: colliders !! Fraggle colliders object - class(fraggle_fragments), intent(inout) :: frag !! Fraggle fragmentation system object - integer(I4B), intent(in) :: status !! Status flag to assign to adds - ! Internals - integer(I4B) :: i, ibiggest, ismallest, iother, nstart, nend, ncolliders, nfrag - logical, dimension(system%pl%nbody) :: lmask - class(symba_pl), allocatable :: plnew, plsub - character(*), parameter :: FRAGFMT = '("Newbody",I0.7)' - character(len=NAMELEN) :: newname - - select type(pl => system%pl) - class is (symba_pl) - select type(pl_discards => system%pl_discards) - class is (symba_merger) - associate(info => pl%info, pl_adds => system%pl_adds, cb => system%cb, npl => pl%nbody) - ! Add the colliders%idx bodies to the subtraction list - ncolliders = colliders%ncoll - nfrag = frag%nbody - - param%maxid_collision = max(param%maxid_collision, maxval(system%pl%info(:)%collision_id)) - param%maxid_collision = param%maxid_collision + 1 - - ! Setup new bodies - allocate(plnew, mold=pl) - call plnew%setup(nfrag, param) - ibiggest = colliders%idx(maxloc(pl%Gmass(colliders%idx(:)), dim=1)) - ismallest = colliders%idx(minloc(pl%Gmass(colliders%idx(:)), dim=1)) - - ! Copy over identification, information, and physical properties of the new bodies from the fragment list - plnew%id(1:nfrag) = frag%id(1:nfrag) - plnew%xb(:, 1:nfrag) = frag%xb(:, 1:nfrag) - plnew%vb(:, 1:nfrag) = frag%vb(:, 1:nfrag) - call pl%vb2vh(cb) - call pl%xh2xb(cb) - do i = 1, nfrag - plnew%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) - plnew%Gmass(1:nfrag) = param%GU * frag%mass(1:nfrag) - plnew%radius(1:nfrag) = frag%radius(1:nfrag) - plnew%density(1:nfrag) = frag%mass(1:nfrag) / frag%radius(1:nfrag) - call plnew%set_rhill(cb) - - select case(status) - case(DISRUPTION) - plnew%status(1:nfrag) = NEW_PARTICLE - do i = 1, nfrag - write(newname, FRAGFMT) frag%id(i) - call plnew%info(i)%set_value(origin_type="Disruption", origin_time=system%t, name=newname, & - 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) then - iother = ismallest - else - iother = ibiggest - end if - call pl%info(colliders%idx(i))%set_value(status="Disruption", discard_time=system%t, & - 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_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) then - iother = ismallest - else - iother = ibiggest - end if - call pl%info(colliders%idx(i))%set_value(status="Supercatastrophic", discard_time=system%t, & - discard_rh=pl%rh(:,i), discard_vh=pl%vh(:,i), & - discard_body_id=iother) - end do - case(HIT_AND_RUN_DISRUPT) - call plnew%info(1)%copy(pl%info(ibiggest)) - plnew%status(1) = OLD_PARTICLE - do i = 2, nfrag - write(newname, FRAGFMT) frag%id(i) - call plnew%info(i)%set_value(origin_type="Hit and run fragment", origin_time=system%t, name=newname, & - 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_rh=pl%rh(:,i), discard_vh=pl%vh(:,i), & - discard_body_id=iother) - end do - case(MERGED) - call plnew%info(1)%copy(pl%info(ibiggest)) - plnew%status(1) = OLD_PARTICLE - do i = 1, ncolliders - if (colliders%idx(i) == ibiggest) cycle - - iother = ibiggest - 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 - - if (param%lrotation) then - plnew%Ip(:, 1:nfrag) = frag%Ip(:, 1:nfrag) - plnew%rot(:, 1:nfrag) = frag%rot(:, 1:nfrag) - end if - - ! if (param%ltides) then - ! plnew%Q = pl%Q(ibiggest) - ! plnew%k2 = pl%k2(ibiggest) - ! plnew%tlag = pl%tlag(ibiggest) - ! end if - - !Copy over or set integration parameters for new bodies - plnew%lcollision(1:nfrag) = .false. - plnew%ldiscard(1:nfrag) = .false. - plnew%levelg(1:nfrag) = pl%levelg(ibiggest) - plnew%levelm(1:nfrag) = pl%levelm(ibiggest) - - ! Log the properties of the new bodies - call fraggle_io_log_pl(plnew, param) - - ! Append the new merged body to the list - nstart = pl_adds%nbody + 1 - nend = pl_adds%nbody + nfrag - call pl_adds%append(plnew, lsource_mask=[(.true., i=1, nfrag)]) - ! Record how many bodies were added in this event - pl_adds%ncomp(nstart:nend) = plnew%nbody - - ! Add the discarded bodies to the discard list - pl%status(colliders%idx(:)) = MERGED - pl%ldiscard(colliders%idx(:)) = .true. - pl%lcollision(colliders%idx(:)) = .true. - lmask(:) = .false. - lmask(colliders%idx(:)) = .true. - - call plnew%setup(0, param) - deallocate(plnew) - - allocate(plsub, mold=pl) - call pl%spill(plsub, lmask, ldestructive=.false.) - - nstart = pl_discards%nbody + 1 - nend = pl_discards%nbody + ncolliders - call pl_discards%append(plsub, lsource_mask=[(.true., i = 1, ncolliders)]) - - ! Record how many bodies were subtracted in this event - pl_discards%ncomp(nstart:nend) = ncolliders - - call plsub%setup(0, param) - deallocate(plsub) - end associate - end select - end select - - return - end subroutine symba_collision_mergeaddsub - - - module subroutine symba_collision_resolve_fragmentations(self, system, param) - !! author: David A. Minton - !! - !! Process list of collisions, determine the collisional regime, and then create fragments. - !! - implicit none - ! Arguments - class(symba_plplenc), intent(inout) :: self !! SyMBA pl-pl encounter list - class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object - class(symba_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions - ! Internals - ! Internals - integer(I4B), dimension(2) :: idx_parent !! Index of the two bodies considered the "parents" of the collision - logical :: lgoodcollision - integer(I4B) :: i - type(fraggle_colliders) :: colliders !! Fraggle colliders object - type(fraggle_fragments) :: frag !! Fraggle fragmentation system object - - associate(plplcollision_list => self, ncollisions => self%nenc, idx1 => self%index1, idx2 => self%index2) - select type(pl => system%pl) - class is (symba_pl) - select type (cb => system%cb) - class is (symba_cb) - do i = 1, ncollisions - idx_parent(1) = pl%kin(idx1(i))%parent - idx_parent(2) = pl%kin(idx2(i))%parent - lgoodcollision = symba_collision_consolidate_colliders(pl, cb, param, idx_parent, colliders) - if ((.not. lgoodcollision) .or. any(pl%status(idx_parent(:)) /= COLLISION)) cycle - - call colliders%regime(frag, system, param) - - select case (frag%regime) - case (COLLRESOLVE_REGIME_DISRUPTION, COLLRESOLVE_REGIME_SUPERCATASTROPHIC) - plplcollision_list%status(i) = symba_collision_casedisruption(system, param, colliders, frag) - case (COLLRESOLVE_REGIME_HIT_AND_RUN) - plplcollision_list%status(i) = symba_collision_casehitandrun(system, param, colliders, frag) - case (COLLRESOLVE_REGIME_MERGE, COLLRESOLVE_REGIME_GRAZE_AND_MERGE) - plplcollision_list%status(i) = symba_collision_casemerge(system, param, colliders, frag) - case default - write(*,*) "Error in symba_collision, unrecognized collision regime" - call util_exit(FAILURE) - end select - end do - end select - end select - end associate - - return - end subroutine symba_collision_resolve_fragmentations - - - module subroutine symba_collision_resolve_mergers(self, system, param) - !! author: David A. Minton - !! - !! Process list of collisions and merge colliding bodies together. - !! - implicit none - ! Arguments - class(symba_plplenc), intent(inout) :: self !! SyMBA pl-pl encounter list - class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object - class(symba_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions - ! Internals - integer(I4B), dimension(2) :: idx_parent !! Index of the two bodies considered the "parents" of the collision - logical :: lgoodcollision - integer(I4B) :: i - type(fraggle_colliders) :: colliders !! Fraggle colliders object - type(fraggle_fragments) :: frag !! Fraggle fragmentation system object - - associate(plplcollision_list => self, ncollisions => self%nenc, idx1 => self%index1, idx2 => self%index2) - select type(pl => system%pl) - class is (symba_pl) - select type(cb => system%cb) - class is (symba_cb) - do i = 1, ncollisions - idx_parent(1) = pl%kin(idx1(i))%parent - idx_parent(2) = pl%kin(idx2(i))%parent - lgoodcollision = symba_collision_consolidate_colliders(pl, cb, param, idx_parent, colliders) - if (.not. lgoodcollision) cycle - if (any(pl%status(idx_parent(:)) /= COLLISION)) cycle ! One of these two bodies has already been resolved - - frag%regime = COLLRESOLVE_REGIME_MERGE - frag%mtot = sum(colliders%mass(:)) - frag%mass_dist(1) = frag%mtot - frag%mass_dist(2) = 0.0_DP - frag%mass_dist(3) = 0.0_DP - frag%xbcom(:) = (colliders%mass(1) * colliders%xb(:,1) + colliders%mass(2) * colliders%xb(:,2)) / frag%mtot - frag%vbcom(:) = (colliders%mass(1) * colliders%vb(:,1) + colliders%mass(2) * colliders%vb(:,2)) / frag%mtot - plplcollision_list%status(i) = symba_collision_casemerge(system, param, colliders, frag) - end do - end select - end select - end associate - - return - end subroutine symba_collision_resolve_mergers - - - module subroutine symba_collision_resolve_plplenc(self, system, param, t, dt, irec) - !! author: David A. Minton - !! - !! Process the pl-pl collision list, then modifiy the massive bodies based on the outcome of the collision - !! - implicit none - ! Arguments - class(symba_plplenc), intent(inout) :: self !! SyMBA pl-pl encounter list - class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions - real(DP), intent(in) :: t !! Current simulation time - real(DP), intent(in) :: dt !! Current simulation step size - integer(I4B), intent(in) :: irec !! Current recursion level - ! Internals - real(DP) :: Eorbit_before, Eorbit_after - logical :: lplpl_collision - character(len=STRMAX) :: timestr - class(symba_parameters), allocatable :: tmp_param - - associate(plplenc_list => self, plplcollision_list => system%plplcollision_list) - select type(pl => system%pl) - class is (symba_pl) - select type(param) - class is (symba_parameters) - if (plplcollision_list%nenc == 0) return ! No collisions to resolve - ! Make sure that the heliocentric and barycentric coordinates are consistent with each other - call pl%vb2vh(system%cb) - call pl%xh2xb(system%cb) - - ! Get the energy before the collision is resolved - if (param%lenergy) then - call system%get_energy_and_momentum(param) - Eorbit_before = system%te - end if - - do - write(timestr,*) t - call io_log_one_message(FRAGGLE_LOG_OUT, "") - call io_log_one_message(FRAGGLE_LOG_OUT, "***********************************************************" // & - "***********************************************************") - call io_log_one_message(FRAGGLE_LOG_OUT, "Collision between massive bodies detected at time t = " // & - trim(adjustl(timestr))) - call io_log_one_message(FRAGGLE_LOG_OUT, "***********************************************************" // & - "***********************************************************") - allocate(tmp_param, source=param) - if (param%lfragmentation) then - call plplcollision_list%resolve_fragmentations(system, param) - else - call plplcollision_list%resolve_mergers(system, param) - end if - - ! Destroy the collision list now that the collisions are resolved - call plplcollision_list%setup(0_I8B) - - if ((system%pl_adds%nbody == 0) .and. (system%pl_discards%nbody == 0)) exit - - ! Save the add/discard information to file - call system%write_discard(tmp_param) - - ! Rearrange the arrays: Remove discarded bodies, add any new bodies, resort, and recompute all indices and encounter lists - call pl%rearray(system, tmp_param) - - ! Destroy the add/discard list so that we don't append the same body multiple times if another collision is detected - call system%pl_discards%setup(0, param) - call system%pl_adds%setup(0, param) - deallocate(tmp_param) - - ! Check whether or not any of the particles that were just added are themselves in a collision state. This will generate a new plplcollision_list - lplpl_collision = plplenc_list%collision_check(system, param, t, dt, irec) - - if (.not.lplpl_collision) exit - end do - - if (param%lenergy) then - call system%get_energy_and_momentum(param) - Eorbit_after = system%te - system%Ecollisions = system%Ecollisions + (Eorbit_after - Eorbit_before) - end if - - end select - end select - end associate - - return - end subroutine symba_collision_resolve_plplenc - - - module subroutine symba_collision_resolve_pltpenc(self, system, param, t, dt, irec) - !! author: David A. Minton - !! - !! Process the pl-tp collision list, then modifiy the massive bodies based on the outcome of the collision - !! - implicit none - ! Arguments - class(symba_pltpenc), intent(inout) :: self !! SyMBA pl-pl encounter list - class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions - real(DP), intent(in) :: t !! Current simulation tim - real(DP), intent(in) :: dt !! Current simulation step size - integer(I4B), intent(in) :: irec !! Current recursion level - - ! Make sure coordinate systems are all synced up due to being inside the recursion at this point - call system%pl%vb2vh(system%cb) - call system%tp%vb2vh(system%cb%vb) - call system%pl%b2h(system%cb) - call system%tp%b2h(system%cb) - - ! Discard the collider - call system%tp%discard(system, param) - - return - end subroutine symba_collision_resolve_pltpenc - -end submodule s_symba_collision \ No newline at end of file From ea48c5faada9e2c2522123b9bfe4e756329ecc03 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Wed, 7 Dec 2022 12:22:17 -0500 Subject: [PATCH 334/569] Changed the naming scheme behavior for disruptions. For non-supercat, the largest body keeps its id and name --- examples/Fragmentation/Fragmentation_Movie.py | 2 +- src/symba/symba_collision.f90 | 41 ++++++++----------- 2 files changed, 18 insertions(+), 25 deletions(-) diff --git a/examples/Fragmentation/Fragmentation_Movie.py b/examples/Fragmentation/Fragmentation_Movie.py index fa1203a8e..4e2ada041 100644 --- a/examples/Fragmentation/Fragmentation_Movie.py +++ b/examples/Fragmentation/Fragmentation_Movie.py @@ -97,7 +97,7 @@ def __init__(self, sim, animfile, title, style, nskip=1): self.body_color_list = {'Initial conditions': 'xkcd:windows blue', 'Disruption': 'xkcd:baby poop', 'Supercatastrophic': 'xkcd:shocking pink', - 'Hit and run fragment': 'xkcd:blue with a hint of purple', + 'Hit and run fragmention': 'xkcd:blue with a hint of purple', 'Central body': 'xkcd:almost black'} # Set up the figure and axes... diff --git a/src/symba/symba_collision.f90 b/src/symba/symba_collision.f90 index 06c474078..eb891eb23 100644 --- a/src/symba/symba_collision.f90 +++ b/src/symba/symba_collision.f90 @@ -26,7 +26,7 @@ module function symba_collision_casedisruption(system, param, colliders, frag) ! Result integer(I4B) :: status !! Status flag assigned to this outcome ! Internals - integer(I4B) :: i, nfrag + integer(I4B) :: i, ibiggest, nfrag logical :: lfailure character(len=STRMAX) :: message @@ -63,11 +63,16 @@ module function symba_collision_casedisruption(system, param, colliders, frag) select case(frag%regime) case(COLLRESOLVE_REGIME_DISRUPTION) status = DISRUPTION + ibiggest = colliders%idx(maxloc(system%pl%Gmass(colliders%idx(:)), dim=1)) + frag%id(1) = system%pl%id(ibiggest) + frag%id(2:nfrag) = [(i, i = param%maxid + 1, param%maxid + nfrag - 1)] + param%maxid = frag%id(nfrag) case(COLLRESOLVE_REGIME_SUPERCATASTROPHIC) status = SUPERCATASTROPHIC + frag%id(1:nfrag) = [(i, i = param%maxid + 1, param%maxid + nfrag)] + param%maxid = frag%id(nfrag) end select - frag%id(1:nfrag) = [(i, i = param%maxid + 1, param%maxid + nfrag)] - param%maxid = frag%id(nfrag) + call symba_collision_mergeaddsub(system, param, colliders, frag, status) end if @@ -720,7 +725,7 @@ subroutine symba_collision_mergeaddsub(system, param, colliders, frag, status) logical, dimension(system%pl%nbody) :: lmask class(symba_pl), allocatable :: plnew, plsub character(*), parameter :: FRAGFMT = '("Newbody",I0.7)' - character(len=NAMELEN) :: newname + character(len=NAMELEN) :: newname, origin_type select type(pl => system%pl) class is (symba_pl) @@ -757,23 +762,6 @@ subroutine symba_collision_mergeaddsub(system, param, colliders, frag, status) call plnew%set_rhill(cb) select case(status) - case(DISRUPTION) - plnew%status(1:nfrag) = NEW_PARTICLE - do i = 1, nfrag - write(newname, FRAGFMT) frag%id(i) - call plnew%info(i)%set_value(origin_type="Disruption", origin_time=system%t, name=newname, & - 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) then - iother = ismallest - else - iother = ibiggest - end if - call pl%info(colliders%idx(i))%set_value(status="Disruption", discard_time=system%t, & - 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 @@ -792,19 +780,24 @@ subroutine symba_collision_mergeaddsub(system, param, colliders, frag, status) discard_rh=pl%rh(:,i), discard_vh=pl%vh(:,i), & discard_body_id=iother) end do - case(HIT_AND_RUN_DISRUPT) + case(DISRUPTION,HIT_AND_RUN_DISRUPT) + if (status == DISRUPTION) then + write(origin_type,*) "Disruption" + else if (status == HIT_AND_RUN_DISRUPT) then + write(origin_type,*) "Hit and run fragmention" + end if call plnew%info(1)%copy(pl%info(ibiggest)) plnew%status(1) = OLD_PARTICLE do i = 2, nfrag write(newname, FRAGFMT) frag%id(i) - call plnew%info(i)%set_value(origin_type="Hit and run fragment", origin_time=system%t, name=newname, & + call plnew%info(i)%set_value(origin_type=origin_type, origin_time=system%t, name=newname, & 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, & + call pl%info(colliders%idx(i))%set_value(status=origin_type, discard_time=system%t, & discard_rh=pl%rh(:,i), discard_vh=pl%vh(:,i), & discard_body_id=iother) end do From 4d4417cf1a81bd27ed2c42f90e0a70abc98fb96e Mon Sep 17 00:00:00 2001 From: David A Minton Date: Wed, 7 Dec 2022 16:46:13 -0500 Subject: [PATCH 335/569] Added in code that can merge together the encounter and simulation data --- examples/Fragmentation/Fragmentation_Movie.py | 39 ++++++++++++++----- 1 file changed, 29 insertions(+), 10 deletions(-) diff --git a/examples/Fragmentation/Fragmentation_Movie.py b/examples/Fragmentation/Fragmentation_Movie.py index 4e2ada041..329a6f343 100644 --- a/examples/Fragmentation/Fragmentation_Movie.py +++ b/examples/Fragmentation/Fragmentation_Movie.py @@ -28,6 +28,7 @@ import swiftest import numpy as np +import xarray as xr import matplotlib.pyplot as plt import matplotlib.animation as animation from pathlib import Path @@ -75,21 +76,37 @@ for k,v in body_Gmass.items(): body_radius[k] = [((Gmass/GU)/(4./3.*np.pi*density))**(1./3.) for Gmass in v] - # ---------------------------------------------------------------------------------------------------------------------- # Define the animation class that will generate the movies of the fragmentation outcomes # ---------------------------------------------------------------------------------------------------------------------- -figsize = (4,4) + + +def encounter_combiner(sim): + """ + Combines simulation data with encounter data to produce a dataset that contains the position, + mass, radius, etc. of both. It will interpolate over empty time values to fill in gaps. + """ + + # Only keep a minimal subset of necessary data from the simulation and encounter datasets + keep_vars = ['rh','Gmass','radius'] + data = sim.data[keep_vars] + enc = sim.enc[keep_vars].load() + + # Remove any encounter data at the same time steps that appear in the data to prevent duplicates + t_not_duplicate = ~enc['time'].isin(data['time']) + enc = enc.where(t_not_duplicate,drop=True) + + # The following will combine the two datasets along the time dimension, sort the time dimension, and then fill in any time gaps with interpolation + ds = xr.combine_nested([data,enc],concat_dim='time').sortby("time").interpolate_na(dim="time") + + return ds + class AnimatedScatter(object): """An animated scatter plot using matplotlib.animations.FuncAnimation.""" def __init__(self, sim, animfile, title, style, nskip=1): - if style == "disruption_headon" or style == "hitandrun": - tgood = sim.enc.where(sim.enc['Gmass'] > 0.8 * body_Gmass[style][0]).time - else: - tgood = sim.enc.where(sim.enc['Gmass'] > 0.01 * body_Gmass[style][1]).time - self.ds = sim.enc[['rh','vh','Gmass','radius']].sel(time=tgood).load().interpolate_na(dim="time") + self.ds = encounter_combiner(sim) nframes = int(self.ds['time'].size) self.sim = sim @@ -101,6 +118,7 @@ def __init__(self, sim, animfile, title, style, nskip=1): 'Central body': 'xkcd:almost black'} # Set up the figure and axes... + self.figsize = (4,4) self.fig, self.ax = self.setup_plot() # Then setup FuncAnimation. @@ -110,7 +128,7 @@ def __init__(self, sim, animfile, title, style, nskip=1): print(f"Finished writing {animfile}") def setup_plot(self): - fig = plt.figure(figsize=figsize, dpi=300) + fig = plt.figure(figsize=self.figsize, dpi=300) plt.tight_layout(pad=0) # Calculate the distance along the y-axis between the colliding bodies at the start of the simulation. @@ -120,7 +138,7 @@ def setup_plot(self): scale_frame = abs(rhy1) + abs(rhy2) ax = plt.Axes(fig, [0.1, 0.1, 0.8, 0.8]) - self.ax_pt_size = figsize[0] * 0.8 * 72 / (2 * scale_frame) + self.ax_pt_size = self.figsize[0] * 0.8 * 72 / (2 * scale_frame) ax.set_xlim(-scale_frame, scale_frame) ax.set_ylim(-scale_frame, scale_frame) ax.set_xticks([]) @@ -185,6 +203,7 @@ def data_stream(self, frame=0): 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, fragmentation_save="TRAJECTORY", gmtiny=gmtiny, minimum_fragment_gmass=minimum_fragment_gmass, verbose=False) - sim.run(dt=1e-4, tstop=4.0e-3, istep_out=1, dump_cadence=0) + sim.run(dt=1e-5, tstop=4.0e-3, istep_out=10, dump_cadence=0) + print("Generating animation") anim = AnimatedScatter(sim,movie_filename,movie_titles[style],style,nskip=1) \ No newline at end of file From f7afdf34fa032de0d28ac1e899ad086d329d8974 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Wed, 7 Dec 2022 19:32:17 -0500 Subject: [PATCH 336/569] Improved the stability of the encounter snapshot --- examples/Fragmentation/Fragmentation_Movie.py | 6 ++-- src/modules/symba_classes.f90 | 17 ++++++++--- src/symba/symba_io.f90 | 10 +++---- src/symba/symba_util.f90 | 30 +++++++++++++++---- 4 files changed, 45 insertions(+), 18 deletions(-) diff --git a/examples/Fragmentation/Fragmentation_Movie.py b/examples/Fragmentation/Fragmentation_Movie.py index 329a6f343..ab2e2b34d 100644 --- a/examples/Fragmentation/Fragmentation_Movie.py +++ b/examples/Fragmentation/Fragmentation_Movie.py @@ -41,8 +41,8 @@ movie_titles = dict(zip(available_movie_styles, movie_title_list)) # These initial conditions were generated by trial and error -pos_vectors = {"disruption_headon" : [np.array([1.0, -5.0e-05, 0.0]), - np.array([1.0, 5.0e-05 ,0.0])], +pos_vectors = {"disruption_headon" : [np.array([1.0, -5.0e-04, 0.0]), + np.array([1.0, 5.0e-04 ,0.0])], "supercatastrophic_off_axis": [np.array([1.0, -4.2e-05, 0.0]), np.array([1.0, 4.2e-05, 0.0])], "hitandrun" : [np.array([1.0, -2.0e-05, 0.0]), @@ -203,7 +203,7 @@ def data_stream(self, frame=0): 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, fragmentation_save="TRAJECTORY", gmtiny=gmtiny, minimum_fragment_gmass=minimum_fragment_gmass, verbose=False) - sim.run(dt=1e-5, tstop=4.0e-3, istep_out=10, dump_cadence=0) + sim.run(dt=1e-4, tstop=1.0e-4, istep_out=1, dump_cadence=0) print("Generating animation") anim = AnimatedScatter(sim,movie_filename,movie_titles[style],style,nskip=1) \ No newline at end of file diff --git a/src/modules/symba_classes.f90 b/src/modules/symba_classes.f90 index 6c3aaae12..4c1b6b673 100644 --- a/src/modules/symba_classes.f90 +++ b/src/modules/symba_classes.f90 @@ -229,11 +229,15 @@ module symba_classes end type symba_nbody_system - type, extends(symba_nbody_system) :: symba_encounter_snapshot - integer(I4B) :: tslot !! The index for the time array in the final NetCDF file + type :: symba_encounter_snapshot + type(symba_pl) :: pl !! Massive body data structure + type(symba_tp) :: tp !! Test particle data structure + real(DP) :: t = 0.0_DP !! Time at the snapshot + integer(I4B) :: tslot = 0 !! The index for the time array in the final NetCDF file contains - procedure :: write_encounter_frame => symba_io_encounter_write_frame !! Writes a frame of encounter data to file - generic :: write_frame => write_encounter_frame + procedure :: write_encounter_frame => symba_io_encounter_write_frame !! Writes a frame of encounter data to file + procedure :: dealloc => symba_util_dealloc_snapshot !! Deallocates all allocatable arrays + generic :: write_frame => write_encounter_frame !! Writes a snaphot frame to file final :: symba_util_final_encounter_snapshot end type symba_encounter_snapshot @@ -657,6 +661,11 @@ module subroutine symba_util_dealloc_merger(self) class(symba_merger), intent(inout) :: self !! SyMBA body merger object end subroutine symba_util_dealloc_merger + module subroutine symba_util_dealloc_snapshot(self) + implicit none + class(symba_encounter_snapshot), intent(inout) :: self !! SyMBA nbody system object + end subroutine symba_util_dealloc_snapshot + module subroutine symba_util_dealloc_system(self) implicit none class(symba_nbody_system), intent(inout) :: self !! SyMBA nbody system object diff --git a/src/symba/symba_io.f90 b/src/symba/symba_io.f90 index bc0f1b985..a4e5a9922 100644 --- a/src/symba/symba_io.f90 +++ b/src/symba/symba_io.f90 @@ -95,7 +95,8 @@ module subroutine symba_io_encounter_initialize_output(self, param) call check( nf90_def_var(nc%id, nc%ptype_varname, NF90_CHAR, [nc%str_dimid, nc%id_dimid], nc%ptype_varid), "symba_io_encounter_initialize_output nf90_def_var ptype_varid" ) call check( nf90_def_var(nc%id, nc%rh_varname, nc%out_type, [nc%space_dimid, nc%id_dimid, nc%time_dimid], nc%rh_varid), "symba_io_encounter_initialize_output nf90_def_var rh_varid" ) call check( nf90_def_var(nc%id, nc%vh_varname, nc%out_type, [nc%space_dimid, nc%id_dimid, nc%time_dimid], nc%vh_varid), "symba_io_encounter_initialize_output nf90_def_var vh_varid" ) - call check( nf90_def_var(nc%id, nc%gmass_varname, nc%out_type, [nc%id_dimid, nc%time_dimid], nc%Gmass_varid), "symba_io_encounter_initialize_output nf90_def_var Gmass_varid" ) + call check( nf90_def_var(nc%id, nc%Gmass_varname, nc%out_type, [nc%id_dimid, nc%time_dimid], nc%Gmass_varid), "symba_io_encounter_initialize_output nf90_def_var Gmass_varid" ) + call check( nf90_def_var(nc%id, nc%level_varname, NF90_INT, [nc%id_dimid, nc%time_dimid], nc%level_varid), "symba_io_encounter_initialize_output nf90_def_var level_varid" ) if (param%lclose) then call check( nf90_def_var(nc%id, nc%radius_varname, nc%out_type, [nc%id_dimid, nc%time_dimid], nc%radius_varid), "symba_io_encounter_initialize_output nf90_def_var radius_varid" ) end if @@ -153,8 +154,7 @@ module subroutine symba_io_encounter_write_frame(self, nc, param) tslot = self%tslot call check( nf90_put_var(nc%id, nc%time_varid, self%t, start=[tslot]), "symba_io_encounter_write_frame nf90_put_var time_varid" ) - select type(pl => self%pl) - class is (symba_pl) + associate(pl => self%pl, tp => self%tp) npl = pl%nbody do i = 1, npl idslot = pl%id(i) @@ -162,6 +162,7 @@ module subroutine symba_io_encounter_write_frame(self, nc, param) call check( nf90_put_var(nc%id, nc%rh_varid, pl%rh(:,i), start=[1,idslot,tslot], count=[NDIM,1,1]), "symba_io_encounter_write_frame nf90_put_var pl rh_varid" ) call check( nf90_put_var(nc%id, nc%vh_varid, pl%vh(:,i), start=[1,idslot,tslot], count=[NDIM,1,1]), "symba_io_encounter_write_frame nf90_put_var pl vh_varid" ) call check( nf90_put_var(nc%id, nc%Gmass_varid, pl%Gmass(i), start=[idslot, tslot]), "symba_io_encounter_write_frame nf90_put_var pl Gmass_varid" ) + call check( nf90_put_var(nc%id, nc%level_varid, pl%levelg(i), start=[idslot, tslot]), "symba_io_encounter_write_frame nf90_put_var pl level_varid" ) if (param%lclose) call check( nf90_put_var(nc%id, nc%radius_varid, pl%radius(i), start=[idslot, tslot]), "symba_io_encounter_write_frame nf90_put_var pl radius_varid" ) @@ -175,10 +176,7 @@ module subroutine symba_io_encounter_write_frame(self, nc, param) charstring = trim(adjustl(pl%info(i)%particle_type)) call check( nf90_put_var(nc%id, nc%ptype_varid, charstring, start=[1, idslot], count=[NAMELEN, 1]), "symba_io_encounter_write_frame nf90_put_var pl particle_type_varid" ) end do - - end select - associate(tp => self%tp) ntp = tp%nbody do i = 1, ntp idslot = tp%id(i) diff --git a/src/symba/symba_util.f90 b/src/symba/symba_util.f90 index b96270fc9..b5b74d93e 100644 --- a/src/symba/symba_util.f90 +++ b/src/symba/symba_util.f90 @@ -238,10 +238,28 @@ module subroutine symba_util_dealloc_merger(self) end subroutine symba_util_dealloc_merger + module subroutine symba_util_dealloc_snapshot(self) + !! author: David A. Minton + !! + !! Deallocates allocatable arrays in an encounter snapshot + implicit none + ! Arguments + class(symba_encounter_snapshot), intent(inout) :: self !! SyMBA nbody system object + + + call self%pl%dealloc() + call self%tp%dealloc() + self%t = 0.0_DP + self%tslot = 0 + + return + end subroutine symba_util_dealloc_snapshot + + module subroutine symba_util_dealloc_system(self) !! author: David A. Minton !! - !! Deallocates all allocatabale arrays + !! Deallocates all allocatabale arrays in a SyMBA system object implicit none ! Arguments class(symba_nbody_system), intent(inout) :: self !! SyMBA nbody system object @@ -937,6 +955,8 @@ module subroutine symba_util_resize_storage(self, nnew) nbig = nbig * 2 end do allocate(symba_encounter_storage(nbig) :: tmp) + tmp%tvals(1:nold) = self%encounter_history%tvals(1:nold) + tmp%tvals(nold+1:nbig) = huge(1.0_DP) if (lmalloc) then do i = 1, nold if (allocated(self%encounter_history%frame(i)%item)) call move_alloc(self%encounter_history%frame(i)%item, tmp%frame(i)%item) @@ -1328,8 +1348,6 @@ module subroutine symba_util_take_encounter_snapshot(self, param, t) allocate(symba_encounter_snapshot :: snapshot) snapshot%t = t - allocate(symba_pl :: snapshot%pl) - allocate(symba_tp :: snapshot%tp) if (npl + ntp == 0) return npl_snap = npl ntp_snap = ntp @@ -1353,6 +1371,8 @@ module subroutine symba_util_take_encounter_snapshot(self, param, t) allocate(snapshot%pl%id(npl_snap)) allocate(snapshot%pl%info(npl_snap)) allocate(snapshot%pl%Gmass(npl_snap)) + allocate(snapshot%pl%levelg(npl_snap)) + snapshot%pl%levelg(:) = pack(pl%levelg(1:npl), pl%lmask(1:npl)) snapshot%pl%id(:) = pack(pl%id(1:npl), pl%lmask(1:npl)) snapshot%pl%info(:) = pack(pl%info(1:npl), pl%lmask(1:npl)) snapshot%pl%Gmass(:) = pack(pl%Gmass(1:npl), pl%lmask(1:npl)) @@ -1394,8 +1414,6 @@ module subroutine symba_util_take_encounter_snapshot(self, param, t) end if ! Save the snapshot - self%encounter_history%iframe = self%encounter_history%iframe + 1 - call self%resize_storage(self%encounter_history%iframe) ! Find out which time slot this belongs in by searching for an existing slot ! with the same value of time or the first available one @@ -1403,6 +1421,8 @@ module subroutine symba_util_take_encounter_snapshot(self, param, t) if (t <= self%encounter_history%tvals(i)) then snapshot%tslot = i self%encounter_history%tvals(i) = t + self%encounter_history%iframe = i + call self%resize_storage(i) exit end if end do From 706d439c1e07c79ad2c4ec88e8814be2805618d2 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Wed, 7 Dec 2022 19:32:46 -0500 Subject: [PATCH 337/569] Simplified fraggle.log output in preparation for storing detailed state information into a NetCDF file --- src/fraggle/fraggle_io.f90 | 124 ++----------------------------------- 1 file changed, 5 insertions(+), 119 deletions(-) diff --git a/src/fraggle/fraggle_io.f90 b/src/fraggle/fraggle_io.f90 index 87d2d7d11..a8c772326 100644 --- a/src/fraggle/fraggle_io.f90 +++ b/src/fraggle/fraggle_io.f90 @@ -36,31 +36,6 @@ module subroutine fraggle_io_log_generate(frag) write(LUN,fmtlabel) ' Qloss |', -frag%Qloss / abs(frag%Etot_before) write(LUN,fmtlabel) ' dE - Qloss |', (frag%Etot_after - frag%Etot_before + frag%Qloss) / abs(frag%Etot_before) write(LUN, "(' -------------------------------------------------------------------------------------')") - write(LUN, *) "Individual fragment values (collisional system natural units)" - write(LUN, *) "mass" - do i = 1, frag%nbody - write(LUN, *) i, frag%mass(i) - end do - write(LUN, *) "x_coll" - do i = 1, frag%nbody - write(LUN, *) i, frag%x_coll(:,i) - end do - write(LUN, *) "v_coll" - do i = 1, frag%nbody - write(LUN, *) i, frag%v_coll(:,i) - end do - write(LUN, *) "xb" - do i = 1, frag%nbody - write(LUN, *) i, frag%xb(:,i) - end do - write(LUN, *) "vb" - do i = 1, frag%nbody - write(LUN, *) i, frag%vb(:,i) - end do - write(LUN, *) "rot" - do i = 1, frag%nbody - write(LUN, *) i, frag%rot(:,i) - end do close(LUN) @@ -82,69 +57,6 @@ module subroutine fraggle_io_log_pl(pl, param) integer(I4B) :: i character(STRMAX) :: errmsg - open(unit=LUN, file=FRAGGLE_LOG_OUT, status = 'OLD', position = 'APPEND', form = 'FORMATTED', err = 667, iomsg = errmsg) - write(LUN, *, err = 667, iomsg = errmsg) - - write(LUN, *) "--------------------------------------------------------------------" - write(LUN, *) " Fraggle fragment final body properties" - write(LUN, *) "--------------------------------------------------------------------" - write(LUN, *) "id, name" - do i = 1, pl%nbody - write(LUN, *) i, pl%id(i), pl%info(i)%name - end do - write(LUN, *) "mass, Gmass" - do i = 1, pl%nbody - write(LUN, *) i, pl%mass(i), pl%Gmass(i) - end do - write(LUN, *) "radius" - do i = 1, pl%nbody - write(LUN, *) i, pl%radius(i) - end do - write(LUN, *) "xb" - do i = 1, pl%nbody - write(LUN, *) i, pl%xb(:,i) - end do - write(LUN, *) "vb" - do i = 1, pl%nbody - write(LUN, *) i, pl%vb(:,i) - end do - write(LUN, *) "rh" - do i = 1, pl%nbody - write(LUN, *) i, pl%rh(:,i) - end do - write(LUN, *) "vh" - do i = 1, pl%nbody - write(LUN, *) i, pl%vh(:,i) - end do - - if (param%lrotation) then - write(LUN, *) "rot" - do i = 1, pl%nbody - write(LUN, *) i, pl%rot(:,i) - end do - write(LUN, *) "Ip" - do i = 1, pl%nbody - write(LUN, *) i, pl%Ip(:,i) - end do - end if - - ! if (param%ltides) then - ! write(LUN, *) "Q" - ! do i = 1, pl%nbody - ! write(LUN, *) i, pl%Q(i) - ! end do - ! write(LUN, *) "k2" - ! do i = 1, pl%nbody - ! write(LUN, *) i, pl%k2(i) - ! end do - ! write(LUN, *) "tlag" - ! do i = 1, pl%nbody - ! write(LUN, *) i, pl%tlag(i) - ! end do - ! end if - - close(LUN) - return 667 continue write(*,*) "Error writing Fraggle message to log file: " // trim(adjustl(errmsg)) @@ -167,46 +79,20 @@ module subroutine fraggle_io_log_regime(colliders, frag) write(LUN, *) "--------------------------------------------------------------------" write(LUN, *) " Fraggle collisional regime determination results" write(LUN, *) "--------------------------------------------------------------------" - write(LUN, *) "----------------------- Collider information -----------------------" write(LUN, *) "True number of colliders : ",colliders%ncoll write(LUN, *) "Index list of true colliders : ",colliders%idx(1:colliders%ncoll) - write(LUN, *) "-------------------- Two-body equialent values ---------------------" - write(LUN, *) "mass1 : ",colliders%mass(1) - write(LUN, *) "radius1 : ",colliders%radius(1) - write(LUN, *) "xb1 : ",colliders%xb(:,1) - write(LUN, *) "vb1 : ",colliders%vb(:,1) - write(LUN, *) "rot1 : ",colliders%rot(:,1) - write(LUN, *) "Ip1 : ",colliders%Ip(:,1) - write(LUN, *) "L_spin1 : ",colliders%L_spin(:,1) - write(LUN, *) "L_orbit1 : ",colliders%L_orbit(:,1) - write(LUN, *) "mass2 : ",colliders%mass(2) - write(LUN, *) "radius2 : ",colliders%radius(2) - write(LUN, *) "xb2 : ",colliders%xb(:,2) - write(LUN, *) "vb2 : ",colliders%vb(:,2) - write(LUN, *) "rot2 : ",colliders%rot(:,2) - write(LUN, *) "Ip2 : ",colliders%Ip(:,2) - write(LUN, *) "L_spin2 : ",colliders%L_spin(:,2) - write(LUN, *) "L_orbit2 : ",colliders%L_orbit(:,2) - write(LUN, *) "------------------------------ Regime -----------------------------" select case(frag%regime) case(COLLRESOLVE_REGIME_MERGE) - write(LUN, *) "Merge" + write(LUN, *) "Regime: Merge" case(COLLRESOLVE_REGIME_DISRUPTION) - write(LUN, *) "Disruption" + write(LUN, *) "Regime: Disruption" case(COLLRESOLVE_REGIME_SUPERCATASTROPHIC) - write(LUN, *) "Supercatastrophic disruption" + write(LUN, *) "Regime: Supercatastrophic disruption" case(COLLRESOLVE_REGIME_GRAZE_AND_MERGE) - write(LUN, *) "Graze and merge" + write(LUN, *) "Regime: Graze and merge" case(COLLRESOLVE_REGIME_HIT_AND_RUN) - write(LUN, *) "Hit and run" + write(LUN, *) "Regime: Hit and run" end select - write(LUN, *) "----------------------- Fragment information ----------------------" - write(LUN, *) "Total mass of fragments : ", frag%mtot - write(LUN, *) "Largest fragment mass : ", frag%mass_dist(1) - write(LUN, *) "Second-largest fragment mass : ", frag%mass_dist(2) - write(LUN, *) "Remaining fragment mass : ", frag%mass_dist(3) - write(LUN, *) "Center of mass position : ", frag%xbcom(:) - write(LUN, *) "Center of mass velocity : ", frag%vbcom(:) write(LUN, *) "Energy loss : ", frag%Qloss write(LUN, *) "--------------------------------------------------------------------" close(LUN) From 954764f42da41dfeb245b5eeac4fe6dbe24da9e4 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Wed, 7 Dec 2022 19:38:47 -0500 Subject: [PATCH 338/569] Minor rearranging in preparation for building the infrastructure for fraggle outputs. --- src/modules/symba_classes.f90 | 28 +++++++++++++++------------- 1 file changed, 15 insertions(+), 13 deletions(-) diff --git a/src/modules/symba_classes.f90 b/src/modules/symba_classes.f90 index 4c1b6b673..cf6872846 100644 --- a/src/modules/symba_classes.f90 +++ b/src/modules/symba_classes.f90 @@ -183,7 +183,7 @@ module symba_classes !! NetCDF dimension and variable names for the enounter save object type, extends(netcdf_parameters) :: symba_io_encounter_parameters integer(I4B) :: ienc_frame = 1 !! Current frame number for the encounter history - character(STRMAX) :: enc_file = "encounter.nc" !! Encounter output file name + character(STRMAX) :: enc_file !! Encounter output file name character(NAMELEN) :: level_varname = "level" !! Recursion depth integer(I4B) :: level_varid !! ID for the recursion level variable integer(I4B) :: time_dimsize = 0 !! Number of time values in snapshot @@ -202,6 +202,20 @@ module symba_classes end type symba_encounter_storage + type :: symba_encounter_snapshot + !! A simplified version of a SyMBA nbody system object for storing minimal snapshots of the system state during encounters + type(symba_pl) :: pl !! Massive body data structure + type(symba_tp) :: tp !! Test particle data structure + real(DP) :: t = 0.0_DP !! Time at the snapshot + integer(I4B) :: tslot = 0 !! The index for the time array in the final NetCDF file + contains + procedure :: write_encounter_frame => symba_io_encounter_write_frame !! Writes a frame of encounter data to file + procedure :: dealloc => symba_util_dealloc_snapshot !! Deallocates all allocatable arrays + generic :: write_frame => write_encounter_frame !! Writes a snaphot frame to file + final :: symba_util_final_encounter_snapshot + end type symba_encounter_snapshot + + !******************************************************************************************************************************** ! symba_nbody_system class definitions and method interfaces !******************************************************************************************************************************** @@ -229,18 +243,6 @@ module symba_classes end type symba_nbody_system - type :: symba_encounter_snapshot - type(symba_pl) :: pl !! Massive body data structure - type(symba_tp) :: tp !! Test particle data structure - real(DP) :: t = 0.0_DP !! Time at the snapshot - integer(I4B) :: tslot = 0 !! The index for the time array in the final NetCDF file - contains - procedure :: write_encounter_frame => symba_io_encounter_write_frame !! Writes a frame of encounter data to file - procedure :: dealloc => symba_util_dealloc_snapshot !! Deallocates all allocatable arrays - generic :: write_frame => write_encounter_frame !! Writes a snaphot frame to file - final :: symba_util_final_encounter_snapshot - end type symba_encounter_snapshot - interface module function symba_collision_check_encounter(self, system, param, t, dt, irec) result(lany_collision) From 51d0853e361acb65f68341395be14fdf366b04aa Mon Sep 17 00:00:00 2001 From: David A Minton Date: Wed, 7 Dec 2022 19:53:44 -0500 Subject: [PATCH 339/569] Set temporary snapshot to be non-allocatable when saving --- src/symba/symba_util.f90 | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/src/symba/symba_util.f90 b/src/symba/symba_util.f90 index b5b74d93e..41fd746ad 100644 --- a/src/symba/symba_util.f90 +++ b/src/symba/symba_util.f90 @@ -1340,12 +1340,11 @@ module subroutine symba_util_take_encounter_snapshot(self, param, t) class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! current time ! Arguments - type(symba_encounter_snapshot), allocatable :: snapshot + type(symba_encounter_snapshot) :: snapshot integer(I4B) :: i, npl_snap, ntp_snap associate(npl => self%pl%nbody, ntp => self%tp%nbody) - allocate(symba_encounter_snapshot :: snapshot) snapshot%t = t if (npl + ntp == 0) return From ba6744137aa5cf16e423abc5632d3a6af3e74a6b Mon Sep 17 00:00:00 2001 From: David A Minton Date: Wed, 7 Dec 2022 20:03:18 -0500 Subject: [PATCH 340/569] Updated structure of the symba storage class to make the netcdf parameter a class instead of a type for easier extending --- src/modules/symba_classes.f90 | 5 ++--- src/setup/setup.f90 | 1 - src/symba/symba_io.f90 | 5 ++++- src/symba/symba_util.f90 | 1 + 4 files changed, 7 insertions(+), 5 deletions(-) diff --git a/src/modules/symba_classes.f90 b/src/modules/symba_classes.f90 index cf6872846..c16644b1d 100644 --- a/src/modules/symba_classes.f90 +++ b/src/modules/symba_classes.f90 @@ -194,14 +194,13 @@ module symba_classes type, extends(swiftest_storage) :: symba_encounter_storage !! A class that that is used to store simulation history data between file output - type(symba_io_encounter_parameters) :: nc !! NetCDF parameter object - real(DP), dimension(nframes) :: tvals !! Stored time values for snapshots + class(symba_io_encounter_parameters), allocatable :: nc !! NetCDF parameter object + real(DP), dimension(nframes) :: tvals !! Stored time values for snapshots contains procedure :: dump => symba_io_encounter_dump !! Dumps contents of encounter history to file final :: symba_util_final_encounter_storage end type symba_encounter_storage - type :: symba_encounter_snapshot !! A simplified version of a SyMBA nbody system object for storing minimal snapshots of the system state during encounters type(symba_pl) :: pl !! Massive body data structure diff --git a/src/setup/setup.f90 b/src/setup/setup.f90 index ea6d3db23..e95505b9b 100644 --- a/src/setup/setup.f90 +++ b/src/setup/setup.f90 @@ -68,7 +68,6 @@ module subroutine setup_construct_system(system, param) allocate(symba_pltpenc :: system%pltpenc_list) allocate(symba_plplenc :: system%plplenc_list) allocate(symba_plplenc :: system%plplcollision_list) - allocate(symba_encounter_storage :: system%encounter_history) end select case (RINGMOONS) write(*,*) 'RINGMOONS-SyMBA integrator not yet enabled' diff --git a/src/symba/symba_io.f90 b/src/symba/symba_io.f90 index a4e5a9922..c5ed78f2a 100644 --- a/src/symba/symba_io.f90 +++ b/src/symba/symba_io.f90 @@ -384,7 +384,10 @@ module subroutine symba_io_start_encounter(self, param, t) class(symba_parameters), intent(inout) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! Current simulation time - if (.not. allocated(self%encounter_history)) allocate(symba_encounter_storage :: self%encounter_history) + if (.not. allocated(self%encounter_history)) then + allocate(symba_encounter_storage :: self%encounter_history) + allocate(symba_io_encounter_parameters :: self%encounter_history%nc) + end if call self%encounter_history%reset() ! Empty out the time slot array for the next pass diff --git a/src/symba/symba_util.f90 b/src/symba/symba_util.f90 index 41fd746ad..b66fe7ed1 100644 --- a/src/symba/symba_util.f90 +++ b/src/symba/symba_util.f90 @@ -955,6 +955,7 @@ module subroutine symba_util_resize_storage(self, nnew) nbig = nbig * 2 end do allocate(symba_encounter_storage(nbig) :: tmp) + call move_alloc(self%encounter_history%nc, tmp%nc) tmp%tvals(1:nold) = self%encounter_history%tvals(1:nold) tmp%tvals(nold+1:nbig) = huge(1.0_DP) if (lmalloc) then From ca87dd1c0a555440189e75e5bc35949b307cd67d Mon Sep 17 00:00:00 2001 From: David A Minton Date: Thu, 8 Dec 2022 12:53:54 -0500 Subject: [PATCH 341/569] Major restructuring of encounter storage classes and methods --- examples/Fragmentation/Fragmentation_Movie.py | 6 +- src/CMakeLists.txt | 2 + src/encounter/encounter_io.f90 | 207 +++++++++++++ src/encounter/encounter_util.f90 | 30 ++ src/fraggle/fraggle_io.f90 | 20 ++ src/fraggle/fraggle_util.f90 | 64 +++++ src/helio/helio_util.f90 | 2 +- src/io/io.f90 | 2 - src/main/swiftest_driver.f90 | 4 +- src/modules/encounter_classes.f90 | 67 ++++- src/modules/fraggle_classes.f90 | 66 ++++- src/modules/helio_classes.f90 | 6 +- src/modules/rmvs_classes.f90 | 10 +- src/modules/swiftest_classes.f90 | 72 ++--- src/modules/symba_classes.f90 | 98 +------ src/modules/whm_classes.f90 | 6 +- src/netcdf/netcdf.f90 | 18 +- src/rmvs/rmvs_util.f90 | 3 +- src/symba/symba_io.f90 | 200 +------------ src/symba/symba_util.f90 | 271 ++++++++---------- src/util/util_dealloc.f90 | 19 -- src/util/util_final.f90 | 62 ++++ src/util/util_reset.f90 | 2 + src/whm/whm_util.f90 | 2 +- 24 files changed, 704 insertions(+), 535 deletions(-) create mode 100644 src/encounter/encounter_io.f90 create mode 100644 src/util/util_final.f90 diff --git a/examples/Fragmentation/Fragmentation_Movie.py b/examples/Fragmentation/Fragmentation_Movie.py index ab2e2b34d..a664ef49e 100644 --- a/examples/Fragmentation/Fragmentation_Movie.py +++ b/examples/Fragmentation/Fragmentation_Movie.py @@ -41,8 +41,8 @@ movie_titles = dict(zip(available_movie_styles, movie_title_list)) # These initial conditions were generated by trial and error -pos_vectors = {"disruption_headon" : [np.array([1.0, -5.0e-04, 0.0]), - np.array([1.0, 5.0e-04 ,0.0])], +pos_vectors = {"disruption_headon" : [np.array([1.0, -5.0e-05, 0.0]), + np.array([1.0, 5.0e-05 ,0.0])], "supercatastrophic_off_axis": [np.array([1.0, -4.2e-05, 0.0]), np.array([1.0, 4.2e-05, 0.0])], "hitandrun" : [np.array([1.0, -2.0e-05, 0.0]), @@ -203,7 +203,7 @@ def data_stream(self, frame=0): 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, fragmentation_save="TRAJECTORY", gmtiny=gmtiny, minimum_fragment_gmass=minimum_fragment_gmass, verbose=False) - sim.run(dt=1e-4, tstop=1.0e-4, istep_out=1, dump_cadence=0) + sim.run(dt=1e-4, tstop=1.0e-3, istep_out=1, dump_cadence=0) print("Generating animation") anim = AnimatedScatter(sim,movie_filename,movie_titles[style],style,nskip=1) \ No newline at end of file diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index 7f45ddd5a..eb9fb20d5 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -30,6 +30,7 @@ SET(FAST_MATH_FILES ${SRC}/encounter/encounter_check.f90 ${SRC}/encounter/encounter_setup.f90 ${SRC}/encounter/encounter_util.f90 + ${SRC}/encounter/encounter_io.f90 ${SRC}/fraggle/fraggle_generate.f90 ${SRC}/fraggle/fraggle_io.f90 ${SRC}/fraggle/fraggle_placeholder.f90 @@ -74,6 +75,7 @@ SET(FAST_MATH_FILES ${SRC}/util/util_dealloc.f90 ${SRC}/util/util_exit.f90 ${SRC}/util/util_fill.f90 + ${SRC}/util/util_final.f90 ${SRC}/util/util_flatten.f90 ${SRC}/util/util_get_energy_momentum.f90 ${SRC}/util/util_index_array.f90 diff --git a/src/encounter/encounter_io.f90 b/src/encounter/encounter_io.f90 new file mode 100644 index 000000000..0cc07b009 --- /dev/null +++ b/src/encounter/encounter_io.f90 @@ -0,0 +1,207 @@ +!! 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 +contains + + + module subroutine encounter_io_dump(self, param) + !! author: David A. Minton + !! + !! Dumps the time history of an encounter to file. + implicit none + ! Arguments + class(encounter_storage(*)), intent(inout) :: self !! Encounter storage object + class(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. + + do i = 1, self%nframes + if (allocated(self%frame(i)%item)) then + select type(snapshot => self%frame(i)%item) + class is (encounter_snapshot) + param%ioutput = self%tslot(i) + call snapshot%write_frame(self%nc,param) + end select + else + exit + end if + end do + + + return + end subroutine encounter_io_dump + + + module subroutine encounter_io_initialize(self, param) + !! author: David A. Minton + !! + !! Initialize a NetCDF encounter file system. This is a simplified version of the main simulation output NetCDF file, but with fewer variables. + use, intrinsic :: ieee_arithmetic + use netcdf + implicit none + ! Arguments + 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 + integer(I4B) :: nvar, varid, vartype + real(DP) :: dfill + real(SP) :: sfill + logical :: fileExists + character(len=STRMAX) :: errmsg + integer(I4B) :: ndims + + associate(nc => self) + dfill = ieee_value(dfill, IEEE_QUIET_NAN) + sfill = ieee_value(sfill, IEEE_QUIET_NAN) + + select case (param%out_type) + case("NETCDF_FLOAT") + self%out_type = NF90_FLOAT + case("NETCDF_DOUBLE") + self%out_type = NF90_DOUBLE + end select + + ! Check if the file exists, and if it does, delete it + inquire(file=nc%enc_file, exist=fileExists) + if (fileExists) then + open(unit=LUN, file=nc%enc_file, status="old", err=667, iomsg=errmsg) + close(unit=LUN, status="delete") + end if + + call check( nf90_create(nc%enc_file, NF90_NETCDF4, nc%id), "encounter_io_initialize nf90_create" ) + + ! Dimensions + call check( nf90_def_dim(nc%id, nc%time_dimname, nc%time_dimsize, nc%time_dimid), "encounter_io_initialize nf90_def_dim time_dimid" ) ! Simulation time dimension + call check( nf90_def_dim(nc%id, nc%space_dimname, NDIM , nc%space_dimid), "encounter_io_initialize nf90_def_dim space_dimid" ) ! 3D space dimension + call check( nf90_def_dim(nc%id, nc%id_dimname, param%maxid, nc%id_dimid), "encounter_io_initialize nf90_def_dim id_dimid" ) ! dimension to store particle id numbers + call check( nf90_def_dim(nc%id, nc%str_dimname, NAMELEN, nc%str_dimid), "encounter_io_initialize nf90_def_dim str_dimid" ) ! Dimension for string variables (aka character arrays) + + ! Dimension coordinates + call check( nf90_def_var(nc%id, nc%time_dimname, nc%out_type, nc%time_dimid, nc%time_varid), "encounter_io_initialize nf90_def_var time_varid" ) + call check( nf90_def_var(nc%id, nc%space_dimname, NF90_CHAR, nc%space_dimid, nc%space_varid), "encounter_io_initialize nf90_def_var space_varid" ) + call check( nf90_def_var(nc%id, nc%id_dimname, NF90_INT, nc%id_dimid, nc%id_varid), "encounter_io_initialize nf90_def_var id_varid" ) + + ! Variables + call check( nf90_def_var(nc%id, nc%name_varname, NF90_CHAR, [nc%str_dimid, nc%id_dimid], nc%name_varid), "encounter_io_initialize nf90_def_var name_varid" ) + call check( nf90_def_var(nc%id, nc%ptype_varname, NF90_CHAR, [nc%str_dimid, nc%id_dimid], nc%ptype_varid), "encounter_io_initialize nf90_def_var ptype_varid" ) + call check( nf90_def_var(nc%id, nc%rh_varname, nc%out_type, [nc%space_dimid, nc%id_dimid, nc%time_dimid], nc%rh_varid), "encounter_io_initialize nf90_def_var rh_varid" ) + call check( nf90_def_var(nc%id, nc%vh_varname, nc%out_type, [nc%space_dimid, nc%id_dimid, nc%time_dimid], nc%vh_varid), "encounter_io_initialize nf90_def_var vh_varid" ) + call check( nf90_def_var(nc%id, nc%Gmass_varname, nc%out_type, [nc%id_dimid, nc%time_dimid], nc%Gmass_varid), "encounter_io_initialize nf90_def_var Gmass_varid" ) + call check( nf90_def_var(nc%id, nc%level_varname, NF90_INT, [nc%id_dimid, nc%time_dimid], nc%level_varid), "encounter_io_initialize nf90_def_var level_varid" ) + if (param%lclose) then + call check( nf90_def_var(nc%id, nc%radius_varname, nc%out_type, [nc%id_dimid, nc%time_dimid], nc%radius_varid), "encounter_io_initialize nf90_def_var radius_varid" ) + end if + if (param%lrotation) then + call check( nf90_def_var(nc%id, nc%Ip_varname, nc%out_type, [nc%space_dimid, nc%id_dimid, nc%time_dimid], nc%Ip_varid), "encounter_io_initialize nf90_def_var Ip_varid" ) + call check( nf90_def_var(nc%id, nc%rot_varname, nc%out_type, [nc%space_dimid, nc%id_dimid, nc%time_dimid], nc%rot_varid), "encounter_io_initialize nf90_def_var rot_varid" ) + end if + + call check( nf90_inquire(nc%id, nVariables=nvar), "encounter_io_initialize nf90_inquire nVariables" ) + do varid = 1, nvar + call check( nf90_inquire_variable(nc%id, varid, xtype=vartype, ndims=ndims), "encounter_io_initialize nf90_inquire_variable" ) + select case(vartype) + case(NF90_INT) + call check( nf90_def_var_fill(nc%id, varid, 0, NF90_FILL_INT), "encounter_io_initialize nf90_def_var_fill NF90_INT" ) + case(NF90_FLOAT) + call check( nf90_def_var_fill(nc%id, varid, 0, sfill), "encounter_io_initialize nf90_def_var_fill NF90_FLOAT" ) + case(NF90_DOUBLE) + call check( nf90_def_var_fill(nc%id, varid, 0, dfill), "encounter_io_initialize nf90_def_var_fill NF90_DOUBLE" ) + case(NF90_CHAR) + call check( nf90_def_var_fill(nc%id, varid, 0, 0), "encounter_io_initialize nf90_def_var_fill NF90_CHAR" ) + end select + end do + + ! Take the file out of define mode + call check( nf90_enddef(nc%id), "encounter_io_initialize nf90_enddef" ) + + ! Add in the space dimension coordinates + call check( nf90_put_var(nc%id, nc%space_varid, nc%space_coords, start=[1], count=[NDIM]), "encounter_io_initialize nf90_put_var space" ) + end associate + + return + + 667 continue + write(*,*) "Error creating encounter output file. " // trim(adjustl(errmsg)) + call util_exit(FAILURE) + end subroutine encounter_io_initialize + + + module subroutine encounter_io_write_frame(self, nc, param) + !! author: David A. Minton + !! + !! Write a frame of output of an encounter trajectory. + use netcdf + implicit none + ! Arguments + class(encounter_snapshot), intent(in) :: self !! Swiftest encounter structure + class(encounter_io_parameters), intent(inout) :: nc !! Parameters used to identify a particular encounter io NetCDF dataset + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + ! Internals + integer(I4B) :: i, tslot, idslot, old_mode, npl, ntp + character(len=NAMELEN) :: charstring + + tslot = param%ioutput + + call check( nf90_set_fill(nc%id, nf90_nofill, old_mode), "encounter_io_write_frame nf90_set_fill" ) + + call check( nf90_put_var(nc%id, nc%time_varid, self%t, start=[tslot]), "encounter_io_write_frame nf90_put_var time_varid" ) + + associate(pl => self%pl, tp => self%tp) + npl = pl%nbody + do i = 1, npl + idslot = pl%id(i) + call check( nf90_put_var(nc%id, nc%id_varid, pl%id(i), start=[idslot]), "encounter_io_write_frame nf90_put_var pl id_varid" ) + call check( nf90_put_var(nc%id, nc%rh_varid, pl%rh(:,i), start=[1,idslot,tslot], count=[NDIM,1,1]), "encounter_io_write_frame nf90_put_var pl rh_varid" ) + call check( nf90_put_var(nc%id, nc%vh_varid, pl%vh(:,i), start=[1,idslot,tslot], count=[NDIM,1,1]), "encounter_io_write_frame nf90_put_var pl vh_varid" ) + call check( nf90_put_var(nc%id, nc%Gmass_varid, pl%Gmass(i), start=[idslot, tslot]), "encounter_io_write_frame nf90_put_var pl Gmass_varid" ) + select type(pl) + class is (symba_pl) + call check( nf90_put_var(nc%id, nc%level_varid, pl%levelg(i), start=[idslot, tslot]), "encounter_io_write_frame nf90_put_var pl level_varid" ) + end select + + if (param%lclose) call check( nf90_put_var(nc%id, nc%radius_varid, pl%radius(i), start=[idslot, tslot]), "encounter_io_write_frame nf90_put_var pl radius_varid" ) + + if (param%lrotation) then + call check( nf90_put_var(nc%id, nc%Ip_varid, pl%Ip(:,i), start=[1, idslot, tslot], count=[NDIM,1,1]), "encounter_io_write_frame nf90_put_var pl Ip_varid" ) + call check( nf90_put_var(nc%id, nc%rot_varid, pl%rot(:,i), start=[1,idslot, tslot], count=[NDIM,1,1]), "encounter_io_write_frame nf90_put_var pl rotx_varid" ) + end if + + charstring = trim(adjustl(pl%info(i)%name)) + call check( nf90_put_var(nc%id, nc%name_varid, charstring, start=[1, idslot], count=[NAMELEN, 1]), "encounter_io_write_frame nf90_put_var pl name_varid" ) + charstring = trim(adjustl(pl%info(i)%particle_type)) + call check( nf90_put_var(nc%id, nc%ptype_varid, charstring, start=[1, idslot], count=[NAMELEN, 1]), "encounter_io_write_frame nf90_put_var pl particle_type_varid" ) + end do + + ntp = tp%nbody + do i = 1, ntp + idslot = tp%id(i) + call check( nf90_put_var(nc%id, nc%id_varid, tp%id(i), start=[idslot]), "encounter_io_write_frame nf90_put_var tp id_varid" ) + call check( nf90_put_var(nc%id, nc%rh_varid, tp%rh(:,i), start=[1,idslot,tslot], count=[NDIM,1,1]), "encounter_io_write_frame nf90_put_var tp rh_varid" ) + call check( nf90_put_var(nc%id, nc%vh_varid, tp%vh(:,i), start=[1,idslot,tslot], count=[NDIM,1,1]), "encounter_io_write_frame nf90_put_var tp vh_varid" ) + + charstring = trim(adjustl(tp%info(i)%name)) + call check( nf90_put_var(nc%id, nc%name_varid, charstring, start=[1, idslot], count=[NAMELEN, 1]), "encounter_io_write_frame nf90_put_var tp name_varid" ) + charstring = trim(adjustl(tp%info(i)%particle_type)) + call check( nf90_put_var(nc%id, nc%ptype_varid, charstring, start=[1, idslot], count=[NAMELEN, 1]), "encounter_io_write_frame nf90_put_var tp particle_type_varid" ) + end do + end associate + + call check( nf90_set_fill(nc%id, old_mode, old_mode) ) + + return + end subroutine encounter_io_write_frame + + + + +end submodule s_encounter_io \ No newline at end of file diff --git a/src/encounter/encounter_util.f90 b/src/encounter/encounter_util.f90 index d0c801ab4..0d3a66d62 100644 --- a/src/encounter/encounter_util.f90 +++ b/src/encounter/encounter_util.f90 @@ -136,6 +136,36 @@ module subroutine encounter_util_final_list(self) end subroutine encounter_util_final_list + module subroutine encounter_util_final_snapshot(self) + !! author: David A. Minton + !! + !! Deallocates allocatable arrays in an encounter snapshot + implicit none + ! Arguments + type(encounter_snapshot), intent(inout) :: self !! Encounter storage object + + if (allocated(self%pl)) deallocate(self%pl) + if (allocated(self%tp)) deallocate(self%tp) + self%t = 0.0_DP + + return + end subroutine encounter_util_final_snapshot + + + module subroutine encounter_util_final_storage(self) + !! author: David A. Minton + !! + !! Deallocates allocatable arrays in an encounter snapshot + implicit none + ! Arguments + type(encounter_storage(*)), intent(inout) :: self !! Encounter storage object + + call util_final_storage(self%swiftest_storage) + + return + end subroutine encounter_util_final_storage + + module subroutine encounter_util_resize_list(self, nnew) !! author: David A. Minton !! diff --git a/src/fraggle/fraggle_io.f90 b/src/fraggle/fraggle_io.f90 index a8c772326..9d00bfb0f 100644 --- a/src/fraggle/fraggle_io.f90 +++ b/src/fraggle/fraggle_io.f90 @@ -12,6 +12,26 @@ contains + + module subroutine fraggle_io_encounter_dump(self, param) + implicit none + class(fraggle_storage(*)), intent(inout) :: self !! Encounter storage object + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + end subroutine fraggle_io_encounter_dump + + module subroutine fraggle_io_encounter_initialize_output(self, param) + implicit none + class(fraggle_io_encounter_parameters), intent(inout) :: self !! Parameters used to identify a particular NetCDF dataset + class(swiftest_parameters), intent(in) :: param + end subroutine fraggle_io_encounter_initialize_output + + module subroutine fraggle_io_encounter_write_frame(self, nc, param) + implicit none + class(fraggle_encounter_snapshot), intent(in) :: self !! Swiftest encounter structure + class(encounter_io_parameters), intent(inout) :: nc !! Parameters used to identify a particular encounter io NetCDF dataset + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + end subroutine fraggle_io_encounter_write_frame + module subroutine fraggle_io_log_generate(frag) !! author: David A. Minton !! diff --git a/src/fraggle/fraggle_util.f90 b/src/fraggle/fraggle_util.f90 index 5c0803912..8688ec2d9 100644 --- a/src/fraggle/fraggle_util.f90 +++ b/src/fraggle/fraggle_util.f90 @@ -131,6 +131,70 @@ module subroutine fraggle_util_construct_temporary_system(frag, system, param, t end subroutine fraggle_util_construct_temporary_system + + module subroutine fraggle_util_final_colliders(self) + !! author: David A. Minton + !! + !! Finalizer will deallocate all allocatables + implicit none + ! Arguments + type(fraggle_colliders), intent(inout) :: self !! Fraggle encountar storage object + + if (allocated(self%idx)) deallocate(self%idx) + + return + end subroutine fraggle_util_final_colliders + + + module subroutine fraggle_util_final_fragments(self) + !! author: David A. Minton + !! + !! Finalizer will deallocate all allocatables + implicit none + ! Arguments + type(fraggle_fragments), intent(inout) :: self !! Fraggle encountar storage object + + if (allocated(self%x_coll)) deallocate(self%x_coll) + if (allocated(self%v_coll)) deallocate(self%v_coll) + if (allocated(self%v_r_unit)) deallocate(self%v_r_unit) + if (allocated(self%v_t_unit)) deallocate(self%v_t_unit) + if (allocated(self%v_n_unit)) deallocate(self%v_n_unit) + if (allocated(self%rmag)) deallocate(self%rmag) + if (allocated(self%rotmag)) deallocate(self%rotmag) + if (allocated(self%v_r_mag)) deallocate(self%v_r_mag) + if (allocated(self%v_t_mag)) deallocate(self%v_t_mag) + + return + end subroutine fraggle_util_final_fragments + + + module subroutine fraggle_util_final_storage(self) + !! author: David A. Minton + !! + !! Finalizer will deallocate all allocatables + implicit none + ! Arguments + type(fraggle_storage(*)), intent(inout) :: self !! Fraggle encountar storage object + + call util_final_storage(self%swiftest_storage) + + return + end subroutine fraggle_util_final_storage + + module subroutine fraggle_util_final_snapshot(self) + !! author: David A. Minton + !! + !! Finalizer will deallocate all allocatables + implicit none + ! Arguments + type(fraggle_encounter_snapshot), intent(inout) :: self !! Fraggle encountar storage object + + call encounter_util_final_snapshot(self%encounter_snapshot) + + return + end subroutine fraggle_util_final_snapshot + + module subroutine fraggle_util_get_energy_momentum(self, colliders, system, param, lbefore) !! Author: David A. Minton !! diff --git a/src/helio/helio_util.f90 b/src/helio/helio_util.f90 index 698bb4849..73a88d58c 100644 --- a/src/helio/helio_util.f90 +++ b/src/helio/helio_util.f90 @@ -33,7 +33,7 @@ module subroutine helio_util_final_system(self) ! Arguments type(helio_nbody_system), intent(inout) :: self !! Helio nbody system object - call self%dealloc() + call whm_util_final_system(self%whm_nbody_system) return end subroutine helio_util_final_system diff --git a/src/io/io.f90 b/src/io/io.f90 index 92924d458..d14f0a694 100644 --- a/src/io/io.f90 +++ b/src/io/io.f90 @@ -122,9 +122,7 @@ module subroutine io_conservation_report(self, param, lterminal) ! Internals real(DP), dimension(NDIM) :: Ltot_now, Lorbit_now, Lspin_now real(DP) :: ke_orbit_now, ke_spin_now, pe_now, Eorbit_now - real(DP) :: Eorbit_error, Etot_error, Ecoll_error real(DP) :: GMtot_now - real(DP) :: Lerror, Merror character(len=STRMAX) :: errmsg integer(I4B), parameter :: EGYIU = 72 character(len=*), parameter :: EGYTERMFMT = '(" DL/L0 = ", ES12.5 & diff --git a/src/main/swiftest_driver.f90 b/src/main/swiftest_driver.f90 index 4ff06d4a8..6d5abce79 100644 --- a/src/main/swiftest_driver.f90 +++ b/src/main/swiftest_driver.f90 @@ -28,7 +28,7 @@ program swiftest_driver 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 + real(DP) :: tfrac !! Fraction of total simulation time completed type(progress_bar) :: pbar !! Object used to print out a progress bar character(*), parameter :: statusfmt = '("Time = ", ES12.5, "; fraction done = ", F6.3, ' // & '"; Number of active pl, tp = ", I6, ", ", I6)' @@ -127,7 +127,7 @@ program swiftest_driver if (iout == istep_out) then iout = 0 idump = idump + 1 - system_history%frame(idump) = nbody_system + system_history%frame(idump) = nbody_system ! Store a snapshot of the system for posterity if (idump == dump_cadence) then idump = 0 diff --git a/src/modules/encounter_classes.f90 b/src/modules/encounter_classes.f90 index b04fca1a1..c7edc5e8a 100644 --- a/src/modules/encounter_classes.f90 +++ b/src/modules/encounter_classes.f90 @@ -38,18 +38,48 @@ module encounter_classes 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 + final :: encounter_util_final_list !! Finalize the encounter list - deallocates all allocatables end type encounter_list + type :: encounter_snapshot + !! A simplified version of a SyMBA nbody system object for storing minimal snapshots of the system state during encounters + class(swiftest_pl), allocatable :: pl !! Massive body data structure + class(swiftest_tp), allocatable :: tp !! Test particle data structure + real(DP) :: t !! Simulation time when snapshot was taken + contains + procedure :: write_frame => encounter_io_write_frame !! Writes a frame of encounter data to file + final :: encounter_util_final_snapshot + end type encounter_snapshot + + !> NetCDF dimension and variable names for the enounter save object + type, extends(netcdf_parameters) :: encounter_io_parameters + integer(I4B) :: ienc_frame = 1 !! Current frame number for the encounter history + character(STRMAX) :: enc_file !! Encounter output file name + character(NAMELEN) :: level_varname = "level" !! Recursion depth + integer(I4B) :: level_varid !! ID for the recursion level variable + integer(I4B) :: time_dimsize = 0 !! Number of time values in snapshot + integer(I4B) :: id_dimsize = 0 !! Number of potential id values in snapshot + contains + procedure :: initialize => encounter_io_initialize !! Initialize a set of parameters used to identify a NetCDF output object + end type encounter_io_parameters + + !> A class that that is used to store simulation history data between file output + type, extends(swiftest_storage) :: encounter_storage + type(encounter_io_parameters) :: nc !! NetCDF parameter object containing the details about the file attached to this storage object + contains + procedure :: dump => encounter_io_dump !! Dumps contents of encounter history to file + final :: encounter_util_final_storage + 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) integer(I8B), dimension(:), allocatable :: ibeg !! Beginning index for box integer(I8B), dimension(:), allocatable :: iend !! Ending index for box contains - procedure :: sort => encounter_check_sort_aabb_1D !! Sorts the bounding box extents along a single dimension prior to the sweep phase - procedure :: dealloc => encounter_util_dealloc_aabb !! Deallocates all allocatables - final :: encounter_util_final_aabb !! Finalize the axis-aligned bounding box (1D) - deallocates all allocatables + procedure :: sort => encounter_check_sort_aabb_1D !! Sorts the bounding box extents along a single dimension prior to the sweep phase + procedure :: dealloc => encounter_util_dealloc_aabb !! Deallocates all allocatables + final :: encounter_util_final_aabb !! Finalize the axis-aligned bounding box (1D) - deallocates all allocatables end type type encounter_bounding_box @@ -173,6 +203,25 @@ 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_dump(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 + + module subroutine encounter_io_initialize(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 + + module subroutine encounter_io_write_frame(self, nc, param) + implicit none + class(encounter_snapshot), intent(in) :: self !! Swiftest encounter structure + class(encounter_io_parameters), intent(inout) :: nc !! 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) implicit none class(encounter_bounding_box), intent(inout) :: self !! Swiftest encounter structure @@ -219,6 +268,16 @@ module subroutine encounter_util_final_list(self) type(encounter_list), intent(inout) :: self !! Swiftest encounter list object end subroutine encounter_util_final_list + module subroutine encounter_util_final_snapshot(self) + implicit none + type(encounter_snapshot), intent(inout) :: self !! Encounter snapshot object + end subroutine encounter_util_final_snapshot + + module subroutine encounter_util_final_storage(self) + implicit none + type(encounter_storage(*)), intent(inout) :: self !! SyMBA nbody system object + end subroutine encounter_util_final_storage + module subroutine encounter_util_resize_list(self, nnew) implicit none class(encounter_list), intent(inout) :: self !! Swiftest encounter list diff --git a/src/modules/fraggle_classes.f90 b/src/modules/fraggle_classes.f90 index d7c949a01..e4a458a3b 100644 --- a/src/modules/fraggle_classes.f90 +++ b/src/modules/fraggle_classes.f90 @@ -12,7 +12,8 @@ module fraggle_classes !! !! Definition of classes and methods specific to Fraggel: The Fragment Generation Model use swiftest_globals - use swiftest_classes, only : swiftest_parameters, swiftest_nbody_system, swiftest_cb, swiftest_pl + use swiftest_classes, only : swiftest_parameters, swiftest_nbody_system, swiftest_cb, swiftest_pl, swiftest_storage, netcdf_parameters + use encounter_classes, only : encounter_snapshot, encounter_io_parameters implicit none public @@ -35,7 +36,8 @@ module fraggle_classes real(DP), dimension(2) :: mass !! Two-body equivalent mass of the collider bodies prior to the collision real(DP), dimension(2) :: radius !! Two-body equivalent radii of the collider bodies prior to the collision contains - procedure :: regime => fraggle_regime_colliders !! Determine which fragmentation regime the set of colliders will be + procedure :: regime => fraggle_regime_colliders !! Determine which fragmentation regime the set of colliders will be + final :: fraggle_util_final_colliders !! Finalizer will deallocate all allocatables end type fraggle_colliders !******************************************************************************************************************************** @@ -103,8 +105,29 @@ module fraggle_classes procedure :: get_ang_mtm => fraggle_util_ang_mtm !! Calcualtes the current angular momentum of the fragments procedure :: get_energy_and_momentum => fraggle_util_get_energy_momentum !! Calculates total system energy in either the pre-collision outcome state (lbefore = .true.) or the post-collision outcome state (lbefore = .false.) procedure :: restructure => fraggle_util_restructure !! Restructure the inputs after a failed attempt failed to find a set of positions and velocities that satisfy the energy and momentum constraints + final :: fraggle_util_final_fragments !! Finalizer will deallocate all allocatables + end type fraggle_fragments + !! NetCDF dimension and variable names for the enounter save object + type, extends(encounter_io_parameters) :: fraggle_io_encounter_parameters + contains + procedure :: initialize => fraggle_io_encounter_initialize_output !! Initialize a set of parameters used to identify a NetCDF output object + end type fraggle_io_encounter_parameters + + !> A class that that is used to store fragmentation data between file output + type, extends(swiftest_storage) :: fraggle_storage + contains + procedure :: dump => fraggle_io_encounter_dump !! Dumps contents of encounter history to file + final :: fraggle_util_final_storage + end type fraggle_storage + + type, extends(encounter_snapshot) :: fraggle_encounter_snapshot + contains + procedure :: write_frame => fraggle_io_encounter_write_frame !! Writes a frame of encounter data to file + final :: fraggle_util_final_snapshot + end type fraggle_encounter_snapshot + interface module subroutine fraggle_generate_fragments(self, colliders, system, param, lfailure) use swiftest_classes, only : swiftest_nbody_system, swiftest_parameters @@ -116,6 +139,25 @@ module subroutine fraggle_generate_fragments(self, colliders, system, param, lfa logical, intent(out) :: lfailure !! Answers the question: Should this have been a merger instead? end subroutine fraggle_generate_fragments + module subroutine fraggle_io_encounter_dump(self, param) + implicit none + class(fraggle_storage(*)), intent(inout) :: self !! Encounter storage object + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + end subroutine fraggle_io_encounter_dump + + module subroutine fraggle_io_encounter_initialize_output(self, param) + implicit none + class(fraggle_io_encounter_parameters), intent(inout) :: self !! Parameters used to identify a particular NetCDF dataset + class(swiftest_parameters), intent(in) :: param + end subroutine fraggle_io_encounter_initialize_output + + module subroutine fraggle_io_encounter_write_frame(self, nc, param) + implicit none + class(fraggle_encounter_snapshot), intent(in) :: self !! Swiftest encounter structure + class(encounter_io_parameters), intent(inout) :: nc !! Parameters used to identify a particular encounter io NetCDF dataset + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + end subroutine fraggle_io_encounter_write_frame + module subroutine fraggle_io_log_generate(frag) implicit none class(fraggle_fragments), intent(in) :: frag @@ -239,6 +281,26 @@ module subroutine fraggle_util_construct_temporary_system(frag, system, param, t class(swiftest_parameters), allocatable, intent(out) :: tmpparam !! Output temporary configuration run parameters end subroutine fraggle_util_construct_temporary_system + module subroutine fraggle_util_final_colliders(self) + implicit none + type(fraggle_colliders), intent(inout) :: self !! Fraggle encountar storage object + end subroutine fraggle_util_final_colliders + + module subroutine fraggle_util_final_fragments(self) + implicit none + type(fraggle_fragments), intent(inout) :: self !! Fraggle encountar storage object + end subroutine fraggle_util_final_fragments + + module subroutine fraggle_util_final_storage(self) + implicit none + type(fraggle_storage(*)), intent(inout) :: self !! Fraggle encountar storage object + end subroutine fraggle_util_final_storage + + module subroutine fraggle_util_final_snapshot(self) + implicit none + type(fraggle_encounter_snapshot), intent(inout) :: self !! Fraggle encountar storage object + end subroutine fraggle_util_final_snapshot + module subroutine fraggle_util_get_energy_momentum(self, colliders, system, param, lbefore) use swiftest_classes, only : swiftest_nbody_system, swiftest_parameters implicit none diff --git a/src/modules/helio_classes.f90 b/src/modules/helio_classes.f90 index 3f12628b7..bad042664 100644 --- a/src/modules/helio_classes.f90 +++ b/src/modules/helio_classes.f90 @@ -26,7 +26,7 @@ module helio_classes contains procedure :: step => helio_step_system !! Advance the Helio nbody system forward in time by one step procedure :: initialize => helio_setup_initialize_system !! Performs Helio-specific initilization steps, including converting to DH coordinates - final :: helio_util_final_system !! Finalizes the Helio system object - deallocates all allocatables + final :: helio_util_final_system !! Finalizes the Helio system object - deallocates all allocatables end type helio_nbody_system !******************************************************************************************************************************** @@ -53,7 +53,7 @@ module helio_classes procedure :: accel => helio_kick_getacch_pl !! Compute heliocentric accelerations of massive bodies procedure :: kick => helio_kick_vb_pl !! Kicks the barycentric velocities procedure :: step => helio_step_pl !! Steps the body forward one stepsize - final :: helio_util_final_pl !! Finalizes the Helio massive body object - deallocates all allocatables + final :: helio_util_final_pl !! Finalizes the Helio massive body object - deallocates all allocatables end type helio_pl !******************************************************************************************************************************** @@ -70,7 +70,7 @@ module helio_classes procedure :: accel => helio_kick_getacch_tp !! Compute heliocentric accelerations of massive bodies procedure :: kick => helio_kick_vb_tp !! Kicks the barycentric velocities procedure :: step => helio_step_tp !! Steps the body forward one stepsize - final :: helio_util_final_tp !! Finalizes the Helio test particle object - deallocates all allocatables + final :: helio_util_final_tp !! Finalizes the Helio test particle object - deallocates all allocatables end type helio_tp interface diff --git a/src/modules/rmvs_classes.f90 b/src/modules/rmvs_classes.f90 index 5c3dc7adc..ec7dfcf16 100644 --- a/src/modules/rmvs_classes.f90 +++ b/src/modules/rmvs_classes.f90 @@ -36,7 +36,7 @@ module rmvs_classes !> Replace the abstract procedures with concrete ones procedure :: initialize => rmvs_setup_initialize_system !! Performs RMVS-specific initilization steps, including generating the close encounter planetocentric structures procedure :: step => rmvs_step_system !! Advance the RMVS nbody system forward in time by one step - final :: rmvs_util_final_system !! Finalizes the RMVS nbody system object - deallocates all allocatables + final :: rmvs_util_final_system !! Finalizes the RMVS nbody system object - deallocates all allocatables end type rmvs_nbody_system type, private :: rmvs_interp @@ -46,7 +46,7 @@ module rmvs_classes real(DP), dimension(:, :), allocatable :: atide !! Encountering planet's tidal acceleration value contains procedure :: dealloc => rmvs_util_dealloc_interp !! Deallocates all allocatable arrays - final :: rmvs_util_final_interp !! Finalizes the RMVS interpolated system variables object - deallocates all allocatables + final :: rmvs_util_final_interp !! Finalizes the RMVS interpolated system variables object - deallocates all allocatables end type rmvs_interp !******************************************************************************************************************************** @@ -59,7 +59,7 @@ module rmvs_classes logical :: lplanetocentric = .false. !! Flag that indicates that the object is a planetocentric set of masive bodies used for close encounter calculations contains procedure :: dealloc => rmvs_util_dealloc_cb !! Deallocates all allocatable arrays - final :: rmvs_util_final_cb !! Finalizes the RMVS central body object - deallocates all allocatables + final :: rmvs_util_final_cb !! Finalizes the RMVS central body object - deallocates all allocatables end type rmvs_cb !******************************************************************************************************************************** @@ -94,7 +94,7 @@ module rmvs_classes procedure :: sort => rmvs_util_sort_tp !! Sorts body arrays by a sortable componen procedure :: rearrange => rmvs_util_sort_rearrange_tp !! Rearranges the order of array elements of body based on an input index array. Used in sorting methods procedure :: spill => rmvs_util_spill_tp !! "Spills" bodies from one object to another depending on the results of a mask (uses the PACK intrinsic) - final :: rmvs_util_final_tp !! Finalizes the RMVS test particle object - deallocates all allocatables + final :: rmvs_util_final_tp !! Finalizes the RMVS test particle object - deallocates all allocatables end type rmvs_tp !******************************************************************************************************************************** @@ -119,7 +119,7 @@ module rmvs_classes procedure :: sort => rmvs_util_sort_pl !! Sorts body arrays by a sortable componen procedure :: rearrange => rmvs_util_sort_rearrange_pl !! Rearranges the order of array elements of body based on an input index array. Used in sorting methods procedure :: spill => rmvs_util_spill_pl !! "Spills" bodies from one object to another depending on the results of a mask (uses the PACK intrinsic) - final :: rmvs_util_final_pl !! Finalizes the RMVS massive body object - deallocates all allocatables + final :: rmvs_util_final_pl !! Finalizes the RMVS massive body object - deallocates all allocatables end type rmvs_pl interface diff --git a/src/modules/swiftest_classes.f90 b/src/modules/swiftest_classes.f90 index a3e109bb5..abda5adc2 100644 --- a/src/modules/swiftest_classes.f90 +++ b/src/modules/swiftest_classes.f90 @@ -39,7 +39,7 @@ module swiftest_classes character(NAMELEN) :: space_dimname = "space" !! name of the space dimension integer(I4B) :: space_dimid !! ID for the space dimension integer(I4B) :: space_varid !! ID for the space variable - character(len=1),dimension(3) :: space_coords = ["x","y","z"] !! The space dimension coordinate labels + character(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 @@ -133,7 +133,6 @@ module swiftest_classes 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 @@ -143,6 +142,27 @@ module swiftest_classes procedure :: sync => netcdf_sync !! Syncrhonize the disk and memory buffer of the NetCDF file (e.g. commit the frame files stored in memory to disk) end type netcdf_parameters + type swiftest_storage_frame + class(*), allocatable :: item + contains + 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 + final :: util_final_storage_frame + end type + + type :: swiftest_storage(nframes) + !! An class that establishes the pattern for various storage objects + integer(I4B), len :: nframes = 4096 !! Total number of frames that can be stored + type(swiftest_storage_frame), dimension(nframes) :: frame !! Array of stored frames + integer(I4B) :: iframe = 0 !! Index of the last frame stored in the system + integer(I4B), dimension(nframes) :: tslot !! The value of the time dimension index associated with each frame + real(DP), dimension(nframes) :: tvals !! Stored time values for snapshots + contains + procedure :: dump => io_dump_storage !! Dumps storage object contents to file + procedure :: reset => util_reset_storage !! Resets a storage object by deallocating all items and resetting the frame counter to 0 + final :: util_final_storage + end type swiftest_storage + !******************************************************************************************************************************** ! swiftest_parameters class definitions !******************************************************************************************************************************** @@ -527,7 +547,6 @@ module swiftest_classes procedure :: initialize => setup_initialize_system !! Initialize the system from input files procedure :: init_particle_info => setup_initialize_particle_info_system !! Initialize the system from input files ! procedure :: step_spin => tides_step_spin_system !! Steps the spins of the massive & central bodies due to tides. - procedure :: dealloc => util_dealloc_system !! Deallocates all allocatable components of the system procedure :: set_msys => util_set_msys !! Sets the value of msys from the masses of system bodies. procedure :: get_energy_and_momentum => util_get_energy_momentum_system !! Calculates the total system energy and momentum procedure :: rescale => util_rescale_system !! Rescales the system into a new set of units @@ -535,22 +554,6 @@ 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 swiftest_storage_frame - class(*), allocatable :: item - contains - 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 :: swiftest_storage(nframes) - !! An class that establishes the pattern for various storage objects - integer(I4B), len :: nframes = 2048 !! Total number of frames that can be stored - type(swiftest_storage_frame), dimension(nframes) :: frame !! Array of stored frames - integer(I4B) :: iframe = 0 !! The current frame number - contains - procedure :: dump => io_dump_storage !! Dumps storage object contents to file - procedure :: reset => util_reset_storage !! Resets a storage object by deallocating all items and resetting the frame counter to 0 - end type swiftest_storage abstract interface subroutine abstract_accel(self, system, param, t, lbeg) @@ -580,14 +583,6 @@ subroutine abstract_kick_body(self, system, param, t, dt, lbeg) logical, intent(in) :: lbeg !! Logical flag indicating whether this is the beginning of the half step or not. end subroutine abstract_kick_body - function abstract_read_frame(self, iu, param) result(ierr) - import DP, I4B, swiftest_base, swiftest_parameters - class(swiftest_base), intent(inout) :: self !! Swiftest base object - integer(I4B), intent(inout) :: iu !! Unit number for the output file to write frame to - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - integer(I4B) :: ierr !! Error code: returns 0 if the read is successful - end function abstract_read_frame - subroutine abstract_set_mu(self, cb) import swiftest_body, swiftest_cb class(swiftest_body), intent(inout) :: self !! Swiftest body object @@ -1026,10 +1021,10 @@ end subroutine netcdf_sync module function netcdf_read_frame_system(self, nc, param) result(ierr) implicit none - class(swiftest_nbody_system), intent(inout) :: self !! Swiftest system object - class(netcdf_parameters), intent(inout) :: nc !! Parameters used to for reading a NetCDF dataset to file - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - integer(I4B) :: ierr !! Error code: returns 0 if the read is successful + class(swiftest_nbody_system), intent(inout) :: self !! Swiftest system object + class(netcdf_parameters), intent(inout) :: nc !! Parameters used to for reading a NetCDF dataset to file + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + integer(I4B) :: ierr !! Error code: returns 0 if the read is successful end function netcdf_read_frame_system module subroutine netcdf_read_hdr_system(self, nc, param) @@ -1390,10 +1385,10 @@ module subroutine util_dealloc_pl(self) class(swiftest_pl), intent(inout) :: self end subroutine util_dealloc_pl - module subroutine util_dealloc_system(self) + module subroutine util_final_system(self) implicit none class(swiftest_nbody_system), intent(inout) :: self - end subroutine util_dealloc_system + end subroutine util_final_system module subroutine util_dealloc_tp(self) implicit none @@ -1472,6 +1467,17 @@ end subroutine util_fill_arr_logical end interface interface + + module subroutine util_final_storage(self) + implicit none + type(swiftest_storage(*)) :: self + end subroutine util_final_storage + + module subroutine util_final_storage_frame(self) + implicit none + type(swiftest_storage_frame) :: self + end subroutine util_final_storage_frame + pure module subroutine util_flatten_eucl_ij_to_k(n, i, j, k) !$omp declare simd(util_flatten_eucl_ij_to_k) implicit none diff --git a/src/modules/symba_classes.f90 b/src/modules/symba_classes.f90 index c16644b1d..faa1e2e80 100644 --- a/src/modules/symba_classes.f90 +++ b/src/modules/symba_classes.f90 @@ -16,7 +16,7 @@ module symba_classes use swiftest_classes, only : swiftest_parameters, swiftest_base, swiftest_particle_info, swiftest_storage, 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, encounter_snapshot implicit none public @@ -180,51 +180,16 @@ module symba_classes end type symba_plplenc - !! NetCDF dimension and variable names for the enounter save object - type, extends(netcdf_parameters) :: symba_io_encounter_parameters - integer(I4B) :: ienc_frame = 1 !! Current frame number for the encounter history - character(STRMAX) :: enc_file !! Encounter output file name - character(NAMELEN) :: level_varname = "level" !! Recursion depth - integer(I4B) :: level_varid !! ID for the recursion level variable - integer(I4B) :: time_dimsize = 0 !! Number of time values in snapshot - integer(I4B) :: id_dimsize = 0 !! Number of potential id values in snapshot - contains - procedure :: initialize => symba_io_encounter_initialize_output !! Initialize a set of parameters used to identify a NetCDF output object - end type symba_io_encounter_parameters - - type, extends(swiftest_storage) :: symba_encounter_storage - !! A class that that is used to store simulation history data between file output - class(symba_io_encounter_parameters), allocatable :: nc !! NetCDF parameter object - real(DP), dimension(nframes) :: tvals !! Stored time values for snapshots - contains - procedure :: dump => symba_io_encounter_dump !! Dumps contents of encounter history to file - final :: symba_util_final_encounter_storage - end type symba_encounter_storage - - type :: symba_encounter_snapshot - !! A simplified version of a SyMBA nbody system object for storing minimal snapshots of the system state during encounters - type(symba_pl) :: pl !! Massive body data structure - type(symba_tp) :: tp !! Test particle data structure - real(DP) :: t = 0.0_DP !! Time at the snapshot - integer(I4B) :: tslot = 0 !! The index for the time array in the final NetCDF file - contains - procedure :: write_encounter_frame => symba_io_encounter_write_frame !! Writes a frame of encounter data to file - procedure :: dealloc => symba_util_dealloc_snapshot !! Deallocates all allocatable arrays - generic :: write_frame => write_encounter_frame !! Writes a snaphot frame to file - final :: symba_util_final_encounter_snapshot - end type symba_encounter_snapshot - - !******************************************************************************************************************************** ! 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 - type(symba_encounter_storage(nframes=:)), allocatable :: encounter_history !! Stores encounter history for later retrieval and saving to file + 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 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 @@ -233,12 +198,10 @@ module symba_classes procedure :: set_recur_levels => symba_step_set_recur_levels_system !! Sets recursion levels of bodies and encounter lists to the current system level procedure :: recursive_step => symba_step_recur_system !! Step interacting planets and active test particles ahead in democratic heliocentric coordinates at the current recursion level, if applicable, and descend to the next deeper level if necessary procedure :: reset => symba_step_reset_system !! Resets pl, tp,and encounter structures at the start of a new step - procedure :: dealloc => symba_util_dealloc_system !! Deallocates all allocatable arrays - procedure :: resize_storage => symba_util_resize_storage !! Resizes the encounter history storage object so that it contains enough spaces for the number of snapshots needed procedure :: snapshot => symba_util_take_encounter_snapshot !! Take a minimal snapshot of the system through an encounter procedure :: start_encounter => symba_io_start_encounter !! Initializes the new encounter history procedure :: stop_encounter => symba_io_stop_encounter !! Saves the encounter and/or fragmentation data to file(s) - final :: symba_util_final_system !! Finalizes the SyMBA nbody system object - deallocates all allocatables + final :: symba_util_final_system !! Finalizes the SyMBA nbody system object - deallocates all allocatables end type symba_nbody_system @@ -424,25 +387,6 @@ module subroutine symba_util_take_encounter_snapshot(self, param, t) real(DP), intent(in) :: t !! current time end subroutine symba_util_take_encounter_snapshot - module subroutine symba_io_encounter_dump(self, param) - implicit none - class(symba_encounter_storage(*)), intent(inout) :: self !! Encounter storage object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - end subroutine symba_io_encounter_dump - - module subroutine symba_io_encounter_initialize_output(self, param) - implicit none - class(symba_io_encounter_parameters), intent(inout) :: self !! Parameters used to identify a particular NetCDF dataset - class(swiftest_parameters), intent(in) :: param - end subroutine symba_io_encounter_initialize_output - - module subroutine symba_io_encounter_write_frame(self, nc, param) - implicit none - class(symba_encounter_snapshot), intent(in) :: self !! Swiftest encounter structure - class(symba_io_encounter_parameters), intent(inout) :: nc !! Parameters used to identify a particular encounter io NetCDF dataset - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - end subroutine symba_io_encounter_write_frame - module subroutine symba_io_param_reader(self, unit, iotype, v_list, iostat, iomsg) implicit none class(symba_parameters), intent(inout) :: self !! Current run configuration parameters with SyMBA additionss @@ -662,16 +606,6 @@ module subroutine symba_util_dealloc_merger(self) class(symba_merger), intent(inout) :: self !! SyMBA body merger object end subroutine symba_util_dealloc_merger - module subroutine symba_util_dealloc_snapshot(self) - implicit none - class(symba_encounter_snapshot), intent(inout) :: self !! SyMBA nbody system object - end subroutine symba_util_dealloc_snapshot - - module subroutine symba_util_dealloc_system(self) - implicit none - class(symba_nbody_system), intent(inout) :: self !! SyMBA nbody system object - end subroutine symba_util_dealloc_system - module subroutine symba_util_dealloc_pl(self) implicit none class(symba_pl), intent(inout) :: self !! SyMBA massive body object @@ -721,16 +655,6 @@ module subroutine symba_util_final_encounter_list(self) type(symba_encounter), intent(inout) :: self !! SyMBA encounter list object end subroutine symba_util_final_encounter_list - module subroutine symba_util_final_encounter_snapshot(self) - implicit none - type(symba_encounter_snapshot), intent(inout) :: self !! SyMBA nbody system object - end subroutine symba_util_final_encounter_snapshot - - module subroutine symba_util_final_encounter_storage(self) - implicit none - type(symba_encounter_storage(*)), intent(inout) :: self !! SyMBA nbody system object - end subroutine symba_util_final_encounter_storage - module subroutine symba_util_final_kin(self) implicit none type(symba_kinship), intent(inout) :: self !! SyMBA kinship object @@ -799,12 +723,6 @@ 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/modules/whm_classes.f90 b/src/modules/whm_classes.f90 index 34922c29a..100e606c4 100644 --- a/src/modules/whm_classes.f90 +++ b/src/modules/whm_classes.f90 @@ -58,7 +58,7 @@ module whm_classes procedure :: spill => whm_util_spill_pl !!"Spills" bodies from one object to another depending on the results of a mask (uses the PACK intrinsic) procedure :: setup => whm_setup_pl !! Constructor method - Allocates space for the input number of bodiess procedure :: step => whm_step_pl !! Steps the body forward one stepsize - final :: whm_util_final_pl !! Finalizes the WHM massive body object - deallocates all allocatables + final :: whm_util_final_pl !! Finalizes the WHM massive body object - deallocates all allocatables end type whm_pl !******************************************************************************************************************************** @@ -75,7 +75,7 @@ module whm_classes procedure :: accel => whm_kick_getacch_tp !! Compute heliocentric accelerations of test particles procedure :: kick => whm_kick_vh_tp !! Kick heliocentric velocities of test particles procedure :: step => whm_step_tp !! Steps the particle forward one stepsize - final :: whm_util_final_tp !! Finalizes the WHM test particle object - deallocates all allocatables + final :: whm_util_final_tp !! Finalizes the WHM test particle object - deallocates all allocatables end type whm_tp !******************************************************************************************************************************** @@ -87,7 +87,7 @@ module whm_classes !> Replace the abstract procedures with concrete ones procedure :: initialize => whm_setup_initialize_system !! Performs WHM-specific initilization steps, like calculating the Jacobi masses procedure :: step => whm_step_system !! Advance the WHM nbody system forward in time by one step - final :: whm_util_final_system !! Finalizes the WHM system object - deallocates all allocatables + final :: whm_util_final_system !! Finalizes the WHM system object - deallocates all allocatables end type whm_nbody_system interface diff --git a/src/netcdf/netcdf.f90 b/src/netcdf/netcdf.f90 index 31de061de..ad5d7bbeb 100644 --- a/src/netcdf/netcdf.f90 +++ b/src/netcdf/netcdf.f90 @@ -77,7 +77,7 @@ module function netcdf_get_old_t_final_system(self, param) result(old_t_final) integer(I4B) :: itmax, idmax real(DP), dimension(:), allocatable :: vals real(DP), dimension(1) :: rtemp - real(DP), dimension(NDIM) :: vectemp, rot0, Ip0, Lnow + real(DP), dimension(NDIM) :: rot0, Ip0, Lnow real(DP) :: KE_orb_orig, KE_spin_orig, PE_orig call param%nc%open(param) @@ -438,7 +438,7 @@ module function netcdf_read_frame_system(self, nc, param) result(ierr) implicit none ! Arguments class(swiftest_nbody_system), intent(inout) :: self !! Swiftest system object - class(netcdf_parameters), intent(inout) :: nc !! Parameters used to identify a particular NetCDF dataset + class(netcdf_parameters), intent(inout) :: nc !! Parameters used to identify a particular NetCDF dataset class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters ! Return integer(I4B) :: ierr !! Error code: returns 0 if the read is successful @@ -449,6 +449,8 @@ module function netcdf_read_frame_system(self, nc, param) result(ierr) integer(I4B), dimension(:), allocatable :: itemp logical, dimension(:), allocatable :: validmask, tpmask, plmask + tslot = param%ioutput + call nc%open(param, readonly=.true.) call self%read_hdr(nc, param) @@ -457,8 +459,6 @@ module function netcdf_read_frame_system(self, nc, param) result(ierr) call pl%setup(npl, param) call tp%setup(ntp, param) - tslot = param%ioutput - call check( nf90_inquire_dimension(nc%id, nc%id_dimid, len=idmax), "netcdf_read_frame_system nf90_inquire_dimension id_dimid" ) allocate(rtemp(idmax)) allocate(vectemp(NDIM,idmax)) @@ -1021,19 +1021,19 @@ module subroutine netcdf_write_frame_base(self, nc, param) !! Note: If outputting to orbital elements, but sure that the conversion is done prior to calling this method implicit none ! Arguments - class(swiftest_base), intent(in) :: self !! Swiftest particle object - class(netcdf_parameters), intent(inout) :: nc !! Parameters used to identify a particular NetCDF dataset - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + class(swiftest_base), intent(in) :: self !! Swiftest particle object + class(netcdf_parameters), intent(inout) :: nc !! Parameters used to identify a particular NetCDF dataset + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters ! Internals integer(I4B) :: i, j, tslot, idslot, old_mode integer(I4B), dimension(:), allocatable :: ind real(DP), dimension(NDIM) :: vh !! Temporary variable to store heliocentric velocity values when converting from pseudovelocity in GR-enabled runs real(DP) :: a, e, inc, omega, capom, capm, varpi, lam, f, cape, capf - call self%write_info(nc, param) - tslot = param%ioutput + call self%write_info(nc, param) + call check( nf90_set_fill(nc%id, nf90_nofill, old_mode), "netcdf_write_frame_base nf90_set_fill" ) select type(self) class is (swiftest_body) diff --git a/src/rmvs/rmvs_util.f90 b/src/rmvs/rmvs_util.f90 index 0fc1ed272..eb31db53d 100644 --- a/src/rmvs/rmvs_util.f90 +++ b/src/rmvs/rmvs_util.f90 @@ -232,7 +232,8 @@ module subroutine rmvs_util_final_system(self) ! Arguments type(rmvs_nbody_system), intent(inout) :: self !! RMVS nbody system object - call self%dealloc() + if (allocated(self%vbeg)) deallocate(self%vbeg) + call whm_util_final_system(self%whm_nbody_system) return end subroutine rmvs_util_final_system diff --git a/src/symba/symba_io.f90 b/src/symba/symba_io.f90 index c5ed78f2a..e790e1685 100644 --- a/src/symba/symba_io.f90 +++ b/src/symba/symba_io.f90 @@ -11,192 +11,6 @@ use swiftest contains - module subroutine symba_io_encounter_dump(self, param) - !! author: David A. Minton - !! - !! Dumps the time history of an encounter to file. - implicit none - ! Arguments - class(symba_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. - - do i = 1, self%nframes - if (allocated(self%frame(i)%item)) then - select type(snapshot => self%frame(i)%item) - class is (symba_encounter_snapshot) - self%nc%ienc_frame = i - call snapshot%write_frame(self%nc,param) - end select - else - exit - end if - end do - - - return - end subroutine symba_io_encounter_dump - - - module subroutine symba_io_encounter_initialize_output(self, param) - !! author: David A. Minton - !! - !! Initialize a NetCDF encounter file system. This is a simplified version of the main simulation output NetCDF file, but with fewer variables. - use, intrinsic :: ieee_arithmetic - use netcdf - implicit none - ! Arguments - class(symba_io_encounter_parameters), intent(inout) :: self !! Parameters used to identify a particular NetCDF dataset - class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters - ! Internals - integer(I4B) :: nvar, varid, vartype - real(DP) :: dfill - real(SP) :: sfill - logical :: fileExists - character(len=STRMAX) :: errmsg - integer(I4B) :: ndims - - associate(nc => self) - dfill = ieee_value(dfill, IEEE_QUIET_NAN) - sfill = ieee_value(sfill, IEEE_QUIET_NAN) - - select case (param%out_type) - case("NETCDF_FLOAT") - self%out_type = NF90_FLOAT - case("NETCDF_DOUBLE") - self%out_type = NF90_DOUBLE - end select - - ! Check if the file exists, and if it does, delete it - inquire(file=nc%enc_file, exist=fileExists) - if (fileExists) then - open(unit=LUN, file=nc%enc_file, status="old", err=667, iomsg=errmsg) - close(unit=LUN, status="delete") - end if - - call check( nf90_create(nc%enc_file, NF90_NETCDF4, nc%id), "symba_io_encounter_initialize_output nf90_create" ) - - ! Dimensions - call check( nf90_def_dim(nc%id, nc%time_dimname, nc%time_dimsize, nc%time_dimid), "symba_io_encounter_initialize_output nf90_def_dim time_dimid" ) ! Simulation time dimension - call check( nf90_def_dim(nc%id, nc%space_dimname, NDIM , nc%space_dimid), "symba_io_encounter_initialize_output nf90_def_dim space_dimid" ) ! 3D space dimension - call check( nf90_def_dim(nc%id, nc%id_dimname, param%maxid, nc%id_dimid), "symba_io_encounter_initialize_output nf90_def_dim id_dimid" ) ! dimension to store particle id numbers - call check( nf90_def_dim(nc%id, nc%str_dimname, NAMELEN, nc%str_dimid), "symba_io_encounter_initialize_output nf90_def_dim str_dimid" ) ! Dimension for string variables (aka character arrays) - - ! Dimension coordinates - call check( nf90_def_var(nc%id, nc%time_dimname, nc%out_type, nc%time_dimid, nc%time_varid), "symba_io_encounter_initialize_output nf90_def_var time_varid" ) - call check( nf90_def_var(nc%id, nc%space_dimname, NF90_CHAR, nc%space_dimid, nc%space_varid), "symba_io_encounter_initialize_output nf90_def_var space_varid" ) - call check( nf90_def_var(nc%id, nc%id_dimname, NF90_INT, nc%id_dimid, nc%id_varid), "symba_io_encounter_initialize_output nf90_def_var id_varid" ) - - ! Variables - call check( nf90_def_var(nc%id, nc%name_varname, NF90_CHAR, [nc%str_dimid, nc%id_dimid], nc%name_varid), "symba_io_encounter_initialize_output nf90_def_var name_varid" ) - call check( nf90_def_var(nc%id, nc%ptype_varname, NF90_CHAR, [nc%str_dimid, nc%id_dimid], nc%ptype_varid), "symba_io_encounter_initialize_output nf90_def_var ptype_varid" ) - call check( nf90_def_var(nc%id, nc%rh_varname, nc%out_type, [nc%space_dimid, nc%id_dimid, nc%time_dimid], nc%rh_varid), "symba_io_encounter_initialize_output nf90_def_var rh_varid" ) - call check( nf90_def_var(nc%id, nc%vh_varname, nc%out_type, [nc%space_dimid, nc%id_dimid, nc%time_dimid], nc%vh_varid), "symba_io_encounter_initialize_output nf90_def_var vh_varid" ) - call check( nf90_def_var(nc%id, nc%Gmass_varname, nc%out_type, [nc%id_dimid, nc%time_dimid], nc%Gmass_varid), "symba_io_encounter_initialize_output nf90_def_var Gmass_varid" ) - call check( nf90_def_var(nc%id, nc%level_varname, NF90_INT, [nc%id_dimid, nc%time_dimid], nc%level_varid), "symba_io_encounter_initialize_output nf90_def_var level_varid" ) - if (param%lclose) then - call check( nf90_def_var(nc%id, nc%radius_varname, nc%out_type, [nc%id_dimid, nc%time_dimid], nc%radius_varid), "symba_io_encounter_initialize_output nf90_def_var radius_varid" ) - end if - if (param%lrotation) then - call check( nf90_def_var(nc%id, nc%Ip_varname, nc%out_type, [nc%space_dimid, nc%id_dimid, nc%time_dimid], nc%Ip_varid), "symba_io_encounter_initialize_output nf90_def_var Ip_varid" ) - call check( nf90_def_var(nc%id, nc%rot_varname, nc%out_type, [nc%space_dimid, nc%id_dimid, nc%time_dimid], nc%rot_varid), "symba_io_encounter_initialize_output nf90_def_var rot_varid" ) - end if - - call check( nf90_inquire(nc%id, nVariables=nvar), "symba_io_encounter_initialize_output nf90_inquire nVariables" ) - do varid = 1, nvar - call check( nf90_inquire_variable(nc%id, varid, xtype=vartype, ndims=ndims), "symba_io_encounter_initialize_output nf90_inquire_variable" ) - select case(vartype) - case(NF90_INT) - call check( nf90_def_var_fill(nc%id, varid, 0, NF90_FILL_INT), "symba_io_encounter_initialize_output nf90_def_var_fill NF90_INT" ) - case(NF90_FLOAT) - call check( nf90_def_var_fill(nc%id, varid, 0, sfill), "symba_io_encounter_initialize_output nf90_def_var_fill NF90_FLOAT" ) - case(NF90_DOUBLE) - call check( nf90_def_var_fill(nc%id, varid, 0, dfill), "symba_io_encounter_initialize_output nf90_def_var_fill NF90_DOUBLE" ) - case(NF90_CHAR) - call check( nf90_def_var_fill(nc%id, varid, 0, 0), "symba_io_encounter_initialize_output nf90_def_var_fill NF90_CHAR" ) - end select - end do - - ! Take the file out of define mode - call check( nf90_enddef(nc%id), "symba_io_encounter_initialize_output nf90_enddef" ) - - ! Add in the space dimension coordinates - call check( nf90_put_var(nc%id, nc%space_varid, nc%space_coords, start=[1], count=[NDIM]), "symba_io_encounter_initialize_output nf90_put_var space" ) - end associate - - return - - 667 continue - write(*,*) "Error creating encounter output file. " // trim(adjustl(errmsg)) - call util_exit(FAILURE) - end subroutine symba_io_encounter_initialize_output - - - module subroutine symba_io_encounter_write_frame(self, nc, param) - !! author: David A. Minton - !! - !! Write a frame of output of an encounter trajectory. - use netcdf - implicit none - ! Arguments - class(symba_encounter_snapshot), intent(in) :: self !! Swiftest encounter structure - class(symba_io_encounter_parameters), intent(inout) :: nc !! Parameters used to identify a particular encounter io NetCDF dataset - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - ! Internals - integer(I4B) :: i, tslot, idslot, old_mode, npl, ntp - character(len=NAMELEN) :: charstring - - call check( nf90_set_fill(nc%id, nf90_nofill, old_mode), "symba_io_encounter_write_frame nf90_set_fill" ) - - tslot = self%tslot - call check( nf90_put_var(nc%id, nc%time_varid, self%t, start=[tslot]), "symba_io_encounter_write_frame nf90_put_var time_varid" ) - - associate(pl => self%pl, tp => self%tp) - npl = pl%nbody - do i = 1, npl - idslot = pl%id(i) - call check( nf90_put_var(nc%id, nc%id_varid, pl%id(i), start=[idslot]), "symba_io_encounter_write_frame nf90_put_var pl id_varid" ) - call check( nf90_put_var(nc%id, nc%rh_varid, pl%rh(:,i), start=[1,idslot,tslot], count=[NDIM,1,1]), "symba_io_encounter_write_frame nf90_put_var pl rh_varid" ) - call check( nf90_put_var(nc%id, nc%vh_varid, pl%vh(:,i), start=[1,idslot,tslot], count=[NDIM,1,1]), "symba_io_encounter_write_frame nf90_put_var pl vh_varid" ) - call check( nf90_put_var(nc%id, nc%Gmass_varid, pl%Gmass(i), start=[idslot, tslot]), "symba_io_encounter_write_frame nf90_put_var pl Gmass_varid" ) - call check( nf90_put_var(nc%id, nc%level_varid, pl%levelg(i), start=[idslot, tslot]), "symba_io_encounter_write_frame nf90_put_var pl level_varid" ) - - if (param%lclose) call check( nf90_put_var(nc%id, nc%radius_varid, pl%radius(i), start=[idslot, tslot]), "symba_io_encounter_write_frame nf90_put_var pl radius_varid" ) - - if (param%lrotation) then - call check( nf90_put_var(nc%id, nc%Ip_varid, pl%Ip(:,i), start=[1, idslot, tslot], count=[NDIM,1,1]), "symba_io_encounter_write_frame nf90_put_var pl Ip_varid" ) - call check( nf90_put_var(nc%id, nc%rot_varid, pl%rot(:,i), start=[1,idslot, tslot], count=[NDIM,1,1]), "symba_io_encounter_write_frame nf90_put_var pl rotx_varid" ) - end if - - charstring = trim(adjustl(pl%info(i)%name)) - call check( nf90_put_var(nc%id, nc%name_varid, charstring, start=[1, idslot], count=[NAMELEN, 1]), "symba_io_encounter_write_frame nf90_put_var pl name_varid" ) - charstring = trim(adjustl(pl%info(i)%particle_type)) - call check( nf90_put_var(nc%id, nc%ptype_varid, charstring, start=[1, idslot], count=[NAMELEN, 1]), "symba_io_encounter_write_frame nf90_put_var pl particle_type_varid" ) - end do - - ntp = tp%nbody - do i = 1, ntp - idslot = tp%id(i) - call check( nf90_put_var(nc%id, nc%id_varid, tp%id(i), start=[idslot]), "symba_io_encounter_write_frame nf90_put_var tp id_varid" ) - call check( nf90_put_var(nc%id, nc%rh_varid, tp%rh(:,i), start=[1,idslot,tslot], count=[NDIM,1,1]), "symba_io_encounter_write_frame nf90_put_var tp rh_varid" ) - call check( nf90_put_var(nc%id, nc%vh_varid, tp%vh(:,i), start=[1,idslot,tslot], count=[NDIM,1,1]), "symba_io_encounter_write_frame nf90_put_var tp vh_varid" ) - - charstring = trim(adjustl(tp%info(i)%name)) - call check( nf90_put_var(nc%id, nc%name_varid, charstring, start=[1, idslot], count=[NAMELEN, 1]), "symba_io_encounter_write_frame nf90_put_var tp name_varid" ) - charstring = trim(adjustl(tp%info(i)%particle_type)) - call check( nf90_put_var(nc%id, nc%ptype_varid, charstring, start=[1, idslot], count=[NAMELEN, 1]), "symba_io_encounter_write_frame nf90_put_var tp particle_type_varid" ) - end do - end associate - - call check( nf90_set_fill(nc%id, old_mode, old_mode) ) - - return - end subroutine symba_io_encounter_write_frame - - module subroutine symba_io_param_reader(self, unit, iotype, v_list, iostat, iomsg) !! author: The Purdue Swiftest Team - David A. Minton, Carlisle A. Wishard, Jennifer L.L. Pouplin, and Jacob R. Elliott !! @@ -385,14 +199,10 @@ module subroutine symba_io_start_encounter(self, param, t) real(DP), intent(in) :: t !! Current simulation time if (.not. allocated(self%encounter_history)) then - allocate(symba_encounter_storage :: self%encounter_history) - allocate(symba_io_encounter_parameters :: self%encounter_history%nc) + allocate(encounter_storage :: self%encounter_history) end if call self%encounter_history%reset() - ! Empty out the time slot array for the next pass - self%encounter_history%tvals(:) = huge(1.0_DP) - ! Take the snapshot at the start of the encounter call self%snapshot(param, t) @@ -414,13 +224,7 @@ module subroutine symba_io_stop_encounter(self, param, t) ! Create and save the output file for this encounter - ! Figure out how many time slots we need - do i = 1, self%encounter_history%nframes - if (self%t + param%dt <= self%encounter_history%tvals(i)) then - self%encounter_history%nc%time_dimsize = i - exit - end if - end do + self%encounter_history%nc%time_dimsize = maxval(self%encounter_history%tslot(:)) write(self%encounter_history%nc%enc_file, '("encounter_",I0.6,".nc")') param%iloop diff --git a/src/symba/symba_util.f90 b/src/symba/symba_util.f90 index b66fe7ed1..d53bd442b 100644 --- a/src/symba/symba_util.f90 +++ b/src/symba/symba_util.f90 @@ -238,43 +238,6 @@ module subroutine symba_util_dealloc_merger(self) end subroutine symba_util_dealloc_merger - module subroutine symba_util_dealloc_snapshot(self) - !! author: David A. Minton - !! - !! Deallocates allocatable arrays in an encounter snapshot - implicit none - ! Arguments - class(symba_encounter_snapshot), intent(inout) :: self !! SyMBA nbody system object - - - call self%pl%dealloc() - call self%tp%dealloc() - self%t = 0.0_DP - self%tslot = 0 - - return - end subroutine symba_util_dealloc_snapshot - - - module subroutine symba_util_dealloc_system(self) - !! author: David A. Minton - !! - !! Deallocates all allocatabale arrays in a SyMBA system object - implicit none - ! Arguments - class(symba_nbody_system), intent(inout) :: self !! SyMBA nbody system object - - if (allocated(self%pl_adds)) deallocate(self%pl_adds) - if (allocated(self%pltpenc_list)) deallocate(self%pltpenc_list) - if (allocated(self%plplenc_list)) deallocate(self%plplenc_list) - if (allocated(self%plplcollision_list)) deallocate(self%plplcollision_list) - - call util_dealloc_system(self) - - return - end subroutine symba_util_dealloc_system - - module subroutine symba_util_dealloc_pl(self) !! author: David A. Minton !! @@ -489,6 +452,7 @@ module subroutine symba_util_final_merger(self) return end subroutine symba_util_final_merger + module subroutine symba_util_final_pl(self) !! author: David A. Minton !! @@ -511,34 +475,15 @@ module subroutine symba_util_final_system(self) ! Argument type(symba_nbody_system), intent(inout) :: self !! SyMBA nbody system object - call self%dealloc() - - return - end subroutine symba_util_final_system - - module subroutine symba_util_final_encounter_snapshot(self) - !! author: David A. Minton - !! - !! Finalize the SyMBA encounter system snapshot object - deallocates all allocatables - implicit none - type(symba_encounter_snapshot), intent(inout) :: self !! SyMBA nbody system object - - call self%dealloc() - - return - end subroutine symba_util_final_encounter_snapshot - + if (allocated(self%pl_adds)) deallocate(self%pl_adds) + if (allocated(self%pltpenc_list)) deallocate(self%pltpenc_list) + if (allocated(self%plplenc_list)) deallocate(self%plplenc_list) + if (allocated(self%plplcollision_list)) deallocate(self%plplcollision_list) - module subroutine symba_util_final_encounter_storage(self) - !! author: David A. Minton - !! - !! Finalize the SyMBA nbody system object - deallocates all allocatables - implicit none - ! Argument - type(symba_encounter_storage(*)), intent(inout) :: self !! SyMBA nbody system object + call helio_util_final_system(self%helio_nbody_system) return - end subroutine symba_util_final_encounter_storage + end subroutine symba_util_final_system module subroutine symba_util_final_tp(self) @@ -924,7 +869,7 @@ module subroutine symba_util_resize_pl(self, nnew) end subroutine symba_util_resize_pl - module subroutine symba_util_resize_storage(self, nnew) + subroutine symba_util_save_storage(system, snapshot, t) !! 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. @@ -933,43 +878,53 @@ module subroutine symba_util_resize_storage(self, nnew) !! 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 + type(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object + class(encounter_snapshot), intent(in) :: snapshot !! Encounter snapshot object + real(DP), intent(in) :: t !! The time of the snapshot ! Internals - type(symba_encounter_storage(nframes=:)), allocatable :: tmp - integer(I4B) :: i, nold, nbig, iframe_old = 0 - logical :: lmalloc + type(encounter_storage(nframes=:)), allocatable :: tmp + integer(I4B) :: i, nnew, nold, nbig + ! Advance the snapshot frame counter + system%encounter_history%iframe = system%encounter_history%iframe + 1 - lmalloc = allocated(self%encounter_history) - if (lmalloc) then - nold = self%encounter_history%nframes - iframe_old = self%encounter_history%iframe - else - nold = 0 - end if + ! Check to make sure the current encounter_history object is big enough. If not, grow it by a factor of 2 + nnew = system%encounter_history%iframe + nold = system%encounter_history%nframes if (nnew > nold) then nbig = nold do while (nbig < nnew) nbig = nbig * 2 end do - allocate(symba_encounter_storage(nbig) :: tmp) - call move_alloc(self%encounter_history%nc, tmp%nc) - tmp%tvals(1:nold) = self%encounter_history%tvals(1:nold) + allocate(encounter_storage(nbig) :: tmp) + tmp%tvals(1:nold) = system%encounter_history%tvals(1:nold) tmp%tvals(nold+1:nbig) = huge(1.0_DP) - if (lmalloc) then - do i = 1, nold - if (allocated(self%encounter_history%frame(i)%item)) call move_alloc(self%encounter_history%frame(i)%item, tmp%frame(i)%item) - end do - deallocate(self%encounter_history) - end if - call move_alloc(tmp,self%encounter_history) - self%encounter_history%iframe = iframe_old + tmp%tslot(1:nold) = system%encounter_history%tslot(1:nold) + tmp%tslot(nold+1:nbig) = 0 + tmp%iframe = system%encounter_history%iframe + + do i = 1, nold + if (allocated(system%encounter_history%frame(i)%item)) call move_alloc(system%encounter_history%frame(i)%item, tmp%frame(i)%item) + end do + deallocate(system%encounter_history) + call move_alloc(tmp,system%encounter_history) + nnew = nbig end if + ! Find out which time slot this belongs in by searching for an existing slot + ! with the same value of time or the first available one + do i = 1, nnew + if (t <= system%encounter_history%tvals(i)) then + system%encounter_history%tvals(i) = t + system%encounter_history%tslot(nnew) = i + system%encounter_history%frame(nnew) = snapshot + exit + end if + end do + return - end subroutine symba_util_resize_storage + end subroutine symba_util_save_storage module subroutine symba_util_resize_tp(self, nnew) @@ -1338,10 +1293,10 @@ module subroutine symba_util_take_encounter_snapshot(self, param, t) implicit none ! Internals class(symba_nbody_system), intent(inout) :: self !! SyMBA nbody system object - class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters - real(DP), intent(in) :: t !! current time + class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters + real(DP), intent(in) :: t !! current time ! Arguments - type(symba_encounter_snapshot) :: snapshot + type(encounter_snapshot) :: snapshot integer(I4B) :: i, npl_snap, ntp_snap associate(npl => self%pl%nbody, ntp => self%tp%nbody) @@ -1356,81 +1311,79 @@ module subroutine symba_util_take_encounter_snapshot(self, param, t) class is (symba_pl) select type (tp => self%tp) class is (symba_tp) - if (npl > 0) then - pl%lmask(1:npl) = pl%status(1:npl) /= INACTIVE .and. pl%levelg(1:npl) == self%irec - npl_snap = count(pl%lmask(1:npl)) - end if - if (ntp > 0) then - tp%lmask(1:ntp) = tp%status(1:ntp) /= INACTIVE .and. tp%levelg(1:ntp) == self%irec - ntp_snap = count(tp%lmask(1:ntp)) - end if - snapshot%pl%nbody = npl_snap - - ! Take snapshot of the currently encountering massive bodies - if (npl_snap > 0) then - allocate(snapshot%pl%id(npl_snap)) - allocate(snapshot%pl%info(npl_snap)) - allocate(snapshot%pl%Gmass(npl_snap)) - allocate(snapshot%pl%levelg(npl_snap)) - snapshot%pl%levelg(:) = pack(pl%levelg(1:npl), pl%lmask(1:npl)) - snapshot%pl%id(:) = pack(pl%id(1:npl), pl%lmask(1:npl)) - snapshot%pl%info(:) = pack(pl%info(1:npl), pl%lmask(1:npl)) - snapshot%pl%Gmass(:) = pack(pl%Gmass(1:npl), pl%lmask(1:npl)) - allocate(snapshot%pl%rh(NDIM,npl_snap)) - allocate(snapshot%pl%vh(NDIM,npl_snap)) - do i = 1, NDIM - snapshot%pl%rh(i,:) = pack(pl%rh(i,1:npl), pl%lmask(1:npl)) - snapshot%pl%vh(i,:) = pack(pl%vb(i,1:npl), pl%lmask(1:npl)) - end do - if (param%lclose) then - allocate(snapshot%pl%radius(npl_snap)) - snapshot%pl%radius(:) = pack(pl%radius(1:npl), pl%lmask(1:npl)) - end if + allocate(symba_pl :: snapshot%pl) + allocate(symba_tp :: snapshot%tp) - if (param%lrotation) then - allocate(snapshot%pl%Ip(NDIM,npl_snap)) - allocate(snapshot%pl%rot(NDIM,npl_snap)) - do i = 1, NDIM - snapshot%pl%Ip(i,:) = pack(pl%Ip(i,1:npl), pl%lmask(1:npl)) - snapshot%pl%rot(i,:) = pack(pl%rot(i,1:npl), pl%lmask(1:npl)) - end do - end if - call snapshot%pl%sort("id", ascending=.true.) - end if + select type(pl_snap => snapshot%pl) + class is (symba_pl) + select type(tp_snap => snapshot%tp) + class is (symba_tp) - ! Take snapshot of the currently encountering test particles - snapshot%tp%nbody = ntp_snap - if (ntp_snap > 0) then - allocate(snapshot%tp%id(ntp_snap)) - allocate(snapshot%tp%info(ntp_snap)) - snapshot%tp%id(:) = pack(tp%id(1:ntp), tp%lmask(1:ntp)) - snapshot%tp%info(:) = pack(tp%info(1:ntp), tp%lmask(1:ntp)) - allocate(snapshot%tp%rh(NDIM,ntp_snap)) - allocate(snapshot%tp%vh(NDIM,ntp_snap)) - do i = 1, NDIM - snapshot%tp%rh(i,:) = pack(tp%rh(i,1:ntp), tp%lmask(1:ntp)) - snapshot%tp%vh(i,:) = pack(tp%vh(i,1:ntp), tp%lmask(1:ntp)) - end do - end if + if (npl > 0) then + pl%lmask(1:npl) = pl%status(1:npl) /= INACTIVE .and. pl%levelg(1:npl) == self%irec + npl_snap = count(pl%lmask(1:npl)) + end if + if (ntp > 0) then + tp%lmask(1:ntp) = tp%status(1:ntp) /= INACTIVE .and. tp%levelg(1:ntp) == self%irec + ntp_snap = count(tp%lmask(1:ntp)) + end if + pl_snap%nbody = npl_snap + + ! Take snapshot of the currently encountering massive bodies + if (npl_snap > 0) then + allocate(pl_snap%id(npl_snap)) + allocate(pl_snap%info(npl_snap)) + allocate(pl_snap%Gmass(npl_snap)) + + allocate(pl_snap%levelg(npl_snap)) + pl_snap%levelg(:) = pack(pl%levelg(1:npl), pl%lmask(1:npl)) + pl_snap%id(:) = pack(pl%id(1:npl), pl%lmask(1:npl)) + pl_snap%info(:) = pack(pl%info(1:npl), pl%lmask(1:npl)) + pl_snap%Gmass(:) = pack(pl%Gmass(1:npl), pl%lmask(1:npl)) + allocate(pl_snap%rh(NDIM,npl_snap)) + allocate(pl_snap%vh(NDIM,npl_snap)) + do i = 1, NDIM + pl_snap%rh(i,:) = pack(pl%rh(i,1:npl), pl%lmask(1:npl)) + pl_snap%vh(i,:) = pack(pl%vb(i,1:npl), pl%lmask(1:npl)) + end do + if (param%lclose) then + allocate(pl_snap%radius(npl_snap)) + pl_snap%radius(:) = pack(pl%radius(1:npl), pl%lmask(1:npl)) + end if - ! Save the snapshot + if (param%lrotation) then + allocate(pl_snap%Ip(NDIM,npl_snap)) + allocate(pl_snap%rot(NDIM,npl_snap)) + do i = 1, NDIM + pl_snap%Ip(i,:) = pack(pl%Ip(i,1:npl), pl%lmask(1:npl)) + pl_snap%rot(i,:) = pack(pl%rot(i,1:npl), pl%lmask(1:npl)) + end do + end if + call pl_snap%sort("id", ascending=.true.) + end if + + ! Take snapshot of the currently encountering test particles + tp_snap%nbody = ntp_snap + if (ntp_snap > 0) then + allocate(tp_snap%id(ntp_snap)) + allocate(tp_snap%info(ntp_snap)) + tp_snap%id(:) = pack(tp%id(1:ntp), tp%lmask(1:ntp)) + tp_snap%info(:) = pack(tp%info(1:ntp), tp%lmask(1:ntp)) + allocate(tp_snap%rh(NDIM,ntp_snap)) + allocate(tp_snap%vh(NDIM,ntp_snap)) + do i = 1, NDIM + tp_snap%rh(i,:) = pack(tp%rh(i,1:ntp), tp%lmask(1:ntp)) + tp_snap%vh(i,:) = pack(tp%vh(i,1:ntp), tp%lmask(1:ntp)) + end do + end if + end select + end select - ! Find out which time slot this belongs in by searching for an existing slot - ! with the same value of time or the first available one - do i = 1, self%encounter_history%nframes - if (t <= self%encounter_history%tvals(i)) then - snapshot%tslot = i - self%encounter_history%tvals(i) = t - self%encounter_history%iframe = i - call self%resize_storage(i) - exit - end if - end do - - self%encounter_history%frame(self%encounter_history%iframe) = snapshot + ! Save the snapshot + call symba_util_save_storage(self,snapshot,t) end select - end select + end select end associate return diff --git a/src/util/util_dealloc.f90 b/src/util/util_dealloc.f90 index b3fb38fd9..54151f567 100644 --- a/src/util/util_dealloc.f90 +++ b/src/util/util_dealloc.f90 @@ -72,25 +72,6 @@ module subroutine util_dealloc_pl(self) return end subroutine util_dealloc_pl - - module subroutine util_dealloc_system(self) - !! author: David A. Minton - !! - !! Finalize the swiftest nbody system object - deallocates all allocatables - implicit none - ! Argument - class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nbody system object - - if (allocated(self%cb)) deallocate(self%cb) - if (allocated(self%pl)) deallocate(self%pl) - if (allocated(self%tp)) deallocate(self%tp) - if (allocated(self%tp_discards)) deallocate(self%tp_discards) - if (allocated(self%pl_discards)) deallocate(self%pl_discards) - - return - end subroutine util_dealloc_system - - module subroutine util_dealloc_tp(self) !! author: David A. Minton !! diff --git a/src/util/util_final.f90 b/src/util/util_final.f90 new file mode 100644 index 000000000..4f4a6dd28 --- /dev/null +++ b/src/util/util_final.f90 @@ -0,0 +1,62 @@ +!! Copyright 2022 - David Minton, Carlisle Wishard, Jennifer Pouplin, Jake Elliott, & Dana Singh +!! This file is part of Swiftest. +!! Swiftest is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License +!! as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. +!! Swiftest is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty +!! of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. +!! You should have received a copy of the GNU General Public License along with Swiftest. +!! If not, see: https://www.gnu.org/licenses. + +submodule (swiftest_classes) s_util_final + use swiftest +contains + + module subroutine util_final_storage(self) + !! author: David A. Minton + !! + !! Finalizer for the storage data type + implicit none + ! Arguments + type(swiftest_storage(*)) :: self + ! Internals + integer(I4B) :: i + + do i = 1, self%nframes + if (allocated(self%frame(i)%item)) deallocate(self%frame(i)%item) + end do + + return + end subroutine util_final_storage + + module subroutine util_final_storage_frame(self) + !! author: David A. Minton + !! + !! Finalizer for the storage frame data type + implicit none + type(swiftest_storage_frame) :: self + + if (allocated(self%item)) deallocate(self%item) + + return + end subroutine util_final_storage_frame + + + module subroutine util_final_system(self) + !! author: David A. Minton + !! + !! Finalize the swiftest nbody system object - deallocates all allocatables + implicit none + ! Argument + class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nbody system object + + if (allocated(self%cb)) deallocate(self%cb) + if (allocated(self%pl)) deallocate(self%pl) + if (allocated(self%tp)) deallocate(self%tp) + if (allocated(self%tp_discards)) deallocate(self%tp_discards) + if (allocated(self%pl_discards)) deallocate(self%pl_discards) + + return + end subroutine util_final_system + + +end submodule s_util_final diff --git a/src/util/util_reset.f90 b/src/util/util_reset.f90 index 569846a68..7bb8d5ee3 100644 --- a/src/util/util_reset.f90 +++ b/src/util/util_reset.f90 @@ -24,6 +24,8 @@ module subroutine util_reset_storage(self) do i = 1, self%nframes if (allocated(self%frame(i)%item)) deallocate(self%frame(i)%item) end do + self%tslot(:) = 0 + self%tvals(:) = huge(1.0_DP) self%iframe = 0 return diff --git a/src/whm/whm_util.f90 b/src/whm/whm_util.f90 index 9c6efdd41..c58f5730f 100644 --- a/src/whm/whm_util.f90 +++ b/src/whm/whm_util.f90 @@ -117,7 +117,7 @@ module subroutine whm_util_final_system(self) ! Arguments type(whm_nbody_system), intent(inout) :: self !! WHM nbody system object - call self%dealloc() + call util_final_system(self) return end subroutine whm_util_final_system From 0f412239001189a7f98799ba75b46724e06833af Mon Sep 17 00:00:00 2001 From: David A Minton Date: Thu, 8 Dec 2022 16:52:31 -0500 Subject: [PATCH 342/569] Fixed the code so that it only outputs encounter data on the dump steps --- python/swiftest/swiftest/io.py | 6 +- python/swiftest/swiftest/simulation_class.py | 5 ++ src/encounter/encounter_io.f90 | 17 ++--- src/io/io.f90 | 11 +++ src/main/swiftest_driver.f90 | 4 +- src/modules/encounter_classes.f90 | 21 +++--- src/modules/symba_classes.f90 | 15 +--- src/setup/setup.f90 | 8 +++ src/symba/symba_io.f90 | 73 +++++++------------- src/symba/symba_step.f90 | 4 +- src/symba/symba_util.f90 | 1 + 11 files changed, 79 insertions(+), 86 deletions(-) diff --git a/python/swiftest/swiftest/io.py b/python/swiftest/swiftest/io.py index a4f370773..f33535327 100644 --- a/python/swiftest/swiftest/io.py +++ b/python/swiftest/swiftest/io.py @@ -64,7 +64,7 @@ # 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"] +int_varnames = ["id", "ntp", "npl", "nplm", "discard_body_id", "collision_id", "loopnum"] def bool2yesno(boolval): """ @@ -816,8 +816,8 @@ def process_netcdf_input(ds, param): ------- ds : xarray dataset """ - - ds = ds.where(~np.isnan(ds.id) ,drop=True) + # + ds = ds.where(ds.id >=0,drop=True) if param['OUT_TYPE'] == "NETCDF_DOUBLE": ds = fix_types(ds,ftype=np.float64) elif param['OUT_TYPE'] == "NETCDF_FLOAT": diff --git a/python/swiftest/swiftest/simulation_class.py b/python/swiftest/swiftest/simulation_class.py index 9b9bd02dc..8fb77ab4a 100644 --- a/python/swiftest/swiftest/simulation_class.py +++ b/python/swiftest/swiftest/simulation_class.py @@ -2780,6 +2780,11 @@ def _preprocess(ds, param): tgood,tid = np.unique(self.enc.time,return_index=True) self.enc = self.enc.isel(time=tid) + # Reduce the dimensionality of variables that got expanded in the combine process + self.enc['loopnum'] = self.enc['loopnum'].max(dim="name") + self.enc['id'] = self.enc['id'].max(dim="time") + self.enc['particle_type'] = self.enc['particle_type'].max(dim="time") + return diff --git a/src/encounter/encounter_io.f90 b/src/encounter/encounter_io.f90 index 0cc07b009..67020fb13 100644 --- a/src/encounter/encounter_io.f90 +++ b/src/encounter/encounter_io.f90 @@ -53,7 +53,7 @@ module subroutine encounter_io_initialize(self, param) 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 - integer(I4B) :: nvar, varid, vartype + integer(I4B) :: i, nvar, varid, vartype real(DP) :: dfill real(SP) :: sfill logical :: fileExists @@ -97,7 +97,7 @@ module subroutine encounter_io_initialize(self, param) call check( nf90_def_var(nc%id, nc%rh_varname, nc%out_type, [nc%space_dimid, nc%id_dimid, nc%time_dimid], nc%rh_varid), "encounter_io_initialize nf90_def_var rh_varid" ) call check( nf90_def_var(nc%id, nc%vh_varname, nc%out_type, [nc%space_dimid, nc%id_dimid, nc%time_dimid], nc%vh_varid), "encounter_io_initialize nf90_def_var vh_varid" ) call check( nf90_def_var(nc%id, nc%Gmass_varname, nc%out_type, [nc%id_dimid, nc%time_dimid], nc%Gmass_varid), "encounter_io_initialize nf90_def_var Gmass_varid" ) - call check( nf90_def_var(nc%id, nc%level_varname, NF90_INT, [nc%id_dimid, nc%time_dimid], nc%level_varid), "encounter_io_initialize nf90_def_var level_varid" ) + call check( nf90_def_var(nc%id, nc%loop_varname, NF90_INT, [nc%time_dimid], nc%loop_varid), "encounter_io_initialize nf90_def_var loop_varid" ) if (param%lclose) then call check( nf90_def_var(nc%id, nc%radius_varname, nc%out_type, [nc%id_dimid, nc%time_dimid], nc%radius_varid), "encounter_io_initialize nf90_def_var radius_varid" ) end if @@ -126,6 +126,10 @@ module subroutine encounter_io_initialize(self, param) ! Add in the space dimension coordinates call check( nf90_put_var(nc%id, nc%space_varid, nc%space_coords, start=[1], count=[NDIM]), "encounter_io_initialize nf90_put_var space" ) + + ! Pre-fill id slots with ids + + call check( nf90_put_var(nc%id, nc%id_varid, [(-1,i=1,param%maxid)], start=[1], count=[param%maxid]), "encounter_io_initialize nf90_put_var pl id_varid" ) end associate return @@ -145,7 +149,7 @@ module subroutine encounter_io_write_frame(self, nc, param) ! Arguments class(encounter_snapshot), intent(in) :: self !! Swiftest encounter structure class(encounter_io_parameters), intent(inout) :: nc !! Parameters used to identify a particular encounter io NetCDF dataset - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters ! Internals integer(I4B) :: i, tslot, idslot, old_mode, npl, ntp character(len=NAMELEN) :: charstring @@ -155,19 +159,16 @@ module subroutine encounter_io_write_frame(self, nc, param) call check( nf90_set_fill(nc%id, nf90_nofill, old_mode), "encounter_io_write_frame nf90_set_fill" ) call check( nf90_put_var(nc%id, nc%time_varid, self%t, start=[tslot]), "encounter_io_write_frame nf90_put_var time_varid" ) + call check( nf90_put_var(nc%id, nc%loop_varid, int(self%iloop,kind=I4B), start=[tslot]), "encounter_io_write_frame nf90_put_var pl loop_varid" ) associate(pl => self%pl, tp => self%tp) npl = pl%nbody do i = 1, npl idslot = pl%id(i) - call check( nf90_put_var(nc%id, nc%id_varid, pl%id(i), start=[idslot]), "encounter_io_write_frame nf90_put_var pl id_varid" ) + call check( nf90_put_var(nc%id, nc%id_varid, pl%id(i), start=[idslot]), "encounter_io_write_frame nf90_put_var pl id_varid" ) call check( nf90_put_var(nc%id, nc%rh_varid, pl%rh(:,i), start=[1,idslot,tslot], count=[NDIM,1,1]), "encounter_io_write_frame nf90_put_var pl rh_varid" ) call check( nf90_put_var(nc%id, nc%vh_varid, pl%vh(:,i), start=[1,idslot,tslot], count=[NDIM,1,1]), "encounter_io_write_frame nf90_put_var pl vh_varid" ) call check( nf90_put_var(nc%id, nc%Gmass_varid, pl%Gmass(i), start=[idslot, tslot]), "encounter_io_write_frame nf90_put_var pl Gmass_varid" ) - select type(pl) - class is (symba_pl) - call check( nf90_put_var(nc%id, nc%level_varid, pl%levelg(i), start=[idslot, tslot]), "encounter_io_write_frame nf90_put_var pl level_varid" ) - end select if (param%lclose) call check( nf90_put_var(nc%id, nc%radius_varid, pl%radius(i), start=[idslot, tslot]), "encounter_io_write_frame nf90_put_var pl radius_varid" ) diff --git a/src/io/io.f90 b/src/io/io.f90 index d14f0a694..f0c1cb994 100644 --- a/src/io/io.f90 +++ b/src/io/io.f90 @@ -264,6 +264,17 @@ module subroutine io_dump_system(self, param) idx = idx + 1 if (idx > NDUMPFILES) idx = 1 + ! Dump the encounter history if necessary + select type(param) + class is (symba_parameters) + if (param%lencounter_save) then + select type(self) + class is (symba_nbody_system) + call self%dump_encounter(param) + end select + end if + end select + return end subroutine io_dump_system diff --git a/src/main/swiftest_driver.f90 b/src/main/swiftest_driver.f90 index 6d5abce79..56ceafd9f 100644 --- a/src/main/swiftest_driver.f90 +++ b/src/main/swiftest_driver.f90 @@ -51,6 +51,8 @@ program swiftest_driver end select param%integrator = trim(adjustl(integrator)) call param%set_display(display_style) + call param%read_in(param_file_name) + call setup_construct_system(nbody_system, param) !> Define the maximum number of threads nthreads = 1 ! In the *serial* case @@ -60,8 +62,6 @@ program swiftest_driver !$ write(param%display_unit,'(a,i3,/)') ' Number of threads = ', nthreads !$ if (param%log_output) write(*,'(a,i3)') ' OpenMP: Number of threads = ',nthreads - call setup_construct_system(nbody_system, param) - call param%read_in(param_file_name) associate(t => nbody_system%t, & t0 => param%t0, & diff --git a/src/modules/encounter_classes.f90 b/src/modules/encounter_classes.f90 index c7edc5e8a..ad73dc4ad 100644 --- a/src/modules/encounter_classes.f90 +++ b/src/modules/encounter_classes.f90 @@ -43,9 +43,10 @@ module encounter_classes type :: encounter_snapshot !! A simplified version of a SyMBA nbody system object for storing minimal snapshots of the system state during encounters - class(swiftest_pl), allocatable :: pl !! Massive body data structure - class(swiftest_tp), allocatable :: tp !! Test particle data structure - real(DP) :: t !! Simulation time when snapshot was taken + class(swiftest_pl), allocatable :: pl !! Massive body data structure + class(swiftest_tp), allocatable :: tp !! Test particle data structure + real(DP) :: t !! Simulation time when snapshot was taken + integer(I8B) :: iloop !! Loop number at time of snapshot contains procedure :: write_frame => encounter_io_write_frame !! Writes a frame of encounter data to file final :: encounter_util_final_snapshot @@ -53,19 +54,19 @@ module encounter_classes !> NetCDF dimension and variable names for the enounter save object type, extends(netcdf_parameters) :: encounter_io_parameters - integer(I4B) :: ienc_frame = 1 !! Current frame number for the encounter history - character(STRMAX) :: enc_file !! Encounter output file name - character(NAMELEN) :: level_varname = "level" !! Recursion depth - integer(I4B) :: level_varid !! ID for the recursion level variable - integer(I4B) :: time_dimsize = 0 !! Number of time values in snapshot - integer(I4B) :: id_dimsize = 0 !! Number of potential id values in snapshot + integer(I4B) :: ienc_frame = 1 !! Current frame number for the encounter history + character(STRMAX) :: enc_file !! Encounter output file name + character(NAMELEN) :: loop_varname = "loopnum" !! Loop number for encounter + integer(I4B) :: loop_varid !! ID for the recursion level variable + integer(I4B) :: time_dimsize = 0 !! Number of time values in snapshot + integer(I4B) :: id_dimsize = 0 !! Number of potential id values in snapshot contains procedure :: initialize => encounter_io_initialize !! Initialize a set of parameters used to identify a NetCDF output object end type encounter_io_parameters !> A class that that is used to store simulation history data between file output type, extends(swiftest_storage) :: encounter_storage - type(encounter_io_parameters) :: nc !! NetCDF parameter object containing the details about the file attached to this storage object + type(encounter_io_parameters) :: nc !! NetCDF parameter object containing the details about the file attached to this storage object contains procedure :: dump => encounter_io_dump !! Dumps contents of encounter history to file final :: encounter_util_final_storage diff --git a/src/modules/symba_classes.f90 b/src/modules/symba_classes.f90 index faa1e2e80..4c56ff6f7 100644 --- a/src/modules/symba_classes.f90 +++ b/src/modules/symba_classes.f90 @@ -199,8 +199,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 :: snapshot => symba_util_take_encounter_snapshot !! Take a minimal snapshot of the system through an encounter - procedure :: start_encounter => symba_io_start_encounter !! Initializes the new encounter history - procedure :: stop_encounter => symba_io_stop_encounter !! Saves the encounter and/or fragmentation data to file(s) + procedure :: dump_encounter => symba_io_dump_encounter !! Saves the encounter and/or fragmentation data to file(s) final :: symba_util_final_system !! Finalizes the SyMBA nbody system object - deallocates all allocatables end type symba_nbody_system @@ -409,19 +408,11 @@ module subroutine symba_io_param_writer(self, unit, iotype, v_list, iostat, ioms character(len=*), intent(inout) :: iomsg !! Message to pass if iostat /= 0 end subroutine symba_io_param_writer - module subroutine symba_io_start_encounter(self, param, t) + module subroutine symba_io_dump_encounter(self, param) implicit none class(symba_nbody_system), intent(inout) :: self !! SyMBA nbody system object class(symba_parameters), intent(inout) :: param !! Current run configuration parameters - real(DP), intent(in) :: t !! Current simulation time - end subroutine symba_io_start_encounter - - module subroutine symba_io_stop_encounter(self, param, t) - implicit none - class(symba_nbody_system), intent(inout) :: self !! SyMBA nbody system object - class(symba_parameters), intent(inout) :: param !! Current run configuration parameters - real(DP), intent(in) :: t !! Current simulation time - end subroutine symba_io_stop_encounter + end subroutine symba_io_dump_encounter module subroutine symba_io_write_discard(self, param) use swiftest_classes, only : swiftest_parameters diff --git a/src/setup/setup.f90 b/src/setup/setup.f90 index e95505b9b..4cd5d130a 100644 --- a/src/setup/setup.f90 +++ b/src/setup/setup.f90 @@ -68,6 +68,14 @@ module subroutine setup_construct_system(system, param) allocate(symba_pltpenc :: system%pltpenc_list) allocate(symba_plplenc :: system%plplenc_list) allocate(symba_plplenc :: system%plplcollision_list) + + select type(param) + class is (symba_parameters) + if (param%lencounter_save) then + if (.not. allocated(system%encounter_history)) allocate(encounter_storage :: system%encounter_history) + call system%encounter_history%reset() + end if + end select end select case (RINGMOONS) write(*,*) 'RINGMOONS-SyMBA integrator not yet enabled' diff --git a/src/symba/symba_io.f90 b/src/symba/symba_io.f90 index e790e1685..3dbf4ebbd 100644 --- a/src/symba/symba_io.f90 +++ b/src/symba/symba_io.f90 @@ -11,6 +11,30 @@ use swiftest contains + + module subroutine symba_io_dump_encounter(self, param) + !! author: David A. Minton + !! + !! Saves the encounter and/or fragmentation data to file with the name of the current output interval number attached + implicit none + ! Arguments + class(symba_nbody_system), intent(inout) :: self !! SyMBA nbody system object + class(symba_parameters), intent(inout) :: param !! Current run configuration parameters + + if (self%encounter_history%iframe == 0) return ! No enounters in this interval + + ! Create and save the output file for this encounter + self%encounter_history%nc%time_dimsize = maxval(self%encounter_history%tslot(:)) + write(self%encounter_history%nc%enc_file, '("encounter_",I0.6,".nc")') param%iloop / param%dump_cadence + call self%encounter_history%nc%initialize(param) + call self%encounter_history%dump(param) + call self%encounter_history%nc%close() + call self%encounter_history%reset() + + return + end subroutine symba_io_dump_encounter + + module subroutine symba_io_param_reader(self, unit, iotype, v_list, iostat, iomsg) !! author: The Purdue Swiftest Team - David A. Minton, Carlisle A. Wishard, Jennifer L.L. Pouplin, and Jacob R. Elliott !! @@ -188,55 +212,6 @@ module subroutine symba_io_param_writer(self, unit, iotype, v_list, iostat, ioms end subroutine symba_io_param_writer - module subroutine symba_io_start_encounter(self, param, t) - !! author: David A. Minton - !! - !! Initializes the new encounter and/or fragmentation history - implicit none - ! Arguments - class(symba_nbody_system), intent(inout) :: self !! SyMBA nbody system object - class(symba_parameters), intent(inout) :: param !! Current run configuration parameters - real(DP), intent(in) :: t !! Current simulation time - - if (.not. allocated(self%encounter_history)) then - allocate(encounter_storage :: self%encounter_history) - end if - call self%encounter_history%reset() - - ! Take the snapshot at the start of the encounter - call self%snapshot(param, t) - - return - end subroutine symba_io_start_encounter - - - module subroutine symba_io_stop_encounter(self, param, t) - !! author: David A. Minton - !! - !! Saves the encounter and/or fragmentation data to file(s) - implicit none - ! Arguments - class(symba_nbody_system), intent(inout) :: self !! SyMBA nbody system object - class(symba_parameters), intent(inout) :: param !! Current run configuration parameters - real(DP), intent(in) :: t !! Current simulation time - ! Internals - integer(I4B) :: i - - ! Create and save the output file for this encounter - - self%encounter_history%nc%time_dimsize = maxval(self%encounter_history%tslot(:)) - - write(self%encounter_history%nc%enc_file, '("encounter_",I0.6,".nc")') param%iloop - - call self%encounter_history%nc%initialize(param) - call self%encounter_history%dump(param) - call self%encounter_history%nc%close() - call self%encounter_history%reset() - - return - end subroutine symba_io_stop_encounter - - module subroutine symba_io_write_discard(self, param) !! author: David A. Minton !! diff --git a/src/symba/symba_step.f90 b/src/symba/symba_step.f90 index e727ed9f3..0b8879464 100644 --- a/src/symba/symba_step.f90 +++ b/src/symba/symba_step.f90 @@ -37,9 +37,9 @@ module subroutine symba_step_system(self, param, t, dt) call self%reset(param) lencounter = pl%encounter_check(param, self, dt, 0) .or. tp%encounter_check(param, self, dt, 0) if (lencounter) then - if (param%lencounter_save) call self%start_encounter(param, t) + if (param%lencounter_save) call self%snapshot(param, t) call self%interp(param, t, dt) - if (param%lencounter_save) call self%stop_encounter(param, t+dt) + if (param%lencounter_save) call self%snapshot(param, t+dt) else self%irec = -1 call helio_step_system(self, param, t, dt) diff --git a/src/symba/symba_util.f90 b/src/symba/symba_util.f90 index d53bd442b..c2a837599 100644 --- a/src/symba/symba_util.f90 +++ b/src/symba/symba_util.f90 @@ -1302,6 +1302,7 @@ module subroutine symba_util_take_encounter_snapshot(self, param, t) associate(npl => self%pl%nbody, ntp => self%tp%nbody) snapshot%t = t + snapshot%iloop = param%iloop if (npl + ntp == 0) return npl_snap = npl From d002ece8be89f616170c8e55aa3486c87d6c31c4 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Thu, 8 Dec 2022 17:13:28 -0500 Subject: [PATCH 343/569] Fixed file numbering issue for encounter files --- examples/Fragmentation/Fragmentation_Movie.py | 2 +- src/encounter/encounter_io.f90 | 1 - src/main/swiftest_driver.f90 | 90 ++++++++++--------- src/modules/encounter_classes.f90 | 1 + src/setup/setup.f90 | 1 + src/symba/symba_io.f90 | 4 +- 6 files changed, 52 insertions(+), 47 deletions(-) diff --git a/examples/Fragmentation/Fragmentation_Movie.py b/examples/Fragmentation/Fragmentation_Movie.py index a664ef49e..914f8ed11 100644 --- a/examples/Fragmentation/Fragmentation_Movie.py +++ b/examples/Fragmentation/Fragmentation_Movie.py @@ -203,7 +203,7 @@ def data_stream(self, frame=0): 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, fragmentation_save="TRAJECTORY", gmtiny=gmtiny, minimum_fragment_gmass=minimum_fragment_gmass, verbose=False) - sim.run(dt=1e-4, tstop=1.0e-3, istep_out=1, dump_cadence=0) + sim.run(dt=1e-4, tstop=1.0e-3, istep_out=1, dump_cadence=4) print("Generating animation") anim = AnimatedScatter(sim,movie_filename,movie_titles[style],style,nskip=1) \ No newline at end of file diff --git a/src/encounter/encounter_io.f90 b/src/encounter/encounter_io.f90 index 67020fb13..86a0c60ad 100644 --- a/src/encounter/encounter_io.f90 +++ b/src/encounter/encounter_io.f90 @@ -23,7 +23,6 @@ module subroutine encounter_io_dump(self, param) ! Internals integer(I4B) :: i - ! Most of this is just temporary test code just to get something working. Eventually this should get cleaned up. do i = 1, self%nframes if (allocated(self%frame(i)%item)) then diff --git a/src/main/swiftest_driver.f90 b/src/main/swiftest_driver.f90 index 56ceafd9f..bfc0b38c6 100644 --- a/src/main/swiftest_driver.f90 +++ b/src/main/swiftest_driver.f90 @@ -18,7 +18,7 @@ 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_nbody_system), allocatable :: 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 @@ -52,33 +52,21 @@ program swiftest_driver param%integrator = trim(adjustl(integrator)) call param%set_display(display_style) call param%read_in(param_file_name) - call setup_construct_system(nbody_system, param) - - !> Define the maximum number of threads - nthreads = 1 ! In the *serial* case - !$ nthreads = omp_get_max_threads() ! In the *parallel* case - !$ write(param%display_unit,'(a)') ' OpenMP parameters:' - !$ write(param%display_unit,'(a)') ' ------------------' - !$ write(param%display_unit,'(a,i3,/)') ' Number of threads = ', nthreads - !$ if (param%log_output) write(*,'(a,i3)') ' OpenMP: Number of threads = ',nthreads - - - associate(t => nbody_system%t, & - t0 => param%t0, & - tstart => param%tstart, & - dt => param%dt, & - tstop => param%tstop, & - iloop => param%iloop, & - istep_out => param%istep_out, & - dump_cadence => param%dump_cadence, & - ioutput => param%ioutput, & - display_style => param%display_style, & - display_unit => param%display_unit) - - call nbody_system%initialize(param) + + + associate(t0 => param%t0, & + tstart => param%tstart, & + dt => param%dt, & + tstop => param%tstop, & + iloop => param%iloop, & + istep_out => param%istep_out, & + dump_cadence => param%dump_cadence, & + ioutput => param%ioutput, & + display_style => param%display_style, & + display_unit => param%display_unit) + ! Set up loop and output cadence variables - t = tstart nloops = ceiling((tstop - t0) / dt, kind=I8B) istart = ceiling((tstart - t0) / dt + 1.0_DP, kind=I8B) ioutput = max(int(istart / istep_out, kind=I4B),1) @@ -87,13 +75,27 @@ program swiftest_driver if (dump_cadence == 0) dump_cadence = ceiling(nloops / (1.0_DP * istep_out), kind=I8B) allocate(swiftest_storage(dump_cadence) :: system_history) + ! Construct the main n-body system using the user-input integrator to choose the type of system + call setup_construct_system(system, param) + + !> Define the maximum number of threads + nthreads = 1 ! In the *serial* case + !$ nthreads = omp_get_max_threads() ! In the *parallel* case + !$ write(param%display_unit,'(a)') ' OpenMP parameters:' + !$ write(param%display_unit,'(a)') ' ------------------' + !$ write(param%display_unit,'(a,i3,/)') ' Number of threads = ', nthreads + !$ if (param%log_output) write(*,'(a,i3)') ' OpenMP: Number of threads = ',nthreads + + call system%initialize(param) + + ! 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 - if (param%lenergy) call nbody_system%conservation_report(param, lterminal=.true.) + if (param%lenergy) call system%conservation_report(param, lterminal=.true.) 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) + if (param%lenergy) call system%conservation_report(param, lterminal=.false.) ! This will save the initial values of energy and momentum + call system%write_frame(param) + call system%dump(param) end if write(display_unit, *) " *************** Main Loop *************** " @@ -104,21 +106,22 @@ program swiftest_driver call pbar%update(1,message=pbarmessage) else if (display_style == "COMPACT") then write(*,*) "SWIFTEST START " // param%integrator - call nbody_system%compact_output(param,integration_timer) + call system%compact_output(param,integration_timer) end if iout = 0 idump = 0 + system%t = tstart do iloop = istart, nloops !> Step the system forward in time call integration_timer%start() - call nbody_system%step(param, t, dt) + call system%step(param, system%t, dt) call integration_timer%stop() - t = t0 + iloop * dt + system%t = t0 + iloop * dt !> Evaluate any discards or collisional outcomes - call nbody_system%discard(param) + call system%discard(param) if (display_style == "PROGRESS") call pbar%update(iloop) !> If the loop counter is at the output cadence value, append the data file with a single frame @@ -127,30 +130,30 @@ program swiftest_driver if (iout == istep_out) then iout = 0 idump = idump + 1 - system_history%frame(idump) = nbody_system ! Store a snapshot of the system for posterity + system_history%frame(idump) = system ! Store a snapshot of the system for posterity if (idump == dump_cadence) then idump = 0 - call nbody_system%dump(param) + call system%dump(param) call system_history%dump(param) end if - tfrac = (t - t0) / (tstop - t0) + tfrac = (system%t - t0) / (tstop - t0) - select type(pl => nbody_system%pl) + select type(pl => system%pl) class is (symba_pl) - write(display_unit, symbastatfmt) t, tfrac, pl%nplm, pl%nbody, nbody_system%tp%nbody + write(display_unit, symbastatfmt) system%t, tfrac, pl%nplm, pl%nbody, system%tp%nbody class default - write(display_unit, statusfmt) t, tfrac, pl%nbody, nbody_system%tp%nbody + write(display_unit, statusfmt) system%t, tfrac, pl%nbody, system%tp%nbody end select - if (param%lenergy) call nbody_system%conservation_report(param, lterminal=.true.) + if (param%lenergy) call system%conservation_report(param, lterminal=.true.) call integration_timer%report(message="Integration steps:", unit=display_unit, nsubsteps=istep_out) if (display_style == "PROGRESS") then - write(pbarmessage,fmt=pbarfmt) t, tstop + write(pbarmessage,fmt=pbarfmt) system%t, tstop call pbar%update(1,message=pbarmessage) else if (display_style == "COMPACT") then - call nbody_system%compact_output(param,integration_timer) + call system%compact_output(param,integration_timer) end if call integration_timer%reset() @@ -160,6 +163,7 @@ program swiftest_driver end do ! Dump any remaining history if it exists + call system%dump(param) call system_history%dump(param) if (display_style == "COMPACT") write(*,*) "SWIFTEST STOP" // param%integrator end associate diff --git a/src/modules/encounter_classes.f90 b/src/modules/encounter_classes.f90 index ad73dc4ad..3329fde02 100644 --- a/src/modules/encounter_classes.f90 +++ b/src/modules/encounter_classes.f90 @@ -60,6 +60,7 @@ module encounter_classes integer(I4B) :: loop_varid !! ID for the recursion level variable integer(I4B) :: time_dimsize = 0 !! Number of time values in snapshot integer(I4B) :: id_dimsize = 0 !! Number of potential id values in snapshot + integer(I4B) :: file_number = 1 !! The number to append on the output file contains procedure :: initialize => encounter_io_initialize !! Initialize a set of parameters used to identify a NetCDF output object end type encounter_io_parameters diff --git a/src/setup/setup.f90 b/src/setup/setup.f90 index 4cd5d130a..13e3ec9a1 100644 --- a/src/setup/setup.f90 +++ b/src/setup/setup.f90 @@ -74,6 +74,7 @@ module subroutine setup_construct_system(system, param) if (param%lencounter_save) then if (.not. allocated(system%encounter_history)) allocate(encounter_storage :: system%encounter_history) call system%encounter_history%reset() + system%encounter_history%nc%file_number = param%iloop / param%dump_cadence end if end select end select diff --git a/src/symba/symba_io.f90 b/src/symba/symba_io.f90 index 3dbf4ebbd..606d359cf 100644 --- a/src/symba/symba_io.f90 +++ b/src/symba/symba_io.f90 @@ -22,10 +22,10 @@ module subroutine symba_io_dump_encounter(self, param) class(symba_parameters), intent(inout) :: param !! Current run configuration parameters if (self%encounter_history%iframe == 0) return ! No enounters in this interval - + self%encounter_history%nc%file_number = self%encounter_history%nc%file_number + 1 ! Create and save the output file for this encounter self%encounter_history%nc%time_dimsize = maxval(self%encounter_history%tslot(:)) - write(self%encounter_history%nc%enc_file, '("encounter_",I0.6,".nc")') param%iloop / param%dump_cadence + write(self%encounter_history%nc%enc_file, '("encounter_",I0.6,".nc")') self%encounter_history%nc%file_number call self%encounter_history%nc%initialize(param) call self%encounter_history%dump(param) call self%encounter_history%nc%close() From 34a8f623fb2fe3ac90791576282c35bff3fe576a Mon Sep 17 00:00:00 2001 From: David A Minton Date: Thu, 8 Dec 2022 17:20:40 -0500 Subject: [PATCH 344/569] Put the dump_cadence back to 0 after testing --- examples/Fragmentation/Fragmentation_Movie.py | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/examples/Fragmentation/Fragmentation_Movie.py b/examples/Fragmentation/Fragmentation_Movie.py index 914f8ed11..a664ef49e 100644 --- a/examples/Fragmentation/Fragmentation_Movie.py +++ b/examples/Fragmentation/Fragmentation_Movie.py @@ -203,7 +203,7 @@ def data_stream(self, frame=0): 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, fragmentation_save="TRAJECTORY", gmtiny=gmtiny, minimum_fragment_gmass=minimum_fragment_gmass, verbose=False) - sim.run(dt=1e-4, tstop=1.0e-3, istep_out=1, dump_cadence=4) + sim.run(dt=1e-4, tstop=1.0e-3, istep_out=1, dump_cadence=0) print("Generating animation") anim = AnimatedScatter(sim,movie_filename,movie_titles[style],style,nskip=1) \ No newline at end of file From 36dc282a7eacea53f9e203cdbc7af4dbc65e0f16 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Thu, 8 Dec 2022 17:26:53 -0500 Subject: [PATCH 345/569] Refactored --- src/modules/fraggle_classes.f90 | 2 ++ src/modules/symba_classes.f90 | 24 ++++++++++++------------ src/symba/symba_collision.f90 | 16 ++++++++-------- 3 files changed, 22 insertions(+), 20 deletions(-) diff --git a/src/modules/fraggle_classes.f90 b/src/modules/fraggle_classes.f90 index e4a458a3b..a45ceb873 100644 --- a/src/modules/fraggle_classes.f90 +++ b/src/modules/fraggle_classes.f90 @@ -123,6 +123,8 @@ module fraggle_classes end type fraggle_storage type, extends(encounter_snapshot) :: fraggle_encounter_snapshot + class(fraggle_colliders), allocatable :: colliders !! Colliders object at this snapshot + class(fraggle_fragments), allocatable :: fragments !! Fragments object at this snapshot contains procedure :: write_frame => fraggle_io_encounter_write_frame !! Writes a frame of encounter data to file final :: fraggle_util_final_snapshot diff --git a/src/modules/symba_classes.f90 b/src/modules/symba_classes.f90 index 4c56ff6f7..66c84cc0b 100644 --- a/src/modules/symba_classes.f90 +++ b/src/modules/symba_classes.f90 @@ -164,7 +164,7 @@ module symba_classes !> SyMBA class for tracking pl-tp close encounters in a step type, extends(symba_encounter) :: symba_pltpenc contains - procedure :: resolve_collision => symba_collision_resolve_pltpenc !! Process the pl-tp collision list, then modifiy the massive bodies based on the outcome of the c + procedure :: resolve_collision => symba_resolve_collision_pltpenc !! Process the pl-tp collision list, then modifiy the massive bodies based on the outcome of the c end type symba_pltpenc !******************************************************************************************************************************** @@ -174,9 +174,9 @@ module symba_classes type, extends(symba_encounter) :: symba_plplenc contains procedure :: extract_collisions => symba_collision_encounter_extract_collisions !! Processes the pl-pl encounter list remove only those encounters that led to a collision - procedure :: resolve_fragmentations => symba_collision_resolve_fragmentations !! Process list of collisions, determine the collisional regime, and then create fragments - procedure :: resolve_mergers => symba_collision_resolve_mergers !! Process list of collisions and merge colliding bodies together - procedure :: resolve_collision => symba_collision_resolve_plplenc !! Process the pl-pl collision list, then modifiy the massive bodies based on the outcome of the c + procedure :: resolve_fragmentations => symba_resolve_collision_fragmentations !! Process list of collisions, determine the collisional regime, and then create fragments + procedure :: resolve_mergers => symba_resolve_collision_mergers !! Process list of collisions and merge colliding bodies together + procedure :: resolve_collision => symba_resolve_collision_plplenc !! Process the pl-pl collision list, then modifiy the massive bodies based on the outcome of the c end type symba_plplenc @@ -231,21 +231,21 @@ module subroutine symba_collision_make_colliders_pl(self,idx) 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) + module subroutine symba_resolve_collision_fragmentations(self, system, param) implicit none class(symba_plplenc), intent(inout) :: self !! SyMBA pl-pl encounter list class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object class(symba_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions - end subroutine symba_collision_resolve_fragmentations + end subroutine symba_resolve_collision_fragmentations - module subroutine symba_collision_resolve_mergers(self, system, param) + module subroutine symba_resolve_collision_mergers(self, system, param) implicit none class(symba_plplenc), intent(inout) :: self !! SyMBA pl-pl encounter list class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object class(symba_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions - end subroutine symba_collision_resolve_mergers + end subroutine symba_resolve_collision_mergers - module subroutine symba_collision_resolve_plplenc(self, system, param, t, dt, irec) + module subroutine symba_resolve_collision_plplenc(self, system, param, t, dt, irec) implicit none class(symba_plplenc), intent(inout) :: self !! SyMBA pl-pl encounter list class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object @@ -253,9 +253,9 @@ module subroutine symba_collision_resolve_plplenc(self, system, param, t, dt, ir real(DP), intent(in) :: t !! Current simulation time real(DP), intent(in) :: dt !! Current simulation step size integer(I4B), intent(in) :: irec !! Current recursion level - end subroutine symba_collision_resolve_plplenc + end subroutine symba_resolve_collision_plplenc - module subroutine symba_collision_resolve_pltpenc(self, system, param, t, dt, irec) + module subroutine symba_resolve_collision_pltpenc(self, system, param, t, dt, irec) implicit none class(symba_pltpenc), intent(inout) :: self !! SyMBA pl-tp encounter list class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object @@ -263,7 +263,7 @@ module subroutine symba_collision_resolve_pltpenc(self, system, param, t, dt, ir real(DP), intent(in) :: t !! Current simulation time real(DP), intent(in) :: dt !! Current simulation step size integer(I4B), intent(in) :: irec !! Current recursion level - end subroutine symba_collision_resolve_pltpenc + end subroutine symba_resolve_collision_pltpenc module subroutine symba_discard_pl(self, system, param) use swiftest_classes, only : swiftest_nbody_system, swiftest_parameters diff --git a/src/symba/symba_collision.f90 b/src/symba/symba_collision.f90 index eb891eb23..d69beea1b 100644 --- a/src/symba/symba_collision.f90 +++ b/src/symba/symba_collision.f90 @@ -870,7 +870,7 @@ subroutine symba_collision_mergeaddsub(system, param, colliders, frag, status) end subroutine symba_collision_mergeaddsub - module subroutine symba_collision_resolve_fragmentations(self, system, param) + module subroutine symba_resolve_collision_fragmentations(self, system, param) !! author: David A. Minton !! !! Process list of collisions, determine the collisional regime, and then create fragments. @@ -918,10 +918,10 @@ module subroutine symba_collision_resolve_fragmentations(self, system, param) end associate return - end subroutine symba_collision_resolve_fragmentations + end subroutine symba_resolve_collision_fragmentations - module subroutine symba_collision_resolve_mergers(self, system, param) + module subroutine symba_resolve_collision_mergers(self, system, param) !! author: David A. Minton !! !! Process list of collisions and merge colliding bodies together. @@ -964,10 +964,10 @@ module subroutine symba_collision_resolve_mergers(self, system, param) end associate return - end subroutine symba_collision_resolve_mergers + end subroutine symba_resolve_collision_mergers - module subroutine symba_collision_resolve_plplenc(self, system, param, t, dt, irec) + module subroutine symba_resolve_collision_plplenc(self, system, param, t, dt, irec) !! author: David A. Minton !! !! Process the pl-pl collision list, then modifiy the massive bodies based on the outcome of the collision @@ -1051,10 +1051,10 @@ module subroutine symba_collision_resolve_plplenc(self, system, param, t, dt, ir end associate return - end subroutine symba_collision_resolve_plplenc + end subroutine symba_resolve_collision_plplenc - module subroutine symba_collision_resolve_pltpenc(self, system, param, t, dt, irec) + module subroutine symba_resolve_collision_pltpenc(self, system, param, t, dt, irec) !! author: David A. Minton !! !! Process the pl-tp collision list, then modifiy the massive bodies based on the outcome of the collision @@ -1078,6 +1078,6 @@ module subroutine symba_collision_resolve_pltpenc(self, system, param, t, dt, ir call system%tp%discard(system, param) return - end subroutine symba_collision_resolve_pltpenc + end subroutine symba_resolve_collision_pltpenc end submodule s_symba_collision \ No newline at end of file From 691acb1716e519f0ee92e594cb9227be88ed2aab Mon Sep 17 00:00:00 2001 From: David A Minton Date: Thu, 8 Dec 2022 17:38:13 -0500 Subject: [PATCH 346/569] Refactoring to prepare to consolidate fraggle stuff into the symba nbody object --- src/modules/symba_classes.f90 | 14 ++-- src/symba/symba_collision.f90 | 128 ++++++++++++++++------------------ 2 files changed, 70 insertions(+), 72 deletions(-) diff --git a/src/modules/symba_classes.f90 b/src/modules/symba_classes.f90 index 66c84cc0b..b61b2079e 100644 --- a/src/modules/symba_classes.f90 +++ b/src/modules/symba_classes.f90 @@ -189,6 +189,8 @@ module symba_classes 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(fraggle_colliders) :: colliders !! Fraggle colliders object + type(fraggle_fragments) :: fragments !! Fraggle fragmentation system object type(encounter_storage(nframes=:)), allocatable :: encounter_history !! Stores encounter history for later retrieval and saving to file contains procedure :: write_discard => symba_io_write_discard !! Write out information about discarded and merged planets and test particles in SyMBA @@ -342,33 +344,33 @@ pure module subroutine symba_gr_p4_tp(self, system, param, dt) real(DP), intent(in) :: dt !! Step size end subroutine symba_gr_p4_tp - module function symba_collision_casedisruption(system, param, colliders, frag) result(status) + module function symba_collision_casedisruption(system, param, colliders, fragments) result(status) use fraggle_classes, only : fraggle_colliders, fraggle_fragments implicit none class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object class(symba_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions class(fraggle_colliders), intent(inout) :: colliders !! Fraggle colliders object - class(fraggle_fragments), intent(inout) :: frag !! Fraggle fragmentation system object + class(fraggle_fragments), intent(inout) :: fragments !! Fraggle fragmentation system object integer(I4B) :: status !! Status flag assigned to this outcome end function symba_collision_casedisruption - module function symba_collision_casehitandrun(system, param, colliders, frag) result(status) + module function symba_collision_casehitandrun(system, param, colliders, fragments) result(status) use fraggle_classes, only : fraggle_colliders, fraggle_fragments implicit none class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object class(symba_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions class(fraggle_colliders), intent(inout) :: colliders !! Fraggle colliders object - class(fraggle_fragments), intent(inout) :: frag !! Fraggle fragmentation system object + class(fraggle_fragments), intent(inout) :: fragments !! Fraggle fragmentation system object integer(I4B) :: status !! Status flag assigned to this outcome end function symba_collision_casehitandrun - module function symba_collision_casemerge(system, param, colliders, frag) result(status) + module function symba_collision_casemerge(system, param, colliders, fragments) result(status) use fraggle_classes, only : fraggle_colliders, fraggle_fragments implicit none class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object class(symba_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions class(fraggle_colliders), intent(inout) :: colliders !! Fraggle colliders object - class(fraggle_fragments), intent(inout) :: frag !! Fraggle fragmentation system object + class(fraggle_fragments), intent(inout) :: fragments !! Fraggle fragmentation system object integer(I4B) :: status !! Status flag assigned to this outcome end function symba_collision_casemerge diff --git a/src/symba/symba_collision.f90 b/src/symba/symba_collision.f90 index d69beea1b..45c4fe854 100644 --- a/src/symba/symba_collision.f90 +++ b/src/symba/symba_collision.f90 @@ -12,7 +12,7 @@ contains - module function symba_collision_casedisruption(system, param, colliders, frag) result(status) + module function symba_collision_casedisruption(system, param, colliders, fragments) result(status) !! author: Jennifer L.L. Pouplin, Carlisle A. Wishard, and David A. Minton !! !! Create the fragments resulting from a non-catastrophic disruption collision @@ -22,7 +22,7 @@ module function symba_collision_casedisruption(system, param, colliders, frag) class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object class(symba_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions class(fraggle_colliders), intent(inout) :: colliders !! Fraggle colliders object - class(fraggle_fragments), intent(inout) :: frag !! Fraggle fragmentation system object + class(fraggle_fragments), intent(inout) :: fragments !! Fraggle fragmentation system object ! Result integer(I4B) :: status !! Status flag assigned to this outcome ! Internals @@ -30,7 +30,7 @@ module function symba_collision_casedisruption(system, param, colliders, frag) logical :: lfailure character(len=STRMAX) :: message - select case(frag%regime) + select case(fragments%regime) case(COLLRESOLVE_REGIME_DISRUPTION) message = "Disruption between" case(COLLRESOLVE_REGIME_SUPERCATASTROPHIC) @@ -40,10 +40,10 @@ module function symba_collision_casedisruption(system, param, colliders, frag) call io_log_one_message(FRAGGLE_LOG_OUT, message) ! Collisional fragments will be uniformly distributed around the pre-impact barycenter - call frag%set_mass_dist(colliders, param) + call fragments%set_mass_dist(colliders, param) ! Generate the position and velocity distributions of the fragments - call frag%generate_fragments(colliders, system, param, lfailure) + call fragments%generate_fragments(colliders, system, param, lfailure) if (lfailure) then call io_log_one_message(FRAGGLE_LOG_OUT, "No fragment solution found, so treat as a pure hit-and-run") @@ -57,30 +57,30 @@ module function symba_collision_casedisruption(system, param, colliders, frag) end select else ! Populate the list of new bodies - nfrag = frag%nbody + nfrag = fragments%nbody write(message, *) nfrag call io_log_one_message(FRAGGLE_LOG_OUT, "Generating " // trim(adjustl(message)) // " fragments") - select case(frag%regime) + select case(fragments%regime) case(COLLRESOLVE_REGIME_DISRUPTION) status = DISRUPTION ibiggest = colliders%idx(maxloc(system%pl%Gmass(colliders%idx(:)), dim=1)) - frag%id(1) = system%pl%id(ibiggest) - frag%id(2:nfrag) = [(i, i = param%maxid + 1, param%maxid + nfrag - 1)] - param%maxid = frag%id(nfrag) + fragments%id(1) = system%pl%id(ibiggest) + fragments%id(2:nfrag) = [(i, i = param%maxid + 1, param%maxid + nfrag - 1)] + param%maxid = fragments%id(nfrag) case(COLLRESOLVE_REGIME_SUPERCATASTROPHIC) status = SUPERCATASTROPHIC - frag%id(1:nfrag) = [(i, i = param%maxid + 1, param%maxid + nfrag)] - param%maxid = frag%id(nfrag) + fragments%id(1:nfrag) = [(i, i = param%maxid + 1, param%maxid + nfrag)] + param%maxid = fragments%id(nfrag) end select - call symba_collision_mergeaddsub(system, param, colliders, frag, status) + call symba_collision_mergeaddsub(system, param, colliders, fragments, status) end if return end function symba_collision_casedisruption - module function symba_collision_casehitandrun(system, param, colliders, frag) result(status) + module function symba_collision_casehitandrun(system, param, colliders, fragments) result(status) !! author: Jennifer L.L. Pouplin, Carlisle A. Wishard, and David A. Minton !! !! Create the fragments resulting from a non-catastrophic hit-and-run collision @@ -90,7 +90,7 @@ module function symba_collision_casehitandrun(system, param, colliders, frag) r class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object class(symba_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions class(fraggle_colliders), intent(inout) :: colliders !! Fraggle colliders object - class(fraggle_fragments), intent(inout) :: frag !! Fraggle fragmentation system object + class(fraggle_fragments), intent(inout) :: fragments !! Fraggle fragmentation system object ! Result integer(I4B) :: status !! Status flag assigned to this outcom ! Internals @@ -110,22 +110,22 @@ module function symba_collision_casehitandrun(system, param, colliders, frag) r jproj = 1 end if - if (frag%mass_dist(2) > 0.9_DP * colliders%mass(jproj)) then ! Pure hit and run, so we'll just keep the two bodies untouched + if (fragments%mass_dist(2) > 0.9_DP * colliders%mass(jproj)) then ! Pure hit and run, so we'll just keep the two bodies untouched call io_log_one_message(FRAGGLE_LOG_OUT, "Pure hit and run. No new fragments generated.") nfrag = 0 lpure = .true. else ! Imperfect hit and run, so we'll keep the largest body and destroy the other lpure = .false. - call frag%set_mass_dist(colliders, param) + call fragments%set_mass_dist(colliders, param) ! Generate the position and velocity distributions of the fragments - call frag%generate_fragments(colliders, system, param, lpure) + call fragments%generate_fragments(colliders, system, param, lpure) if (lpure) then call io_log_one_message(FRAGGLE_LOG_OUT, "Should have been a pure hit and run instead") nfrag = 0 else - nfrag = frag%nbody + nfrag = fragments%nbody write(message, *) nfrag call io_log_one_message(FRAGGLE_LOG_OUT, "Generating " // trim(adjustl(message)) // " fragments") end if @@ -140,18 +140,18 @@ module function symba_collision_casehitandrun(system, param, colliders, frag) r end select else ibiggest = colliders%idx(maxloc(system%pl%Gmass(colliders%idx(:)), dim=1)) - frag%id(1) = system%pl%id(ibiggest) - frag%id(2:nfrag) = [(i, i = param%maxid + 1, param%maxid + nfrag - 1)] - param%maxid = frag%id(nfrag) + fragments%id(1) = system%pl%id(ibiggest) + fragments%id(2:nfrag) = [(i, i = param%maxid + 1, param%maxid + nfrag - 1)] + param%maxid = fragments%id(nfrag) status = HIT_AND_RUN_DISRUPT - call symba_collision_mergeaddsub(system, param, colliders, frag, status) + call symba_collision_mergeaddsub(system, param, colliders, fragments, status) end if return end function symba_collision_casehitandrun - module function symba_collision_casemerge(system, param, colliders, frag) result(status) + module function symba_collision_casemerge(system, param, colliders, fragments) result(status) !! author: Jennifer L.L. Pouplin, Carlisle A. Wishard, and David A. Minton !! !! Merge massive bodies. @@ -164,7 +164,7 @@ module function symba_collision_casemerge(system, param, colliders, frag) resul class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object class(symba_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions class(fraggle_colliders), intent(inout) :: colliders !! Fraggle colliders object - class(fraggle_fragments), intent(inout) :: frag !! Fraggle fragmentation system object + class(fraggle_fragments), intent(inout) :: fragments !! Fraggle fragmentation system object ! Result integer(I4B) :: status !! Status flag assigned to this outcome ! Internals @@ -180,18 +180,18 @@ module function symba_collision_casemerge(system, param, colliders, frag) resul select type(pl => system%pl) class is (symba_pl) - call frag%set_mass_dist(colliders, param) + call fragments%set_mass_dist(colliders, param) ibiggest = colliders%idx(maxloc(pl%Gmass(colliders%idx(:)), dim=1)) - frag%id(1) = pl%id(ibiggest) - frag%xb(:,1) = frag%xbcom(:) - frag%vb(:,1) = frag%vbcom(:) + fragments%id(1) = pl%id(ibiggest) + fragments%xb(:,1) = fragments%xbcom(:) + fragments%vb(:,1) = fragments%vbcom(:) if (param%lrotation) then ! Conserve angular momentum by putting pre-impact orbital momentum into spin of the new body L_spin_new(:) = colliders%L_orbit(:,1) + colliders%L_orbit(:,2) + colliders%L_spin(:,1) + colliders%L_spin(:,2) ! Assume prinicpal axis rotation on 3rd Ip axis - frag%rot(:,1) = L_spin_new(:) / (frag%Ip(3,1) * frag%mass(1) * frag%radius(1)**2) + fragments%rot(:,1) = L_spin_new(:) / (fragments%Ip(3,1) * fragments%mass(1) * fragments%radius(1)**2) else ! If spin is not enabled, we will consider the lost pre-collision angular momentum as "escaped" and add it to our bookkeeping variable param%Lescape(:) = param%Lescape(:) + colliders%L_orbit(:,1) + colliders%L_orbit(:,2) end if @@ -225,7 +225,7 @@ module function symba_collision_casemerge(system, param, colliders, frag) resul status = MERGED - call symba_collision_mergeaddsub(system, param, colliders, frag, status) + call symba_collision_mergeaddsub(system, param, colliders, fragments, status) end select @@ -708,7 +708,7 @@ module subroutine symba_collision_make_colliders_pl(self, idx) end subroutine symba_collision_make_colliders_pl - subroutine symba_collision_mergeaddsub(system, param, colliders, frag, status) + subroutine symba_collision_mergeaddsub(system, param, colliders, fragments, status) !! author: David A. Minton !! !! Fills the pl_discards and pl_adds with removed and added bodies @@ -718,7 +718,7 @@ subroutine symba_collision_mergeaddsub(system, param, colliders, frag, status) class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object class(symba_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions class(fraggle_colliders), intent(inout) :: colliders !! Fraggle colliders object - class(fraggle_fragments), intent(inout) :: frag !! Fraggle fragmentation system object + class(fraggle_fragments), intent(inout) :: fragments !! Fraggle fragmentation system object integer(I4B), intent(in) :: status !! Status flag to assign to adds ! Internals integer(I4B) :: i, ibiggest, ismallest, iother, nstart, nend, ncolliders, nfrag @@ -734,7 +734,7 @@ subroutine symba_collision_mergeaddsub(system, param, colliders, frag, status) associate(info => pl%info, pl_adds => system%pl_adds, cb => system%cb, npl => pl%nbody) ! Add the colliders%idx bodies to the subtraction list ncolliders = colliders%ncoll - nfrag = frag%nbody + nfrag = fragments%nbody param%maxid_collision = max(param%maxid_collision, maxval(system%pl%info(:)%collision_id)) param%maxid_collision = param%maxid_collision + 1 @@ -746,26 +746,26 @@ subroutine symba_collision_mergeaddsub(system, param, colliders, frag, status) ismallest = colliders%idx(minloc(pl%Gmass(colliders%idx(:)), dim=1)) ! Copy over identification, information, and physical properties of the new bodies from the fragment list - plnew%id(1:nfrag) = frag%id(1:nfrag) - plnew%xb(:, 1:nfrag) = frag%xb(:, 1:nfrag) - plnew%vb(:, 1:nfrag) = frag%vb(:, 1:nfrag) + plnew%id(1:nfrag) = fragments%id(1:nfrag) + plnew%xb(:, 1:nfrag) = fragments%xb(:, 1:nfrag) + plnew%vb(:, 1:nfrag) = fragments%vb(:, 1:nfrag) call pl%vb2vh(cb) call pl%xh2xb(cb) do i = 1, nfrag - plnew%rh(:,i) = frag%xb(:, i) - cb%xb(:) - plnew%vh(:,i) = frag%vb(:, i) - cb%vb(:) + plnew%rh(:,i) = fragments%xb(:, i) - cb%xb(:) + plnew%vh(:,i) = fragments%vb(:, i) - cb%vb(:) end do - plnew%mass(1:nfrag) = frag%mass(1:nfrag) - plnew%Gmass(1:nfrag) = param%GU * frag%mass(1:nfrag) - plnew%radius(1:nfrag) = frag%radius(1:nfrag) - plnew%density(1:nfrag) = frag%mass(1:nfrag) / frag%radius(1:nfrag) + plnew%mass(1:nfrag) = fragments%mass(1:nfrag) + plnew%Gmass(1:nfrag) = param%GU * fragments%mass(1:nfrag) + plnew%radius(1:nfrag) = fragments%radius(1:nfrag) + plnew%density(1:nfrag) = fragments%mass(1:nfrag) / fragments%radius(1:nfrag) call plnew%set_rhill(cb) select case(status) case(SUPERCATASTROPHIC) plnew%status(1:nfrag) = NEW_PARTICLE do i = 1, nfrag - write(newname, FRAGFMT) frag%id(i) + write(newname, FRAGFMT) fragments%id(i) call plnew%info(i)%set_value(origin_type="Supercatastrophic", origin_time=system%t, name=newname, & origin_rh=plnew%rh(:,i), origin_vh=plnew%vh(:,i), & collision_id=param%maxid_collision) @@ -789,7 +789,7 @@ subroutine symba_collision_mergeaddsub(system, param, colliders, frag, status) call plnew%info(1)%copy(pl%info(ibiggest)) plnew%status(1) = OLD_PARTICLE do i = 2, nfrag - write(newname, FRAGFMT) frag%id(i) + write(newname, FRAGFMT) fragments%id(i) call plnew%info(i)%set_value(origin_type=origin_type, origin_time=system%t, name=newname, & origin_rh=plnew%rh(:,i), origin_vh=plnew%vh(:,i), & collision_id=param%maxid_collision) @@ -814,8 +814,8 @@ subroutine symba_collision_mergeaddsub(system, param, colliders, frag, status) end select if (param%lrotation) then - plnew%Ip(:, 1:nfrag) = frag%Ip(:, 1:nfrag) - plnew%rot(:, 1:nfrag) = frag%rot(:, 1:nfrag) + plnew%Ip(:, 1:nfrag) = fragments%Ip(:, 1:nfrag) + plnew%rot(:, 1:nfrag) = fragments%rot(:, 1:nfrag) end if ! if (param%ltides) then @@ -885,10 +885,8 @@ module subroutine symba_resolve_collision_fragmentations(self, system, param) integer(I4B), dimension(2) :: idx_parent !! Index of the two bodies considered the "parents" of the collision logical :: lgoodcollision integer(I4B) :: i - type(fraggle_colliders) :: colliders !! Fraggle colliders object - type(fraggle_fragments) :: frag !! Fraggle fragmentation system object - associate(plplcollision_list => self, ncollisions => self%nenc, idx1 => self%index1, idx2 => self%index2) + associate(plplcollision_list => self, ncollisions => self%nenc, idx1 => self%index1, idx2 => self%index2, colliders => system%colliders, fragments => system%fragments) select type(pl => system%pl) class is (symba_pl) select type (cb => system%cb) @@ -899,15 +897,15 @@ module subroutine symba_resolve_collision_fragmentations(self, system, param) lgoodcollision = symba_collision_consolidate_colliders(pl, cb, param, idx_parent, colliders) if ((.not. lgoodcollision) .or. any(pl%status(idx_parent(:)) /= COLLISION)) cycle - call colliders%regime(frag, system, param) + call colliders%regime(fragments, system, param) - select case (frag%regime) + select case (fragments%regime) case (COLLRESOLVE_REGIME_DISRUPTION, COLLRESOLVE_REGIME_SUPERCATASTROPHIC) - plplcollision_list%status(i) = symba_collision_casedisruption(system, param, colliders, frag) + plplcollision_list%status(i) = symba_collision_casedisruption(system, param, colliders, fragments) case (COLLRESOLVE_REGIME_HIT_AND_RUN) - plplcollision_list%status(i) = symba_collision_casehitandrun(system, param, colliders, frag) + plplcollision_list%status(i) = symba_collision_casehitandrun(system, param, colliders, fragments) case (COLLRESOLVE_REGIME_MERGE, COLLRESOLVE_REGIME_GRAZE_AND_MERGE) - plplcollision_list%status(i) = symba_collision_casemerge(system, param, colliders, frag) + plplcollision_list%status(i) = symba_collision_casemerge(system, param, colliders, fragments) case default write(*,*) "Error in symba_collision, unrecognized collision regime" call util_exit(FAILURE) @@ -935,10 +933,8 @@ module subroutine symba_resolve_collision_mergers(self, system, param) integer(I4B), dimension(2) :: idx_parent !! Index of the two bodies considered the "parents" of the collision logical :: lgoodcollision integer(I4B) :: i - type(fraggle_colliders) :: colliders !! Fraggle colliders object - type(fraggle_fragments) :: frag !! Fraggle fragmentation system object - associate(plplcollision_list => self, ncollisions => self%nenc, idx1 => self%index1, idx2 => self%index2) + associate(plplcollision_list => self, ncollisions => self%nenc, idx1 => self%index1, idx2 => self%index2, fragments => system%fragments, colliders => system%colliders) select type(pl => system%pl) class is (symba_pl) select type(cb => system%cb) @@ -950,14 +946,14 @@ module subroutine symba_resolve_collision_mergers(self, system, param) if (.not. lgoodcollision) cycle if (any(pl%status(idx_parent(:)) /= COLLISION)) cycle ! One of these two bodies has already been resolved - frag%regime = COLLRESOLVE_REGIME_MERGE - frag%mtot = sum(colliders%mass(:)) - frag%mass_dist(1) = frag%mtot - frag%mass_dist(2) = 0.0_DP - frag%mass_dist(3) = 0.0_DP - frag%xbcom(:) = (colliders%mass(1) * colliders%xb(:,1) + colliders%mass(2) * colliders%xb(:,2)) / frag%mtot - frag%vbcom(:) = (colliders%mass(1) * colliders%vb(:,1) + colliders%mass(2) * colliders%vb(:,2)) / frag%mtot - plplcollision_list%status(i) = symba_collision_casemerge(system, param, colliders, frag) + fragments%regime = COLLRESOLVE_REGIME_MERGE + fragments%mtot = sum(colliders%mass(:)) + fragments%mass_dist(1) = fragments%mtot + fragments%mass_dist(2) = 0.0_DP + fragments%mass_dist(3) = 0.0_DP + fragments%xbcom(:) = (colliders%mass(1) * colliders%xb(:,1) + colliders%mass(2) * colliders%xb(:,2)) / fragments%mtot + fragments%vbcom(:) = (colliders%mass(1) * colliders%vb(:,1) + colliders%mass(2) * colliders%vb(:,2)) / fragments%mtot + plplcollision_list%status(i) = symba_collision_casemerge(system, param, colliders, fragments) end do end select end select From fb2a95ec3bc4d398d098ec2d67c2227ee7a2796a Mon Sep 17 00:00:00 2001 From: David A Minton Date: Thu, 8 Dec 2022 17:47:58 -0500 Subject: [PATCH 347/569] OOFed Fraggle --- src/modules/symba_classes.f90 | 15 +- src/symba/symba_collision.f90 | 289 +++++++++++++++++----------------- 2 files changed, 147 insertions(+), 157 deletions(-) diff --git a/src/modules/symba_classes.f90 b/src/modules/symba_classes.f90 index b61b2079e..c30762243 100644 --- a/src/modules/symba_classes.f90 +++ b/src/modules/symba_classes.f90 @@ -344,33 +344,24 @@ pure module subroutine symba_gr_p4_tp(self, system, param, dt) real(DP), intent(in) :: dt !! Step size end subroutine symba_gr_p4_tp - module function symba_collision_casedisruption(system, param, colliders, fragments) result(status) - use fraggle_classes, only : fraggle_colliders, fraggle_fragments + module function symba_collision_casedisruption(system, param) result(status) implicit none class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object class(symba_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions - class(fraggle_colliders), intent(inout) :: colliders !! Fraggle colliders object - class(fraggle_fragments), intent(inout) :: fragments !! Fraggle fragmentation system object integer(I4B) :: status !! Status flag assigned to this outcome end function symba_collision_casedisruption - module function symba_collision_casehitandrun(system, param, colliders, fragments) result(status) - use fraggle_classes, only : fraggle_colliders, fraggle_fragments + module function symba_collision_casehitandrun(system, param) result(status) implicit none class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object class(symba_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions - class(fraggle_colliders), intent(inout) :: colliders !! Fraggle colliders object - class(fraggle_fragments), intent(inout) :: fragments !! Fraggle fragmentation system object integer(I4B) :: status !! Status flag assigned to this outcome end function symba_collision_casehitandrun - module function symba_collision_casemerge(system, param, colliders, fragments) result(status) - use fraggle_classes, only : fraggle_colliders, fraggle_fragments + module function symba_collision_casemerge(system, param) result(status) implicit none class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object class(symba_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions - class(fraggle_colliders), intent(inout) :: colliders !! Fraggle colliders object - class(fraggle_fragments), intent(inout) :: fragments !! Fraggle fragmentation system object integer(I4B) :: status !! Status flag assigned to this outcome end function symba_collision_casemerge diff --git a/src/symba/symba_collision.f90 b/src/symba/symba_collision.f90 index 45c4fe854..be6406374 100644 --- a/src/symba/symba_collision.f90 +++ b/src/symba/symba_collision.f90 @@ -12,7 +12,7 @@ contains - module function symba_collision_casedisruption(system, param, colliders, fragments) result(status) + module function symba_collision_casedisruption(system, param) result(status) !! author: Jennifer L.L. Pouplin, Carlisle A. Wishard, and David A. Minton !! !! Create the fragments resulting from a non-catastrophic disruption collision @@ -21,8 +21,6 @@ module function symba_collision_casedisruption(system, param, colliders, fragmen ! Arguments class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object class(symba_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions - class(fraggle_colliders), intent(inout) :: colliders !! Fraggle colliders object - class(fraggle_fragments), intent(inout) :: fragments !! Fraggle fragmentation system object ! Result integer(I4B) :: status !! Status flag assigned to this outcome ! Internals @@ -30,57 +28,60 @@ module function symba_collision_casedisruption(system, param, colliders, fragmen logical :: lfailure character(len=STRMAX) :: message - select case(fragments%regime) - case(COLLRESOLVE_REGIME_DISRUPTION) - message = "Disruption between" - case(COLLRESOLVE_REGIME_SUPERCATASTROPHIC) - message = "Supercatastrophic disruption between" - end select - call symba_collision_collider_message(system%pl, colliders%idx, message) - call io_log_one_message(FRAGGLE_LOG_OUT, message) - - ! Collisional fragments will be uniformly distributed around the pre-impact barycenter - call fragments%set_mass_dist(colliders, param) - - ! Generate the position and velocity distributions of the fragments - call fragments%generate_fragments(colliders, system, param, lfailure) + associate(colliders => system%colliders, fragments => system%fragments) - if (lfailure) then - call io_log_one_message(FRAGGLE_LOG_OUT, "No fragment solution found, so treat as a pure hit-and-run") - status = ACTIVE - nfrag = 0 - select type(pl => system%pl) - class is (symba_pl) - pl%status(colliders%idx(:)) = status - pl%ldiscard(colliders%idx(:)) = .false. - pl%lcollision(colliders%idx(:)) = .false. - end select - else - ! Populate the list of new bodies - nfrag = fragments%nbody - write(message, *) nfrag - call io_log_one_message(FRAGGLE_LOG_OUT, "Generating " // trim(adjustl(message)) // " fragments") select case(fragments%regime) case(COLLRESOLVE_REGIME_DISRUPTION) - status = DISRUPTION - ibiggest = colliders%idx(maxloc(system%pl%Gmass(colliders%idx(:)), dim=1)) - fragments%id(1) = system%pl%id(ibiggest) - fragments%id(2:nfrag) = [(i, i = param%maxid + 1, param%maxid + nfrag - 1)] - param%maxid = fragments%id(nfrag) + message = "Disruption between" case(COLLRESOLVE_REGIME_SUPERCATASTROPHIC) - status = SUPERCATASTROPHIC - fragments%id(1:nfrag) = [(i, i = param%maxid + 1, param%maxid + nfrag)] - param%maxid = fragments%id(nfrag) + message = "Supercatastrophic disruption between" end select + call symba_collision_collider_message(system%pl, colliders%idx, message) + call io_log_one_message(FRAGGLE_LOG_OUT, message) - call symba_collision_mergeaddsub(system, param, colliders, fragments, status) - end if + ! Collisional fragments will be uniformly distributed around the pre-impact barycenter + call fragments%set_mass_dist(colliders, param) + + ! Generate the position and velocity distributions of the fragments + call fragments%generate_fragments(colliders, system, param, lfailure) + + if (lfailure) then + call io_log_one_message(FRAGGLE_LOG_OUT, "No fragment solution found, so treat as a pure hit-and-run") + status = ACTIVE + nfrag = 0 + select type(pl => system%pl) + class is (symba_pl) + pl%status(colliders%idx(:)) = status + pl%ldiscard(colliders%idx(:)) = .false. + pl%lcollision(colliders%idx(:)) = .false. + end select + else + ! Populate the list of new bodies + nfrag = fragments%nbody + write(message, *) nfrag + call io_log_one_message(FRAGGLE_LOG_OUT, "Generating " // trim(adjustl(message)) // " fragments") + select case(fragments%regime) + case(COLLRESOLVE_REGIME_DISRUPTION) + status = DISRUPTION + ibiggest = colliders%idx(maxloc(system%pl%Gmass(colliders%idx(:)), dim=1)) + fragments%id(1) = system%pl%id(ibiggest) + fragments%id(2:nfrag) = [(i, i = param%maxid + 1, param%maxid + nfrag - 1)] + param%maxid = fragments%id(nfrag) + case(COLLRESOLVE_REGIME_SUPERCATASTROPHIC) + status = SUPERCATASTROPHIC + fragments%id(1:nfrag) = [(i, i = param%maxid + 1, param%maxid + nfrag)] + param%maxid = fragments%id(nfrag) + end select + + call symba_collision_mergeaddsub(system, param, status) + end if + end associate return end function symba_collision_casedisruption - module function symba_collision_casehitandrun(system, param, colliders, fragments) result(status) + module function symba_collision_casehitandrun(system, param) result(status) !! author: Jennifer L.L. Pouplin, Carlisle A. Wishard, and David A. Minton !! !! Create the fragments resulting from a non-catastrophic hit-and-run collision @@ -89,8 +90,6 @@ module function symba_collision_casehitandrun(system, param, colliders, fragment ! Arguments class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object class(symba_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions - class(fraggle_colliders), intent(inout) :: colliders !! Fraggle colliders object - class(fraggle_fragments), intent(inout) :: fragments !! Fraggle fragmentation system object ! Result integer(I4B) :: status !! Status flag assigned to this outcom ! Internals @@ -98,60 +97,63 @@ module function symba_collision_casehitandrun(system, param, colliders, fragment logical :: lpure character(len=STRMAX) :: message - message = "Hit and run between" - call symba_collision_collider_message(system%pl, colliders%idx, message) - call io_log_one_message(FRAGGLE_LOG_OUT, trim(adjustl(message))) + associate(colliders => system%colliders, fragments => system%fragments) + message = "Hit and run between" + call symba_collision_collider_message(system%pl, colliders%idx, message) + call io_log_one_message(FRAGGLE_LOG_OUT, trim(adjustl(message))) - if (colliders%mass(1) > colliders%mass(2)) then - jtarg = 1 - jproj = 2 - else - jtarg = 2 - jproj = 1 - end if + if (colliders%mass(1) > colliders%mass(2)) then + jtarg = 1 + jproj = 2 + else + jtarg = 2 + jproj = 1 + end if - if (fragments%mass_dist(2) > 0.9_DP * colliders%mass(jproj)) then ! Pure hit and run, so we'll just keep the two bodies untouched - call io_log_one_message(FRAGGLE_LOG_OUT, "Pure hit and run. No new fragments generated.") - nfrag = 0 - lpure = .true. - else ! Imperfect hit and run, so we'll keep the largest body and destroy the other - lpure = .false. - call fragments%set_mass_dist(colliders, param) + if (fragments%mass_dist(2) > 0.9_DP * colliders%mass(jproj)) then ! Pure hit and run, so we'll just keep the two bodies untouched + call io_log_one_message(FRAGGLE_LOG_OUT, "Pure hit and run. No new fragments generated.") + nfrag = 0 + lpure = .true. + else ! Imperfect hit and run, so we'll keep the largest body and destroy the other + lpure = .false. + call fragments%set_mass_dist(colliders, param) - ! Generate the position and velocity distributions of the fragments - call fragments%generate_fragments(colliders, system, param, lpure) + ! Generate the position and velocity distributions of the fragments + call fragments%generate_fragments(colliders, system, param, lpure) - if (lpure) then - call io_log_one_message(FRAGGLE_LOG_OUT, "Should have been a pure hit and run instead") - nfrag = 0 + if (lpure) then + call io_log_one_message(FRAGGLE_LOG_OUT, "Should have been a pure hit and run instead") + nfrag = 0 + else + nfrag = fragments%nbody + write(message, *) nfrag + call io_log_one_message(FRAGGLE_LOG_OUT, "Generating " // trim(adjustl(message)) // " fragments") + end if + end if + if (lpure) then ! Reset these bodies back to being active so that nothing further is done to them + status = HIT_AND_RUN_PURE + select type(pl => system%pl) + class is (symba_pl) + pl%status(colliders%idx(:)) = ACTIVE + pl%ldiscard(colliders%idx(:)) = .false. + pl%lcollision(colliders%idx(:)) = .false. + end select else - nfrag = fragments%nbody - write(message, *) nfrag - call io_log_one_message(FRAGGLE_LOG_OUT, "Generating " // trim(adjustl(message)) // " fragments") + ibiggest = colliders%idx(maxloc(system%pl%Gmass(colliders%idx(:)), dim=1)) + fragments%id(1) = system%pl%id(ibiggest) + fragments%id(2:nfrag) = [(i, i = param%maxid + 1, param%maxid + nfrag - 1)] + param%maxid = fragments%id(nfrag) + status = HIT_AND_RUN_DISRUPT + call symba_collision_mergeaddsub(system, param, status) end if - end if - if (lpure) then ! Reset these bodies back to being active so that nothing further is done to them - status = HIT_AND_RUN_PURE - select type(pl => system%pl) - class is (symba_pl) - pl%status(colliders%idx(:)) = ACTIVE - pl%ldiscard(colliders%idx(:)) = .false. - pl%lcollision(colliders%idx(:)) = .false. - end select - else - ibiggest = colliders%idx(maxloc(system%pl%Gmass(colliders%idx(:)), dim=1)) - fragments%id(1) = system%pl%id(ibiggest) - fragments%id(2:nfrag) = [(i, i = param%maxid + 1, param%maxid + nfrag - 1)] - param%maxid = fragments%id(nfrag) - status = HIT_AND_RUN_DISRUPT - call symba_collision_mergeaddsub(system, param, colliders, fragments, status) - end if + + end associate return end function symba_collision_casehitandrun - module function symba_collision_casemerge(system, param, colliders, fragments) result(status) + module function symba_collision_casemerge(system, param) result(status) !! author: Jennifer L.L. Pouplin, Carlisle A. Wishard, and David A. Minton !! !! Merge massive bodies. @@ -163,8 +165,6 @@ module function symba_collision_casemerge(system, param, colliders, fragments) ! Arguments class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object class(symba_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions - class(fraggle_colliders), intent(inout) :: colliders !! Fraggle colliders object - class(fraggle_fragments), intent(inout) :: fragments !! Fraggle fragmentation system object ! Result integer(I4B) :: status !! Status flag assigned to this outcome ! Internals @@ -173,62 +173,63 @@ module function symba_collision_casemerge(system, param, colliders, fragments) real(DP), dimension(NDIM) :: L_spin_new character(len=STRMAX) :: message - message = "Merging" - call symba_collision_collider_message(system%pl, colliders%idx, message) - call io_log_one_message(FRAGGLE_LOG_OUT, message) - - select type(pl => system%pl) - class is (symba_pl) + associate(colliders => system%colliders, fragments => system%fragments) + message = "Merging" + call symba_collision_collider_message(system%pl, colliders%idx, message) + call io_log_one_message(FRAGGLE_LOG_OUT, message) - call fragments%set_mass_dist(colliders, param) - ibiggest = colliders%idx(maxloc(pl%Gmass(colliders%idx(:)), dim=1)) - fragments%id(1) = pl%id(ibiggest) - fragments%xb(:,1) = fragments%xbcom(:) - fragments%vb(:,1) = fragments%vbcom(:) + select type(pl => system%pl) + class is (symba_pl) - if (param%lrotation) then - ! Conserve angular momentum by putting pre-impact orbital momentum into spin of the new body - L_spin_new(:) = colliders%L_orbit(:,1) + colliders%L_orbit(:,2) + colliders%L_spin(:,1) + colliders%L_spin(:,2) + call fragments%set_mass_dist(colliders, param) + ibiggest = colliders%idx(maxloc(pl%Gmass(colliders%idx(:)), dim=1)) + fragments%id(1) = pl%id(ibiggest) + fragments%xb(:,1) = fragments%xbcom(:) + fragments%vb(:,1) = fragments%vbcom(:) - ! Assume prinicpal axis rotation on 3rd Ip axis - fragments%rot(:,1) = L_spin_new(:) / (fragments%Ip(3,1) * fragments%mass(1) * fragments%radius(1)**2) - else ! If spin is not enabled, we will consider the lost pre-collision angular momentum as "escaped" and add it to our bookkeeping variable - param%Lescape(:) = param%Lescape(:) + colliders%L_orbit(:,1) + colliders%L_orbit(:,2) - end if + if (param%lrotation) then + ! Conserve angular momentum by putting pre-impact orbital momentum into spin of the new body + L_spin_new(:) = colliders%L_orbit(:,1) + colliders%L_orbit(:,2) + colliders%L_spin(:,1) + colliders%L_spin(:,2) - ! Keep track of the component of potential energy due to the pre-impact colliders%idx for book-keeping - pe = 0.0_DP - do j = 1, colliders%ncoll - do i = j + 1, colliders%ncoll - pe = pe - pl%Gmass(i) * pl%mass(j) / norm2(pl%xb(:, i) - pl%xb(:, j)) - end do - end do - system%Ecollisions = system%Ecollisions + pe - system%Euntracked = system%Euntracked - pe + ! Assume prinicpal axis rotation on 3rd Ip axis + fragments%rot(:,1) = L_spin_new(:) / (fragments%Ip(3,1) * fragments%mass(1) * fragments%radius(1)**2) + else ! If spin is not enabled, we will consider the lost pre-collision angular momentum as "escaped" and add it to our bookkeeping variable + param%Lescape(:) = param%Lescape(:) + colliders%L_orbit(:,1) + colliders%L_orbit(:,2) + end if - ! Update any encounter lists that have the removed bodies in them so that they instead point to the new - do k = 1, system%plplenc_list%nenc + ! Keep track of the component of potential energy due to the pre-impact colliders%idx for book-keeping + pe = 0.0_DP do j = 1, colliders%ncoll - i = colliders%idx(j) - if (i == ibiggest) cycle - if (system%plplenc_list%id1(k) == pl%id(i)) then - system%plplenc_list%id1(k) = pl%id(ibiggest) - system%plplenc_list%index1(k) = i - end if - if (system%plplenc_list%id2(k) == pl%id(i)) then - system%plplenc_list%id2(k) = pl%id(ibiggest) - system%plplenc_list%index2(k) = i - end if - if (system%plplenc_list%id1(k) == system%plplenc_list%id2(k)) system%plplenc_list%status(k) = INACTIVE + do i = j + 1, colliders%ncoll + pe = pe - pl%Gmass(i) * pl%mass(j) / norm2(pl%xb(:, i) - pl%xb(:, j)) + end do + end do + system%Ecollisions = system%Ecollisions + pe + system%Euntracked = system%Euntracked - pe + + ! Update any encounter lists that have the removed bodies in them so that they instead point to the new + do k = 1, system%plplenc_list%nenc + do j = 1, colliders%ncoll + i = colliders%idx(j) + if (i == ibiggest) cycle + if (system%plplenc_list%id1(k) == pl%id(i)) then + system%plplenc_list%id1(k) = pl%id(ibiggest) + system%plplenc_list%index1(k) = i + end if + if (system%plplenc_list%id2(k) == pl%id(i)) then + system%plplenc_list%id2(k) = pl%id(ibiggest) + system%plplenc_list%index2(k) = i + end if + if (system%plplenc_list%id1(k) == system%plplenc_list%id2(k)) system%plplenc_list%status(k) = INACTIVE + end do end do - end do - - status = MERGED - - call symba_collision_mergeaddsub(system, param, colliders, fragments, status) - end select + status = MERGED + + call symba_collision_mergeaddsub(system, param, status) + end select + end associate return end function symba_collision_casemerge @@ -708,7 +709,7 @@ module subroutine symba_collision_make_colliders_pl(self, idx) end subroutine symba_collision_make_colliders_pl - subroutine symba_collision_mergeaddsub(system, param, colliders, fragments, status) + subroutine symba_collision_mergeaddsub(system, param, status) !! author: David A. Minton !! !! Fills the pl_discards and pl_adds with removed and added bodies @@ -717,8 +718,6 @@ subroutine symba_collision_mergeaddsub(system, param, colliders, fragments, stat ! Arguments class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object class(symba_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions - class(fraggle_colliders), intent(inout) :: colliders !! Fraggle colliders object - class(fraggle_fragments), intent(inout) :: fragments !! Fraggle fragmentation system object integer(I4B), intent(in) :: status !! Status flag to assign to adds ! Internals integer(I4B) :: i, ibiggest, ismallest, iother, nstart, nend, ncolliders, nfrag @@ -731,7 +730,7 @@ subroutine symba_collision_mergeaddsub(system, param, colliders, fragments, stat class is (symba_pl) select type(pl_discards => system%pl_discards) class is (symba_merger) - associate(info => pl%info, pl_adds => system%pl_adds, cb => system%cb, npl => pl%nbody) + associate(info => pl%info, pl_adds => system%pl_adds, cb => system%cb, npl => pl%nbody, colliders => system%colliders, fragments => system%fragments) ! Add the colliders%idx bodies to the subtraction list ncolliders = colliders%ncoll nfrag = fragments%nbody @@ -901,11 +900,11 @@ module subroutine symba_resolve_collision_fragmentations(self, system, param) select case (fragments%regime) case (COLLRESOLVE_REGIME_DISRUPTION, COLLRESOLVE_REGIME_SUPERCATASTROPHIC) - plplcollision_list%status(i) = symba_collision_casedisruption(system, param, colliders, fragments) + plplcollision_list%status(i) = symba_collision_casedisruption(system, param) case (COLLRESOLVE_REGIME_HIT_AND_RUN) - plplcollision_list%status(i) = symba_collision_casehitandrun(system, param, colliders, fragments) + plplcollision_list%status(i) = symba_collision_casehitandrun(system, param) case (COLLRESOLVE_REGIME_MERGE, COLLRESOLVE_REGIME_GRAZE_AND_MERGE) - plplcollision_list%status(i) = symba_collision_casemerge(system, param, colliders, fragments) + plplcollision_list%status(i) = symba_collision_casemerge(system, param) case default write(*,*) "Error in symba_collision, unrecognized collision regime" call util_exit(FAILURE) @@ -953,7 +952,7 @@ module subroutine symba_resolve_collision_mergers(self, system, param) fragments%mass_dist(3) = 0.0_DP fragments%xbcom(:) = (colliders%mass(1) * colliders%xb(:,1) + colliders%mass(2) * colliders%xb(:,2)) / fragments%mtot fragments%vbcom(:) = (colliders%mass(1) * colliders%vb(:,1) + colliders%mass(2) * colliders%vb(:,2)) / fragments%mtot - plplcollision_list%status(i) = symba_collision_casemerge(system, param, colliders, fragments) + plplcollision_list%status(i) = symba_collision_casemerge(system, param) end do end select end select From 127e73609141830997735c874f1bbca571ed6287 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Thu, 8 Dec 2022 18:18:20 -0500 Subject: [PATCH 348/569] Added collision detection logicals to encounter list so that the collision stuff can get saved to the snapshot --- src/modules/encounter_classes.f90 | 25 +++++++++++++------------ src/symba/symba_step.f90 | 5 +++-- 2 files changed, 16 insertions(+), 14 deletions(-) diff --git a/src/modules/encounter_classes.f90 b/src/modules/encounter_classes.f90 index 3329fde02..8bc1e00b7 100644 --- a/src/modules/encounter_classes.f90 +++ b/src/modules/encounter_classes.f90 @@ -19,18 +19,19 @@ module encounter_classes integer(I4B), parameter :: SWEEPDIM = 3 type :: encounter_list - 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 + integer(I8B) :: nenc = 0 !! Total number of encounters + logical :: lcollision !! Indicates if the encounter resulted in at least one collision + 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 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 diff --git a/src/symba/symba_step.f90 b/src/symba/symba_step.f90 index 0b8879464..cf2b819e7 100644 --- a/src/symba/symba_step.f90 +++ b/src/symba/symba_step.f90 @@ -178,9 +178,10 @@ recursive module subroutine symba_step_recur_system(self, param, t, ireci) ! Internals integer(I4B) :: j, irecp, nloops real(DP) :: dtl, dth - logical :: lencounter, lplpl_collision, lpltp_collision + logical :: lencounter - associate(system => self, plplenc_list => self%plplenc_list, pltpenc_list => self%pltpenc_list) + associate(system => self, plplenc_list => self%plplenc_list, pltpenc_list => self%pltpenc_list, & + lplpl_collision => self%plplenc_list%lcollision, lpltp_collision => self%pltpenc_list%lcollision) select type(param) class is (symba_parameters) select type(pl => self%pl) From 2ea96cd7bfd0cab6df008088bac6625a99a261a1 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Thu, 8 Dec 2022 18:25:05 -0500 Subject: [PATCH 349/569] Save fraggle snapshot to the symba storage object --- src/symba/symba_util.f90 | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/src/symba/symba_util.f90 b/src/symba/symba_util.f90 index c2a837599..0e090601e 100644 --- a/src/symba/symba_util.f90 +++ b/src/symba/symba_util.f90 @@ -1296,7 +1296,7 @@ module subroutine symba_util_take_encounter_snapshot(self, param, t) class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! current time ! Arguments - type(encounter_snapshot) :: snapshot + type(fraggle_encounter_snapshot) :: snapshot integer(I4B) :: i, npl_snap, ntp_snap associate(npl => self%pl%nbody, ntp => self%tp%nbody) @@ -1380,6 +1380,10 @@ module subroutine symba_util_take_encounter_snapshot(self, param, t) end select end select + if (self%plplenc_list%lcollision) then + allocate(snapshot%colliders, source=self%colliders) + allocate(snapshot%fragments, source=self%fragments) + end if ! Save the snapshot call symba_util_save_storage(self,snapshot,t) From 9ae43a7cee149dfa742aa520263542318523cf1b Mon Sep 17 00:00:00 2001 From: David A Minton Date: Thu, 8 Dec 2022 19:31:50 -0500 Subject: [PATCH 350/569] Did some OOF magic to get the fraggle encounters saved and output selected --- src/encounter/encounter_io.f90 | 6 +++++- src/modules/fraggle_classes.f90 | 5 +++-- src/symba/symba_step.f90 | 2 ++ src/symba/symba_util.f90 | 12 +++++++++--- 4 files changed, 19 insertions(+), 6 deletions(-) diff --git a/src/encounter/encounter_io.f90 b/src/encounter/encounter_io.f90 index 86a0c60ad..7c3730df2 100644 --- a/src/encounter/encounter_io.f90 +++ b/src/encounter/encounter_io.f90 @@ -23,13 +23,17 @@ module subroutine encounter_io_dump(self, param) ! Internals integer(I4B) :: i - do i = 1, self%nframes if (allocated(self%frame(i)%item)) then select type(snapshot => self%frame(i)%item) class is (encounter_snapshot) param%ioutput = self%tslot(i) call snapshot%write_frame(self%nc,param) + select type(snapshot) ! Be sure to call the base class method to get the regular encounter data sved + class is (fraggle_encounter_snapshot) + call snapshot%encounter_snapshot%write_frame(self%nc,param) + end select + end select else exit diff --git a/src/modules/fraggle_classes.f90 b/src/modules/fraggle_classes.f90 index a45ceb873..581eb1a65 100644 --- a/src/modules/fraggle_classes.f90 +++ b/src/modules/fraggle_classes.f90 @@ -123,8 +123,9 @@ module fraggle_classes end type fraggle_storage type, extends(encounter_snapshot) :: fraggle_encounter_snapshot - class(fraggle_colliders), allocatable :: colliders !! Colliders object at this snapshot - class(fraggle_fragments), allocatable :: fragments !! Fragments object at this snapshot + logical :: lcollision !! Indicates that this snapshot contains at least one collision + class(fraggle_colliders), allocatable :: colliders !! Colliders object at this snapshot + class(fraggle_fragments), allocatable :: fragments !! Fragments object at this snapshot contains procedure :: write_frame => fraggle_io_encounter_write_frame !! Writes a frame of encounter data to file final :: fraggle_util_final_snapshot diff --git a/src/symba/symba_step.f90 b/src/symba/symba_step.f90 index cf2b819e7..9e8f643bd 100644 --- a/src/symba/symba_step.f90 +++ b/src/symba/symba_step.f90 @@ -296,6 +296,7 @@ module subroutine symba_step_reset_system(self, param) call pl%set_renc(0) call system%plplenc_list%setup(nenc_old) ! This resizes the pl-pl encounter list to be the same size as it was the last step, to decrease the number of potential resize operations that have to be one inside the step system%plplenc_list%nenc = 0 ! Sets the true number of encounters back to 0 after resizing + system%plplenc_list%lcollision = .false. end if nenc_old = system%pltpenc_list%nenc @@ -308,6 +309,7 @@ module subroutine symba_step_reset_system(self, param) tp%ldiscard(1:ntp) = .false. call system%pltpenc_list%setup(nenc_old)! This resizes the pl-tp encounter list to be the same size as it was the last step, to decrease the number of potential resize operations that have to be one inside the step system%pltpenc_list%nenc = 0 ! Sets the true number of encounters back to 0 after resizing + system%pltpenc_list%lcollision = .false. end if call system%pl_adds%setup(0, param) diff --git a/src/symba/symba_util.f90 b/src/symba/symba_util.f90 index 0e090601e..ffd077f0e 100644 --- a/src/symba/symba_util.f90 +++ b/src/symba/symba_util.f90 @@ -1296,11 +1296,16 @@ module subroutine symba_util_take_encounter_snapshot(self, param, t) class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! current time ! Arguments - type(fraggle_encounter_snapshot) :: snapshot + class(encounter_snapshot), allocatable :: snapshot integer(I4B) :: i, npl_snap, ntp_snap associate(npl => self%pl%nbody, ntp => self%tp%nbody) + if (self%plplenc_list%lcollision) then + allocate(fraggle_encounter_snapshot :: snapshot) + else + allocate(encounter_snapshot :: snapshot) + end if snapshot%t = t snapshot%iloop = param%iloop @@ -1380,10 +1385,11 @@ module subroutine symba_util_take_encounter_snapshot(self, param, t) end select end select - if (self%plplenc_list%lcollision) then + select type(snapshot) + class is (fraggle_encounter_snapshot) allocate(snapshot%colliders, source=self%colliders) allocate(snapshot%fragments, source=self%fragments) - end if + end select ! Save the snapshot call symba_util_save_storage(self,snapshot,t) From aa96f8ea97bf39c5a7f77999d5402a234a6c111c Mon Sep 17 00:00:00 2001 From: David A Minton Date: Thu, 8 Dec 2022 19:35:40 -0500 Subject: [PATCH 351/569] Removed unecessary fraggle_storage type definition --- src/fraggle/fraggle_io.f90 | 6 ------ src/fraggle/fraggle_util.f90 | 13 ------------- src/modules/fraggle_classes.f90 | 18 ------------------ 3 files changed, 37 deletions(-) diff --git a/src/fraggle/fraggle_io.f90 b/src/fraggle/fraggle_io.f90 index 9d00bfb0f..6d912a5fb 100644 --- a/src/fraggle/fraggle_io.f90 +++ b/src/fraggle/fraggle_io.f90 @@ -13,12 +13,6 @@ contains - module subroutine fraggle_io_encounter_dump(self, param) - implicit none - class(fraggle_storage(*)), intent(inout) :: self !! Encounter storage object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - end subroutine fraggle_io_encounter_dump - module subroutine fraggle_io_encounter_initialize_output(self, param) implicit none class(fraggle_io_encounter_parameters), intent(inout) :: self !! Parameters used to identify a particular NetCDF dataset diff --git a/src/fraggle/fraggle_util.f90 b/src/fraggle/fraggle_util.f90 index 8688ec2d9..c65b96282 100644 --- a/src/fraggle/fraggle_util.f90 +++ b/src/fraggle/fraggle_util.f90 @@ -168,19 +168,6 @@ module subroutine fraggle_util_final_fragments(self) end subroutine fraggle_util_final_fragments - module subroutine fraggle_util_final_storage(self) - !! author: David A. Minton - !! - !! Finalizer will deallocate all allocatables - implicit none - ! Arguments - type(fraggle_storage(*)), intent(inout) :: self !! Fraggle encountar storage object - - call util_final_storage(self%swiftest_storage) - - return - end subroutine fraggle_util_final_storage - module subroutine fraggle_util_final_snapshot(self) !! author: David A. Minton !! diff --git a/src/modules/fraggle_classes.f90 b/src/modules/fraggle_classes.f90 index 581eb1a65..a7dcfedc8 100644 --- a/src/modules/fraggle_classes.f90 +++ b/src/modules/fraggle_classes.f90 @@ -115,13 +115,6 @@ module fraggle_classes procedure :: initialize => fraggle_io_encounter_initialize_output !! Initialize a set of parameters used to identify a NetCDF output object end type fraggle_io_encounter_parameters - !> A class that that is used to store fragmentation data between file output - type, extends(swiftest_storage) :: fraggle_storage - contains - procedure :: dump => fraggle_io_encounter_dump !! Dumps contents of encounter history to file - final :: fraggle_util_final_storage - end type fraggle_storage - type, extends(encounter_snapshot) :: fraggle_encounter_snapshot logical :: lcollision !! Indicates that this snapshot contains at least one collision class(fraggle_colliders), allocatable :: colliders !! Colliders object at this snapshot @@ -142,12 +135,6 @@ module subroutine fraggle_generate_fragments(self, colliders, system, param, lfa logical, intent(out) :: lfailure !! Answers the question: Should this have been a merger instead? end subroutine fraggle_generate_fragments - module subroutine fraggle_io_encounter_dump(self, param) - implicit none - class(fraggle_storage(*)), intent(inout) :: self !! Encounter storage object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - end subroutine fraggle_io_encounter_dump - module subroutine fraggle_io_encounter_initialize_output(self, param) implicit none class(fraggle_io_encounter_parameters), intent(inout) :: self !! Parameters used to identify a particular NetCDF dataset @@ -294,11 +281,6 @@ module subroutine fraggle_util_final_fragments(self) type(fraggle_fragments), intent(inout) :: self !! Fraggle encountar storage object end subroutine fraggle_util_final_fragments - module subroutine fraggle_util_final_storage(self) - implicit none - type(fraggle_storage(*)), intent(inout) :: self !! Fraggle encountar storage object - end subroutine fraggle_util_final_storage - module subroutine fraggle_util_final_snapshot(self) implicit none type(fraggle_encounter_snapshot), intent(inout) :: self !! Fraggle encountar storage object From 503156d3700cf271db5bf2e58912c79c6fb755fd Mon Sep 17 00:00:00 2001 From: David A Minton Date: Thu, 8 Dec 2022 22:55:41 -0500 Subject: [PATCH 352/569] Started to flesh out the fraggle netcdf output --- src/fraggle/fraggle_io.f90 | 100 ++++++++++++++++++++++++++++-- src/modules/encounter_classes.f90 | 2 +- src/modules/fraggle_classes.f90 | 29 ++++++--- src/modules/swiftest_classes.f90 | 2 +- src/setup/setup.f90 | 1 + src/symba/symba_io.f90 | 4 ++ src/symba/symba_util.f90 | 1 + 7 files changed, 123 insertions(+), 16 deletions(-) diff --git a/src/fraggle/fraggle_io.f90 b/src/fraggle/fraggle_io.f90 index 6d912a5fb..28457d570 100644 --- a/src/fraggle/fraggle_io.f90 +++ b/src/fraggle/fraggle_io.f90 @@ -13,18 +13,108 @@ contains - module subroutine fraggle_io_encounter_initialize_output(self, param) + module subroutine fraggle_io_initialize_output(self, param) + !! author: David A. Minton + !! + !! Initialize a NetCDF fragment history file system. This is a simplified version of the main simulation output NetCDF file, but with fewer variables. + use, intrinsic :: ieee_arithmetic + use netcdf implicit none - class(fraggle_io_encounter_parameters), intent(inout) :: self !! Parameters used to identify a particular NetCDF dataset + ! Arguments + class(fraggle_io_parameters), intent(inout) :: self !! Parameters used to identify a particular NetCDF dataset class(swiftest_parameters), intent(in) :: param - end subroutine fraggle_io_encounter_initialize_output + ! Internals + integer(I4B) :: i, nvar, varid, vartype + real(DP) :: dfill + real(SP) :: sfill + logical :: fileExists + character(len=STRMAX) :: errmsg + integer(I4B) :: ndims + + associate(nc => self) + dfill = ieee_value(dfill, IEEE_QUIET_NAN) + sfill = ieee_value(sfill, IEEE_QUIET_NAN) + + + select case (param%out_type) + case("NETCDF_FLOAT") + self%out_type = NF90_FLOAT + case("NETCDF_DOUBLE") + self%out_type = NF90_DOUBLE + end select + + ! Check if the file exists, and if it does, delete it + inquire(file=nc%frag_file, exist=fileExists) + if (fileExists) then + open(unit=LUN, file=nc%enc_file, status="old", err=667, iomsg=errmsg) + close(unit=LUN, status="delete") + end if + + + call check( nf90_create(nc%frag_file, NF90_NETCDF4, nc%id), "fraggle_io_initialize nf90_create" ) + + ! Dimensions + call check( nf90_def_dim(nc%id, nc%time_dimname, nc%time_dimsize, nc%time_dimid), "fraggle_io_initialize nf90_def_dim time_dimid" ) ! Simulation time dimension + call check( nf90_def_dim(nc%id, nc%space_dimname, NDIM , nc%space_dimid), "fraggle_io_initialize nf90_def_dim space_dimid" ) ! 3D space dimension + call check( nf90_def_dim(nc%id, nc%id_dimname, param%maxid, nc%id_dimid), "fraggle_io_initialize nf90_def_dim id_dimid" ) ! dimension to store particle id numbers + call check( nf90_def_dim(nc%id, nc%str_dimname, NAMELEN, nc%str_dimid), "fraggle_io_initialize nf90_def_dim str_dimid" ) ! Dimension for string variables (aka character arrays) + call check( nf90_def_dim(nc%id, nc%stage_dimname, 2, nc%stage_dimid), "fraggle_io_initialize nf90_def_dim stage_dimid" ) ! Dimension for stage variables (aka "before" vs. "after" + + ! Variables + call check( nf90_def_var(nc%id, nc%name_varname, NF90_CHAR, [nc%str_dimid, nc%id_dimid], nc%name_varid), "fraggle_io_initialize nf90_def_var name_varid" ) + call check( nf90_def_var(nc%id, nc%rh_varname, nc%out_type, [nc%space_dimid, nc%id_dimid, nc%time_dimid], nc%rh_varid), "fraggle_io_initialize nf90_def_var rh_varid" ) + call check( nf90_def_var(nc%id, nc%vh_varname, nc%out_type, [nc%space_dimid, nc%id_dimid, nc%time_dimid], nc%vh_varid), "fraggle_io_initialize nf90_def_var vh_varid" ) + call check( nf90_def_var(nc%id, nc%Gmass_varname, nc%out_type, [nc%id_dimid, nc%time_dimid], nc%Gmass_varid), "fraggle_io_initialize nf90_def_var Gmass_varid" ) + call check( nf90_def_var(nc%id, nc%loop_varname, NF90_INT, [nc%time_dimid], nc%loop_varid), "fraggle_io_initialize nf90_def_var loop_varid" ) + if (param%lclose) then + call check( nf90_def_var(nc%id, nc%radius_varname, nc%out_type, [nc%id_dimid, nc%time_dimid], nc%radius_varid), "fraggle_io_initialize nf90_def_var radius_varid" ) + end if + if (param%lrotation) then + call check( nf90_def_var(nc%id, nc%Ip_varname, nc%out_type, [nc%space_dimid, nc%id_dimid, nc%time_dimid], nc%Ip_varid), "fraggle_io_initialize nf90_def_var Ip_varid" ) + call check( nf90_def_var(nc%id, nc%rot_varname, nc%out_type, [nc%space_dimid, nc%id_dimid, nc%time_dimid], nc%rot_varid), "fraggle_io_initialize nf90_def_var rot_varid" ) + end if + + call check( nf90_inquire(nc%id, nVariables=nvar), "fraggle_io_initialize nf90_inquire nVariables" ) + do varid = 1, nvar + call check( nf90_inquire_variable(nc%id, varid, xtype=vartype, ndims=ndims), "fraggle_io_initialize nf90_inquire_variable" ) + select case(vartype) + case(NF90_INT) + call check( nf90_def_var_fill(nc%id, varid, 0, NF90_FILL_INT), "fraggle_io_initialize nf90_def_var_fill NF90_INT" ) + case(NF90_FLOAT) + call check( nf90_def_var_fill(nc%id, varid, 0, sfill), "fraggle_io_initialize nf90_def_var_fill NF90_FLOAT" ) + case(NF90_DOUBLE) + call check( nf90_def_var_fill(nc%id, varid, 0, dfill), "fraggle_io_initialize nf90_def_var_fill NF90_DOUBLE" ) + case(NF90_CHAR) + call check( nf90_def_var_fill(nc%id, varid, 0, 0), "fraggle_io_initialize nf90_def_var_fill NF90_CHAR" ) + end select + end do + ! Take the file out of define mode + call check( nf90_enddef(nc%id), "fraggle_io_initialize nf90_enddef" ) + + ! Add in the space and stage dimension coordinates + call check( nf90_put_var(nc%id, nc%space_varid, nc%space_coords, start=[1], count=[NDIM]), "fraggle_io_initialize nf90_put_var space" ) + call check( nf90_put_var(nc%id, nc%stage_varid, nc%stage_coords, start=[1], count=[2]), "fraggle_io_initialize nf90_put_var stage" ) + + ! Pre-fill id slots with ids + call check( nf90_put_var(nc%id, nc%id_varid, [(-1,i=1,param%maxid)], start=[1], count=[param%maxid]), "fraggle_io_initialize nf90_put_var pl id_varid" ) + end associate + + return - module subroutine fraggle_io_encounter_write_frame(self, nc, param) + 667 continue + write(*,*) "Error creating encounter output file. " // trim(adjustl(errmsg)) + call util_exit(FAILURE) + end subroutine fraggle_io_initialize_output + + + module subroutine fraggle_io_write_frame(self, nc, param) implicit none class(fraggle_encounter_snapshot), intent(in) :: self !! Swiftest encounter structure class(encounter_io_parameters), intent(inout) :: nc !! Parameters used to identify a particular encounter io NetCDF dataset class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - end subroutine fraggle_io_encounter_write_frame + + return + end subroutine fraggle_io_write_frame module subroutine fraggle_io_log_generate(frag) !! author: David A. Minton diff --git a/src/modules/encounter_classes.f90 b/src/modules/encounter_classes.f90 index 8bc1e00b7..b350f1a1c 100644 --- a/src/modules/encounter_classes.f90 +++ b/src/modules/encounter_classes.f90 @@ -68,7 +68,7 @@ module encounter_classes !> A class that that is used to store simulation history data between file output type, extends(swiftest_storage) :: encounter_storage - type(encounter_io_parameters) :: nc !! NetCDF parameter object containing the details about the file attached to this storage object + class(encounter_io_parameters), allocatable :: nc !! NetCDF parameter object containing the details about the file attached to this storage object contains procedure :: dump => encounter_io_dump !! Dumps contents of encounter history to file final :: encounter_util_final_storage diff --git a/src/modules/fraggle_classes.f90 b/src/modules/fraggle_classes.f90 index a7dcfedc8..d09c0d159 100644 --- a/src/modules/fraggle_classes.f90 +++ b/src/modules/fraggle_classes.f90 @@ -110,17 +110,28 @@ module fraggle_classes end type fraggle_fragments !! NetCDF dimension and variable names for the enounter save object - type, extends(encounter_io_parameters) :: fraggle_io_encounter_parameters + type, extends(encounter_io_parameters) :: fraggle_io_parameters + character(STRMAX) :: frag_file !! Encounter output file name + integer(I4B) :: stage_dimid !! ID for the name variable + integer(I4B) :: stage_varid !! ID for the name variable + character(NAMELEN) :: stage_dimname = "stage" !! name of the stage dimension (before/after) + character(len=6), dimension(2) :: stage_coords = ["before", "after "] !! The stage coordinate labels + + character(NAMELEN) :: Qloss_varname = "Qloss" !! name of the energy loss variable + integer(I4B) :: Qloss_varid !! ID for the energy loss variable + character(NAMELEN) :: regime_varname = "regime" !! name of the collision regime variable + integer(I4B) :: regime_varid !! ID for the collision regime variable + contains - procedure :: initialize => fraggle_io_encounter_initialize_output !! Initialize a set of parameters used to identify a NetCDF output object - end type fraggle_io_encounter_parameters + procedure :: initialize => fraggle_io_initialize_output !! Initialize a set of parameters used to identify a NetCDF output object + end type fraggle_io_parameters type, extends(encounter_snapshot) :: fraggle_encounter_snapshot logical :: lcollision !! Indicates that this snapshot contains at least one collision class(fraggle_colliders), allocatable :: colliders !! Colliders object at this snapshot class(fraggle_fragments), allocatable :: fragments !! Fragments object at this snapshot contains - procedure :: write_frame => fraggle_io_encounter_write_frame !! Writes a frame of encounter data to file + procedure :: write_frame => fraggle_io_write_frame !! Writes a frame of encounter data to file final :: fraggle_util_final_snapshot end type fraggle_encounter_snapshot @@ -135,18 +146,18 @@ module subroutine fraggle_generate_fragments(self, colliders, system, param, lfa logical, intent(out) :: lfailure !! Answers the question: Should this have been a merger instead? end subroutine fraggle_generate_fragments - module subroutine fraggle_io_encounter_initialize_output(self, param) + module subroutine fraggle_io_initialize_output(self, param) implicit none - class(fraggle_io_encounter_parameters), intent(inout) :: self !! Parameters used to identify a particular NetCDF dataset + class(fraggle_io_parameters), intent(inout) :: self !! Parameters used to identify a particular NetCDF dataset class(swiftest_parameters), intent(in) :: param - end subroutine fraggle_io_encounter_initialize_output + end subroutine fraggle_io_initialize_output - module subroutine fraggle_io_encounter_write_frame(self, nc, param) + module subroutine fraggle_io_write_frame(self, nc, param) implicit none class(fraggle_encounter_snapshot), intent(in) :: self !! Swiftest encounter structure class(encounter_io_parameters), intent(inout) :: nc !! Parameters used to identify a particular encounter io NetCDF dataset class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - end subroutine fraggle_io_encounter_write_frame + end subroutine fraggle_io_write_frame module subroutine fraggle_io_log_generate(frag) implicit none diff --git a/src/modules/swiftest_classes.f90 b/src/modules/swiftest_classes.f90 index abda5adc2..1bd1edef8 100644 --- a/src/modules/swiftest_classes.f90 +++ b/src/modules/swiftest_classes.f90 @@ -45,7 +45,7 @@ module swiftest_classes 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 + integer(I4B) :: name_varid !! ID for the name variable character(NAMELEN) :: npl_varname = "npl" !! name of the number of active massive bodies variable integer(I4B) :: npl_varid !! ID for the number of active massive bodies variable character(NAMELEN) :: ntp_varname = "ntp" !! name of the number of active test particles variable diff --git a/src/setup/setup.f90 b/src/setup/setup.f90 index 13e3ec9a1..481d35761 100644 --- a/src/setup/setup.f90 +++ b/src/setup/setup.f90 @@ -73,6 +73,7 @@ module subroutine setup_construct_system(system, param) class is (symba_parameters) if (param%lencounter_save) then if (.not. allocated(system%encounter_history)) allocate(encounter_storage :: system%encounter_history) + allocate(fraggle_io_parameters :: system%encounter_history%nc) call system%encounter_history%reset() system%encounter_history%nc%file_number = param%iloop / param%dump_cadence end if diff --git a/src/symba/symba_io.f90 b/src/symba/symba_io.f90 index 606d359cf..0fde607f6 100644 --- a/src/symba/symba_io.f90 +++ b/src/symba/symba_io.f90 @@ -26,6 +26,10 @@ module subroutine symba_io_dump_encounter(self, param) ! Create and save the output file for this encounter self%encounter_history%nc%time_dimsize = maxval(self%encounter_history%tslot(:)) write(self%encounter_history%nc%enc_file, '("encounter_",I0.6,".nc")') self%encounter_history%nc%file_number + select type(nc => self%encounter_history%nc) + class is (fraggle_io_parameters) + write(nc%frag_file, '("fragmentation_",I0.6,".nc")') nc%file_number + end select call self%encounter_history%nc%initialize(param) call self%encounter_history%dump(param) call self%encounter_history%nc%close() diff --git a/src/symba/symba_util.f90 b/src/symba/symba_util.f90 index ffd077f0e..faa6bf431 100644 --- a/src/symba/symba_util.f90 +++ b/src/symba/symba_util.f90 @@ -903,6 +903,7 @@ subroutine symba_util_save_storage(system, snapshot, t) tmp%tslot(1:nold) = system%encounter_history%tslot(1:nold) tmp%tslot(nold+1:nbig) = 0 tmp%iframe = system%encounter_history%iframe + call move_alloc(system%encounter_history%nc, tmp%nc) do i = 1, nold if (allocated(system%encounter_history%frame(i)%item)) call move_alloc(system%encounter_history%frame(i)%item, tmp%frame(i)%item) From da267de02fe9bf0cc750153e9406c6b1136d7db4 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Fri, 9 Dec 2022 12:17:26 -0500 Subject: [PATCH 353/569] Made a number of structural improvements to the outputting as I work on implementing a NetCDF-based fragmentation log file --- src/fraggle/fraggle_io.f90 | 75 ++++++++++++++------------------------ 1 file changed, 28 insertions(+), 47 deletions(-) diff --git a/src/fraggle/fraggle_io.f90 b/src/fraggle/fraggle_io.f90 index 28457d570..60b96f855 100644 --- a/src/fraggle/fraggle_io.f90 +++ b/src/fraggle/fraggle_io.f90 @@ -22,14 +22,14 @@ module subroutine fraggle_io_initialize_output(self, param) implicit none ! Arguments class(fraggle_io_parameters), intent(inout) :: self !! Parameters used to identify a particular NetCDF dataset - class(swiftest_parameters), intent(in) :: param + class(swiftest_parameters), intent(in) :: param ! Internals - integer(I4B) :: i, nvar, varid, vartype + integer(I4B) :: nvar, varid, vartype real(DP) :: dfill real(SP) :: sfill logical :: fileExists character(len=STRMAX) :: errmsg - integer(I4B) :: ndims + integer(I4B) :: i, ndims associate(nc => self) dfill = ieee_value(dfill, IEEE_QUIET_NAN) @@ -44,14 +44,14 @@ module subroutine fraggle_io_initialize_output(self, param) end select ! Check if the file exists, and if it does, delete it - inquire(file=nc%frag_file, exist=fileExists) + inquire(file=nc%file_name, exist=fileExists) if (fileExists) then - open(unit=LUN, file=nc%enc_file, status="old", err=667, iomsg=errmsg) + open(unit=LUN, file=nc%file_name, status="old", err=667, iomsg=errmsg) close(unit=LUN, status="delete") end if - call check( nf90_create(nc%frag_file, NF90_NETCDF4, nc%id), "fraggle_io_initialize nf90_create" ) + call check( nf90_create(nc%file_name, NF90_NETCDF4, nc%id), "fraggle_io_initialize nf90_create" ) ! Dimensions call check( nf90_def_dim(nc%id, nc%time_dimname, nc%time_dimsize, nc%time_dimid), "fraggle_io_initialize nf90_def_dim time_dimid" ) ! Simulation time dimension @@ -60,19 +60,32 @@ module subroutine fraggle_io_initialize_output(self, param) call check( nf90_def_dim(nc%id, nc%str_dimname, NAMELEN, nc%str_dimid), "fraggle_io_initialize nf90_def_dim str_dimid" ) ! Dimension for string variables (aka character arrays) call check( nf90_def_dim(nc%id, nc%stage_dimname, 2, nc%stage_dimid), "fraggle_io_initialize nf90_def_dim stage_dimid" ) ! Dimension for stage variables (aka "before" vs. "after" + ! Dimension coordinates + call check( nf90_def_var(nc%id, nc%time_dimname, nc%out_type, nc%time_dimid, nc%time_varid), "fraggle_io_initialize nf90_def_var time_varid" ) + call check( nf90_def_var(nc%id, nc%space_dimname, NF90_CHAR, nc%space_dimid, nc%space_varid), "fraggle_io_initialize nf90_def_var space_varid" ) + call check( nf90_def_var(nc%id, nc%id_dimname, NF90_INT, nc%id_dimid, nc%id_varid), "fraggle_io_initialize nf90_def_var id_varid" ) + call check( nf90_def_var(nc%id, nc%stage_dimname, NF90_CHAR, nc%stage_dimid, nc%stage_varid), "fraggle_io_initialize nf90_def_var stage_varid" ) + + ! Variables call check( nf90_def_var(nc%id, nc%name_varname, NF90_CHAR, [nc%str_dimid, nc%id_dimid], nc%name_varid), "fraggle_io_initialize nf90_def_var name_varid" ) call check( nf90_def_var(nc%id, nc%rh_varname, nc%out_type, [nc%space_dimid, nc%id_dimid, nc%time_dimid], nc%rh_varid), "fraggle_io_initialize nf90_def_var rh_varid" ) call check( nf90_def_var(nc%id, nc%vh_varname, nc%out_type, [nc%space_dimid, nc%id_dimid, nc%time_dimid], nc%vh_varid), "fraggle_io_initialize nf90_def_var vh_varid" ) call check( nf90_def_var(nc%id, nc%Gmass_varname, nc%out_type, [nc%id_dimid, nc%time_dimid], nc%Gmass_varid), "fraggle_io_initialize nf90_def_var Gmass_varid" ) call check( nf90_def_var(nc%id, nc%loop_varname, NF90_INT, [nc%time_dimid], nc%loop_varid), "fraggle_io_initialize nf90_def_var loop_varid" ) - if (param%lclose) then - call check( nf90_def_var(nc%id, nc%radius_varname, nc%out_type, [nc%id_dimid, nc%time_dimid], nc%radius_varid), "fraggle_io_initialize nf90_def_var radius_varid" ) - end if - if (param%lrotation) then - call check( nf90_def_var(nc%id, nc%Ip_varname, nc%out_type, [nc%space_dimid, nc%id_dimid, nc%time_dimid], nc%Ip_varid), "fraggle_io_initialize nf90_def_var Ip_varid" ) - call check( nf90_def_var(nc%id, nc%rot_varname, nc%out_type, [nc%space_dimid, nc%id_dimid, nc%time_dimid], nc%rot_varid), "fraggle_io_initialize nf90_def_var rot_varid" ) - end if + call check( nf90_def_var(nc%id, nc%radius_varname, nc%out_type, [nc%id_dimid, nc%time_dimid], nc%radius_varid), "fraggle_io_initialize nf90_def_var radius_varid" ) + call check( nf90_def_var(nc%id, nc%Ip_varname, nc%out_type, [nc%space_dimid, nc%id_dimid, nc%time_dimid], nc%Ip_varid), "fraggle_io_initialize nf90_def_var Ip_varid" ) + call check( nf90_def_var(nc%id, nc%rot_varname, nc%out_type, [nc%space_dimid, nc%id_dimid, nc%time_dimid], nc%rot_varid), "fraggle_io_initialize nf90_def_var rot_varid" ) + call check( nf90_def_var(nc%id, nc%ke_orb_varname, nc%out_type, nc%time_dimid, nc%KE_orb_varid), "netcdf_initialize_output nf90_def_var KE_orb_varid" ) + call check( nf90_def_var(nc%id, nc%ke_spin_varname, nc%out_type, nc%time_dimid, nc%KE_spin_varid), "netcdf_initialize_output nf90_def_var KE_spin_varid" ) + call check( nf90_def_var(nc%id, nc%pe_varname, nc%out_type, nc%time_dimid, nc%PE_varid), "netcdf_initialize_output nf90_def_var PE_varid" ) + call check( nf90_def_var(nc%id, nc%L_orb_varname, nc%out_type, [nc%space_dimid, nc%time_dimid], nc%L_orb_varid), "netcdf_initialize_output nf90_def_var L_orb_varid" ) + call check( nf90_def_var(nc%id, nc%L_spin_varname, nc%out_type, [nc%space_dimid, nc%time_dimid], nc%L_spin_varid), "netcdf_initialize_output nf90_def_var L_spin_varid" ) + call check( nf90_def_var(nc%id, nc%L_escape_varname, nc%out_type, [nc%space_dimid, nc%time_dimid], nc%L_escape_varid), "netcdf_initialize_output nf90_def_var L_escape_varid" ) + call check( nf90_def_var(nc%id, nc%Ecollisions_varname, nc%out_type, nc%time_dimid, nc%Ecollisions_varid), "netcdf_initialize_output nf90_def_var Ecollisions_varid" ) + call check( nf90_def_var(nc%id, nc%Euntracked_varname, nc%out_type, nc%time_dimid, nc%Euntracked_varid), "netcdf_initialize_output nf90_def_var Euntracked_varid" ) + call check( nf90_def_var(nc%id, nc%GMescape_varname, nc%out_type, nc%time_dimid, nc%GMescape_varid), "netcdf_initialize_output nf90_def_var GMescape_varid" ) + call check( nf90_inquire(nc%id, nVariables=nvar), "fraggle_io_initialize nf90_inquire nVariables" ) do varid = 1, nvar @@ -102,7 +115,7 @@ module subroutine fraggle_io_initialize_output(self, param) return 667 continue - write(*,*) "Error creating encounter output file. " // trim(adjustl(errmsg)) + write(*,*) "Error creating fragmentation output file. " // trim(adjustl(errmsg)) call util_exit(FAILURE) end subroutine fraggle_io_initialize_output @@ -110,44 +123,12 @@ end subroutine fraggle_io_initialize_output module subroutine fraggle_io_write_frame(self, nc, param) implicit none class(fraggle_encounter_snapshot), intent(in) :: self !! Swiftest encounter structure - class(encounter_io_parameters), intent(inout) :: nc !! Parameters used to identify a particular encounter io NetCDF dataset + class(encounter_io_parameters), intent(inout) :: nc !! Parameters used to identify a particular encounter io NetCDF dataset class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters return end subroutine fraggle_io_write_frame - module subroutine fraggle_io_log_generate(frag) - !! author: David A. Minton - !! - !! Writes a log of the results of the fragment generation - implicit none - ! Arguments - class(fraggle_fragments), intent(in) :: frag - ! Internals - integer(I4B) :: i - character(STRMAX) :: errmsg - character(len=*), parameter :: fmtlabel = "(A14,10(ES11.4,1X,:))" - - open(unit=LUN, file=FRAGGLE_LOG_OUT, status = 'OLD', position = 'APPEND', form = 'FORMATTED', err = 667, iomsg = errmsg) - write(LUN, *, err = 667, iomsg = errmsg) - write(LUN, *) "--------------------------------------------------------------------" - write(LUN, *) " Fraggle fragment generation results" - write(LUN, *) "--------------------------------------------------------------------" - write(LUN, "(' dL_tot should be very small' )") - write(LUN,fmtlabel) ' dL_tot |', (.mag.(frag%Ltot_after(:) - frag%Ltot_before(:))) / (.mag.frag%Ltot_before(:)) - write(LUN, "(' dE_tot should be negative and equal to Qloss' )") - write(LUN,fmtlabel) ' dE_tot |', (frag%Etot_after - frag%Etot_before) / abs(frag%Etot_before) - write(LUN,fmtlabel) ' Qloss |', -frag%Qloss / abs(frag%Etot_before) - write(LUN,fmtlabel) ' dE - Qloss |', (frag%Etot_after - frag%Etot_before + frag%Qloss) / abs(frag%Etot_before) - write(LUN, "(' -------------------------------------------------------------------------------------')") - - close(LUN) - - return - 667 continue - write(*,*) "Error writing Fraggle message to log file: " // trim(adjustl(errmsg)) - end subroutine fraggle_io_log_generate - module subroutine fraggle_io_log_pl(pl, param) !! author: David A. Minton From 3e678c1c5c835986fbccddeee6d2b203b4f3b0a6 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Fri, 9 Dec 2022 12:18:55 -0500 Subject: [PATCH 354/569] Made a number of structural improvements to the outputting as I work on implementing a NetCDF-based fragmentation log file (take 2) --- python/swiftest/swiftest/io.py | 3 +- python/swiftest/swiftest/simulation_class.py | 3 +- src/encounter/encounter_io.f90 | 43 ++++++++++---------- src/fraggle/fraggle_generate.f90 | 1 - src/io/io.f90 | 5 ++- src/modules/encounter_classes.f90 | 6 +-- src/modules/fraggle_classes.f90 | 12 ++---- src/modules/swiftest_classes.f90 | 1 + src/modules/symba_classes.f90 | 16 ++++---- src/netcdf/netcdf.f90 | 13 +++--- src/setup/setup.f90 | 8 ++-- src/symba/symba_io.f90 | 29 +++++++------ src/symba/symba_util.f90 | 3 +- 13 files changed, 75 insertions(+), 68 deletions(-) diff --git a/python/swiftest/swiftest/io.py b/python/swiftest/swiftest/io.py index f33535327..5331e50fd 100644 --- a/python/swiftest/swiftest/io.py +++ b/python/swiftest/swiftest/io.py @@ -827,7 +827,8 @@ def process_netcdf_input(ds, param): if "id" in ds.dims: if len(np.unique(ds['name'])) == len(ds['name']): ds = ds.swap_dims({"id" : "name"}) - ds = ds.reset_coords("id") + if "id" in ds: + ds = ds.reset_coords("id") return ds diff --git a/python/swiftest/swiftest/simulation_class.py b/python/swiftest/swiftest/simulation_class.py index 8fb77ab4a..8f6a8d9dd 100644 --- a/python/swiftest/swiftest/simulation_class.py +++ b/python/swiftest/swiftest/simulation_class.py @@ -2505,7 +2505,8 @@ def _combine_and_fix_dsnew(self,dsnew): if "id" not in self.data.dims: if len(np.unique(dsnew['name'])) == len(dsnew['name']): dsnew = dsnew.swap_dims({"id" : "name"}) - dsnew = dsnew.reset_coords("id") + if "id" in dsnew: + dsnew = dsnew.reset_coords("id") else: msg = "Non-unique names detected for bodies. The Dataset will be dimensioned by integer id instead of name." msg +="\nConsider using unique names instead." diff --git a/src/encounter/encounter_io.f90 b/src/encounter/encounter_io.f90 index 7c3730df2..22412e97f 100644 --- a/src/encounter/encounter_io.f90 +++ b/src/encounter/encounter_io.f90 @@ -25,15 +25,14 @@ module subroutine encounter_io_dump(self, param) do i = 1, self%nframes if (allocated(self%frame(i)%item)) then + param%ioutput = self%tslot(i) + select type(snapshot => self%frame(i)%item) + class is (fraggle_encounter_snapshot) + call snapshot%write_frame(self%ncc,param) + call snapshot%encounter_snapshot%write_frame(self%nce,param) class is (encounter_snapshot) - param%ioutput = self%tslot(i) - call snapshot%write_frame(self%nc,param) - select type(snapshot) ! Be sure to call the base class method to get the regular encounter data sved - class is (fraggle_encounter_snapshot) - call snapshot%encounter_snapshot%write_frame(self%nc,param) - end select - + call snapshot%write_frame(self%nce,param) end select else exit @@ -56,12 +55,13 @@ module subroutine encounter_io_initialize(self, param) 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 - integer(I4B) :: i, nvar, varid, vartype + integer(I4B) :: nvar, varid, vartype real(DP) :: dfill real(SP) :: sfill logical :: fileExists character(len=STRMAX) :: errmsg - integer(I4B) :: ndims + integer(I4B) :: ndims, i + character(len=NAMELEN) :: charstring associate(nc => self) dfill = ieee_value(dfill, IEEE_QUIET_NAN) @@ -75,13 +75,13 @@ module subroutine encounter_io_initialize(self, param) end select ! Check if the file exists, and if it does, delete it - inquire(file=nc%enc_file, exist=fileExists) + inquire(file=nc%file_name, exist=fileExists) if (fileExists) then - open(unit=LUN, file=nc%enc_file, status="old", err=667, iomsg=errmsg) + open(unit=LUN, file=nc%file_name, status="old", err=667, iomsg=errmsg) close(unit=LUN, status="delete") end if - call check( nf90_create(nc%enc_file, NF90_NETCDF4, nc%id), "encounter_io_initialize nf90_create" ) + call check( nf90_create(nc%file_name, NF90_NETCDF4, nc%id), "encounter_io_initialize nf90_create" ) ! Dimensions call check( nf90_def_dim(nc%id, nc%time_dimname, nc%time_dimsize, nc%time_dimid), "encounter_io_initialize nf90_def_dim time_dimid" ) ! Simulation time dimension @@ -130,8 +130,7 @@ module subroutine encounter_io_initialize(self, param) ! Add in the space dimension coordinates call check( nf90_put_var(nc%id, nc%space_varid, nc%space_coords, start=[1], count=[NDIM]), "encounter_io_initialize nf90_put_var space" ) - ! Pre-fill id slots with ids - + ! Pre-fill name slots with ids call check( nf90_put_var(nc%id, nc%id_varid, [(-1,i=1,param%maxid)], start=[1], count=[param%maxid]), "encounter_io_initialize nf90_put_var pl id_varid" ) end associate @@ -151,20 +150,20 @@ module subroutine encounter_io_write_frame(self, nc, param) implicit none ! Arguments class(encounter_snapshot), intent(in) :: self !! Swiftest encounter structure - class(encounter_io_parameters), intent(inout) :: nc !! Parameters used to identify a particular encounter io NetCDF dataset + class(encounter_io_parameters), intent(inout) :: nc !! Parameters used to identify a particular encounter io NetCDF dataset class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters ! Internals integer(I4B) :: i, tslot, idslot, old_mode, npl, ntp character(len=NAMELEN) :: charstring tslot = param%ioutput + associate(pl => self%pl, tp => self%tp) - call check( nf90_set_fill(nc%id, nf90_nofill, old_mode), "encounter_io_write_frame nf90_set_fill" ) - - call check( nf90_put_var(nc%id, nc%time_varid, self%t, start=[tslot]), "encounter_io_write_frame nf90_put_var time_varid" ) - call check( nf90_put_var(nc%id, nc%loop_varid, int(self%iloop,kind=I4B), start=[tslot]), "encounter_io_write_frame nf90_put_var pl loop_varid" ) + call check( nf90_set_fill(nc%id, nf90_nofill, old_mode), "encounter_io_write_frame nf90_set_fill" ) + + call check( nf90_put_var(nc%id, nc%time_varid, self%t, start=[tslot]), "encounter_io_write_frame nf90_put_var time_varid" ) + call check( nf90_put_var(nc%id, nc%loop_varid, int(self%iloop,kind=I4B), start=[tslot]), "encounter_io_write_frame nf90_put_var pl loop_varid" ) - associate(pl => self%pl, tp => self%tp) npl = pl%nbody do i = 1, npl idslot = pl%id(i) @@ -198,9 +197,9 @@ module subroutine encounter_io_write_frame(self, nc, param) charstring = trim(adjustl(tp%info(i)%particle_type)) call check( nf90_put_var(nc%id, nc%ptype_varid, charstring, start=[1, idslot], count=[NAMELEN, 1]), "encounter_io_write_frame nf90_put_var tp particle_type_varid" ) end do - end associate - call check( nf90_set_fill(nc%id, old_mode, old_mode) ) + call check( nf90_set_fill(nc%id, old_mode, old_mode) ) + end associate return end subroutine encounter_io_write_frame diff --git a/src/fraggle/fraggle_generate.f90 b/src/fraggle/fraggle_generate.f90 index 3ec23ef99..4da30c3d8 100644 --- a/src/fraggle/fraggle_generate.f90 +++ b/src/fraggle/fraggle_generate.f90 @@ -151,7 +151,6 @@ module subroutine fraggle_generate_fragments(self, colliders, system, param, lfa else call io_log_one_message(FRAGGLE_LOG_OUT, "Fraggle fragment generation succeeded after " // & trim(adjustl(message)) // " tries") - call fraggle_io_log_generate(frag) end if call frag%set_original_scale(colliders) diff --git a/src/io/io.f90 b/src/io/io.f90 index f0c1cb994..74116d5b0 100644 --- a/src/io/io.f90 +++ b/src/io/io.f90 @@ -253,7 +253,7 @@ module subroutine io_dump_system(self, param) call dump_param%dump(param_file_name) dump_param%out_form = "XV" - dump_param%outfile = trim(adjustl(DUMP_NC_FILE(idx))) + dump_param%nc%file_name = trim(adjustl(DUMP_NC_FILE(idx))) dump_param%ioutput = 1 call dump_param%nc%initialize(dump_param) call self%write_frame(dump_param%nc, dump_param) @@ -1312,7 +1312,7 @@ module subroutine io_read_in_system(self, param) self%Euntracked = param%Euntracked else allocate(tmp_param, source=param) - tmp_param%outfile = param%in_netcdf + tmp_param%nc%file_name = param%in_netcdf tmp_param%out_form = param%in_form if (.not. param%lrestart) then ! Turn off energy computation so we don't have to feed it into the initial conditions @@ -1549,6 +1549,7 @@ module subroutine io_write_frame_system(self, param) param%nc%id_chunk = self%pl%nbody + self%tp%nbody param%nc%time_chunk = max(param%dump_cadence / param%istep_out, 1) + param%nc%file_name = param%outfile if (lfirst) then inquire(file=param%outfile, exist=fileExists) diff --git a/src/modules/encounter_classes.f90 b/src/modules/encounter_classes.f90 index b350f1a1c..2af59b94b 100644 --- a/src/modules/encounter_classes.f90 +++ b/src/modules/encounter_classes.f90 @@ -56,7 +56,6 @@ module encounter_classes !> NetCDF dimension and variable names for the enounter save object type, extends(netcdf_parameters) :: encounter_io_parameters integer(I4B) :: ienc_frame = 1 !! Current frame number for the encounter history - character(STRMAX) :: enc_file !! Encounter output file name character(NAMELEN) :: loop_varname = "loopnum" !! Loop number for encounter integer(I4B) :: loop_varid !! ID for the recursion level variable integer(I4B) :: time_dimsize = 0 !! Number of time values in snapshot @@ -68,7 +67,8 @@ module encounter_classes !> A class that that is used to store simulation history data between file output type, extends(swiftest_storage) :: encounter_storage - class(encounter_io_parameters), allocatable :: nc !! NetCDF parameter object containing the details about the file attached to this storage object + class(encounter_io_parameters), allocatable :: nce !! NetCDF parameter object containing the details about the encounter file attached to this storage object + class(encounter_io_parameters), allocatable :: ncc !! NetCDF parameter object containing the details about the collision file attached to this storage object contains procedure :: dump => encounter_io_dump !! Dumps contents of encounter history to file final :: encounter_util_final_storage @@ -221,7 +221,7 @@ end subroutine encounter_io_initialize module subroutine encounter_io_write_frame(self, nc, param) implicit none class(encounter_snapshot), intent(in) :: self !! Swiftest encounter structure - class(encounter_io_parameters), intent(inout) :: nc !! Parameters used to identify a particular encounter io NetCDF dataset + class(encounter_io_parameters), intent(inout) :: nc !! 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 diff --git a/src/modules/fraggle_classes.f90 b/src/modules/fraggle_classes.f90 index d09c0d159..0aa7421a3 100644 --- a/src/modules/fraggle_classes.f90 +++ b/src/modules/fraggle_classes.f90 @@ -10,10 +10,10 @@ module fraggle_classes !! author: The Purdue Swiftest Team - David A. Minton, Carlisle A. Wishard, Jennifer L.L. Pouplin, and Jacob R. Elliott !! - !! Definition of classes and methods specific to Fraggel: The Fragment Generation Model + !! Definition of classes and methods specific to Fraggle: *Frag*ment *g*eneration that conserves angular momentum (*L*) and energy (*E*) use swiftest_globals use swiftest_classes, only : swiftest_parameters, swiftest_nbody_system, swiftest_cb, swiftest_pl, swiftest_storage, netcdf_parameters - use encounter_classes, only : encounter_snapshot, encounter_io_parameters + use encounter_classes, only : encounter_snapshot, encounter_io_parameters, encounter_storage implicit none public @@ -111,7 +111,6 @@ module fraggle_classes !! NetCDF dimension and variable names for the enounter save object type, extends(encounter_io_parameters) :: fraggle_io_parameters - character(STRMAX) :: frag_file !! Encounter output file name integer(I4B) :: stage_dimid !! ID for the name variable integer(I4B) :: stage_varid !! ID for the name variable character(NAMELEN) :: stage_dimname = "stage" !! name of the stage dimension (before/after) @@ -155,15 +154,10 @@ end subroutine fraggle_io_initialize_output module subroutine fraggle_io_write_frame(self, nc, param) implicit none class(fraggle_encounter_snapshot), intent(in) :: self !! Swiftest encounter structure - class(encounter_io_parameters), intent(inout) :: nc !! Parameters used to identify a particular encounter io NetCDF dataset + class(encounter_io_parameters), intent(inout) :: nc !! Parameters used to identify a particular encounter io NetCDF dataset class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters end subroutine fraggle_io_write_frame - module subroutine fraggle_io_log_generate(frag) - implicit none - class(fraggle_fragments), intent(in) :: frag - end subroutine fraggle_io_log_generate - module subroutine fraggle_io_log_pl(pl, param) implicit none class(swiftest_pl), intent(in) :: pl !! Swiftest massive body object (only the new bodies generated in a collision) diff --git a/src/modules/swiftest_classes.f90 b/src/modules/swiftest_classes.f90 index 1bd1edef8..9c60dd884 100644 --- a/src/modules/swiftest_classes.f90 +++ b/src/modules/swiftest_classes.f90 @@ -20,6 +20,7 @@ module swiftest_classes !! 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 + character(STRMAX) :: file_name !! Name of the output file 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 diff --git a/src/modules/symba_classes.f90 b/src/modules/symba_classes.f90 index c30762243..a896c3dc1 100644 --- a/src/modules/symba_classes.f90 +++ b/src/modules/symba_classes.f90 @@ -16,7 +16,7 @@ module symba_classes use swiftest_classes, only : swiftest_parameters, swiftest_base, swiftest_particle_info, swiftest_storage, 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, encounter_storage, encounter_snapshot + use encounter_classes, only : encounter_list, encounter_snapshot, encounter_storage implicit none public @@ -184,13 +184,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 - type(fraggle_colliders) :: colliders !! Fraggle colliders object - type(fraggle_fragments) :: fragments !! Fraggle fragmentation system object + 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(fraggle_colliders) :: colliders !! Fraggle colliders object + type(fraggle_fragments) :: fragments !! Fraggle fragmentation system object type(encounter_storage(nframes=:)), allocatable :: encounter_history !! Stores encounter history for later retrieval and saving to file contains procedure :: write_discard => symba_io_write_discard !! Write out information about discarded and merged planets and test particles in SyMBA diff --git a/src/netcdf/netcdf.f90 b/src/netcdf/netcdf.f90 index ad5d7bbeb..d44cbb5a7 100644 --- a/src/netcdf/netcdf.f90 +++ b/src/netcdf/netcdf.f90 @@ -172,14 +172,14 @@ module subroutine netcdf_initialize_output(self, param) end select ! Check if the file exists, and if it does, delete it - inquire(file=param%outfile, exist=fileExists) + inquire(file=nc%file_name, exist=fileExists) if (fileExists) then - open(unit=LUN, file=param%outfile, status="old", err=667, iomsg=errmsg) + open(unit=LUN, file=nc%file_name, status="old", err=667, iomsg=errmsg) close(unit=LUN, status="delete") end if ! Create the file - call check( nf90_create(param%outfile, NF90_NETCDF4, nc%id), "netcdf_initialize_output nf90_create" ) + call check( nf90_create(nc%file_name, NF90_NETCDF4, nc%id), "netcdf_initialize_output nf90_create" ) ! Dimensions call check( nf90_def_dim(nc%id, nc%time_dimname, NF90_UNLIMITED, nc%time_dimid), "netcdf_initialize_output nf90_def_dim time_dimid" ) ! Simulation time dimension @@ -324,8 +324,8 @@ module subroutine netcdf_open(self, param, readonly) associate(nc => self) - write(errmsg,*) "netcdf_open nf90_open ",trim(adjustl(param%outfile)) - call check( nf90_open(param%outfile, mode, nc%id), errmsg) + write(errmsg,*) "netcdf_open nf90_open ",trim(adjustl(nc%file_name)) + call check( nf90_open(nc%file_name, mode, nc%id), errmsg) ! Dimensions call check( nf90_inq_dimid(nc%id, nc%time_dimname, nc%time_dimid), "netcdf_open nf90_inq_dimid time_dimid" ) @@ -824,6 +824,9 @@ module subroutine netcdf_read_particle_info_system(self, nc, param, plmask, tpma cb%id = itemp(1) pl%id(:) = pack(itemp, plmask) tp%id(:) = pack(itemp, tpmask) + cb%id = 0 + pl%id(:) = pack([(i,i=1,idmax)],plmask) + tp%id(:) = pack([(i,i=1,idmax)],tpmask) call check( nf90_get_var(nc%id, nc%name_varid, ctemp, count=[NAMELEN, idmax]), "netcdf_read_particle_info_system nf90_getvar name_varid" ) call cb%info%set_value(name=ctemp(1)) diff --git a/src/setup/setup.f90 b/src/setup/setup.f90 index 481d35761..835d1c995 100644 --- a/src/setup/setup.f90 +++ b/src/setup/setup.f90 @@ -72,10 +72,12 @@ module subroutine setup_construct_system(system, param) select type(param) class is (symba_parameters) if (param%lencounter_save) then - if (.not. allocated(system%encounter_history)) allocate(encounter_storage :: system%encounter_history) - allocate(fraggle_io_parameters :: system%encounter_history%nc) + allocate(encounter_storage :: system%encounter_history) + allocate(encounter_io_parameters :: system%encounter_history%nce) + allocate(fraggle_io_parameters :: system%encounter_history%ncc) call system%encounter_history%reset() - system%encounter_history%nc%file_number = param%iloop / param%dump_cadence + system%encounter_history%nce%file_number = param%iloop / param%dump_cadence + system%encounter_history%ncc%file_number = param%iloop / param%dump_cadence end if end select end select diff --git a/src/symba/symba_io.f90 b/src/symba/symba_io.f90 index 0fde607f6..6c1d53a6c 100644 --- a/src/symba/symba_io.f90 +++ b/src/symba/symba_io.f90 @@ -22,18 +22,23 @@ module subroutine symba_io_dump_encounter(self, param) class(symba_parameters), intent(inout) :: param !! Current run configuration parameters if (self%encounter_history%iframe == 0) return ! No enounters in this interval - self%encounter_history%nc%file_number = self%encounter_history%nc%file_number + 1 - ! Create and save the output file for this encounter - self%encounter_history%nc%time_dimsize = maxval(self%encounter_history%tslot(:)) - write(self%encounter_history%nc%enc_file, '("encounter_",I0.6,".nc")') self%encounter_history%nc%file_number - select type(nc => self%encounter_history%nc) - class is (fraggle_io_parameters) - write(nc%frag_file, '("fragmentation_",I0.6,".nc")') nc%file_number - end select - call self%encounter_history%nc%initialize(param) - call self%encounter_history%dump(param) - call self%encounter_history%nc%close() - call self%encounter_history%reset() + + associate(encounter_history => self%encounter_history, nce => self%encounter_history%nce, ncc => self%encounter_history%ncc, iframe => self%encounter_history%iframe) + + ! Create and save the output files for this encounter and fragmentation + nce%file_number = nce%file_number + 1 + ncc%file_number = ncc%file_number + 1 + nce%time_dimsize = maxval(encounter_history%tslot(:)) + ncc%time_dimsize = maxval(encounter_history%tslot(:)) + write(nce%file_name, '("encounter_",I0.6,".nc")') nce%file_number + write(ncc%file_name, '("fragmentation_",I0.6,".nc")') ncc%file_number + call nce%initialize(param) + call ncc%initialize(param) + call encounter_history%dump(param) + call nce%close() + call ncc%close() + call encounter_history%reset() + end associate return end subroutine symba_io_dump_encounter diff --git a/src/symba/symba_util.f90 b/src/symba/symba_util.f90 index faa6bf431..5d8a4a444 100644 --- a/src/symba/symba_util.f90 +++ b/src/symba/symba_util.f90 @@ -903,7 +903,8 @@ subroutine symba_util_save_storage(system, snapshot, t) tmp%tslot(1:nold) = system%encounter_history%tslot(1:nold) tmp%tslot(nold+1:nbig) = 0 tmp%iframe = system%encounter_history%iframe - call move_alloc(system%encounter_history%nc, tmp%nc) + call move_alloc(system%encounter_history%nce, tmp%nce) + call move_alloc(system%encounter_history%ncc, tmp%ncc) do i = 1, nold if (allocated(system%encounter_history%frame(i)%item)) call move_alloc(system%encounter_history%frame(i)%item, tmp%frame(i)%item) From daa3e1d817e0ea720239801c0c0696d6a1a13b09 Mon Sep 17 00:00:00 2001 From: Carlisle Wishard Date: Fri, 9 Dec 2022 15:18:29 -0500 Subject: [PATCH 355/569] continued to update the README --- README.md | 239 ++++++++++++++++++++++++++++++++---------------------- 1 file changed, 142 insertions(+), 97 deletions(-) diff --git a/README.md b/README.md index 41f5ecea4..8309f911c 100644 --- a/README.md +++ b/README.md @@ -133,6 +133,120 @@ $ ipython kernel install --user --name EnvName --display-name "Swiftest Kernel" Swiftest is built to make running a Swiftest simulation a streamlined and user friendly experience, even for a new user. As a result, Swiftest is highly flexible and a simulation can be created, run, and processed in a number of different ways. The first choice the user must make is if they would prefer ASCII input files or NetCDF input files. We recommend NetCDF input files, however we include documentation for ASCII input files for completeness. +**NetCDF Input Files (Recommended)** + +Swiftest accepts a single NetCDF input file. This file can be created using the Swiftest Python Package through a few simple steps. + +To begin, simply create a new Python script in the directory you would like to store your simulation. Open the new script and import the Swiftest Python package. + +``` +import swiftest +``` + +Next, we initialize the Swiftest simulation object. Various parameters can be provided to the simulation via key word arguments at this stage. + +``` +sim = swiftest.Simulation(**kwargs) +``` + +The key word arguments available to the user, along with the default values for these arguments, are as follows: + +| Key Word Name | Key Word Description | Options | Compatible Integrators | +|---------------------------------|----------------------------------------------------------------------------------------------------|----------------------------------------------------------------------------------------------------|------------------------| +|```simdir``` | Path to subdirectory in which to store data. Default is ```/simdir```. | pathlike string (ex. ```path/to/directory```) | all +|```read_param``` | Read in a pre-existing parameter input file. Default is ```False```. | ```True```, ```False``` | all +|```param_file``` | Name of the pre-existing parameter input file. Only used if ```read_param``` is set to ```True```. | string (ex. ```param.in```) | all +|```read_old_output_file``` | Read in a pre-existing simulation output file. Default is ```False```. | ```True```, ```False``` | all +|```codename``` | Name of the N-body code to use. Default is ```Swiftest```. | ```Swiftest```, ```Swifter```, ```Swift``` | all +|```integrator``` | Name of the N-body integrator to use. Default is ```symba```. | ```symba```, ```helio```, ```rmvs```, ```whm``` | all +|```t0``` | The reference time for the start of the simulation in time units. Default is ```0.0```. | floating point (ex. ```0.0```) | all +|```tstart``` | Simulation start time for a restarted run in time units. Default is ```0.0```. | floating point (ex. ```0.0```) | all +|```tstop``` | Simulation end time in time units. Must be greater than ```tstart```. | floating point (ex. ```100.0```) | all +|```dt``` | Simulation step size in time units. Must be less than or equal to ```tstop```-```tstart```. | floating point (ex. ```0.005```) | all +|```istep_out``` | The number of time steps (```dt```) between output saves to memory. Either ```istep_out``` **OR** ```tstep_out``` may be set. Default is ```1```. | integer (ex. ```200```) | all +|```dump_cadence``` | The number of output steps between when data saved to memory is written to file. Setting to ```0``` results in writing data to file only at the completion of the simulation. Default is ```10```. | integer (ex. ```10```) | all +|```tstep_out``` | The approximate time between when outputs saved in memory are written to file in time units. Either ```istep_out``` **OR** ```tstep_out``` may be set. | floating point (ex. ```10.0```) that calculates ```istep_out = floor(tstep_out / dt)``` | all +|```init_cond_file_type``` | Input file format. Default is ```NETCDF_DOUBLE```. | ```NETCDF_DOUBLE```, ```NETCDF_FLOAT```, ```ASCII``` | all +|```init_cond_file_name``` | Input file name(s). If ```init_cond_file_type``` is set to ```NETCDF_DOUBLE``` or ```NETCDF_FLOAT```, default is ```init_cond.nc```. If ```init_cond_file_type``` is set to ```ASCII```, default is a dictionary: ```{"CB" : "cb.in", "PL" : "pl.in", "TP" : "tp.in"}```. | string (ex. ```my_init_cond.nc```) or dictionary ```{"CB" : "mycb.in", "PL" : "mypl.in", "TP" : "mytp.in"}``` | all +|```init_cond_format``` | Input format. Default is ```EL```. | ```EL```, ```XV``` | all +|```output_file_type``` | Output file format. Default is ```NETCDF_DOUBLE```. ```REAL4```, ```REAL8```, ```XDR4```, ```XDR8``` Swifter/Swift only. | ```NETCDF_DOUBLE```, ```NETCDF_FLOAT```, ```REAL4```, ```REAL8```, ```XDR4```, ```XDR8``` | all +|```output_file_name``` | Output file name. Default is ```bin.nc```. | string (ex. ```mydata.nc```) | all +|```output_format``` | Output format. Default is ```XVEL```. | ```XV```, ```XVEL``` | all +|```MU``` | Mass unit system to use in the simulation. Default is ```Msun```. | ```Msun```, ```Mearth```, ```kg```, ```g``` (case-insensitive) | all +|```DU``` | Distance unit system to use in the simulation. Default is ```AU```. | ```AU```, ```Rearth```, ```m```, ```cm``` (case-insensitive) | all +|```TU``` | Time unit system to use in the simulation. Default is ```Y```. | ```Y```, ```YR```, ```DAY``` (Julian day), ```d``` (Julian day), ```JD``` (Julian day), ```s``` (case-insensitive) | all +|```MU2KG``` | Mass units to kilogram conversion factor. Overrides ```MU```. | floating point (ex. ```1.988409870698051e+30```) | all +|```DU2M``` | Distance units to meters conversion factor. Overrides ```DU```. | floating point (ex. ```31557600.0```) | all +|```TU2S``` | Time units to seconds conversion factor. Overrides ```TU```. | floating point (ex. ```149597870700.0```) | all +|```rmin``` | Heliocentric distance at which a test particle is considered merged with the central body in distance units. Default is the radius of the central body in system units. | floating point (ex. ```0.3```) | all +|```rmax``` | Heliocentric distance at which a test particle is too distant from the central body in distance units. Default is ```10000.0 AU```. | floating point (ex. ```10000.0```) | all +|```qmin_coord``` | Coordinate frame used to check for minimum pericenter distance. Default is ```HELIO```. | ```HELIO```, ```BARY``` | all +|```mtiny``` | Mass cutoff between fully and semi-interacting massive bodies in mass units. Either ```mtiny``` **OR** ```gmtiny``` may be set. | floating point (ex. ```1e23```) | all +|```gmtiny``` | Mass cutoff between fully and semi-interacting massive bodies in gravitational mass units. Default is ```0.0```. Either ```mtiny``` **OR** ```gmtiny``` may be set. | floating point (ex. ```4e-6```) | all +|```close_encounter_check``` | Check for close encounters. Default is ```True```. Requires radius of massive bodies to be provided in initial conditions. | ```True```, ```False``` | all +|```general_relativity``` | General relativity. Default is ```True```. | ```True```, ```False``` | all +|```fragmentation``` | Resolve collisions with fragmentation. Default is ```False```. | ```True```, ```False``` | SyMBA +|```minimum_fragment_gmass``` | Minimum fragment mass in gravitational mass units. Default is ```0.0```. Either ```minimum_fragment_gmass``` **OR** ```minimum_fragment_mass``` may be set. | floating point (ex. ```1e-9```) | SyMBA +|```minimum_fragment_mass``` | Minimum fragment mass in mass units. Either ```minimum_fragment_gmass``` **OR** ```minimum_fragment_mass``` may be set. | floating point (ex. ```1e20```) | SyMBA +|```rotation``` | Rotation of massive bodies. Requires rotation vectors, radii, and moments of inertia to be provided in initial conditions. Default is ```False```. | ```True```, ```False``` | SyMBA +|```compute_conservation_values```| Track and report the total energy, angular momentum, and mass of the system. Default is ```False```. | ```True```, ```False``` | SyMBA +|```rhill_present``` | Hill Radius present in massive body input file. Default is ```False```. | ```True```, ```False``` | SyMBA +|```extra_force``` | Additional user defined force routines provided. Default is ```False```. | ```True```, ```False``` | all +|```big_discard``` | Include data for all fully-interacting bodies (above GMTINY) in each discard. Swifter only. Default is ```False```. | ```True```, ```False``` | all +|```restart``` | If ```True```, the simulation given by ```output_file_name``` will be restarted from ```t0```. Default is ```False```. | ```True```, ```False``` | all +|```interaction_loops``` | Method for checking for interactions between bodies. Default is ```TRIANGULAR```. | ```TRIANGULAR```, ```FLAT```, ```ADAPTIVE``` | all +|```encounter_check_loops``` | Method for checking for close encounters between bodies. Default is ```TRIANGULAR```. | ```TRIANGULAR```, ```SORTSWEEP```, ```ADAPTIVE``` | all + +In the above list, the following are defined as: +- ```HELIO``` - Use the heliocentric coordinate frame. +- ```BARY``` - Use the barycentric coordinate frame. +- ```XV``` - Heliocentric position and velocity components. +- ```EL``` - Osculating orbital elements. +- ```XVEL``` - Heliocentric position and velocity components and osculating orbital elements. +- ```NETCDF_FLOAT``` - Single precision NetCDF format. +- ```NETCDF_DOUBLE``` - Double precision NetCDF format. +- ```REAL4``` - Single precision 4-byte native Fortran binary format (Swifter/Swift only) +- ```REAL8``` - Double precision 8-byte native Fortran binary format (Swifter/Swift only) +- ```XDR4``` - Single precision 4-byte XDR format (Swifter/Swift only) +- ```XDR8``` - Double precision 8-byte XDR format (Swifter/Swift only) + +After creating the simulation and defining all desired parameters as keyword arguments, it is time to add bodies to the simulation. The Swiftest Python package interfaces with the [NASA JPL Horizons database](https://ssd.jpl.nasa.gov/horizons/), allowing a user to easily import the initial conditions of known solar system bodies using the ```add_solar_system_body``` method. + +``` +sim.add_solar_system_body(["Sun","Mercury","Venus","Earth","Mars","Jupiter","Saturn","Uranus","Neptune","Pluto"]) +``` + +User defined bodies can also be added to a Swiftest simulation through the Python package. Massive bodies and test particles can both be added using the ```add_body``` method. + +``` +sim.add_body(**kwargs**) +``` + +The ```add_body``` method accepts the following keyword arguments: + +| Key Word Name | Key Word Description | Options | +|-----------------|-----------------------------------------------------------------------------------------------------------------------------------------|--------------------------------| +| ```name``` | Name(s) of bodies. | string or array-like of strings +| ```id``` | Unique identification value(s) of bodies. | float or array-like of floats +| ```a``` | Semi-major axis value(s) of bodies. Only used if ```init_cond_format``` is set to ```EL```. | float or array-like of floats +| ```e``` | Eccentricity value(s) of bodies. Only used if ```init_cond_format``` is set to ```EL```. | float or array-like of floats +| ```inc``` | Inclination value(s) of bodies. Only used if ```init_cond_format``` is set to ```EL```. | float or array-like of floats +| ```capom``` | Longitude of the ascending node value(s) of bodies. Only used if ```init_cond_format``` is set to ```EL```. | float or array-like of floats +| ```omega``` | Argument of pericenter value(s) of bodies. Only used if ```init_cond_format``` is set to ```EL```. | float or array-like of floats +| ```capm``` | Mean anomaly value(s) of bodies. Only used if ```init_cond_format``` is set to ```EL```. | float or array-like of floats +| ```rh``` | Position vector(s) of bodies. Only used if ```init_cond_format``` is set to ```XV```. | (n,3) array-like of floats +| ```vh``` | Velocity vector(s) of bodies. Only used if ```init_cond_format``` is set to ```XV```. | (n,3) array-like of floats +| ```mass``` | Mass value(s) of bodies. Only for massive bodies. Only ```mass``` **OR** ```Gmass``` may be set. | float or array-like of floats +| ```Gmass``` | Gravitational mass value(s) of bodies. Only for massive bodies. Only ```mass``` **OR** ```Gmass``` may be set. | float or array-like of floats +| ```radius``` | Radius value(s) of bodies. Only for massive bodies. | float or array-like of floats +| ```rhill``` | Hill Radius value(s) of bodies. Only for massive bodies. | float or array-like of floats +| ```rot``` | Rotation rate vector(s) of bodies. Only for massive bodies. Only used if ```rotation``` is set to ```True```. | (n,3) array-like of floats +| ```Ip``` | Principal axes moments of inertia vector(s) of bodies. Only for massive bodies. Only used if ```rotation``` is set to ```True```. | (n,3) array-like of floats +| ```J2``` | The J2 term of the central body. | float or array-like of floats +| ```J4``` | The J4 term of the central body. | float or array-like of floats + +All desired bodies and parameters are added to the simulation object and the information is saved to a NetCDF input file (**init_cond.nc**) and an ASCII parameter file (**param.in**) automatically. The parameter file is not necessary to run a Swiftest simulation, it is simply a convenient reference for the user. These files are stored in the ```/simdata``` subdirectory. + **ASCII Input Files** Swiftest accepts 4 ASCII input files. All four input files are necessary, however the structure of each input file varies slightly depending on the features and capabilities of the integrator selected. For examples of Swiftest input files, see the examples section. The four input files are as follows: @@ -165,21 +279,21 @@ The parameter options used in the **param.in** are as follows: | ```CHK_RMIN``` | Heliocentric distance at which a test particle is considered merged with the central body in distance units. | floating point, turn off using ```-1.0``` | all | ```CHK_RMAX``` | Heliocentric distance at which a test particle is too distant from the central body in distance units. | floating point (ex. ```1000.0```) | all | ```CHK_EJECT``` | Heliocentric distance at which an unbound test particle is too distant from the central body in distance units. | floating point (ex. ```1000.0```) | all -| ```CHK_QMIN_COORD``` | Coordinate frame used to check for pericenter distance. | ```HELIO```, ```BARY``` | all +| ```CHK_QMIN_COORD``` | Coordinate frame used to check for minimum pericenter distance. | ```HELIO```, ```BARY``` | all | ```CHK_QMIN_RANGE``` | Upper and lower bounds of the semimajor axis range used to check the pericenter distance. | two floating points, turn off using ```-1.0 -1.0``` | all | ```EXTRA_FORCE``` | Additional user defined force routines provided. | ```YES```, ```NO``` | all -| ```CHK_CLOSE``` | Check for close encounters. | ```YES```, ```NO``` | all +| ```CHK_CLOSE``` | Check for close encounters. Requires radius of massive bodies to be provided in initial conditions. | ```YES```, ```NO``` | all | ```INTERACTION_LOOPS``` | Method for checking for interactions between bodies. | ```TRIANGULAR```, ```FLAT```, ```ADAPTIVE``` | all | ```ENCOUNTER_CHECK``` | Method for checking for close encounters between bodies. | ```TRIANGULAR```, ```SORTSWEEP```, ```ADAPTIVE``` | all -| ```MU2KG``` | Mass units to kilogram conversion. | floating point (ex. ```1.988409870698051e+30```) | all -| ```TU2S``` | Time units to seconds conversion. | floating point (ex. ```31557600.0```) | all -| ```DU2M``` | Distance units to meters conversion. | floating point (ex. ```149597870700.0```) | all -| ```BIG_DISCARD``` | Include data for all fully-interacting bodies (above GMTINY) in each discard. | ```YES```, ```NO``` | all +| ```MU2KG``` | Mass units to kilogram conversion factor. | floating point (ex. ```1.988409870698051e+30```) | all +| ```TU2S``` | Time units to seconds conversion factor. | floating point (ex. ```31557600.0```) | all +| ```DU2M``` | Distance units to meters conversion factor. | floating point (ex. ```149597870700.0```) | all +| ```BIG_DISCARD``` | Include data for all fully-interacting bodies (above GMTINY) in each discard. Swifter only. | ```YES```, ```NO``` | all | ```GR``` | General relativity. | ```YES```, ```NO``` | all | ```RHILL_PRESENT``` | Hill Radius present in massive body input file. | ```YES```, ```NO``` | SyMBA -| ```ENERGY``` | Track the total energy of the system. | ```YES```, ```NO``` | SyMBA +| ```ENERGY``` | Track and report the total energy, angular momentum, and mass of the system. | ```YES```, ```NO``` | SyMBA | ```FRAGMENTATION``` | Resolve collisions with fragmentation. | ```YES```, ```NO``` | SyMBA -| ```ROTATION``` | Rotational vectors present in massive body input file. | ```YES```, ```NO``` | SyMBA +| ```ROTATION``` | Rotation of massive bodies. Requires rotation vectors, radii, and moments of inertia to be provided in initial conditions. | ```YES```, ```NO``` | SyMBA | ```GMTINY``` | Mass cutoff between fully and semi-interacting massive bodies in gravitational mass units. | floating point (ex. ```4e-06```) | SyMBA | ```MIN_GMFRAG``` | Minimum fragment mass in gravitational mass units. | floating point (ex. ```1e-09```) | SyMBA | ```TIDES``` | Tidal dissipation model. | ```YES```, ```NO``` | *(under development)* @@ -241,97 +355,26 @@ The **tp.in** includes all test particle initial conditions. In the Note that the ID numbers of the test particles are a continuation of the ID numbers of the massive bodies. No two bodies in the system can have the same ID number. -**NetCDF Input Files (Recommended)** - -Swiftest accepts a single NetCDF input file. This file can be created using the Swiftest Python Package through a few simple steps. - -To begin, simply create a new Python script in the directory you would like to store your simulation. Open the new script and import the Swiftest Python package. - -``` -import swiftest -``` - -Next, we initialize the Swiftest simulation object. Various parameters can be provided to the simulation via key word arguments at this stage. - -``` -sim = swiftest.Simulation() -``` - -The key word arguments available to the user, along with the default values for these arguments, are as follows: +**Running a Swiftest Simulation** -| Key Word Name | Key Word Description | Options | Compatible Integrators | -|---------------------------------|----------------------------------------------------------------------------------------------------|----------------------------------------------------------------------------------------------------|------------------------| -|```simdir``` | Path to subdirectory in which to store data. Default is ```/simdir```. | pathlike string (ex. ```path/to/directory```) -|```read_param``` | Read in a pre-existing parameter input file. Default is ```False```. | ```True```, ```False``` -|```param_file``` | Name of the pre-existing parameter input file. Only used if ```param_file``` is set to ```True```. | string (ex. ```param.in```) -|```read_old_output_file``` | Read in a pre-existing simulation output file. Default is ```False```. | ```True```, ```False``` -|```codename``` | Name of the N-body code to use. Default is ```Swiftest```. | ```Swiftest```, ```Swifter```, ```Swift``` -|```integrator``` | Name of the N-body integrator to use. Default is ```symba```. | ```symba```, ```helio```, ```rmvs```, ```whm``` -|```t0``` | The reference time for the start of the simulation in time units. Default is ```0.0```. | floating point (ex. ```0.0```) -|```tstart``` | Simulation start time for a restarted run in time units. Default is ```0.0```. | floating point (ex. ```0.0```) -|```tstop``` | Simulation end time in time units. Must be greater than ```tstart```. | floating point (ex. ```100.0```) -|```dt``` | Simulation step size in time units. Must be less than or equal to ```tstop```-```tstart```. | floating point (ex. ```0.005```) -|```istep_out``` | The number of time steps (```dt```) between output saves to memory. Either ```istep_out``` **OR** ```tstep_out``` may be set. | integer (ex. ```200```) -|```dump_cadence``` | The number of output steps between when data saved to memory is written to file. Setting to ```0``` results in writing data to file only at the completion of the simulation. Default is ```10```. | integer (ex. ```10```) -|```tstep_out``` | The approximate time between when outputs saved in memory are written to file in time units. Either ```istep_out``` **OR** ```tstep_out``` may be set. | floating point (ex. ```10.0```) that calculates ```istep_out = floor(tstep_out / dt)``` -|```init_cond_file_type``` | Input file format. Default is ```NETCDF_DOUBLE```. | ```NETCDF_DOUBLE```, ```NETCDF_FLOAT```, ```ASCII``` -|```init_cond_file_name``` | Input file name(s). If ```init_cond_file_type``` is set to ```NETCDF_DOUBLE``` or ```NETCDF_FLOAT```, default is ```init_cond.nc```. If ```init_cond_file_type``` is set to ```ASCII```, default is a dictionary: ```{"CB" : "cb.in", "PL" : "pl.in", "TP" : "tp.in"}```. | string (ex. ```my_init_cond.nc```) or dictionary ```{"CB" : "mycb.in", "PL" : "mypl.in", "TP" : "mytp.in"}``` -|```init_cond_format``` | Input format. Default is ```EL```. | ```EL```, ```XV``` -|```output_file_type``` | Output file format. Default is ```NETCDF_DOUBLE```. | ```NETCDF_DOUBLE```, ```NETCDF_FLOAT```, ```REAL4```, ```REAL8```, ```XDR4```, ```XDR8``` -|```output_file_name``` | Output file name. Default is ```bin.nc```. | string (ex. ```mydata.nc```) -|```output_format``` | Output format. Default is ```XVEL```. | ```XV```, ```XVEL``` -|```MU``` | Mass unit system to use in the simulation. Default is ```Msun```. | ```Msun```, ```Mearth```, ```kg```, ```g``` (case-insensitive) -|```DU``` | Distance unit system to use in the simulation. -|```TU``` | -|```MU2KG``` | -|```DU2M``` | -|```TU2S``` | -|```MU_NAME``` | -|```DU_NAME``` | -|```TU_NAME``` | -|```rmin``` | -|```rmax``` | -|```qmin_coord``` | -|```mtiny``` | -|```gmtiny``` | -|```close_encounter_check``` | -|```general_relativity``` | -|```fragmentation``` | -|```minimum_fragment_gmass``` | -|```minimum_fragment_mass``` | -|```rotation``` | -|```compute_conservation_values```| -|```extra_force``` | -|```big_discard``` | -|```rhill_present``` | -|```restart``` | -|```interaction_loops``` | -|```encounter_check_loops``` | -|```verbose``` | +The input files necessary to successfully run Swiftest should now be generated in the simulation directory. The user is now faced with a second choice: to run a Swiftest simulation from a Python environment (recommended) or to run it directly from the terminal. Either option is possible with NetCDF format input files, however ASCII input files must be run directly from the terminal. +**Running via Python** -**NOTHING IS CHECKED BELOW HERE** - -The Swiftest Python package also interfaces with the [NASA JPL Horizons database](https://ssd.jpl.nasa.gov/horizons/), allowing a user to easily import the initial conditions of known solar system bodies using the ```add``` function. +To run a Swiftest simulation from the same script in which the initial conditions are created, simply add the following line after you have finished defining parameters and adding bodies to the simulation: ``` -sim.add("Mercury") # An example of how to add a known body from the JPL Horizons database to a Swiftest simulation. +sim.run() ``` -User defined bodies can also be added to a Swiftest simulation through the Python package. To add massive bodies using the ```addp``` function, define an ```IN_FORM``` and then add all desired initial conditions. The first 8 arguments (the id, the name, and either the cartesian state vectors or the orbital elements, depending on the value of ```IN_FORM```) are required, while the last 9 arguments (the gravitational mass, the radius, the Hill Radius, the principal moments of inertia, and the rotation vector) are optional. The ```addp``` function accepts single values or arrays of values. +To run a previously created set of initial conditions, first read the old output file into Python, and then run it. Note that Swiftest will look in the ```/simdata``` subdirectory for the initial conditions by default. You may set a new path to the initial conditions using the ```param_file``` keyword argument. ``` -sim.param['IN_FORM'] = "EL" # Set the in form to be orbital elements. Can also set to cartesian state vectors using XV. -sim.addp(id, name, a, e, inc, capom, omega, capm, GMpl=GMpl, Rpl=Rpl, rhill=rhill, Ip1=Ip1, Ip2=Ip2, Ip3=Ip3, rotx=rotx, roty=roty, rotz=rotz) # An example of how to add a user defined body to a Swiftest simulation. +sim = swiftest.Simulation(read_param=True, param_file='path/to/param.in') +sim.run() ``` -Once all desired bodies and parameters are added to the simulation object, the information is saved to a set of initial condition files (**param.in**, **cb.in**, **pl.in**, **tp.in**) using the following line: - -``` -sim.save('param.in') # Saving the Swiftest input files. -``` - -The input files necessary to successfully run Swiftest should now be generated in the simulation directory. +**Running via a Terminal** When creating a new Swiftest simulation, ensure that all required input files exist in a unique directory. A symbolic link to the Swiftest driver should also exist in the simulation directory. To create a symbolic link to the Swiftest driver from your current directory, type: @@ -347,17 +390,17 @@ $ ./swiftest_driver INTEGRATOR param.in Where ```INTEGRATOR``` is your integrator of choice, either ```whm```, ```rmvs```, ```helio```, or ```symba```. - **Outputs** -Swiftest generates between 1 and 6 output files, depending on the parameters defined in the **param.in**. The output files are as follows: -- **out.nc** - Always generated, the output file containing the information for every body in the system, written every ```ISTEP_OUT``` timesteps. -- **fraggle.log** - The log containing the record of each fragmentation event, including the properties of the colliding bodies, the collisional regime, and the properties of the fragments created, only if ```FRAGMENTATION``` is ```YES```, SyMBA only, ASCII file format only -- **encounter_check_plpl_timer.log** - The log containing the encounter check timer for each massive body/massive body encounter, only if ```ENCOUNTER_CHECK``` is ```ADAPTIVE```, ASCII file format only -- **encounter_check_pltp_time.log** - The log containing the encounter check timer for each massive body/test particle encounter, only if ```ENCOUNTER_CHECK``` is ```ADAPTIVE```, ASCII file format only +Swiftest generates between 1 and 6 output files, depending on the input parameters selected and the method through which Swiftest was run. The output files are as follows: +- **bin.nc** - Always generated, the output file containing the information for every body in the system, recorded every ```ISTEP_OUT``` timesteps and written every ```DUMP_CADENCE```. +- **fraggle.log** - The log containing the record of each fragmentation event, including the properties of the colliding bodies, the collisional regime, and the properties of the fragments created, only if ```FRAGMENTATION``` is ```YES```, Swiftest SyMBA only, ASCII file format only +- **encounter_check_plpl_timer.log** - The log containing the encounter check timer for each massive body/massive body encounter, only if ```CHK_CLOSE```/```close_encounter_check``` is ```YES```/```True``` and ```ENCOUNTER_CHECK```/```encounter_check_loops``` is ```ADAPTIVE```, ASCII file format only +- **encounter_check_pltp_time.log** - The log containing the encounter check timer for each massive body/test particle encounter, only if ```CHK_CLOSE```/```close_encounter_check``` is ```YES```/```True``` and ```ENCOUNTER_CHECK```/```encounter_check_loops``` is ```ADAPTIVE```, ASCII file format only - **interaction_timer.log** - The log containing the interaction loop timer for each interacting pair of bodies, only if ```INTERACTION_LOOPS``` is ```ADAPTIVE```, ASCII file format only +- **swiftest.log** - A log containing the input parameters and a brief updated on the status of the run. Only generated if Swiftest is run through the Python package. If Swiftest is run through the terminal, these updates are output directly to the terminal. -Each time Swiftest writes to the output files, it also writes a short update to the terminal. At the start of the simulation, it outputs all user parameters set in the **param.in** to the terminal. Each subsequent output is then appended beneath the listed parameters in the following fashion: +Regardless of whether the status outputs are recorded in the **swiftest.log** or in the terminal, the output format is the same. Below is an example of a single status output: `````` Time = 1.00000E+03; fraction done = 0.001; Number of active plm, pl, tp = 57, 108, 50 @@ -365,11 +408,13 @@ Time = 1.00000E+03; fraction done = 0.001; Number of active plm, pl, tp = 5 Integration steps: Total wall time: 2.99848E+02; Interval wall time: 9.36192E+01;Interval wall time/step: 4.68956E-04 `````` -The first line includes the simulation time, the fraction of the simulation that is complete relative to ```tmax```, the number of fully-interactive massive bodies (```plm```), the total number of massive bodies (```pl```) including fully-interactive and semi-interactive bodies, and the number of test particles (```tp```) remaining in the system at that time. The second line includes the angular momentum error, the change in energy as a result of collisions only, the total change in energy, and the change in mass up to this point in the simulation. The third line contains the total wall time elapsed since the start of the simulation, the wall time elapsed since the start of the last step, and the average wall time per step since the start of the simulation. +The first line includes the simulation time, the fraction of the simulation that is complete relative to ```tstop```, the number of fully-interactive massive bodies (```plm```) (SyMBA only), the total number of massive bodies (```pl```) including fully-interactive and semi-interactive bodies, and the number of test particles (```tp```) remaining in the system at that time. The second line includes the angular momentum error, the change in energy as a result of collisions only, the total change in energy, and the change in mass up to this point in the simulation (error analysis included only if ```ENERGY```/```compute_conservation_values``` is set to ```YES```/```True```). The third line contains the total wall time elapsed since the start of the simulation, the wall time elapsed since the start of the last step, and the average wall time per step since the start of the simulation. + +**NOTHING IS CHECKED BELOW HERE** **Restarting a Simulation From t $\neq$ 0** -Swiftest allows the user to restart a simulation in two different ways. Restarting from the dump files is ideal if there is a risk that the simulation was terminated in the writing stage or if the output was corrupted during termination. Restarting from a timestamp is ideal if the point at which the user would like to restart from is not the last timestep written to the output file. Both ways allow the user to restart a simulation from the last timestep written to the output file. +Just like Swiftest allows the user to run a simulation through the terminal or through Python, Swiftest also allows the user to restart a simulation in the same two manners. In case of accidental termination of a simulation, such as through a power outage or computer failure, Swiftest generates a series of dump files. Every ```ISTEP_DUMP``` timesteps, Swiftest dumps all simulation information to the dump files. Every ```ISTEP_DUMP``` timestep, Swiftest alternates which set of dump files to dump to (either set "1" or set "2"). This way, even if Swiftest is terminated during the writing stage, at least one set of dump files is preserved and the information is not lost. When Swiftest is restarted from a dump file, it automatically determines which set of dump files has proceeded further in simulation time, and picks up from that point. From e6ba484634fe9eabffc8fb13633070c2b7b8a761 Mon Sep 17 00:00:00 2001 From: Carlisle Wishard Date: Fri, 9 Dec 2022 15:18:52 -0500 Subject: [PATCH 356/569] fixed documentation typo --- python/swiftest/swiftest/simulation_class.py | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/python/swiftest/swiftest/simulation_class.py b/python/swiftest/swiftest/simulation_class.py index 4ac07386c..ae66ec083 100644 --- a/python/swiftest/swiftest/simulation_class.py +++ b/python/swiftest/swiftest/simulation_class.py @@ -2348,7 +2348,7 @@ def add_body(self, 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" + longitude of ascending node for param['IN_FORM'] == "EL" omega : float or array-like of float, optional argument of periapsis for param['IN_FORM'] == "EL" capm : float or array-like of float, optional From 876f2b7ec5ed0f03b403bda7226106b3e863d9c2 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Fri, 9 Dec 2022 16:38:55 -0500 Subject: [PATCH 357/569] Added in the correct dimensions to the collision output file, and changed "fragmentation_" to "collision_" for the file names --- src/fraggle/fraggle_io.f90 | 59 +++++++++++++++++++++++++++----------- src/symba/symba_io.f90 | 2 +- 2 files changed, 43 insertions(+), 18 deletions(-) diff --git a/src/fraggle/fraggle_io.f90 b/src/fraggle/fraggle_io.f90 index 60b96f855..5702759f1 100644 --- a/src/fraggle/fraggle_io.f90 +++ b/src/fraggle/fraggle_io.f90 @@ -68,23 +68,48 @@ module subroutine fraggle_io_initialize_output(self, param) ! Variables - call check( nf90_def_var(nc%id, nc%name_varname, NF90_CHAR, [nc%str_dimid, nc%id_dimid], nc%name_varid), "fraggle_io_initialize nf90_def_var name_varid" ) - call check( nf90_def_var(nc%id, nc%rh_varname, nc%out_type, [nc%space_dimid, nc%id_dimid, nc%time_dimid], nc%rh_varid), "fraggle_io_initialize nf90_def_var rh_varid" ) - call check( nf90_def_var(nc%id, nc%vh_varname, nc%out_type, [nc%space_dimid, nc%id_dimid, nc%time_dimid], nc%vh_varid), "fraggle_io_initialize nf90_def_var vh_varid" ) - call check( nf90_def_var(nc%id, nc%Gmass_varname, nc%out_type, [nc%id_dimid, nc%time_dimid], nc%Gmass_varid), "fraggle_io_initialize nf90_def_var Gmass_varid" ) - call check( nf90_def_var(nc%id, nc%loop_varname, NF90_INT, [nc%time_dimid], nc%loop_varid), "fraggle_io_initialize nf90_def_var loop_varid" ) - call check( nf90_def_var(nc%id, nc%radius_varname, nc%out_type, [nc%id_dimid, nc%time_dimid], nc%radius_varid), "fraggle_io_initialize nf90_def_var radius_varid" ) - call check( nf90_def_var(nc%id, nc%Ip_varname, nc%out_type, [nc%space_dimid, nc%id_dimid, nc%time_dimid], nc%Ip_varid), "fraggle_io_initialize nf90_def_var Ip_varid" ) - call check( nf90_def_var(nc%id, nc%rot_varname, nc%out_type, [nc%space_dimid, nc%id_dimid, nc%time_dimid], nc%rot_varid), "fraggle_io_initialize nf90_def_var rot_varid" ) - call check( nf90_def_var(nc%id, nc%ke_orb_varname, nc%out_type, nc%time_dimid, nc%KE_orb_varid), "netcdf_initialize_output nf90_def_var KE_orb_varid" ) - call check( nf90_def_var(nc%id, nc%ke_spin_varname, nc%out_type, nc%time_dimid, nc%KE_spin_varid), "netcdf_initialize_output nf90_def_var KE_spin_varid" ) - call check( nf90_def_var(nc%id, nc%pe_varname, nc%out_type, nc%time_dimid, nc%PE_varid), "netcdf_initialize_output nf90_def_var PE_varid" ) - call check( nf90_def_var(nc%id, nc%L_orb_varname, nc%out_type, [nc%space_dimid, nc%time_dimid], nc%L_orb_varid), "netcdf_initialize_output nf90_def_var L_orb_varid" ) - call check( nf90_def_var(nc%id, nc%L_spin_varname, nc%out_type, [nc%space_dimid, nc%time_dimid], nc%L_spin_varid), "netcdf_initialize_output nf90_def_var L_spin_varid" ) - call check( nf90_def_var(nc%id, nc%L_escape_varname, nc%out_type, [nc%space_dimid, nc%time_dimid], nc%L_escape_varid), "netcdf_initialize_output nf90_def_var L_escape_varid" ) - call check( nf90_def_var(nc%id, nc%Ecollisions_varname, nc%out_type, nc%time_dimid, nc%Ecollisions_varid), "netcdf_initialize_output nf90_def_var Ecollisions_varid" ) - call check( nf90_def_var(nc%id, nc%Euntracked_varname, nc%out_type, nc%time_dimid, nc%Euntracked_varid), "netcdf_initialize_output nf90_def_var Euntracked_varid" ) - call check( nf90_def_var(nc%id, nc%GMescape_varname, nc%out_type, nc%time_dimid, nc%GMescape_varid), "netcdf_initialize_output nf90_def_var GMescape_varid" ) + + call check( nf90_def_var(nc%id, nc%name_varname, NF90_CHAR, & + [nc%str_dimid, nc%id_dimid ], nc%name_varid), "fraggle_io_initialize nf90_def_var name_varid") + + call check( nf90_def_var(nc%id, nc%loop_varname, NF90_INT, & + [ nc%time_dimid], nc%loop_varid), "fraggle_io_initialize nf90_def_var loop_varid") + + call check( nf90_def_var(nc%id, nc%rh_varname,nc%out_type,& + [ nc%space_dimid, nc%id_dimid, nc%stage_dimid, nc%time_dimid], nc%rh_varid), "fraggle_io_initialize nf90_def_var rh_varid") + + call check( nf90_def_var(nc%id, nc%vh_varname, nc%out_type,& + [ nc%space_dimid, nc%id_dimid, nc%stage_dimid, nc%time_dimid], nc%vh_varid), "fraggle_io_initialize nf90_def_var vh_varid") + + call check( nf90_def_var(nc%id, nc%Gmass_varname, nc%out_type,& + [ nc%id_dimid, nc%stage_dimid, nc%time_dimid], nc%Gmass_varid), "fraggle_io_initialize nf90_def_var Gmass_varid") + + + call check( nf90_def_var(nc%id, nc%radius_varname, nc%out_type,& + [ nc%id_dimid, nc%stage_dimid, nc%time_dimid], nc%radius_varid), "fraggle_io_initialize nf90_def_var radius_varid") + + call check( nf90_def_var(nc%id, nc%Ip_varname, nc%out_type,& + [ nc%space_dimid, nc%id_dimid, nc%stage_dimid, nc%time_dimid], nc%Ip_varid), "fraggle_io_initialize nf90_def_var Ip_varid") + + call check( nf90_def_var(nc%id, nc%rot_varname, nc%out_type,& + [ nc%space_dimid, nc%id_dimid, nc%stage_dimid, nc%time_dimid], nc%rot_varid), "fraggle_io_initialize nf90_def_var rot_varid") + + call check( nf90_def_var(nc%id, nc%ke_orb_varname, nc%out_type,& + [ nc%stage_dimid, nc%time_dimid], nc%KE_orb_varid), "netcdf_initialize_output nf90_def_var KE_orb_varid") + + call check( nf90_def_var(nc%id, nc%ke_spin_varname, nc%out_type,& + [ nc%stage_dimid, nc%time_dimid], nc%KE_spin_varid), "netcdf_initialize_output nf90_def_var KE_spin_varid" ) + + call check( nf90_def_var(nc%id, nc%pe_varname,& + nc%out_type,& + [ nc%stage_dimid, nc%time_dimid], nc%PE_varid), "netcdf_initialize_output nf90_def_var PE_varid" ) + + call check( nf90_def_var(nc%id, nc%L_orb_varname, nc%out_type, & + [ nc%space_dimid, nc%stage_dimid, nc%time_dimid], nc%L_orb_varid), "netcdf_initialize_output nf90_def_var L_orb_varid" ) + + call check( nf90_def_var(nc%id, nc%L_spin_varname, nc%out_type,& + [ nc%space_dimid, nc%stage_dimid, nc%time_dimid], nc%L_spin_varid), "netcdf_initialize_output nf90_def_var L_spin_varid" ) + call check( nf90_inquire(nc%id, nVariables=nvar), "fraggle_io_initialize nf90_inquire nVariables" ) diff --git a/src/symba/symba_io.f90 b/src/symba/symba_io.f90 index 6c1d53a6c..b1fb0faf4 100644 --- a/src/symba/symba_io.f90 +++ b/src/symba/symba_io.f90 @@ -31,7 +31,7 @@ module subroutine symba_io_dump_encounter(self, param) nce%time_dimsize = maxval(encounter_history%tslot(:)) ncc%time_dimsize = maxval(encounter_history%tslot(:)) write(nce%file_name, '("encounter_",I0.6,".nc")') nce%file_number - write(ncc%file_name, '("fragmentation_",I0.6,".nc")') ncc%file_number + write(ncc%file_name, '("collision_",I0.6,".nc")') ncc%file_number call nce%initialize(param) call ncc%initialize(param) call encounter_history%dump(param) From 9af252dff210c57782bc4c2cfbf4314acc9d2bfa Mon Sep 17 00:00:00 2001 From: David A Minton Date: Fri, 9 Dec 2022 17:03:52 -0500 Subject: [PATCH 358/569] Started fleshing out the write_frame method for collisions --- src/fraggle/fraggle_io.f90 | 42 +++++++++++++++++++++++++++++-- src/modules/encounter_classes.f90 | 1 - 2 files changed, 40 insertions(+), 3 deletions(-) diff --git a/src/fraggle/fraggle_io.f90 b/src/fraggle/fraggle_io.f90 index 5702759f1..025b793c6 100644 --- a/src/fraggle/fraggle_io.f90 +++ b/src/fraggle/fraggle_io.f90 @@ -35,7 +35,6 @@ module subroutine fraggle_io_initialize_output(self, param) dfill = ieee_value(dfill, IEEE_QUIET_NAN) sfill = ieee_value(sfill, IEEE_QUIET_NAN) - select case (param%out_type) case("NETCDF_FLOAT") self%out_type = NF90_FLOAT @@ -50,7 +49,6 @@ module subroutine fraggle_io_initialize_output(self, param) close(unit=LUN, status="delete") end if - call check( nf90_create(nc%file_name, NF90_NETCDF4, nc%id), "fraggle_io_initialize nf90_create" ) ! Dimensions @@ -146,10 +144,50 @@ end subroutine fraggle_io_initialize_output module subroutine fraggle_io_write_frame(self, nc, param) + !! author: David A. Minton + !! + !! Write a frame of output of a collision result + use netcdf implicit none + ! Arguments class(fraggle_encounter_snapshot), intent(in) :: self !! Swiftest encounter structure class(encounter_io_parameters), intent(inout) :: nc !! Parameters used to identify a particular encounter io NetCDF dataset class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + ! Internals + integer(I4B) :: i, tslot, idslot, old_mode, npl + character(len=NAMELEN) :: charstring + + tslot = param%ioutput + associate(pl => self%pl, colliders => self%colliders, fragments => self%fragments) + + call check( nf90_set_fill(nc%id, nf90_nofill, old_mode), "fraggle_io_write_frame nf90_set_fill" ) + + call check( nf90_put_var(nc%id, nc%time_varid, self%t, start=[tslot]), "fraggle_io_write_frame nf90_put_var time_varid" ) + call check( nf90_put_var(nc%id, nc%loop_varid, int(self%iloop,kind=I4B), start=[tslot]), "fraggle_io_write_frame nf90_put_var pl loop_varid" ) + + ! npl = pl%nbody + ! do i = 1, npl + ! idslot = pl%id(i) + ! call check( nf90_put_var(nc%id, nc%id_varid, pl%id(i), start=[idslot]), "fraggle_io_write_frame nf90_put_var pl id_varid" ) + ! call check( nf90_put_var(nc%id, nc%rh_varid, pl%rh(:,i), start=[1,idslot,tslot], count=[NDIM,1,1]), "fraggle_io_write_frame nf90_put_var pl rh_varid" ) + ! call check( nf90_put_var(nc%id, nc%vh_varid, pl%vh(:,i), start=[1,idslot,tslot], count=[NDIM,1,1]), "fraggle_io_write_frame nf90_put_var pl vh_varid" ) + ! call check( nf90_put_var(nc%id, nc%Gmass_varid, pl%Gmass(i), start=[idslot, tslot]), "fraggle_io_write_frame nf90_put_var pl Gmass_varid" ) + + ! if (param%lclose) call check( nf90_put_var(nc%id, nc%radius_varid, pl%radius(i), start=[idslot, tslot]), "fraggle_io_write_frame nf90_put_var pl radius_varid" ) + + ! if (param%lrotation) then + ! call check( nf90_put_var(nc%id, nc%Ip_varid, pl%Ip(:,i), start=[1, idslot, tslot], count=[NDIM,1,1]), "fraggle_io_write_frame nf90_put_var pl Ip_varid" ) + ! call check( nf90_put_var(nc%id, nc%rot_varid, pl%rot(:,i), start=[1,idslot, tslot], count=[NDIM,1,1]), "fraggle_io_write_frame nf90_put_var pl rotx_varid" ) + ! end if + + ! charstring = trim(adjustl(pl%info(i)%name)) + ! call check( nf90_put_var(nc%id, nc%name_varid, charstring, start=[1, idslot], count=[NAMELEN, 1]), "fraggle_io_write_frame nf90_put_var pl name_varid" ) + ! charstring = trim(adjustl(pl%info(i)%particle_type)) + ! call check( nf90_put_var(nc%id, nc%ptype_varid, charstring, start=[1, idslot], count=[NAMELEN, 1]), "fraggle_io_write_frame nf90_put_var pl particle_type_varid" ) + ! end do + + call check( nf90_set_fill(nc%id, old_mode, old_mode) ) + end associate return end subroutine fraggle_io_write_frame diff --git a/src/modules/encounter_classes.f90 b/src/modules/encounter_classes.f90 index 2af59b94b..69ed90e19 100644 --- a/src/modules/encounter_classes.f90 +++ b/src/modules/encounter_classes.f90 @@ -55,7 +55,6 @@ module encounter_classes !> NetCDF dimension and variable names for the enounter save object type, extends(netcdf_parameters) :: encounter_io_parameters - integer(I4B) :: ienc_frame = 1 !! Current frame number for the encounter history character(NAMELEN) :: loop_varname = "loopnum" !! Loop number for encounter integer(I4B) :: loop_varid !! ID for the recursion level variable integer(I4B) :: time_dimsize = 0 !! Number of time values in snapshot From 0a808bf8d757b67d42f9a3e1fa582a71ce24c71a Mon Sep 17 00:00:00 2001 From: David A Minton Date: Fri, 9 Dec 2022 17:14:56 -0500 Subject: [PATCH 359/569] Switched collision outputs to an "event" dimension instead of time --- src/fraggle/fraggle_io.f90 | 58 ++++++++++++++++++--------------- src/modules/fraggle_classes.f90 | 16 +++++---- 2 files changed, 41 insertions(+), 33 deletions(-) diff --git a/src/fraggle/fraggle_io.f90 b/src/fraggle/fraggle_io.f90 index 025b793c6..8db44eb3c 100644 --- a/src/fraggle/fraggle_io.f90 +++ b/src/fraggle/fraggle_io.f90 @@ -52,61 +52,65 @@ module subroutine fraggle_io_initialize_output(self, param) call check( nf90_create(nc%file_name, NF90_NETCDF4, nc%id), "fraggle_io_initialize nf90_create" ) ! Dimensions - call check( nf90_def_dim(nc%id, nc%time_dimname, nc%time_dimsize, nc%time_dimid), "fraggle_io_initialize nf90_def_dim time_dimid" ) ! Simulation time dimension + call check( nf90_def_var(nc%id, nc%event_dimname, NF90_INT, nc%event_dimid, nc%event_varid), "fraggle_io_initialize nf90_def_var event_varid" ) call check( nf90_def_dim(nc%id, nc%space_dimname, NDIM , nc%space_dimid), "fraggle_io_initialize nf90_def_dim space_dimid" ) ! 3D space dimension call check( nf90_def_dim(nc%id, nc%id_dimname, param%maxid, nc%id_dimid), "fraggle_io_initialize nf90_def_dim id_dimid" ) ! dimension to store particle id numbers call check( nf90_def_dim(nc%id, nc%str_dimname, NAMELEN, nc%str_dimid), "fraggle_io_initialize nf90_def_dim str_dimid" ) ! Dimension for string variables (aka character arrays) call check( nf90_def_dim(nc%id, nc%stage_dimname, 2, nc%stage_dimid), "fraggle_io_initialize nf90_def_dim stage_dimid" ) ! Dimension for stage variables (aka "before" vs. "after" ! Dimension coordinates - call check( nf90_def_var(nc%id, nc%time_dimname, nc%out_type, nc%time_dimid, nc%time_varid), "fraggle_io_initialize nf90_def_var time_varid" ) + call check( nf90_def_var(nc%id, nc%event_dimname, nc%out_type, nc%event_dimid, nc%event_varid), "fraggle_io_initialize nf90_def_var event_varid" ) call check( nf90_def_var(nc%id, nc%space_dimname, NF90_CHAR, nc%space_dimid, nc%space_varid), "fraggle_io_initialize nf90_def_var space_varid" ) call check( nf90_def_var(nc%id, nc%id_dimname, NF90_INT, nc%id_dimid, nc%id_varid), "fraggle_io_initialize nf90_def_var id_varid" ) call check( nf90_def_var(nc%id, nc%stage_dimname, NF90_CHAR, nc%stage_dimid, nc%stage_varid), "fraggle_io_initialize nf90_def_var stage_varid" ) - ! Variables - + call check( nf90_def_var(nc%id, nc%time_dimname, nc%out_type, & + nc%event_dimid, nc%time_varid), "fraggle_io_initialize nf90_def_var time_varid" ) + call check( nf90_def_var(nc%id, nc%regime_varname, NF90_CHAR, & + [nc%str_dimid, nc%event_dimid], nc%regime_varid), "fraggle_io_initialize nf90_def_var regime_varid") + call check( nf90_def_var(nc%id, nc%Qloss_varname, NF90_CHAR, & + [ nc%event_dimid], nc%regime_varid), "fraggle_io_initialize nf90_def_var regime_varid") call check( nf90_def_var(nc%id, nc%name_varname, NF90_CHAR, & - [nc%str_dimid, nc%id_dimid ], nc%name_varid), "fraggle_io_initialize nf90_def_var name_varid") + [nc%str_dimid, nc%id_dimid ], nc%name_varid), "fraggle_io_initialize nf90_def_var name_varid") call check( nf90_def_var(nc%id, nc%loop_varname, NF90_INT, & - [ nc%time_dimid], nc%loop_varid), "fraggle_io_initialize nf90_def_var loop_varid") + [ nc%event_dimid], nc%loop_varid), "fraggle_io_initialize nf90_def_var loop_varid") call check( nf90_def_var(nc%id, nc%rh_varname,nc%out_type,& - [ nc%space_dimid, nc%id_dimid, nc%stage_dimid, nc%time_dimid], nc%rh_varid), "fraggle_io_initialize nf90_def_var rh_varid") + [ nc%space_dimid, nc%id_dimid, nc%stage_dimid, nc%event_dimid], nc%rh_varid), "fraggle_io_initialize nf90_def_var rh_varid") call check( nf90_def_var(nc%id, nc%vh_varname, nc%out_type,& - [ nc%space_dimid, nc%id_dimid, nc%stage_dimid, nc%time_dimid], nc%vh_varid), "fraggle_io_initialize nf90_def_var vh_varid") + [ nc%space_dimid, nc%id_dimid, nc%stage_dimid, nc%event_dimid], nc%vh_varid), "fraggle_io_initialize nf90_def_var vh_varid") call check( nf90_def_var(nc%id, nc%Gmass_varname, nc%out_type,& - [ nc%id_dimid, nc%stage_dimid, nc%time_dimid], nc%Gmass_varid), "fraggle_io_initialize nf90_def_var Gmass_varid") + [ nc%id_dimid, nc%stage_dimid, nc%event_dimid], nc%Gmass_varid), "fraggle_io_initialize nf90_def_var Gmass_varid") call check( nf90_def_var(nc%id, nc%radius_varname, nc%out_type,& - [ nc%id_dimid, nc%stage_dimid, nc%time_dimid], nc%radius_varid), "fraggle_io_initialize nf90_def_var radius_varid") + [ nc%id_dimid, nc%stage_dimid, nc%event_dimid], nc%radius_varid), "fraggle_io_initialize nf90_def_var radius_varid") call check( nf90_def_var(nc%id, nc%Ip_varname, nc%out_type,& - [ nc%space_dimid, nc%id_dimid, nc%stage_dimid, nc%time_dimid], nc%Ip_varid), "fraggle_io_initialize nf90_def_var Ip_varid") + [ nc%space_dimid, nc%id_dimid, nc%stage_dimid, nc%event_dimid], nc%Ip_varid), "fraggle_io_initialize nf90_def_var Ip_varid") call check( nf90_def_var(nc%id, nc%rot_varname, nc%out_type,& - [ nc%space_dimid, nc%id_dimid, nc%stage_dimid, nc%time_dimid], nc%rot_varid), "fraggle_io_initialize nf90_def_var rot_varid") + [ nc%space_dimid, nc%id_dimid, nc%stage_dimid, nc%event_dimid], nc%rot_varid), "fraggle_io_initialize nf90_def_var rot_varid") call check( nf90_def_var(nc%id, nc%ke_orb_varname, nc%out_type,& - [ nc%stage_dimid, nc%time_dimid], nc%KE_orb_varid), "netcdf_initialize_output nf90_def_var KE_orb_varid") + [ nc%stage_dimid, nc%event_dimid], nc%KE_orb_varid), "netcdf_initialize_output nf90_def_var KE_orb_varid") call check( nf90_def_var(nc%id, nc%ke_spin_varname, nc%out_type,& - [ nc%stage_dimid, nc%time_dimid], nc%KE_spin_varid), "netcdf_initialize_output nf90_def_var KE_spin_varid" ) + [ nc%stage_dimid, nc%event_dimid], nc%KE_spin_varid), "netcdf_initialize_output nf90_def_var KE_spin_varid" ) call check( nf90_def_var(nc%id, nc%pe_varname,& nc%out_type,& - [ nc%stage_dimid, nc%time_dimid], nc%PE_varid), "netcdf_initialize_output nf90_def_var PE_varid" ) + [ nc%stage_dimid, nc%event_dimid], nc%PE_varid), "netcdf_initialize_output nf90_def_var PE_varid" ) call check( nf90_def_var(nc%id, nc%L_orb_varname, nc%out_type, & - [ nc%space_dimid, nc%stage_dimid, nc%time_dimid], nc%L_orb_varid), "netcdf_initialize_output nf90_def_var L_orb_varid" ) + [ nc%space_dimid, nc%stage_dimid, nc%event_dimid], nc%L_orb_varid), "netcdf_initialize_output nf90_def_var L_orb_varid" ) call check( nf90_def_var(nc%id, nc%L_spin_varname, nc%out_type,& - [ nc%space_dimid, nc%stage_dimid, nc%time_dimid], nc%L_spin_varid), "netcdf_initialize_output nf90_def_var L_spin_varid" ) + [ nc%space_dimid, nc%stage_dimid, nc%event_dimid], nc%L_spin_varid), "netcdf_initialize_output nf90_def_var L_spin_varid" ) @@ -154,30 +158,30 @@ module subroutine fraggle_io_write_frame(self, nc, param) class(encounter_io_parameters), intent(inout) :: nc !! Parameters used to identify a particular encounter io NetCDF dataset class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters ! Internals - integer(I4B) :: i, tslot, idslot, old_mode, npl + integer(I4B) :: i, eslot, idslot, old_mode, npl character(len=NAMELEN) :: charstring - tslot = param%ioutput + eslot = param%ioutput associate(pl => self%pl, colliders => self%colliders, fragments => self%fragments) call check( nf90_set_fill(nc%id, nf90_nofill, old_mode), "fraggle_io_write_frame nf90_set_fill" ) - call check( nf90_put_var(nc%id, nc%time_varid, self%t, start=[tslot]), "fraggle_io_write_frame nf90_put_var time_varid" ) - call check( nf90_put_var(nc%id, nc%loop_varid, int(self%iloop,kind=I4B), start=[tslot]), "fraggle_io_write_frame nf90_put_var pl loop_varid" ) + call check( nf90_put_var(nc%id, nc%time_varid, self%t, start=[eslot]), "fraggle_io_write_frame nf90_put_var time_varid" ) + call check( nf90_put_var(nc%id, nc%loop_varid, int(self%iloop,kind=I4B), start=[eslot]), "fraggle_io_write_frame nf90_put_var pl loop_varid" ) ! npl = pl%nbody ! do i = 1, npl ! idslot = pl%id(i) ! call check( nf90_put_var(nc%id, nc%id_varid, pl%id(i), start=[idslot]), "fraggle_io_write_frame nf90_put_var pl id_varid" ) - ! call check( nf90_put_var(nc%id, nc%rh_varid, pl%rh(:,i), start=[1,idslot,tslot], count=[NDIM,1,1]), "fraggle_io_write_frame nf90_put_var pl rh_varid" ) - ! call check( nf90_put_var(nc%id, nc%vh_varid, pl%vh(:,i), start=[1,idslot,tslot], count=[NDIM,1,1]), "fraggle_io_write_frame nf90_put_var pl vh_varid" ) - ! call check( nf90_put_var(nc%id, nc%Gmass_varid, pl%Gmass(i), start=[idslot, tslot]), "fraggle_io_write_frame nf90_put_var pl Gmass_varid" ) + ! call check( nf90_put_var(nc%id, nc%rh_varid, pl%rh(:,i), start=[1,idslot,eslot], count=[NDIM,1,1]), "fraggle_io_write_frame nf90_put_var pl rh_varid" ) + ! call check( nf90_put_var(nc%id, nc%vh_varid, pl%vh(:,i), start=[1,idslot,eslot], count=[NDIM,1,1]), "fraggle_io_write_frame nf90_put_var pl vh_varid" ) + ! call check( nf90_put_var(nc%id, nc%Gmass_varid, pl%Gmass(i), start=[idslot, eslot]), "fraggle_io_write_frame nf90_put_var pl Gmass_varid" ) - ! if (param%lclose) call check( nf90_put_var(nc%id, nc%radius_varid, pl%radius(i), start=[idslot, tslot]), "fraggle_io_write_frame nf90_put_var pl radius_varid" ) + ! if (param%lclose) call check( nf90_put_var(nc%id, nc%radius_varid, pl%radius(i), start=[idslot, eslot]), "fraggle_io_write_frame nf90_put_var pl radius_varid" ) ! if (param%lrotation) then - ! call check( nf90_put_var(nc%id, nc%Ip_varid, pl%Ip(:,i), start=[1, idslot, tslot], count=[NDIM,1,1]), "fraggle_io_write_frame nf90_put_var pl Ip_varid" ) - ! call check( nf90_put_var(nc%id, nc%rot_varid, pl%rot(:,i), start=[1,idslot, tslot], count=[NDIM,1,1]), "fraggle_io_write_frame nf90_put_var pl rotx_varid" ) + ! call check( nf90_put_var(nc%id, nc%Ip_varid, pl%Ip(:,i), start=[1, idslot, eslot], count=[NDIM,1,1]), "fraggle_io_write_frame nf90_put_var pl Ip_varid" ) + ! call check( nf90_put_var(nc%id, nc%rot_varid, pl%rot(:,i), start=[1,idslot, eslot], count=[NDIM,1,1]), "fraggle_io_write_frame nf90_put_var pl rotx_varid" ) ! end if ! charstring = trim(adjustl(pl%info(i)%name)) diff --git a/src/modules/fraggle_classes.f90 b/src/modules/fraggle_classes.f90 index 0aa7421a3..3ffd84d87 100644 --- a/src/modules/fraggle_classes.f90 +++ b/src/modules/fraggle_classes.f90 @@ -111,15 +111,19 @@ module fraggle_classes !! NetCDF dimension and variable names for the enounter save object type, extends(encounter_io_parameters) :: fraggle_io_parameters - integer(I4B) :: stage_dimid !! ID for the name variable - integer(I4B) :: stage_varid !! ID for the name variable + integer(I4B) :: stage_dimid !! ID for the stage dimension + integer(I4B) :: stage_varid !! ID for the stage variable character(NAMELEN) :: stage_dimname = "stage" !! name of the stage dimension (before/after) character(len=6), dimension(2) :: stage_coords = ["before", "after "] !! The stage coordinate labels - character(NAMELEN) :: Qloss_varname = "Qloss" !! name of the energy loss variable - integer(I4B) :: Qloss_varid !! ID for the energy loss variable - character(NAMELEN) :: regime_varname = "regime" !! name of the collision regime variable - integer(I4B) :: regime_varid !! ID for the collision regime variable + character(NAMELEN) :: event_dimname = "collision" !! Name of collision event dimension + integer(I4B) :: event_dimid !! ID for the collision event dimension + integer(I4B) :: event_varid !! ID for the collision event variable + + character(NAMELEN) :: Qloss_varname = "Qloss" !! name of the energy loss variable + integer(I4B) :: Qloss_varid !! ID for the energy loss variable + character(NAMELEN) :: regime_varname = "regime" !! name of the collision regime variable + integer(I4B) :: regime_varid !! ID for the collision regime variable contains procedure :: initialize => fraggle_io_initialize_output !! Initialize a set of parameters used to identify a NetCDF output object From b3f8c06438df9833b1babfa798e344fe6172383f Mon Sep 17 00:00:00 2001 From: David A Minton Date: Fri, 9 Dec 2022 17:41:03 -0500 Subject: [PATCH 360/569] Added more detail to the fraggle output. I discovered a need to take a snapshot of some of the planet variables in the colliders object. --- src/fraggle/fraggle_io.f90 | 62 ++++++++++++++++---------------- src/modules/fraggle_classes.f90 | 1 + src/modules/swiftest_globals.f90 | 1 + 3 files changed, 34 insertions(+), 30 deletions(-) diff --git a/src/fraggle/fraggle_io.f90 b/src/fraggle/fraggle_io.f90 index 8db44eb3c..0a302f020 100644 --- a/src/fraggle/fraggle_io.f90 +++ b/src/fraggle/fraggle_io.f90 @@ -158,39 +158,41 @@ module subroutine fraggle_io_write_frame(self, nc, param) class(encounter_io_parameters), intent(inout) :: nc !! Parameters used to identify a particular encounter io NetCDF dataset class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters ! Internals - integer(I4B) :: i, eslot, idslot, old_mode, npl + integer(I4B) :: i, j, eslot, idslot, old_mode, npl character(len=NAMELEN) :: charstring eslot = param%ioutput - associate(pl => self%pl, colliders => self%colliders, fragments => self%fragments) - - call check( nf90_set_fill(nc%id, nf90_nofill, old_mode), "fraggle_io_write_frame nf90_set_fill" ) - - call check( nf90_put_var(nc%id, nc%time_varid, self%t, start=[eslot]), "fraggle_io_write_frame nf90_put_var time_varid" ) - call check( nf90_put_var(nc%id, nc%loop_varid, int(self%iloop,kind=I4B), start=[eslot]), "fraggle_io_write_frame nf90_put_var pl loop_varid" ) - - ! npl = pl%nbody - ! do i = 1, npl - ! idslot = pl%id(i) - ! call check( nf90_put_var(nc%id, nc%id_varid, pl%id(i), start=[idslot]), "fraggle_io_write_frame nf90_put_var pl id_varid" ) - ! call check( nf90_put_var(nc%id, nc%rh_varid, pl%rh(:,i), start=[1,idslot,eslot], count=[NDIM,1,1]), "fraggle_io_write_frame nf90_put_var pl rh_varid" ) - ! call check( nf90_put_var(nc%id, nc%vh_varid, pl%vh(:,i), start=[1,idslot,eslot], count=[NDIM,1,1]), "fraggle_io_write_frame nf90_put_var pl vh_varid" ) - ! call check( nf90_put_var(nc%id, nc%Gmass_varid, pl%Gmass(i), start=[idslot, eslot]), "fraggle_io_write_frame nf90_put_var pl Gmass_varid" ) - - ! if (param%lclose) call check( nf90_put_var(nc%id, nc%radius_varid, pl%radius(i), start=[idslot, eslot]), "fraggle_io_write_frame nf90_put_var pl radius_varid" ) - - ! if (param%lrotation) then - ! call check( nf90_put_var(nc%id, nc%Ip_varid, pl%Ip(:,i), start=[1, idslot, eslot], count=[NDIM,1,1]), "fraggle_io_write_frame nf90_put_var pl Ip_varid" ) - ! call check( nf90_put_var(nc%id, nc%rot_varid, pl%rot(:,i), start=[1,idslot, eslot], count=[NDIM,1,1]), "fraggle_io_write_frame nf90_put_var pl rotx_varid" ) - ! end if - - ! charstring = trim(adjustl(pl%info(i)%name)) - ! call check( nf90_put_var(nc%id, nc%name_varid, charstring, start=[1, idslot], count=[NAMELEN, 1]), "fraggle_io_write_frame nf90_put_var pl name_varid" ) - ! charstring = trim(adjustl(pl%info(i)%particle_type)) - ! call check( nf90_put_var(nc%id, nc%ptype_varid, charstring, start=[1, idslot], count=[NAMELEN, 1]), "fraggle_io_write_frame nf90_put_var pl particle_type_varid" ) - ! end do - - call check( nf90_set_fill(nc%id, old_mode, old_mode) ) + associate(pl => self%colliders%pl, colliders => self%colliders, fragments => self%fragments) + select type(nc) + class is (fraggle_io_parameters) + call check( nf90_set_fill(nc%id, nf90_nofill, old_mode), "fraggle_io_write_frame nf90_set_fill" ) + + call check( nf90_put_var(nc%id, nc%time_varid, self%t, start=[eslot]), "fraggle_io_write_frame nf90_put_var time_varid" ) + call check( nf90_put_var(nc%id, nc%loop_varid, int(self%iloop,kind=I4B), start=[eslot]), "fraggle_io_write_frame nf90_put_var pl loop_varid" ) + call check( nf90_put_var(nc%id, nc%regime_varid, REGIME_NAMES(fragments%regime) , start=[eslot]), "fraggle_io_write_frame nf90_put_var pl loop_varid" ) + + ! Stage 1: The Colliders + npl = size(colliders%idx) + do j = 1, npl + i = colliders%idx(j) + idslot = pl%id(i) + call check( nf90_put_var(nc%id, nc%id_varid, pl%id(i), start=[ idslot ]), "fraggle_io_write_frame nf90_put_var pl id_varid" ) + charstring = trim(adjustl(pl%info(i)%name)) + call check( nf90_put_var(nc%id, nc%name_varid, charstring, start=[1, idslot], count=[NAMELEN, 1]), "fraggle_io_write_frame nf90_put_var pl name_varid" ) + charstring = trim(adjustl(pl%info(i)%particle_type)) + call check( nf90_put_var(nc%id, nc%ptype_varid, charstring, start=[1, idslot], count=[NAMELEN, 1]), "fraggle_io_write_frame nf90_put_var pl particle_type_varid" ) + end do + + call check( nf90_put_var(nc%id, nc%rh_varid, pl%rh(:,i), start=[1, idslot, 1, eslot], count=[NDIM,1,1,1]), "fraggle_io_write_frame nf90_put_var pl rh_varid" ) + call check( nf90_put_var(nc%id, nc%vh_varid, pl%vh(:,i), start=[1, idslot, 1, eslot], count=[NDIM,1,1,1]), "fraggle_io_write_frame nf90_put_var pl vh_varid" ) + call check( nf90_put_var(nc%id, nc%Gmass_varid, pl%Gmass(i), start=[ idslot, 1, eslot]), "fraggle_io_write_frame nf90_put_var pl Gmass_varid" ) + call check( nf90_put_var(nc%id, nc%radius_varid, pl%radius(i), start=[ idslot, 1, eslot]), "fraggle_io_write_frame nf90_put_var pl radius_varid" ) + call check( nf90_put_var(nc%id, nc%Ip_varid, pl%Ip(:,i), start=[1, idslot, 1, eslot], count=[NDIM,1,1,1]), "fraggle_io_write_frame nf90_put_var pl Ip_varid" ) + call check( nf90_put_var(nc%id, nc%rot_varid, pl%rot(:,i), start=[1, idslot, 1, eslot], count=[NDIM,1,1,1]), "fraggle_io_write_frame nf90_put_var pl rotx_varid" ) + + + call check( nf90_set_fill(nc%id, old_mode, old_mode) ) + end select end associate return diff --git a/src/modules/fraggle_classes.f90 b/src/modules/fraggle_classes.f90 index 3ffd84d87..ff6563b3e 100644 --- a/src/modules/fraggle_classes.f90 +++ b/src/modules/fraggle_classes.f90 @@ -35,6 +35,7 @@ module fraggle_classes real(DP), dimension(NDIM,2) :: Ip !! Two-body equivalent principal axes moments of inertia the collider bodies prior to collision real(DP), dimension(2) :: mass !! Two-body equivalent mass of the collider bodies prior to the collision real(DP), dimension(2) :: radius !! Two-body equivalent radii of the collider bodies prior to the collision + class(swiftest_pl), allocatable :: pl !! A snapshot of the planets involved in the collision contains procedure :: regime => fraggle_regime_colliders !! Determine which fragmentation regime the set of colliders will be final :: fraggle_util_final_colliders !! Finalizer will deallocate all allocatables diff --git a/src/modules/swiftest_globals.f90 b/src/modules/swiftest_globals.f90 index 4c8c21693..25f355152 100644 --- a/src/modules/swiftest_globals.f90 +++ b/src/modules/swiftest_globals.f90 @@ -101,6 +101,7 @@ module swiftest_globals integer(I4B), parameter :: COLLRESOLVE_REGIME_SUPERCATASTROPHIC = 3 integer(I4B), parameter :: COLLRESOLVE_REGIME_GRAZE_AND_MERGE = 4 integer(I4B), parameter :: COLLRESOLVE_REGIME_HIT_AND_RUN = 5 + character(len=*),dimension(5), parameter :: REGIME_NAMES = ["Merge", "Disruption", "Supercatastrophic", "Graze and Merge", "Hit and Run"] !> String labels for body/particle addition/subtraction in discard file character(*), parameter :: ADD = '+1' From 948aca431cdc1d690aed5eb1d1429247fc29d7ff Mon Sep 17 00:00:00 2001 From: David A Minton Date: Fri, 9 Dec 2022 17:41:51 -0500 Subject: [PATCH 361/569] Minor fixes --- src/fraggle/fraggle_io.f90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/fraggle/fraggle_io.f90 b/src/fraggle/fraggle_io.f90 index 0a302f020..12e2db7b8 100644 --- a/src/fraggle/fraggle_io.f90 +++ b/src/fraggle/fraggle_io.f90 @@ -172,7 +172,7 @@ module subroutine fraggle_io_write_frame(self, nc, param) call check( nf90_put_var(nc%id, nc%regime_varid, REGIME_NAMES(fragments%regime) , start=[eslot]), "fraggle_io_write_frame nf90_put_var pl loop_varid" ) ! Stage 1: The Colliders - npl = size(colliders%idx) + npl = pl%nbody do j = 1, npl i = colliders%idx(j) idslot = pl%id(i) @@ -181,7 +181,6 @@ module subroutine fraggle_io_write_frame(self, nc, param) call check( nf90_put_var(nc%id, nc%name_varid, charstring, start=[1, idslot], count=[NAMELEN, 1]), "fraggle_io_write_frame nf90_put_var pl name_varid" ) charstring = trim(adjustl(pl%info(i)%particle_type)) call check( nf90_put_var(nc%id, nc%ptype_varid, charstring, start=[1, idslot], count=[NAMELEN, 1]), "fraggle_io_write_frame nf90_put_var pl particle_type_varid" ) - end do call check( nf90_put_var(nc%id, nc%rh_varid, pl%rh(:,i), start=[1, idslot, 1, eslot], count=[NDIM,1,1,1]), "fraggle_io_write_frame nf90_put_var pl rh_varid" ) call check( nf90_put_var(nc%id, nc%vh_varid, pl%vh(:,i), start=[1, idslot, 1, eslot], count=[NDIM,1,1,1]), "fraggle_io_write_frame nf90_put_var pl vh_varid" ) @@ -190,6 +189,7 @@ module subroutine fraggle_io_write_frame(self, nc, param) call check( nf90_put_var(nc%id, nc%Ip_varid, pl%Ip(:,i), start=[1, idslot, 1, eslot], count=[NDIM,1,1,1]), "fraggle_io_write_frame nf90_put_var pl Ip_varid" ) call check( nf90_put_var(nc%id, nc%rot_varid, pl%rot(:,i), start=[1, idslot, 1, eslot], count=[NDIM,1,1,1]), "fraggle_io_write_frame nf90_put_var pl rotx_varid" ) + end do call check( nf90_set_fill(nc%id, old_mode, old_mode) ) end select From fa3b7f3d02bff4a4e0d79c24f9325a6f440dcfb5 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Fri, 9 Dec 2022 18:06:15 -0500 Subject: [PATCH 362/569] Added the structure necessary to snapshot collisions. Refactored fragmentation_save to collision_save --- examples/Fragmentation/Fragmentation_Movie.py | 2 +- python/swiftest/swiftest/simulation_class.py | 22 +++++++-------- src/encounter/encounter_io.f90 | 2 +- src/fraggle/fraggle_io.f90 | 2 +- src/fraggle/fraggle_util.f90 | 2 +- src/modules/fraggle_classes.f90 | 8 +++--- src/modules/symba_classes.f90 | 13 +++++++-- src/symba/symba_collision.f90 | 6 ++-- src/symba/symba_io.f90 | 8 +++--- src/symba/symba_step.f90 | 6 ++-- src/symba/symba_util.f90 | 28 +++++++++++++++++-- 11 files changed, 67 insertions(+), 32 deletions(-) diff --git a/examples/Fragmentation/Fragmentation_Movie.py b/examples/Fragmentation/Fragmentation_Movie.py index a664ef49e..e68c8a260 100644 --- a/examples/Fragmentation/Fragmentation_Movie.py +++ b/examples/Fragmentation/Fragmentation_Movie.py @@ -202,7 +202,7 @@ def data_stream(self, frame=0): # 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, fragmentation_save="TRAJECTORY", gmtiny=gmtiny, minimum_fragment_gmass=minimum_fragment_gmass, verbose=False) + sim.set_parameter(fragmentation=True, collision_save="TRAJECTORY", gmtiny=gmtiny, minimum_fragment_gmass=minimum_fragment_gmass, verbose=False) sim.run(dt=1e-4, tstop=1.0e-3, istep_out=1, dump_cadence=0) print("Generating animation") diff --git a/python/swiftest/swiftest/simulation_class.py b/python/swiftest/swiftest/simulation_class.py index 8f6a8d9dd..b7fdc1b7a 100644 --- a/python/swiftest/swiftest/simulation_class.py +++ b/python/swiftest/swiftest/simulation_class.py @@ -227,7 +227,7 @@ def __init__(self,read_param: bool = False, read_old_output_file: bool = False, If set to True, this turns on the Fraggle fragment generation code and `rotation` must also be True. This argument only applies to Swiftest-SyMBA simulations. It will be ignored otherwise. Parameter input file equivalent: `FRAGMENTATION` - fragmentation_save : {"NONE","TRAJECTORY","CLOSEST"}, default "NONE" + collision_save : {"NONE","TRAJECTORY","CLOSEST"}, default "NONE" Indicate if and how fragmentation data should be saved. If set to "TRAJECTORY" the full close encounter trajectories associated with each collision are saved to file. If set to "CLOSEST" only the trajectories at a the time the collision occurs are saved. If set to "NONE" no trajectory information is saved (collision @@ -794,7 +794,7 @@ def set_parameter(self, verbose: bool = True, **kwargs): "ephemeris_date": "MBCL", "restart": False, "encounter_save" : "NONE", - "fragmentation_save" : "NONE" + "collision_save" : "NONE" } param_file = kwargs.pop("param_file",None) @@ -1031,7 +1031,7 @@ def set_feature(self, interaction_loops: Literal["TRIANGULAR", "FLAT", "ADAPTIVE"] | None = None, encounter_check_loops: Literal["TRIANGULAR", "SORTSWEEP", "ADAPTIVE"] | None = None, encounter_save: Literal["NONE", "TRAJECTORY", "CLOSEST"] | None = None, - fragmentation_save: Literal["NONE", "TRAJECTORY", "CLOSEST"] | None = None, + collision_save: Literal["NONE", "TRAJECTORY", "CLOSEST"] | None = None, verbose: bool | None = None, **kwargs: Any ): @@ -1053,7 +1053,7 @@ def set_feature(self, fragmentation : bool, optional If set to True, this turns on the Fraggle fragment generation code and `rotation` must also be True. This argument only applies to Swiftest-SyMBA simulations. It will be ignored otherwise. - fragmentation_save : {"NONE","TRAJECTORY","CLOSEST"}, default "NONE" + collision_save : {"NONE","TRAJECTORY","CLOSEST"}, default "NONE" Indicate if and how fragmentation data should be saved. If set to "TRAJECTORY" the full close encounter trajectories associated with each collision are saved to file. If set to "CLOSEST" only the trajectories at a the time the collision occurs are saved. If set to "NONE" no trajectory information is saved (collision @@ -1226,18 +1226,18 @@ def set_feature(self, update_list.append("encounter_save") - if fragmentation_save is not None: - fragmentation_save = fragmentation_save.upper() + if collision_save is not None: + collision_save = collision_save.upper() valid_vals = ["NONE", "TRAJECTORY", "CLOSEST"] - if fragmentation_save not in valid_vals: - msg = f"{fragmentation_save} is not a valid option for fragmentation_save." + if collision_save not in valid_vals: + msg = f"{collision_save} is not a valid option for collision_save." msg += f"\nMust be one of {valid_vals}" warnings.warn(msg,stacklevel=2) if "FRAGMENTATION_SAVE" not in self.param: self.param["FRAGMENTATION_SAVE"] = valid_vals[0] else: - self.param["FRAGMENTATION_SAVE"] = fragmentation_save - update_list.append("fragmentation_save") + self.param["FRAGMENTATION_SAVE"] = collision_save + update_list.append("collision_save") self.param["TIDES"] = False @@ -1271,7 +1271,7 @@ def get_feature(self, arg_list: str | List[str] | None = None, verbose: bool | N valid_var = {"close_encounter_check": "CHK_CLOSE", "fragmentation": "FRAGMENTATION", "encounter_save": "ENCOUNTER_SAVE", - "fragmentation_save": "FRAGMENTATION_SAVE", + "collision_save": "FRAGMENTATION_SAVE", "minimum_fragment_gmass": "MIN_GMFRAG", "rotation": "ROTATION", "general_relativity": "GR", diff --git a/src/encounter/encounter_io.f90 b/src/encounter/encounter_io.f90 index 22412e97f..aece1e89f 100644 --- a/src/encounter/encounter_io.f90 +++ b/src/encounter/encounter_io.f90 @@ -28,7 +28,7 @@ module subroutine encounter_io_dump(self, param) param%ioutput = self%tslot(i) select type(snapshot => self%frame(i)%item) - class is (fraggle_encounter_snapshot) + class is (fraggle_collision_snapshot) call snapshot%write_frame(self%ncc,param) call snapshot%encounter_snapshot%write_frame(self%nce,param) class is (encounter_snapshot) diff --git a/src/fraggle/fraggle_io.f90 b/src/fraggle/fraggle_io.f90 index 12e2db7b8..5f3d6169e 100644 --- a/src/fraggle/fraggle_io.f90 +++ b/src/fraggle/fraggle_io.f90 @@ -154,7 +154,7 @@ module subroutine fraggle_io_write_frame(self, nc, param) use netcdf implicit none ! Arguments - class(fraggle_encounter_snapshot), intent(in) :: self !! Swiftest encounter structure + class(fraggle_collision_snapshot), intent(in) :: self !! Swiftest encounter structure class(encounter_io_parameters), intent(inout) :: nc !! Parameters used to identify a particular encounter io NetCDF dataset class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters ! Internals diff --git a/src/fraggle/fraggle_util.f90 b/src/fraggle/fraggle_util.f90 index c65b96282..2f708859c 100644 --- a/src/fraggle/fraggle_util.f90 +++ b/src/fraggle/fraggle_util.f90 @@ -174,7 +174,7 @@ module subroutine fraggle_util_final_snapshot(self) !! Finalizer will deallocate all allocatables implicit none ! Arguments - type(fraggle_encounter_snapshot), intent(inout) :: self !! Fraggle encountar storage object + type(fraggle_collision_snapshot), intent(inout) :: self !! Fraggle encountar storage object call encounter_util_final_snapshot(self%encounter_snapshot) diff --git a/src/modules/fraggle_classes.f90 b/src/modules/fraggle_classes.f90 index ff6563b3e..79c929710 100644 --- a/src/modules/fraggle_classes.f90 +++ b/src/modules/fraggle_classes.f90 @@ -130,14 +130,14 @@ module fraggle_classes procedure :: initialize => fraggle_io_initialize_output !! Initialize a set of parameters used to identify a NetCDF output object end type fraggle_io_parameters - type, extends(encounter_snapshot) :: fraggle_encounter_snapshot + type, extends(encounter_snapshot) :: fraggle_collision_snapshot logical :: lcollision !! Indicates that this snapshot contains at least one collision class(fraggle_colliders), allocatable :: colliders !! Colliders object at this snapshot class(fraggle_fragments), allocatable :: fragments !! Fragments object at this snapshot contains procedure :: write_frame => fraggle_io_write_frame !! Writes a frame of encounter data to file final :: fraggle_util_final_snapshot - end type fraggle_encounter_snapshot + end type fraggle_collision_snapshot interface module subroutine fraggle_generate_fragments(self, colliders, system, param, lfailure) @@ -158,7 +158,7 @@ end subroutine fraggle_io_initialize_output module subroutine fraggle_io_write_frame(self, nc, param) implicit none - class(fraggle_encounter_snapshot), intent(in) :: self !! Swiftest encounter structure + class(fraggle_collision_snapshot), intent(in) :: self !! Swiftest encounter structure class(encounter_io_parameters), intent(inout) :: nc !! Parameters used to identify a particular encounter io NetCDF dataset class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters end subroutine fraggle_io_write_frame @@ -293,7 +293,7 @@ end subroutine fraggle_util_final_fragments module subroutine fraggle_util_final_snapshot(self) implicit none - type(fraggle_encounter_snapshot), intent(inout) :: self !! Fraggle encountar storage object + type(fraggle_collision_snapshot), intent(inout) :: self !! Fraggle encountar storage object end subroutine fraggle_util_final_snapshot module subroutine fraggle_util_get_energy_momentum(self, colliders, system, param, lbefore) diff --git a/src/modules/symba_classes.f90 b/src/modules/symba_classes.f90 index a896c3dc1..f0c7ee340 100644 --- a/src/modules/symba_classes.f90 +++ b/src/modules/symba_classes.f90 @@ -31,7 +31,7 @@ module symba_classes integer(I4B), dimension(:), allocatable :: seed !! Random seeds logical :: lfragmentation = .false. !! Do fragmentation modeling instead of simple merger. character(STRMAX) :: encounter_save = "NONE" !! Indicate if and how encounter data should be saved - character(STRMAX) :: fragmentation_save = "NONE" !! Indicate if and how fragmentation data should be saved + character(STRMAX) :: collision_save = "NONE" !! Indicate if and how fragmentation data should be saved logical :: lencounter_save = .false. !! Turns on encounter saving contains procedure :: reader => symba_io_param_reader @@ -200,7 +200,8 @@ module symba_classes procedure :: set_recur_levels => symba_step_set_recur_levels_system !! Sets recursion levels of bodies and encounter lists to the current system level procedure :: recursive_step => symba_step_recur_system !! Step interacting planets and active test particles ahead in democratic heliocentric coordinates at the current recursion level, if applicable, and descend to the next deeper level if necessary procedure :: reset => symba_step_reset_system !! Resets pl, tp,and encounter structures at the start of a new step - procedure :: snapshot => symba_util_take_encounter_snapshot !! Take a minimal snapshot of the system through an encounter + procedure :: encounter_snap => symba_util_take_encounter_snapshot !! Take a minimal snapshot of the system through an encounter + procedure :: collision_snap => symba_util_take_collision_snapshot !! Take a minimal snapshot of the system before and after a collision procedure :: dump_encounter => symba_io_dump_encounter !! Saves the encounter and/or fragmentation data to file(s) final :: symba_util_final_system !! Finalizes the SyMBA nbody system object - deallocates all allocatables end type symba_nbody_system @@ -371,6 +372,14 @@ module subroutine symba_util_set_renc(self, scale) integer(I4B), intent(in) :: scale !! Current recursion depth end subroutine symba_util_set_renc + module subroutine symba_util_take_collision_snapshot(self, param, t, stage) + implicit none + class(symba_nbody_system), intent(inout) :: self !! SyMBA nbody system object + class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters + real(DP), intent(in) :: t !! current time + character(*), intent(in) :: stage !! Either before or afte + end subroutine symba_util_take_collision_snapshot + module subroutine symba_util_take_encounter_snapshot(self, param, t) use swiftest_classes, only : swiftest_parameters implicit none diff --git a/src/symba/symba_collision.f90 b/src/symba/symba_collision.f90 index be6406374..6107e9d12 100644 --- a/src/symba/symba_collision.f90 +++ b/src/symba/symba_collision.f90 @@ -885,7 +885,7 @@ module subroutine symba_resolve_collision_fragmentations(self, system, param) logical :: lgoodcollision integer(I4B) :: i - associate(plplcollision_list => self, ncollisions => self%nenc, idx1 => self%index1, idx2 => self%index2, colliders => system%colliders, fragments => system%fragments) + associate(plplcollision_list => self, ncollisions => self%nenc, idx1 => self%index1, idx2 => self%index2, colliders => system%colliders, fragments => system%fragments, t => system%t) select type(pl => system%pl) class is (symba_pl) select type (cb => system%cb) @@ -897,7 +897,8 @@ module subroutine symba_resolve_collision_fragmentations(self, system, param) if ((.not. lgoodcollision) .or. any(pl%status(idx_parent(:)) /= COLLISION)) cycle call colliders%regime(fragments, system, param) - + + if (param%lencounter_save) call system%collision_snap(param, t, "before") select case (fragments%regime) case (COLLRESOLVE_REGIME_DISRUPTION, COLLRESOLVE_REGIME_SUPERCATASTROPHIC) plplcollision_list%status(i) = symba_collision_casedisruption(system, param) @@ -909,6 +910,7 @@ module subroutine symba_resolve_collision_fragmentations(self, system, param) write(*,*) "Error in symba_collision, unrecognized collision regime" call util_exit(FAILURE) end select + if (param%lencounter_save) call system%collision_snap(param, t, "after") end do end select end select diff --git a/src/symba/symba_io.f90 b/src/symba/symba_io.f90 index b1fb0faf4..d76bb9e59 100644 --- a/src/symba/symba_io.f90 +++ b/src/symba/symba_io.f90 @@ -101,7 +101,7 @@ module subroutine symba_io_param_reader(self, unit, iotype, v_list, iostat, ioms read(param_value, *) param%encounter_save case ("FRAGMENTATION_SAVE") call io_toupper(param_value) - read(param_value, *) param%fragmentation_save + read(param_value, *) param%collision_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 @@ -159,14 +159,14 @@ module subroutine symba_io_param_reader(self, unit, iotype, v_list, iostat, ioms return end if - if ((param%fragmentation_save /= "NONE") .and. (param%fragmentation_save /= "TRAJECTORY") .and. (param%fragmentation_save /= "CLOSEST")) then - write(iomsg,*) 'Invalid fragmentation_save parameter: ',trim(adjustl(param%out_type)) + if ((param%collision_save /= "NONE") .and. (param%collision_save /= "TRAJECTORY") .and. (param%collision_save /= "CLOSEST")) then + write(iomsg,*) 'Invalid collision_save parameter: ',trim(adjustl(param%out_type)) write(iomsg,*) 'Valid options are NONE, TRAJECTORY, or CLOSEST' iostat = -1 return end if param%lencounter_save = (param%encounter_save == "TRAJECTORY") .or. (param%encounter_save == "CLOSEST") .or. & - (param%fragmentation_save == "TRAJECTORY") .or. (param%fragmentation_save == "CLOSEST") + (param%collision_save == "TRAJECTORY") .or. (param%collision_save == "CLOSEST") ! Call the base method (which also prints the contents to screen) call io_param_reader(param, unit, iotype, v_list, iostat, iomsg) diff --git a/src/symba/symba_step.f90 b/src/symba/symba_step.f90 index 9e8f643bd..dc303b4f7 100644 --- a/src/symba/symba_step.f90 +++ b/src/symba/symba_step.f90 @@ -37,9 +37,9 @@ module subroutine symba_step_system(self, param, t, dt) call self%reset(param) lencounter = pl%encounter_check(param, self, dt, 0) .or. tp%encounter_check(param, self, dt, 0) if (lencounter) then - if (param%lencounter_save) call self%snapshot(param, t) + if (param%lencounter_save) call self%encounter_snap(param, t) call self%interp(param, t, dt) - if (param%lencounter_save) call self%snapshot(param, t+dt) + if (param%lencounter_save) call self%encounter_snap(param, t+dt) else self%irec = -1 call helio_step_system(self, param, t, dt) @@ -244,7 +244,7 @@ recursive module subroutine symba_step_recur_system(self, param, t, ireci) if (lplpl_collision) call plplenc_list%resolve_collision(system, param, t+dtl, dtl, ireci) if (lpltp_collision) call pltpenc_list%resolve_collision(system, param, t+dtl, dtl, ireci) end if - if (param%lencounter_save) call system%snapshot(param, t+dtl) + if (param%lencounter_save) call system%encounter_snap(param, t+dtl) call self%set_recur_levels(ireci) diff --git a/src/symba/symba_util.f90 b/src/symba/symba_util.f90 index 5d8a4a444..5c902730d 100644 --- a/src/symba/symba_util.f90 +++ b/src/symba/symba_util.f90 @@ -1287,6 +1287,30 @@ module subroutine symba_util_spill_tp(self, discards, lspill_list, ldestructive) end subroutine symba_util_spill_tp + module subroutine symba_util_take_collision_snapshot(self, param, t, stage) + !! author: David A. Minton + !! + !! Takes a minimal snapshot of the state of the system during an encounter so that the trajectories + !! can be played back through the encounter + implicit none + ! Internals + class(symba_nbody_system), intent(inout) :: self !! SyMBA nbody system object + class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters + real(DP), intent(in) :: t !! current time + character(*), intent(in) :: stage !! Either before or after + ! Arguments + class(fraggle_collision_snapshot), allocatable :: snapshot + + select case(stage) + case("before") + + case("after") + + end select + + return + end subroutine symba_util_take_collision_snapshot + module subroutine symba_util_take_encounter_snapshot(self, param, t) !! author: David A. Minton !! @@ -1304,7 +1328,7 @@ module subroutine symba_util_take_encounter_snapshot(self, param, t) associate(npl => self%pl%nbody, ntp => self%tp%nbody) if (self%plplenc_list%lcollision) then - allocate(fraggle_encounter_snapshot :: snapshot) + allocate(fraggle_collision_snapshot :: snapshot) else allocate(encounter_snapshot :: snapshot) end if @@ -1388,7 +1412,7 @@ module subroutine symba_util_take_encounter_snapshot(self, param, t) end select select type(snapshot) - class is (fraggle_encounter_snapshot) + class is (fraggle_collision_snapshot) allocate(snapshot%colliders, source=self%colliders) allocate(snapshot%fragments, source=self%fragments) end select From df77b321cc728b5677bcc3aa31bea7da11bc0dc0 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Fri, 9 Dec 2022 18:22:44 -0500 Subject: [PATCH 363/569] Switched fragments and colliders to be allocatables so they get wiped out between collision resolves --- src/modules/symba_classes.f90 | 4 ++-- src/symba/symba_collision.f90 | 11 +++++++---- 2 files changed, 9 insertions(+), 6 deletions(-) diff --git a/src/modules/symba_classes.f90 b/src/modules/symba_classes.f90 index f0c7ee340..93640a8d1 100644 --- a/src/modules/symba_classes.f90 +++ b/src/modules/symba_classes.f90 @@ -189,8 +189,8 @@ module symba_classes 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(fraggle_colliders) :: colliders !! Fraggle colliders object - type(fraggle_fragments) :: fragments !! Fraggle fragmentation system object + class(fraggle_colliders), allocatable :: colliders !! Fraggle colliders object + class(fraggle_fragments), allocatable :: fragments !! Fraggle fragmentation system object type(encounter_storage(nframes=:)), allocatable :: encounter_history !! Stores encounter history for later retrieval and saving to file contains procedure :: write_discard => symba_io_write_discard !! Write out information about discarded and merged planets and test particles in SyMBA diff --git a/src/symba/symba_collision.f90 b/src/symba/symba_collision.f90 index 6107e9d12..12822cb07 100644 --- a/src/symba/symba_collision.f90 +++ b/src/symba/symba_collision.f90 @@ -885,21 +885,23 @@ module subroutine symba_resolve_collision_fragmentations(self, system, param) logical :: lgoodcollision integer(I4B) :: i - associate(plplcollision_list => self, ncollisions => self%nenc, idx1 => self%index1, idx2 => self%index2, colliders => system%colliders, fragments => system%fragments, t => system%t) + associate(plplcollision_list => self, ncollisions => self%nenc, idx1 => self%index1, idx2 => self%index2, t => system%t) select type(pl => system%pl) class is (symba_pl) select type (cb => system%cb) class is (symba_cb) do i = 1, ncollisions + allocate(fraggle_colliders :: system%colliders) + allocate(fraggle_fragments :: system%fragments) idx_parent(1) = pl%kin(idx1(i))%parent idx_parent(2) = pl%kin(idx2(i))%parent - lgoodcollision = symba_collision_consolidate_colliders(pl, cb, param, idx_parent, colliders) + lgoodcollision = symba_collision_consolidate_colliders(pl, cb, param, idx_parent, system%colliders) if ((.not. lgoodcollision) .or. any(pl%status(idx_parent(:)) /= COLLISION)) cycle - call colliders%regime(fragments, system, param) + call system%colliders%regime(system%fragments, system, param) if (param%lencounter_save) call system%collision_snap(param, t, "before") - select case (fragments%regime) + select case (system%fragments%regime) case (COLLRESOLVE_REGIME_DISRUPTION, COLLRESOLVE_REGIME_SUPERCATASTROPHIC) plplcollision_list%status(i) = symba_collision_casedisruption(system, param) case (COLLRESOLVE_REGIME_HIT_AND_RUN) @@ -911,6 +913,7 @@ module subroutine symba_resolve_collision_fragmentations(self, system, param) call util_exit(FAILURE) end select if (param%lencounter_save) call system%collision_snap(param, t, "after") + deallocate(system%colliders,system%fragments) end do end select end select From 245c9bd8c3acc95540e252810f28f10e3cb11868 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Fri, 9 Dec 2022 18:56:30 -0500 Subject: [PATCH 364/569] More updates to the collision snapshot taker --- src/symba/symba_util.f90 | 27 +++++++++++++++++++++------ 1 file changed, 21 insertions(+), 6 deletions(-) diff --git a/src/symba/symba_util.f90 b/src/symba/symba_util.f90 index 5c902730d..853a3db0f 100644 --- a/src/symba/symba_util.f90 +++ b/src/symba/symba_util.f90 @@ -1300,14 +1300,35 @@ module subroutine symba_util_take_collision_snapshot(self, param, t, stage) character(*), intent(in) :: stage !! Either before or after ! Arguments class(fraggle_collision_snapshot), allocatable :: snapshot + integer(I4B) :: i,j select case(stage) case("before") + associate (idx => self%colliders%idx, ncoll => self%colliders%ncoll) + allocate(fraggle_collision_snapshot :: snapshot) + allocate(snapshot%colliders, source=self%colliders) + allocate(symba_pl :: snapshot%colliders%pl) + select type(pl => snapshot%colliders%pl) + class is (symba_pl) + call pl%setup(ncoll, param) + pl%id(:) = self%pl%id(idx(:)) + pl%Gmass(:) = self%pl%Gmass(idx(:)) + pl%radius(:) = self%pl%radius(idx(:)) + pl%rot(:,:) = self%pl%rot(:,idx(:)) + pl%Ip(:,:) = self%pl%Ip(:,idx(:)) + pl%rh(:,:) = self%pl%rh(:,idx(:)) + pl%vh(:,:) = self%pl%vh(:,idx(:)) + pl%info(:) = self%pl%info(idx(:)) + end select + end associate case("after") end select + + ! Save the self + call symba_util_save_storage(self,snapshot,t) return end subroutine symba_util_take_collision_snapshot @@ -1411,12 +1432,6 @@ module subroutine symba_util_take_encounter_snapshot(self, param, t) end select end select - select type(snapshot) - class is (fraggle_collision_snapshot) - allocate(snapshot%colliders, source=self%colliders) - allocate(snapshot%fragments, source=self%fragments) - end select - ! Save the snapshot call symba_util_save_storage(self,snapshot,t) end select From 4d2fb37cfc1f552e89ffcc8b208a21ccf43523d9 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Fri, 9 Dec 2022 19:11:50 -0500 Subject: [PATCH 365/569] Keep on adding snapshot stuff --- src/modules/fraggle_classes.f90 | 1 + src/symba/symba_collision.f90 | 1 + src/symba/symba_util.f90 | 6 +++--- 3 files changed, 5 insertions(+), 3 deletions(-) diff --git a/src/modules/fraggle_classes.f90 b/src/modules/fraggle_classes.f90 index 79c929710..0aaead00b 100644 --- a/src/modules/fraggle_classes.f90 +++ b/src/modules/fraggle_classes.f90 @@ -66,6 +66,7 @@ module fraggle_classes real(DP), dimension(:), allocatable :: rotmag !! Array of rotation magnitudes of individual fragments real(DP), dimension(:), allocatable :: v_r_mag !! Array of radial direction velocity magnitudes of individual fragments real(DP), dimension(:), allocatable :: v_t_mag !! Array of tangential direction velocity magnitudes of individual fragments + class(swiftest_pl), allocatable :: pl !! A snapshot of the fragments created in the collision ! Energy and momentum book-keeping variables that characterize the whole system of fragments real(DP) :: ke_orbit !! Current orbital kinetic energy of the system of fragments in the collisional frame diff --git a/src/symba/symba_collision.f90 b/src/symba/symba_collision.f90 index 12822cb07..53e0a84bc 100644 --- a/src/symba/symba_collision.f90 +++ b/src/symba/symba_collision.f90 @@ -831,6 +831,7 @@ subroutine symba_collision_mergeaddsub(system, param, status) ! Log the properties of the new bodies call fraggle_io_log_pl(plnew, param) + allocate(system%fragments%pl, source=plnew) ! Append the new merged body to the list nstart = pl_adds%nbody + 1 diff --git a/src/symba/symba_util.f90 b/src/symba/symba_util.f90 index 853a3db0f..eedb632fc 100644 --- a/src/symba/symba_util.f90 +++ b/src/symba/symba_util.f90 @@ -1323,12 +1323,12 @@ module subroutine symba_util_take_collision_snapshot(self, param, t, stage) end associate case("after") - + allocate(snapshot%fragments, source=self%fragments) end select - ! Save the self - call symba_util_save_storage(self,snapshot,t) + ! Save the snapshot + !call symba_util_save_storage(self,snapshot,t) return end subroutine symba_util_take_collision_snapshot From f1387ba295c0d5cb0f5b1738e6b03e6420a50b5a Mon Sep 17 00:00:00 2001 From: David A Minton Date: Fri, 9 Dec 2022 19:15:20 -0500 Subject: [PATCH 366/569] Rearranged snapshot taking for collisions --- src/symba/symba_util.f90 | 18 ++++++++---------- 1 file changed, 8 insertions(+), 10 deletions(-) diff --git a/src/symba/symba_util.f90 b/src/symba/symba_util.f90 index eedb632fc..d54027696 100644 --- a/src/symba/symba_util.f90 +++ b/src/symba/symba_util.f90 @@ -1299,16 +1299,14 @@ module subroutine symba_util_take_collision_snapshot(self, param, t, stage) real(DP), intent(in) :: t !! current time character(*), intent(in) :: stage !! Either before or after ! Arguments - class(fraggle_collision_snapshot), allocatable :: snapshot + class(fraggle_collision_snapshot), allocatable:: snapshot integer(I4B) :: i,j select case(stage) case("before") associate (idx => self%colliders%idx, ncoll => self%colliders%ncoll) - allocate(fraggle_collision_snapshot :: snapshot) - allocate(snapshot%colliders, source=self%colliders) - allocate(symba_pl :: snapshot%colliders%pl) - select type(pl => snapshot%colliders%pl) + allocate(symba_pl :: self%colliders%pl) + select type(pl => self%colliders%pl) class is (symba_pl) call pl%setup(ncoll, param) pl%id(:) = self%pl%id(idx(:)) @@ -1321,14 +1319,14 @@ module subroutine symba_util_take_collision_snapshot(self, param, t, stage) pl%info(:) = self%pl%info(idx(:)) end select end associate - case("after") - allocate(snapshot%fragments, source=self%fragments) + allocate(fraggle_collision_snapshot :: snapshot) + allocate(snapshot%colliders, source=self%colliders) + allocate(snapshot%fragments, source=self%fragments) + !call symba_util_save_storage(self,snapshot,t) + deallocate(snapshot) end select - - ! Save the snapshot - !call symba_util_save_storage(self,snapshot,t) return end subroutine symba_util_take_collision_snapshot From e08f725691745f60d28c769869a729ea36c0ff8e Mon Sep 17 00:00:00 2001 From: David A Minton Date: Fri, 9 Dec 2022 19:16:34 -0500 Subject: [PATCH 367/569] Helpful comments --- src/symba/symba_util.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/symba/symba_util.f90 b/src/symba/symba_util.f90 index d54027696..9b6d11463 100644 --- a/src/symba/symba_util.f90 +++ b/src/symba/symba_util.f90 @@ -1304,6 +1304,7 @@ module subroutine symba_util_take_collision_snapshot(self, param, t, stage) select case(stage) case("before") + ! Saves the states of the bodies involved in the collision before the collision is resolved associate (idx => self%colliders%idx, ncoll => self%colliders%ncoll) allocate(symba_pl :: self%colliders%pl) select type(pl => self%colliders%pl) @@ -1324,7 +1325,6 @@ module subroutine symba_util_take_collision_snapshot(self, param, t, stage) allocate(snapshot%colliders, source=self%colliders) allocate(snapshot%fragments, source=self%fragments) !call symba_util_save_storage(self,snapshot,t) - deallocate(snapshot) end select return From dc894e69f258ab1c219ab125139fb9f55be942d3 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Fri, 9 Dec 2022 20:13:30 -0500 Subject: [PATCH 368/569] OOF stuff --- src/setup/setup.f90 | 18 +++++++++++++----- 1 file changed, 13 insertions(+), 5 deletions(-) diff --git a/src/setup/setup.f90 b/src/setup/setup.f90 index 835d1c995..9123514ad 100644 --- a/src/setup/setup.f90 +++ b/src/setup/setup.f90 @@ -73,11 +73,19 @@ module subroutine setup_construct_system(system, param) class is (symba_parameters) if (param%lencounter_save) then allocate(encounter_storage :: system%encounter_history) - allocate(encounter_io_parameters :: system%encounter_history%nce) - allocate(fraggle_io_parameters :: system%encounter_history%ncc) - call system%encounter_history%reset() - system%encounter_history%nce%file_number = param%iloop / param%dump_cadence - system%encounter_history%ncc%file_number = param%iloop / param%dump_cadence + associate (encounter_history => system%encounter_history) + allocate(encounter_io_parameters :: encounter_history%nce) + call encounter_history%reset() + select type(nce => encounter_history%nce) + class is (encounter_io_parameters) + nce%file_number = param%iloop / param%dump_cadence + end select + allocate(fraggle_io_parameters :: encounter_history%ncc) + select type(ncc => encounter_history%ncc) + class is (fraggle_io_parameters) + ncc%file_number = param%iloop / param%dump_cadence + end select + end associate end if end select end select From 7972bcc5137f490d7427760fccb586531e76ca26 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Fri, 9 Dec 2022 21:10:23 -0500 Subject: [PATCH 369/569] Made new collision_history storage object --- src/encounter/encounter_io.f90 | 6 +++--- src/modules/encounter_classes.f90 | 3 +-- src/modules/symba_classes.f90 | 1 + src/setup/setup.f90 | 17 +++++++++++------ src/symba/symba_io.f90 | 16 ++++++++++------ src/symba/symba_util.f90 | 3 +-- 6 files changed, 27 insertions(+), 19 deletions(-) diff --git a/src/encounter/encounter_io.f90 b/src/encounter/encounter_io.f90 index aece1e89f..025b923fc 100644 --- a/src/encounter/encounter_io.f90 +++ b/src/encounter/encounter_io.f90 @@ -29,10 +29,10 @@ module subroutine encounter_io_dump(self, param) select type(snapshot => self%frame(i)%item) class is (fraggle_collision_snapshot) - call snapshot%write_frame(self%ncc,param) - call snapshot%encounter_snapshot%write_frame(self%nce,param) + call snapshot%write_frame(self%nc,param) + call snapshot%encounter_snapshot%write_frame(self%nc,param) class is (encounter_snapshot) - call snapshot%write_frame(self%nce,param) + call snapshot%write_frame(self%nc,param) end select else exit diff --git a/src/modules/encounter_classes.f90 b/src/modules/encounter_classes.f90 index 69ed90e19..95f230344 100644 --- a/src/modules/encounter_classes.f90 +++ b/src/modules/encounter_classes.f90 @@ -66,8 +66,7 @@ module encounter_classes !> A class that that is used to store simulation history data between file output type, extends(swiftest_storage) :: encounter_storage - class(encounter_io_parameters), allocatable :: nce !! NetCDF parameter object containing the details about the encounter file attached to this storage object - class(encounter_io_parameters), allocatable :: ncc !! NetCDF parameter object containing the details about the collision file attached to this storage object + class(encounter_io_parameters), allocatable :: nc !! NetCDF parameter object containing the details about the file attached to this storage object contains procedure :: dump => encounter_io_dump !! Dumps contents of encounter history to file final :: encounter_util_final_storage diff --git a/src/modules/symba_classes.f90 b/src/modules/symba_classes.f90 index 93640a8d1..a31d042f9 100644 --- a/src/modules/symba_classes.f90 +++ b/src/modules/symba_classes.f90 @@ -192,6 +192,7 @@ module symba_classes class(fraggle_colliders), allocatable :: colliders !! Fraggle colliders object class(fraggle_fragments), allocatable :: fragments !! Fraggle fragmentation system object type(encounter_storage(nframes=:)), allocatable :: encounter_history !! Stores encounter history for later retrieval and saving to file + type(encounter_storage(nframes=:)), allocatable :: collision_history !! Stores encounter history for later retrieval and saving to file 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 diff --git a/src/setup/setup.f90 b/src/setup/setup.f90 index 9123514ad..ea822f45d 100644 --- a/src/setup/setup.f90 +++ b/src/setup/setup.f90 @@ -74,16 +74,21 @@ module subroutine setup_construct_system(system, param) if (param%lencounter_save) then allocate(encounter_storage :: system%encounter_history) associate (encounter_history => system%encounter_history) - allocate(encounter_io_parameters :: encounter_history%nce) + allocate(encounter_io_parameters :: encounter_history%nc) call encounter_history%reset() - select type(nce => encounter_history%nce) + select type(nc => encounter_history%nc) class is (encounter_io_parameters) - nce%file_number = param%iloop / param%dump_cadence + nc%file_number = param%iloop / param%dump_cadence end select - allocate(fraggle_io_parameters :: encounter_history%ncc) - select type(ncc => encounter_history%ncc) + end associate + + allocate(encounter_storage :: system%collision_history) + associate (collision_history => system%collision_history) + allocate(fraggle_io_parameters :: collision_history%nc) + call collision_history%reset() + select type(nc => collision_history%nc) class is (fraggle_io_parameters) - ncc%file_number = param%iloop / param%dump_cadence + nc%file_number = param%iloop / param%dump_cadence end select end associate end if diff --git a/src/symba/symba_io.f90 b/src/symba/symba_io.f90 index d76bb9e59..94f53d3f9 100644 --- a/src/symba/symba_io.f90 +++ b/src/symba/symba_io.f90 @@ -23,21 +23,25 @@ module subroutine symba_io_dump_encounter(self, param) if (self%encounter_history%iframe == 0) return ! No enounters in this interval - associate(encounter_history => self%encounter_history, nce => self%encounter_history%nce, ncc => self%encounter_history%ncc, iframe => self%encounter_history%iframe) + associate(encounter_history => self%encounter_history, nce => self%encounter_history%nc, eframe => self%encounter_history%iframe,& + collision_history => self%collision_history, ncc => self%collision_history%nc, cframe => self%collision_history%iframe) ! Create and save the output files for this encounter and fragmentation nce%file_number = nce%file_number + 1 - ncc%file_number = ncc%file_number + 1 nce%time_dimsize = maxval(encounter_history%tslot(:)) - ncc%time_dimsize = maxval(encounter_history%tslot(:)) write(nce%file_name, '("encounter_",I0.6,".nc")') nce%file_number - write(ncc%file_name, '("collision_",I0.6,".nc")') ncc%file_number call nce%initialize(param) - call ncc%initialize(param) call encounter_history%dump(param) call nce%close() - call ncc%close() call encounter_history%reset() + + ncc%file_number = ncc%file_number + 1 + write(ncc%file_name, '("collision_",I0.6,".nc")') ncc%file_number + ncc%time_dimsize = maxval(collision_history%tslot(:)) + call ncc%initialize(param) + call collision_history%dump(param) + call ncc%close() + call collision_history%reset() end associate return diff --git a/src/symba/symba_util.f90 b/src/symba/symba_util.f90 index 9b6d11463..d90c3268c 100644 --- a/src/symba/symba_util.f90 +++ b/src/symba/symba_util.f90 @@ -903,8 +903,7 @@ subroutine symba_util_save_storage(system, snapshot, t) tmp%tslot(1:nold) = system%encounter_history%tslot(1:nold) tmp%tslot(nold+1:nbig) = 0 tmp%iframe = system%encounter_history%iframe - call move_alloc(system%encounter_history%nce, tmp%nce) - call move_alloc(system%encounter_history%ncc, tmp%ncc) + call move_alloc(system%encounter_history%nc, tmp%nc) do i = 1, nold if (allocated(system%encounter_history%frame(i)%item)) call move_alloc(system%encounter_history%frame(i)%item, tmp%frame(i)%item) From ec08c01f98913ebeb607bd5d1e1fc4add3568888 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Fri, 9 Dec 2022 23:30:02 -0500 Subject: [PATCH 370/569] More progress. Everything is connected. Just needs to be tested and bugs fixed --- src/encounter/encounter_io.f90 | 4 +-- src/symba/symba_util.f90 | 57 +++++++++++++++++++++++++++++++--- 2 files changed, 55 insertions(+), 6 deletions(-) diff --git a/src/encounter/encounter_io.f90 b/src/encounter/encounter_io.f90 index 025b923fc..d4677ac3c 100644 --- a/src/encounter/encounter_io.f90 +++ b/src/encounter/encounter_io.f90 @@ -25,13 +25,13 @@ module subroutine encounter_io_dump(self, param) do i = 1, self%nframes if (allocated(self%frame(i)%item)) then - param%ioutput = self%tslot(i) select type(snapshot => self%frame(i)%item) class is (fraggle_collision_snapshot) + param%ioutput = i call snapshot%write_frame(self%nc,param) - call snapshot%encounter_snapshot%write_frame(self%nc,param) class is (encounter_snapshot) + param%ioutput = self%tslot(i) call snapshot%write_frame(self%nc,param) end select else diff --git a/src/symba/symba_util.f90 b/src/symba/symba_util.f90 index d90c3268c..c149e1126 100644 --- a/src/symba/symba_util.f90 +++ b/src/symba/symba_util.f90 @@ -869,7 +869,56 @@ module subroutine symba_util_resize_pl(self, nnew) end subroutine symba_util_resize_pl - subroutine symba_util_save_storage(system, snapshot, t) + subroutine symba_util_save_collision(system, snapshot) + !! author: David A. Minton + !! + !! Checks the current size of the encounter storage against the required size and extends it by a factor of 2 more than requested if it is too small. + !! Note: The reason to extend it by a factor of 2 is for performance. When there are many enounters per step, resizing every time you want to add an + !! encounter takes significant computational effort. Resizing by a factor of 2 is a tradeoff between performance (fewer resize calls) and memory managment + !! Memory usage grows by a factor of 2 each time it fills up, but no more. + implicit none + ! Arguments + type(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object + class(encounter_snapshot), intent(in) :: snapshot !! Encounter snapshot object + ! Internals + type(encounter_storage(nframes=:)), allocatable :: tmp + integer(I4B) :: i, nnew, nold, nbig + + ! Advance the snapshot frame counter + system%collision_history%iframe = system%collision_history%iframe + 1 + + ! Check to make sure the current encounter_history object is big enough. If not, grow it by a factor of 2 + nnew = system%encounter_history%iframe + nold = system%encounter_history%nframes + + if (nnew > nold) then + nbig = nold + do while (nbig < nnew) + nbig = nbig * 2 + end do + allocate(encounter_storage(nbig) :: tmp) + tmp%tvals(1:nold) = system%encounter_history%tvals(1:nold) + tmp%tvals(nold+1:nbig) = huge(1.0_DP) + tmp%tslot(1:nold) = system%encounter_history%tslot(1:nold) + tmp%tslot(nold+1:nbig) = 0 + tmp%iframe = system%encounter_history%iframe + call move_alloc(system%encounter_history%nc, tmp%nc) + + do i = 1, nold + if (allocated(system%encounter_history%frame(i)%item)) call move_alloc(system%encounter_history%frame(i)%item, tmp%frame(i)%item) + end do + deallocate(system%encounter_history) + call move_alloc(tmp,system%encounter_history) + nnew = nbig + end if + + system%collision_history%frame(nnew) = snapshot + + return + end subroutine symba_util_save_collision + + + subroutine symba_util_save_encounter(system, snapshot, t) !! 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. @@ -925,7 +974,7 @@ subroutine symba_util_save_storage(system, snapshot, t) end do return - end subroutine symba_util_save_storage + end subroutine symba_util_save_encounter module subroutine symba_util_resize_tp(self, nnew) @@ -1323,7 +1372,7 @@ module subroutine symba_util_take_collision_snapshot(self, param, t, stage) allocate(fraggle_collision_snapshot :: snapshot) allocate(snapshot%colliders, source=self%colliders) allocate(snapshot%fragments, source=self%fragments) - !call symba_util_save_storage(self,snapshot,t) + call symba_util_save_collision(self,snapshot) end select return @@ -1430,7 +1479,7 @@ module subroutine symba_util_take_encounter_snapshot(self, param, t) end select ! Save the snapshot - call symba_util_save_storage(self,snapshot,t) + call symba_util_save_encounter(self,snapshot,t) end select end select end associate From 076126bdd80f64e5205e0d5d61c22c1b3c3b1037 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Fri, 9 Dec 2022 23:32:57 -0500 Subject: [PATCH 371/569] Fixed wrong object --- src/symba/symba_util.f90 | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) diff --git a/src/symba/symba_util.f90 b/src/symba/symba_util.f90 index c149e1126..d5ff2ba2e 100644 --- a/src/symba/symba_util.f90 +++ b/src/symba/symba_util.f90 @@ -888,8 +888,8 @@ subroutine symba_util_save_collision(system, snapshot) system%collision_history%iframe = system%collision_history%iframe + 1 ! Check to make sure the current encounter_history object is big enough. If not, grow it by a factor of 2 - nnew = system%encounter_history%iframe - nold = system%encounter_history%nframes + nnew = system%collision_history%iframe + nold = system%collision_history%nframes if (nnew > nold) then nbig = nold @@ -897,18 +897,18 @@ subroutine symba_util_save_collision(system, snapshot) nbig = nbig * 2 end do allocate(encounter_storage(nbig) :: tmp) - tmp%tvals(1:nold) = system%encounter_history%tvals(1:nold) + tmp%tvals(1:nold) = system%collision_history%tvals(1:nold) tmp%tvals(nold+1:nbig) = huge(1.0_DP) - tmp%tslot(1:nold) = system%encounter_history%tslot(1:nold) + tmp%tslot(1:nold) = system%collision_history%tslot(1:nold) tmp%tslot(nold+1:nbig) = 0 - tmp%iframe = system%encounter_history%iframe - call move_alloc(system%encounter_history%nc, tmp%nc) + tmp%iframe = system%collision_history%iframe + call move_alloc(system%collision_history%nc, tmp%nc) do i = 1, nold - if (allocated(system%encounter_history%frame(i)%item)) call move_alloc(system%encounter_history%frame(i)%item, tmp%frame(i)%item) + if (allocated(system%collision_history%frame(i)%item)) call move_alloc(system%collision_history%frame(i)%item, tmp%frame(i)%item) end do - deallocate(system%encounter_history) - call move_alloc(tmp,system%encounter_history) + deallocate(system%collision_history) + call move_alloc(tmp,system%collision_history) nnew = nbig end if From 38b375325d1571dd9a6db27afe260568f07d4899 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Sat, 10 Dec 2022 07:58:02 -0500 Subject: [PATCH 372/569] Fixed incorrect type allocation --- src/encounter/encounter_io.f90 | 1 - src/symba/symba_util.f90 | 6 +----- 2 files changed, 1 insertion(+), 6 deletions(-) diff --git a/src/encounter/encounter_io.f90 b/src/encounter/encounter_io.f90 index d4677ac3c..3f34c0e83 100644 --- a/src/encounter/encounter_io.f90 +++ b/src/encounter/encounter_io.f90 @@ -25,7 +25,6 @@ module subroutine encounter_io_dump(self, param) do i = 1, self%nframes if (allocated(self%frame(i)%item)) then - select type(snapshot => self%frame(i)%item) class is (fraggle_collision_snapshot) param%ioutput = i diff --git a/src/symba/symba_util.f90 b/src/symba/symba_util.f90 index d5ff2ba2e..5b840ad0c 100644 --- a/src/symba/symba_util.f90 +++ b/src/symba/symba_util.f90 @@ -1394,11 +1394,7 @@ module subroutine symba_util_take_encounter_snapshot(self, param, t) associate(npl => self%pl%nbody, ntp => self%tp%nbody) - if (self%plplenc_list%lcollision) then - allocate(fraggle_collision_snapshot :: snapshot) - else - allocate(encounter_snapshot :: snapshot) - end if + allocate(encounter_snapshot :: snapshot) snapshot%t = t snapshot%iloop = param%iloop From 71e8c27e01020304a62bc589ab4a6019c2efcb23 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Sat, 10 Dec 2022 08:11:45 -0500 Subject: [PATCH 373/569] Fixed up some netcdf stuff --- src/fraggle/fraggle_io.f90 | 43 +++++++++++++++++++------------------- 1 file changed, 21 insertions(+), 22 deletions(-) diff --git a/src/fraggle/fraggle_io.f90 b/src/fraggle/fraggle_io.f90 index 5f3d6169e..43f4f25ff 100644 --- a/src/fraggle/fraggle_io.f90 +++ b/src/fraggle/fraggle_io.f90 @@ -52,17 +52,16 @@ module subroutine fraggle_io_initialize_output(self, param) call check( nf90_create(nc%file_name, NF90_NETCDF4, nc%id), "fraggle_io_initialize nf90_create" ) ! Dimensions - call check( nf90_def_var(nc%id, nc%event_dimname, NF90_INT, nc%event_dimid, nc%event_varid), "fraggle_io_initialize nf90_def_var event_varid" ) - call check( nf90_def_dim(nc%id, nc%space_dimname, NDIM , nc%space_dimid), "fraggle_io_initialize nf90_def_dim space_dimid" ) ! 3D space dimension - call check( nf90_def_dim(nc%id, nc%id_dimname, param%maxid, nc%id_dimid), "fraggle_io_initialize nf90_def_dim id_dimid" ) ! dimension to store particle id numbers - call check( nf90_def_dim(nc%id, nc%str_dimname, NAMELEN, nc%str_dimid), "fraggle_io_initialize nf90_def_dim str_dimid" ) ! Dimension for string variables (aka character arrays) - call check( nf90_def_dim(nc%id, nc%stage_dimname, 2, nc%stage_dimid), "fraggle_io_initialize nf90_def_dim stage_dimid" ) ! Dimension for stage variables (aka "before" vs. "after" + call check( nf90_def_dim(nc%id, nc%event_dimname, NF90_UNLIMITED, nc%event_dimid), "fraggle_io_initialize nf90_def_dim event_dimid" ) ! Dimension to store individual collision events + call check( nf90_def_dim(nc%id, nc%space_dimname, NDIM, nc%space_dimid), "fraggle_io_initialize nf90_def_dim space_dimid" ) ! 3D space dimension + call check( nf90_def_dim(nc%id, nc%id_dimname, param%maxid, nc%id_dimid), "fraggle_io_initialize nf90_def_dim id_dimid" ) ! Dimension to store particle id numbers + call check( nf90_def_dim(nc%id, nc%str_dimname, NAMELEN, nc%str_dimid), "fraggle_io_initialize nf90_def_dim str_dimid" ) ! Dimension for string variables (aka character arrays) + call check( nf90_def_dim(nc%id, nc%stage_dimname, 2, nc%stage_dimid), "fraggle_io_initialize nf90_def_dim stage_dimid" ) ! Dimension for stage variables (aka "before" vs. "after" ! Dimension coordinates - call check( nf90_def_var(nc%id, nc%event_dimname, nc%out_type, nc%event_dimid, nc%event_varid), "fraggle_io_initialize nf90_def_var event_varid" ) - call check( nf90_def_var(nc%id, nc%space_dimname, NF90_CHAR, nc%space_dimid, nc%space_varid), "fraggle_io_initialize nf90_def_var space_varid" ) - call check( nf90_def_var(nc%id, nc%id_dimname, NF90_INT, nc%id_dimid, nc%id_varid), "fraggle_io_initialize nf90_def_var id_varid" ) - call check( nf90_def_var(nc%id, nc%stage_dimname, NF90_CHAR, nc%stage_dimid, nc%stage_varid), "fraggle_io_initialize nf90_def_var stage_varid" ) + call check( nf90_def_var(nc%id, nc%space_dimname, NF90_CHAR, nc%space_dimid, nc%space_varid), "fraggle_io_initialize nf90_def_var space_varid" ) + call check( nf90_def_var(nc%id, nc%id_dimname, NF90_INT, nc%id_dimid, nc%id_varid), "fraggle_io_initialize nf90_def_var id_varid" ) + call check( nf90_def_var(nc%id, nc%stage_dimname, NF90_CHAR, nc%stage_dimid, nc%stage_varid), "fraggle_io_initialize nf90_def_var stage_varid" ) ! Variables call check( nf90_def_var(nc%id, nc%time_dimname, nc%out_type, & @@ -136,7 +135,7 @@ module subroutine fraggle_io_initialize_output(self, param) call check( nf90_put_var(nc%id, nc%stage_varid, nc%stage_coords, start=[1], count=[2]), "fraggle_io_initialize nf90_put_var stage" ) ! Pre-fill id slots with ids - call check( nf90_put_var(nc%id, nc%id_varid, [(-1,i=1,param%maxid)], start=[1], count=[param%maxid]), "fraggle_io_initialize nf90_put_var pl id_varid" ) + call check( nf90_put_var(nc%id, nc%id_varid, [(-1,i=1,param%maxid)], start=[1], count=[param%maxid]), "fraggle_io_initialize nf90_put_varid_varid" ) end associate return @@ -168,26 +167,26 @@ module subroutine fraggle_io_write_frame(self, nc, param) call check( nf90_set_fill(nc%id, nf90_nofill, old_mode), "fraggle_io_write_frame nf90_set_fill" ) call check( nf90_put_var(nc%id, nc%time_varid, self%t, start=[eslot]), "fraggle_io_write_frame nf90_put_var time_varid" ) - call check( nf90_put_var(nc%id, nc%loop_varid, int(self%iloop,kind=I4B), start=[eslot]), "fraggle_io_write_frame nf90_put_var pl loop_varid" ) - call check( nf90_put_var(nc%id, nc%regime_varid, REGIME_NAMES(fragments%regime) , start=[eslot]), "fraggle_io_write_frame nf90_put_var pl loop_varid" ) + call check( nf90_put_var (nc%id, nc%loop_varid, int(self%iloop,kind=I4B), start=[eslot]), "fraggle_io_write_frame nf90_put_varloop_varid" ) + call check( nf90_put_var(nc%id, nc%regime_varid, REGIME_NAMES(fragments%regime) , start=[eslot]), "fraggle_io_write_frame nf90_put_var regime_varid" ) ! Stage 1: The Colliders npl = pl%nbody do j = 1, npl i = colliders%idx(j) idslot = pl%id(i) - call check( nf90_put_var(nc%id, nc%id_varid, pl%id(i), start=[ idslot ]), "fraggle_io_write_frame nf90_put_var pl id_varid" ) + call check( nf90_put_var(nc%id, nc%id_varid, pl%id(i), start=[ idslot ]), "fraggle_io_write_frame nf90_put_var id_varid" ) charstring = trim(adjustl(pl%info(i)%name)) - call check( nf90_put_var(nc%id, nc%name_varid, charstring, start=[1, idslot], count=[NAMELEN, 1]), "fraggle_io_write_frame nf90_put_var pl name_varid" ) + call check( nf90_put_var(nc%id, nc%name_varid, charstring, start=[1, idslot], count=[NAMELEN, 1]), "fraggle_io_write_frame nf90_put_var name_varid" ) charstring = trim(adjustl(pl%info(i)%particle_type)) - call check( nf90_put_var(nc%id, nc%ptype_varid, charstring, start=[1, idslot], count=[NAMELEN, 1]), "fraggle_io_write_frame nf90_put_var pl particle_type_varid" ) + call check( nf90_put_var(nc%id, nc%ptype_varid, charstring, start=[1, idslot], count=[NAMELEN, 1]), "fraggle_io_write_frame nf90_put_var particle_type_varid" ) - call check( nf90_put_var(nc%id, nc%rh_varid, pl%rh(:,i), start=[1, idslot, 1, eslot], count=[NDIM,1,1,1]), "fraggle_io_write_frame nf90_put_var pl rh_varid" ) - call check( nf90_put_var(nc%id, nc%vh_varid, pl%vh(:,i), start=[1, idslot, 1, eslot], count=[NDIM,1,1,1]), "fraggle_io_write_frame nf90_put_var pl vh_varid" ) - call check( nf90_put_var(nc%id, nc%Gmass_varid, pl%Gmass(i), start=[ idslot, 1, eslot]), "fraggle_io_write_frame nf90_put_var pl Gmass_varid" ) - call check( nf90_put_var(nc%id, nc%radius_varid, pl%radius(i), start=[ idslot, 1, eslot]), "fraggle_io_write_frame nf90_put_var pl radius_varid" ) - call check( nf90_put_var(nc%id, nc%Ip_varid, pl%Ip(:,i), start=[1, idslot, 1, eslot], count=[NDIM,1,1,1]), "fraggle_io_write_frame nf90_put_var pl Ip_varid" ) - call check( nf90_put_var(nc%id, nc%rot_varid, pl%rot(:,i), start=[1, idslot, 1, eslot], count=[NDIM,1,1,1]), "fraggle_io_write_frame nf90_put_var pl rotx_varid" ) + call check( nf90_put_var(nc%id, nc%rh_varid, pl%rh(:,i), start=[1, idslot, 1, eslot], count=[NDIM,1,1,1]), "fraggle_io_write_frame nf90_put_var rh_varid" ) + call check( nf90_put_var(nc%id, nc%vh_varid, pl%vh(:,i), start=[1, idslot, 1, eslot], count=[NDIM,1,1,1]), "fraggle_io_write_frame nf90_put_var vh_varid" ) + call check( nf90_put_var(nc%id, nc%Gmass_varid, pl%Gmass(i), start=[ idslot, 1, eslot]), "fraggle_io_write_frame nf90_put_var Gmass_varid" ) + call check( nf90_put_var(nc%id, nc%radius_varid, pl%radius(i), start=[ idslot, 1, eslot]), "fraggle_io_write_frame nf90_put_var radius_varid" ) + call check( nf90_put_var(nc%id, nc%Ip_varid, pl%Ip(:,i), start=[1, idslot, 1, eslot], count=[NDIM,1,1,1]), "fraggle_io_write_frame nf90_put_var Ip_varid" ) + call check( nf90_put_var(nc%id, nc%rot_varid, pl%rot(:,i), start=[1, idslot, 1, eslot], count=[NDIM,1,1,1]), "fraggle_io_write_frame nf90_put_var rotx_varid" ) end do @@ -205,7 +204,7 @@ module subroutine fraggle_io_log_pl(pl, param) !! Writes a single message to the fraggle log file implicit none ! Arguments - class(swiftest_pl), intent(in) :: pl !! Swiftest massive body object (only the new bodies generated in a collision) + class(swiftest_pl), intent(in) :: pl !! Swiftest massive body object (only the new bodies generated in a collision) class(swiftest_parameters), intent(in) :: param !! Current swiftest run configuration parameters ! Internals integer(I4B) :: i From 05359b1673db63f1d71743402a7253231ce0a27a Mon Sep 17 00:00:00 2001 From: David A Minton Date: Sat, 10 Dec 2022 08:17:57 -0500 Subject: [PATCH 374/569] Fixed a bunch of NetCDF fraggle stuff and now it compiles and doesn't crash! --- src/fraggle/fraggle_io.f90 | 63 +++++++++++++++++++------------------- 1 file changed, 32 insertions(+), 31 deletions(-) diff --git a/src/fraggle/fraggle_io.f90 b/src/fraggle/fraggle_io.f90 index 43f4f25ff..e8dafd84c 100644 --- a/src/fraggle/fraggle_io.f90 +++ b/src/fraggle/fraggle_io.f90 @@ -64,52 +64,54 @@ module subroutine fraggle_io_initialize_output(self, param) call check( nf90_def_var(nc%id, nc%stage_dimname, NF90_CHAR, nc%stage_dimid, nc%stage_varid), "fraggle_io_initialize nf90_def_var stage_varid" ) ! Variables - call check( nf90_def_var(nc%id, nc%time_dimname, nc%out_type, & - nc%event_dimid, nc%time_varid), "fraggle_io_initialize nf90_def_var time_varid" ) + call check( nf90_def_var(nc%id, nc%time_dimname, nc%out_type, & + nc%event_dimid, nc%time_varid), "fraggle_io_initialize nf90_def_var time_varid" ) call check( nf90_def_var(nc%id, nc%regime_varname, NF90_CHAR, & [nc%str_dimid, nc%event_dimid], nc%regime_varid), "fraggle_io_initialize nf90_def_var regime_varid") - call check( nf90_def_var(nc%id, nc%Qloss_varname, NF90_CHAR, & + call check( nf90_def_var(nc%id, nc%Qloss_varname, NF90_CHAR, & [ nc%event_dimid], nc%regime_varid), "fraggle_io_initialize nf90_def_var regime_varid") - call check( nf90_def_var(nc%id, nc%name_varname, NF90_CHAR, & - [nc%str_dimid, nc%id_dimid ], nc%name_varid), "fraggle_io_initialize nf90_def_var name_varid") + call check( nf90_def_var(nc%id, nc%name_varname, NF90_CHAR, & + [nc%str_dimid, nc%id_dimid ], nc%name_varid), "fraggle_io_initialize nf90_def_var name_varid") + + call check( nf90_def_var(nc%id, nc%ptype_varname, NF90_CHAR, & + [nc%str_dimid, nc%id_dimid, nc%event_dimid], nc%ptype_varid), "fraggle_io_initialize nf90_def_var ptype_varid") - call check( nf90_def_var(nc%id, nc%loop_varname, NF90_INT, & - [ nc%event_dimid], nc%loop_varid), "fraggle_io_initialize nf90_def_var loop_varid") + call check( nf90_def_var(nc%id, nc%loop_varname, NF90_INT, & + [ nc%event_dimid], nc%loop_varid), "fraggle_io_initialize nf90_def_var loop_varid") - call check( nf90_def_var(nc%id, nc%rh_varname,nc%out_type,& - [ nc%space_dimid, nc%id_dimid, nc%stage_dimid, nc%event_dimid], nc%rh_varid), "fraggle_io_initialize nf90_def_var rh_varid") + call check( nf90_def_var(nc%id, nc%rh_varname, nc%out_type,& + [ nc%space_dimid, nc%id_dimid, nc%stage_dimid, nc%event_dimid], nc%rh_varid), "fraggle_io_initialize nf90_def_var rh_varid") - call check( nf90_def_var(nc%id, nc%vh_varname, nc%out_type,& - [ nc%space_dimid, nc%id_dimid, nc%stage_dimid, nc%event_dimid], nc%vh_varid), "fraggle_io_initialize nf90_def_var vh_varid") + call check( nf90_def_var(nc%id, nc%vh_varname, nc%out_type,& + [ nc%space_dimid, nc%id_dimid, nc%stage_dimid, nc%event_dimid], nc%vh_varid), "fraggle_io_initialize nf90_def_var vh_varid") - call check( nf90_def_var(nc%id, nc%Gmass_varname, nc%out_type,& - [ nc%id_dimid, nc%stage_dimid, nc%event_dimid], nc%Gmass_varid), "fraggle_io_initialize nf90_def_var Gmass_varid") + call check( nf90_def_var(nc%id, nc%Gmass_varname, nc%out_type,& + [ nc%id_dimid, nc%stage_dimid, nc%event_dimid], nc%Gmass_varid), "fraggle_io_initialize nf90_def_var Gmass_varid") - call check( nf90_def_var(nc%id, nc%radius_varname, nc%out_type,& + call check( nf90_def_var(nc%id, nc%radius_varname, nc%out_type,& [ nc%id_dimid, nc%stage_dimid, nc%event_dimid], nc%radius_varid), "fraggle_io_initialize nf90_def_var radius_varid") - call check( nf90_def_var(nc%id, nc%Ip_varname, nc%out_type,& - [ nc%space_dimid, nc%id_dimid, nc%stage_dimid, nc%event_dimid], nc%Ip_varid), "fraggle_io_initialize nf90_def_var Ip_varid") + call check( nf90_def_var(nc%id, nc%Ip_varname, nc%out_type,& + [ nc%space_dimid, nc%id_dimid, nc%stage_dimid, nc%event_dimid], nc%Ip_varid), "fraggle_io_initialize nf90_def_var Ip_varid") - call check( nf90_def_var(nc%id, nc%rot_varname, nc%out_type,& - [ nc%space_dimid, nc%id_dimid, nc%stage_dimid, nc%event_dimid], nc%rot_varid), "fraggle_io_initialize nf90_def_var rot_varid") + call check( nf90_def_var(nc%id, nc%rot_varname, nc%out_type,& + [ nc%space_dimid, nc%id_dimid, nc%stage_dimid, nc%event_dimid], nc%rot_varid), "fraggle_io_initialize nf90_def_var rot_varid") - call check( nf90_def_var(nc%id, nc%ke_orb_varname, nc%out_type,& - [ nc%stage_dimid, nc%event_dimid], nc%KE_orb_varid), "netcdf_initialize_output nf90_def_var KE_orb_varid") + call check( nf90_def_var(nc%id, nc%ke_orb_varname, nc%out_type,& + [ nc%stage_dimid, nc%event_dimid], nc%KE_orb_varid), "fraggle_io_initialize_output nf90_def_var KE_orb_varid") call check( nf90_def_var(nc%id, nc%ke_spin_varname, nc%out_type,& - [ nc%stage_dimid, nc%event_dimid], nc%KE_spin_varid), "netcdf_initialize_output nf90_def_var KE_spin_varid" ) + [ nc%stage_dimid, nc%event_dimid], nc%KE_spin_varid), "fraggle_io_initialize_output nf90_def_var KE_spin_varid" ) - call check( nf90_def_var(nc%id, nc%pe_varname,& - nc%out_type,& - [ nc%stage_dimid, nc%event_dimid], nc%PE_varid), "netcdf_initialize_output nf90_def_var PE_varid" ) + call check( nf90_def_var(nc%id, nc%pe_varname, nc%out_type,& + [ nc%stage_dimid, nc%event_dimid], nc%PE_varid), "fraggle_io_initialize_output nf90_def_var PE_varid" ) - call check( nf90_def_var(nc%id, nc%L_orb_varname, nc%out_type, & - [ nc%space_dimid, nc%stage_dimid, nc%event_dimid], nc%L_orb_varid), "netcdf_initialize_output nf90_def_var L_orb_varid" ) + call check( nf90_def_var(nc%id, nc%L_orb_varname, nc%out_type, & + [ nc%space_dimid, nc%stage_dimid, nc%event_dimid], nc%L_orb_varid), "fraggle_io_initialize_output nf90_def_var L_orb_varid" ) call check( nf90_def_var(nc%id, nc%L_spin_varname, nc%out_type,& - [ nc%space_dimid, nc%stage_dimid, nc%event_dimid], nc%L_spin_varid), "netcdf_initialize_output nf90_def_var L_spin_varid" ) + [ nc%space_dimid, nc%stage_dimid, nc%event_dimid], nc%L_spin_varid), "fraggle_io_initialize_output nf90_def_var L_spin_varid" ) @@ -157,7 +159,7 @@ module subroutine fraggle_io_write_frame(self, nc, param) class(encounter_io_parameters), intent(inout) :: nc !! Parameters used to identify a particular encounter io NetCDF dataset class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters ! Internals - integer(I4B) :: i, j, eslot, idslot, old_mode, npl + integer(I4B) :: i, eslot, idslot, old_mode, npl character(len=NAMELEN) :: charstring eslot = param%ioutput @@ -172,14 +174,13 @@ module subroutine fraggle_io_write_frame(self, nc, param) ! Stage 1: The Colliders npl = pl%nbody - do j = 1, npl - i = colliders%idx(j) + do i = 1, npl idslot = pl%id(i) call check( nf90_put_var(nc%id, nc%id_varid, pl%id(i), start=[ idslot ]), "fraggle_io_write_frame nf90_put_var id_varid" ) charstring = trim(adjustl(pl%info(i)%name)) call check( nf90_put_var(nc%id, nc%name_varid, charstring, start=[1, idslot], count=[NAMELEN, 1]), "fraggle_io_write_frame nf90_put_var name_varid" ) charstring = trim(adjustl(pl%info(i)%particle_type)) - call check( nf90_put_var(nc%id, nc%ptype_varid, charstring, start=[1, idslot], count=[NAMELEN, 1]), "fraggle_io_write_frame nf90_put_var particle_type_varid" ) + call check( nf90_put_var(nc%id, nc%ptype_varid, charstring, start=[1, idslot, eslot], count=[NAMELEN, 1, 1]), "fraggle_io_write_frame nf90_put_var particle_type_varid" ) call check( nf90_put_var(nc%id, nc%rh_varid, pl%rh(:,i), start=[1, idslot, 1, eslot], count=[NDIM,1,1,1]), "fraggle_io_write_frame nf90_put_var rh_varid" ) call check( nf90_put_var(nc%id, nc%vh_varid, pl%vh(:,i), start=[1, idslot, 1, eslot], count=[NDIM,1,1,1]), "fraggle_io_write_frame nf90_put_var vh_varid" ) From 8eeae19ff7f42b1be1a985ce4ae3dbd4be651196 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Sat, 10 Dec 2022 08:44:24 -0500 Subject: [PATCH 375/569] Getting the collision ouput data cleaned up. --- examples/Fragmentation/Fragmentation_Movie.py | 2 +- python/swiftest/swiftest/simulation_class.py | 4 +- src/encounter/encounter_io.f90 | 11 +++--- src/fraggle/fraggle_io.f90 | 11 +++--- src/modules/fraggle_classes.f90 | 2 +- src/netcdf/netcdf.f90 | 14 +++---- src/symba/symba_io.f90 | 37 ++++++++++--------- 7 files changed, 42 insertions(+), 39 deletions(-) diff --git a/examples/Fragmentation/Fragmentation_Movie.py b/examples/Fragmentation/Fragmentation_Movie.py index e68c8a260..0e4a6c598 100644 --- a/examples/Fragmentation/Fragmentation_Movie.py +++ b/examples/Fragmentation/Fragmentation_Movie.py @@ -203,7 +203,7 @@ def data_stream(self, frame=0): 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, collision_save="TRAJECTORY", gmtiny=gmtiny, minimum_fragment_gmass=minimum_fragment_gmass, verbose=False) - sim.run(dt=1e-4, tstop=1.0e-3, istep_out=1, dump_cadence=0) + sim.run(dt=1e-4, tstop=1.0e-3, istep_out=1, dump_cadence=1) print("Generating animation") anim = AnimatedScatter(sim,movie_filename,movie_titles[style],style,nskip=1) \ No newline at end of file diff --git a/python/swiftest/swiftest/simulation_class.py b/python/swiftest/swiftest/simulation_class.py index b7fdc1b7a..2c2d10c98 100644 --- a/python/swiftest/swiftest/simulation_class.py +++ b/python/swiftest/swiftest/simulation_class.py @@ -2958,8 +2958,8 @@ def clean(self): ] glob_files = [self.simdir.glob("**/dump_param?.in")] \ + [self.simdir.glob("**/dump_bin?.nc")] \ - + [self.simdir.glob("**/enc*.nc")] \ - + [self.simdir.glob("**/frag*.nc")] + + [self.simdir.glob("**/encounter_*.nc")] \ + + [self.simdir.glob("**/collision_*.nc")] for f in old_files: if f.exists(): diff --git a/src/encounter/encounter_io.f90 b/src/encounter/encounter_io.f90 index 3f34c0e83..eade6d9e3 100644 --- a/src/encounter/encounter_io.f90 +++ b/src/encounter/encounter_io.f90 @@ -60,7 +60,6 @@ module subroutine encounter_io_initialize(self, param) logical :: fileExists character(len=STRMAX) :: errmsg integer(I4B) :: ndims, i - character(len=NAMELEN) :: charstring associate(nc => self) dfill = ieee_value(dfill, IEEE_QUIET_NAN) @@ -153,7 +152,7 @@ module subroutine encounter_io_write_frame(self, nc, param) class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters ! Internals integer(I4B) :: i, tslot, idslot, old_mode, npl, ntp - character(len=NAMELEN) :: charstring + character(len=:), allocatable :: charstring tslot = param%ioutput associate(pl => self%pl, tp => self%tp) @@ -179,9 +178,9 @@ module subroutine encounter_io_write_frame(self, nc, param) end if charstring = trim(adjustl(pl%info(i)%name)) - call check( nf90_put_var(nc%id, nc%name_varid, charstring, start=[1, idslot], count=[NAMELEN, 1]), "encounter_io_write_frame nf90_put_var pl name_varid" ) + call check( nf90_put_var(nc%id, nc%name_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "encounter_io_write_frame nf90_put_var pl name_varid" ) charstring = trim(adjustl(pl%info(i)%particle_type)) - call check( nf90_put_var(nc%id, nc%ptype_varid, charstring, start=[1, idslot], count=[NAMELEN, 1]), "encounter_io_write_frame nf90_put_var pl particle_type_varid" ) + call check( nf90_put_var(nc%id, nc%ptype_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "encounter_io_write_frame nf90_put_var pl particle_type_varid" ) end do ntp = tp%nbody @@ -192,9 +191,9 @@ module subroutine encounter_io_write_frame(self, nc, param) call check( nf90_put_var(nc%id, nc%vh_varid, tp%vh(:,i), start=[1,idslot,tslot], count=[NDIM,1,1]), "encounter_io_write_frame nf90_put_var tp vh_varid" ) charstring = trim(adjustl(tp%info(i)%name)) - call check( nf90_put_var(nc%id, nc%name_varid, charstring, start=[1, idslot], count=[NAMELEN, 1]), "encounter_io_write_frame nf90_put_var tp name_varid" ) + call check( nf90_put_var(nc%id, nc%name_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "encounter_io_write_frame nf90_put_var tp name_varid" ) charstring = trim(adjustl(tp%info(i)%particle_type)) - call check( nf90_put_var(nc%id, nc%ptype_varid, charstring, start=[1, idslot], count=[NAMELEN, 1]), "encounter_io_write_frame nf90_put_var tp particle_type_varid" ) + call check( nf90_put_var(nc%id, nc%ptype_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "encounter_io_write_frame nf90_put_var tp particle_type_varid" ) end do call check( nf90_set_fill(nc%id, old_mode, old_mode) ) diff --git a/src/fraggle/fraggle_io.f90 b/src/fraggle/fraggle_io.f90 index e8dafd84c..faedff8a8 100644 --- a/src/fraggle/fraggle_io.f90 +++ b/src/fraggle/fraggle_io.f90 @@ -61,7 +61,7 @@ module subroutine fraggle_io_initialize_output(self, param) ! Dimension coordinates call check( nf90_def_var(nc%id, nc%space_dimname, NF90_CHAR, nc%space_dimid, nc%space_varid), "fraggle_io_initialize nf90_def_var space_varid" ) call check( nf90_def_var(nc%id, nc%id_dimname, NF90_INT, nc%id_dimid, nc%id_varid), "fraggle_io_initialize nf90_def_var id_varid" ) - call check( nf90_def_var(nc%id, nc%stage_dimname, NF90_CHAR, nc%stage_dimid, nc%stage_varid), "fraggle_io_initialize nf90_def_var stage_varid" ) + call check( nf90_def_var(nc%id, nc%stage_dimname, NF90_CHAR, [nc%str_dimid, nc%stage_dimid], nc%stage_varid), "fraggle_io_initialize nf90_def_var stage_varid" ) ! Variables call check( nf90_def_var(nc%id, nc%time_dimname, nc%out_type, & @@ -134,7 +134,8 @@ module subroutine fraggle_io_initialize_output(self, param) ! Add in the space and stage dimension coordinates call check( nf90_put_var(nc%id, nc%space_varid, nc%space_coords, start=[1], count=[NDIM]), "fraggle_io_initialize nf90_put_var space" ) - call check( nf90_put_var(nc%id, nc%stage_varid, nc%stage_coords, start=[1], count=[2]), "fraggle_io_initialize nf90_put_var stage" ) + call check( nf90_put_var(nc%id, nc%stage_varid, nc%stage_coords(1), start=[1,1], count=[len(nc%stage_coords(1)),1]), "fraggle_io_initialize nf90_put_var stage 1" ) + call check( nf90_put_var(nc%id, nc%stage_varid, nc%stage_coords(2), start=[1,2], count=[len(nc%stage_coords(2)),1]), "fraggle_io_initialize nf90_put_var stage 2" ) ! Pre-fill id slots with ids call check( nf90_put_var(nc%id, nc%id_varid, [(-1,i=1,param%maxid)], start=[1], count=[param%maxid]), "fraggle_io_initialize nf90_put_varid_varid" ) @@ -160,7 +161,7 @@ module subroutine fraggle_io_write_frame(self, nc, param) class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters ! Internals integer(I4B) :: i, eslot, idslot, old_mode, npl - character(len=NAMELEN) :: charstring + character(len=:), allocatable :: charstring eslot = param%ioutput associate(pl => self%colliders%pl, colliders => self%colliders, fragments => self%fragments) @@ -178,9 +179,9 @@ module subroutine fraggle_io_write_frame(self, nc, param) idslot = pl%id(i) call check( nf90_put_var(nc%id, nc%id_varid, pl%id(i), start=[ idslot ]), "fraggle_io_write_frame nf90_put_var id_varid" ) charstring = trim(adjustl(pl%info(i)%name)) - call check( nf90_put_var(nc%id, nc%name_varid, charstring, start=[1, idslot], count=[NAMELEN, 1]), "fraggle_io_write_frame nf90_put_var name_varid" ) + call check( nf90_put_var(nc%id, nc%name_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "fraggle_io_write_frame nf90_put_var name_varid" ) charstring = trim(adjustl(pl%info(i)%particle_type)) - call check( nf90_put_var(nc%id, nc%ptype_varid, charstring, start=[1, idslot, eslot], count=[NAMELEN, 1, 1]), "fraggle_io_write_frame nf90_put_var particle_type_varid" ) + call check( nf90_put_var(nc%id, nc%ptype_varid, charstring, start=[1, idslot, eslot], count=[len(charstring), 1, 1]), "fraggle_io_write_frame nf90_put_var particle_type_varid" ) call check( nf90_put_var(nc%id, nc%rh_varid, pl%rh(:,i), start=[1, idslot, 1, eslot], count=[NDIM,1,1,1]), "fraggle_io_write_frame nf90_put_var rh_varid" ) call check( nf90_put_var(nc%id, nc%vh_varid, pl%vh(:,i), start=[1, idslot, 1, eslot], count=[NDIM,1,1,1]), "fraggle_io_write_frame nf90_put_var vh_varid" ) diff --git a/src/modules/fraggle_classes.f90 b/src/modules/fraggle_classes.f90 index 0aaead00b..0b95fd67a 100644 --- a/src/modules/fraggle_classes.f90 +++ b/src/modules/fraggle_classes.f90 @@ -116,7 +116,7 @@ module fraggle_classes integer(I4B) :: stage_dimid !! ID for the stage dimension integer(I4B) :: stage_varid !! ID for the stage variable character(NAMELEN) :: stage_dimname = "stage" !! name of the stage dimension (before/after) - character(len=6), dimension(2) :: stage_coords = ["before", "after "] !! The stage coordinate labels + character(len=6), dimension(2) :: stage_coords = ["before", "after"] !! The stage coordinate labels character(NAMELEN) :: event_dimname = "collision" !! Name of collision event dimension integer(I4B) :: event_dimid !! ID for the collision event dimension diff --git a/src/netcdf/netcdf.f90 b/src/netcdf/netcdf.f90 index d44cbb5a7..8cfc6432f 100644 --- a/src/netcdf/netcdf.f90 +++ b/src/netcdf/netcdf.f90 @@ -1163,7 +1163,7 @@ module subroutine netcdf_write_info_base(self, nc, param) ! Internals integer(I4B) :: i, j, idslot, old_mode integer(I4B), dimension(:), allocatable :: ind - character(len=NAMELEN) :: charstring + character(len=:), allocatable :: charstring ! This string of spaces of length NAMELEN is used to clear out any old data left behind inside the string variables call check( nf90_set_fill(nc%id, nf90_nofill, old_mode), "netcdf_write_info_base nf90_set_fill nf90_nofill" ) @@ -1180,14 +1180,14 @@ module subroutine netcdf_write_info_base(self, nc, param) call check( nf90_put_var(nc%id, nc%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(nc%id, nc%name_varid, charstring, start=[1, idslot], count=[NAMELEN, 1]), "netcdf_write_info_base nf90_put_var name_varid" ) + call check( nf90_put_var(nc%id, nc%name_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "netcdf_write_info_base nf90_put_var name_varid" ) charstring = trim(adjustl(self%info(j)%particle_type)) - call check( nf90_put_var(nc%id, nc%ptype_varid, charstring, start=[1, idslot], count=[NAMELEN, 1]), "netcdf_write_info_base nf90_put_var particle_type_varid" ) + call check( nf90_put_var(nc%id, nc%ptype_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "netcdf_write_info_base nf90_put_var particle_type_varid" ) if (param%lclose) then charstring = trim(adjustl(self%info(j)%origin_type)) - call check( nf90_put_var(nc%id, nc%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(nc%id, nc%origin_type_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "netcdf_write_info_base nf90_put_var origin_type_varid" ) call check( nf90_put_var(nc%id, nc%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(nc%id, nc%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(nc%id, nc%origin_vh_varid, self%info(j)%origin_vh(:), start=[1,idslot], count=[NDIM,1]), "netcdf_write_info_base nf90_put_var origin_vh_varid" ) @@ -1206,14 +1206,14 @@ module subroutine netcdf_write_info_base(self, nc, param) call check( nf90_put_var(nc%id, nc%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(nc%id, nc%name_varid, charstring, start=[1, idslot], count=[NAMELEN, 1]), "netcdf_write_info_base nf90_put_var cb name_varid" ) + call check( nf90_put_var(nc%id, nc%name_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "netcdf_write_info_base nf90_put_var cb name_varid" ) charstring = trim(adjustl(self%info%particle_type)) - call check( nf90_put_var(nc%id, nc%ptype_varid, charstring, start=[1, idslot], count=[NAMELEN, 1]), "netcdf_write_info_base nf90_put_var cb ptype_varid" ) + call check( nf90_put_var(nc%id, nc%ptype_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "netcdf_write_info_base nf90_put_var cb ptype_varid" ) if (param%lclose) then charstring = trim(adjustl(self%info%origin_type)) - call check( nf90_put_var(nc%id, nc%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(nc%id, nc%origin_type_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "netcdf_write_info_base nf90_put_var cb origin_type_varid" ) call check( nf90_put_var(nc%id, nc%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(nc%id, nc%origin_rh_varid, self%info%origin_rh(:), start=[1, idslot], count=[NDIM,1]), "netcdf_write_info_base nf90_put_var cb origin_rh_varid" ) diff --git a/src/symba/symba_io.f90 b/src/symba/symba_io.f90 index 94f53d3f9..9722fa0c3 100644 --- a/src/symba/symba_io.f90 +++ b/src/symba/symba_io.f90 @@ -21,27 +21,30 @@ module subroutine symba_io_dump_encounter(self, param) class(symba_nbody_system), intent(inout) :: self !! SyMBA nbody system object class(symba_parameters), intent(inout) :: param !! Current run configuration parameters - if (self%encounter_history%iframe == 0) return ! No enounters in this interval associate(encounter_history => self%encounter_history, nce => self%encounter_history%nc, eframe => self%encounter_history%iframe,& collision_history => self%collision_history, ncc => self%collision_history%nc, cframe => self%collision_history%iframe) - ! Create and save the output files for this encounter and fragmentation - nce%file_number = nce%file_number + 1 - nce%time_dimsize = maxval(encounter_history%tslot(:)) - write(nce%file_name, '("encounter_",I0.6,".nc")') nce%file_number - call nce%initialize(param) - call encounter_history%dump(param) - call nce%close() - call encounter_history%reset() - - ncc%file_number = ncc%file_number + 1 - write(ncc%file_name, '("collision_",I0.6,".nc")') ncc%file_number - ncc%time_dimsize = maxval(collision_history%tslot(:)) - call ncc%initialize(param) - call collision_history%dump(param) - call ncc%close() - call collision_history%reset() + if (encounter_history%iframe > 0) then + ! Create and save the output files for this encounter and fragmentation + nce%file_number = nce%file_number + 1 + nce%time_dimsize = maxval(encounter_history%tslot(:)) + write(nce%file_name, '("encounter_",I0.6,".nc")') nce%file_number + call nce%initialize(param) + call encounter_history%dump(param) + call nce%close() + call encounter_history%reset() + end if + + if (collision_history%iframe > 0) then + ncc%file_number = ncc%file_number + 1 + write(ncc%file_name, '("collision_",I0.6,".nc")') ncc%file_number + ncc%time_dimsize = maxval(collision_history%tslot(:)) + call ncc%initialize(param) + call collision_history%dump(param) + call ncc%close() + call collision_history%reset() + end if end associate return From 536f3182e21862df0368a288f28b4243fe996a5a Mon Sep 17 00:00:00 2001 From: David A Minton Date: Sat, 10 Dec 2022 10:26:15 -0500 Subject: [PATCH 376/569] Fixed id position issue --- src/encounter/encounter_io.f90 | 4 ++-- src/fraggle/fraggle_io.f90 | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/src/encounter/encounter_io.f90 b/src/encounter/encounter_io.f90 index eade6d9e3..94b0fade6 100644 --- a/src/encounter/encounter_io.f90 +++ b/src/encounter/encounter_io.f90 @@ -164,7 +164,7 @@ module subroutine encounter_io_write_frame(self, nc, param) npl = pl%nbody do i = 1, npl - idslot = pl%id(i) + idslot = pl%id(i) + 1 call check( nf90_put_var(nc%id, nc%id_varid, pl%id(i), start=[idslot]), "encounter_io_write_frame nf90_put_var pl id_varid" ) call check( nf90_put_var(nc%id, nc%rh_varid, pl%rh(:,i), start=[1,idslot,tslot], count=[NDIM,1,1]), "encounter_io_write_frame nf90_put_var pl rh_varid" ) call check( nf90_put_var(nc%id, nc%vh_varid, pl%vh(:,i), start=[1,idslot,tslot], count=[NDIM,1,1]), "encounter_io_write_frame nf90_put_var pl vh_varid" ) @@ -185,7 +185,7 @@ module subroutine encounter_io_write_frame(self, nc, param) ntp = tp%nbody do i = 1, ntp - idslot = tp%id(i) + idslot = tp%id(i) + 1 call check( nf90_put_var(nc%id, nc%id_varid, tp%id(i), start=[idslot]), "encounter_io_write_frame nf90_put_var tp id_varid" ) call check( nf90_put_var(nc%id, nc%rh_varid, tp%rh(:,i), start=[1,idslot,tslot], count=[NDIM,1,1]), "encounter_io_write_frame nf90_put_var tp rh_varid" ) call check( nf90_put_var(nc%id, nc%vh_varid, tp%vh(:,i), start=[1,idslot,tslot], count=[NDIM,1,1]), "encounter_io_write_frame nf90_put_var tp vh_varid" ) diff --git a/src/fraggle/fraggle_io.f90 b/src/fraggle/fraggle_io.f90 index faedff8a8..524ac7d2d 100644 --- a/src/fraggle/fraggle_io.f90 +++ b/src/fraggle/fraggle_io.f90 @@ -176,7 +176,7 @@ module subroutine fraggle_io_write_frame(self, nc, param) ! Stage 1: The Colliders npl = pl%nbody do i = 1, npl - idslot = pl%id(i) + idslot = pl%id(i) + 1 call check( nf90_put_var(nc%id, nc%id_varid, pl%id(i), start=[ idslot ]), "fraggle_io_write_frame nf90_put_var id_varid" ) charstring = trim(adjustl(pl%info(i)%name)) call check( nf90_put_var(nc%id, nc%name_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "fraggle_io_write_frame nf90_put_var name_varid" ) From beaef0b00c392eb012cb0ea11ca7dcfb93af046a Mon Sep 17 00:00:00 2001 From: David A Minton Date: Sat, 10 Dec 2022 10:29:35 -0500 Subject: [PATCH 377/569] Minor bug fixes to fraggle netcdf --- src/fraggle/fraggle_io.f90 | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/src/fraggle/fraggle_io.f90 b/src/fraggle/fraggle_io.f90 index 524ac7d2d..a16084184 100644 --- a/src/fraggle/fraggle_io.f90 +++ b/src/fraggle/fraggle_io.f90 @@ -171,7 +171,8 @@ module subroutine fraggle_io_write_frame(self, nc, param) call check( nf90_put_var(nc%id, nc%time_varid, self%t, start=[eslot]), "fraggle_io_write_frame nf90_put_var time_varid" ) call check( nf90_put_var (nc%id, nc%loop_varid, int(self%iloop,kind=I4B), start=[eslot]), "fraggle_io_write_frame nf90_put_varloop_varid" ) - call check( nf90_put_var(nc%id, nc%regime_varid, REGIME_NAMES(fragments%regime) , start=[eslot]), "fraggle_io_write_frame nf90_put_var regime_varid" ) + charstring = trim(adjustl(REGIME_NAMES(fragments%regime))) + call check( nf90_put_var(nc%id, nc%regime_varid, charstring, start=[1, eslot], count=[len(charstring), 1]), "fraggle_io_write_frame nf90_put_var regime_varid" ) ! Stage 1: The Colliders npl = pl%nbody @@ -179,7 +180,7 @@ module subroutine fraggle_io_write_frame(self, nc, param) idslot = pl%id(i) + 1 call check( nf90_put_var(nc%id, nc%id_varid, pl%id(i), start=[ idslot ]), "fraggle_io_write_frame nf90_put_var id_varid" ) charstring = trim(adjustl(pl%info(i)%name)) - call check( nf90_put_var(nc%id, nc%name_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "fraggle_io_write_frame nf90_put_var name_varid" ) + call check( nf90_put_var(nc%id, nc%name_varid, charstring, start=[1, idslot ], count=[len(charstring), 1]), "fraggle_io_write_frame nf90_put_var name_varid" ) charstring = trim(adjustl(pl%info(i)%particle_type)) call check( nf90_put_var(nc%id, nc%ptype_varid, charstring, start=[1, idslot, eslot], count=[len(charstring), 1, 1]), "fraggle_io_write_frame nf90_put_var particle_type_varid" ) @@ -189,9 +190,11 @@ module subroutine fraggle_io_write_frame(self, nc, param) call check( nf90_put_var(nc%id, nc%radius_varid, pl%radius(i), start=[ idslot, 1, eslot]), "fraggle_io_write_frame nf90_put_var radius_varid" ) call check( nf90_put_var(nc%id, nc%Ip_varid, pl%Ip(:,i), start=[1, idslot, 1, eslot], count=[NDIM,1,1,1]), "fraggle_io_write_frame nf90_put_var Ip_varid" ) call check( nf90_put_var(nc%id, nc%rot_varid, pl%rot(:,i), start=[1, idslot, 1, eslot], count=[NDIM,1,1,1]), "fraggle_io_write_frame nf90_put_var rotx_varid" ) - end do + ! Stage 2: The fragments + + call check( nf90_set_fill(nc%id, old_mode, old_mode) ) end select end associate From 7c0afc030e8bfb7c5c608beadd51da8b4cbdd29a Mon Sep 17 00:00:00 2001 From: David A Minton Date: Sat, 10 Dec 2022 10:44:09 -0500 Subject: [PATCH 378/569] Save the before and after state variables in the collision history --- src/fraggle/fraggle_io.f90 | 57 +++++++++++++++++++++----------------- 1 file changed, 31 insertions(+), 26 deletions(-) diff --git a/src/fraggle/fraggle_io.f90 b/src/fraggle/fraggle_io.f90 index a16084184..29fc40b8e 100644 --- a/src/fraggle/fraggle_io.f90 +++ b/src/fraggle/fraggle_io.f90 @@ -74,7 +74,7 @@ module subroutine fraggle_io_initialize_output(self, param) [nc%str_dimid, nc%id_dimid ], nc%name_varid), "fraggle_io_initialize nf90_def_var name_varid") call check( nf90_def_var(nc%id, nc%ptype_varname, NF90_CHAR, & - [nc%str_dimid, nc%id_dimid, nc%event_dimid], nc%ptype_varid), "fraggle_io_initialize nf90_def_var ptype_varid") + [nc%str_dimid, nc%id_dimid, nc%stage_dimid, nc%event_dimid], nc%ptype_varid), "fraggle_io_initialize nf90_def_var ptype_varid") call check( nf90_def_var(nc%id, nc%loop_varname, NF90_INT, & [ nc%event_dimid], nc%loop_varid), "fraggle_io_initialize nf90_def_var loop_varid") @@ -160,45 +160,50 @@ module subroutine fraggle_io_write_frame(self, nc, param) class(encounter_io_parameters), intent(inout) :: nc !! Parameters used to identify a particular encounter io NetCDF dataset class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters ! Internals - integer(I4B) :: i, eslot, idslot, old_mode, npl + integer(I4B) :: i, eslot, idslot, old_mode, npl, stage character(len=:), allocatable :: charstring + class(swiftest_pl), allocatable :: pl - eslot = param%ioutput - associate(pl => self%colliders%pl, colliders => self%colliders, fragments => self%fragments) + associate(colliders => self%colliders, fragments => self%fragments) + eslot = param%ioutput select type(nc) class is (fraggle_io_parameters) call check( nf90_set_fill(nc%id, nf90_nofill, old_mode), "fraggle_io_write_frame nf90_set_fill" ) - call check( nf90_put_var(nc%id, nc%time_varid, self%t, start=[eslot]), "fraggle_io_write_frame nf90_put_var time_varid" ) call check( nf90_put_var (nc%id, nc%loop_varid, int(self%iloop,kind=I4B), start=[eslot]), "fraggle_io_write_frame nf90_put_varloop_varid" ) + charstring = trim(adjustl(REGIME_NAMES(fragments%regime))) call check( nf90_put_var(nc%id, nc%regime_varid, charstring, start=[1, eslot], count=[len(charstring), 1]), "fraggle_io_write_frame nf90_put_var regime_varid" ) - ! Stage 1: The Colliders - npl = pl%nbody - do i = 1, npl - idslot = pl%id(i) + 1 - call check( nf90_put_var(nc%id, nc%id_varid, pl%id(i), start=[ idslot ]), "fraggle_io_write_frame nf90_put_var id_varid" ) - charstring = trim(adjustl(pl%info(i)%name)) - call check( nf90_put_var(nc%id, nc%name_varid, charstring, start=[1, idslot ], count=[len(charstring), 1]), "fraggle_io_write_frame nf90_put_var name_varid" ) - charstring = trim(adjustl(pl%info(i)%particle_type)) - call check( nf90_put_var(nc%id, nc%ptype_varid, charstring, start=[1, idslot, eslot], count=[len(charstring), 1, 1]), "fraggle_io_write_frame nf90_put_var particle_type_varid" ) - - call check( nf90_put_var(nc%id, nc%rh_varid, pl%rh(:,i), start=[1, idslot, 1, eslot], count=[NDIM,1,1,1]), "fraggle_io_write_frame nf90_put_var rh_varid" ) - call check( nf90_put_var(nc%id, nc%vh_varid, pl%vh(:,i), start=[1, idslot, 1, eslot], count=[NDIM,1,1,1]), "fraggle_io_write_frame nf90_put_var vh_varid" ) - call check( nf90_put_var(nc%id, nc%Gmass_varid, pl%Gmass(i), start=[ idslot, 1, eslot]), "fraggle_io_write_frame nf90_put_var Gmass_varid" ) - call check( nf90_put_var(nc%id, nc%radius_varid, pl%radius(i), start=[ idslot, 1, eslot]), "fraggle_io_write_frame nf90_put_var radius_varid" ) - call check( nf90_put_var(nc%id, nc%Ip_varid, pl%Ip(:,i), start=[1, idslot, 1, eslot], count=[NDIM,1,1,1]), "fraggle_io_write_frame nf90_put_var Ip_varid" ) - call check( nf90_put_var(nc%id, nc%rot_varid, pl%rot(:,i), start=[1, idslot, 1, eslot], count=[NDIM,1,1,1]), "fraggle_io_write_frame nf90_put_var rotx_varid" ) + do stage = 1,2 + if (allocated(pl)) deallocate(pl) + select case(stage) + case(1) + allocate(pl, source=colliders%pl) + case(2) + allocate(pl, source=fragments%pl) + end select + npl = pl%nbody + do i = 1, npl + idslot = pl%id(i) + 1 + call check( nf90_put_var(nc%id, nc%id_varid, pl%id(i), start=[ idslot ]), "fraggle_io_write_frame nf90_put_var id_varid" ) + charstring = trim(adjustl(pl%info(i)%name)) + call check( nf90_put_var(nc%id, nc%name_varid, charstring, start=[1, idslot ], count=[len(charstring), 1]), "fraggle_io_write_frame nf90_put_var name_varid" ) + charstring = trim(adjustl(pl%info(i)%particle_type)) + call check( nf90_put_var(nc%id, nc%ptype_varid, charstring, start=[1, idslot, stage, eslot], count=[len(charstring), 1, 1]), "fraggle_io_write_frame nf90_put_var particle_type_varid" ) + call check( nf90_put_var(nc%id, nc%rh_varid, pl%rh(:,i), start=[1, idslot, stage, eslot], count=[NDIM,1,1,1]), "fraggle_io_write_frame nf90_put_var rh_varid" ) + call check( nf90_put_var(nc%id, nc%vh_varid, pl%vh(:,i), start=[1, idslot, stage, eslot], count=[NDIM,1,1,1]), "fraggle_io_write_frame nf90_put_var vh_varid" ) + call check( nf90_put_var(nc%id, nc%Gmass_varid, pl%Gmass(i), start=[ idslot, stage, eslot]), "fraggle_io_write_frame nf90_put_var Gmass_varid" ) + call check( nf90_put_var(nc%id, nc%radius_varid, pl%radius(i), start=[ idslot, stage, eslot]), "fraggle_io_write_frame nf90_put_var radius_varid" ) + call check( nf90_put_var(nc%id, nc%Ip_varid, pl%Ip(:,i), start=[1, idslot, stage, eslot], count=[NDIM,1,1,1]), "fraggle_io_write_frame nf90_put_var Ip_varid" ) + call check( nf90_put_var(nc%id, nc%rot_varid, pl%rot(:,i), start=[1, idslot, stage, eslot], count=[NDIM,1,1,1]), "fraggle_io_write_frame nf90_put_var rotx_varid" ) + end do end do - - ! Stage 2: The fragments - - + call check( nf90_set_fill(nc%id, old_mode, old_mode) ) end select - end associate + end associate return end subroutine fraggle_io_write_frame From d38350729e6d44b61a834c32497abacfa9607de2 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Sat, 10 Dec 2022 10:53:58 -0500 Subject: [PATCH 379/569] added energy tracking variables to fragmentation output --- src/fraggle/fraggle_io.f90 | 17 ++++++++++++++--- 1 file changed, 14 insertions(+), 3 deletions(-) diff --git a/src/fraggle/fraggle_io.f90 b/src/fraggle/fraggle_io.f90 index 29fc40b8e..866c7b093 100644 --- a/src/fraggle/fraggle_io.f90 +++ b/src/fraggle/fraggle_io.f90 @@ -169,11 +169,12 @@ module subroutine fraggle_io_write_frame(self, nc, param) select type(nc) class is (fraggle_io_parameters) call check( nf90_set_fill(nc%id, nf90_nofill, old_mode), "fraggle_io_write_frame nf90_set_fill" ) - call check( nf90_put_var(nc%id, nc%time_varid, self%t, start=[eslot]), "fraggle_io_write_frame nf90_put_var time_varid" ) - call check( nf90_put_var (nc%id, nc%loop_varid, int(self%iloop,kind=I4B), start=[eslot]), "fraggle_io_write_frame nf90_put_varloop_varid" ) + + call check( nf90_put_var(nc%id, nc%time_varid, self%t, start=[eslot]), "fraggle_io_write_frame nf90_put_var time_varid" ) + call check( nf90_put_var(nc%id, nc%loop_varid, int(self%iloop,kind=I4B), start=[eslot]), "fraggle_io_write_frame nf90_put_varloop_varid" ) charstring = trim(adjustl(REGIME_NAMES(fragments%regime))) - call check( nf90_put_var(nc%id, nc%regime_varid, charstring, start=[1, eslot], count=[len(charstring), 1]), "fraggle_io_write_frame nf90_put_var regime_varid" ) + call check( nf90_put_var(nc%id, nc%regime_varid, charstring, start=[1, eslot], count=[len(charstring), 1]), "fraggle_io_write_frame nf90_put_var regime_varid" ) do stage = 1,2 if (allocated(pl)) deallocate(pl) @@ -199,6 +200,16 @@ module subroutine fraggle_io_write_frame(self, nc, param) call check( nf90_put_var(nc%id, nc%rot_varid, pl%rot(:,i), start=[1, idslot, stage, eslot], count=[NDIM,1,1,1]), "fraggle_io_write_frame nf90_put_var rotx_varid" ) end do end do + call check( nf90_put_var(nc%id, nc%ke_orb_varid, fragments%ke_orbit_before, start=[ 1, eslot]), "fraggle_io_write_frame nf90_put_var ke_orb_varid before" ) + call check( nf90_put_var(nc%id, nc%ke_orb_varid, fragments%ke_orbit_after, start=[ 2, eslot]), "fraggle_io_write_frame nf90_put_var ke_orb_varid after" ) + call check( nf90_put_var(nc%id, nc%pe_varid, fragments%pe_before, start=[ 1, eslot]), "fraggle_io_write_frame nf90_put_var pe_varid before" ) + call check( nf90_put_var(nc%id, nc%pe_varid, fragments%pe_after, start=[ 2, eslot]), "fraggle_io_write_frame nf90_put_var pe_varid after" ) + call check( nf90_put_var(nc%id, nc%L_orb_varid, fragments%Lorbit_before(:), start=[1, 1, eslot], count=[NDIM, 1, eslot]), "fraggle_io_write_frame nf90_put_var L_orb_varid before" ) + call check( nf90_put_var(nc%id, nc%L_orb_varid, fragments%Lorbit_after(:), start=[1, 2, eslot], count=[NDIM, 1, eslot]), "fraggle_io_write_frame nf90_put_var L_orb_varid after" ) + call check( nf90_put_var(nc%id, nc%L_spin_varid, fragments%Lspin_before(:), start=[1, 1, eslot], count=[NDIM, 1, eslot]), "fraggle_io_write_frame nf90_put_var L_spin_varid before" ) + call check( nf90_put_var(nc%id, nc%L_spin_varid, fragments%Lspin_after(:), start=[1, 2, eslot], count=[NDIM, 1, eslot]), "fraggle_io_write_frame nf90_put_var L_spin_varid after" ) + + call check( nf90_set_fill(nc%id, old_mode, old_mode) ) end select From 5d72cf4fffec07953f30c49d6dd2f77c3e714774 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Sat, 10 Dec 2022 10:56:52 -0500 Subject: [PATCH 380/569] Fixed indexing of id dimension coordinate --- src/encounter/encounter_io.f90 | 4 ++-- src/fraggle/fraggle_io.f90 | 6 ++---- 2 files changed, 4 insertions(+), 6 deletions(-) diff --git a/src/encounter/encounter_io.f90 b/src/encounter/encounter_io.f90 index 94b0fade6..4789ab2bf 100644 --- a/src/encounter/encounter_io.f90 +++ b/src/encounter/encounter_io.f90 @@ -84,7 +84,7 @@ module subroutine encounter_io_initialize(self, param) ! Dimensions call check( nf90_def_dim(nc%id, nc%time_dimname, nc%time_dimsize, nc%time_dimid), "encounter_io_initialize nf90_def_dim time_dimid" ) ! Simulation time dimension call check( nf90_def_dim(nc%id, nc%space_dimname, NDIM , nc%space_dimid), "encounter_io_initialize nf90_def_dim space_dimid" ) ! 3D space dimension - call check( nf90_def_dim(nc%id, nc%id_dimname, param%maxid, nc%id_dimid), "encounter_io_initialize nf90_def_dim id_dimid" ) ! dimension to store particle id numbers + call check( nf90_def_dim(nc%id, nc%id_dimname, param%maxid+1, nc%id_dimid), "encounter_io_initialize nf90_def_dim id_dimid" ) ! dimension to store particle id numbers call check( nf90_def_dim(nc%id, nc%str_dimname, NAMELEN, nc%str_dimid), "encounter_io_initialize nf90_def_dim str_dimid" ) ! Dimension for string variables (aka character arrays) ! Dimension coordinates @@ -129,7 +129,7 @@ module subroutine encounter_io_initialize(self, param) call check( nf90_put_var(nc%id, nc%space_varid, nc%space_coords, start=[1], count=[NDIM]), "encounter_io_initialize nf90_put_var space" ) ! Pre-fill name slots with ids - call check( nf90_put_var(nc%id, nc%id_varid, [(-1,i=1,param%maxid)], start=[1], count=[param%maxid]), "encounter_io_initialize nf90_put_var pl id_varid" ) + call check( nf90_put_var(nc%id, nc%id_varid, [(-1,i=1,param%maxid+1)], start=[1], count=[param%maxid+1]), "encounter_io_initialize nf90_put_var pl id_varid" ) end associate return diff --git a/src/fraggle/fraggle_io.f90 b/src/fraggle/fraggle_io.f90 index 866c7b093..85dcf6e0e 100644 --- a/src/fraggle/fraggle_io.f90 +++ b/src/fraggle/fraggle_io.f90 @@ -54,7 +54,7 @@ module subroutine fraggle_io_initialize_output(self, param) ! Dimensions call check( nf90_def_dim(nc%id, nc%event_dimname, NF90_UNLIMITED, nc%event_dimid), "fraggle_io_initialize nf90_def_dim event_dimid" ) ! Dimension to store individual collision events call check( nf90_def_dim(nc%id, nc%space_dimname, NDIM, nc%space_dimid), "fraggle_io_initialize nf90_def_dim space_dimid" ) ! 3D space dimension - call check( nf90_def_dim(nc%id, nc%id_dimname, param%maxid, nc%id_dimid), "fraggle_io_initialize nf90_def_dim id_dimid" ) ! Dimension to store particle id numbers + call check( nf90_def_dim(nc%id, nc%id_dimname, param%maxid+1, nc%id_dimid), "fraggle_io_initialize nf90_def_dim id_dimid" ) ! Dimension to store particle id numbers call check( nf90_def_dim(nc%id, nc%str_dimname, NAMELEN, nc%str_dimid), "fraggle_io_initialize nf90_def_dim str_dimid" ) ! Dimension for string variables (aka character arrays) call check( nf90_def_dim(nc%id, nc%stage_dimname, 2, nc%stage_dimid), "fraggle_io_initialize nf90_def_dim stage_dimid" ) ! Dimension for stage variables (aka "before" vs. "after" @@ -138,7 +138,7 @@ module subroutine fraggle_io_initialize_output(self, param) call check( nf90_put_var(nc%id, nc%stage_varid, nc%stage_coords(2), start=[1,2], count=[len(nc%stage_coords(2)),1]), "fraggle_io_initialize nf90_put_var stage 2" ) ! Pre-fill id slots with ids - call check( nf90_put_var(nc%id, nc%id_varid, [(-1,i=1,param%maxid)], start=[1], count=[param%maxid]), "fraggle_io_initialize nf90_put_varid_varid" ) + call check( nf90_put_var(nc%id, nc%id_varid, [(-1,i=1,param%maxid+1)], start=[1], count=[param%maxid+1]), "fraggle_io_initialize nf90_put_varid_varid" ) end associate return @@ -208,8 +208,6 @@ module subroutine fraggle_io_write_frame(self, nc, param) call check( nf90_put_var(nc%id, nc%L_orb_varid, fragments%Lorbit_after(:), start=[1, 2, eslot], count=[NDIM, 1, eslot]), "fraggle_io_write_frame nf90_put_var L_orb_varid after" ) call check( nf90_put_var(nc%id, nc%L_spin_varid, fragments%Lspin_before(:), start=[1, 1, eslot], count=[NDIM, 1, eslot]), "fraggle_io_write_frame nf90_put_var L_spin_varid before" ) call check( nf90_put_var(nc%id, nc%L_spin_varid, fragments%Lspin_after(:), start=[1, 2, eslot], count=[NDIM, 1, eslot]), "fraggle_io_write_frame nf90_put_var L_spin_varid after" ) - - call check( nf90_set_fill(nc%id, old_mode, old_mode) ) end select From 7553ca4a792229365d672d4189be53ad0ea95d61 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Sat, 10 Dec 2022 11:13:15 -0500 Subject: [PATCH 381/569] Fixed a problem with id values getting shifted by one. We count from 0 because the central body is always 0 --- src/netcdf/netcdf.f90 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/netcdf/netcdf.f90 b/src/netcdf/netcdf.f90 index 8cfc6432f..b573688c3 100644 --- a/src/netcdf/netcdf.f90 +++ b/src/netcdf/netcdf.f90 @@ -808,7 +808,7 @@ module subroutine netcdf_read_particle_info_system(self, nc, param, plmask, tpma call pl%info(i)%set_value(status="ACTIVE") end do allocate(plind(npl)) - plind(:) = pack([(i, i = 1, idmax)], plmask(:)) + plind(:) = pack([(i, i = 0, idmax-1)], plmask(:)) end if if (ntp > 0) then tp%status(:) = ACTIVE @@ -817,7 +817,7 @@ module subroutine netcdf_read_particle_info_system(self, nc, param, plmask, tpma call tp%info(i)%set_value(status="ACTIVE") end do allocate(tpind(ntp)) - tpind(:) = pack([(i, i = 1, idmax)], tpmask(:)) + tpind(:) = pack([(i, i = 0, idmax-1)], tpmask(:)) end if call check( nf90_get_var(nc%id, nc%id_varid, itemp), "netcdf_read_particle_info_system nf90_getvar id_varid" ) @@ -825,8 +825,8 @@ module subroutine netcdf_read_particle_info_system(self, nc, param, plmask, tpma pl%id(:) = pack(itemp, plmask) tp%id(:) = pack(itemp, tpmask) cb%id = 0 - pl%id(:) = pack([(i,i=1,idmax)],plmask) - tp%id(:) = pack([(i,i=1,idmax)],tpmask) + pl%id(:) = pack([(i,i=0,idmax-1)],plmask) + tp%id(:) = pack([(i,i=0,idmax-1)],tpmask) call check( nf90_get_var(nc%id, nc%name_varid, ctemp, count=[NAMELEN, idmax]), "netcdf_read_particle_info_system nf90_getvar name_varid" ) call cb%info%set_value(name=ctemp(1)) From 850f3adb933dbeb89158e5f9d8515673eebed980 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Sat, 10 Dec 2022 11:38:03 -0500 Subject: [PATCH 382/569] Fixed lots of netcdf bugs --- src/fraggle/fraggle_io.f90 | 23 +++++++-------- src/modules/fraggle_classes.f90 | 1 + src/symba/symba_io.f90 | 50 ++++++++++++++++++--------------- 3 files changed, 41 insertions(+), 33 deletions(-) diff --git a/src/fraggle/fraggle_io.f90 b/src/fraggle/fraggle_io.f90 index 85dcf6e0e..4feb40dbe 100644 --- a/src/fraggle/fraggle_io.f90 +++ b/src/fraggle/fraggle_io.f90 @@ -52,11 +52,11 @@ module subroutine fraggle_io_initialize_output(self, param) call check( nf90_create(nc%file_name, NF90_NETCDF4, nc%id), "fraggle_io_initialize nf90_create" ) ! Dimensions - call check( nf90_def_dim(nc%id, nc%event_dimname, NF90_UNLIMITED, nc%event_dimid), "fraggle_io_initialize nf90_def_dim event_dimid" ) ! Dimension to store individual collision events - call check( nf90_def_dim(nc%id, nc%space_dimname, NDIM, nc%space_dimid), "fraggle_io_initialize nf90_def_dim space_dimid" ) ! 3D space dimension - call check( nf90_def_dim(nc%id, nc%id_dimname, param%maxid+1, nc%id_dimid), "fraggle_io_initialize nf90_def_dim id_dimid" ) ! Dimension to store particle id numbers - call check( nf90_def_dim(nc%id, nc%str_dimname, NAMELEN, nc%str_dimid), "fraggle_io_initialize nf90_def_dim str_dimid" ) ! Dimension for string variables (aka character arrays) - call check( nf90_def_dim(nc%id, nc%stage_dimname, 2, nc%stage_dimid), "fraggle_io_initialize nf90_def_dim stage_dimid" ) ! Dimension for stage variables (aka "before" vs. "after" + call check( nf90_def_dim(nc%id, nc%event_dimname, nc%event_dimsize, nc%event_dimid), "fraggle_io_initialize nf90_def_dim event_dimid" ) ! Dimension to store individual collision events + call check( nf90_def_dim(nc%id, nc%space_dimname, NDIM, nc%space_dimid), "fraggle_io_initialize nf90_def_dim space_dimid" ) ! 3D space dimension + call check( nf90_def_dim(nc%id, nc%id_dimname, param%maxid+1, nc%id_dimid), "fraggle_io_initialize nf90_def_dim id_dimid" ) ! Dimension to store particle id numbers + call check( nf90_def_dim(nc%id, nc%str_dimname, NAMELEN, nc%str_dimid), "fraggle_io_initialize nf90_def_dim str_dimid" ) ! Dimension for string variables (aka character arrays) + call check( nf90_def_dim(nc%id, nc%stage_dimname, 2, nc%stage_dimid), "fraggle_io_initialize nf90_def_dim stage_dimid" ) ! Dimension for stage variables (aka "before" vs. "after" ! Dimension coordinates call check( nf90_def_var(nc%id, nc%space_dimname, NF90_CHAR, nc%space_dimid, nc%space_varid), "fraggle_io_initialize nf90_def_var space_varid" ) @@ -68,8 +68,8 @@ module subroutine fraggle_io_initialize_output(self, param) nc%event_dimid, nc%time_varid), "fraggle_io_initialize nf90_def_var time_varid" ) call check( nf90_def_var(nc%id, nc%regime_varname, NF90_CHAR, & [nc%str_dimid, nc%event_dimid], nc%regime_varid), "fraggle_io_initialize nf90_def_var regime_varid") - call check( nf90_def_var(nc%id, nc%Qloss_varname, NF90_CHAR, & - [ nc%event_dimid], nc%regime_varid), "fraggle_io_initialize nf90_def_var regime_varid") + call check( nf90_def_var(nc%id, nc%Qloss_varname, nc%out_type, & + [ nc%event_dimid], nc%Qloss_varid), "fraggle_io_initialize nf90_def_var Qloss_varid") call check( nf90_def_var(nc%id, nc%name_varname, NF90_CHAR, & [nc%str_dimid, nc%id_dimid ], nc%name_varid), "fraggle_io_initialize nf90_def_var name_varid") @@ -175,6 +175,7 @@ module subroutine fraggle_io_write_frame(self, nc, param) charstring = trim(adjustl(REGIME_NAMES(fragments%regime))) call check( nf90_put_var(nc%id, nc%regime_varid, charstring, start=[1, eslot], count=[len(charstring), 1]), "fraggle_io_write_frame nf90_put_var regime_varid" ) + call check( nf90_put_var(nc%id, nc%Qloss_varid, fragments%Qloss, start=[eslot] ), "fraggle_io_write_frame nf90_put_var Qloss_varid" ) do stage = 1,2 if (allocated(pl)) deallocate(pl) @@ -204,10 +205,10 @@ module subroutine fraggle_io_write_frame(self, nc, param) call check( nf90_put_var(nc%id, nc%ke_orb_varid, fragments%ke_orbit_after, start=[ 2, eslot]), "fraggle_io_write_frame nf90_put_var ke_orb_varid after" ) call check( nf90_put_var(nc%id, nc%pe_varid, fragments%pe_before, start=[ 1, eslot]), "fraggle_io_write_frame nf90_put_var pe_varid before" ) call check( nf90_put_var(nc%id, nc%pe_varid, fragments%pe_after, start=[ 2, eslot]), "fraggle_io_write_frame nf90_put_var pe_varid after" ) - call check( nf90_put_var(nc%id, nc%L_orb_varid, fragments%Lorbit_before(:), start=[1, 1, eslot], count=[NDIM, 1, eslot]), "fraggle_io_write_frame nf90_put_var L_orb_varid before" ) - call check( nf90_put_var(nc%id, nc%L_orb_varid, fragments%Lorbit_after(:), start=[1, 2, eslot], count=[NDIM, 1, eslot]), "fraggle_io_write_frame nf90_put_var L_orb_varid after" ) - call check( nf90_put_var(nc%id, nc%L_spin_varid, fragments%Lspin_before(:), start=[1, 1, eslot], count=[NDIM, 1, eslot]), "fraggle_io_write_frame nf90_put_var L_spin_varid before" ) - call check( nf90_put_var(nc%id, nc%L_spin_varid, fragments%Lspin_after(:), start=[1, 2, eslot], count=[NDIM, 1, eslot]), "fraggle_io_write_frame nf90_put_var L_spin_varid after" ) + call check( nf90_put_var(nc%id, nc%L_orb_varid, fragments%Lorbit_before(:), start=[1, 1, eslot], count=[NDIM, 1, 1]), "fraggle_io_write_frame nf90_put_var L_orb_varid before" ) + call check( nf90_put_var(nc%id, nc%L_orb_varid, fragments%Lorbit_after(:), start=[1, 2, eslot], count=[NDIM, 1, 1]), "fraggle_io_write_frame nf90_put_var L_orb_varid after" ) + call check( nf90_put_var(nc%id, nc%L_spin_varid, fragments%Lspin_before(:), start=[1, 1, eslot], count=[NDIM, 1, 1]), "fraggle_io_write_frame nf90_put_var L_spin_varid before" ) + call check( nf90_put_var(nc%id, nc%L_spin_varid, fragments%Lspin_after(:), start=[1, 2, eslot], count=[NDIM, 1, 1]), "fraggle_io_write_frame nf90_put_var L_spin_varid after" ) call check( nf90_set_fill(nc%id, old_mode, old_mode) ) end select diff --git a/src/modules/fraggle_classes.f90 b/src/modules/fraggle_classes.f90 index 0b95fd67a..2dfbe8b5a 100644 --- a/src/modules/fraggle_classes.f90 +++ b/src/modules/fraggle_classes.f90 @@ -121,6 +121,7 @@ module fraggle_classes character(NAMELEN) :: event_dimname = "collision" !! Name of collision event dimension integer(I4B) :: event_dimid !! ID for the collision event dimension integer(I4B) :: event_varid !! ID for the collision event variable + integer(I4B) :: event_dimsize = 0 !! Number of events character(NAMELEN) :: Qloss_varname = "Qloss" !! name of the energy loss variable integer(I4B) :: Qloss_varid !! ID for the energy loss variable diff --git a/src/symba/symba_io.f90 b/src/symba/symba_io.f90 index 9722fa0c3..cd8693598 100644 --- a/src/symba/symba_io.f90 +++ b/src/symba/symba_io.f90 @@ -22,29 +22,35 @@ module subroutine symba_io_dump_encounter(self, param) class(symba_parameters), intent(inout) :: param !! Current run configuration parameters - associate(encounter_history => self%encounter_history, nce => self%encounter_history%nc, eframe => self%encounter_history%iframe,& - collision_history => self%collision_history, ncc => self%collision_history%nc, cframe => self%collision_history%iframe) - - if (encounter_history%iframe > 0) then - ! Create and save the output files for this encounter and fragmentation - nce%file_number = nce%file_number + 1 - nce%time_dimsize = maxval(encounter_history%tslot(:)) - write(nce%file_name, '("encounter_",I0.6,".nc")') nce%file_number - call nce%initialize(param) - call encounter_history%dump(param) - call nce%close() - call encounter_history%reset() - end if + associate(encounter_history => self%encounter_history, num_enc_frames => self%encounter_history%iframe,& + collision_history => self%collision_history, num_coll_frames => self%collision_history%iframe) + + select type(nce => self%encounter_history%nc) + class is (encounter_io_parameters) + if (num_enc_frames > 0) then + ! Create and save the output files for this encounter and fragmentation + nce%file_number = nce%file_number + 1 + nce%time_dimsize = maxval(encounter_history%tslot(:)) + write(nce%file_name, '("encounter_",I0.6,".nc")') nce%file_number + call nce%initialize(param) + call encounter_history%dump(param) + call nce%close() + call encounter_history%reset() + end if + end select - if (collision_history%iframe > 0) then - ncc%file_number = ncc%file_number + 1 - write(ncc%file_name, '("collision_",I0.6,".nc")') ncc%file_number - ncc%time_dimsize = maxval(collision_history%tslot(:)) - call ncc%initialize(param) - call collision_history%dump(param) - call ncc%close() - call collision_history%reset() - end if + select type(ncc => self%collision_history%nc) + class is (fraggle_io_parameters) + if (num_coll_frames > 0) then + ncc%file_number = ncc%file_number + 1 + ncc%event_dimsize = num_coll_frames + write(ncc%file_name, '("collision_",I0.6,".nc")') ncc%file_number + call ncc%initialize(param) + call collision_history%dump(param) + call ncc%close() + call collision_history%reset() + end if + end select end associate return From 82859d31e6635ff5f6165c5758e7a2d42b201dea Mon Sep 17 00:00:00 2001 From: David A Minton Date: Sat, 10 Dec 2022 19:30:14 -0500 Subject: [PATCH 383/569] Fixed and rearranged a bunch of stuff getting the collision history object to work --- src/CMakeLists.txt | 2 +- src/encounter/encounter_io.f90 | 32 +++++++++++++-- src/encounter/encounter_util.f90 | 41 +++++++++++++++++++ src/fraggle/fraggle_io.f90 | 1 - src/modules/encounter_classes.f90 | 39 ++++++++++++++++-- src/modules/fraggle_classes.f90 | 6 +-- src/modules/swiftest_classes.f90 | 21 ++++++---- src/modules/symba_classes.f90 | 4 +- src/netcdf/netcdf.f90 | 8 ++-- src/setup/setup.f90 | 2 +- src/symba/symba_collision.f90 | 1 - src/symba/symba_util.f90 | 34 +++++++-------- .../{util_index_array.f90 => util_index.f90} | 13 ++++++ 13 files changed, 160 insertions(+), 44 deletions(-) rename src/util/{util_index_array.f90 => util_index.f90} (84%) diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index eb9fb20d5..344a2e7d8 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -78,7 +78,7 @@ SET(FAST_MATH_FILES ${SRC}/util/util_final.f90 ${SRC}/util/util_flatten.f90 ${SRC}/util/util_get_energy_momentum.f90 - ${SRC}/util/util_index_array.f90 + ${SRC}/util/util_index.f90 ${SRC}/util/util_minimize_bfgs.f90 ${SRC}/util/util_peri.f90 ${SRC}/util/util_rescale.f90 diff --git a/src/encounter/encounter_io.f90 b/src/encounter/encounter_io.f90 index 4789ab2bf..414c3854a 100644 --- a/src/encounter/encounter_io.f90 +++ b/src/encounter/encounter_io.f90 @@ -12,14 +12,14 @@ contains - module subroutine encounter_io_dump(self, param) + module subroutine encounter_io_dump_collision_storage(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 + class(collision_storage(*)), intent(inout) :: self !! Encounter storage object + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters ! Internals integer(I4B) :: i @@ -29,6 +29,30 @@ module subroutine encounter_io_dump(self, param) class is (fraggle_collision_snapshot) param%ioutput = i call snapshot%write_frame(self%nc,param) + end select + else + exit + end if + end do + + return + end subroutine encounter_io_dump_collision_storage + + + module subroutine encounter_io_dump_storage(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 + + do i = 1, self%nframes + if (allocated(self%frame(i)%item)) then + select type(snapshot => self%frame(i)%item) class is (encounter_snapshot) param%ioutput = self%tslot(i) call snapshot%write_frame(self%nc,param) @@ -40,7 +64,7 @@ module subroutine encounter_io_dump(self, param) return - end subroutine encounter_io_dump + end subroutine encounter_io_dump_storage module subroutine encounter_io_initialize(self, param) diff --git a/src/encounter/encounter_util.f90 b/src/encounter/encounter_util.f90 index 0d3a66d62..7d5094ede 100644 --- a/src/encounter/encounter_util.f90 +++ b/src/encounter/encounter_util.f90 @@ -152,6 +152,20 @@ module subroutine encounter_util_final_snapshot(self) end subroutine encounter_util_final_snapshot + module subroutine encounter_util_final_collision_storage(self) + !! author: David A. Minton + !! + !! Finalizer will deallocate all allocatables + implicit none + ! Arguments + type(collision_storage(*)), intent(inout) :: self !! SyMBA nbody system object + + call util_final_storage(self%swiftest_storage) + + return + end subroutine encounter_util_final_collision_storage + + module subroutine encounter_util_final_storage(self) !! author: David A. Minton !! @@ -166,6 +180,33 @@ module subroutine encounter_util_final_storage(self) end subroutine encounter_util_final_storage + module subroutine encounter_util_index_map_storage(self) + !! author: David A. Minton + !! + !! Maps body id values to storage index values so we don't have to use unlimited dimensions for id + implicit none + ! Arguments + class(encounter_storage(*)), intent(inout) :: self !! Swiftest storage object + ! Internals + + return + end subroutine encounter_util_index_map_storage + + + + module subroutine encounter_util_index_map_collision_storage(self) + !! author: David A. Minton + !! + !! Maps body id values to storage index values so we don't have to use unlimited dimensions for id + implicit none + ! Arguments + class(collision_storage(*)), intent(inout) :: self !! Swiftest storage object + ! Internals + + return + end subroutine encounter_util_index_map_collision_storage + + module subroutine encounter_util_resize_list(self, nnew) !! author: David A. Minton !! diff --git a/src/fraggle/fraggle_io.f90 b/src/fraggle/fraggle_io.f90 index 4feb40dbe..4f5fec19b 100644 --- a/src/fraggle/fraggle_io.f90 +++ b/src/fraggle/fraggle_io.f90 @@ -12,7 +12,6 @@ contains - module subroutine fraggle_io_initialize_output(self, param) !! author: David A. Minton !! diff --git a/src/modules/encounter_classes.f90 b/src/modules/encounter_classes.f90 index 95f230344..49065fc2a 100644 --- a/src/modules/encounter_classes.f90 +++ b/src/modules/encounter_classes.f90 @@ -68,10 +68,20 @@ module encounter_classes type, extends(swiftest_storage) :: encounter_storage class(encounter_io_parameters), allocatable :: nc !! NetCDF parameter object containing the details about the file attached to this storage object contains - procedure :: dump => encounter_io_dump !! Dumps contents of encounter history to file - final :: encounter_util_final_storage + procedure :: dump => encounter_io_dump_storage !! Dumps contents of encounter history to file + procedure :: mapid => encounter_util_index_map_storage !! Maps body id values to storage index values so we don't have to use unlimited dimensions for id + final :: encounter_util_final_storage end type encounter_storage + !> A class that that is used to store simulation history data between file output + type, extends(swiftest_storage) :: collision_storage + class(encounter_io_parameters), allocatable :: nc !! NetCDF parameter object containing the details about the file attached to this storage object + contains + procedure :: dump => encounter_io_dump_collision_storage !! Dumps contents of encounter history to file + procedure :: mapid => encounter_util_index_map_collision_storage !! Maps body id values to storage index values so we don't have to use unlimited dimensions for id + final :: encounter_util_final_collision_storage + end type collision_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) @@ -204,11 +214,17 @@ 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_dump(self, param) + module subroutine encounter_io_dump_collision_storage(self, param) + implicit none + class(collision_storage(*)), intent(inout) :: self !! Collision storage object + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + end subroutine encounter_io_dump_collision_storage + + module subroutine encounter_io_dump_storage(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 + end subroutine encounter_io_dump_storage module subroutine encounter_io_initialize(self, param) implicit none @@ -264,6 +280,11 @@ module subroutine encounter_util_final_aabb(self) type(encounter_bounding_box_1D), intent(inout) :: self !!Bounding box structure along a single dimension end subroutine encounter_util_final_aabb + module subroutine encounter_util_final_collision_storage(self) + implicit none + type(collision_storage(*)), intent(inout) :: self !! SyMBA nbody system object + end subroutine encounter_util_final_collision_storage + module subroutine encounter_util_final_list(self) implicit none type(encounter_list), intent(inout) :: self !! Swiftest encounter list object @@ -279,6 +300,16 @@ module subroutine encounter_util_final_storage(self) type(encounter_storage(*)), intent(inout) :: self !! SyMBA nbody system object end subroutine encounter_util_final_storage + module subroutine encounter_util_index_map_collision_storage(self) + implicit none + class(collision_storage(*)), intent(inout) :: self !! E + end subroutine encounter_util_index_map_collision_storage + + module subroutine encounter_util_index_map_storage(self) + implicit none + class(encounter_storage(*)), intent(inout) :: self !! Swiftest storage object + end subroutine encounter_util_index_map_storage + module subroutine encounter_util_resize_list(self, nnew) implicit none class(encounter_list), intent(inout) :: self !! Swiftest encounter list diff --git a/src/modules/fraggle_classes.f90 b/src/modules/fraggle_classes.f90 index 2dfbe8b5a..8d8e1c33e 100644 --- a/src/modules/fraggle_classes.f90 +++ b/src/modules/fraggle_classes.f90 @@ -285,17 +285,17 @@ end subroutine fraggle_util_construct_temporary_system module subroutine fraggle_util_final_colliders(self) implicit none - type(fraggle_colliders), intent(inout) :: self !! Fraggle encountar storage object + type(fraggle_colliders), intent(inout) :: self !! Fraggle colliders object end subroutine fraggle_util_final_colliders module subroutine fraggle_util_final_fragments(self) implicit none - type(fraggle_fragments), intent(inout) :: self !! Fraggle encountar storage object + type(fraggle_fragments), intent(inout) :: self !! Fraggle frgments object end subroutine fraggle_util_final_fragments module subroutine fraggle_util_final_snapshot(self) implicit none - type(fraggle_collision_snapshot), intent(inout) :: self !! Fraggle encountar storage object + type(fraggle_collision_snapshot), intent(inout) :: self !! Fraggle storage snapshot object end subroutine fraggle_util_final_snapshot module subroutine fraggle_util_get_energy_momentum(self, colliders, system, param, lbefore) diff --git a/src/modules/swiftest_classes.f90 b/src/modules/swiftest_classes.f90 index 9c60dd884..8624f8ece 100644 --- a/src/modules/swiftest_classes.f90 +++ b/src/modules/swiftest_classes.f90 @@ -153,14 +153,16 @@ module swiftest_classes type :: swiftest_storage(nframes) !! An class that establishes the pattern for various storage objects - integer(I4B), len :: nframes = 4096 !! Total number of frames that can be stored - type(swiftest_storage_frame), dimension(nframes) :: frame !! Array of stored frames - integer(I4B) :: iframe = 0 !! Index of the last frame stored in the system - integer(I4B), dimension(nframes) :: tslot !! The value of the time dimension index associated with each frame - real(DP), dimension(nframes) :: tvals !! Stored time values for snapshots + integer(I4B), len :: nframes = 4096 !! Total number of frames that can be stored + type(swiftest_storage_frame), dimension(nframes) :: frame !! Array of stored frames + integer(I4B) :: iframe = 0 !! Index of the last frame stored in the system + integer(I4B), dimension(nframes) :: tslot !! The value of the time dimension index associated with each frame + real(DP), dimension(nframes) :: tvals !! Stored time values for snapshots + integer(I4B), dimension(:), allocatable :: idmap !! The id value -> index map contains - procedure :: dump => io_dump_storage !! Dumps storage object contents to file - procedure :: reset => util_reset_storage !! Resets a storage object by deallocating all items and resetting the frame counter to 0 + procedure :: dump => io_dump_storage !! Dumps storage object contents to file + procedure :: mapid => util_index_map_storage !! Maps body id values to storage index values so we don't have to use unlimited dimensions for id + procedure :: reset => util_reset_storage !! Resets a storage object by deallocating all items and resetting the frame counter to 0 final :: util_final_storage end type swiftest_storage @@ -1515,6 +1517,11 @@ module subroutine util_index_array(ind_arr, n) integer(I4B), intent(in) :: n !! The new size of the index array end subroutine util_index_array + module subroutine util_index_map_storage(self) + implicit none + class(swiftest_storage(*)), intent(inout) :: self !! Swiftest storage object + end subroutine util_index_map_storage + module function util_minimize_bfgs(f, N, x0, eps, maxloop, lerr) result(x1) use lambda_function implicit none diff --git a/src/modules/symba_classes.f90 b/src/modules/symba_classes.f90 index a31d042f9..ff2597b5f 100644 --- a/src/modules/symba_classes.f90 +++ b/src/modules/symba_classes.f90 @@ -16,7 +16,7 @@ module symba_classes use swiftest_classes, only : swiftest_parameters, swiftest_base, swiftest_particle_info, swiftest_storage, 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, encounter_snapshot, encounter_storage + use encounter_classes, only : encounter_list, encounter_snapshot, encounter_storage, collision_storage implicit none public @@ -192,7 +192,7 @@ module symba_classes class(fraggle_colliders), allocatable :: colliders !! Fraggle colliders object class(fraggle_fragments), allocatable :: fragments !! Fraggle fragmentation system object type(encounter_storage(nframes=:)), allocatable :: encounter_history !! Stores encounter history for later retrieval and saving to file - type(encounter_storage(nframes=:)), allocatable :: collision_history !! Stores encounter history for later retrieval and saving to file + type(collision_storage(nframes=:)), allocatable :: collision_history !! Stores encounter history for later retrieval and saving to file 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 diff --git a/src/netcdf/netcdf.f90 b/src/netcdf/netcdf.f90 index b573688c3..8cfc6432f 100644 --- a/src/netcdf/netcdf.f90 +++ b/src/netcdf/netcdf.f90 @@ -808,7 +808,7 @@ module subroutine netcdf_read_particle_info_system(self, nc, param, plmask, tpma call pl%info(i)%set_value(status="ACTIVE") end do allocate(plind(npl)) - plind(:) = pack([(i, i = 0, idmax-1)], plmask(:)) + plind(:) = pack([(i, i = 1, idmax)], plmask(:)) end if if (ntp > 0) then tp%status(:) = ACTIVE @@ -817,7 +817,7 @@ module subroutine netcdf_read_particle_info_system(self, nc, param, plmask, tpma call tp%info(i)%set_value(status="ACTIVE") end do allocate(tpind(ntp)) - tpind(:) = pack([(i, i = 0, idmax-1)], tpmask(:)) + tpind(:) = pack([(i, i = 1, idmax)], tpmask(:)) end if call check( nf90_get_var(nc%id, nc%id_varid, itemp), "netcdf_read_particle_info_system nf90_getvar id_varid" ) @@ -825,8 +825,8 @@ module subroutine netcdf_read_particle_info_system(self, nc, param, plmask, tpma pl%id(:) = pack(itemp, plmask) tp%id(:) = pack(itemp, tpmask) cb%id = 0 - pl%id(:) = pack([(i,i=0,idmax-1)],plmask) - tp%id(:) = pack([(i,i=0,idmax-1)],tpmask) + pl%id(:) = pack([(i,i=1,idmax)],plmask) + tp%id(:) = pack([(i,i=1,idmax)],tpmask) call check( nf90_get_var(nc%id, nc%name_varid, ctemp, count=[NAMELEN, idmax]), "netcdf_read_particle_info_system nf90_getvar name_varid" ) call cb%info%set_value(name=ctemp(1)) diff --git a/src/setup/setup.f90 b/src/setup/setup.f90 index ea822f45d..a107179a1 100644 --- a/src/setup/setup.f90 +++ b/src/setup/setup.f90 @@ -82,7 +82,7 @@ module subroutine setup_construct_system(system, param) end select end associate - allocate(encounter_storage :: system%collision_history) + allocate(collision_storage :: system%collision_history) associate (collision_history => system%collision_history) allocate(fraggle_io_parameters :: collision_history%nc) call collision_history%reset() diff --git a/src/symba/symba_collision.f90 b/src/symba/symba_collision.f90 index 53e0a84bc..95d0dcf4f 100644 --- a/src/symba/symba_collision.f90 +++ b/src/symba/symba_collision.f90 @@ -494,7 +494,6 @@ function symba_collision_consolidate_colliders(pl, cb, param, idx_parent, collid associate(idx_arr => parent_child_index_array(j)%idx, & id_arr => parent_child_index_array(j)%id, & ncj => nchild(j), & - pl => pl, & plkinj => pl%kin(idx_parent(j))) idx_arr(1) = idx_parent(j) if (ncj > 0) idx_arr(2:ncj + 1) = plkinj%child(1:ncj) diff --git a/src/symba/symba_util.f90 b/src/symba/symba_util.f90 index 5b840ad0c..60c3311c4 100644 --- a/src/symba/symba_util.f90 +++ b/src/symba/symba_util.f90 @@ -881,7 +881,7 @@ subroutine symba_util_save_collision(system, snapshot) type(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object class(encounter_snapshot), intent(in) :: snapshot !! Encounter snapshot object ! Internals - type(encounter_storage(nframes=:)), allocatable :: tmp + type(collision_storage(nframes=:)), allocatable :: tmp integer(I4B) :: i, nnew, nold, nbig ! Advance the snapshot frame counter @@ -896,7 +896,7 @@ subroutine symba_util_save_collision(system, snapshot) do while (nbig < nnew) nbig = nbig * 2 end do - allocate(encounter_storage(nbig) :: tmp) + allocate(collision_storage(nbig) :: tmp) tmp%tvals(1:nold) = system%collision_history%tvals(1:nold) tmp%tvals(nold+1:nbig) = huge(1.0_DP) tmp%tslot(1:nold) = system%collision_history%tslot(1:nold) @@ -1347,26 +1347,28 @@ module subroutine symba_util_take_collision_snapshot(self, param, t, stage) real(DP), intent(in) :: t !! current time character(*), intent(in) :: stage !! Either before or after ! Arguments - class(fraggle_collision_snapshot), allocatable:: snapshot + class(fraggle_collision_snapshot), allocatable :: snapshot + type(symba_pl) :: pl integer(I4B) :: i,j select case(stage) case("before") ! Saves the states of the bodies involved in the collision before the collision is resolved associate (idx => self%colliders%idx, ncoll => self%colliders%ncoll) - allocate(symba_pl :: self%colliders%pl) - select type(pl => self%colliders%pl) - class is (symba_pl) - call pl%setup(ncoll, param) - pl%id(:) = self%pl%id(idx(:)) - pl%Gmass(:) = self%pl%Gmass(idx(:)) - pl%radius(:) = self%pl%radius(idx(:)) - pl%rot(:,:) = self%pl%rot(:,idx(:)) - pl%Ip(:,:) = self%pl%Ip(:,idx(:)) - pl%rh(:,:) = self%pl%rh(:,idx(:)) - pl%vh(:,:) = self%pl%vh(:,idx(:)) - pl%info(:) = self%pl%info(idx(:)) - end select + !allocate(symba_pl :: self%colliders%pl) + !select type(pl => self%colliders%pl) + !class is (symba_pl) + call pl%setup(ncoll, param) + pl%id(:) = self%pl%id(idx(:)) + pl%Gmass(:) = self%pl%Gmass(idx(:)) + pl%radius(:) = self%pl%radius(idx(:)) + pl%rot(:,:) = self%pl%rot(:,idx(:)) + pl%Ip(:,:) = self%pl%Ip(:,idx(:)) + pl%rh(:,:) = self%pl%rh(:,idx(:)) + pl%vh(:,:) = self%pl%vh(:,idx(:)) + pl%info(:) = self%pl%info(idx(:)) + !end select + allocate(self%colliders%pl, source=pl) end associate case("after") allocate(fraggle_collision_snapshot :: snapshot) diff --git a/src/util/util_index_array.f90 b/src/util/util_index.f90 similarity index 84% rename from src/util/util_index_array.f90 rename to src/util/util_index.f90 index b59e829e1..20772a2a6 100644 --- a/src/util/util_index_array.f90 +++ b/src/util/util_index.f90 @@ -44,4 +44,17 @@ module subroutine util_index_array(ind_arr, n) return end subroutine util_index_array + + module subroutine util_index_map_storage(self) + !! author: David A. Minton + !! + !! Maps body id values to storage index values so we don't have to use unlimited dimensions for id + implicit none + ! Arguments + class(swiftest_storage(*)), intent(inout) :: self !! Swiftest storage object + ! Internals + + return + end subroutine util_index_map_storage + end submodule s_util_index_array \ No newline at end of file From a83690cd75a73f2e689a5937eb94ab171860b30f Mon Sep 17 00:00:00 2001 From: David A Minton Date: Sat, 10 Dec 2022 21:08:06 -0500 Subject: [PATCH 384/569] Started working on a more efficient way to store ids --- src/CMakeLists.txt | 1 + src/encounter/encounter_io.f90 | 2 +- src/encounter/encounter_util.f90 | 32 ++++++++++++++++++++++++- src/modules/swiftest_classes.f90 | 7 ++++++ src/symba/symba_util.f90 | 2 ++ src/util/util_reset.f90 | 2 ++ src/util/util_unique.f90 | 41 ++++++++++++++++++++++++++++++++ 7 files changed, 85 insertions(+), 2 deletions(-) create mode 100644 src/util/util_unique.f90 diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index 344a2e7d8..6f382cd8e 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -88,6 +88,7 @@ SET(FAST_MATH_FILES ${SRC}/util/util_solve.f90 ${SRC}/util/util_sort.f90 ${SRC}/util/util_spill.f90 + ${SRC}/util/util_unique.f90 ${SRC}/util/util_valid.f90 ${SRC}/util/util_version.f90 ${SRC}/walltime/walltime.f90 diff --git a/src/encounter/encounter_io.f90 b/src/encounter/encounter_io.f90 index 414c3854a..c5e458e57 100644 --- a/src/encounter/encounter_io.f90 +++ b/src/encounter/encounter_io.f90 @@ -50,6 +50,7 @@ module subroutine encounter_io_dump_storage(self, param) ! Internals integer(I4B) :: i + call self%mapid() do i = 1, self%nframes if (allocated(self%frame(i)%item)) then select type(snapshot => self%frame(i)%item) @@ -62,7 +63,6 @@ module subroutine encounter_io_dump_storage(self, param) end if end do - return end subroutine encounter_io_dump_storage diff --git a/src/encounter/encounter_util.f90 b/src/encounter/encounter_util.f90 index 7d5094ede..9385ad2c0 100644 --- a/src/encounter/encounter_util.f90 +++ b/src/encounter/encounter_util.f90 @@ -183,11 +183,41 @@ end subroutine encounter_util_final_storage module subroutine encounter_util_index_map_storage(self) !! author: David A. Minton !! - !! Maps body id values to storage index values so we don't have to use unlimited dimensions for id + !! Maps body id values to storage index values so we don't have to use unlimited dimensions for id. + !! Basically this will make a unique list of ids that exist in all of the saved snapshots implicit none ! Arguments class(encounter_storage(*)), intent(inout) :: self !! Swiftest storage object ! Internals + integer(I4B) :: i, n, nold + integer(I4B), dimension(:), allocatable :: idlist + + if (self%nid == 0) return + allocate(idlist(self%nid)) + + n = 0 + nold = 1 + do i = 1, self%nframes + if (allocated(self%frame(i)%item)) then + select type(snapshot => self%frame(i)%item) + class is (encounter_snapshot) + if (allocated(snapshot%pl)) then + n = n + snapshot%pl%nbody + idlist(nold:n) = snapshot%pl%id(:) + nold = n+1 + end if + if (allocated(snapshot%tp)) then + n = n + snapshot%tp%nbody + idlist(nold:n) = snapshot%tp%id(:) + nold = n+1 + end if + end select + else + exit + end if + end do + + call util_unique(idlist,self%idmap) return end subroutine encounter_util_index_map_storage diff --git a/src/modules/swiftest_classes.f90 b/src/modules/swiftest_classes.f90 index 8624f8ece..6fb35383e 100644 --- a/src/modules/swiftest_classes.f90 +++ b/src/modules/swiftest_classes.f90 @@ -159,6 +159,7 @@ module swiftest_classes integer(I4B), dimension(nframes) :: tslot !! The value of the time dimension index associated with each frame real(DP), dimension(nframes) :: tvals !! Stored time values for snapshots integer(I4B), dimension(:), allocatable :: idmap !! The id value -> index map + integer(I4B) :: nid !! Number of unique id values in all saved snapshots contains procedure :: dump => io_dump_storage !! Dumps storage object contents to file procedure :: mapid => util_index_map_storage !! Maps body id values to storage index values so we don't have to use unlimited dimensions for id @@ -1956,6 +1957,12 @@ module subroutine util_spill_tp(self, discards, lspill_list, ldestructive) logical, intent(in) :: ldestructive !! Logical flag indicating whether or not this operation should alter the keeps array or not end subroutine util_spill_tp + module subroutine util_unique(input_array, output_array) + implicit none + integer(I4B), dimension(:), intent(in) :: input_array + integer(I4B), dimension(:), allocatable, intent(out) :: output_array + end subroutine util_unique + module subroutine util_valid_id_system(self, param) implicit none class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nbody system object diff --git a/src/symba/symba_util.f90 b/src/symba/symba_util.f90 index 60c3311c4..f7711e6bf 100644 --- a/src/symba/symba_util.f90 +++ b/src/symba/symba_util.f90 @@ -1380,6 +1380,7 @@ module subroutine symba_util_take_collision_snapshot(self, param, t, stage) return end subroutine symba_util_take_collision_snapshot + module subroutine symba_util_take_encounter_snapshot(self, param, t) !! author: David A. Minton !! @@ -1477,6 +1478,7 @@ module subroutine symba_util_take_encounter_snapshot(self, param, t) end select ! Save the snapshot + self%encounter_history%nid = self%encounter_history%nid + ntp_snap + npl_snap call symba_util_save_encounter(self,snapshot,t) end select end select diff --git a/src/util/util_reset.f90 b/src/util/util_reset.f90 index 7bb8d5ee3..a588c65fe 100644 --- a/src/util/util_reset.f90 +++ b/src/util/util_reset.f90 @@ -27,6 +27,8 @@ module subroutine util_reset_storage(self) self%tslot(:) = 0 self%tvals(:) = huge(1.0_DP) self%iframe = 0 + if (allocated(self%idmap)) deallocate(self%idmap) + self%nid = 0 return end subroutine util_reset_storage diff --git a/src/util/util_unique.f90 b/src/util/util_unique.f90 new file mode 100644 index 000000000..9cf77536c --- /dev/null +++ b/src/util/util_unique.f90 @@ -0,0 +1,41 @@ +!! Copyright 2022 - David Minton, Carlisle Wishard, Jennifer Pouplin, Jake Elliott, & Dana Singh +!! This file is part of Swiftest. +!! Swiftest is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License +!! as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. +!! Swiftest is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty +!! of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. +!! You should have received a copy of the GNU General Public License along with Swiftest. +!! If not, see: https://www.gnu.org/licenses. + +submodule (swiftest_classes) s_util_unique + use swiftest +contains + + module subroutine util_unique(input_array, output_array) + !! author: David A. Minton + !! + !! Takes an input unsorted integer array and returns a new array of sorted, unique values + implicit none + ! Arguments + integer(I4B), dimension(:), intent(in) :: input_array + integer(I4B), dimension(:), allocatable, intent(out) :: output_array + ! Internals + integer(I4B), dimension(:), allocatable :: unique_array + integer(I4B) :: n, lo, hi + + allocate(unique_array, mold=input_array) + lo = minval(input_array) - 1 + hi = maxval(input_array) + + n = 0 + do while (lo < hi) + n = n + 1 + lo = minval(input_array, mask=input_array > lo) + unique_array(n) = lo + enddo + allocate(output_array(n), source=unique_array(1:n)) + + return + end subroutine util_unique + +end submodule s_util_unique \ No newline at end of file From 0fe3f1f90cfa394f70dd49a17968be31b754e1b7 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Sun, 11 Dec 2022 09:31:08 -0500 Subject: [PATCH 385/569] Another major restructuring aimed toward improving how the storage objects handle the indexing of bodies and time steps --- src/CMakeLists.txt | 1 + src/encounter/encounter_io.f90 | 3 +- src/encounter/encounter_util.f90 | 23 ++++++++++---- src/io/io.f90 | 8 +++-- src/main/swiftest_driver.f90 | 8 ++--- src/modules/encounter_classes.f90 | 12 +++---- src/modules/swiftest_classes.f90 | 50 ++++++++++++++++++++--------- src/netcdf/netcdf.f90 | 4 +-- src/symba/symba_io.f90 | 3 +- src/symba/symba_util.f90 | 17 +--------- src/util/util_index.f90 | 42 ++++++++++++++++++++++++ src/util/util_reset.f90 | 7 ++-- src/util/util_snapshot.f90 | 33 +++++++++++++++++++ src/util/util_unique.f90 | 53 +++++++++++++++++++++++++++---- 14 files changed, 198 insertions(+), 66 deletions(-) create mode 100644 src/util/util_snapshot.f90 diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index 6f382cd8e..594850a50 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -85,6 +85,7 @@ SET(FAST_MATH_FILES ${SRC}/util/util_reset.f90 ${SRC}/util/util_resize.f90 ${SRC}/util/util_set.f90 + ${SRC}/util/util_snapshot.f90 ${SRC}/util/util_solve.f90 ${SRC}/util/util_sort.f90 ${SRC}/util/util_spill.f90 diff --git a/src/encounter/encounter_io.f90 b/src/encounter/encounter_io.f90 index c5e458e57..0f821f49b 100644 --- a/src/encounter/encounter_io.f90 +++ b/src/encounter/encounter_io.f90 @@ -50,12 +50,11 @@ module subroutine encounter_io_dump_storage(self, param) ! Internals integer(I4B) :: i - call self%mapid() do i = 1, self%nframes if (allocated(self%frame(i)%item)) then select type(snapshot => self%frame(i)%item) class is (encounter_snapshot) - param%ioutput = self%tslot(i) + param%ioutput = self%tmap(i) call snapshot%write_frame(self%nc,param) end select else diff --git a/src/encounter/encounter_util.f90 b/src/encounter/encounter_util.f90 index 9385ad2c0..ef89b3cf3 100644 --- a/src/encounter/encounter_util.f90 +++ b/src/encounter/encounter_util.f90 @@ -189,11 +189,14 @@ module subroutine encounter_util_index_map_storage(self) ! Arguments class(encounter_storage(*)), intent(inout) :: self !! Swiftest storage object ! Internals - integer(I4B) :: i, n, nold - integer(I4B), dimension(:), allocatable :: idlist + ! Internals + integer(I4B) :: i, n, nold, nt + integer(I4B), dimension(:), allocatable :: idvals + real(DP), dimension(:), allocatable :: tvals if (self%nid == 0) return - allocate(idlist(self%nid)) + allocate(idvals(self%nid)) + allocate(tvals(self%nframes)) n = 0 nold = 1 @@ -201,23 +204,29 @@ module subroutine encounter_util_index_map_storage(self) if (allocated(self%frame(i)%item)) then select type(snapshot => self%frame(i)%item) class is (encounter_snapshot) + tvals(i) = snapshot%t if (allocated(snapshot%pl)) then n = n + snapshot%pl%nbody - idlist(nold:n) = snapshot%pl%id(:) + idvals(nold:n) = snapshot%pl%id(:) nold = n+1 - end if + end if if (allocated(snapshot%tp)) then n = n + snapshot%tp%nbody - idlist(nold:n) = snapshot%tp%id(:) + idvals(nold:n) = snapshot%tp%id(:) nold = n+1 end if end select else + nt = i-1 exit end if end do - call util_unique(idlist,self%idmap) + call util_unique(idvals,self%idvals,self%idmap) + self%nid = size(self%idvals) + + call util_unique(tvals(1:nt),self%tvals,self%tmap) + self%nt = size(self%tvals) return end subroutine encounter_util_index_map_storage diff --git a/src/io/io.f90 b/src/io/io.f90 index 74116d5b0..3d694e027 100644 --- a/src/io/io.f90 +++ b/src/io/io.f90 @@ -294,9 +294,11 @@ module subroutine io_dump_storage(self, param) integer(I4B) :: i integer(I8B) :: iloop_start - iloop_start = max(param%iloop - int(param%istep_out * param%dump_cadence, kind=I8B),1) + if (self%iframe == 0) return + iloop_start = param%iloop - int(param%istep_out * param%dump_cadence, kind=I8B) + 1 + call self%make_index_map() do i = 1, param%dump_cadence - param%ioutput = max(int(iloop_start / param%istep_out, kind=I4B),1) + i + param%ioutput = iloop_start + self%tmap(i) if (allocated(self%frame(i)%item)) then select type(system => self%frame(i)%item) class is (swiftest_nbody_system) @@ -305,7 +307,7 @@ module subroutine io_dump_storage(self, param) deallocate(self%frame(i)%item) end if end do - + call self%reset() return end subroutine io_dump_storage diff --git a/src/main/swiftest_driver.f90 b/src/main/swiftest_driver.f90 index bfc0b38c6..803ca6849 100644 --- a/src/main/swiftest_driver.f90 +++ b/src/main/swiftest_driver.f90 @@ -88,15 +88,15 @@ program swiftest_driver call system%initialize(param) - ! 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 if (param%lenergy) call system%conservation_report(param, lterminal=.true.) else if (param%lenergy) call system%conservation_report(param, lterminal=.false.) ! This will save the initial values of energy and momentum - call system%write_frame(param) - call system%dump(param) + call system_history%take_snapshot(system) + call system_history%dump(param) end if + call system%dump(param) write(display_unit, *) " *************** Main Loop *************** " @@ -130,7 +130,7 @@ program swiftest_driver if (iout == istep_out) then iout = 0 idump = idump + 1 - system_history%frame(idump) = system ! Store a snapshot of the system for posterity + call system_history%take_snapshot(system) if (idump == dump_cadence) then idump = 0 diff --git a/src/modules/encounter_classes.f90 b/src/modules/encounter_classes.f90 index 49065fc2a..b1b7bb079 100644 --- a/src/modules/encounter_classes.f90 +++ b/src/modules/encounter_classes.f90 @@ -68,18 +68,18 @@ module encounter_classes type, extends(swiftest_storage) :: encounter_storage class(encounter_io_parameters), allocatable :: nc !! NetCDF parameter object containing the details about the file attached to this storage object contains - procedure :: dump => encounter_io_dump_storage !! Dumps contents of encounter history to file - procedure :: mapid => encounter_util_index_map_storage !! Maps body id values to storage index values so we don't have to use unlimited dimensions for id - final :: encounter_util_final_storage + procedure :: dump => encounter_io_dump_storage !! Dumps contents of encounter history to file + procedure :: make_index_map => encounter_util_index_map_storage !! Maps body id values to storage index values so we don't have to use unlimited dimensions for id + final :: encounter_util_final_storage end type encounter_storage !> A class that that is used to store simulation history data between file output type, extends(swiftest_storage) :: collision_storage class(encounter_io_parameters), allocatable :: nc !! NetCDF parameter object containing the details about the file attached to this storage object contains - procedure :: dump => encounter_io_dump_collision_storage !! Dumps contents of encounter history to file - procedure :: mapid => encounter_util_index_map_collision_storage !! Maps body id values to storage index values so we don't have to use unlimited dimensions for id - final :: encounter_util_final_collision_storage + procedure :: dump => encounter_io_dump_collision_storage !! Dumps contents of encounter history to file + procedure :: make_index_map => encounter_util_index_map_collision_storage !! Maps body id values to storage index values so we don't have to use unlimited dimensions for id + final :: encounter_util_final_collision_storage end type collision_storage type encounter_bounding_box_1D diff --git a/src/modules/swiftest_classes.f90 b/src/modules/swiftest_classes.f90 index 6fb35383e..4894e305d 100644 --- a/src/modules/swiftest_classes.f90 +++ b/src/modules/swiftest_classes.f90 @@ -148,7 +148,7 @@ module swiftest_classes contains 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 - final :: util_final_storage_frame + final :: util_final_storage_frame end type type :: swiftest_storage(nframes) @@ -156,15 +156,18 @@ module swiftest_classes integer(I4B), len :: nframes = 4096 !! Total number of frames that can be stored type(swiftest_storage_frame), dimension(nframes) :: frame !! Array of stored frames integer(I4B) :: iframe = 0 !! Index of the last frame stored in the system - integer(I4B), dimension(nframes) :: tslot !! The value of the time dimension index associated with each frame - real(DP), dimension(nframes) :: tvals !! Stored time values for snapshots - integer(I4B), dimension(:), allocatable :: idmap !! The id value -> index map integer(I4B) :: nid !! Number of unique id values in all saved snapshots + integer(I4B), dimension(:), allocatable :: idvals !! The set of unique id values contained in the snapshots + integer(I4B), dimension(:), allocatable :: idmap !! The id value -> index map + integer(I4B) :: nt !! Number of unique time values in all saved snapshots + real(DP), dimension(:), allocatable :: tvals !! The set of unique time values contained in the snapshots + integer(I4B), dimension(:), allocatable :: tmap !! The t value -> index map contains - procedure :: dump => io_dump_storage !! Dumps storage object contents to file - procedure :: mapid => util_index_map_storage !! Maps body id values to storage index values so we don't have to use unlimited dimensions for id - procedure :: reset => util_reset_storage !! Resets a storage object by deallocating all items and resetting the frame counter to 0 - final :: util_final_storage + procedure :: dump => io_dump_storage !! Dumps storage object contents to file + procedure :: make_index_map => util_index_map_storage !! Maps body id values to storage index values so we don't have to use unlimited dimensions for id + procedure :: reset => util_reset_storage !! Resets a storage object by deallocating all items and resetting the frame counter to 0 + procedure :: take_snapshot => util_snapshot_system !! Takes a snapshot of the system for later file storage + final :: util_final_storage end type swiftest_storage !******************************************************************************************************************************** @@ -550,7 +553,7 @@ module swiftest_classes procedure :: finalize => setup_finalize_system !! Runs any finalization subroutines when ending the simulation. procedure :: initialize => setup_initialize_system !! Initialize the system from input files procedure :: init_particle_info => setup_initialize_particle_info_system !! Initialize the system from input files - ! procedure :: step_spin => tides_step_spin_system !! Steps the spins of the massive & central bodies due to tides. + ! procedure :: step_spin => tides_step_spin_system !! Steps the spins of the massive & central bodies due to tides. procedure :: set_msys => util_set_msys !! Sets the value of msys from the masses of system bodies. procedure :: get_energy_and_momentum => util_get_energy_momentum_system !! Calculates the total system energy and momentum procedure :: rescale => util_rescale_system !! Rescales the system into a new set of units @@ -611,11 +614,9 @@ 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 @@ -1690,6 +1691,12 @@ module subroutine util_set_rhill_approximate(self,cb) class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object class(swiftest_cb), intent(inout) :: cb !! Swiftest central body object end subroutine util_set_rhill_approximate + + module subroutine util_snapshot_system(self, system) + implicit none + class(swiftest_storage(*)), intent(inout) :: self !! Swiftest storage object + class(swiftest_nbody_system), intent(in) :: system !! Swiftest nbody system object to store + end subroutine util_snapshot_system end interface interface util_solve_linear_system @@ -1957,12 +1964,25 @@ module subroutine util_spill_tp(self, discards, lspill_list, ldestructive) logical, intent(in) :: ldestructive !! Logical flag indicating whether or not this operation should alter the keeps array or not end subroutine util_spill_tp - module subroutine util_unique(input_array, output_array) + end interface + + interface util_unique + module subroutine util_unique_DP(input_array, output_array, index_map) implicit none - integer(I4B), dimension(:), intent(in) :: input_array - integer(I4B), dimension(:), allocatable, intent(out) :: output_array - end subroutine util_unique + real(DP), dimension(:), intent(in) :: input_array !! Unsorted input array + real(DP), dimension(:), allocatable, intent(out) :: output_array !! Sorted array of unique values + integer(I4B), dimension(:), allocatable, intent(out) :: index_map !! An array of the same size as input_array that such that any for any index i, output_array(index_map(i)) = input_array(i) + end subroutine util_unique_DP + module subroutine util_unique_I4B(input_array, output_array, index_map) + implicit none + integer(I4B), dimension(:), intent(in) :: input_array !! Unsorted input array + integer(I4B), dimension(:), allocatable, intent(out) :: output_array !! Sorted array of unique values + integer(I4B), dimension(:), allocatable, intent(out) :: index_map !! An array of the same size as input_array that such that any for any index i, output_array(index_map(i)) = input_array(i) + end subroutine util_unique_I4B + end interface util_unique + + interface module subroutine util_valid_id_system(self, param) implicit none class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nbody system object diff --git a/src/netcdf/netcdf.f90 b/src/netcdf/netcdf.f90 index 8cfc6432f..9bc945227 100644 --- a/src/netcdf/netcdf.f90 +++ b/src/netcdf/netcdf.f90 @@ -825,8 +825,8 @@ module subroutine netcdf_read_particle_info_system(self, nc, param, plmask, tpma pl%id(:) = pack(itemp, plmask) tp%id(:) = pack(itemp, tpmask) cb%id = 0 - pl%id(:) = pack([(i,i=1,idmax)],plmask) - tp%id(:) = pack([(i,i=1,idmax)],tpmask) + pl%id(:) = pack([(i,i=0,idmax-1)],plmask) + tp%id(:) = pack([(i,i=0,idmax-1)],tpmask) call check( nf90_get_var(nc%id, nc%name_varid, ctemp, count=[NAMELEN, idmax]), "netcdf_read_particle_info_system nf90_getvar name_varid" ) call cb%info%set_value(name=ctemp(1)) diff --git a/src/symba/symba_io.f90 b/src/symba/symba_io.f90 index cd8693598..d1f36abca 100644 --- a/src/symba/symba_io.f90 +++ b/src/symba/symba_io.f90 @@ -30,7 +30,7 @@ module subroutine symba_io_dump_encounter(self, param) if (num_enc_frames > 0) then ! Create and save the output files for this encounter and fragmentation nce%file_number = nce%file_number + 1 - nce%time_dimsize = maxval(encounter_history%tslot(:)) + call encounter_history%make_index_map() write(nce%file_name, '("encounter_",I0.6,".nc")') nce%file_number call nce%initialize(param) call encounter_history%dump(param) @@ -44,6 +44,7 @@ module subroutine symba_io_dump_encounter(self, param) if (num_coll_frames > 0) then ncc%file_number = ncc%file_number + 1 ncc%event_dimsize = num_coll_frames + call collision_history%make_index_map() write(ncc%file_name, '("collision_",I0.6,".nc")') ncc%file_number call ncc%initialize(param) call collision_history%dump(param) diff --git a/src/symba/symba_util.f90 b/src/symba/symba_util.f90 index f7711e6bf..4381ce93b 100644 --- a/src/symba/symba_util.f90 +++ b/src/symba/symba_util.f90 @@ -897,10 +897,6 @@ subroutine symba_util_save_collision(system, snapshot) nbig = nbig * 2 end do allocate(collision_storage(nbig) :: tmp) - tmp%tvals(1:nold) = system%collision_history%tvals(1:nold) - tmp%tvals(nold+1:nbig) = huge(1.0_DP) - tmp%tslot(1:nold) = system%collision_history%tslot(1:nold) - tmp%tslot(nold+1:nbig) = 0 tmp%iframe = system%collision_history%iframe call move_alloc(system%collision_history%nc, tmp%nc) @@ -947,10 +943,6 @@ subroutine symba_util_save_encounter(system, snapshot, t) nbig = nbig * 2 end do allocate(encounter_storage(nbig) :: tmp) - tmp%tvals(1:nold) = system%encounter_history%tvals(1:nold) - tmp%tvals(nold+1:nbig) = huge(1.0_DP) - tmp%tslot(1:nold) = system%encounter_history%tslot(1:nold) - tmp%tslot(nold+1:nbig) = 0 tmp%iframe = system%encounter_history%iframe call move_alloc(system%encounter_history%nc, tmp%nc) @@ -964,14 +956,7 @@ subroutine symba_util_save_encounter(system, snapshot, t) ! Find out which time slot this belongs in by searching for an existing slot ! with the same value of time or the first available one - do i = 1, nnew - if (t <= system%encounter_history%tvals(i)) then - system%encounter_history%tvals(i) = t - system%encounter_history%tslot(nnew) = i - system%encounter_history%frame(nnew) = snapshot - exit - end if - end do + system%encounter_history%frame(nnew) = snapshot return end subroutine symba_util_save_encounter diff --git a/src/util/util_index.f90 b/src/util/util_index.f90 index 20772a2a6..ae4a80ce8 100644 --- a/src/util/util_index.f90 +++ b/src/util/util_index.f90 @@ -53,6 +53,48 @@ module subroutine util_index_map_storage(self) ! Arguments class(swiftest_storage(*)), intent(inout) :: self !! Swiftest storage object ! Internals + integer(I4B) :: i, n, nold, nt + integer(I4B), dimension(:), allocatable :: idvals + real(DP), dimension(:), allocatable :: tvals + + if (self%nid == 0) return + allocate(idvals(self%nid)) + allocate(tvals(self%nframes)) + + n = 0 + nold = 1 + nt = 0 + do i = 1, self%nframes + if (allocated(self%frame(i)%item)) then + nt = i + select type(snapshot => self%frame(i)%item) + class is (swiftest_nbody_system) + tvals(i) = snapshot%t + ! Central body + n = n + 1 + idvals(n) = snapshot%cb%id + nold = n + 1 + if (allocated(snapshot%pl)) then + n = n + snapshot%pl%nbody + idvals(nold:n) = snapshot%pl%id(:) + nold = n+1 + end if + if (allocated(snapshot%tp)) then + n = n + snapshot%tp%nbody + idvals(nold:n) = snapshot%tp%id(:) + nold = n+1 + end if + end select + else + exit + end if + end do + + call util_unique(idvals,self%idvals,self%idmap) + self%nid = size(self%idvals) + + call util_unique(tvals(1:nt),self%tvals,self%tmap) + self%nt = size(self%tvals) return end subroutine util_index_map_storage diff --git a/src/util/util_reset.f90 b/src/util/util_reset.f90 index a588c65fe..9b37f7d15 100644 --- a/src/util/util_reset.f90 +++ b/src/util/util_reset.f90 @@ -24,11 +24,12 @@ module subroutine util_reset_storage(self) do i = 1, self%nframes if (allocated(self%frame(i)%item)) deallocate(self%frame(i)%item) end do - self%tslot(:) = 0 - self%tvals(:) = huge(1.0_DP) - self%iframe = 0 + if (allocated(self%idmap)) deallocate(self%idmap) + if (allocated(self%tmap)) deallocate(self%tmap) self%nid = 0 + self%nt = 0 + self%iframe = 0 return end subroutine util_reset_storage diff --git a/src/util/util_snapshot.f90 b/src/util/util_snapshot.f90 new file mode 100644 index 000000000..1c67bc7f8 --- /dev/null +++ b/src/util/util_snapshot.f90 @@ -0,0 +1,33 @@ +!! Copyright 2022 - David Minton, Carlisle Wishard, Jennifer Pouplin, Jake Elliott, & Dana Singh +!! This file is part of Swiftest. +!! Swiftest is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License +!! as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. +!! Swiftest is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty +!! of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. +!! You should have received a copy of the GNU General Public License along with Swiftest. +!! If not, see: https://www.gnu.org/licenses. + +submodule(swiftest_classes) s_util_snapshot + use swiftest +contains + + module subroutine util_snapshot_system(self, system) + !! author: David A. Minton + !! + !! Takes a snapshot of the system for later file storage + implicit none + ! Arguments + class(swiftest_storage(*)), intent(inout) :: self !! Swiftest storage object + class(swiftest_nbody_system), intent(in) :: system !! Swiftest nbody system object to store + + self%iframe = self%iframe + 1 + self%nt = self%iframe + self%frame(self%iframe) = system ! Store a snapshot of the system for posterity + self%nid = self%nid + 1 ! Central body + if (allocated(system%pl)) self%nid = self%nid + system%pl%nbody + if (allocated(system%tp)) self%nid = self%nid + system%tp%nbody + + return + end subroutine util_snapshot_system + +end submodule s_util_snapshot \ No newline at end of file diff --git a/src/util/util_unique.f90 b/src/util/util_unique.f90 index 9cf77536c..19eb4ba78 100644 --- a/src/util/util_unique.f90 +++ b/src/util/util_unique.f90 @@ -11,31 +11,70 @@ use swiftest contains - module subroutine util_unique(input_array, output_array) + module subroutine util_unique_DP(input_array, output_array, index_map) !! author: David A. Minton !! - !! Takes an input unsorted integer array and returns a new array of sorted, unique values + !! Takes an input unsorted integer array and returns a new array of sorted, unique values (DP version) implicit none ! Arguments - integer(I4B), dimension(:), intent(in) :: input_array - integer(I4B), dimension(:), allocatable, intent(out) :: output_array + real(DP), dimension(:), intent(in) :: input_array !! Unsorted input array + real(DP), dimension(:), allocatable, intent(out) :: output_array !! Sorted array of unique values + integer(I4B), dimension(:), allocatable, intent(out) :: index_map !! An array of the same size as input_array that such that any for any index i, output_array(index_map(i)) = input_array(i) + ! Internals + real(DP), dimension(:), allocatable :: unique_array + integer(I4B) :: n + real(DP) :: lo, hi + + allocate(unique_array, mold=input_array) + allocate(index_map(size(input_array))) + lo = minval(input_array) - 1 + hi = maxval(input_array) + + n = 0 + do + n = n + 1 + lo = minval(input_array(:), mask=input_array(:) > lo) + unique_array(n) = lo + where(input_array(:) == lo) index_map(:) = n + if (lo >= hi) exit + enddo + allocate(output_array(n), source=unique_array(1:n)) + + return + end subroutine util_unique_DP + + + module subroutine util_unique_I4B(input_array, output_array, index_map) + !! author: David A. Minton + !! + !! Takes an input unsorted integer array and returns a new array of sorted, unique values (I4B version) + implicit none + ! Arguments + integer(I4B), dimension(:), intent(in) :: input_array !! Unsorted input array + integer(I4B), dimension(:), allocatable, intent(out) :: output_array !! Sorted array of unique values + integer(I4B), dimension(:), allocatable, intent(out) :: index_map !! An array of the same size as input_array that such that any for any index i, output_array(index_map(i)) = input_array(i) ! Internals integer(I4B), dimension(:), allocatable :: unique_array integer(I4B) :: n, lo, hi allocate(unique_array, mold=input_array) + allocate(index_map, mold=input_array) lo = minval(input_array) - 1 hi = maxval(input_array) n = 0 - do while (lo < hi) + do n = n + 1 - lo = minval(input_array, mask=input_array > lo) + lo = minval(input_array(:), mask=input_array(:) > lo) unique_array(n) = lo + where(input_array(:) == lo) index_map(:) = n + if (lo >= hi) exit enddo allocate(output_array(n), source=unique_array(1:n)) return - end subroutine util_unique + end subroutine util_unique_I4B + + end submodule s_util_unique \ No newline at end of file From a7fb1c76168beb1827ebc1cc08dcc8b1c0b26e6f Mon Sep 17 00:00:00 2001 From: David A Minton Date: Sun, 11 Dec 2022 17:21:35 -0500 Subject: [PATCH 386/569] I am once again restructuring. This time to try to get all of the storage objects to have a consistent structure and set of methods --- src/discard/discard.f90 | 4 +- src/encounter/encounter_io.f90 | 171 +++++++++++-------- src/encounter/encounter_util.f90 | 262 ++++++++++++++++++++++++++++++ src/fraggle/fraggle_io.f90 | 100 ++++++------ src/io/io.f90 | 101 ++++++------ src/main/swiftest_driver.f90 | 153 ++++++++--------- src/modules/encounter_classes.f90 | 55 +++++-- src/modules/fraggle_classes.f90 | 6 +- src/modules/swiftest_classes.f90 | 13 +- src/modules/symba_classes.f90 | 29 +--- src/netcdf/netcdf.f90 | 82 +++++----- src/setup/setup.f90 | 22 ++- src/symba/symba_collision.f90 | 6 +- src/symba/symba_io.f90 | 49 +----- src/symba/symba_step.f90 | 47 +++--- src/symba/symba_util.f90 | 247 +--------------------------- src/util/util_snapshot.f90 | 9 +- 17 files changed, 690 insertions(+), 666 deletions(-) diff --git a/src/discard/discard.f90 b/src/discard/discard.f90 index 1e0be68bd..72782df84 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_info(param%nc, param) - if (lpl_discards) call pl_discards%write_info(param%nc, param) + if (ltp_discards) call tp_discards%write_info(param%system_history%nc, param) + if (lpl_discards) call pl_discards%write_info(param%system_history%nc, param) if (lpl_discards .and. param%lenergy) call self%conservation_report(param, lterminal=.false.) if (lpl_check) call pl_discards%setup(0,param) if (ltp_check) call tp_discards%setup(0,param) diff --git a/src/encounter/encounter_io.f90 b/src/encounter/encounter_io.f90 index 0f821f49b..350f2f1d2 100644 --- a/src/encounter/encounter_io.f90 +++ b/src/encounter/encounter_io.f90 @@ -12,35 +12,49 @@ contains - module subroutine encounter_io_dump_collision_storage(self, param) + module subroutine encounter_io_dump_collision(self, param) !! author: David A. Minton !! !! Dumps the time history of an encounter to file. implicit none ! Arguments - class(collision_storage(*)), intent(inout) :: self !! Encounter storage object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + class(collision_storage(*)), intent(inout) :: self !! Encounter storage object + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters ! Internals integer(I4B) :: i - do i = 1, self%nframes - if (allocated(self%frame(i)%item)) then - select type(snapshot => self%frame(i)%item) - class is (fraggle_collision_snapshot) - param%ioutput = i - call snapshot%write_frame(self%nc,param) - end select - else - exit + select type(nc => self%nc) + class is (fraggle_io_parameters) + if (self%iframe > 0) then + nc%file_number = nc%file_number + 1 + nc%event_dimsize = self%iframe + call self%make_index_map() + write(nc%file_name, '("collision_",I0.6,".nc")') nc%file_number + call nc%initialize(param) + + do i = 1, self%nframes + if (allocated(self%frame(i)%item)) then + select type(snapshot => self%frame(i)%item) + class is (fraggle_collision_snapshot) + param%ioutput = i + call snapshot%write_frame(nc,param) + end select + else + exit + end if + end do + + call nc%close() + call self%reset() end if - end do + end select return - end subroutine encounter_io_dump_collision_storage + end subroutine encounter_io_dump_collision - module subroutine encounter_io_dump_storage(self, param) - !! author: David A. Minton + module subroutine encounter_io_dump_encounter(self, param) + ! author: David A. Minton !! !! Dumps the time history of an encounter to file. implicit none @@ -50,20 +64,34 @@ module subroutine encounter_io_dump_storage(self, param) ! Internals integer(I4B) :: i - do i = 1, self%nframes - if (allocated(self%frame(i)%item)) then - select type(snapshot => self%frame(i)%item) - class is (encounter_snapshot) - param%ioutput = self%tmap(i) - call snapshot%write_frame(self%nc,param) - end select - else - exit + select type(nc => self%nc) + class is (encounter_io_parameters) + if (self%iframe > 0) then + ! Create and save the output files for this encounter and fragmentation + nc%file_number = nc%file_number + 1 + call self%make_index_map() + write(nc%file_name, '("encounter_",I0.6,".nc")') nc%file_number + call nc%initialize(param) + + do i = 1, self%nframes + if (allocated(self%frame(i)%item)) then + select type(snapshot => self%frame(i)%item) + class is (encounter_snapshot) + param%ioutput = self%tmap(i) + call snapshot%write_frame(nc,param) + end select + else + exit + end if + end do + + call nc%close() + call self%reset() end if - end do + end select return - end subroutine encounter_io_dump_storage + end subroutine encounter_io_dump_encounter module subroutine encounter_io_initialize(self, param) @@ -170,56 +198,59 @@ module subroutine encounter_io_write_frame(self, nc, param) use netcdf implicit none ! Arguments - class(encounter_snapshot), intent(in) :: self !! Swiftest encounter structure - class(encounter_io_parameters), intent(inout) :: nc !! Parameters used to identify a particular encounter io NetCDF dataset - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + class(encounter_snapshot), intent(in) :: self !! Swiftest encounter structure + class(netcdf_parameters), intent(inout) :: nc !! Parameters used to identify a particular encounter io NetCDF dataset + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters ! Internals integer(I4B) :: i, tslot, idslot, old_mode, npl, ntp character(len=:), allocatable :: charstring tslot = param%ioutput associate(pl => self%pl, tp => self%tp) + select type (nc) + class is (encounter_io_parameters) - call check( nf90_set_fill(nc%id, nf90_nofill, old_mode), "encounter_io_write_frame nf90_set_fill" ) - - call check( nf90_put_var(nc%id, nc%time_varid, self%t, start=[tslot]), "encounter_io_write_frame nf90_put_var time_varid" ) - call check( nf90_put_var(nc%id, nc%loop_varid, int(self%iloop,kind=I4B), start=[tslot]), "encounter_io_write_frame nf90_put_var pl loop_varid" ) - - npl = pl%nbody - do i = 1, npl - idslot = pl%id(i) + 1 - call check( nf90_put_var(nc%id, nc%id_varid, pl%id(i), start=[idslot]), "encounter_io_write_frame nf90_put_var pl id_varid" ) - call check( nf90_put_var(nc%id, nc%rh_varid, pl%rh(:,i), start=[1,idslot,tslot], count=[NDIM,1,1]), "encounter_io_write_frame nf90_put_var pl rh_varid" ) - call check( nf90_put_var(nc%id, nc%vh_varid, pl%vh(:,i), start=[1,idslot,tslot], count=[NDIM,1,1]), "encounter_io_write_frame nf90_put_var pl vh_varid" ) - call check( nf90_put_var(nc%id, nc%Gmass_varid, pl%Gmass(i), start=[idslot, tslot]), "encounter_io_write_frame nf90_put_var pl Gmass_varid" ) - - if (param%lclose) call check( nf90_put_var(nc%id, nc%radius_varid, pl%radius(i), start=[idslot, tslot]), "encounter_io_write_frame nf90_put_var pl radius_varid" ) - - if (param%lrotation) then - call check( nf90_put_var(nc%id, nc%Ip_varid, pl%Ip(:,i), start=[1, idslot, tslot], count=[NDIM,1,1]), "encounter_io_write_frame nf90_put_var pl Ip_varid" ) - call check( nf90_put_var(nc%id, nc%rot_varid, pl%rot(:,i), start=[1,idslot, tslot], count=[NDIM,1,1]), "encounter_io_write_frame nf90_put_var pl rotx_varid" ) - end if - - charstring = trim(adjustl(pl%info(i)%name)) - call check( nf90_put_var(nc%id, nc%name_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "encounter_io_write_frame nf90_put_var pl name_varid" ) - charstring = trim(adjustl(pl%info(i)%particle_type)) - call check( nf90_put_var(nc%id, nc%ptype_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "encounter_io_write_frame nf90_put_var pl particle_type_varid" ) - end do - - ntp = tp%nbody - do i = 1, ntp - idslot = tp%id(i) + 1 - call check( nf90_put_var(nc%id, nc%id_varid, tp%id(i), start=[idslot]), "encounter_io_write_frame nf90_put_var tp id_varid" ) - call check( nf90_put_var(nc%id, nc%rh_varid, tp%rh(:,i), start=[1,idslot,tslot], count=[NDIM,1,1]), "encounter_io_write_frame nf90_put_var tp rh_varid" ) - call check( nf90_put_var(nc%id, nc%vh_varid, tp%vh(:,i), start=[1,idslot,tslot], count=[NDIM,1,1]), "encounter_io_write_frame nf90_put_var tp vh_varid" ) - - charstring = trim(adjustl(tp%info(i)%name)) - call check( nf90_put_var(nc%id, nc%name_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "encounter_io_write_frame nf90_put_var tp name_varid" ) - charstring = trim(adjustl(tp%info(i)%particle_type)) - call check( nf90_put_var(nc%id, nc%ptype_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "encounter_io_write_frame nf90_put_var tp particle_type_varid" ) - end do - - call check( nf90_set_fill(nc%id, old_mode, old_mode) ) + call check( nf90_set_fill(nc%id, nf90_nofill, old_mode), "encounter_io_write_frame nf90_set_fill" ) + + call check( nf90_put_var(nc%id, nc%time_varid, self%t, start=[tslot]), "encounter_io_write_frame nf90_put_var time_varid" ) + call check( nf90_put_var(nc%id, nc%loop_varid, int(self%iloop,kind=I4B), start=[tslot]), "encounter_io_write_frame nf90_put_var pl loop_varid" ) + + npl = pl%nbody + do i = 1, npl + idslot = pl%id(i) + 1 + call check( nf90_put_var(nc%id, nc%id_varid, pl%id(i), start=[idslot]), "encounter_io_write_frame nf90_put_var pl id_varid" ) + call check( nf90_put_var(nc%id, nc%rh_varid, pl%rh(:,i), start=[1,idslot,tslot], count=[NDIM,1,1]), "encounter_io_write_frame nf90_put_var pl rh_varid" ) + call check( nf90_put_var(nc%id, nc%vh_varid, pl%vh(:,i), start=[1,idslot,tslot], count=[NDIM,1,1]), "encounter_io_write_frame nf90_put_var pl vh_varid" ) + call check( nf90_put_var(nc%id, nc%Gmass_varid, pl%Gmass(i), start=[idslot, tslot]), "encounter_io_write_frame nf90_put_var pl Gmass_varid" ) + + if (param%lclose) call check( nf90_put_var(nc%id, nc%radius_varid, pl%radius(i), start=[idslot, tslot]), "encounter_io_write_frame nf90_put_var pl radius_varid" ) + + if (param%lrotation) then + call check( nf90_put_var(nc%id, nc%Ip_varid, pl%Ip(:,i), start=[1, idslot, tslot], count=[NDIM,1,1]), "encounter_io_write_frame nf90_put_var pl Ip_varid" ) + call check( nf90_put_var(nc%id, nc%rot_varid, pl%rot(:,i), start=[1,idslot, tslot], count=[NDIM,1,1]), "encounter_io_write_frame nf90_put_var pl rotx_varid" ) + end if + + charstring = trim(adjustl(pl%info(i)%name)) + call check( nf90_put_var(nc%id, nc%name_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "encounter_io_write_frame nf90_put_var pl name_varid" ) + charstring = trim(adjustl(pl%info(i)%particle_type)) + call check( nf90_put_var(nc%id, nc%ptype_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "encounter_io_write_frame nf90_put_var pl particle_type_varid" ) + end do + + ntp = tp%nbody + do i = 1, ntp + idslot = tp%id(i) + 1 + call check( nf90_put_var(nc%id, nc%id_varid, tp%id(i), start=[idslot]), "encounter_io_write_frame nf90_put_var tp id_varid" ) + call check( nf90_put_var(nc%id, nc%rh_varid, tp%rh(:,i), start=[1,idslot,tslot], count=[NDIM,1,1]), "encounter_io_write_frame nf90_put_var tp rh_varid" ) + call check( nf90_put_var(nc%id, nc%vh_varid, tp%vh(:,i), start=[1,idslot,tslot], count=[NDIM,1,1]), "encounter_io_write_frame nf90_put_var tp vh_varid" ) + + charstring = trim(adjustl(tp%info(i)%name)) + call check( nf90_put_var(nc%id, nc%name_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "encounter_io_write_frame nf90_put_var tp name_varid" ) + charstring = trim(adjustl(tp%info(i)%particle_type)) + call check( nf90_put_var(nc%id, nc%ptype_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "encounter_io_write_frame nf90_put_var tp particle_type_varid" ) + end do + + call check( nf90_set_fill(nc%id, old_mode, old_mode) ) + end select end associate return diff --git a/src/encounter/encounter_util.f90 b/src/encounter/encounter_util.f90 index ef89b3cf3..45766a887 100644 --- a/src/encounter/encounter_util.f90 +++ b/src/encounter/encounter_util.f90 @@ -320,4 +320,266 @@ module subroutine encounter_util_spill_list(self, discards, lspill_list, ldestru return end subroutine encounter_util_spill_list + + + subroutine encounter_util_save_collision(param, snapshot) + !! author: David A. Minton + !! + !! Checks the current size of the encounter storage against the required size and extends it by a factor of 2 more than requested if it is too small. + !! Note: The reason to extend it by a factor of 2 is for performance. When there are many enounters per step, resizing every time you want to add an + !! encounter takes significant computational effort. Resizing by a factor of 2 is a tradeoff between performance (fewer resize calls) and memory managment + !! Memory usage grows by a factor of 2 each time it fills up, but no more. + implicit none + ! Arguments + class(symba_parameters), intent(inout) :: param !! SyMBA parameter object + class(encounter_snapshot), intent(in) :: snapshot !! Encounter snapshot object + ! Internals + type(collision_storage(nframes=:)), allocatable :: tmp + integer(I4B) :: i, nnew, nold, nbig + + ! Advance the snapshot frame counter + param%collision_history%iframe = param%collision_history%iframe + 1 + + ! Check to make sure the current encounter_history object is big enough. If not, grow it by a factor of 2 + nnew = param%collision_history%iframe + nold = param%collision_history%nframes + + if (nnew > nold) then + nbig = nold + do while (nbig < nnew) + nbig = nbig * 2 + end do + allocate(collision_storage(nbig) :: tmp) + tmp%iframe = param%collision_history%iframe + call move_alloc(param%collision_history%nc, tmp%nc) + + do i = 1, nold + if (allocated(param%collision_history%frame(i)%item)) call move_alloc(param%collision_history%frame(i)%item, tmp%frame(i)%item) + end do + deallocate(param%collision_history) + call move_alloc(tmp,param%collision_history) + nnew = nbig + end if + + param%collision_history%frame(nnew) = snapshot + + return + end subroutine encounter_util_save_collision + + + subroutine encounter_util_save_encounter(param, snapshot, t) + !! 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_parameters), intent(inout) :: param !! SyMBA parameter object + class(encounter_snapshot), intent(in) :: snapshot !! Encounter snapshot object + real(DP), intent(in) :: t !! The time of the snapshot + ! Internals + type(encounter_storage(nframes=:)), allocatable :: tmp + integer(I4B) :: i, nnew, nold, nbig + + ! Advance the snapshot frame counter + param%encounter_history%iframe = param%encounter_history%iframe + 1 + + ! Check to make sure the current encounter_history object is big enough. If not, grow it by a factor of 2 + nnew = param%encounter_history%iframe + nold = param%encounter_history%nframes + + if (nnew > nold) then + nbig = nold + do while (nbig < nnew) + nbig = nbig * 2 + end do + allocate(encounter_storage(nbig) :: tmp) + tmp%iframe = param%encounter_history%iframe + call move_alloc(param%encounter_history%nc, tmp%nc) + + do i = 1, nold + if (allocated(param%encounter_history%frame(i)%item)) call move_alloc(param%encounter_history%frame(i)%item, tmp%frame(i)%item) + end do + deallocate(param%encounter_history) + call move_alloc(tmp,param%encounter_history) + nnew = nbig + end if + + ! Find out which time slot this belongs in by searching for an existing slot + ! with the same value of time or the first available one + param%encounter_history%frame(nnew) = snapshot + + return + end subroutine encounter_util_save_encounter + + + module subroutine encounter_util_snapshot_collision(self, param, system, t, arg) + !! author: David A. Minton + !! + !! Takes a minimal snapshot of the state of the system during an encounter so that the trajectories + !! can be played back through the encounter + implicit none + ! Internals + class(collision_storage(*)), intent(inout) :: self !! Swiftest storage object + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object to store + real(DP), intent(in), optional :: t !! Time of snapshot if different from system time + character(*), intent(in), optional :: arg !! Optional argument (needed for extended storage type used in collision snapshots) + ! Arguments + class(fraggle_collision_snapshot), allocatable :: snapshot + type(symba_pl) :: pl + character(len=:), allocatable :: stage + integer(I4B) :: i,j + + + if (present(arg)) then + stage = arg + else + stage = "" + end if + + select type (system) + class is (symba_nbody_system) + + select case(stage) + case("before") + ! Saves the states of the bodies involved in the collision before the collision is resolved + associate (idx => system%colliders%idx, ncoll => system%colliders%ncoll) + call pl%setup(ncoll, param) + pl%id(:) = system%pl%id(idx(:)) + pl%Gmass(:) = system%pl%Gmass(idx(:)) + pl%radius(:) = system%pl%radius(idx(:)) + pl%rot(:,:) = system%pl%rot(:,idx(:)) + pl%Ip(:,:) = system%pl%Ip(:,idx(:)) + pl%rh(:,:) = system%pl%rh(:,idx(:)) + pl%vh(:,:) = system%pl%vh(:,idx(:)) + pl%info(:) = system%pl%info(idx(:)) + !end select + allocate(system%colliders%pl, source=pl) + end associate + case("after") + allocate(fraggle_collision_snapshot :: snapshot) + allocate(snapshot%colliders, source=system%colliders) + allocate(snapshot%fragments, source=system%fragments) + select type (param) + class is (symba_parameters) + call encounter_util_save_collision(param,snapshot) + end select + case default + write(*,*) "encounter_util_snapshot_collision requies either 'before' or 'after' passed to 'arg'" + end select + + end select + + return + end subroutine encounter_util_snapshot_collision + + + module subroutine encounter_util_snapshot_encounter(self, param, system, t, arg) + !! author: David A. Minton + !! + !! Takes a minimal snapshot of the state of the system during an encounter so that the trajectories + !! can be played back through the encounter + implicit none + ! Internals + class(encounter_storage(*)), intent(inout) :: self !! Swiftest storage object + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object to store + real(DP), intent(in), optional :: t !! Time of snapshot if different from system time + character(*), intent(in), optional :: arg !! Optional argument (needed for extended storage type used in collision snapshots) + ! Arguments + class(encounter_snapshot), allocatable :: snapshot + integer(I4B) :: i, npl_snap, ntp_snap + + if (.not.present(t)) then + write(*,*) "encounter_util_snapshot_encounter requires `t` to be passed" + end if + select type (system) + class is (symba_nbody_system) + select type(pl => system%pl) + class is (symba_pl) + select type (tp => system%tp) + class is (symba_tp) + associate(npl => pl%nbody, ntp => tp%nbody) + + allocate(encounter_snapshot :: snapshot) + snapshot%t = t + snapshot%iloop = param%iloop + + if (npl + ntp == 0) return + npl_snap = npl + ntp_snap = ntp + + allocate(snapshot%pl, mold=pl) + allocate(snapshot%tp, mold=tp) + select type(pl_snap => snapshot%pl) + class is (symba_pl) + if (npl > 0) then + pl%lmask(1:npl) = pl%status(1:npl) /= INACTIVE .and. pl%levelg(1:npl) == system%irec + npl_snap = count(pl%lmask(1:npl)) + end if + if (ntp > 0) then + tp%lmask(1:ntp) = tp%status(1:ntp) /= INACTIVE .and. tp%levelg(1:ntp) == system%irec + ntp_snap = count(tp%lmask(1:ntp)) + end if + pl_snap%nbody = npl_snap + end select + + select type(pl_snap => snapshot%pl) + class is (symba_pl) + ! Take snapshot of the currently encountering massive bodies + if (npl_snap > 0) then + call pl_snap%setup(npl_snap, param) + pl_snap%levelg(:) = pack(pl%levelg(1:npl), pl%lmask(1:npl)) + pl_snap%id(:) = pack(pl%id(1:npl), pl%lmask(1:npl)) + pl_snap%info(:) = pack(pl%info(1:npl), pl%lmask(1:npl)) + pl_snap%Gmass(:) = pack(pl%Gmass(1:npl), pl%lmask(1:npl)) + do i = 1, NDIM + pl_snap%rh(i,:) = pack(pl%rh(i,1:npl), pl%lmask(1:npl)) + pl_snap%vh(i,:) = pack(pl%vb(i,1:npl), pl%lmask(1:npl)) + end do + if (param%lclose) then + pl_snap%radius(:) = pack(pl%radius(1:npl), pl%lmask(1:npl)) + end if + + if (param%lrotation) then + do i = 1, NDIM + pl_snap%Ip(i,:) = pack(pl%Ip(i,1:npl), pl%lmask(1:npl)) + pl_snap%rot(i,:) = pack(pl%rot(i,1:npl), pl%lmask(1:npl)) + end do + end if + call pl_snap%sort("id", ascending=.true.) + end if + end select + + select type(tp_snap => snapshot%tp) + class is (symba_tp) + ! Take snapshot of the currently encountering test particles + tp_snap%nbody = ntp_snap + if (ntp_snap > 0) then + call tp_snap%setup(ntp_snap, param) + tp_snap%id(:) = pack(tp%id(1:ntp), tp%lmask(1:ntp)) + tp_snap%info(:) = pack(tp%info(1:ntp), tp%lmask(1:ntp)) + do i = 1, NDIM + tp_snap%rh(i,:) = pack(tp%rh(i,1:ntp), tp%lmask(1:ntp)) + tp_snap%vh(i,:) = pack(tp%vh(i,1:ntp), tp%lmask(1:ntp)) + end do + end if + end select + end associate + ! Save the snapshot + select type(param) + class is (symba_parameters) + param%encounter_history%nid = param%encounter_history%nid + ntp_snap + npl_snap + call encounter_util_save_encounter(param,snapshot,t) + end select + end select + end select + end select + + return + end subroutine encounter_util_snapshot_encounter + end submodule s_encounter_util \ No newline at end of file diff --git a/src/fraggle/fraggle_io.f90 b/src/fraggle/fraggle_io.f90 index 4f5fec19b..d4a8d3d9e 100644 --- a/src/fraggle/fraggle_io.f90 +++ b/src/fraggle/fraggle_io.f90 @@ -155,64 +155,66 @@ module subroutine fraggle_io_write_frame(self, nc, param) use netcdf implicit none ! Arguments - class(fraggle_collision_snapshot), intent(in) :: self !! Swiftest encounter structure - class(encounter_io_parameters), intent(inout) :: nc !! Parameters used to identify a particular encounter io NetCDF dataset - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + class(fraggle_collision_snapshot), intent(in) :: self !! Swiftest encounter structure + class(netcdf_parameters), intent(inout) :: nc !! Parameters used to identify a particular encounter io NetCDF dataset + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters ! Internals integer(I4B) :: i, eslot, idslot, old_mode, npl, stage character(len=:), allocatable :: charstring class(swiftest_pl), allocatable :: pl associate(colliders => self%colliders, fragments => self%fragments) - eslot = param%ioutput select type(nc) - class is (fraggle_io_parameters) - call check( nf90_set_fill(nc%id, nf90_nofill, old_mode), "fraggle_io_write_frame nf90_set_fill" ) - - call check( nf90_put_var(nc%id, nc%time_varid, self%t, start=[eslot]), "fraggle_io_write_frame nf90_put_var time_varid" ) - call check( nf90_put_var(nc%id, nc%loop_varid, int(self%iloop,kind=I4B), start=[eslot]), "fraggle_io_write_frame nf90_put_varloop_varid" ) - - charstring = trim(adjustl(REGIME_NAMES(fragments%regime))) - call check( nf90_put_var(nc%id, nc%regime_varid, charstring, start=[1, eslot], count=[len(charstring), 1]), "fraggle_io_write_frame nf90_put_var regime_varid" ) - call check( nf90_put_var(nc%id, nc%Qloss_varid, fragments%Qloss, start=[eslot] ), "fraggle_io_write_frame nf90_put_var Qloss_varid" ) - - do stage = 1,2 - if (allocated(pl)) deallocate(pl) - select case(stage) - case(1) - allocate(pl, source=colliders%pl) - case(2) - allocate(pl, source=fragments%pl) - end select - npl = pl%nbody - do i = 1, npl - idslot = pl%id(i) + 1 - call check( nf90_put_var(nc%id, nc%id_varid, pl%id(i), start=[ idslot ]), "fraggle_io_write_frame nf90_put_var id_varid" ) - charstring = trim(adjustl(pl%info(i)%name)) - call check( nf90_put_var(nc%id, nc%name_varid, charstring, start=[1, idslot ], count=[len(charstring), 1]), "fraggle_io_write_frame nf90_put_var name_varid" ) - charstring = trim(adjustl(pl%info(i)%particle_type)) - call check( nf90_put_var(nc%id, nc%ptype_varid, charstring, start=[1, idslot, stage, eslot], count=[len(charstring), 1, 1]), "fraggle_io_write_frame nf90_put_var particle_type_varid" ) - call check( nf90_put_var(nc%id, nc%rh_varid, pl%rh(:,i), start=[1, idslot, stage, eslot], count=[NDIM,1,1,1]), "fraggle_io_write_frame nf90_put_var rh_varid" ) - call check( nf90_put_var(nc%id, nc%vh_varid, pl%vh(:,i), start=[1, idslot, stage, eslot], count=[NDIM,1,1,1]), "fraggle_io_write_frame nf90_put_var vh_varid" ) - call check( nf90_put_var(nc%id, nc%Gmass_varid, pl%Gmass(i), start=[ idslot, stage, eslot]), "fraggle_io_write_frame nf90_put_var Gmass_varid" ) - call check( nf90_put_var(nc%id, nc%radius_varid, pl%radius(i), start=[ idslot, stage, eslot]), "fraggle_io_write_frame nf90_put_var radius_varid" ) - call check( nf90_put_var(nc%id, nc%Ip_varid, pl%Ip(:,i), start=[1, idslot, stage, eslot], count=[NDIM,1,1,1]), "fraggle_io_write_frame nf90_put_var Ip_varid" ) - call check( nf90_put_var(nc%id, nc%rot_varid, pl%rot(:,i), start=[1, idslot, stage, eslot], count=[NDIM,1,1,1]), "fraggle_io_write_frame nf90_put_var rotx_varid" ) + class is (encounter_io_parameters) + eslot = param%ioutput + select type(nc) + class is (fraggle_io_parameters) + call check( nf90_set_fill(nc%id, nf90_nofill, old_mode), "fraggle_io_write_frame nf90_set_fill" ) + + call check( nf90_put_var(nc%id, nc%time_varid, self%t, start=[eslot]), "fraggle_io_write_frame nf90_put_var time_varid" ) + call check( nf90_put_var(nc%id, nc%loop_varid, int(self%iloop,kind=I4B), start=[eslot]), "fraggle_io_write_frame nf90_put_varloop_varid" ) + + charstring = trim(adjustl(REGIME_NAMES(fragments%regime))) + call check( nf90_put_var(nc%id, nc%regime_varid, charstring, start=[1, eslot], count=[len(charstring), 1]), "fraggle_io_write_frame nf90_put_var regime_varid" ) + call check( nf90_put_var(nc%id, nc%Qloss_varid, fragments%Qloss, start=[eslot] ), "fraggle_io_write_frame nf90_put_var Qloss_varid" ) + + do stage = 1,2 + if (allocated(pl)) deallocate(pl) + select case(stage) + case(1) + allocate(pl, source=colliders%pl) + case(2) + allocate(pl, source=fragments%pl) + end select + npl = pl%nbody + do i = 1, npl + idslot = pl%id(i) + 1 + call check( nf90_put_var(nc%id, nc%id_varid, pl%id(i), start=[ idslot ]), "fraggle_io_write_frame nf90_put_var id_varid" ) + charstring = trim(adjustl(pl%info(i)%name)) + call check( nf90_put_var(nc%id, nc%name_varid, charstring, start=[1, idslot ], count=[len(charstring), 1]), "fraggle_io_write_frame nf90_put_var name_varid" ) + charstring = trim(adjustl(pl%info(i)%particle_type)) + call check( nf90_put_var(nc%id, nc%ptype_varid, charstring, start=[1, idslot, stage, eslot], count=[len(charstring), 1, 1]), "fraggle_io_write_frame nf90_put_var particle_type_varid" ) + call check( nf90_put_var(nc%id, nc%rh_varid, pl%rh(:,i), start=[1, idslot, stage, eslot], count=[NDIM,1,1,1]), "fraggle_io_write_frame nf90_put_var rh_varid" ) + call check( nf90_put_var(nc%id, nc%vh_varid, pl%vh(:,i), start=[1, idslot, stage, eslot], count=[NDIM,1,1,1]), "fraggle_io_write_frame nf90_put_var vh_varid" ) + call check( nf90_put_var(nc%id, nc%Gmass_varid, pl%Gmass(i), start=[ idslot, stage, eslot]), "fraggle_io_write_frame nf90_put_var Gmass_varid" ) + call check( nf90_put_var(nc%id, nc%radius_varid, pl%radius(i), start=[ idslot, stage, eslot]), "fraggle_io_write_frame nf90_put_var radius_varid" ) + call check( nf90_put_var(nc%id, nc%Ip_varid, pl%Ip(:,i), start=[1, idslot, stage, eslot], count=[NDIM,1,1,1]), "fraggle_io_write_frame nf90_put_var Ip_varid" ) + call check( nf90_put_var(nc%id, nc%rot_varid, pl%rot(:,i), start=[1, idslot, stage, eslot], count=[NDIM,1,1,1]), "fraggle_io_write_frame nf90_put_var rotx_varid" ) + end do end do - end do - call check( nf90_put_var(nc%id, nc%ke_orb_varid, fragments%ke_orbit_before, start=[ 1, eslot]), "fraggle_io_write_frame nf90_put_var ke_orb_varid before" ) - call check( nf90_put_var(nc%id, nc%ke_orb_varid, fragments%ke_orbit_after, start=[ 2, eslot]), "fraggle_io_write_frame nf90_put_var ke_orb_varid after" ) - call check( nf90_put_var(nc%id, nc%pe_varid, fragments%pe_before, start=[ 1, eslot]), "fraggle_io_write_frame nf90_put_var pe_varid before" ) - call check( nf90_put_var(nc%id, nc%pe_varid, fragments%pe_after, start=[ 2, eslot]), "fraggle_io_write_frame nf90_put_var pe_varid after" ) - call check( nf90_put_var(nc%id, nc%L_orb_varid, fragments%Lorbit_before(:), start=[1, 1, eslot], count=[NDIM, 1, 1]), "fraggle_io_write_frame nf90_put_var L_orb_varid before" ) - call check( nf90_put_var(nc%id, nc%L_orb_varid, fragments%Lorbit_after(:), start=[1, 2, eslot], count=[NDIM, 1, 1]), "fraggle_io_write_frame nf90_put_var L_orb_varid after" ) - call check( nf90_put_var(nc%id, nc%L_spin_varid, fragments%Lspin_before(:), start=[1, 1, eslot], count=[NDIM, 1, 1]), "fraggle_io_write_frame nf90_put_var L_spin_varid before" ) - call check( nf90_put_var(nc%id, nc%L_spin_varid, fragments%Lspin_after(:), start=[1, 2, eslot], count=[NDIM, 1, 1]), "fraggle_io_write_frame nf90_put_var L_spin_varid after" ) - - call check( nf90_set_fill(nc%id, old_mode, old_mode) ) + call check( nf90_put_var(nc%id, nc%ke_orb_varid, fragments%ke_orbit_before, start=[ 1, eslot]), "fraggle_io_write_frame nf90_put_var ke_orb_varid before" ) + call check( nf90_put_var(nc%id, nc%ke_orb_varid, fragments%ke_orbit_after, start=[ 2, eslot]), "fraggle_io_write_frame nf90_put_var ke_orb_varid after" ) + call check( nf90_put_var(nc%id, nc%pe_varid, fragments%pe_before, start=[ 1, eslot]), "fraggle_io_write_frame nf90_put_var pe_varid before" ) + call check( nf90_put_var(nc%id, nc%pe_varid, fragments%pe_after, start=[ 2, eslot]), "fraggle_io_write_frame nf90_put_var pe_varid after" ) + call check( nf90_put_var(nc%id, nc%L_orb_varid, fragments%Lorbit_before(:), start=[1, 1, eslot], count=[NDIM, 1, 1]), "fraggle_io_write_frame nf90_put_var L_orb_varid before" ) + call check( nf90_put_var(nc%id, nc%L_orb_varid, fragments%Lorbit_after(:), start=[1, 2, eslot], count=[NDIM, 1, 1]), "fraggle_io_write_frame nf90_put_var L_orb_varid after" ) + call check( nf90_put_var(nc%id, nc%L_spin_varid, fragments%Lspin_before(:), start=[1, 1, eslot], count=[NDIM, 1, 1]), "fraggle_io_write_frame nf90_put_var L_spin_varid before" ) + call check( nf90_put_var(nc%id, nc%L_spin_varid, fragments%Lspin_after(:), start=[1, 2, eslot], count=[NDIM, 1, 1]), "fraggle_io_write_frame nf90_put_var L_spin_varid after" ) + + call check( nf90_set_fill(nc%id, old_mode, old_mode) ) + end select end select - - end associate + end associate return end subroutine fraggle_io_write_frame diff --git a/src/io/io.f90 b/src/io/io.f90 index 3d694e027..af4b30442 100644 --- a/src/io/io.f90 +++ b/src/io/io.f90 @@ -130,7 +130,7 @@ module subroutine io_conservation_report(self, param, lterminal) "; D(Eorbit+Ecollisions)/|E0| = ", ES12.5, & "; DM/M0 = ", ES12.5)' - associate(system => self, pl => self%pl, cb => self%cb, npl => self%pl%nbody, display_unit => param%display_unit) + associate(system => self, pl => self%pl, cb => self%cb, npl => self%pl%nbody, display_unit => param%display_unit, nc => param%system_history%nc) call pl%vb2vh(cb) call pl%xh2xb(cb) @@ -177,8 +177,8 @@ module subroutine io_conservation_report(self, param, lterminal) write(*,*) "Severe error! Mass not conserved! Halting!" ! Save the frame of data to the bin file in the slot just after the present one for diagnostics param%ioutput = param%ioutput + 1 - call self%write_frame(param%nc, param) - call param%nc%close() + call self%write_frame(nc, param) + call nc%close() call util_exit(FAILURE) end if end if @@ -246,20 +246,22 @@ module subroutine io_dump_system(self, param) dump_param%out_stat = 'APPEND' dump_param%in_type = "NETCDF_DOUBLE" dump_param%in_netcdf = trim(adjustl(DUMP_NC_FILE(idx))) - dump_param%nc%id_chunk = self%pl%nbody + self%tp%nbody - dump_param%nc%time_chunk = 1 - dump_param%tstart = self%t - - call dump_param%dump(param_file_name) - - dump_param%out_form = "XV" - dump_param%nc%file_name = trim(adjustl(DUMP_NC_FILE(idx))) - dump_param%ioutput = 1 - call dump_param%nc%initialize(dump_param) - call self%write_frame(dump_param%nc, dump_param) - call dump_param%nc%close() - ! Syncrhonize the disk and memory buffer of the NetCDF file (e.g. commit the frame files stored in memory to disk) - call param%nc%flush(param) + associate(nc => dump_param%system_history%nc) + nc%id_chunk = self%pl%nbody + self%tp%nbody + nc%time_chunk = 1 + dump_param%tstart = self%t + + call dump_param%dump(param_file_name) + + dump_param%out_form = "XV" + nc%file_name = trim(adjustl(DUMP_NC_FILE(idx))) + dump_param%ioutput = 1 + call nc%initialize(dump_param) + call self%write_frame(nc, dump_param) + call nc%close() + ! Syncrhonize the disk and memory buffer of the NetCDF file (e.g. commit the frame files stored in memory to disk) + call nc%flush(param) + end associate idx = idx + 1 if (idx > NDUMPFILES) idx = 1 @@ -267,14 +269,13 @@ module subroutine io_dump_system(self, param) ! Dump the encounter history if necessary select type(param) class is (symba_parameters) - if (param%lencounter_save) then - select type(self) - class is (symba_nbody_system) - call self%dump_encounter(param) - end select - end if + call param%encounter_history%dump(param) + call param%collision_history%dump(param) end select + ! Dump the system history to file + call param%system_history%dump(param) + return end subroutine io_dump_system @@ -1314,13 +1315,13 @@ module subroutine io_read_in_system(self, param) self%Euntracked = param%Euntracked else allocate(tmp_param, source=param) - tmp_param%nc%file_name = param%in_netcdf + tmp_param%system_history%nc%file_name = param%in_netcdf tmp_param%out_form = param%in_form if (.not. param%lrestart) then ! Turn off energy computation so we don't have to feed it into the initial conditions tmp_param%lenergy = .false. end if - ierr = self%read_frame(tmp_param%nc, tmp_param) + ierr = self%read_frame(tmp_param%system_history%nc, tmp_param) deallocate(tmp_param) if (ierr /=0) call util_exit(FAILURE) end if @@ -1549,32 +1550,34 @@ module subroutine io_write_frame_system(self, param) character(len=STRMAX) :: errmsg logical :: fileExists - param%nc%id_chunk = self%pl%nbody + self%tp%nbody - param%nc%time_chunk = max(param%dump_cadence / param%istep_out, 1) - param%nc%file_name = param%outfile - if (lfirst) then - inquire(file=param%outfile, exist=fileExists) - - select case(param%out_stat) - case('APPEND') - if (.not.fileExists) then - errmsg = param%outfile // " not found! You must specify OUT_STAT = NEW, REPLACE, or UNKNOWN" - goto 667 - end if - case('NEW') - if (fileExists) then - errmsg = param%outfile // " Alread Exists! You must specify OUT_STAT = APPEND, REPLACE, or UNKNOWN" - goto 667 - end if - call param%nc%initialize(param) - case('REPLACE', 'UNKNOWN') - call param%nc%initialize(param) - end select + associate (nc => param%system_history%nc, pl => self%pl, tp => self%tp, npl => self%pl%nbody, ntp => self%tp%nbody) + nc%id_chunk = npl + ntp + nc%time_chunk = max(param%dump_cadence / param%istep_out, 1) + nc%file_name = param%outfile + if (lfirst) then + inquire(file=param%outfile, exist=fileExists) + + select case(param%out_stat) + case('APPEND') + if (.not.fileExists) then + errmsg = param%outfile // " not found! You must specify OUT_STAT = NEW, REPLACE, or UNKNOWN" + goto 667 + end if + case('NEW') + if (fileExists) then + errmsg = param%outfile // " Alread Exists! You must specify OUT_STAT = APPEND, REPLACE, or UNKNOWN" + goto 667 + end if + call nc%initialize(param) + case('REPLACE', 'UNKNOWN') + call nc%initialize(param) + end select - lfirst = .false. - end if + lfirst = .false. + end if - call self%write_frame(param%nc, param) + call self%write_frame(nc, param) + end associate return diff --git a/src/main/swiftest_driver.f90 b/src/main/swiftest_driver.f90 index 803ca6849..cab6d4aca 100644 --- a/src/main/swiftest_driver.f90 +++ b/src/main/swiftest_driver.f90 @@ -21,7 +21,7 @@ program swiftest_driver class(swiftest_nbody_system), allocatable :: 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 :: 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 @@ -38,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) @@ -73,7 +73,6 @@ program swiftest_driver ! 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) ! Construct the main n-body system using the user-input integrator to choose the type of system call setup_construct_system(system, param) @@ -88,84 +87,86 @@ program swiftest_driver call system%initialize(param) - ! 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 - if (param%lenergy) call system%conservation_report(param, lterminal=.true.) - else - if (param%lenergy) call system%conservation_report(param, lterminal=.false.) ! This will save the initial values of energy and momentum - call system_history%take_snapshot(system) - call system_history%dump(param) - end if - call system%dump(param) - - write(display_unit, *) " *************** Main Loop *************** " - - if (display_style == "PROGRESS") then - call pbar%reset(nloops) - write(pbarmessage,fmt=pbarfmt) t0, tstop - call pbar%update(1,message=pbarmessage) - else if (display_style == "COMPACT") then - write(*,*) "SWIFTEST START " // param%integrator - call system%compact_output(param,integration_timer) - end if - - iout = 0 - idump = 0 - system%t = tstart - do iloop = istart, nloops - !> Step the system forward in time - call integration_timer%start() - call system%step(param, system%t, dt) - call integration_timer%stop() - - system%t = t0 + iloop * dt - - !> Evaluate any discards or collisional outcomes - call system%discard(param) - if (display_style == "PROGRESS") call pbar%update(iloop) - - !> If the loop counter is at the output cadence value, append the data file with a single frame - if (istep_out > 0) then - iout = iout + 1 - if (iout == istep_out) then - iout = 0 - idump = idump + 1 - call system_history%take_snapshot(system) - - if (idump == dump_cadence) then - idump = 0 - call system%dump(param) - call system_history%dump(param) - end if + associate (system_history => param%system_history) + ! If this is a new run, compute energy initial conditions (if energy tracking is turned on) and write the initial conditions to file. + if (param%lrestart) then + if (param%lenergy) call system%conservation_report(param, lterminal=.true.) + else + if (param%lenergy) call system%conservation_report(param, lterminal=.false.) ! This will save the initial values of energy and momentum + call system_history%take_snapshot(param,system) + call system_history%dump(param) + end if + call system%dump(param) - tfrac = (system%t - t0) / (tstop - t0) - - select type(pl => system%pl) - class is (symba_pl) - write(display_unit, symbastatfmt) system%t, tfrac, pl%nplm, pl%nbody, system%tp%nbody - class default - write(display_unit, statusfmt) system%t, tfrac, pl%nbody, system%tp%nbody - end select - if (param%lenergy) call system%conservation_report(param, lterminal=.true.) - call integration_timer%report(message="Integration steps:", unit=display_unit, nsubsteps=istep_out) - - if (display_style == "PROGRESS") then - write(pbarmessage,fmt=pbarfmt) system%t, tstop - call pbar%update(1,message=pbarmessage) - else if (display_style == "COMPACT") then - call system%compact_output(param,integration_timer) - end if + write(display_unit, *) " *************** Main Loop *************** " - call integration_timer%reset() + if (display_style == "PROGRESS") then + call pbar%reset(nloops) + write(pbarmessage,fmt=pbarfmt) t0, tstop + call pbar%update(1,message=pbarmessage) + else if (display_style == "COMPACT") then + write(*,*) "SWIFTEST START " // param%integrator + call system%compact_output(param,integration_timer) + end if + iout = 0 + idump = 0 + system%t = tstart + do iloop = istart, nloops + !> Step the system forward in time + call integration_timer%start() + call system%step(param, system%t, dt) + call integration_timer%stop() + + system%t = t0 + iloop * dt + + !> Evaluate any discards or collisional outcomes + call system%discard(param) + if (display_style == "PROGRESS") call pbar%update(iloop) + + !> If the loop counter is at the output cadence value, append the data file with a single frame + if (istep_out > 0) then + iout = iout + 1 + if (iout == istep_out) then + iout = 0 + idump = idump + 1 + call system_history%take_snapshot(param,system) + + if (idump == dump_cadence) then + idump = 0 + call system%dump(param) + + end if + + tfrac = (system%t - t0) / (tstop - t0) + + select type(pl => system%pl) + class is (symba_pl) + write(display_unit, symbastatfmt) system%t, tfrac, pl%nplm, pl%nbody, system%tp%nbody + class default + write(display_unit, statusfmt) system%t, tfrac, pl%nbody, system%tp%nbody + end select + if (param%lenergy) call system%conservation_report(param, lterminal=.true.) + call integration_timer%report(message="Integration steps:", unit=display_unit, nsubsteps=istep_out) + + if (display_style == "PROGRESS") then + write(pbarmessage,fmt=pbarfmt) system%t, tstop + call pbar%update(1,message=pbarmessage) + else if (display_style == "COMPACT") then + call system%compact_output(param,integration_timer) + end if + + call integration_timer%reset() + + end if end if - end if - end do - ! Dump any remaining history if it exists - call system%dump(param) - call system_history%dump(param) - if (display_style == "COMPACT") write(*,*) "SWIFTEST STOP" // param%integrator + end do + ! Dump any remaining history if it exists + call system%dump(param) + call system_history%dump(param) + if (display_style == "COMPACT") write(*,*) "SWIFTEST STOP" // param%integrator + end associate end associate call util_exit(SUCCESS) diff --git a/src/modules/encounter_classes.f90 b/src/modules/encounter_classes.f90 index b1b7bb079..d339b6660 100644 --- a/src/modules/encounter_classes.f90 +++ b/src/modules/encounter_classes.f90 @@ -64,24 +64,24 @@ module encounter_classes procedure :: initialize => encounter_io_initialize !! Initialize a set of parameters used to identify a NetCDF output object end type encounter_io_parameters - !> A class that that is used to store simulation history data between file output - type, extends(swiftest_storage) :: encounter_storage - class(encounter_io_parameters), allocatable :: nc !! NetCDF parameter object containing the details about the file attached to this storage object - contains - procedure :: dump => encounter_io_dump_storage !! Dumps contents of encounter history to file - procedure :: make_index_map => encounter_util_index_map_storage !! Maps body id values to storage index values so we don't have to use unlimited dimensions for id - final :: encounter_util_final_storage - end type encounter_storage - !> A class that that is used to store simulation history data between file output type, extends(swiftest_storage) :: collision_storage - class(encounter_io_parameters), allocatable :: nc !! NetCDF parameter object containing the details about the file attached to this storage object contains - procedure :: dump => encounter_io_dump_collision_storage !! Dumps contents of encounter history to file + procedure :: dump => encounter_io_dump_collision !! Dumps contents of encounter history to file procedure :: make_index_map => encounter_util_index_map_collision_storage !! Maps body id values to storage index values so we don't have to use unlimited dimensions for id + procedure :: take_snapshot => encounter_util_snapshot_collision !! Take a minimal snapshot of the system through an encounter final :: encounter_util_final_collision_storage end type collision_storage + !> A class that that is used to store simulation history data between file output + type, extends(swiftest_storage) :: encounter_storage + contains + procedure :: dump => encounter_io_dump_encounter !! Dumps contents of encounter history to file + procedure :: make_index_map => encounter_util_index_map_storage !! Maps body id values to storage index values so we don't have to use unlimited dimensions for id + procedure :: take_snapshot => encounter_util_snapshot_encounter !! Take a minimal snapshot of the system through an encounter + final :: encounter_util_final_storage + 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) @@ -214,17 +214,17 @@ 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_dump_collision_storage(self, param) + module subroutine encounter_io_dump_collision(self, param) implicit none class(collision_storage(*)), intent(inout) :: self !! Collision storage object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - end subroutine encounter_io_dump_collision_storage + end subroutine encounter_io_dump_collision - module subroutine encounter_io_dump_storage(self, param) + module subroutine encounter_io_dump_encounter(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 + end subroutine encounter_io_dump_encounter module subroutine encounter_io_initialize(self, param) implicit none @@ -234,9 +234,9 @@ end subroutine encounter_io_initialize module subroutine encounter_io_write_frame(self, nc, param) implicit none - class(encounter_snapshot), intent(in) :: self !! Swiftest encounter structure - class(encounter_io_parameters), intent(inout) :: nc !! Parameters used to identify a particular encounter io NetCDF dataset - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + class(encounter_snapshot), intent(in) :: self !! Swiftest encounter structure + class(netcdf_parameters), intent(inout) :: nc !! 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) @@ -316,6 +316,25 @@ module subroutine encounter_util_resize_list(self, nnew) integer(I8B), intent(in) :: nnew !! New size of list needed end subroutine encounter_util_resize_list + module subroutine encounter_util_snapshot_collision(self, param, system, t, arg) + implicit none + class(collision_storage(*)), intent(inout) :: self !! Swiftest storage object + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object to store + real(DP), intent(in), optional :: t !! Time of snapshot if different from system time + character(*), intent(in), optional :: arg !! Optional argument (needed for extended storage type used in collision snapshots) + end subroutine encounter_util_snapshot_collision + + module subroutine encounter_util_snapshot_encounter(self, param, system, t, arg) + implicit none + class(encounter_storage(*)), intent(inout) :: self !! Swiftest storage object + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object to store + real(DP), intent(in), optional :: t !! Time of snapshot if different from system time + character(*), intent(in), optional :: arg !! Optional argument (needed for extended storage type used in collision snapshots) + end subroutine encounter_util_snapshot_encounter + + module subroutine encounter_util_spill_list(self, discards, lspill_list, ldestructive) implicit none class(encounter_list), intent(inout) :: self !! Swiftest encounter list diff --git a/src/modules/fraggle_classes.f90 b/src/modules/fraggle_classes.f90 index 8d8e1c33e..2bd120b83 100644 --- a/src/modules/fraggle_classes.f90 +++ b/src/modules/fraggle_classes.f90 @@ -160,9 +160,9 @@ end subroutine fraggle_io_initialize_output module subroutine fraggle_io_write_frame(self, nc, param) implicit none - class(fraggle_collision_snapshot), intent(in) :: self !! Swiftest encounter structure - class(encounter_io_parameters), intent(inout) :: nc !! Parameters used to identify a particular encounter io NetCDF dataset - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + class(fraggle_collision_snapshot), intent(in) :: self !! Swiftest encounter structure + class(netcdf_parameters), intent(inout) :: nc !! Parameters used to identify a particular encounter io NetCDF dataset + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters end subroutine fraggle_io_write_frame module subroutine fraggle_io_log_pl(pl, param) diff --git a/src/modules/swiftest_classes.f90 b/src/modules/swiftest_classes.f90 index 4894e305d..b89e9eee8 100644 --- a/src/modules/swiftest_classes.f90 +++ b/src/modules/swiftest_classes.f90 @@ -162,6 +162,7 @@ module swiftest_classes integer(I4B) :: nt !! Number of unique time values in all saved snapshots real(DP), dimension(:), allocatable :: tvals !! The set of unique time values contained in the snapshots integer(I4B), dimension(:), allocatable :: tmap !! The t value -> index map + class(netcdf_parameters), allocatable :: nc !! NetCDF object attached to this storage object contains procedure :: dump => io_dump_storage !! Dumps storage object contents to file procedure :: make_index_map => util_index_map_storage !! Maps body id values to storage index values so we don't have to use unlimited dimensions for id @@ -255,8 +256,7 @@ module swiftest_classes logical :: lgr = .false. !! Turn on GR logical :: lyarkovsky = .false. !! Turn on Yarkovsky effect logical :: lyorp = .false. !! Turn on YORP effect - - type(netcdf_parameters) :: nc !! Object containing NetCDF parameters + type(swiftest_storage(nframes=:)), allocatable :: system_history contains procedure :: reader => io_param_reader procedure :: writer => io_param_writer @@ -1692,10 +1692,13 @@ module subroutine util_set_rhill_approximate(self,cb) class(swiftest_cb), intent(inout) :: cb !! Swiftest central body object end subroutine util_set_rhill_approximate - module subroutine util_snapshot_system(self, system) + module subroutine util_snapshot_system(self, param, system, t, arg) implicit none - class(swiftest_storage(*)), intent(inout) :: self !! Swiftest storage object - class(swiftest_nbody_system), intent(in) :: system !! Swiftest nbody system object to store + class(swiftest_storage(*)), intent(inout) :: self !! Swiftest storage object + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object to store + real(DP), intent(in), optional :: t !! Time of snapshot if different from system time + character(*), intent(in), optional :: arg !! Optional argument (needed for extended storage type used in collision snapshots) end subroutine util_snapshot_system end interface diff --git a/src/modules/symba_classes.f90 b/src/modules/symba_classes.f90 index ff2597b5f..3dbcfb90f 100644 --- a/src/modules/symba_classes.f90 +++ b/src/modules/symba_classes.f90 @@ -33,6 +33,8 @@ module symba_classes character(STRMAX) :: encounter_save = "NONE" !! Indicate if and how encounter data should be saved character(STRMAX) :: collision_save = "NONE" !! Indicate if and how fragmentation data should be saved logical :: lencounter_save = .false. !! Turns on encounter saving + type(encounter_storage(nframes=:)), allocatable :: encounter_history !! Stores encounter history for later retrieval and saving to file + type(collision_storage(nframes=:)), allocatable :: collision_history !! Stores encounter history for later retrieval and saving to file contains procedure :: reader => symba_io_param_reader procedure :: writer => symba_io_param_writer @@ -191,8 +193,6 @@ module symba_classes integer(I4B) :: irec !! System recursion level class(fraggle_colliders), allocatable :: colliders !! Fraggle colliders object class(fraggle_fragments), allocatable :: fragments !! Fraggle fragmentation system object - type(encounter_storage(nframes=:)), allocatable :: encounter_history !! Stores encounter history for later retrieval and saving to file - type(collision_storage(nframes=:)), allocatable :: collision_history !! Stores encounter history for later retrieval and saving to file 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 @@ -201,9 +201,6 @@ module symba_classes procedure :: set_recur_levels => symba_step_set_recur_levels_system !! Sets recursion levels of bodies and encounter lists to the current system level procedure :: recursive_step => symba_step_recur_system !! Step interacting planets and active test particles ahead in democratic heliocentric coordinates at the current recursion level, if applicable, and descend to the next deeper level if necessary procedure :: reset => symba_step_reset_system !! Resets pl, tp,and encounter structures at the start of a new step - procedure :: encounter_snap => symba_util_take_encounter_snapshot !! Take a minimal snapshot of the system through an encounter - procedure :: collision_snap => symba_util_take_collision_snapshot !! Take a minimal snapshot of the system before and after a collision - procedure :: dump_encounter => symba_io_dump_encounter !! Saves the encounter and/or fragmentation data to file(s) final :: symba_util_final_system !! Finalizes the SyMBA nbody system object - deallocates all allocatables end type symba_nbody_system @@ -373,22 +370,6 @@ module subroutine symba_util_set_renc(self, scale) integer(I4B), intent(in) :: scale !! Current recursion depth end subroutine symba_util_set_renc - module subroutine symba_util_take_collision_snapshot(self, param, t, stage) - implicit none - class(symba_nbody_system), intent(inout) :: self !! SyMBA nbody system object - class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters - real(DP), intent(in) :: t !! current time - character(*), intent(in) :: stage !! Either before or afte - end subroutine symba_util_take_collision_snapshot - - module subroutine symba_util_take_encounter_snapshot(self, param, t) - use swiftest_classes, only : swiftest_parameters - implicit none - class(symba_nbody_system), intent(inout) :: self !! SyMBA nbody system object - class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters - real(DP), intent(in) :: t !! current time - end subroutine symba_util_take_encounter_snapshot - module subroutine symba_io_param_reader(self, unit, iotype, v_list, iostat, iomsg) implicit none class(symba_parameters), intent(inout) :: self !! Current run configuration parameters with SyMBA additionss @@ -411,12 +392,6 @@ module subroutine symba_io_param_writer(self, unit, iotype, v_list, iostat, ioms character(len=*), intent(inout) :: iomsg !! Message to pass if iostat /= 0 end subroutine symba_io_param_writer - module subroutine symba_io_dump_encounter(self, param) - implicit none - class(symba_nbody_system), intent(inout) :: self !! SyMBA nbody system object - class(symba_parameters), intent(inout) :: param !! Current run configuration parameters - end subroutine symba_io_dump_encounter - module subroutine symba_io_write_discard(self, param) use swiftest_classes, only : swiftest_parameters implicit none diff --git a/src/netcdf/netcdf.f90 b/src/netcdf/netcdf.f90 index 9bc945227..42e2a2ea6 100644 --- a/src/netcdf/netcdf.f90 +++ b/src/netcdf/netcdf.f90 @@ -80,63 +80,65 @@ module function netcdf_get_old_t_final_system(self, param) result(old_t_final) real(DP), dimension(NDIM) :: rot0, Ip0, Lnow real(DP) :: KE_orb_orig, KE_spin_orig, PE_orig - call param%nc%open(param) - call check( nf90_inquire_dimension(param%nc%id, param%nc%time_dimid, len=itmax), "netcdf_get_old_t_final_system time_dimid" ) - call check( nf90_inquire_dimension(param%nc%id, param%nc%id_dimid, len=idmax), "netcdf_get_old_t_final_system id_dimid" ) - allocate(vals(idmax)) - call check( nf90_get_var(param%nc%id, param%nc%time_varid, rtemp, start=[1], count=[1]), "netcdf_get_old_t_final_system time_varid" ) + associate (nc => param%system_history%nc) + call nc%open(param) + call check( nf90_inquire_dimension(nc%id, nc%time_dimid, len=itmax), "netcdf_get_old_t_final_system time_dimid" ) + call check( nf90_inquire_dimension(nc%id, nc%id_dimid, len=idmax), "netcdf_get_old_t_final_system id_dimid" ) + allocate(vals(idmax)) + call check( nf90_get_var(nc%id, nc%time_varid, rtemp, start=[1], count=[1]), "netcdf_get_old_t_final_system time_varid" ) - !old_t_final = rtemp(1) - old_t_final = param%t0 ! For NetCDF it is safe to overwrite the final t value on a restart + !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%nc%id, param%nc%KE_orb_varid, rtemp, start=[1], count=[1]), "netcdf_get_old_t_final_system KE_orb_varid" ) - KE_orb_orig = rtemp(1) + if (param%lenergy) then + call check( nf90_get_var(nc%id, nc%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%nc%id, param%nc%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(nc%id, nc%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%nc%id, param%nc%PE_varid, rtemp, start=[1], count=[1]), "netcdf_get_old_t_final_system PE_varid" ) - PE_orig = rtemp(1) + call check( nf90_get_var(nc%id, nc%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%nc%id, param%nc%Ecollisions_varid, self%Ecollisions, start=[1]), "netcdf_get_old_t_final_system Ecollisions_varid" ) - call check( nf90_get_var(param%nc%id, param%nc%Euntracked_varid, self%Euntracked, start=[1]), "netcdf_get_old_t_final_system Euntracked_varid" ) + call check( nf90_get_var(nc%id, nc%Ecollisions_varid, self%Ecollisions, start=[1]), "netcdf_get_old_t_final_system Ecollisions_varid" ) + call check( nf90_get_var(nc%id, nc%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 + self%Eorbit_orig = KE_orb_orig + KE_spin_orig + PE_orig + self%Ecollisions + self%Euntracked - call check( nf90_get_var(param%nc%id, param%nc%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%nc%id, param%nc%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%nc%id, param%nc%L_escape_varid, self%Lescape(:), start=[1,1], count=[NDIM,1]), "netcdf_get_old_t_final_system L_escape_varid" ) + call check( nf90_get_var(nc%id, nc%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(nc%id, nc%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(nc%id, nc%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(:) + self%Ltot_orig(:) = self%Lorbit_orig(:) + self%Lspin_orig(:) + self%Lescape(:) - call check( nf90_get_var(param%nc%id, param%nc%Gmass_varid, vals, start=[1,1], count=[idmax,1]), "netcdf_get_old_t_final_system Gmass_varid" ) - call check( nf90_get_var(param%nc%id, param%nc%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 + call check( nf90_get_var(nc%id, nc%Gmass_varid, vals, start=[1,1], count=[idmax,1]), "netcdf_get_old_t_final_system Gmass_varid" ) + call check( nf90_get_var(nc%id, nc%GMescape_varid, self%GMescape, start=[1]), "netcdf_get_old_t_final_system GMescape_varid" ) + self%GMtot_orig = vals(1) + sum(vals(2:idmax), vals(2:idmax) == vals(2:idmax)) + self%GMescape - select type(cb => self%cb) - class is (symba_cb) - cb%GM0 = vals(1) - cb%dGM = cb%Gmass - cb%GM0 + select type(cb => self%cb) + class is (symba_cb) + cb%GM0 = vals(1) + cb%dGM = cb%Gmass - cb%GM0 - call check( nf90_get_var(param%nc%id, param%nc%radius_varid, rtemp, start=[1,1], count=[1,1]), "netcdf_get_old_t_final_system radius_varid" ) - cb%R0 = rtemp(1) + call check( nf90_get_var(nc%id, nc%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 + if (param%lrotation) then - call check( nf90_get_var(param%nc%id, param%nc%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%nc%id, param%nc%Ip_varid, Ip0, start=[1,1,1], count=[NDIM,1,1]), "netcdf_get_old_t_final_system Ip_varid" ) + call check( nf90_get_var(nc%id, nc%rot_varid, rot0, start=[1,1,1], count=[NDIM,1,1]), "netcdf_get_old_t_final_system rot_varid" ) + call check( nf90_get_var(nc%id, nc%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(:) + cb%L0(:) = Ip0(3) * cb%GM0 * cb%R0**2 * rot0(:) - Lnow(:) = cb%Ip(3) * cb%Gmass * cb%radius**2 * cb%rot(:) - cb%dL(:) = Lnow(:) - cb%L0(:) - end if - end select + Lnow(:) = cb%Ip(3) * cb%Gmass * cb%radius**2 * cb%rot(:) + cb%dL(:) = Lnow(:) - cb%L0(:) + end if + end select - end if + end if - deallocate(vals) + deallocate(vals) + end associate return end function netcdf_get_old_t_final_system diff --git a/src/setup/setup.f90 b/src/setup/setup.f90 index a107179a1..64c63b390 100644 --- a/src/setup/setup.f90 +++ b/src/setup/setup.f90 @@ -21,6 +21,10 @@ module subroutine setup_construct_system(system, param) class(swiftest_nbody_system), allocatable, intent(inout) :: system !! Swiftest system object class(swiftest_parameters), intent(inout) :: param !! Swiftest parameters + allocate(swiftest_storage(param%dump_cadence) :: param%system_history) + allocate(netcdf_parameters :: param%system_history%nc) + call param%system_history%reset() + select case(param%integrator) case (BS) write(*,*) 'Bulirsch-Stoer integrator not yet enabled' @@ -72,8 +76,8 @@ module subroutine setup_construct_system(system, param) select type(param) class is (symba_parameters) if (param%lencounter_save) then - allocate(encounter_storage :: system%encounter_history) - associate (encounter_history => system%encounter_history) + allocate(encounter_storage :: param%encounter_history) + associate (encounter_history => param%encounter_history) allocate(encounter_io_parameters :: encounter_history%nc) call encounter_history%reset() select type(nc => encounter_history%nc) @@ -81,9 +85,9 @@ module subroutine setup_construct_system(system, param) nc%file_number = param%iloop / param%dump_cadence end select end associate - - allocate(collision_storage :: system%collision_history) - associate (collision_history => system%collision_history) + + allocate(collision_storage :: param%collision_history) + associate (collision_history => param%collision_history) allocate(fraggle_io_parameters :: collision_history%nc) call collision_history%reset() select type(nc => collision_history%nc) @@ -93,6 +97,8 @@ module subroutine setup_construct_system(system, param) end associate end if end select + + end select case (RINGMOONS) write(*,*) 'RINGMOONS-SyMBA integrator not yet enabled' @@ -101,6 +107,10 @@ module subroutine setup_construct_system(system, param) call util_exit(FAILURE) end select + + + + return end subroutine setup_construct_system @@ -116,7 +126,7 @@ module subroutine setup_finalize_system(self, param) class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters associate(system => self) - call param%nc%close() + call param%system_history%nc%close() end associate return diff --git a/src/symba/symba_collision.f90 b/src/symba/symba_collision.f90 index 95d0dcf4f..ab2962054 100644 --- a/src/symba/symba_collision.f90 +++ b/src/symba/symba_collision.f90 @@ -885,7 +885,7 @@ module subroutine symba_resolve_collision_fragmentations(self, system, param) logical :: lgoodcollision integer(I4B) :: i - associate(plplcollision_list => self, ncollisions => self%nenc, idx1 => self%index1, idx2 => self%index2, t => system%t) + associate(plplcollision_list => self, ncollisions => self%nenc, idx1 => self%index1, idx2 => self%index2, t => system%t, collision_history => param%collision_history) select type(pl => system%pl) class is (symba_pl) select type (cb => system%cb) @@ -900,7 +900,7 @@ module subroutine symba_resolve_collision_fragmentations(self, system, param) call system%colliders%regime(system%fragments, system, param) - if (param%lencounter_save) call system%collision_snap(param, t, "before") + if (param%lencounter_save) call collision_history%take_snapshot(param,system, t, "before") select case (system%fragments%regime) case (COLLRESOLVE_REGIME_DISRUPTION, COLLRESOLVE_REGIME_SUPERCATASTROPHIC) plplcollision_list%status(i) = symba_collision_casedisruption(system, param) @@ -912,7 +912,7 @@ module subroutine symba_resolve_collision_fragmentations(self, system, param) write(*,*) "Error in symba_collision, unrecognized collision regime" call util_exit(FAILURE) end select - if (param%lencounter_save) call system%collision_snap(param, t, "after") + if (param%lencounter_save) call collision_history%take_snapshot(param,system, t, "after") deallocate(system%colliders,system%fragments) end do end select diff --git a/src/symba/symba_io.f90 b/src/symba/symba_io.f90 index d1f36abca..18b56767e 100644 --- a/src/symba/symba_io.f90 +++ b/src/symba/symba_io.f90 @@ -12,51 +12,6 @@ contains - module subroutine symba_io_dump_encounter(self, param) - !! author: David A. Minton - !! - !! Saves the encounter and/or fragmentation data to file with the name of the current output interval number attached - implicit none - ! Arguments - class(symba_nbody_system), intent(inout) :: self !! SyMBA nbody system object - class(symba_parameters), intent(inout) :: param !! Current run configuration parameters - - - associate(encounter_history => self%encounter_history, num_enc_frames => self%encounter_history%iframe,& - collision_history => self%collision_history, num_coll_frames => self%collision_history%iframe) - - select type(nce => self%encounter_history%nc) - class is (encounter_io_parameters) - if (num_enc_frames > 0) then - ! Create and save the output files for this encounter and fragmentation - nce%file_number = nce%file_number + 1 - call encounter_history%make_index_map() - write(nce%file_name, '("encounter_",I0.6,".nc")') nce%file_number - call nce%initialize(param) - call encounter_history%dump(param) - call nce%close() - call encounter_history%reset() - end if - end select - - select type(ncc => self%collision_history%nc) - class is (fraggle_io_parameters) - if (num_coll_frames > 0) then - ncc%file_number = ncc%file_number + 1 - ncc%event_dimsize = num_coll_frames - call collision_history%make_index_map() - write(ncc%file_name, '("collision_",I0.6,".nc")') ncc%file_number - call ncc%initialize(param) - call collision_history%dump(param) - call ncc%close() - call collision_history%reset() - end if - end select - end associate - - return - end subroutine symba_io_dump_encounter - module subroutine symba_io_param_reader(self, unit, iotype, v_list, iostat, iomsg) !! author: The Purdue Swiftest Team - David A. Minton, Carlisle A. Wishard, Jennifer L.L. Pouplin, and Jacob R. Elliott @@ -246,12 +201,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_info(param%nc, param) + if (self%tp_discards%nbody > 0) call self%tp_discards%write_info(param%system_history%nc, param) select type(pl_discards => self%pl_discards) class is (symba_merger) if (pl_discards%nbody == 0) return - call pl_discards%write_info(param%nc, param) + call pl_discards%write_info(param%system_history%nc, param) end select end associate diff --git a/src/symba/symba_step.f90 b/src/symba/symba_step.f90 index dc303b4f7..54e2464d1 100644 --- a/src/symba/symba_step.f90 +++ b/src/symba/symba_step.f90 @@ -34,17 +34,19 @@ module subroutine symba_step_system(self, param, t, dt) class is (symba_tp) select type(param) class is (symba_parameters) - call self%reset(param) - lencounter = pl%encounter_check(param, self, dt, 0) .or. tp%encounter_check(param, self, dt, 0) - if (lencounter) then - if (param%lencounter_save) call self%encounter_snap(param, t) - call self%interp(param, t, dt) - if (param%lencounter_save) call self%encounter_snap(param, t+dt) - else - self%irec = -1 - call helio_step_system(self, param, t, dt) - end if - param%lfirstkick = pl%lfirst + associate(encounter_history => param%encounter_history) + call self%reset(param) + lencounter = pl%encounter_check(param, self, dt, 0) .or. tp%encounter_check(param, self, dt, 0) + if (lencounter) then + if (param%lencounter_save) call encounter_history%take_snapshot(param, self, t) + call self%interp(param, t, dt) + if (param%lencounter_save) call encounter_history%take_snapshot(param, self, t+dt) + else + self%irec = -1 + call helio_step_system(self, param, t, dt) + end if + param%lfirstkick = pl%lfirst + end associate end select end select end select @@ -180,14 +182,15 @@ recursive module subroutine symba_step_recur_system(self, param, t, ireci) real(DP) :: dtl, dth logical :: lencounter - associate(system => self, plplenc_list => self%plplenc_list, pltpenc_list => self%pltpenc_list, & - lplpl_collision => self%plplenc_list%lcollision, lpltp_collision => self%pltpenc_list%lcollision) - select type(param) - class is (symba_parameters) - select type(pl => self%pl) - class is (symba_pl) - select type(tp => self%tp) - class is (symba_tp) + select type(param) + class is (symba_parameters) + select type(pl => self%pl) + class is (symba_pl) + select type(tp => self%tp) + class is (symba_tp) + associate(system => self, plplenc_list => self%plplenc_list, pltpenc_list => self%pltpenc_list, & + lplpl_collision => self%plplenc_list%lcollision, lpltp_collision => self%pltpenc_list%lcollision, & + encounter_history => param%encounter_history) system%irec = ireci dtl = param%dt / (NTENC**ireci) dth = 0.5_DP * dtl @@ -244,15 +247,15 @@ recursive module subroutine symba_step_recur_system(self, param, t, ireci) if (lplpl_collision) call plplenc_list%resolve_collision(system, param, t+dtl, dtl, ireci) if (lpltp_collision) call pltpenc_list%resolve_collision(system, param, t+dtl, dtl, ireci) end if - if (param%lencounter_save) call system%encounter_snap(param, t+dtl) + if (param%lencounter_save) call encounter_history%take_snapshot(param, self, t+dtl) call self%set_recur_levels(ireci) end do - end select + end associate end select end select - end associate + end select return end subroutine symba_step_recur_system diff --git a/src/symba/symba_util.f90 b/src/symba/symba_util.f90 index 4381ce93b..9443d658c 100644 --- a/src/symba/symba_util.f90 +++ b/src/symba/symba_util.f90 @@ -667,7 +667,7 @@ module subroutine symba_util_rearray_pl(self, system, param) end where end select - call pl%write_info(param%nc, param) + call pl%write_info(param%system_history%nc, param) deallocate(ldump_mask) ! Reindex the new list of bodies @@ -868,100 +868,6 @@ module subroutine symba_util_resize_pl(self, nnew) return end subroutine symba_util_resize_pl - - subroutine symba_util_save_collision(system, snapshot) - !! author: David A. Minton - !! - !! Checks the current size of the encounter storage against the required size and extends it by a factor of 2 more than requested if it is too small. - !! Note: The reason to extend it by a factor of 2 is for performance. When there are many enounters per step, resizing every time you want to add an - !! encounter takes significant computational effort. Resizing by a factor of 2 is a tradeoff between performance (fewer resize calls) and memory managment - !! Memory usage grows by a factor of 2 each time it fills up, but no more. - implicit none - ! Arguments - type(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object - class(encounter_snapshot), intent(in) :: snapshot !! Encounter snapshot object - ! Internals - type(collision_storage(nframes=:)), allocatable :: tmp - integer(I4B) :: i, nnew, nold, nbig - - ! Advance the snapshot frame counter - system%collision_history%iframe = system%collision_history%iframe + 1 - - ! Check to make sure the current encounter_history object is big enough. If not, grow it by a factor of 2 - nnew = system%collision_history%iframe - nold = system%collision_history%nframes - - if (nnew > nold) then - nbig = nold - do while (nbig < nnew) - nbig = nbig * 2 - end do - allocate(collision_storage(nbig) :: tmp) - tmp%iframe = system%collision_history%iframe - call move_alloc(system%collision_history%nc, tmp%nc) - - do i = 1, nold - if (allocated(system%collision_history%frame(i)%item)) call move_alloc(system%collision_history%frame(i)%item, tmp%frame(i)%item) - end do - deallocate(system%collision_history) - call move_alloc(tmp,system%collision_history) - nnew = nbig - end if - - system%collision_history%frame(nnew) = snapshot - - return - end subroutine symba_util_save_collision - - - subroutine symba_util_save_encounter(system, snapshot, t) - !! 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 - type(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object - class(encounter_snapshot), intent(in) :: snapshot !! Encounter snapshot object - real(DP), intent(in) :: t !! The time of the snapshot - ! Internals - type(encounter_storage(nframes=:)), allocatable :: tmp - integer(I4B) :: i, nnew, nold, nbig - - ! Advance the snapshot frame counter - system%encounter_history%iframe = system%encounter_history%iframe + 1 - - ! Check to make sure the current encounter_history object is big enough. If not, grow it by a factor of 2 - nnew = system%encounter_history%iframe - nold = system%encounter_history%nframes - - if (nnew > nold) then - nbig = nold - do while (nbig < nnew) - nbig = nbig * 2 - end do - allocate(encounter_storage(nbig) :: tmp) - tmp%iframe = system%encounter_history%iframe - call move_alloc(system%encounter_history%nc, tmp%nc) - - do i = 1, nold - if (allocated(system%encounter_history%frame(i)%item)) call move_alloc(system%encounter_history%frame(i)%item, tmp%frame(i)%item) - end do - deallocate(system%encounter_history) - call move_alloc(tmp,system%encounter_history) - nnew = nbig - end if - - ! Find out which time slot this belongs in by searching for an existing slot - ! with the same value of time or the first available one - system%encounter_history%frame(nnew) = snapshot - - return - end subroutine symba_util_save_encounter - - module subroutine symba_util_resize_tp(self, nnew) !! author: David A. Minton !! @@ -1320,156 +1226,5 @@ module subroutine symba_util_spill_tp(self, discards, lspill_list, ldestructive) end subroutine symba_util_spill_tp - module subroutine symba_util_take_collision_snapshot(self, param, t, stage) - !! author: David A. Minton - !! - !! Takes a minimal snapshot of the state of the system during an encounter so that the trajectories - !! can be played back through the encounter - implicit none - ! Internals - class(symba_nbody_system), intent(inout) :: self !! SyMBA nbody system object - class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters - real(DP), intent(in) :: t !! current time - character(*), intent(in) :: stage !! Either before or after - ! Arguments - class(fraggle_collision_snapshot), allocatable :: snapshot - type(symba_pl) :: pl - integer(I4B) :: i,j - - select case(stage) - case("before") - ! Saves the states of the bodies involved in the collision before the collision is resolved - associate (idx => self%colliders%idx, ncoll => self%colliders%ncoll) - !allocate(symba_pl :: self%colliders%pl) - !select type(pl => self%colliders%pl) - !class is (symba_pl) - call pl%setup(ncoll, param) - pl%id(:) = self%pl%id(idx(:)) - pl%Gmass(:) = self%pl%Gmass(idx(:)) - pl%radius(:) = self%pl%radius(idx(:)) - pl%rot(:,:) = self%pl%rot(:,idx(:)) - pl%Ip(:,:) = self%pl%Ip(:,idx(:)) - pl%rh(:,:) = self%pl%rh(:,idx(:)) - pl%vh(:,:) = self%pl%vh(:,idx(:)) - pl%info(:) = self%pl%info(idx(:)) - !end select - allocate(self%colliders%pl, source=pl) - end associate - case("after") - allocate(fraggle_collision_snapshot :: snapshot) - allocate(snapshot%colliders, source=self%colliders) - allocate(snapshot%fragments, source=self%fragments) - call symba_util_save_collision(self,snapshot) - end select - - return - end subroutine symba_util_take_collision_snapshot - - - module subroutine symba_util_take_encounter_snapshot(self, param, t) - !! author: David A. Minton - !! - !! Takes a minimal snapshot of the state of the system during an encounter so that the trajectories - !! can be played back through the encounter - implicit none - ! Internals - class(symba_nbody_system), intent(inout) :: self !! SyMBA nbody system object - class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters - real(DP), intent(in) :: t !! current time - ! Arguments - class(encounter_snapshot), allocatable :: snapshot - integer(I4B) :: i, npl_snap, ntp_snap - - associate(npl => self%pl%nbody, ntp => self%tp%nbody) - - allocate(encounter_snapshot :: snapshot) - snapshot%t = t - snapshot%iloop = param%iloop - - if (npl + ntp == 0) return - npl_snap = npl - ntp_snap = ntp - - select type (pl => self%pl) - class is (symba_pl) - select type (tp => self%tp) - class is (symba_tp) - allocate(symba_pl :: snapshot%pl) - allocate(symba_tp :: snapshot%tp) - - select type(pl_snap => snapshot%pl) - class is (symba_pl) - select type(tp_snap => snapshot%tp) - class is (symba_tp) - - if (npl > 0) then - pl%lmask(1:npl) = pl%status(1:npl) /= INACTIVE .and. pl%levelg(1:npl) == self%irec - npl_snap = count(pl%lmask(1:npl)) - end if - if (ntp > 0) then - tp%lmask(1:ntp) = tp%status(1:ntp) /= INACTIVE .and. tp%levelg(1:ntp) == self%irec - ntp_snap = count(tp%lmask(1:ntp)) - end if - pl_snap%nbody = npl_snap - - ! Take snapshot of the currently encountering massive bodies - if (npl_snap > 0) then - allocate(pl_snap%id(npl_snap)) - allocate(pl_snap%info(npl_snap)) - allocate(pl_snap%Gmass(npl_snap)) - - allocate(pl_snap%levelg(npl_snap)) - pl_snap%levelg(:) = pack(pl%levelg(1:npl), pl%lmask(1:npl)) - pl_snap%id(:) = pack(pl%id(1:npl), pl%lmask(1:npl)) - pl_snap%info(:) = pack(pl%info(1:npl), pl%lmask(1:npl)) - pl_snap%Gmass(:) = pack(pl%Gmass(1:npl), pl%lmask(1:npl)) - allocate(pl_snap%rh(NDIM,npl_snap)) - allocate(pl_snap%vh(NDIM,npl_snap)) - do i = 1, NDIM - pl_snap%rh(i,:) = pack(pl%rh(i,1:npl), pl%lmask(1:npl)) - pl_snap%vh(i,:) = pack(pl%vb(i,1:npl), pl%lmask(1:npl)) - end do - if (param%lclose) then - allocate(pl_snap%radius(npl_snap)) - pl_snap%radius(:) = pack(pl%radius(1:npl), pl%lmask(1:npl)) - end if - - if (param%lrotation) then - allocate(pl_snap%Ip(NDIM,npl_snap)) - allocate(pl_snap%rot(NDIM,npl_snap)) - do i = 1, NDIM - pl_snap%Ip(i,:) = pack(pl%Ip(i,1:npl), pl%lmask(1:npl)) - pl_snap%rot(i,:) = pack(pl%rot(i,1:npl), pl%lmask(1:npl)) - end do - end if - call pl_snap%sort("id", ascending=.true.) - end if - - ! Take snapshot of the currently encountering test particles - tp_snap%nbody = ntp_snap - if (ntp_snap > 0) then - allocate(tp_snap%id(ntp_snap)) - allocate(tp_snap%info(ntp_snap)) - tp_snap%id(:) = pack(tp%id(1:ntp), tp%lmask(1:ntp)) - tp_snap%info(:) = pack(tp%info(1:ntp), tp%lmask(1:ntp)) - allocate(tp_snap%rh(NDIM,ntp_snap)) - allocate(tp_snap%vh(NDIM,ntp_snap)) - do i = 1, NDIM - tp_snap%rh(i,:) = pack(tp%rh(i,1:ntp), tp%lmask(1:ntp)) - tp_snap%vh(i,:) = pack(tp%vh(i,1:ntp), tp%lmask(1:ntp)) - end do - end if - end select - end select - - ! Save the snapshot - self%encounter_history%nid = self%encounter_history%nid + ntp_snap + npl_snap - call symba_util_save_encounter(self,snapshot,t) - end select - end select - end associate - - return - end subroutine symba_util_take_encounter_snapshot end submodule s_symba_util diff --git a/src/util/util_snapshot.f90 b/src/util/util_snapshot.f90 index 1c67bc7f8..c3a98855b 100644 --- a/src/util/util_snapshot.f90 +++ b/src/util/util_snapshot.f90 @@ -11,14 +11,17 @@ use swiftest contains - module subroutine util_snapshot_system(self, system) + module subroutine util_snapshot_system(self, param, system, t, arg) !! author: David A. Minton !! !! Takes a snapshot of the system for later file storage implicit none ! Arguments - class(swiftest_storage(*)), intent(inout) :: self !! Swiftest storage object - class(swiftest_nbody_system), intent(in) :: system !! Swiftest nbody system object to store + class(swiftest_storage(*)), intent(inout) :: self !! Swiftest storage object + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object to store + real(DP), intent(in), optional :: t !! Time of snapshot if different from system time + character(*), intent(in), optional :: arg !! Optional argument (needed for extended storage type used in collision snapshots) self%iframe = self%iframe + 1 self%nt = self%iframe From 69ebd88a506b6708de9a6f1e7357fca6cf74defd Mon Sep 17 00:00:00 2001 From: David A Minton Date: Sun, 11 Dec 2022 17:33:32 -0500 Subject: [PATCH 387/569] Got rid of spurious flush command and simplified the driver a tad --- src/io/io.f90 | 2 -- src/main/swiftest_driver.f90 | 13 +++++++------ 2 files changed, 7 insertions(+), 8 deletions(-) diff --git a/src/io/io.f90 b/src/io/io.f90 index af4b30442..062d0f70a 100644 --- a/src/io/io.f90 +++ b/src/io/io.f90 @@ -259,8 +259,6 @@ module subroutine io_dump_system(self, param) call nc%initialize(dump_param) call self%write_frame(nc, dump_param) call nc%close() - ! Syncrhonize the disk and memory buffer of the NetCDF file (e.g. commit the frame files stored in memory to disk) - call nc%flush(param) end associate idx = idx + 1 diff --git a/src/main/swiftest_driver.f90 b/src/main/swiftest_driver.f90 index cab6d4aca..ebd207e54 100644 --- a/src/main/swiftest_driver.f90 +++ b/src/main/swiftest_driver.f90 @@ -89,13 +89,14 @@ program swiftest_driver associate (system_history => param%system_history) ! If this is a new run, compute energy initial conditions (if energy tracking is turned on) and write the initial conditions to file. - if (param%lrestart) then - if (param%lenergy) call system%conservation_report(param, lterminal=.true.) - else - if (param%lenergy) call system%conservation_report(param, lterminal=.false.) ! This will save the initial values of energy and momentum - call system_history%take_snapshot(param,system) - call system_history%dump(param) + if (param%lenergy) then + if (param%lrestart) then + call system%conservation_report(param, lterminal=.true.) + else + call system%conservation_report(param, lterminal=.false.) ! This will save the initial values of energy and momentum + end if end if + call system_history%take_snapshot(param,system) call system%dump(param) write(display_unit, *) " *************** Main Loop *************** " From eb781b480c9296db8f32e99f7b7da7e590fdd270 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Sun, 11 Dec 2022 18:02:24 -0500 Subject: [PATCH 388/569] Refactored .enc to .encounters --- examples/Fragmentation/Fragmentation_Movie.py | 2 +- python/swiftest/swiftest/simulation_class.py | 29 ++++++++++--------- 2 files changed, 16 insertions(+), 15 deletions(-) diff --git a/examples/Fragmentation/Fragmentation_Movie.py b/examples/Fragmentation/Fragmentation_Movie.py index 0e4a6c598..c7fc31299 100644 --- a/examples/Fragmentation/Fragmentation_Movie.py +++ b/examples/Fragmentation/Fragmentation_Movie.py @@ -90,7 +90,7 @@ def encounter_combiner(sim): # Only keep a minimal subset of necessary data from the simulation and encounter datasets keep_vars = ['rh','Gmass','radius'] data = sim.data[keep_vars] - enc = sim.enc[keep_vars].load() + enc = sim.encounters[keep_vars].load() # Remove any encounter data at the same time steps that appear in the data to prevent duplicates t_not_duplicate = ~enc['time'].isin(data['time']) diff --git a/python/swiftest/swiftest/simulation_class.py b/python/swiftest/swiftest/simulation_class.py index 2c2d10c98..ca11f121e 100644 --- a/python/swiftest/swiftest/simulation_class.py +++ b/python/swiftest/swiftest/simulation_class.py @@ -319,7 +319,8 @@ def __init__(self,read_param: bool = False, read_old_output_file: bool = False, self.param = {} self.data = xr.Dataset() self.ic = xr.Dataset() - self.enc = xr.Dataset() + self.encounters = xr.Dataset() + self.collision = xr.Dataset() self.simdir = Path(simdir) if self.simdir.exists(): @@ -2735,9 +2736,9 @@ def read_output_file(self,read_init_cond : bool = True): # results if "ENCOUNTER_SAVE" in self.param or "FRAGMENTATION_SAVE" in self.param: - read_encounter = self.param["ENCOUNTER_SAVE"] != "NONE" or self.param["FRAGMENTATION_SAVE"] != "NONE" + read_encounters = self.param["ENCOUNTER_SAVE"] != "NONE" or self.param["FRAGMENTATION_SAVE"] != "NONE" else: - read_encounter = False + read_encounters = False param_tmp = self.param.copy() param_tmp['BIN_OUT'] = os.path.join(self.simdir, self.param['BIN_OUT']) if self.codename == "Swiftest": @@ -2752,8 +2753,8 @@ def read_output_file(self,read_init_cond : bool = True): self.ic = io.swiftest2xr(param_tmp, verbose=self.verbose) else: self.ic = self.data.isel(time=0) - if read_encounter: - self.read_encounter() + if read_encounters: + self.read_encounters() elif self.codename == "Swifter": self.data = io.swifter2xr(param_tmp, verbose=self.verbose) @@ -2764,9 +2765,9 @@ def read_output_file(self,read_init_cond : bool = True): warnings.warn('Cannot process unknown code type. Call the read_param method with a valid code name. Valid options are "Swiftest", "Swifter", or "Swift".',stacklevel=2) return - def read_encounter(self): + def read_encounters(self): if self.verbose: - print("Reading encounter history file as .enc") + print("Reading encounter history file as .encounters") enc_files = glob(f"{self.simdir}{os.path.sep}encounter_*.nc") enc_files.sort() @@ -2775,16 +2776,16 @@ def _preprocess(ds, param): return io.process_netcdf_input(ds,param) partial_func = partial(_preprocess, param=self.param) - self.enc = xr.open_mfdataset(enc_files,parallel=True,combine="nested",concat_dim="time",join="left",preprocess=partial_func,mask_and_scale=True) - self.enc = io.process_netcdf_input(self.enc, self.param) + self.encounters = xr.open_mfdataset(enc_files,parallel=True,combine="nested",concat_dim="time",join="left",preprocess=partial_func,mask_and_scale=True) + self.encounters = io.process_netcdf_input(self.encounters, self.param) # Remove any overlapping time values - tgood,tid = np.unique(self.enc.time,return_index=True) - self.enc = self.enc.isel(time=tid) + tgood,tid = np.unique(self.encounters.time,return_index=True) + self.encounters = self.encounters.isel(time=tid) # Reduce the dimensionality of variables that got expanded in the combine process - self.enc['loopnum'] = self.enc['loopnum'].max(dim="name") - self.enc['id'] = self.enc['id'].max(dim="time") - self.enc['particle_type'] = self.enc['particle_type'].max(dim="time") + self.encounters['loopnum'] = self.encounters['loopnum'].max(dim="name") + self.encounters['id'] = self.encounters['id'].max(dim="time") + self.encounters['particle_type'] = self.encounters['particle_type'].max(dim="time") return From 25acb8492bd2c949f6460840c1463f14d8db963a Mon Sep 17 00:00:00 2001 From: David A Minton Date: Mon, 12 Dec 2022 08:03:56 -0500 Subject: [PATCH 389/569] Refactor --- src/encounter/encounter_io.f90 | 86 ++++++++++++++++--------------- src/encounter/encounter_util.f90 | 8 +-- src/modules/encounter_classes.f90 | 12 ++--- 3 files changed, 55 insertions(+), 51 deletions(-) diff --git a/src/encounter/encounter_io.f90 b/src/encounter/encounter_io.f90 index 350f2f1d2..265cfde5c 100644 --- a/src/encounter/encounter_io.f90 +++ b/src/encounter/encounter_io.f90 @@ -209,47 +209,51 @@ module subroutine encounter_io_write_frame(self, nc, param) associate(pl => self%pl, tp => self%tp) select type (nc) class is (encounter_io_parameters) - - call check( nf90_set_fill(nc%id, nf90_nofill, old_mode), "encounter_io_write_frame nf90_set_fill" ) - - call check( nf90_put_var(nc%id, nc%time_varid, self%t, start=[tslot]), "encounter_io_write_frame nf90_put_var time_varid" ) - call check( nf90_put_var(nc%id, nc%loop_varid, int(self%iloop,kind=I4B), start=[tslot]), "encounter_io_write_frame nf90_put_var pl loop_varid" ) - - npl = pl%nbody - do i = 1, npl - idslot = pl%id(i) + 1 - call check( nf90_put_var(nc%id, nc%id_varid, pl%id(i), start=[idslot]), "encounter_io_write_frame nf90_put_var pl id_varid" ) - call check( nf90_put_var(nc%id, nc%rh_varid, pl%rh(:,i), start=[1,idslot,tslot], count=[NDIM,1,1]), "encounter_io_write_frame nf90_put_var pl rh_varid" ) - call check( nf90_put_var(nc%id, nc%vh_varid, pl%vh(:,i), start=[1,idslot,tslot], count=[NDIM,1,1]), "encounter_io_write_frame nf90_put_var pl vh_varid" ) - call check( nf90_put_var(nc%id, nc%Gmass_varid, pl%Gmass(i), start=[idslot, tslot]), "encounter_io_write_frame nf90_put_var pl Gmass_varid" ) - - if (param%lclose) call check( nf90_put_var(nc%id, nc%radius_varid, pl%radius(i), start=[idslot, tslot]), "encounter_io_write_frame nf90_put_var pl radius_varid" ) - - if (param%lrotation) then - call check( nf90_put_var(nc%id, nc%Ip_varid, pl%Ip(:,i), start=[1, idslot, tslot], count=[NDIM,1,1]), "encounter_io_write_frame nf90_put_var pl Ip_varid" ) - call check( nf90_put_var(nc%id, nc%rot_varid, pl%rot(:,i), start=[1,idslot, tslot], count=[NDIM,1,1]), "encounter_io_write_frame nf90_put_var pl rotx_varid" ) - end if - - charstring = trim(adjustl(pl%info(i)%name)) - call check( nf90_put_var(nc%id, nc%name_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "encounter_io_write_frame nf90_put_var pl name_varid" ) - charstring = trim(adjustl(pl%info(i)%particle_type)) - call check( nf90_put_var(nc%id, nc%ptype_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "encounter_io_write_frame nf90_put_var pl particle_type_varid" ) - end do - - ntp = tp%nbody - do i = 1, ntp - idslot = tp%id(i) + 1 - call check( nf90_put_var(nc%id, nc%id_varid, tp%id(i), start=[idslot]), "encounter_io_write_frame nf90_put_var tp id_varid" ) - call check( nf90_put_var(nc%id, nc%rh_varid, tp%rh(:,i), start=[1,idslot,tslot], count=[NDIM,1,1]), "encounter_io_write_frame nf90_put_var tp rh_varid" ) - call check( nf90_put_var(nc%id, nc%vh_varid, tp%vh(:,i), start=[1,idslot,tslot], count=[NDIM,1,1]), "encounter_io_write_frame nf90_put_var tp vh_varid" ) - - charstring = trim(adjustl(tp%info(i)%name)) - call check( nf90_put_var(nc%id, nc%name_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "encounter_io_write_frame nf90_put_var tp name_varid" ) - charstring = trim(adjustl(tp%info(i)%particle_type)) - call check( nf90_put_var(nc%id, nc%ptype_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "encounter_io_write_frame nf90_put_var tp particle_type_varid" ) - end do - - call check( nf90_set_fill(nc%id, old_mode, old_mode) ) + select type (param) + class is (symba_parameters) + + call check( nf90_set_fill(nc%id, nf90_nofill, old_mode), "encounter_io_write_frame nf90_set_fill" ) + + call check( nf90_put_var(nc%id, nc%time_varid, self%t, start=[tslot]), "encounter_io_write_frame nf90_put_var time_varid" ) + call check( nf90_put_var(nc%id, nc%loop_varid, int(self%iloop,kind=I4B), start=[tslot]), "encounter_io_write_frame nf90_put_var pl loop_varid" ) + + npl = pl%nbody + do i = 1, npl + idslot = pl%id(i) + 1 + idslot = param%encounter_history%idmap(pl%id(i)) + call check( nf90_put_var(nc%id, nc%id_varid, pl%id(i), start=[idslot]), "encounter_io_write_frame nf90_put_var pl id_varid" ) + call check( nf90_put_var(nc%id, nc%rh_varid, pl%rh(:,i), start=[1,idslot,tslot], count=[NDIM,1,1]), "encounter_io_write_frame nf90_put_var pl rh_varid" ) + call check( nf90_put_var(nc%id, nc%vh_varid, pl%vh(:,i), start=[1,idslot,tslot], count=[NDIM,1,1]), "encounter_io_write_frame nf90_put_var pl vh_varid" ) + call check( nf90_put_var(nc%id, nc%Gmass_varid, pl%Gmass(i), start=[idslot, tslot]), "encounter_io_write_frame nf90_put_var pl Gmass_varid" ) + + if (param%lclose) call check( nf90_put_var(nc%id, nc%radius_varid, pl%radius(i), start=[idslot, tslot]), "encounter_io_write_frame nf90_put_var pl radius_varid" ) + + if (param%lrotation) then + call check( nf90_put_var(nc%id, nc%Ip_varid, pl%Ip(:,i), start=[1, idslot, tslot], count=[NDIM,1,1]), "encounter_io_write_frame nf90_put_var pl Ip_varid" ) + call check( nf90_put_var(nc%id, nc%rot_varid, pl%rot(:,i), start=[1,idslot, tslot], count=[NDIM,1,1]), "encounter_io_write_frame nf90_put_var pl rotx_varid" ) + end if + + charstring = trim(adjustl(pl%info(i)%name)) + call check( nf90_put_var(nc%id, nc%name_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "encounter_io_write_frame nf90_put_var pl name_varid" ) + charstring = trim(adjustl(pl%info(i)%particle_type)) + call check( nf90_put_var(nc%id, nc%ptype_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "encounter_io_write_frame nf90_put_var pl particle_type_varid" ) + end do + + ntp = tp%nbody + do i = 1, ntp + idslot = tp%id(i) + 1 + call check( nf90_put_var(nc%id, nc%id_varid, tp%id(i), start=[idslot]), "encounter_io_write_frame nf90_put_var tp id_varid" ) + call check( nf90_put_var(nc%id, nc%rh_varid, tp%rh(:,i), start=[1,idslot,tslot], count=[NDIM,1,1]), "encounter_io_write_frame nf90_put_var tp rh_varid" ) + call check( nf90_put_var(nc%id, nc%vh_varid, tp%vh(:,i), start=[1,idslot,tslot], count=[NDIM,1,1]), "encounter_io_write_frame nf90_put_var tp vh_varid" ) + + charstring = trim(adjustl(tp%info(i)%name)) + call check( nf90_put_var(nc%id, nc%name_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "encounter_io_write_frame nf90_put_var tp name_varid" ) + charstring = trim(adjustl(tp%info(i)%particle_type)) + call check( nf90_put_var(nc%id, nc%ptype_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "encounter_io_write_frame nf90_put_var tp particle_type_varid" ) + end do + + call check( nf90_set_fill(nc%id, old_mode, old_mode) ) + end select end select end associate diff --git a/src/encounter/encounter_util.f90 b/src/encounter/encounter_util.f90 index 45766a887..f5467b69f 100644 --- a/src/encounter/encounter_util.f90 +++ b/src/encounter/encounter_util.f90 @@ -180,7 +180,7 @@ module subroutine encounter_util_final_storage(self) end subroutine encounter_util_final_storage - module subroutine encounter_util_index_map_storage(self) + module subroutine encounter_util_index_map_encounter(self) !! author: David A. Minton !! !! Maps body id values to storage index values so we don't have to use unlimited dimensions for id. @@ -229,11 +229,11 @@ module subroutine encounter_util_index_map_storage(self) self%nt = size(self%tvals) return - end subroutine encounter_util_index_map_storage + end subroutine encounter_util_index_map_encounter - module subroutine encounter_util_index_map_collision_storage(self) + module subroutine encounter_util_index_map_collision(self) !! author: David A. Minton !! !! Maps body id values to storage index values so we don't have to use unlimited dimensions for id @@ -243,7 +243,7 @@ module subroutine encounter_util_index_map_collision_storage(self) ! Internals return - end subroutine encounter_util_index_map_collision_storage + end subroutine encounter_util_index_map_collision module subroutine encounter_util_resize_list(self, nnew) diff --git a/src/modules/encounter_classes.f90 b/src/modules/encounter_classes.f90 index d339b6660..f9ed5b896 100644 --- a/src/modules/encounter_classes.f90 +++ b/src/modules/encounter_classes.f90 @@ -68,7 +68,7 @@ module encounter_classes type, extends(swiftest_storage) :: collision_storage contains procedure :: dump => encounter_io_dump_collision !! Dumps contents of encounter history to file - procedure :: make_index_map => encounter_util_index_map_collision_storage !! Maps body id values to storage index values so we don't have to use unlimited dimensions for id + procedure :: make_index_map => encounter_util_index_map_collision !! Maps body id values to storage index values so we don't have to use unlimited dimensions for id procedure :: take_snapshot => encounter_util_snapshot_collision !! Take a minimal snapshot of the system through an encounter final :: encounter_util_final_collision_storage end type collision_storage @@ -77,7 +77,7 @@ module encounter_classes type, extends(swiftest_storage) :: encounter_storage contains procedure :: dump => encounter_io_dump_encounter !! Dumps contents of encounter history to file - procedure :: make_index_map => encounter_util_index_map_storage !! Maps body id values to storage index values so we don't have to use unlimited dimensions for id + procedure :: make_index_map => encounter_util_index_map_encounter !! Maps body id values to storage index values so we don't have to use unlimited dimensions for id procedure :: take_snapshot => encounter_util_snapshot_encounter !! Take a minimal snapshot of the system through an encounter final :: encounter_util_final_storage end type encounter_storage @@ -300,15 +300,15 @@ module subroutine encounter_util_final_storage(self) type(encounter_storage(*)), intent(inout) :: self !! SyMBA nbody system object end subroutine encounter_util_final_storage - module subroutine encounter_util_index_map_collision_storage(self) + module subroutine encounter_util_index_map_collision(self) implicit none class(collision_storage(*)), intent(inout) :: self !! E - end subroutine encounter_util_index_map_collision_storage + end subroutine encounter_util_index_map_collision - module subroutine encounter_util_index_map_storage(self) + module subroutine encounter_util_index_map_encounter(self) implicit none class(encounter_storage(*)), intent(inout) :: self !! Swiftest storage object - end subroutine encounter_util_index_map_storage + end subroutine encounter_util_index_map_encounter module subroutine encounter_util_resize_list(self, nnew) implicit none From 682b6f353576ab821954591fde88cc067214d9da Mon Sep 17 00:00:00 2001 From: David A Minton Date: Mon, 12 Dec 2022 08:37:47 -0500 Subject: [PATCH 390/569] Fixed encounter id indexing --- src/encounter/encounter_io.f90 | 133 ++++++++++++++++--------------- src/encounter/encounter_util.f90 | 2 +- 2 files changed, 69 insertions(+), 66 deletions(-) diff --git a/src/encounter/encounter_io.f90 b/src/encounter/encounter_io.f90 index 265cfde5c..bc3bfaac2 100644 --- a/src/encounter/encounter_io.f90 +++ b/src/encounter/encounter_io.f90 @@ -113,74 +113,77 @@ module subroutine encounter_io_initialize(self, param) integer(I4B) :: ndims, i associate(nc => self) - dfill = ieee_value(dfill, IEEE_QUIET_NAN) - sfill = ieee_value(sfill, IEEE_QUIET_NAN) - - select case (param%out_type) - case("NETCDF_FLOAT") - self%out_type = NF90_FLOAT - case("NETCDF_DOUBLE") - self%out_type = NF90_DOUBLE - end select - - ! Check if the file exists, and if it does, delete it - inquire(file=nc%file_name, exist=fileExists) - if (fileExists) then - open(unit=LUN, file=nc%file_name, status="old", err=667, iomsg=errmsg) - close(unit=LUN, status="delete") - end if - - call check( nf90_create(nc%file_name, NF90_NETCDF4, nc%id), "encounter_io_initialize nf90_create" ) - - ! Dimensions - call check( nf90_def_dim(nc%id, nc%time_dimname, nc%time_dimsize, nc%time_dimid), "encounter_io_initialize nf90_def_dim time_dimid" ) ! Simulation time dimension - call check( nf90_def_dim(nc%id, nc%space_dimname, NDIM , nc%space_dimid), "encounter_io_initialize nf90_def_dim space_dimid" ) ! 3D space dimension - call check( nf90_def_dim(nc%id, nc%id_dimname, param%maxid+1, nc%id_dimid), "encounter_io_initialize nf90_def_dim id_dimid" ) ! dimension to store particle id numbers - call check( nf90_def_dim(nc%id, nc%str_dimname, NAMELEN, nc%str_dimid), "encounter_io_initialize nf90_def_dim str_dimid" ) ! Dimension for string variables (aka character arrays) - - ! Dimension coordinates - call check( nf90_def_var(nc%id, nc%time_dimname, nc%out_type, nc%time_dimid, nc%time_varid), "encounter_io_initialize nf90_def_var time_varid" ) - call check( nf90_def_var(nc%id, nc%space_dimname, NF90_CHAR, nc%space_dimid, nc%space_varid), "encounter_io_initialize nf90_def_var space_varid" ) - call check( nf90_def_var(nc%id, nc%id_dimname, NF90_INT, nc%id_dimid, nc%id_varid), "encounter_io_initialize nf90_def_var id_varid" ) - - ! Variables - call check( nf90_def_var(nc%id, nc%name_varname, NF90_CHAR, [nc%str_dimid, nc%id_dimid], nc%name_varid), "encounter_io_initialize nf90_def_var name_varid" ) - call check( nf90_def_var(nc%id, nc%ptype_varname, NF90_CHAR, [nc%str_dimid, nc%id_dimid], nc%ptype_varid), "encounter_io_initialize nf90_def_var ptype_varid" ) - call check( nf90_def_var(nc%id, nc%rh_varname, nc%out_type, [nc%space_dimid, nc%id_dimid, nc%time_dimid], nc%rh_varid), "encounter_io_initialize nf90_def_var rh_varid" ) - call check( nf90_def_var(nc%id, nc%vh_varname, nc%out_type, [nc%space_dimid, nc%id_dimid, nc%time_dimid], nc%vh_varid), "encounter_io_initialize nf90_def_var vh_varid" ) - call check( nf90_def_var(nc%id, nc%Gmass_varname, nc%out_type, [nc%id_dimid, nc%time_dimid], nc%Gmass_varid), "encounter_io_initialize nf90_def_var Gmass_varid" ) - call check( nf90_def_var(nc%id, nc%loop_varname, NF90_INT, [nc%time_dimid], nc%loop_varid), "encounter_io_initialize nf90_def_var loop_varid" ) - if (param%lclose) then - call check( nf90_def_var(nc%id, nc%radius_varname, nc%out_type, [nc%id_dimid, nc%time_dimid], nc%radius_varid), "encounter_io_initialize nf90_def_var radius_varid" ) - end if - if (param%lrotation) then - call check( nf90_def_var(nc%id, nc%Ip_varname, nc%out_type, [nc%space_dimid, nc%id_dimid, nc%time_dimid], nc%Ip_varid), "encounter_io_initialize nf90_def_var Ip_varid" ) - call check( nf90_def_var(nc%id, nc%rot_varname, nc%out_type, [nc%space_dimid, nc%id_dimid, nc%time_dimid], nc%rot_varid), "encounter_io_initialize nf90_def_var rot_varid" ) - end if - - call check( nf90_inquire(nc%id, nVariables=nvar), "encounter_io_initialize nf90_inquire nVariables" ) - do varid = 1, nvar - call check( nf90_inquire_variable(nc%id, varid, xtype=vartype, ndims=ndims), "encounter_io_initialize nf90_inquire_variable" ) - select case(vartype) - case(NF90_INT) - call check( nf90_def_var_fill(nc%id, varid, 0, NF90_FILL_INT), "encounter_io_initialize nf90_def_var_fill NF90_INT" ) - case(NF90_FLOAT) - call check( nf90_def_var_fill(nc%id, varid, 0, sfill), "encounter_io_initialize nf90_def_var_fill NF90_FLOAT" ) - case(NF90_DOUBLE) - call check( nf90_def_var_fill(nc%id, varid, 0, dfill), "encounter_io_initialize nf90_def_var_fill NF90_DOUBLE" ) - case(NF90_CHAR) - call check( nf90_def_var_fill(nc%id, varid, 0, 0), "encounter_io_initialize nf90_def_var_fill NF90_CHAR" ) + select type(param) + class is (symba_parameters) + dfill = ieee_value(dfill, IEEE_QUIET_NAN) + sfill = ieee_value(sfill, IEEE_QUIET_NAN) + + select case (param%out_type) + case("NETCDF_FLOAT") + self%out_type = NF90_FLOAT + case("NETCDF_DOUBLE") + self%out_type = NF90_DOUBLE end select - end do - ! Take the file out of define mode - call check( nf90_enddef(nc%id), "encounter_io_initialize nf90_enddef" ) + ! Check if the file exists, and if it does, delete it + inquire(file=nc%file_name, exist=fileExists) + if (fileExists) then + open(unit=LUN, file=nc%file_name, status="old", err=667, iomsg=errmsg) + close(unit=LUN, status="delete") + end if + + call check( nf90_create(nc%file_name, NF90_NETCDF4, nc%id), "encounter_io_initialize nf90_create" ) + + ! Dimensions + call check( nf90_def_dim(nc%id, nc%time_dimname, nc%time_dimsize, nc%time_dimid), "encounter_io_initialize nf90_def_dim time_dimid" ) ! Simulation time dimension + call check( nf90_def_dim(nc%id, nc%space_dimname, NDIM , nc%space_dimid), "encounter_io_initialize nf90_def_dim space_dimid" ) ! 3D space dimension + call check( nf90_def_dim(nc%id, nc%id_dimname, param%encounter_history%nid, nc%id_dimid), "encounter_io_initialize nf90_def_dim id_dimid" ) ! dimension to store particle id numbers + call check( nf90_def_dim(nc%id, nc%str_dimname, NAMELEN, nc%str_dimid), "encounter_io_initialize nf90_def_dim str_dimid" ) ! Dimension for string variables (aka character arrays) + + ! Dimension coordinates + call check( nf90_def_var(nc%id, nc%time_dimname, nc%out_type, nc%time_dimid, nc%time_varid), "encounter_io_initialize nf90_def_var time_varid" ) + call check( nf90_def_var(nc%id, nc%space_dimname, NF90_CHAR, nc%space_dimid, nc%space_varid), "encounter_io_initialize nf90_def_var space_varid" ) + call check( nf90_def_var(nc%id, nc%id_dimname, NF90_INT, nc%id_dimid, nc%id_varid), "encounter_io_initialize nf90_def_var id_varid" ) + + ! Variables + call check( nf90_def_var(nc%id, nc%name_varname, NF90_CHAR, [nc%str_dimid, nc%id_dimid], nc%name_varid), "encounter_io_initialize nf90_def_var name_varid" ) + call check( nf90_def_var(nc%id, nc%ptype_varname, NF90_CHAR, [nc%str_dimid, nc%id_dimid], nc%ptype_varid), "encounter_io_initialize nf90_def_var ptype_varid" ) + call check( nf90_def_var(nc%id, nc%rh_varname, nc%out_type, [nc%space_dimid, nc%id_dimid, nc%time_dimid], nc%rh_varid), "encounter_io_initialize nf90_def_var rh_varid" ) + call check( nf90_def_var(nc%id, nc%vh_varname, nc%out_type, [nc%space_dimid, nc%id_dimid, nc%time_dimid], nc%vh_varid), "encounter_io_initialize nf90_def_var vh_varid" ) + call check( nf90_def_var(nc%id, nc%Gmass_varname, nc%out_type, [nc%id_dimid, nc%time_dimid], nc%Gmass_varid), "encounter_io_initialize nf90_def_var Gmass_varid" ) + call check( nf90_def_var(nc%id, nc%loop_varname, NF90_INT, [nc%time_dimid], nc%loop_varid), "encounter_io_initialize nf90_def_var loop_varid" ) + if (param%lclose) then + call check( nf90_def_var(nc%id, nc%radius_varname, nc%out_type, [nc%id_dimid, nc%time_dimid], nc%radius_varid), "encounter_io_initialize nf90_def_var radius_varid" ) + end if + if (param%lrotation) then + call check( nf90_def_var(nc%id, nc%Ip_varname, nc%out_type, [nc%space_dimid, nc%id_dimid, nc%time_dimid], nc%Ip_varid), "encounter_io_initialize nf90_def_var Ip_varid" ) + call check( nf90_def_var(nc%id, nc%rot_varname, nc%out_type, [nc%space_dimid, nc%id_dimid, nc%time_dimid], nc%rot_varid), "encounter_io_initialize nf90_def_var rot_varid" ) + end if + + call check( nf90_inquire(nc%id, nVariables=nvar), "encounter_io_initialize nf90_inquire nVariables" ) + do varid = 1, nvar + call check( nf90_inquire_variable(nc%id, varid, xtype=vartype, ndims=ndims), "encounter_io_initialize nf90_inquire_variable" ) + select case(vartype) + case(NF90_INT) + call check( nf90_def_var_fill(nc%id, varid, 0, NF90_FILL_INT), "encounter_io_initialize nf90_def_var_fill NF90_INT" ) + case(NF90_FLOAT) + call check( nf90_def_var_fill(nc%id, varid, 0, sfill), "encounter_io_initialize nf90_def_var_fill NF90_FLOAT" ) + case(NF90_DOUBLE) + call check( nf90_def_var_fill(nc%id, varid, 0, dfill), "encounter_io_initialize nf90_def_var_fill NF90_DOUBLE" ) + case(NF90_CHAR) + call check( nf90_def_var_fill(nc%id, varid, 0, 0), "encounter_io_initialize nf90_def_var_fill NF90_CHAR" ) + end select + end do - ! Add in the space dimension coordinates - call check( nf90_put_var(nc%id, nc%space_varid, nc%space_coords, start=[1], count=[NDIM]), "encounter_io_initialize nf90_put_var space" ) + ! Take the file out of define mode + call check( nf90_enddef(nc%id), "encounter_io_initialize nf90_enddef" ) - ! Pre-fill name slots with ids - call check( nf90_put_var(nc%id, nc%id_varid, [(-1,i=1,param%maxid+1)], start=[1], count=[param%maxid+1]), "encounter_io_initialize nf90_put_var pl id_varid" ) + ! Add in the space dimension coordinates + call check( nf90_put_var(nc%id, nc%space_varid, nc%space_coords, start=[1], count=[NDIM]), "encounter_io_initialize nf90_put_var space" ) + + ! Pre-fill name slots with ids + !call check( nf90_put_var(nc%id, nc%id_varid, [(-1,i=1,param%maxid+1)], start=[1], count=[param%maxid+1]), "encounter_io_initialize nf90_put_var pl id_varid" ) + end select end associate return @@ -220,7 +223,7 @@ module subroutine encounter_io_write_frame(self, nc, param) npl = pl%nbody do i = 1, npl idslot = pl%id(i) + 1 - idslot = param%encounter_history%idmap(pl%id(i)) + idslot = findloc(param%encounter_history%idvals,pl%id(i),dim=1) call check( nf90_put_var(nc%id, nc%id_varid, pl%id(i), start=[idslot]), "encounter_io_write_frame nf90_put_var pl id_varid" ) call check( nf90_put_var(nc%id, nc%rh_varid, pl%rh(:,i), start=[1,idslot,tslot], count=[NDIM,1,1]), "encounter_io_write_frame nf90_put_var pl rh_varid" ) call check( nf90_put_var(nc%id, nc%vh_varid, pl%vh(:,i), start=[1,idslot,tslot], count=[NDIM,1,1]), "encounter_io_write_frame nf90_put_var pl vh_varid" ) diff --git a/src/encounter/encounter_util.f90 b/src/encounter/encounter_util.f90 index f5467b69f..5c4212253 100644 --- a/src/encounter/encounter_util.f90 +++ b/src/encounter/encounter_util.f90 @@ -191,7 +191,7 @@ module subroutine encounter_util_index_map_encounter(self) ! Internals ! Internals integer(I4B) :: i, n, nold, nt - integer(I4B), dimension(:), allocatable :: idvals + integer(I4B), dimension(:), allocatable :: idvals, tmp real(DP), dimension(:), allocatable :: tvals if (self%nid == 0) return From 1b82c228d5f5829c7b83e0e9fd399743fd2cfb55 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Mon, 12 Dec 2022 12:39:48 -0500 Subject: [PATCH 391/569] Lots of fixes to indexing of encounters and collisions --- src/encounter/encounter_io.f90 | 160 ++++++++++++------------ src/encounter/encounter_util.f90 | 144 ++++++++++++++++----- src/fraggle/fraggle_io.f90 | 200 +++++++++++++++--------------- src/fraggle/fraggle_util.f90 | 36 +++++- src/modules/encounter_classes.f90 | 17 ++- src/modules/fraggle_classes.f90 | 15 ++- src/modules/swiftest_classes.f90 | 7 ++ src/util/util_index.f90 | 130 +++++++++++++------ 8 files changed, 447 insertions(+), 262 deletions(-) diff --git a/src/encounter/encounter_io.f90 b/src/encounter/encounter_io.f90 index bc3bfaac2..09c2dd676 100644 --- a/src/encounter/encounter_io.f90 +++ b/src/encounter/encounter_io.f90 @@ -27,15 +27,17 @@ module subroutine encounter_io_dump_collision(self, param) class is (fraggle_io_parameters) if (self%iframe > 0) then nc%file_number = nc%file_number + 1 - nc%event_dimsize = self%iframe call self%make_index_map() + nc%event_dimsize = self%nt + nc%id_dimsize = self%nid + write(nc%file_name, '("collision_",I0.6,".nc")') nc%file_number call nc%initialize(param) do i = 1, self%nframes if (allocated(self%frame(i)%item)) then select type(snapshot => self%frame(i)%item) - class is (fraggle_collision_snapshot) + class is (fraggle_snapshot) param%ioutput = i call snapshot%write_frame(nc,param) end select @@ -70,6 +72,8 @@ module subroutine encounter_io_dump_encounter(self, param) ! Create and save the output files for this encounter and fragmentation nc%file_number = nc%file_number + 1 call self%make_index_map() + nc%time_dimsize = self%nt + nc%id_dimsize = self%nid write(nc%file_name, '("encounter_",I0.6,".nc")') nc%file_number call nc%initialize(param) @@ -113,77 +117,72 @@ module subroutine encounter_io_initialize(self, param) integer(I4B) :: ndims, i associate(nc => self) - select type(param) - class is (symba_parameters) - dfill = ieee_value(dfill, IEEE_QUIET_NAN) - sfill = ieee_value(sfill, IEEE_QUIET_NAN) - - select case (param%out_type) - case("NETCDF_FLOAT") - self%out_type = NF90_FLOAT - case("NETCDF_DOUBLE") - self%out_type = NF90_DOUBLE - end select + dfill = ieee_value(dfill, IEEE_QUIET_NAN) + sfill = ieee_value(sfill, IEEE_QUIET_NAN) + + select case (param%out_type) + case("NETCDF_FLOAT") + self%out_type = NF90_FLOAT + case("NETCDF_DOUBLE") + self%out_type = NF90_DOUBLE + end select - ! Check if the file exists, and if it does, delete it - inquire(file=nc%file_name, exist=fileExists) - if (fileExists) then - open(unit=LUN, file=nc%file_name, status="old", err=667, iomsg=errmsg) - close(unit=LUN, status="delete") - end if - - call check( nf90_create(nc%file_name, NF90_NETCDF4, nc%id), "encounter_io_initialize nf90_create" ) - - ! Dimensions - call check( nf90_def_dim(nc%id, nc%time_dimname, nc%time_dimsize, nc%time_dimid), "encounter_io_initialize nf90_def_dim time_dimid" ) ! Simulation time dimension - call check( nf90_def_dim(nc%id, nc%space_dimname, NDIM , nc%space_dimid), "encounter_io_initialize nf90_def_dim space_dimid" ) ! 3D space dimension - call check( nf90_def_dim(nc%id, nc%id_dimname, param%encounter_history%nid, nc%id_dimid), "encounter_io_initialize nf90_def_dim id_dimid" ) ! dimension to store particle id numbers - call check( nf90_def_dim(nc%id, nc%str_dimname, NAMELEN, nc%str_dimid), "encounter_io_initialize nf90_def_dim str_dimid" ) ! Dimension for string variables (aka character arrays) - - ! Dimension coordinates - call check( nf90_def_var(nc%id, nc%time_dimname, nc%out_type, nc%time_dimid, nc%time_varid), "encounter_io_initialize nf90_def_var time_varid" ) - call check( nf90_def_var(nc%id, nc%space_dimname, NF90_CHAR, nc%space_dimid, nc%space_varid), "encounter_io_initialize nf90_def_var space_varid" ) - call check( nf90_def_var(nc%id, nc%id_dimname, NF90_INT, nc%id_dimid, nc%id_varid), "encounter_io_initialize nf90_def_var id_varid" ) - - ! Variables - call check( nf90_def_var(nc%id, nc%name_varname, NF90_CHAR, [nc%str_dimid, nc%id_dimid], nc%name_varid), "encounter_io_initialize nf90_def_var name_varid" ) - call check( nf90_def_var(nc%id, nc%ptype_varname, NF90_CHAR, [nc%str_dimid, nc%id_dimid], nc%ptype_varid), "encounter_io_initialize nf90_def_var ptype_varid" ) - call check( nf90_def_var(nc%id, nc%rh_varname, nc%out_type, [nc%space_dimid, nc%id_dimid, nc%time_dimid], nc%rh_varid), "encounter_io_initialize nf90_def_var rh_varid" ) - call check( nf90_def_var(nc%id, nc%vh_varname, nc%out_type, [nc%space_dimid, nc%id_dimid, nc%time_dimid], nc%vh_varid), "encounter_io_initialize nf90_def_var vh_varid" ) - call check( nf90_def_var(nc%id, nc%Gmass_varname, nc%out_type, [nc%id_dimid, nc%time_dimid], nc%Gmass_varid), "encounter_io_initialize nf90_def_var Gmass_varid" ) - call check( nf90_def_var(nc%id, nc%loop_varname, NF90_INT, [nc%time_dimid], nc%loop_varid), "encounter_io_initialize nf90_def_var loop_varid" ) - if (param%lclose) then - call check( nf90_def_var(nc%id, nc%radius_varname, nc%out_type, [nc%id_dimid, nc%time_dimid], nc%radius_varid), "encounter_io_initialize nf90_def_var radius_varid" ) - end if - if (param%lrotation) then - call check( nf90_def_var(nc%id, nc%Ip_varname, nc%out_type, [nc%space_dimid, nc%id_dimid, nc%time_dimid], nc%Ip_varid), "encounter_io_initialize nf90_def_var Ip_varid" ) - call check( nf90_def_var(nc%id, nc%rot_varname, nc%out_type, [nc%space_dimid, nc%id_dimid, nc%time_dimid], nc%rot_varid), "encounter_io_initialize nf90_def_var rot_varid" ) - end if - - call check( nf90_inquire(nc%id, nVariables=nvar), "encounter_io_initialize nf90_inquire nVariables" ) - do varid = 1, nvar - call check( nf90_inquire_variable(nc%id, varid, xtype=vartype, ndims=ndims), "encounter_io_initialize nf90_inquire_variable" ) - select case(vartype) - case(NF90_INT) - call check( nf90_def_var_fill(nc%id, varid, 0, NF90_FILL_INT), "encounter_io_initialize nf90_def_var_fill NF90_INT" ) - case(NF90_FLOAT) - call check( nf90_def_var_fill(nc%id, varid, 0, sfill), "encounter_io_initialize nf90_def_var_fill NF90_FLOAT" ) - case(NF90_DOUBLE) - call check( nf90_def_var_fill(nc%id, varid, 0, dfill), "encounter_io_initialize nf90_def_var_fill NF90_DOUBLE" ) - case(NF90_CHAR) - call check( nf90_def_var_fill(nc%id, varid, 0, 0), "encounter_io_initialize nf90_def_var_fill NF90_CHAR" ) - end select - end do + ! Check if the file exists, and if it does, delete it + inquire(file=nc%file_name, exist=fileExists) + if (fileExists) then + open(unit=LUN, file=nc%file_name, status="old", err=667, iomsg=errmsg) + close(unit=LUN, status="delete") + end if - ! Take the file out of define mode - call check( nf90_enddef(nc%id), "encounter_io_initialize nf90_enddef" ) + call check( nf90_create(nc%file_name, NF90_NETCDF4, nc%id), "encounter_io_initialize nf90_create" ) + + ! Dimensions + call check( nf90_def_dim(nc%id, nc%time_dimname, nc%time_dimsize, nc%time_dimid), "encounter_io_initialize nf90_def_dim time_dimid" ) ! Simulation time dimension + call check( nf90_def_dim(nc%id, nc%space_dimname, NDIM , nc%space_dimid), "encounter_io_initialize nf90_def_dim space_dimid" ) ! 3D space dimension + call check( nf90_def_dim(nc%id, nc%id_dimname, nc%id_dimsize, nc%id_dimid), "encounter_io_initialize nf90_def_dim id_dimid" ) ! dimension to store particle id numbers + call check( nf90_def_dim(nc%id, nc%str_dimname, NAMELEN, nc%str_dimid), "encounter_io_initialize nf90_def_dim str_dimid" ) ! Dimension for string variables (aka character arrays) + + ! Dimension coordinates + call check( nf90_def_var(nc%id, nc%time_dimname, nc%out_type, nc%time_dimid, nc%time_varid), "encounter_io_initialize nf90_def_var time_varid" ) + call check( nf90_def_var(nc%id, nc%space_dimname, NF90_CHAR, nc%space_dimid, nc%space_varid), "encounter_io_initialize nf90_def_var space_varid" ) + call check( nf90_def_var(nc%id, nc%id_dimname, NF90_INT, nc%id_dimid, nc%id_varid), "encounter_io_initialize nf90_def_var id_varid" ) + + ! Variables + call check( nf90_def_var(nc%id, nc%name_varname, NF90_CHAR, [nc%str_dimid, nc%id_dimid], nc%name_varid), "encounter_io_initialize nf90_def_var name_varid" ) + call check( nf90_def_var(nc%id, nc%ptype_varname, NF90_CHAR, [nc%str_dimid, nc%id_dimid], nc%ptype_varid), "encounter_io_initialize nf90_def_var ptype_varid" ) + call check( nf90_def_var(nc%id, nc%rh_varname, nc%out_type, [nc%space_dimid, nc%id_dimid, nc%time_dimid], nc%rh_varid), "encounter_io_initialize nf90_def_var rh_varid" ) + call check( nf90_def_var(nc%id, nc%vh_varname, nc%out_type, [nc%space_dimid, nc%id_dimid, nc%time_dimid], nc%vh_varid), "encounter_io_initialize nf90_def_var vh_varid" ) + call check( nf90_def_var(nc%id, nc%Gmass_varname, nc%out_type, [nc%id_dimid, nc%time_dimid], nc%Gmass_varid), "encounter_io_initialize nf90_def_var Gmass_varid" ) + call check( nf90_def_var(nc%id, nc%loop_varname, NF90_INT, [nc%time_dimid], nc%loop_varid), "encounter_io_initialize nf90_def_var loop_varid" ) + if (param%lclose) then + call check( nf90_def_var(nc%id, nc%radius_varname, nc%out_type, [nc%id_dimid, nc%time_dimid], nc%radius_varid), "encounter_io_initialize nf90_def_var radius_varid" ) + end if + if (param%lrotation) then + call check( nf90_def_var(nc%id, nc%Ip_varname, nc%out_type, [nc%space_dimid, nc%id_dimid, nc%time_dimid], nc%Ip_varid), "encounter_io_initialize nf90_def_var Ip_varid" ) + call check( nf90_def_var(nc%id, nc%rot_varname, nc%out_type, [nc%space_dimid, nc%id_dimid, nc%time_dimid], nc%rot_varid), "encounter_io_initialize nf90_def_var rot_varid" ) + end if - ! Add in the space dimension coordinates - call check( nf90_put_var(nc%id, nc%space_varid, nc%space_coords, start=[1], count=[NDIM]), "encounter_io_initialize nf90_put_var space" ) + call check( nf90_inquire(nc%id, nVariables=nvar), "encounter_io_initialize nf90_inquire nVariables" ) + do varid = 1, nvar + call check( nf90_inquire_variable(nc%id, varid, xtype=vartype, ndims=ndims), "encounter_io_initialize nf90_inquire_variable" ) + select case(vartype) + case(NF90_INT) + call check( nf90_def_var_fill(nc%id, varid, 0, NF90_FILL_INT), "encounter_io_initialize nf90_def_var_fill NF90_INT" ) + case(NF90_FLOAT) + call check( nf90_def_var_fill(nc%id, varid, 0, sfill), "encounter_io_initialize nf90_def_var_fill NF90_FLOAT" ) + case(NF90_DOUBLE) + call check( nf90_def_var_fill(nc%id, varid, 0, dfill), "encounter_io_initialize nf90_def_var_fill NF90_DOUBLE" ) + case(NF90_CHAR) + call check( nf90_def_var_fill(nc%id, varid, 0, 0), "encounter_io_initialize nf90_def_var_fill NF90_CHAR" ) + end select + end do + + ! Take the file out of define mode + call check( nf90_enddef(nc%id), "encounter_io_initialize nf90_enddef" ) + + ! Add in the space dimension coordinates + call check( nf90_put_var(nc%id, nc%space_varid, nc%space_coords, start=[1], count=[NDIM]), "encounter_io_initialize nf90_put_var space" ) - ! Pre-fill name slots with ids - !call check( nf90_put_var(nc%id, nc%id_varid, [(-1,i=1,param%maxid+1)], start=[1], count=[param%maxid+1]), "encounter_io_initialize nf90_put_var pl id_varid" ) - end select end associate return @@ -205,16 +204,14 @@ module subroutine encounter_io_write_frame(self, nc, param) class(netcdf_parameters), intent(inout) :: nc !! Parameters used to identify a particular encounter io NetCDF dataset class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters ! Internals - integer(I4B) :: i, tslot, idslot, old_mode, npl, ntp + integer(I4B) :: i, idslot, old_mode, npl, ntp character(len=:), allocatable :: charstring - tslot = param%ioutput - associate(pl => self%pl, tp => self%tp) - select type (nc) - class is (encounter_io_parameters) - select type (param) - class is (symba_parameters) - + select type (nc) + class is (encounter_io_parameters) + select type (param) + class is (symba_parameters) + associate(pl => self%pl, tp => self%tp, encounter_history => param%encounter_history, tslot => param%ioutput) call check( nf90_set_fill(nc%id, nf90_nofill, old_mode), "encounter_io_write_frame nf90_set_fill" ) call check( nf90_put_var(nc%id, nc%time_varid, self%t, start=[tslot]), "encounter_io_write_frame nf90_put_var time_varid" ) @@ -222,8 +219,7 @@ module subroutine encounter_io_write_frame(self, nc, param) npl = pl%nbody do i = 1, npl - idslot = pl%id(i) + 1 - idslot = findloc(param%encounter_history%idvals,pl%id(i),dim=1) + idslot = findloc(encounter_history%idvals,pl%id(i),dim=1) call check( nf90_put_var(nc%id, nc%id_varid, pl%id(i), start=[idslot]), "encounter_io_write_frame nf90_put_var pl id_varid" ) call check( nf90_put_var(nc%id, nc%rh_varid, pl%rh(:,i), start=[1,idslot,tslot], count=[NDIM,1,1]), "encounter_io_write_frame nf90_put_var pl rh_varid" ) call check( nf90_put_var(nc%id, nc%vh_varid, pl%vh(:,i), start=[1,idslot,tslot], count=[NDIM,1,1]), "encounter_io_write_frame nf90_put_var pl vh_varid" ) @@ -244,7 +240,7 @@ module subroutine encounter_io_write_frame(self, nc, param) ntp = tp%nbody do i = 1, ntp - idslot = tp%id(i) + 1 + idslot = findloc(param%encounter_history%idvals,tp%id(i),dim=1) call check( nf90_put_var(nc%id, nc%id_varid, tp%id(i), start=[idslot]), "encounter_io_write_frame nf90_put_var tp id_varid" ) call check( nf90_put_var(nc%id, nc%rh_varid, tp%rh(:,i), start=[1,idslot,tslot], count=[NDIM,1,1]), "encounter_io_write_frame nf90_put_var tp rh_varid" ) call check( nf90_put_var(nc%id, nc%vh_varid, tp%vh(:,i), start=[1,idslot,tslot], count=[NDIM,1,1]), "encounter_io_write_frame nf90_put_var tp vh_varid" ) @@ -256,9 +252,9 @@ module subroutine encounter_io_write_frame(self, nc, param) end do call check( nf90_set_fill(nc%id, old_mode, old_mode) ) - end select + end associate end select - end associate + end select return end subroutine encounter_io_write_frame diff --git a/src/encounter/encounter_util.f90 b/src/encounter/encounter_util.f90 index 5c4212253..3a9f4b062 100644 --- a/src/encounter/encounter_util.f90 +++ b/src/encounter/encounter_util.f90 @@ -180,6 +180,97 @@ module subroutine encounter_util_final_storage(self) end subroutine encounter_util_final_storage + module subroutine encounter_util_get_idvalues_snapshot(self, idvals) + !! author: David A. Minton + !! + !! Returns an array of all id values saved in this snapshot + implicit none + ! Arguments + class(encounter_snapshot), intent(in) :: self !! Encounter snapshot object + integer(I4B), dimension(:), allocatable, intent(out) :: idvals !! Array of all id values saved in this snapshot + ! Internals + integer(I4B) :: npl, ntp + + if (allocated(self%pl)) then + npl = self%pl%nbody + else + npl = 0 + end if + if (allocated(self%tp)) then + ntp = self%tp%nbody + else + ntp = 0 + end if + + if (npl + ntp == 0) return + allocate(idvals(npl+ntp)) + + if (npl > 0) idvals(1:npl) = self%pl%id(:) + if (ntp >0) idvals(npl+1:npl+ntp) = self%tp%id(:) + + return + + end subroutine encounter_util_get_idvalues_snapshot + + + subroutine encounter_util_get_vals_storage(storage, idvals, tvals) + !! author: David A. Minton + !! + !! Gets the id values in a storage object, regardless of whether it is encounter of collision + ! Argument + class(swiftest_storage(*)), intent(in) :: storage !! Swiftest storage object + integer(I4B), dimension(:), allocatable, intent(out) :: idvals !! Array of all id values in all snapshots + real(DP), dimension(:), allocatable, intent(out) :: tvals !! Array of all time values in all snapshots + ! Internals + integer(I4B) :: i, n, nlo, nhi, ntotal + integer(I4B), dimension(:), allocatable :: itmp + + associate(nsnaps => storage%iframe) + + allocate(tvals(nsnaps)) + + tvals(:) = 0.0_DP + + ! First pass to get total number of ids + ntotal = 0 + do i = 1, nsnaps + if (allocated(storage%frame(i)%item)) then + select type(snapshot => storage%frame(i)%item) + class is (encounter_snapshot) + tvals(i) = snapshot%t + call snapshot%get_idvals(itmp) + if (allocated(itmp)) then + n = size(itmp) + ntotal = ntotal + n + end if + end select + end if + end do + + allocate(idvals(ntotal)) + nlo = 1 + ! Second pass to store all ids get all of the ids stored + do i = 1, nsnaps + if (allocated(storage%frame(i)%item)) then + select type(snapshot => storage%frame(i)%item) + class is (encounter_snapshot) + tvals(i) = snapshot%t + call snapshot%get_idvals(itmp) + if (allocated(itmp)) then + n = size(itmp) + nhi = nlo + n - 1 + idvals(nlo:nhi) = itmp(1:n) + nlo = nhi + 1 + end if + end select + end if + end do + + end associate + return + end subroutine encounter_util_get_vals_storage + + module subroutine encounter_util_index_map_encounter(self) !! author: David A. Minton !! @@ -189,43 +280,17 @@ module subroutine encounter_util_index_map_encounter(self) ! Arguments class(encounter_storage(*)), intent(inout) :: self !! Swiftest storage object ! Internals - ! Internals - integer(I4B) :: i, n, nold, nt - integer(I4B), dimension(:), allocatable :: idvals, tmp + integer(I4B), dimension(:), allocatable :: idvals real(DP), dimension(:), allocatable :: tvals - if (self%nid == 0) return - allocate(idvals(self%nid)) - allocate(tvals(self%nframes)) - - n = 0 - nold = 1 - do i = 1, self%nframes - if (allocated(self%frame(i)%item)) then - select type(snapshot => self%frame(i)%item) - class is (encounter_snapshot) - tvals(i) = snapshot%t - if (allocated(snapshot%pl)) then - n = n + snapshot%pl%nbody - idvals(nold:n) = snapshot%pl%id(:) - nold = n+1 - end if - if (allocated(snapshot%tp)) then - n = n + snapshot%tp%nbody - idvals(nold:n) = snapshot%tp%id(:) - nold = n+1 - end if - end select - else - nt = i-1 - exit - end if - end do + call encounter_util_get_vals_storage(self, idvals, tvals) + ! Consolidate ids to only unique values call util_unique(idvals,self%idvals,self%idmap) self%nid = size(self%idvals) - call util_unique(tvals(1:nt),self%tvals,self%tmap) + ! Consolidate time values to only unique values + call util_unique(tvals,self%tvals,self%tmap) self%nt = size(self%tvals) return @@ -239,8 +304,19 @@ module subroutine encounter_util_index_map_collision(self) !! Maps body id values to storage index values so we don't have to use unlimited dimensions for id implicit none ! Arguments - class(collision_storage(*)), intent(inout) :: self !! Swiftest storage object + class(collision_storage(*)), intent(inout) :: self !! Swiftest storage object ! Internals + integer(I4B), dimension(:), allocatable :: idvals + real(DP), dimension(:), allocatable :: tvals + + call encounter_util_get_vals_storage(self, idvals, tvals) + + ! Consolidate ids to only unique values + call util_unique(idvals,self%idvals,self%idmap) + self%nid = size(self%idvals) + + ! Don't consolidate time values (multiple collisions can happen in a single time step) + self%nt = size(self%tvals) return end subroutine encounter_util_index_map_collision @@ -428,7 +504,7 @@ module subroutine encounter_util_snapshot_collision(self, param, system, t, arg) real(DP), intent(in), optional :: t !! Time of snapshot if different from system time character(*), intent(in), optional :: arg !! Optional argument (needed for extended storage type used in collision snapshots) ! Arguments - class(fraggle_collision_snapshot), allocatable :: snapshot + class(fraggle_snapshot), allocatable :: snapshot type(symba_pl) :: pl character(len=:), allocatable :: stage integer(I4B) :: i,j @@ -460,7 +536,7 @@ module subroutine encounter_util_snapshot_collision(self, param, system, t, arg) allocate(system%colliders%pl, source=pl) end associate case("after") - allocate(fraggle_collision_snapshot :: snapshot) + allocate(fraggle_snapshot :: snapshot) allocate(snapshot%colliders, source=system%colliders) allocate(snapshot%fragments, source=system%fragments) select type (param) diff --git a/src/fraggle/fraggle_io.f90 b/src/fraggle/fraggle_io.f90 index d4a8d3d9e..ff20394e7 100644 --- a/src/fraggle/fraggle_io.f90 +++ b/src/fraggle/fraggle_io.f90 @@ -30,115 +30,116 @@ module subroutine fraggle_io_initialize_output(self, param) character(len=STRMAX) :: errmsg integer(I4B) :: i, ndims - associate(nc => self) - dfill = ieee_value(dfill, IEEE_QUIET_NAN) - sfill = ieee_value(sfill, IEEE_QUIET_NAN) - - select case (param%out_type) - case("NETCDF_FLOAT") - self%out_type = NF90_FLOAT - case("NETCDF_DOUBLE") - self%out_type = NF90_DOUBLE - end select + select type(param) + class is (symba_parameters) + associate(nc => self, collision_history => param%collision_history) + dfill = ieee_value(dfill, IEEE_QUIET_NAN) + sfill = ieee_value(sfill, IEEE_QUIET_NAN) + + select case (param%out_type) + case("NETCDF_FLOAT") + self%out_type = NF90_FLOAT + case("NETCDF_DOUBLE") + self%out_type = NF90_DOUBLE + end select - ! Check if the file exists, and if it does, delete it - inquire(file=nc%file_name, exist=fileExists) - if (fileExists) then - open(unit=LUN, file=nc%file_name, status="old", err=667, iomsg=errmsg) - close(unit=LUN, status="delete") - end if - - call check( nf90_create(nc%file_name, NF90_NETCDF4, nc%id), "fraggle_io_initialize nf90_create" ) - - ! Dimensions - call check( nf90_def_dim(nc%id, nc%event_dimname, nc%event_dimsize, nc%event_dimid), "fraggle_io_initialize nf90_def_dim event_dimid" ) ! Dimension to store individual collision events - call check( nf90_def_dim(nc%id, nc%space_dimname, NDIM, nc%space_dimid), "fraggle_io_initialize nf90_def_dim space_dimid" ) ! 3D space dimension - call check( nf90_def_dim(nc%id, nc%id_dimname, param%maxid+1, nc%id_dimid), "fraggle_io_initialize nf90_def_dim id_dimid" ) ! Dimension to store particle id numbers - call check( nf90_def_dim(nc%id, nc%str_dimname, NAMELEN, nc%str_dimid), "fraggle_io_initialize nf90_def_dim str_dimid" ) ! Dimension for string variables (aka character arrays) - call check( nf90_def_dim(nc%id, nc%stage_dimname, 2, nc%stage_dimid), "fraggle_io_initialize nf90_def_dim stage_dimid" ) ! Dimension for stage variables (aka "before" vs. "after" - - ! Dimension coordinates - call check( nf90_def_var(nc%id, nc%space_dimname, NF90_CHAR, nc%space_dimid, nc%space_varid), "fraggle_io_initialize nf90_def_var space_varid" ) - call check( nf90_def_var(nc%id, nc%id_dimname, NF90_INT, nc%id_dimid, nc%id_varid), "fraggle_io_initialize nf90_def_var id_varid" ) - call check( nf90_def_var(nc%id, nc%stage_dimname, NF90_CHAR, [nc%str_dimid, nc%stage_dimid], nc%stage_varid), "fraggle_io_initialize nf90_def_var stage_varid" ) - - ! Variables - call check( nf90_def_var(nc%id, nc%time_dimname, nc%out_type, & - nc%event_dimid, nc%time_varid), "fraggle_io_initialize nf90_def_var time_varid" ) - call check( nf90_def_var(nc%id, nc%regime_varname, NF90_CHAR, & - [nc%str_dimid, nc%event_dimid], nc%regime_varid), "fraggle_io_initialize nf90_def_var regime_varid") - call check( nf90_def_var(nc%id, nc%Qloss_varname, nc%out_type, & - [ nc%event_dimid], nc%Qloss_varid), "fraggle_io_initialize nf90_def_var Qloss_varid") - call check( nf90_def_var(nc%id, nc%name_varname, NF90_CHAR, & - [nc%str_dimid, nc%id_dimid ], nc%name_varid), "fraggle_io_initialize nf90_def_var name_varid") + ! Check if the file exists, and if it does, delete it + inquire(file=nc%file_name, exist=fileExists) + if (fileExists) then + open(unit=LUN, file=nc%file_name, status="old", err=667, iomsg=errmsg) + close(unit=LUN, status="delete") + end if + + call check( nf90_create(nc%file_name, NF90_NETCDF4, nc%id), "fraggle_io_initialize nf90_create" ) + + ! Dimensions + call check( nf90_def_dim(nc%id, nc%event_dimname, nc%event_dimsize, nc%event_dimid), "fraggle_io_initialize nf90_def_dim event_dimid" ) ! Dimension to store individual collision events + call check( nf90_def_dim(nc%id, nc%space_dimname, NDIM, nc%space_dimid), "fraggle_io_initialize nf90_def_dim space_dimid" ) ! 3D space dimension + call check( nf90_def_dim(nc%id, nc%id_dimname, nc%id_dimsize, nc%id_dimid), "fraggle_io_initialize nf90_def_dim id_dimid" ) ! Dimension to store particle id numbers + call check( nf90_def_dim(nc%id, nc%str_dimname, NAMELEN, nc%str_dimid), "fraggle_io_initialize nf90_def_dim str_dimid" ) ! Dimension for string variables (aka character arrays) + call check( nf90_def_dim(nc%id, nc%stage_dimname, 2, nc%stage_dimid), "fraggle_io_initialize nf90_def_dim stage_dimid" ) ! Dimension for stage variables (aka "before" vs. "after" + + ! Dimension coordinates + call check( nf90_def_var(nc%id, nc%space_dimname, NF90_CHAR, nc%space_dimid, nc%space_varid), "fraggle_io_initialize nf90_def_var space_varid" ) + call check( nf90_def_var(nc%id, nc%id_dimname, NF90_INT, nc%id_dimid, nc%id_varid), "fraggle_io_initialize nf90_def_var id_varid" ) + call check( nf90_def_var(nc%id, nc%stage_dimname, NF90_CHAR, [nc%str_dimid, nc%stage_dimid], nc%stage_varid), "fraggle_io_initialize nf90_def_var stage_varid" ) - call check( nf90_def_var(nc%id, nc%ptype_varname, NF90_CHAR, & - [nc%str_dimid, nc%id_dimid, nc%stage_dimid, nc%event_dimid], nc%ptype_varid), "fraggle_io_initialize nf90_def_var ptype_varid") + ! Variables + call check( nf90_def_var(nc%id, nc%time_dimname, nc%out_type, & + nc%event_dimid, nc%time_varid), "fraggle_io_initialize nf90_def_var time_varid" ) + call check( nf90_def_var(nc%id, nc%regime_varname, NF90_CHAR, & + [nc%str_dimid, nc%event_dimid], nc%regime_varid), "fraggle_io_initialize nf90_def_var regime_varid") + call check( nf90_def_var(nc%id, nc%Qloss_varname, nc%out_type, & + [ nc%event_dimid], nc%Qloss_varid), "fraggle_io_initialize nf90_def_var Qloss_varid") + call check( nf90_def_var(nc%id, nc%name_varname, NF90_CHAR, & + [nc%str_dimid, nc%id_dimid ], nc%name_varid), "fraggle_io_initialize nf90_def_var name_varid") + + call check( nf90_def_var(nc%id, nc%ptype_varname, NF90_CHAR, & + [nc%str_dimid, nc%id_dimid, nc%stage_dimid, nc%event_dimid], nc%ptype_varid), "fraggle_io_initialize nf90_def_var ptype_varid") - call check( nf90_def_var(nc%id, nc%loop_varname, NF90_INT, & - [ nc%event_dimid], nc%loop_varid), "fraggle_io_initialize nf90_def_var loop_varid") + call check( nf90_def_var(nc%id, nc%loop_varname, NF90_INT, & + [ nc%event_dimid], nc%loop_varid), "fraggle_io_initialize nf90_def_var loop_varid") - call check( nf90_def_var(nc%id, nc%rh_varname, nc%out_type,& - [ nc%space_dimid, nc%id_dimid, nc%stage_dimid, nc%event_dimid], nc%rh_varid), "fraggle_io_initialize nf90_def_var rh_varid") + call check( nf90_def_var(nc%id, nc%rh_varname, nc%out_type,& + [ nc%space_dimid, nc%id_dimid, nc%stage_dimid, nc%event_dimid], nc%rh_varid), "fraggle_io_initialize nf90_def_var rh_varid") - call check( nf90_def_var(nc%id, nc%vh_varname, nc%out_type,& - [ nc%space_dimid, nc%id_dimid, nc%stage_dimid, nc%event_dimid], nc%vh_varid), "fraggle_io_initialize nf90_def_var vh_varid") + call check( nf90_def_var(nc%id, nc%vh_varname, nc%out_type,& + [ nc%space_dimid, nc%id_dimid, nc%stage_dimid, nc%event_dimid], nc%vh_varid), "fraggle_io_initialize nf90_def_var vh_varid") - call check( nf90_def_var(nc%id, nc%Gmass_varname, nc%out_type,& - [ nc%id_dimid, nc%stage_dimid, nc%event_dimid], nc%Gmass_varid), "fraggle_io_initialize nf90_def_var Gmass_varid") + call check( nf90_def_var(nc%id, nc%Gmass_varname, nc%out_type,& + [ nc%id_dimid, nc%stage_dimid, nc%event_dimid], nc%Gmass_varid), "fraggle_io_initialize nf90_def_var Gmass_varid") - call check( nf90_def_var(nc%id, nc%radius_varname, nc%out_type,& - [ nc%id_dimid, nc%stage_dimid, nc%event_dimid], nc%radius_varid), "fraggle_io_initialize nf90_def_var radius_varid") + call check( nf90_def_var(nc%id, nc%radius_varname, nc%out_type,& + [ nc%id_dimid, nc%stage_dimid, nc%event_dimid], nc%radius_varid), "fraggle_io_initialize nf90_def_var radius_varid") - call check( nf90_def_var(nc%id, nc%Ip_varname, nc%out_type,& - [ nc%space_dimid, nc%id_dimid, nc%stage_dimid, nc%event_dimid], nc%Ip_varid), "fraggle_io_initialize nf90_def_var Ip_varid") + call check( nf90_def_var(nc%id, nc%Ip_varname, nc%out_type,& + [ nc%space_dimid, nc%id_dimid, nc%stage_dimid, nc%event_dimid], nc%Ip_varid), "fraggle_io_initialize nf90_def_var Ip_varid") - call check( nf90_def_var(nc%id, nc%rot_varname, nc%out_type,& - [ nc%space_dimid, nc%id_dimid, nc%stage_dimid, nc%event_dimid], nc%rot_varid), "fraggle_io_initialize nf90_def_var rot_varid") + call check( nf90_def_var(nc%id, nc%rot_varname, nc%out_type,& + [ nc%space_dimid, nc%id_dimid, nc%stage_dimid, nc%event_dimid], nc%rot_varid), "fraggle_io_initialize nf90_def_var rot_varid") - call check( nf90_def_var(nc%id, nc%ke_orb_varname, nc%out_type,& - [ nc%stage_dimid, nc%event_dimid], nc%KE_orb_varid), "fraggle_io_initialize_output nf90_def_var KE_orb_varid") + call check( nf90_def_var(nc%id, nc%ke_orb_varname, nc%out_type,& + [ nc%stage_dimid, nc%event_dimid], nc%KE_orb_varid), "fraggle_io_initialize_output nf90_def_var KE_orb_varid") - call check( nf90_def_var(nc%id, nc%ke_spin_varname, nc%out_type,& - [ nc%stage_dimid, nc%event_dimid], nc%KE_spin_varid), "fraggle_io_initialize_output nf90_def_var KE_spin_varid" ) + call check( nf90_def_var(nc%id, nc%ke_spin_varname, nc%out_type,& + [ nc%stage_dimid, nc%event_dimid], nc%KE_spin_varid), "fraggle_io_initialize_output nf90_def_var KE_spin_varid" ) - call check( nf90_def_var(nc%id, nc%pe_varname, nc%out_type,& - [ nc%stage_dimid, nc%event_dimid], nc%PE_varid), "fraggle_io_initialize_output nf90_def_var PE_varid" ) + call check( nf90_def_var(nc%id, nc%pe_varname, nc%out_type,& + [ nc%stage_dimid, nc%event_dimid], nc%PE_varid), "fraggle_io_initialize_output nf90_def_var PE_varid" ) - call check( nf90_def_var(nc%id, nc%L_orb_varname, nc%out_type, & - [ nc%space_dimid, nc%stage_dimid, nc%event_dimid], nc%L_orb_varid), "fraggle_io_initialize_output nf90_def_var L_orb_varid" ) + call check( nf90_def_var(nc%id, nc%L_orb_varname, nc%out_type, & + [ nc%space_dimid, nc%stage_dimid, nc%event_dimid], nc%L_orb_varid), "fraggle_io_initialize_output nf90_def_var L_orb_varid" ) - call check( nf90_def_var(nc%id, nc%L_spin_varname, nc%out_type,& - [ nc%space_dimid, nc%stage_dimid, nc%event_dimid], nc%L_spin_varid), "fraggle_io_initialize_output nf90_def_var L_spin_varid" ) + call check( nf90_def_var(nc%id, nc%L_spin_varname, nc%out_type,& + [ nc%space_dimid, nc%stage_dimid, nc%event_dimid], nc%L_spin_varid), "fraggle_io_initialize_output nf90_def_var L_spin_varid" ) - call check( nf90_inquire(nc%id, nVariables=nvar), "fraggle_io_initialize nf90_inquire nVariables" ) - do varid = 1, nvar - call check( nf90_inquire_variable(nc%id, varid, xtype=vartype, ndims=ndims), "fraggle_io_initialize nf90_inquire_variable" ) - select case(vartype) - case(NF90_INT) - call check( nf90_def_var_fill(nc%id, varid, 0, NF90_FILL_INT), "fraggle_io_initialize nf90_def_var_fill NF90_INT" ) - case(NF90_FLOAT) - call check( nf90_def_var_fill(nc%id, varid, 0, sfill), "fraggle_io_initialize nf90_def_var_fill NF90_FLOAT" ) - case(NF90_DOUBLE) - call check( nf90_def_var_fill(nc%id, varid, 0, dfill), "fraggle_io_initialize nf90_def_var_fill NF90_DOUBLE" ) - case(NF90_CHAR) - call check( nf90_def_var_fill(nc%id, varid, 0, 0), "fraggle_io_initialize nf90_def_var_fill NF90_CHAR" ) - end select - end do - ! Take the file out of define mode - call check( nf90_enddef(nc%id), "fraggle_io_initialize nf90_enddef" ) + call check( nf90_inquire(nc%id, nVariables=nvar), "fraggle_io_initialize nf90_inquire nVariables" ) + do varid = 1, nvar + call check( nf90_inquire_variable(nc%id, varid, xtype=vartype, ndims=ndims), "fraggle_io_initialize nf90_inquire_variable" ) + select case(vartype) + case(NF90_INT) + call check( nf90_def_var_fill(nc%id, varid, 0, NF90_FILL_INT), "fraggle_io_initialize nf90_def_var_fill NF90_INT" ) + case(NF90_FLOAT) + call check( nf90_def_var_fill(nc%id, varid, 0, sfill), "fraggle_io_initialize nf90_def_var_fill NF90_FLOAT" ) + case(NF90_DOUBLE) + call check( nf90_def_var_fill(nc%id, varid, 0, dfill), "fraggle_io_initialize nf90_def_var_fill NF90_DOUBLE" ) + case(NF90_CHAR) + call check( nf90_def_var_fill(nc%id, varid, 0, 0), "fraggle_io_initialize nf90_def_var_fill NF90_CHAR" ) + end select + end do + ! Take the file out of define mode + call check( nf90_enddef(nc%id), "fraggle_io_initialize nf90_enddef" ) - ! Add in the space and stage dimension coordinates - call check( nf90_put_var(nc%id, nc%space_varid, nc%space_coords, start=[1], count=[NDIM]), "fraggle_io_initialize nf90_put_var space" ) - call check( nf90_put_var(nc%id, nc%stage_varid, nc%stage_coords(1), start=[1,1], count=[len(nc%stage_coords(1)),1]), "fraggle_io_initialize nf90_put_var stage 1" ) - call check( nf90_put_var(nc%id, nc%stage_varid, nc%stage_coords(2), start=[1,2], count=[len(nc%stage_coords(2)),1]), "fraggle_io_initialize nf90_put_var stage 2" ) + ! Add in the space and stage dimension coordinates + call check( nf90_put_var(nc%id, nc%space_varid, nc%space_coords, start=[1], count=[NDIM]), "fraggle_io_initialize nf90_put_var space" ) + call check( nf90_put_var(nc%id, nc%stage_varid, nc%stage_coords(1), start=[1,1], count=[len(nc%stage_coords(1)),1]), "fraggle_io_initialize nf90_put_var stage 1" ) + call check( nf90_put_var(nc%id, nc%stage_varid, nc%stage_coords(2), start=[1,2], count=[len(nc%stage_coords(2)),1]), "fraggle_io_initialize nf90_put_var stage 2" ) - ! Pre-fill id slots with ids - call check( nf90_put_var(nc%id, nc%id_varid, [(-1,i=1,param%maxid+1)], start=[1], count=[param%maxid+1]), "fraggle_io_initialize nf90_put_varid_varid" ) - end associate + end associate + end select return @@ -155,20 +156,19 @@ module subroutine fraggle_io_write_frame(self, nc, param) use netcdf implicit none ! Arguments - class(fraggle_collision_snapshot), intent(in) :: self !! Swiftest encounter structure + class(fraggle_snapshot), intent(in) :: self !! Swiftest encounter structure class(netcdf_parameters), intent(inout) :: nc !! Parameters used to identify a particular encounter io NetCDF dataset class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters ! Internals - integer(I4B) :: i, eslot, idslot, old_mode, npl, stage + integer(I4B) :: i, idslot, old_mode, npl, stage character(len=:), allocatable :: charstring class(swiftest_pl), allocatable :: pl - associate(colliders => self%colliders, fragments => self%fragments) - select type(nc) - class is (encounter_io_parameters) - eslot = param%ioutput - select type(nc) - class is (fraggle_io_parameters) + select type(nc) + class is (fraggle_io_parameters) + select type (param) + class is (symba_parameters) + associate(colliders => self%colliders, fragments => self%fragments, collision_history => param%collision_history, eslot => param%ioutput) call check( nf90_set_fill(nc%id, nf90_nofill, old_mode), "fraggle_io_write_frame nf90_set_fill" ) call check( nf90_put_var(nc%id, nc%time_varid, self%t, start=[eslot]), "fraggle_io_write_frame nf90_put_var time_varid" ) @@ -188,7 +188,7 @@ module subroutine fraggle_io_write_frame(self, nc, param) end select npl = pl%nbody do i = 1, npl - idslot = pl%id(i) + 1 + idslot = findloc(collision_history%idvals,pl%id(i),dim=1) call check( nf90_put_var(nc%id, nc%id_varid, pl%id(i), start=[ idslot ]), "fraggle_io_write_frame nf90_put_var id_varid" ) charstring = trim(adjustl(pl%info(i)%name)) call check( nf90_put_var(nc%id, nc%name_varid, charstring, start=[1, idslot ], count=[len(charstring), 1]), "fraggle_io_write_frame nf90_put_var name_varid" ) @@ -212,9 +212,9 @@ module subroutine fraggle_io_write_frame(self, nc, param) call check( nf90_put_var(nc%id, nc%L_spin_varid, fragments%Lspin_after(:), start=[1, 2, eslot], count=[NDIM, 1, 1]), "fraggle_io_write_frame nf90_put_var L_spin_varid after" ) call check( nf90_set_fill(nc%id, old_mode, old_mode) ) - end select + end associate end select - end associate + end select return end subroutine fraggle_io_write_frame diff --git a/src/fraggle/fraggle_util.f90 b/src/fraggle/fraggle_util.f90 index 2f708859c..22ca5cd55 100644 --- a/src/fraggle/fraggle_util.f90 +++ b/src/fraggle/fraggle_util.f90 @@ -174,7 +174,7 @@ module subroutine fraggle_util_final_snapshot(self) !! Finalizer will deallocate all allocatables implicit none ! Arguments - type(fraggle_collision_snapshot), intent(inout) :: self !! Fraggle encountar storage object + type(fraggle_snapshot), intent(inout) :: self !! Fraggle encountar storage object call encounter_util_final_snapshot(self%encounter_snapshot) @@ -257,6 +257,40 @@ module subroutine fraggle_util_get_energy_momentum(self, colliders, system, para end subroutine fraggle_util_get_energy_momentum + module subroutine fraggle_util_get_idvalues_snapshot(self, idvals) + !! author: David A. Minton + !! + !! Returns an array of all id values saved in this snapshot + implicit none + ! Arguments + class(fraggle_snapshot), intent(in) :: self !! Fraggle snapshot object + integer(I4B), dimension(:), allocatable, intent(out) :: idvals !! Array of all id values saved in this snapshot + ! Internals + integer(I4B) :: ncoll, nfrag + + if (allocated(self%colliders)) then + ncoll = self%colliders%pl%nbody + else + ncoll = 0 + end if + + if (allocated(self%fragments)) then + nfrag = self%fragments%pl%nbody + else + nfrag = 0 + end if + + if (ncoll + nfrag == 0) return + allocate(idvals(ncoll+nfrag)) + + if (ncoll > 0) idvals(1:ncoll) = self%colliders%pl%id(:) + if (nfrag > 0) idvals(ncoll+1:ncoll+nfrag) = self%fragments%pl%id(:) + + return + + end subroutine fraggle_util_get_idvalues_snapshot + + module subroutine fraggle_util_restructure(self, colliders, try, f_spin, r_max_start) !! Author: David A. Minton !! diff --git a/src/modules/encounter_classes.f90 b/src/modules/encounter_classes.f90 index f9ed5b896..f5429fd12 100644 --- a/src/modules/encounter_classes.f90 +++ b/src/modules/encounter_classes.f90 @@ -49,7 +49,8 @@ module encounter_classes real(DP) :: t !! Simulation time when snapshot was taken integer(I8B) :: iloop !! Loop number at time of snapshot contains - procedure :: write_frame => encounter_io_write_frame !! Writes a frame of encounter data to file + procedure :: write_frame => encounter_io_write_frame !! Writes a frame of encounter data to file + procedure :: get_idvals => encounter_util_get_idvalues_snapshot !! Gets an array of all id values saved in this snapshot final :: encounter_util_final_snapshot end type encounter_snapshot @@ -68,8 +69,8 @@ module encounter_classes type, extends(swiftest_storage) :: collision_storage contains procedure :: dump => encounter_io_dump_collision !! Dumps contents of encounter history to file - procedure :: make_index_map => encounter_util_index_map_collision !! Maps body id values to storage index values so we don't have to use unlimited dimensions for id - procedure :: take_snapshot => encounter_util_snapshot_collision !! Take a minimal snapshot of the system through an encounter + procedure :: take_snapshot => encounter_util_snapshot_collision !! Take a minimal snapshot of the system through an encounter + procedure :: make_index_map => encounter_util_index_map_collision !! Maps body id values to storage index values so we don't have to use unlimited dimensions for id final :: encounter_util_final_collision_storage end type collision_storage @@ -300,14 +301,20 @@ module subroutine encounter_util_final_storage(self) type(encounter_storage(*)), intent(inout) :: self !! SyMBA nbody system object end subroutine encounter_util_final_storage + module subroutine encounter_util_get_idvalues_snapshot(self, idvals) + implicit none + class(encounter_snapshot), intent(in) :: self !! Encounter snapshot object + integer(I4B), dimension(:), allocatable, intent(out) :: idvals !! Array of all id values saved in this snapshot + end subroutine encounter_util_get_idvalues_snapshot + module subroutine encounter_util_index_map_collision(self) implicit none - class(collision_storage(*)), intent(inout) :: self !! E + class(collision_storage(*)), intent(inout) :: self !! Collision storage object end subroutine encounter_util_index_map_collision module subroutine encounter_util_index_map_encounter(self) implicit none - class(encounter_storage(*)), intent(inout) :: self !! Swiftest storage object + class(encounter_storage(*)), intent(inout) :: self !! Encounter storage object end subroutine encounter_util_index_map_encounter module subroutine encounter_util_resize_list(self, nnew) diff --git a/src/modules/fraggle_classes.f90 b/src/modules/fraggle_classes.f90 index 2bd120b83..989399f94 100644 --- a/src/modules/fraggle_classes.f90 +++ b/src/modules/fraggle_classes.f90 @@ -132,14 +132,15 @@ module fraggle_classes procedure :: initialize => fraggle_io_initialize_output !! Initialize a set of parameters used to identify a NetCDF output object end type fraggle_io_parameters - type, extends(encounter_snapshot) :: fraggle_collision_snapshot + type, extends(encounter_snapshot) :: fraggle_snapshot logical :: lcollision !! Indicates that this snapshot contains at least one collision class(fraggle_colliders), allocatable :: colliders !! Colliders object at this snapshot class(fraggle_fragments), allocatable :: fragments !! Fragments object at this snapshot contains procedure :: write_frame => fraggle_io_write_frame !! Writes a frame of encounter data to file + procedure :: get_idvals => fraggle_util_get_idvalues_snapshot !! Gets an array of all id values saved in this snapshot final :: fraggle_util_final_snapshot - end type fraggle_collision_snapshot + end type fraggle_snapshot interface module subroutine fraggle_generate_fragments(self, colliders, system, param, lfailure) @@ -160,7 +161,7 @@ end subroutine fraggle_io_initialize_output module subroutine fraggle_io_write_frame(self, nc, param) implicit none - class(fraggle_collision_snapshot), intent(in) :: self !! Swiftest encounter structure + class(fraggle_snapshot), intent(in) :: self !! Swiftest encounter structure class(netcdf_parameters), intent(inout) :: nc !! Parameters used to identify a particular encounter io NetCDF dataset class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters end subroutine fraggle_io_write_frame @@ -295,7 +296,7 @@ end subroutine fraggle_util_final_fragments module subroutine fraggle_util_final_snapshot(self) implicit none - type(fraggle_collision_snapshot), intent(inout) :: self !! Fraggle storage snapshot object + type(fraggle_snapshot), intent(inout) :: self !! Fraggle storage snapshot object end subroutine fraggle_util_final_snapshot module subroutine fraggle_util_get_energy_momentum(self, colliders, system, param, lbefore) @@ -308,6 +309,12 @@ module subroutine fraggle_util_get_energy_momentum(self, colliders, system, para logical, intent(in) :: lbefore !! Flag indicating that this the "before" state of the system, with colliders included and fragments excluded or vice versa end subroutine fraggle_util_get_energy_momentum + module subroutine fraggle_util_get_idvalues_snapshot(self, idvals) + implicit none + class(fraggle_snapshot), intent(in) :: self !! Fraggle snapshot object + integer(I4B), dimension(:), allocatable, intent(out) :: idvals !! Array of all id values saved in this snapshot + end subroutine fraggle_util_get_idvalues_snapshot + module subroutine fraggle_util_restructure(self, colliders, try, f_spin, r_max_start) implicit none class(fraggle_fragments), intent(inout) :: self !! Fraggle fragment system object diff --git a/src/modules/swiftest_classes.f90 b/src/modules/swiftest_classes.f90 index b89e9eee8..6dc6a9877 100644 --- a/src/modules/swiftest_classes.f90 +++ b/src/modules/swiftest_classes.f90 @@ -556,6 +556,7 @@ module swiftest_classes ! procedure :: step_spin => tides_step_spin_system !! Steps the spins of the massive & central bodies due to tides. procedure :: set_msys => util_set_msys !! Sets the value of msys from the masses of system bodies. procedure :: get_energy_and_momentum => util_get_energy_momentum_system !! Calculates the total system energy and momentum + procedure :: get_idvals => util_get_idvalues_system !! Returns an array of all id values in use in the system procedure :: rescale => util_rescale_system !! Rescales the system into a new set of units procedure :: validate_ids => util_valid_id_system !! Validate the numerical ids passed to the system and save the maximum value generic :: write_frame => write_frame_system, write_frame_netcdf !! Generic method call for reading a frame of output data @@ -1620,6 +1621,12 @@ module subroutine util_get_energy_momentum_system(self, param) class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters end subroutine util_get_energy_momentum_system + module subroutine util_get_idvalues_system(self, idvals) + implicit none + class(swiftest_nbody_system), intent(in) :: self !! Encounter snapshot object + integer(I4B), dimension(:), allocatable, intent(out) :: idvals !! Array of all id values saved in this snapshot + end subroutine util_get_idvalues_system + module subroutine util_set_beg_end_pl(self, xbeg, xend, vbeg) implicit none class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object diff --git a/src/util/util_index.f90 b/src/util/util_index.f90 index ae4a80ce8..0fbd40319 100644 --- a/src/util/util_index.f90 +++ b/src/util/util_index.f90 @@ -45,55 +45,113 @@ module subroutine util_index_array(ind_arr, n) end subroutine util_index_array + module subroutine util_get_idvalues_system(self, idvals) + !! author: David A. Minton + !! + !! Returns an array of all id values saved in this snapshot + implicit none + ! Arguments + class(swiftest_nbody_system), intent(in) :: self !! Encounter snapshot object + integer(I4B), dimension(:), allocatable, intent(out) :: idvals !! Array of all id values saved in this snapshot + ! Internals + integer(I4B) :: npl, ntp + + if (allocated(self%pl)) then + npl = self%pl%nbody + else + npl = 0 + end if + if (allocated(self%tp)) then + ntp = self%tp%nbody + else + ntp = 0 + end if + + allocate(idvals(1 + npl+ntp)) + + idvals(1) = self%cb%id + if (npl > 0) idvals(2:npl+1) = self%pl%id(:) + if (ntp > 0) idvals(npl+2:npl+ntp+1) = self%tp%id(:) + + return + + end subroutine util_get_idvalues_system + + + subroutine util_get_vals_storage(storage, idvals, tvals) + !! author: David A. Minton + !! + !! Gets the id values in a storage object, regardless of whether it is encounter of collision + ! Argument + class(swiftest_storage(*)), intent(in) :: storage !! Swiftest storage object + integer(I4B), dimension(:), allocatable, intent(out) :: idvals !! Array of all id values in all snapshots + real(DP), dimension(:), allocatable, intent(out) :: tvals !! Array of all time values in all snapshots + ! Internals + integer(I4B) :: i, n, nlo, nhi, ntotal + integer(I4B), dimension(:), allocatable :: itmp + + associate(nsnaps => storage%iframe) + + allocate(tvals(nsnaps)) + tvals(:) = 0.0_DP + + ! First pass to get total number of ids + ntotal = 0 + do i = 1, nsnaps + if (allocated(storage%frame(i)%item)) then + select type(snapshot => storage%frame(i)%item) + class is (swiftest_nbody_system) + tvals(i) = snapshot%t + call snapshot%get_idvals(itmp) + if (allocated(itmp)) then + n = size(itmp) + ntotal = ntotal + n + end if + end select + end if + end do + + allocate(idvals(ntotal)) + nlo = 1 + ! Second pass to store all ids get all of the ids stored + do i = 1, nsnaps + if (allocated(storage%frame(i)%item)) then + select type(snapshot => storage%frame(i)%item) + class is (swiftest_nbody_system) + tvals(i) = snapshot%t + call snapshot%get_idvals(itmp) + if (allocated(itmp)) then + n = size(itmp) + nhi = nlo + n - 1 + idvals(nlo:nhi) = itmp(1:n) + nlo = nhi + 1 + end if + end select + end if + end do + + end associate + return + end subroutine util_get_vals_storage + + module subroutine util_index_map_storage(self) !! author: David A. Minton !! !! Maps body id values to storage index values so we don't have to use unlimited dimensions for id implicit none ! Arguments - class(swiftest_storage(*)), intent(inout) :: self !! Swiftest storage object + class(swiftest_storage(*)), intent(inout) :: self !! Swiftest storage object ! Internals - integer(I4B) :: i, n, nold, nt integer(I4B), dimension(:), allocatable :: idvals real(DP), dimension(:), allocatable :: tvals - - if (self%nid == 0) return - allocate(idvals(self%nid)) - allocate(tvals(self%nframes)) - - n = 0 - nold = 1 - nt = 0 - do i = 1, self%nframes - if (allocated(self%frame(i)%item)) then - nt = i - select type(snapshot => self%frame(i)%item) - class is (swiftest_nbody_system) - tvals(i) = snapshot%t - ! Central body - n = n + 1 - idvals(n) = snapshot%cb%id - nold = n + 1 - if (allocated(snapshot%pl)) then - n = n + snapshot%pl%nbody - idvals(nold:n) = snapshot%pl%id(:) - nold = n+1 - end if - if (allocated(snapshot%tp)) then - n = n + snapshot%tp%nbody - idvals(nold:n) = snapshot%tp%id(:) - nold = n+1 - end if - end select - else - exit - end if - end do + + call util_get_vals_storage(self, idvals, tvals) call util_unique(idvals,self%idvals,self%idmap) self%nid = size(self%idvals) - call util_unique(tvals(1:nt),self%tvals,self%tmap) + call util_unique(tvals,self%tvals,self%tmap) self%nt = size(self%tvals) return From c12ec199c83487737eb7eace7bbd895283bedef7 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Mon, 12 Dec 2022 12:55:08 -0500 Subject: [PATCH 392/569] Collisions are now processed in the Python side --- python/swiftest/swiftest/io.py | 6 +-- python/swiftest/swiftest/simulation_class.py | 44 ++++++++++++++++---- src/io/io.f90 | 2 +- src/symba/symba_io.f90 | 2 +- 4 files changed, 42 insertions(+), 12 deletions(-) diff --git a/python/swiftest/swiftest/io.py b/python/swiftest/swiftest/io.py index 5331e50fd..beb5ebab9 100644 --- a/python/swiftest/swiftest/io.py +++ b/python/swiftest/swiftest/io.py @@ -33,7 +33,7 @@ "TSTART", "DUMP_CADENCE", "ENCOUNTER_SAVE", - "FRAGMENTATION_SAVE") + "COLLISION_SAVE") @@ -55,14 +55,14 @@ float_param = ["T0", "TSTART", "TSTOP", "DT", "CHK_RMIN", "CHK_RMAX", "CHK_EJECT", "CHK_QMIN", "DU2M", "MU2KG", "TU2S", "MIN_GMFRAG", "GMTINY"] -upper_str_param = ["OUT_TYPE","OUT_FORM","OUT_STAT","IN_TYPE","IN_FORM","ENCOUNTER_SAVE","FRAGMENTATION_SAVE", "CHK_QMIN_COORD"] +upper_str_param = ["OUT_TYPE","OUT_FORM","OUT_STAT","IN_TYPE","IN_FORM","ENCOUNTER_SAVE","COLLISION_SAVE", "CHK_QMIN_COORD"] lower_str_param = ["NC_IN", "PL_IN", "TP_IN", "CB_IN", "CHK_QMIN_RANGE"] param_keys = ['! VERSION'] + int_param + float_param + upper_str_param + lower_str_param+ bool_param # This defines Xarray Dataset variables that are strings, which must be processed due to quirks in how NetCDF-Fortran # handles strings differently than Python's Xarray. -string_varnames = ["name", "particle_type", "status", "origin_type"] +string_varnames = ["name", "particle_type", "status", "origin_type", "stage", "regime"] char_varnames = ["space"] int_varnames = ["id", "ntp", "npl", "nplm", "discard_body_id", "collision_id", "loopnum"] diff --git a/python/swiftest/swiftest/simulation_class.py b/python/swiftest/swiftest/simulation_class.py index ca11f121e..58bc3b713 100644 --- a/python/swiftest/swiftest/simulation_class.py +++ b/python/swiftest/swiftest/simulation_class.py @@ -320,7 +320,7 @@ def __init__(self,read_param: bool = False, read_old_output_file: bool = False, self.data = xr.Dataset() self.ic = xr.Dataset() self.encounters = xr.Dataset() - self.collision = xr.Dataset() + self.collisions = xr.Dataset() self.simdir = Path(simdir) if self.simdir.exists(): @@ -1234,10 +1234,10 @@ def set_feature(self, msg = f"{collision_save} is not a valid option for collision_save." msg += f"\nMust be one of {valid_vals}" warnings.warn(msg,stacklevel=2) - if "FRAGMENTATION_SAVE" not in self.param: - self.param["FRAGMENTATION_SAVE"] = valid_vals[0] + if "COLLISION_SAVE" not in self.param: + self.param["COLLISION_SAVE"] = valid_vals[0] else: - self.param["FRAGMENTATION_SAVE"] = collision_save + self.param["COLLISION_SAVE"] = collision_save update_list.append("collision_save") self.param["TIDES"] = False @@ -1272,7 +1272,7 @@ def get_feature(self, arg_list: str | List[str] | None = None, verbose: bool | N valid_var = {"close_encounter_check": "CHK_CLOSE", "fragmentation": "FRAGMENTATION", "encounter_save": "ENCOUNTER_SAVE", - "collision_save": "FRAGMENTATION_SAVE", + "collision_save": "COLLISION_SAVE", "minimum_fragment_gmass": "MIN_GMFRAG", "rotation": "ROTATION", "general_relativity": "GR", @@ -2735,10 +2735,16 @@ def read_output_file(self,read_init_cond : bool = True): # This is done to handle cases where the method is called from a different working directory than the simulation # results - if "ENCOUNTER_SAVE" in self.param or "FRAGMENTATION_SAVE" in self.param: - read_encounters = self.param["ENCOUNTER_SAVE"] != "NONE" or self.param["FRAGMENTATION_SAVE"] != "NONE" + if "ENCOUNTER_SAVE" in self.param: + read_encounters = self.param["ENCOUNTER_SAVE"] != "NONE" else: read_encounters = False + + if "COLLISION_SAVE" in self.param: + read_collisions = self.param["COLLISION_SAVE"] != "NONE" + else: + read_collisions = False + param_tmp = self.param.copy() param_tmp['BIN_OUT'] = os.path.join(self.simdir, self.param['BIN_OUT']) if self.codename == "Swiftest": @@ -2755,6 +2761,8 @@ def read_output_file(self,read_init_cond : bool = True): self.ic = self.data.isel(time=0) if read_encounters: self.read_encounters() + if read_collisions: + self.read_collisions() elif self.codename == "Swifter": self.data = io.swifter2xr(param_tmp, verbose=self.verbose) @@ -2790,6 +2798,28 @@ def _preprocess(ds, param): return + def read_collisions(self): + if self.verbose: + print("Reading collision history file as .collisions") + col_files = glob(f"{self.simdir}{os.path.sep}collision_*.nc") + col_files.sort() + + # This is needed in order to pass the param argument down to the io.process_netcdf_input function + def _preprocess(ds, param): + return io.process_netcdf_input(ds,param) + partial_func = partial(_preprocess, param=self.param) + + self.collisions = xr.open_mfdataset(col_files,parallel=True,combine="nested",concat_dim="collision",join="left",preprocess=partial_func,mask_and_scale=True) + self.collisions = io.process_netcdf_input(self.collisions, self.param) + + # # Reduce the dimensionality of variables that got expanded in the combine process + # self.encounters['loopnum'] = self.encounters['loopnum'].max(dim="name") + # self.encounters['id'] = self.encounters['id'].max(dim="time") + # self.encounters['particle_type'] = self.encounters['particle_type'].max(dim="time") + + return + + def follow(self, codestyle="Swifter"): """ An implementation of the Swift tool_follow algorithm. Under development. Currently only for Swift simulations. diff --git a/src/io/io.f90 b/src/io/io.f90 index 062d0f70a..71815b4be 100644 --- a/src/io/io.f90 +++ b/src/io/io.f90 @@ -682,7 +682,7 @@ module subroutine io_param_reader(self, unit, iotype, v_list, iostat, iomsg) param%lrestart = .true. end if ! Ignore SyMBA-specific, not-yet-implemented, or obsolete input parameters - case ("NPLMAX", "NTPMAX", "GMTINY", "MIN_GMFRAG", "FRAGMENTATION", "SEED", "YARKOVSKY", "YORP", "ENCOUNTER_SAVE", "FRAGMENTATION_SAVE") + case ("NPLMAX", "NTPMAX", "GMTINY", "MIN_GMFRAG", "FRAGMENTATION", "SEED", "YARKOVSKY", "YORP", "ENCOUNTER_SAVE", "COLLISION_SAVE") case default write(*,*) "Ignoring unknown parameter -> ",param_name end select diff --git a/src/symba/symba_io.f90 b/src/symba/symba_io.f90 index 18b56767e..4f19bfd30 100644 --- a/src/symba/symba_io.f90 +++ b/src/symba/symba_io.f90 @@ -68,7 +68,7 @@ module subroutine symba_io_param_reader(self, unit, iotype, v_list, iostat, ioms case ("ENCOUNTER_SAVE") call io_toupper(param_value) read(param_value, *) param%encounter_save - case ("FRAGMENTATION_SAVE") + case ("COLLISION_SAVE") call io_toupper(param_value) read(param_value, *) param%collision_save case("SEED") From e9ee8cd2c566f8e0206479ef2448be45da5c8eef Mon Sep 17 00:00:00 2001 From: David A Minton Date: Mon, 12 Dec 2022 22:52:33 -0500 Subject: [PATCH 393/569] Now index by "name" instead of "id" on the Fortran side --- examples/Fragmentation/Fragmentation_Movie.py | 2 +- python/swiftest/swiftest/io.py | 21 +++-- python/swiftest/swiftest/simulation_class.py | 12 +-- src/encounter/encounter_io.f90 | 26 +++--- src/fraggle/fraggle_io.f90 | 23 +++--- src/modules/encounter_classes.f90 | 2 +- src/modules/swiftest_classes.f90 | 10 +-- src/netcdf/netcdf.f90 | 80 +++++++++---------- 8 files changed, 81 insertions(+), 95 deletions(-) diff --git a/examples/Fragmentation/Fragmentation_Movie.py b/examples/Fragmentation/Fragmentation_Movie.py index c7fc31299..090a4f4a3 100644 --- a/examples/Fragmentation/Fragmentation_Movie.py +++ b/examples/Fragmentation/Fragmentation_Movie.py @@ -202,7 +202,7 @@ def data_stream(self, frame=0): # 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, collision_save="TRAJECTORY", gmtiny=gmtiny, minimum_fragment_gmass=minimum_fragment_gmass, verbose=False) + sim.set_parameter(fragmentation=True, collision_save="TRAJECTORY", encounter_save="TRAJECTORY", gmtiny=gmtiny, minimum_fragment_gmass=minimum_fragment_gmass, verbose=False) sim.run(dt=1e-4, tstop=1.0e-3, istep_out=1, dump_cadence=1) print("Generating animation") diff --git a/python/swiftest/swiftest/io.py b/python/swiftest/swiftest/io.py index beb5ebab9..be70cae50 100644 --- a/python/swiftest/swiftest/io.py +++ b/python/swiftest/swiftest/io.py @@ -817,18 +817,18 @@ def process_netcdf_input(ds, param): ds : xarray dataset """ # - ds = ds.where(ds.id >=0,drop=True) + #ds = ds.where(ds.id >=0,drop=True) if param['OUT_TYPE'] == "NETCDF_DOUBLE": ds = fix_types(ds,ftype=np.float64) elif param['OUT_TYPE'] == "NETCDF_FLOAT": ds = fix_types(ds,ftype=np.float32) - # Check if the name variable contains unique values. If so, make name the dimension instead of id - if "id" in ds.dims: - if len(np.unique(ds['name'])) == len(ds['name']): - ds = ds.swap_dims({"id" : "name"}) - if "id" in ds: - ds = ds.reset_coords("id") + # # Check if the name variable contains unique values. If so, make name the dimension instead of id + # if "id" in ds.dims: + # if len(np.unique(ds['name'])) == len(ds['name']): + # ds = ds.swap_dims({"id" : "name"}) + # if "id" in ds: + # ds = ds.reset_coords("id") return ds @@ -1127,9 +1127,6 @@ def swiftest_xr2infile(ds, param, in_type="NETCDF_DOUBLE", infile_name=None,fram param_tmp['OUT_FORM'] = param['IN_FORM'] frame = select_active_from_frame(ds, param_tmp, framenum) - if "name" in frame.dims: - frame = frame.swap_dims({"name" : "id"}) - frame = frame.reset_coords("name") if in_type == "NETCDF_DOUBLE" or in_type == "NETCDF_FLOAT": # Convert strings back to byte form and save the NetCDF file @@ -1146,8 +1143,8 @@ def swiftest_xr2infile(ds, param, in_type="NETCDF_DOUBLE", infile_name=None,fram return frame # All other file types need seperate files for each of the inputs - cb = frame.where(frame.id == 0, drop=True) - pl = frame.where(frame.id > 0, drop=True) + cb = frame.isel(name=0) + pl = frame.where(name != cb.name) pl = pl.where(np.invert(np.isnan(pl['Gmass'])), drop=True).drop_vars(['j2rp2', 'j2rp2'],errors="ignore") tp = frame.where(np.isnan(frame['Gmass']), drop=True).drop_vars(['Gmass', 'radius', 'j2rp2', 'j4rp4'],errors="ignore") diff --git a/python/swiftest/swiftest/simulation_class.py b/python/swiftest/swiftest/simulation_class.py index 58bc3b713..1bedfeba4 100644 --- a/python/swiftest/swiftest/simulation_class.py +++ b/python/swiftest/swiftest/simulation_class.py @@ -2790,11 +2790,6 @@ def _preprocess(ds, param): tgood,tid = np.unique(self.encounters.time,return_index=True) self.encounters = self.encounters.isel(time=tid) - # Reduce the dimensionality of variables that got expanded in the combine process - self.encounters['loopnum'] = self.encounters['loopnum'].max(dim="name") - self.encounters['id'] = self.encounters['id'].max(dim="time") - self.encounters['particle_type'] = self.encounters['particle_type'].max(dim="time") - return @@ -2809,14 +2804,9 @@ def _preprocess(ds, param): return io.process_netcdf_input(ds,param) partial_func = partial(_preprocess, param=self.param) - self.collisions = xr.open_mfdataset(col_files,parallel=True,combine="nested",concat_dim="collision",join="left",preprocess=partial_func,mask_and_scale=True) + self.collisions = xr.open_mfdataset(col_files,parallel=True, coords=["collision"], join="inner", preprocess=partial_func,mask_and_scale=True) self.collisions = io.process_netcdf_input(self.collisions, self.param) - # # Reduce the dimensionality of variables that got expanded in the combine process - # self.encounters['loopnum'] = self.encounters['loopnum'].max(dim="name") - # self.encounters['id'] = self.encounters['id'].max(dim="time") - # self.encounters['particle_type'] = self.encounters['particle_type'].max(dim="time") - return diff --git a/src/encounter/encounter_io.f90 b/src/encounter/encounter_io.f90 index 09c2dd676..22827f611 100644 --- a/src/encounter/encounter_io.f90 +++ b/src/encounter/encounter_io.f90 @@ -29,7 +29,7 @@ module subroutine encounter_io_dump_collision(self, param) nc%file_number = nc%file_number + 1 call self%make_index_map() nc%event_dimsize = self%nt - nc%id_dimsize = self%nid + nc%name_dimsize = self%nid write(nc%file_name, '("collision_",I0.6,".nc")') nc%file_number call nc%initialize(param) @@ -73,7 +73,7 @@ module subroutine encounter_io_dump_encounter(self, param) nc%file_number = nc%file_number + 1 call self%make_index_map() nc%time_dimsize = self%nt - nc%id_dimsize = self%nid + nc%name_dimsize = self%nid write(nc%file_name, '("encounter_",I0.6,".nc")') nc%file_number call nc%initialize(param) @@ -138,28 +138,28 @@ module subroutine encounter_io_initialize(self, param) ! Dimensions call check( nf90_def_dim(nc%id, nc%time_dimname, nc%time_dimsize, nc%time_dimid), "encounter_io_initialize nf90_def_dim time_dimid" ) ! Simulation time dimension - call check( nf90_def_dim(nc%id, nc%space_dimname, NDIM , nc%space_dimid), "encounter_io_initialize nf90_def_dim space_dimid" ) ! 3D space dimension - call check( nf90_def_dim(nc%id, nc%id_dimname, nc%id_dimsize, nc%id_dimid), "encounter_io_initialize nf90_def_dim id_dimid" ) ! dimension to store particle id numbers + call check( nf90_def_dim(nc%id, nc%space_dimname, NDIM, nc%space_dimid), "encounter_io_initialize nf90_def_dim space_dimid" ) ! 3D space dimension + call check( nf90_def_dim(nc%id, nc%name_dimname, nc%name_dimsize, nc%name_dimid), "encounter_io_initialize nf90_def_dim name_dimid" ) ! dimension to store particle id numbers call check( nf90_def_dim(nc%id, nc%str_dimname, NAMELEN, nc%str_dimid), "encounter_io_initialize nf90_def_dim str_dimid" ) ! Dimension for string variables (aka character arrays) ! Dimension coordinates call check( nf90_def_var(nc%id, nc%time_dimname, nc%out_type, nc%time_dimid, nc%time_varid), "encounter_io_initialize nf90_def_var time_varid" ) call check( nf90_def_var(nc%id, nc%space_dimname, NF90_CHAR, nc%space_dimid, nc%space_varid), "encounter_io_initialize nf90_def_var space_varid" ) - call check( nf90_def_var(nc%id, nc%id_dimname, NF90_INT, nc%id_dimid, nc%id_varid), "encounter_io_initialize nf90_def_var id_varid" ) + call check( nf90_def_var(nc%id, nc%name_dimname, NF90_CHAR, [nc%str_dimid, nc%name_dimid], nc%name_varid), "encounter_io_initialize nf90_def_var id_varid" ) ! Variables - call check( nf90_def_var(nc%id, nc%name_varname, NF90_CHAR, [nc%str_dimid, nc%id_dimid], nc%name_varid), "encounter_io_initialize nf90_def_var name_varid" ) - call check( nf90_def_var(nc%id, nc%ptype_varname, NF90_CHAR, [nc%str_dimid, nc%id_dimid], nc%ptype_varid), "encounter_io_initialize nf90_def_var ptype_varid" ) - call check( nf90_def_var(nc%id, nc%rh_varname, nc%out_type, [nc%space_dimid, nc%id_dimid, nc%time_dimid], nc%rh_varid), "encounter_io_initialize nf90_def_var rh_varid" ) - call check( nf90_def_var(nc%id, nc%vh_varname, nc%out_type, [nc%space_dimid, nc%id_dimid, nc%time_dimid], nc%vh_varid), "encounter_io_initialize nf90_def_var vh_varid" ) - call check( nf90_def_var(nc%id, nc%Gmass_varname, nc%out_type, [nc%id_dimid, nc%time_dimid], nc%Gmass_varid), "encounter_io_initialize nf90_def_var Gmass_varid" ) + call check( nf90_def_var(nc%id, nc%id_varname, NF90_INT, nc%name_dimid, nc%id_varid), "encounter_io_initialize nf90_def_var id_varid" ) + call check( nf90_def_var(nc%id, nc%ptype_varname, NF90_CHAR, [nc%str_dimid, nc%name_dimid], nc%ptype_varid), "encounter_io_initialize nf90_def_var ptype_varid" ) + call check( nf90_def_var(nc%id, nc%rh_varname, nc%out_type, [nc%space_dimid, nc%name_dimid, nc%time_dimid], nc%rh_varid), "encounter_io_initialize nf90_def_var rh_varid" ) + call check( nf90_def_var(nc%id, nc%vh_varname, nc%out_type, [nc%space_dimid, nc%name_dimid, nc%time_dimid], nc%vh_varid), "encounter_io_initialize nf90_def_var vh_varid" ) + call check( nf90_def_var(nc%id, nc%Gmass_varname, nc%out_type, [nc%name_dimid, nc%time_dimid], nc%Gmass_varid), "encounter_io_initialize nf90_def_var Gmass_varid" ) call check( nf90_def_var(nc%id, nc%loop_varname, NF90_INT, [nc%time_dimid], nc%loop_varid), "encounter_io_initialize nf90_def_var loop_varid" ) if (param%lclose) then - call check( nf90_def_var(nc%id, nc%radius_varname, nc%out_type, [nc%id_dimid, nc%time_dimid], nc%radius_varid), "encounter_io_initialize nf90_def_var radius_varid" ) + call check( nf90_def_var(nc%id, nc%radius_varname, nc%out_type, [nc%name_dimid, nc%time_dimid], nc%radius_varid), "encounter_io_initialize nf90_def_var radius_varid" ) end if if (param%lrotation) then - call check( nf90_def_var(nc%id, nc%Ip_varname, nc%out_type, [nc%space_dimid, nc%id_dimid, nc%time_dimid], nc%Ip_varid), "encounter_io_initialize nf90_def_var Ip_varid" ) - call check( nf90_def_var(nc%id, nc%rot_varname, nc%out_type, [nc%space_dimid, nc%id_dimid, nc%time_dimid], nc%rot_varid), "encounter_io_initialize nf90_def_var rot_varid" ) + call check( nf90_def_var(nc%id, nc%Ip_varname, nc%out_type, [nc%space_dimid, nc%name_dimid, nc%time_dimid], nc%Ip_varid), "encounter_io_initialize nf90_def_var Ip_varid" ) + call check( nf90_def_var(nc%id, nc%rot_varname, nc%out_type, [nc%space_dimid, nc%name_dimid, nc%time_dimid], nc%rot_varid), "encounter_io_initialize nf90_def_var rot_varid" ) end if call check( nf90_inquire(nc%id, nVariables=nvar), "encounter_io_initialize nf90_inquire nVariables" ) diff --git a/src/fraggle/fraggle_io.f90 b/src/fraggle/fraggle_io.f90 index ff20394e7..f47a64047 100644 --- a/src/fraggle/fraggle_io.f90 +++ b/src/fraggle/fraggle_io.f90 @@ -55,49 +55,48 @@ module subroutine fraggle_io_initialize_output(self, param) ! Dimensions call check( nf90_def_dim(nc%id, nc%event_dimname, nc%event_dimsize, nc%event_dimid), "fraggle_io_initialize nf90_def_dim event_dimid" ) ! Dimension to store individual collision events call check( nf90_def_dim(nc%id, nc%space_dimname, NDIM, nc%space_dimid), "fraggle_io_initialize nf90_def_dim space_dimid" ) ! 3D space dimension - call check( nf90_def_dim(nc%id, nc%id_dimname, nc%id_dimsize, nc%id_dimid), "fraggle_io_initialize nf90_def_dim id_dimid" ) ! Dimension to store particle id numbers + call check( nf90_def_dim(nc%id, nc%name_dimname, nc%name_dimsize, nc%name_dimid), "fraggle_io_initialize nf90_def_dim name_dimid" ) ! Dimension to store particle id numbers call check( nf90_def_dim(nc%id, nc%str_dimname, NAMELEN, nc%str_dimid), "fraggle_io_initialize nf90_def_dim str_dimid" ) ! Dimension for string variables (aka character arrays) call check( nf90_def_dim(nc%id, nc%stage_dimname, 2, nc%stage_dimid), "fraggle_io_initialize nf90_def_dim stage_dimid" ) ! Dimension for stage variables (aka "before" vs. "after" ! Dimension coordinates call check( nf90_def_var(nc%id, nc%space_dimname, NF90_CHAR, nc%space_dimid, nc%space_varid), "fraggle_io_initialize nf90_def_var space_varid" ) - call check( nf90_def_var(nc%id, nc%id_dimname, NF90_INT, nc%id_dimid, nc%id_varid), "fraggle_io_initialize nf90_def_var id_varid" ) - call check( nf90_def_var(nc%id, nc%stage_dimname, NF90_CHAR, [nc%str_dimid, nc%stage_dimid], nc%stage_varid), "fraggle_io_initialize nf90_def_var stage_varid" ) + call check( nf90_def_var(nc%id, nc%name_dimname, NF90_CHAR, [nc%str_dimid, nc%name_dimid], nc%name_varid), "fraggle_io_initialize nf90_def_var name_varid") + call check( nf90_def_var(nc%id, nc%stage_dimname, NF90_CHAR, [nc%str_dimid, nc%stage_dimid], nc%stage_varid), "fraggle_io_initialize nf90_def_var stage_varid" ) ! Variables + call check( nf90_def_var(nc%id, nc%id_varname, NF90_INT, nc%name_dimid, nc%id_varid), "fraggle_io_initialize nf90_def_var id_varid" ) call check( nf90_def_var(nc%id, nc%time_dimname, nc%out_type, & nc%event_dimid, nc%time_varid), "fraggle_io_initialize nf90_def_var time_varid" ) call check( nf90_def_var(nc%id, nc%regime_varname, NF90_CHAR, & [nc%str_dimid, nc%event_dimid], nc%regime_varid), "fraggle_io_initialize nf90_def_var regime_varid") call check( nf90_def_var(nc%id, nc%Qloss_varname, nc%out_type, & [ nc%event_dimid], nc%Qloss_varid), "fraggle_io_initialize nf90_def_var Qloss_varid") - call check( nf90_def_var(nc%id, nc%name_varname, NF90_CHAR, & - [nc%str_dimid, nc%id_dimid ], nc%name_varid), "fraggle_io_initialize nf90_def_var name_varid") call check( nf90_def_var(nc%id, nc%ptype_varname, NF90_CHAR, & - [nc%str_dimid, nc%id_dimid, nc%stage_dimid, nc%event_dimid], nc%ptype_varid), "fraggle_io_initialize nf90_def_var ptype_varid") + [nc%str_dimid, nc%name_dimid, nc%stage_dimid, nc%event_dimid], nc%ptype_varid), "fraggle_io_initialize nf90_def_var ptype_varid") call check( nf90_def_var(nc%id, nc%loop_varname, NF90_INT, & [ nc%event_dimid], nc%loop_varid), "fraggle_io_initialize nf90_def_var loop_varid") call check( nf90_def_var(nc%id, nc%rh_varname, nc%out_type,& - [ nc%space_dimid, nc%id_dimid, nc%stage_dimid, nc%event_dimid], nc%rh_varid), "fraggle_io_initialize nf90_def_var rh_varid") + [ nc%space_dimid, nc%name_dimid, nc%stage_dimid, nc%event_dimid], nc%rh_varid), "fraggle_io_initialize nf90_def_var rh_varid") call check( nf90_def_var(nc%id, nc%vh_varname, nc%out_type,& - [ nc%space_dimid, nc%id_dimid, nc%stage_dimid, nc%event_dimid], nc%vh_varid), "fraggle_io_initialize nf90_def_var vh_varid") + [ nc%space_dimid, nc%name_dimid, nc%stage_dimid, nc%event_dimid], nc%vh_varid), "fraggle_io_initialize nf90_def_var vh_varid") call check( nf90_def_var(nc%id, nc%Gmass_varname, nc%out_type,& - [ nc%id_dimid, nc%stage_dimid, nc%event_dimid], nc%Gmass_varid), "fraggle_io_initialize nf90_def_var Gmass_varid") + [ nc%name_dimid, nc%stage_dimid, nc%event_dimid], nc%Gmass_varid), "fraggle_io_initialize nf90_def_var Gmass_varid") call check( nf90_def_var(nc%id, nc%radius_varname, nc%out_type,& - [ nc%id_dimid, nc%stage_dimid, nc%event_dimid], nc%radius_varid), "fraggle_io_initialize nf90_def_var radius_varid") + [ nc%name_dimid, nc%stage_dimid, nc%event_dimid], nc%radius_varid), "fraggle_io_initialize nf90_def_var radius_varid") call check( nf90_def_var(nc%id, nc%Ip_varname, nc%out_type,& - [ nc%space_dimid, nc%id_dimid, nc%stage_dimid, nc%event_dimid], nc%Ip_varid), "fraggle_io_initialize nf90_def_var Ip_varid") + [ nc%space_dimid, nc%name_dimid, nc%stage_dimid, nc%event_dimid], nc%Ip_varid), "fraggle_io_initialize nf90_def_var Ip_varid") call check( nf90_def_var(nc%id, nc%rot_varname, nc%out_type,& - [ nc%space_dimid, nc%id_dimid, nc%stage_dimid, nc%event_dimid], nc%rot_varid), "fraggle_io_initialize nf90_def_var rot_varid") + [ nc%space_dimid, nc%name_dimid, nc%stage_dimid, nc%event_dimid], nc%rot_varid), "fraggle_io_initialize nf90_def_var rot_varid") call check( nf90_def_var(nc%id, nc%ke_orb_varname, nc%out_type,& [ nc%stage_dimid, nc%event_dimid], nc%KE_orb_varid), "fraggle_io_initialize_output nf90_def_var KE_orb_varid") diff --git a/src/modules/encounter_classes.f90 b/src/modules/encounter_classes.f90 index f5429fd12..8e74913ed 100644 --- a/src/modules/encounter_classes.f90 +++ b/src/modules/encounter_classes.f90 @@ -59,7 +59,7 @@ module encounter_classes character(NAMELEN) :: loop_varname = "loopnum" !! Loop number for encounter integer(I4B) :: loop_varid !! ID for the recursion level variable integer(I4B) :: time_dimsize = 0 !! Number of time values in snapshot - integer(I4B) :: id_dimsize = 0 !! Number of potential id values in snapshot + integer(I4B) :: name_dimsize = 0 !! Number of potential id values in snapshot integer(I4B) :: file_number = 1 !! The number to append on the output file contains procedure :: initialize => encounter_io_initialize !! Initialize a set of parameters used to identify a NetCDF output object diff --git a/src/modules/swiftest_classes.f90 b/src/modules/swiftest_classes.f90 index 6dc6a9877..1762a8e78 100644 --- a/src/modules/swiftest_classes.f90 +++ b/src/modules/swiftest_classes.f90 @@ -34,9 +34,9 @@ module swiftest_classes 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) :: name_dimname = "name" !! name of the particle name dimension + integer(I4B) :: name_dimid !! ID for the particle name dimension + integer(I4B) :: name_varid !! ID for the particle name variable character(NAMELEN) :: space_dimname = "space" !! name of the space dimension integer(I4B) :: space_dimid !! ID for the space dimension integer(I4B) :: space_varid !! ID for the space variable @@ -45,8 +45,8 @@ module swiftest_classes ! 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 name variable + character(NAMELEN) :: id_varname = "id" !! name of the particle id variable + integer(I4B) :: id_varid !! ID for the id variable character(NAMELEN) :: npl_varname = "npl" !! name of the number of active massive bodies variable integer(I4B) :: npl_varid !! ID for the number of active massive bodies variable character(NAMELEN) :: ntp_varname = "ntp" !! name of the number of active test particles variable diff --git a/src/netcdf/netcdf.f90 b/src/netcdf/netcdf.f90 index 42e2a2ea6..588a138d6 100644 --- a/src/netcdf/netcdf.f90 +++ b/src/netcdf/netcdf.f90 @@ -83,7 +83,7 @@ module function netcdf_get_old_t_final_system(self, param) result(old_t_final) associate (nc => param%system_history%nc) call nc%open(param) call check( nf90_inquire_dimension(nc%id, nc%time_dimid, len=itmax), "netcdf_get_old_t_final_system time_dimid" ) - call check( nf90_inquire_dimension(nc%id, nc%id_dimid, len=idmax), "netcdf_get_old_t_final_system id_dimid" ) + call check( nf90_inquire_dimension(nc%id, nc%name_dimid, len=idmax), "netcdf_get_old_t_final_system name_dimid" ) allocate(vals(idmax)) call check( nf90_get_var(nc%id, nc%time_varid, rtemp, start=[1], count=[1]), "netcdf_get_old_t_final_system time_varid" ) @@ -186,77 +186,77 @@ module subroutine netcdf_initialize_output(self, param) ! Dimensions call check( nf90_def_dim(nc%id, nc%time_dimname, NF90_UNLIMITED, nc%time_dimid), "netcdf_initialize_output nf90_def_dim time_dimid" ) ! Simulation time dimension call check( nf90_def_dim(nc%id, nc%space_dimname, NDIM, nc%space_dimid), "netcdf_initialize_output nf90_def_dim space_dimid" ) ! 3D space dimension - call check( nf90_def_dim(nc%id, nc%id_dimname, NF90_UNLIMITED, nc%id_dimid), "netcdf_initialize_output nf90_def_dim id_dimid" ) ! dimension to store particle id numbers + call check( nf90_def_dim(nc%id, nc%name_dimname, NF90_UNLIMITED, nc%name_dimid), "netcdf_initialize_output nf90_def_dim name_dimid" ) ! dimension to store particle id numbers call check( nf90_def_dim(nc%id, nc%str_dimname, NAMELEN, nc%str_dimid), "netcdf_initialize_output nf90_def_dim str_dimid" ) ! Dimension for string variables (aka character arrays) ! Dimension coordinates call check( nf90_def_var(nc%id, nc%time_dimname, nc%out_type, nc%time_dimid, nc%time_varid), "netcdf_initialize_output nf90_def_var time_varid" ) call check( nf90_def_var(nc%id, nc%space_dimname, NF90_CHAR, nc%space_dimid, nc%space_varid), "netcdf_initialize_output nf90_def_var space_varid" ) - call check( nf90_def_var(nc%id, nc%id_dimname, NF90_INT, nc%id_dimid, nc%id_varid), "netcdf_initialize_output nf90_def_var id_varid" ) + call check( nf90_def_var(nc%id, nc%name_dimname, NF90_CHAR, [nc%str_dimid, nc%name_dimid], nc%name_varid), "netcdf_initialize_output nf90_def_var name_varid" ) ! Variables + call check( nf90_def_var(nc%id, nc%id_varname, NF90_INT, nc%name_dimid, nc%id_varid), "netcdf_initialize_output nf90_def_var id_varid" ) call check( nf90_def_var(nc%id, nc%npl_varname, NF90_INT, nc%time_dimid, nc%npl_varid), "netcdf_initialize_output nf90_def_var npl_varid" ) call check( nf90_def_var(nc%id, nc%ntp_varname, NF90_INT, nc%time_dimid, nc%ntp_varid), "netcdf_initialize_output nf90_def_var ntp_varid" ) if (param%integrator == SYMBA) call check( nf90_def_var(nc%id, nc%nplm_varname, NF90_INT, nc%time_dimid, nc%nplm_varid), "netcdf_initialize_output nf90_def_var nplm_varid" ) - call check( nf90_def_var(nc%id, nc%name_varname, NF90_CHAR, [nc%str_dimid, nc%id_dimid], nc%name_varid), "netcdf_initialize_output nf90_def_var name_varid" ) - call check( nf90_def_var(nc%id, nc%ptype_varname, NF90_CHAR, [nc%str_dimid, nc%id_dimid], nc%ptype_varid), "netcdf_initialize_output nf90_def_var ptype_varid" ) + call check( nf90_def_var(nc%id, nc%ptype_varname, NF90_CHAR, [nc%str_dimid, nc%name_dimid], nc%ptype_varid), "netcdf_initialize_output nf90_def_var ptype_varid" ) if ((param%out_form == "XV") .or. (param%out_form == "XVEL")) then - call check( nf90_def_var(nc%id, nc%rh_varname, nc%out_type, [nc%space_dimid, nc%id_dimid, nc%time_dimid], nc%rh_varid), "netcdf_initialize_output nf90_def_var rh_varid" ) - call check( nf90_def_var(nc%id, nc%vh_varname, nc%out_type, [nc%space_dimid, nc%id_dimid, nc%time_dimid], nc%vh_varid), "netcdf_initialize_output nf90_def_var vh_varid" ) + call check( nf90_def_var(nc%id, nc%rh_varname, nc%out_type, [nc%space_dimid, nc%name_dimid, nc%time_dimid], nc%rh_varid), "netcdf_initialize_output nf90_def_var rh_varid" ) + call check( nf90_def_var(nc%id, nc%vh_varname, nc%out_type, [nc%space_dimid, nc%name_dimid, nc%time_dimid], nc%vh_varid), "netcdf_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(nc%id, nc%gr_pseudo_vh_varname, nc%out_type, [nc%space_dimid, nc%id_dimid, nc%time_dimid], nc%gr_pseudo_vh_varid), "netcdf_initialize_output nf90_def_var gr_psuedo_vh_varid" ) + call check( nf90_def_var(nc%id, nc%gr_pseudo_vh_varname, nc%out_type, [nc%space_dimid, nc%name_dimid, nc%time_dimid], nc%gr_pseudo_vh_varid), "netcdf_initialize_output nf90_def_var gr_psuedo_vh_varid" ) nc%lpseudo_vel_exists = .true. end if end if if ((param%out_form == "EL") .or. (param%out_form == "XVEL")) then - call check( nf90_def_var(nc%id, nc%a_varname, nc%out_type, [nc%id_dimid, nc%time_dimid], nc%a_varid), "netcdf_initialize_output nf90_def_var a_varid" ) - call check( nf90_def_var(nc%id, nc%e_varname, nc%out_type, [nc%id_dimid, nc%time_dimid], nc%e_varid), "netcdf_initialize_output nf90_def_var e_varid" ) - call check( nf90_def_var(nc%id, nc%inc_varname, nc%out_type, [nc%id_dimid, nc%time_dimid], nc%inc_varid), "netcdf_initialize_output nf90_def_var inc_varid" ) - call check( nf90_def_var(nc%id, nc%capom_varname, nc%out_type, [nc%id_dimid, nc%time_dimid], nc%capom_varid), "netcdf_initialize_output nf90_def_var capom_varid" ) - call check( nf90_def_var(nc%id, nc%omega_varname, nc%out_type, [nc%id_dimid, nc%time_dimid], nc%omega_varid), "netcdf_initialize_output nf90_def_var omega_varid" ) - call check( nf90_def_var(nc%id, nc%capm_varname, nc%out_type, [nc%id_dimid, nc%time_dimid], nc%capm_varid), "netcdf_initialize_output nf90_def_var capm_varid" ) - call check( nf90_def_var(nc%id, nc%varpi_varname, nc%out_type, [nc%id_dimid, nc%time_dimid], nc%varpi_varid), "netcdf_initialize_output nf90_def_var varpi_varid" ) - call check( nf90_def_var(nc%id, nc%lam_varname, nc%out_type, [nc%id_dimid, nc%time_dimid], nc%lam_varid), "netcdf_initialize_output nf90_def_var lam_varid" ) - call check( nf90_def_var(nc%id, nc%f_varname, nc%out_type, [nc%id_dimid, nc%time_dimid], nc%f_varid), "netcdf_initialize_output nf90_def_var f_varid" ) - call check( nf90_def_var(nc%id, nc%cape_varname, nc%out_type, [nc%id_dimid, nc%time_dimid], nc%cape_varid), "netcdf_initialize_output nf90_def_var cape_varid" ) + call check( nf90_def_var(nc%id, nc%a_varname, nc%out_type, [nc%name_dimid, nc%time_dimid], nc%a_varid), "netcdf_initialize_output nf90_def_var a_varid" ) + call check( nf90_def_var(nc%id, nc%e_varname, nc%out_type, [nc%name_dimid, nc%time_dimid], nc%e_varid), "netcdf_initialize_output nf90_def_var e_varid" ) + call check( nf90_def_var(nc%id, nc%inc_varname, nc%out_type, [nc%name_dimid, nc%time_dimid], nc%inc_varid), "netcdf_initialize_output nf90_def_var inc_varid" ) + call check( nf90_def_var(nc%id, nc%capom_varname, nc%out_type, [nc%name_dimid, nc%time_dimid], nc%capom_varid), "netcdf_initialize_output nf90_def_var capom_varid" ) + call check( nf90_def_var(nc%id, nc%omega_varname, nc%out_type, [nc%name_dimid, nc%time_dimid], nc%omega_varid), "netcdf_initialize_output nf90_def_var omega_varid" ) + call check( nf90_def_var(nc%id, nc%capm_varname, nc%out_type, [nc%name_dimid, nc%time_dimid], nc%capm_varid), "netcdf_initialize_output nf90_def_var capm_varid" ) + call check( nf90_def_var(nc%id, nc%varpi_varname, nc%out_type, [nc%name_dimid, nc%time_dimid], nc%varpi_varid), "netcdf_initialize_output nf90_def_var varpi_varid" ) + call check( nf90_def_var(nc%id, nc%lam_varname, nc%out_type, [nc%name_dimid, nc%time_dimid], nc%lam_varid), "netcdf_initialize_output nf90_def_var lam_varid" ) + call check( nf90_def_var(nc%id, nc%f_varname, nc%out_type, [nc%name_dimid, nc%time_dimid], nc%f_varid), "netcdf_initialize_output nf90_def_var f_varid" ) + call check( nf90_def_var(nc%id, nc%cape_varname, nc%out_type, [nc%name_dimid, nc%time_dimid], nc%cape_varid), "netcdf_initialize_output nf90_def_var cape_varid" ) end if - call check( nf90_def_var(nc%id, nc%gmass_varname, nc%out_type, [nc%id_dimid, nc%time_dimid], nc%Gmass_varid), "netcdf_initialize_output nf90_def_var Gmass_varid" ) + call check( nf90_def_var(nc%id, nc%gmass_varname, nc%out_type, [nc%name_dimid, nc%time_dimid], nc%Gmass_varid), "netcdf_initialize_output nf90_def_var Gmass_varid" ) if (param%lrhill_present) then - call check( nf90_def_var(nc%id, nc%rhill_varname, nc%out_type, [nc%id_dimid, nc%time_dimid], nc%rhill_varid), "netcdf_initialize_output nf90_def_var rhill_varid" ) + call check( nf90_def_var(nc%id, nc%rhill_varname, nc%out_type, [nc%name_dimid, nc%time_dimid], nc%rhill_varid), "netcdf_initialize_output nf90_def_var rhill_varid" ) end if if (param%lclose) then - call check( nf90_def_var(nc%id, nc%radius_varname, nc%out_type, [nc%id_dimid, nc%time_dimid], nc%radius_varid), "netcdf_initialize_output nf90_def_var radius_varid" ) + call check( nf90_def_var(nc%id, nc%radius_varname, nc%out_type, [nc%name_dimid, nc%time_dimid], nc%radius_varid), "netcdf_initialize_output nf90_def_var radius_varid" ) - call check( nf90_def_var(nc%id, nc%origin_time_varname, nc%out_type, nc%id_dimid, nc%origin_time_varid), "netcdf_initialize_output nf90_def_var origin_time_varid" ) - call check( nf90_def_var(nc%id, nc%origin_type_varname, NF90_CHAR, [nc%str_dimid, nc%id_dimid], & + call check( nf90_def_var(nc%id, nc%origin_time_varname, nc%out_type, nc%name_dimid, nc%origin_time_varid), "netcdf_initialize_output nf90_def_var origin_time_varid" ) + call check( nf90_def_var(nc%id, nc%origin_type_varname, NF90_CHAR, [nc%str_dimid, nc%name_dimid], & nc%origin_type_varid), "netcdf_initialize_output nf90_create" ) - call check( nf90_def_var(nc%id, nc%origin_rh_varname, nc%out_type, [nc%space_dimid, nc%id_dimid], nc%origin_rh_varid), "netcdf_initialize_output nf90_def_var origin_rh_varid" ) - call check( nf90_def_var(nc%id, nc%origin_vh_varname, nc%out_type, [nc%space_dimid, nc%id_dimid], nc%origin_vh_varid), "netcdf_initialize_output nf90_def_var origin_vh_varid" ) - - call check( nf90_def_var(nc%id, nc%collision_id_varname, NF90_INT, nc%id_dimid, nc%collision_id_varid), "netcdf_initialize_output nf90_def_var collision_id_varid" ) - call check( nf90_def_var(nc%id, nc%discard_time_varname, nc%out_type, nc%id_dimid, nc%discard_time_varid), "netcdf_initialize_output nf90_def_var discard_time_varid" ) - call check( nf90_def_var(nc%id, nc%discard_rh_varname, nc%out_type, [nc%space_dimid, nc%id_dimid], nc%discard_rh_varid), "netcdf_initialize_output nf90_def_var discard_rh_varid" ) - call check( nf90_def_var(nc%id, nc%discard_vh_varname, nc%out_type, [nc%space_dimid, nc%id_dimid], nc%discard_vh_varid), "netcdf_initialize_output nf90_def_var discard_vh_varid" ) - call check( nf90_def_var(nc%id, nc%discard_body_id_varname, NF90_INT, nc%id_dimid, nc%discard_body_id_varid), "netcdf_initialize_output nf90_def_var discard_body_id_varid" ) + call check( nf90_def_var(nc%id, nc%origin_rh_varname, nc%out_type, [nc%space_dimid, nc%name_dimid], nc%origin_rh_varid), "netcdf_initialize_output nf90_def_var origin_rh_varid" ) + call check( nf90_def_var(nc%id, nc%origin_vh_varname, nc%out_type, [nc%space_dimid, nc%name_dimid], nc%origin_vh_varid), "netcdf_initialize_output nf90_def_var origin_vh_varid" ) + + call check( nf90_def_var(nc%id, nc%collision_id_varname, NF90_INT, nc%name_dimid, nc%collision_id_varid), "netcdf_initialize_output nf90_def_var collision_id_varid" ) + call check( nf90_def_var(nc%id, nc%discard_time_varname, nc%out_type, nc%name_dimid, nc%discard_time_varid), "netcdf_initialize_output nf90_def_var discard_time_varid" ) + call check( nf90_def_var(nc%id, nc%discard_rh_varname, nc%out_type, [nc%space_dimid, nc%name_dimid], nc%discard_rh_varid), "netcdf_initialize_output nf90_def_var discard_rh_varid" ) + call check( nf90_def_var(nc%id, nc%discard_vh_varname, nc%out_type, [nc%space_dimid, nc%name_dimid], nc%discard_vh_varid), "netcdf_initialize_output nf90_def_var discard_vh_varid" ) + call check( nf90_def_var(nc%id, nc%discard_body_id_varname, NF90_INT, nc%name_dimid, nc%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(nc%id, nc%Ip_varname, nc%out_type, [nc%space_dimid, nc%id_dimid, nc%time_dimid], nc%Ip_varid), "netcdf_initialize_output nf90_def_var Ip_varid" ) - call check( nf90_def_var(nc%id, nc%rot_varname, nc%out_type, [nc%space_dimid, nc%id_dimid, nc%time_dimid], nc%rot_varid), "netcdf_initialize_output nf90_def_var rot_varid" ) + call check( nf90_def_var(nc%id, nc%Ip_varname, nc%out_type, [nc%space_dimid, nc%name_dimid, nc%time_dimid], nc%Ip_varid), "netcdf_initialize_output nf90_def_var Ip_varid" ) + call check( nf90_def_var(nc%id, nc%rot_varname, nc%out_type, [nc%space_dimid, nc%name_dimid, nc%time_dimid], nc%rot_varid), "netcdf_initialize_output nf90_def_var rot_varid" ) end if ! if (param%ltides) then - ! call check( nf90_def_var(nc%id, nc%k2_varname, nc%out_type, [nc%id_dimid, nc%time_dimid], nc%k2_varid), "netcdf_initialize_output nf90_def_var k2_varid" ) - ! call check( nf90_def_var(nc%id, nc%q_varname, nc%out_type, [nc%id_dimid, nc%time_dimid], nc%Q_varid), "netcdf_initialize_output nf90_def_var Q_varid" ) + ! call check( nf90_def_var(nc%id, nc%k2_varname, nc%out_type, [nc%name_dimid, nc%time_dimid], nc%k2_varid), "netcdf_initialize_output nf90_def_var k2_varid" ) + ! call check( nf90_def_var(nc%id, nc%q_varname, nc%out_type, [nc%name_dimid, nc%time_dimid], nc%Q_varid), "netcdf_initialize_output nf90_def_var Q_varid" ) ! end if if (param%lenergy) then @@ -332,16 +332,16 @@ module subroutine netcdf_open(self, param, readonly) ! Dimensions call check( nf90_inq_dimid(nc%id, nc%time_dimname, nc%time_dimid), "netcdf_open nf90_inq_dimid time_dimid" ) call check( nf90_inq_dimid(nc%id, nc%space_dimname, nc%space_dimid), "netcdf_open nf90_inq_dimid space_dimid" ) - call check( nf90_inq_dimid(nc%id, nc%id_dimname, nc%id_dimid), "netcdf_open nf90_inq_dimid id_dimid" ) + call check( nf90_inq_dimid(nc%id, nc%name_dimname, nc%name_dimid), "netcdf_open nf90_inq_dimid name_dimid" ) call check( nf90_inq_dimid(nc%id, nc%str_dimname, nc%str_dimid), "netcdf_open nf90_inq_dimid str_dimid" ) ! Dimension coordinates call check( nf90_inq_varid(nc%id, nc%time_dimname, nc%time_varid), "netcdf_open nf90_inq_varid time_varid" ) call check( nf90_inq_varid(nc%id, nc%space_dimname, nc%space_varid), "netcdf_open nf90_inq_varid space_varid" ) - call check( nf90_inq_varid(nc%id, nc%id_dimname, nc%id_varid), "netcdf_open nf90_inq_varid id_varid" ) + call check( nf90_inq_varid(nc%id, nc%name_dimname, nc%name_varid), "netcdf_open nf90_inq_varid name_varid" ) ! Required Variables - call check( nf90_inq_varid(nc%id, nc%name_varname, nc%name_varid), "netcdf_open nf90_inq_varid name_varid" ) + call check( nf90_inq_varid(nc%id, nc%id_varname, nc%id_varid), "netcdf_open nf90_inq_varid name_varid" ) call check( nf90_inq_varid(nc%id, nc%gmass_varname, nc%Gmass_varid), "netcdf_open nf90_inq_varid Gmass_varid" ) if ((param%out_form == "XV") .or. (param%out_form == "XVEL")) then @@ -461,7 +461,7 @@ module function netcdf_read_frame_system(self, nc, param) result(ierr) call pl%setup(npl, param) call tp%setup(ntp, param) - call check( nf90_inquire_dimension(nc%id, nc%id_dimid, len=idmax), "netcdf_read_frame_system nf90_inquire_dimension id_dimid" ) + call check( nf90_inquire_dimension(nc%id, nc%name_dimid, len=idmax), "netcdf_read_frame_system nf90_inquire_dimension name_dimid" ) allocate(rtemp(idmax)) allocate(vectemp(NDIM,idmax)) allocate(itemp(idmax)) @@ -703,7 +703,7 @@ module subroutine netcdf_read_hdr_system(self, nc, param) tslot = param%ioutput - call check( nf90_inquire_dimension(nc%id, nc%id_dimid, len=idmax), "netcdf_read_hdr_system nf90_inquire_dimension id_dimid" ) + call check( nf90_inquire_dimension(nc%id, nc%name_dimid, len=idmax), "netcdf_read_hdr_system nf90_inquire_dimension name_dimid" ) call check( nf90_get_var(nc%id, nc%time_varid, self%t, start=[tslot]), "netcdf_read_hdr_system nf90_getvar time_varid" ) allocate(gmtemp(idmax)) From ff507bddd6190452e07bb45bb6ce7c8270df9904 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Tue, 13 Dec 2022 05:50:18 -0500 Subject: [PATCH 394/569] Refactored xh,xb -> rh,rb --- src/discard/discard.f90 | 2 +- src/fraggle/fraggle_generate.f90 | 14 +++++----- src/fraggle/fraggle_regime.f90 | 14 +++++----- src/fraggle/fraggle_set.f90 | 12 ++++----- src/fraggle/fraggle_setup.f90 | 2 +- src/fraggle/fraggle_util.f90 | 4 +-- src/helio/helio_kick.f90 | 4 +-- src/io/io.f90 | 2 +- src/kick/kick.f90 | 6 ++--- src/modules/fraggle_classes.f90 | 4 +-- src/modules/rmvs_classes.f90 | 2 +- src/modules/swiftest_classes.f90 | 26 +++++++++--------- src/rmvs/rmvs_encounter_check.f90 | 2 +- src/rmvs/rmvs_kick.f90 | 12 ++++----- src/rmvs/rmvs_setup.f90 | 2 +- src/rmvs/rmvs_step.f90 | 28 ++++++++++---------- src/rmvs/rmvs_util.f90 | 8 +++--- src/setup/setup.f90 | 4 +-- src/symba/symba_collision.f90 | 38 +++++++++++++-------------- src/symba/symba_discard.f90 | 24 ++++++++--------- src/symba/symba_kick.f90 | 2 +- src/symba/symba_util.f90 | 8 +++--- src/tides/tides_spin_step.f90 | 22 ++++++++-------- src/util/util_append.f90 | 4 +-- src/util/util_coord.f90 | 24 ++++++++--------- src/util/util_dealloc.f90 | 2 +- src/util/util_fill.f90 | 4 +-- src/util/util_get_energy_momentum.f90 | 32 +++++++++++----------- src/util/util_peri.f90 | 4 +-- src/util/util_rescale.f90 | 4 +-- src/util/util_resize.f90 | 4 +-- src/util/util_set.f90 | 12 ++++----- src/util/util_sort.f90 | 8 +++--- src/util/util_spill.f90 | 4 +-- src/whm/whm_kick.f90 | 14 +++++----- 35 files changed, 179 insertions(+), 179 deletions(-) diff --git a/src/discard/discard.f90 b/src/discard/discard.f90 index 72782df84..fc5160fd7 100644 --- a/src/discard/discard.f90 +++ b/src/discard/discard.f90 @@ -153,7 +153,7 @@ subroutine discard_cb_tp(tp, system, param) 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)) + rb2 = dot_product(tp%rb(:, i), tp%rb(:, i)) vb2 = dot_product(tp%vb(:, i), tp%vb(:, i)) energy = 0.5_DP * vb2 - Gmtot / sqrt(rb2) if ((energy > 0.0_DP) .and. (rb2 > rmaxu2)) then diff --git a/src/fraggle/fraggle_generate.f90 b/src/fraggle/fraggle_generate.f90 index 4da30c3d8..8253fb12a 100644 --- a/src/fraggle/fraggle_generate.f90 +++ b/src/fraggle/fraggle_generate.f90 @@ -72,7 +72,7 @@ module subroutine fraggle_generate_fragments(self, colliders, system, param, lfa call frag%get_energy_and_momentum(colliders, system, param, lbefore=.true.) ! Start out the fragments close to the initial separation distance. This will be increased if there is any overlap or we fail to find a solution - r_max_start = 1 * norm2(colliders%xb(:,2) - colliders%xb(:,1)) + r_max_start = 1 * norm2(colliders%rb(:,2) - colliders%rb(:,1)) lfailure = .false. try = 1 do while (try < MAXTRY) @@ -194,8 +194,8 @@ subroutine fraggle_generate_pos_vec(frag, colliders, r_max_start) call random_number(frag%x_coll(:,3:nfrag)) loverlap(:) = .true. do while (any(loverlap(3:nfrag))) - frag%x_coll(:, 1) = colliders%xb(:, 1) - frag%xbcom(:) - frag%x_coll(:, 2) = colliders%xb(:, 2) - frag%xbcom(:) + frag%x_coll(:, 1) = colliders%rb(:, 1) - frag%rbcom(:) + frag%x_coll(:, 2) = colliders%rb(:, 2) - frag%rbcom(:) r_max = r_max + 0.1_DP * rad do i = 3, nfrag if (loverlap(i)) then @@ -215,14 +215,14 @@ subroutine fraggle_generate_pos_vec(frag, colliders, r_max_start) call frag%set_coordinate_system(colliders) do i = 1, nfrag - frag%xb(:,i) = frag%x_coll(:,i) + frag%xbcom(:) + frag%rb(:,i) = frag%x_coll(:,i) + frag%rbcom(:) end do - frag%xbcom(:) = 0.0_DP + frag%rbcom(:) = 0.0_DP do i = 1, nfrag - frag%xbcom(:) = frag%xbcom(:) + frag%mass(i) * frag%xb(:,i) + frag%rbcom(:) = frag%rbcom(:) + frag%mass(i) * frag%rb(:,i) end do - frag%xbcom(:) = frag%xbcom(:) / frag%mtot + frag%rbcom(:) = frag%rbcom(:) / frag%mtot end associate return diff --git a/src/fraggle/fraggle_regime.f90 b/src/fraggle/fraggle_regime.f90 index cf8d5891c..7b3191149 100644 --- a/src/fraggle/fraggle_regime.f90 +++ b/src/fraggle/fraggle_regime.f90 @@ -42,9 +42,9 @@ module subroutine fraggle_regime_colliders(self, frag, system, param) mass_si(:) = colliders%mass([jtarg, jproj]) * param%MU2KG !! The two-body equivalent masses of the collider system radius_si(:) = colliders%radius([jtarg, jproj]) * param%DU2M !! The two-body equivalent radii of the collider system density_si(:) = mass_si(:) / (4.0_DP / 3._DP * PI * radius_si(:)**3) !! The two-body equivalent density of the collider system - x1_si(:) = colliders%xb(:,jtarg) * param%DU2M !! The first body of the two-body equivalent position vector the collider system + x1_si(:) = colliders%rb(:,jtarg) * param%DU2M !! The first body of the two-body equivalent position vector the collider system v1_si(:) = colliders%vb(:,jtarg) * param%DU2M / param%TU2S !! The first body of the two-body equivalent velocity vector the collider system - x2_si(:) = colliders%xb(:,jproj) * param%DU2M !! The second body of the two-body equivalent position vector the collider system + x2_si(:) = colliders%rb(:,jproj) * param%DU2M !! The second body of the two-body equivalent position vector the collider system v2_si(:) = colliders%vb(:,jproj) * param%DU2M / param%TU2S !! The second body of the two-body equivalent velocity vector the collider system Mcb_si = system%cb%mass * param%MU2KG !! The central body mass of the system select type(param) @@ -68,7 +68,7 @@ module subroutine fraggle_regime_colliders(self, frag, system, param) ! Find the center of mass of the collisional system frag%mtot = sum(colliders%mass(:)) - frag%xbcom(:) = (colliders%mass(1) * colliders%xb(:,1) + colliders%mass(2) * colliders%xb(:,2)) / frag%mtot + frag%rbcom(:) = (colliders%mass(1) * colliders%rb(:,1) + colliders%mass(2) * colliders%rb(:,2)) / frag%mtot frag%vbcom(:) = (colliders%mass(1) * colliders%vb(:,1) + colliders%mass(2) * colliders%vb(:,2)) / frag%mtot ! Convert quantities back to the system units and save them into the fragment system @@ -82,7 +82,7 @@ module subroutine fraggle_regime_colliders(self, frag, system, param) end subroutine fraggle_regime_colliders - subroutine fraggle_regime_collresolve(Mcb, m1, m2, rad1, rad2, xh1, xh2, vb1, vb2, den1, den2, min_mfrag, & + subroutine fraggle_regime_collresolve(Mcb, m1, m2, rad1, rad2, rh1, rh2, vb1, vb2, den1, den2, min_mfrag, & regime, Mlr, Mslr, Qloss) !! Author: Jennifer L.L. Pouplin, Carlisle A. Wishard, and David A. Minton !! @@ -103,7 +103,7 @@ subroutine fraggle_regime_collresolve(Mcb, m1, m2, rad1, rad2, xh1, xh2, vb1, vb implicit none ! Arguments real(DP), intent(in) :: Mcb, m1, m2, rad1, rad2, den1, den2, min_mfrag - real(DP), dimension(:), intent(in) :: xh1, xh2, vb1, vb2 + real(DP), dimension(:), intent(in) :: rh1, rh2, vb1, vb2 integer(I4B), intent(out) :: regime real(DP), intent(out) :: Mlr, Mslr real(DP), intent(out) :: Qloss !! The residual energy after the collision @@ -130,9 +130,9 @@ subroutine fraggle_regime_collresolve(Mcb, m1, m2, rad1, rad2, xh1, xh2, vb1, vb real(DP) :: U_binding Vimp = norm2(vb2(:) - vb1(:)) - b = calc_b(xh2, vb2, xh1, vb1) + b = calc_b(rh2, vb2, rh1, vb1) l = (rad1 + rad2) * (1 - b) - egy = 0.5_DP * dot_product(vb1, vb1) - GC * Mcb / norm2(xh1) + egy = 0.5_DP * dot_product(vb1, vb1) - GC * Mcb / norm2(rh1) a1 = - GC * Mcb / 2.0_DP / egy Mtot = m1 + m2 mu = (m1 * m2) / Mtot diff --git a/src/fraggle/fraggle_set.f90 b/src/fraggle/fraggle_set.f90 index 6f61b989c..4a70130b6 100644 --- a/src/fraggle/fraggle_set.f90 +++ b/src/fraggle/fraggle_set.f90 @@ -177,7 +177,7 @@ module subroutine fraggle_set_coordinate_system(self, colliders) associate(frag => self, nfrag => self%nbody) delta_v(:) = colliders%vb(:, 2) - colliders%vb(:, 1) v_col_norm = .mag. delta_v(:) - delta_r(:) = colliders%xb(:, 2) - colliders%xb(:, 1) + delta_r(:) = colliders%rb(:, 2) - colliders%rb(:, 1) r_col_norm = .mag. delta_r(:) ! We will initialize fragments on a plane defined by the pre-impact system, with the z-axis aligned with the angular momentum vector @@ -234,9 +234,9 @@ module subroutine fraggle_set_natural_scale_factors(self, colliders) frag%Lscale = frag%mscale * frag%dscale * frag%vscale ! Scale all dimensioned quantities of colliders and fragments - frag%xbcom(:) = frag%xbcom(:) / frag%dscale + frag%rbcom(:) = frag%rbcom(:) / frag%dscale frag%vbcom(:) = frag%vbcom(:) / frag%vscale - colliders%xb(:,:) = colliders%xb(:,:) / frag%dscale + colliders%rb(:,:) = colliders%rb(:,:) / frag%dscale colliders%vb(:,:) = colliders%vb(:,:) / frag%vscale colliders%mass(:) = colliders%mass(:) / frag%mscale colliders%radius(:) = colliders%radius(:) / frag%dscale @@ -276,12 +276,12 @@ module subroutine fraggle_set_original_scale_factors(self, colliders) associate(frag => self) ! Restore scale factors - frag%xbcom(:) = frag%xbcom(:) * frag%dscale + frag%rbcom(:) = frag%rbcom(:) * frag%dscale frag%vbcom(:) = frag%vbcom(:) * frag%vscale colliders%mass = colliders%mass * frag%mscale colliders%radius = colliders%radius * frag%dscale - colliders%xb = colliders%xb * frag%dscale + colliders%rb = colliders%rb * frag%dscale colliders%vb = colliders%vb * frag%vscale colliders%L_spin = colliders%L_spin * frag%Lscale do i = 1, 2 @@ -297,7 +297,7 @@ module subroutine fraggle_set_original_scale_factors(self, colliders) frag%v_coll = frag%v_coll * frag%vscale do i = 1, frag%nbody - frag%xb(:, i) = frag%x_coll(:, i) + frag%xbcom(:) + frag%rb(:, i) = frag%x_coll(:, i) + frag%rbcom(:) frag%vb(:, i) = frag%v_coll(:, i) + frag%vbcom(:) end do diff --git a/src/fraggle/fraggle_setup.f90 b/src/fraggle/fraggle_setup.f90 index 2eff96c29..ab31af995 100644 --- a/src/fraggle/fraggle_setup.f90 +++ b/src/fraggle/fraggle_setup.f90 @@ -19,7 +19,7 @@ module subroutine fraggle_setup_reset_fragments(self) ! Arguments class(fraggle_fragments), intent(inout) :: self - self%xb(:,:) = 0.0_DP + self%rb(:,:) = 0.0_DP self%vb(:,:) = 0.0_DP self%rot(:,:) = 0.0_DP self%x_coll(:,:) = 0.0_DP diff --git a/src/fraggle/fraggle_util.f90 b/src/fraggle/fraggle_util.f90 index 22ca5cd55..038b3c1a5 100644 --- a/src/fraggle/fraggle_util.f90 +++ b/src/fraggle/fraggle_util.f90 @@ -35,9 +35,9 @@ module subroutine fraggle_util_add_fragments_to_system(frag, colliders, system, pl%Gmass(npl_before+1:npl_after) = frag%mass(1:nfrag) * param%GU pl%radius(npl_before+1:npl_after) = frag%radius(1:nfrag) do concurrent (i = 1:nfrag) - pl%xb(:,npl_before+i) = frag%xb(:,i) + pl%rb(:,npl_before+i) = frag%rb(:,i) pl%vb(:,npl_before+i) = frag%vb(:,i) - pl%rh(:,npl_before+i) = frag%xb(:,i) - cb%xb(:) + pl%rh(:,npl_before+i) = frag%rb(:,i) - cb%rb(:) pl%vh(:,npl_before+i) = frag%vb(:,i) - cb%vb(:) end do if (param%lrotation) then diff --git a/src/helio/helio_kick.f90 b/src/helio/helio_kick.f90 index b5161b405..03bc688b5 100644 --- a/src/helio/helio_kick.f90 +++ b/src/helio/helio_kick.f90 @@ -75,7 +75,7 @@ module subroutine helio_kick_getacch_tp(self, system, param, t, lbeg) associate(tp => self, cb => system%cb, pl => system%pl, npl => system%pl%nbody) system%lbeg = lbeg if (system%lbeg) then - call tp%accel_int(param, pl%Gmass(1:npl), pl%xbeg(:,1:npl), npl) + call tp%accel_int(param, pl%Gmass(1:npl), pl%rbeg(:,1:npl), npl) else call tp%accel_int(param, pl%Gmass(1:npl), pl%xend(:,1:npl), npl) end if @@ -112,7 +112,7 @@ 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%rh) + call pl%set_beg_end(rbeg = pl%rh) else call pl%set_beg_end(xend = pl%rh) end if diff --git a/src/io/io.f90 b/src/io/io.f90 index 71815b4be..c58eb4dbb 100644 --- a/src/io/io.f90 +++ b/src/io/io.f90 @@ -133,7 +133,7 @@ module subroutine io_conservation_report(self, param, lterminal) associate(system => self, pl => self%pl, cb => self%cb, npl => self%pl%nbody, display_unit => param%display_unit, nc => param%system_history%nc) call pl%vb2vh(cb) - call pl%xh2xb(cb) + call pl%rh2rb(cb) call system%get_energy_and_momentum(param) ke_orbit_now = system%ke_orbit diff --git a/src/kick/kick.f90 b/src/kick/kick.f90 index 40b238fec..8f1ae7e08 100644 --- a/src/kick/kick.f90 +++ b/src/kick/kick.f90 @@ -63,7 +63,7 @@ module subroutine kick_getacch_int_pl(self, param) end subroutine kick_getacch_int_pl - module subroutine kick_getacch_int_tp(self, param, GMpl, xhp, npl) + module subroutine kick_getacch_int_tp(self, param, GMpl, rhp, npl) !! author: David A. Minton !! !! Compute direct cross (third) term heliocentric accelerations of test particles by massive bodies @@ -75,12 +75,12 @@ module subroutine kick_getacch_int_tp(self, param, GMpl, xhp, npl) class(swiftest_tp), intent(inout) :: self !! Swiftest test particle object class(swiftest_parameters), intent(inout) :: param !! Current swiftest run configuration parameters real(DP), dimension(:), intent(in) :: GMpl !! Massive body masses - real(DP), dimension(:,:), intent(in) :: xhp !! Massive body position vectors + real(DP), dimension(:,:), intent(in) :: rhp !! Massive body position vectors integer(I4B), intent(in) :: npl !! Number of active massive bodies if ((self%nbody == 0) .or. (npl == 0)) return - call kick_getacch_int_all_tp(self%nbody, npl, self%rh, xhp, GMpl, self%lmask, self%ah) + call kick_getacch_int_all_tp(self%nbody, npl, self%rh, rhp, GMpl, self%lmask, self%ah) return end subroutine kick_getacch_int_tp diff --git a/src/modules/fraggle_classes.f90 b/src/modules/fraggle_classes.f90 index 989399f94..8c75a3fc6 100644 --- a/src/modules/fraggle_classes.f90 +++ b/src/modules/fraggle_classes.f90 @@ -27,7 +27,7 @@ module fraggle_classes type :: fraggle_colliders integer(I4B) :: ncoll !! Number of bodies involved in the collision integer(I4B), dimension(:), allocatable :: idx !! Index of bodies involved in the collision - real(DP), dimension(NDIM,2) :: xb !! Two-body equivalent position vectors of the collider bodies prior to collision + real(DP), dimension(NDIM,2) :: rb !! Two-body equivalent position vectors of the collider bodies prior to collision real(DP), dimension(NDIM,2) :: vb !! Two-body equivalent velocity vectors of the collider bodies prior to collision real(DP), dimension(NDIM,2) :: rot !! Two-body equivalent principal axes moments of inertia the collider bodies prior to collision real(DP), dimension(NDIM,2) :: L_spin !! Two-body equivalent spin angular momentum vectors of the collider bodies prior to collision @@ -52,7 +52,7 @@ module fraggle_classes integer(I4B) :: regime !! Collresolve regime code for this collision ! Values in a coordinate frame centered on the collider barycenter and collisional system unit vectors (these are used internally by the fragment generation subroutine) - real(DP), dimension(NDIM) :: xbcom !! Center of mass position vector of the collider system in system barycentric coordinates + real(DP), dimension(NDIM) :: rbcom !! Center of mass position vector of the collider system in system barycentric coordinates real(DP), dimension(NDIM) :: vbcom !! Velocity vector of the center of mass of the collider system in system barycentric coordinates real(DP), dimension(NDIM) :: x_coll_unit !! x-direction unit vector of collisional system real(DP), dimension(NDIM) :: y_coll_unit !! y-direction unit vector of collisional system diff --git a/src/modules/rmvs_classes.f90 b/src/modules/rmvs_classes.f90 index ec7dfcf16..f8add18eb 100644 --- a/src/modules/rmvs_classes.f90 +++ b/src/modules/rmvs_classes.f90 @@ -77,7 +77,7 @@ module rmvs_classes ! The following are used to correctly set the oblateness values of the acceleration during an inner encounter with a planet type(rmvs_cb) :: cb_heliocentric !! Copy of original central body object passed to close encounter (used for oblateness acceleration during planetocentric encoountters) - real(DP), dimension(:,:), allocatable :: xheliocentric !! original heliocentric position (used for oblateness calculation during close encounters) + real(DP), dimension(:,:), allocatable :: rheliocentric !! original heliocentric position (used for oblateness calculation during close encounters) integer(I4B) :: index !! inner substep number within current set integer(I4B) :: ipleP !! index value of encountering planet logical :: lplanetocentric = .false. !! Flag that indicates that the object is a planetocentric set of masive bodies used for close encounter calculations diff --git a/src/modules/swiftest_classes.f90 b/src/modules/swiftest_classes.f90 index 1762a8e78..d86a742b2 100644 --- a/src/modules/swiftest_classes.f90 +++ b/src/modules/swiftest_classes.f90 @@ -320,7 +320,7 @@ module swiftest_classes real(DP), dimension(NDIM) :: aoblend = 0.0_DP !! Barycentric acceleration due to central body oblatenes at end of step real(DP), dimension(NDIM) :: atidebeg = 0.0_DP !! Barycentric acceleration due to central body oblatenes at beginning of step real(DP), dimension(NDIM) :: atideend = 0.0_DP !! Barycentric acceleration due to central body oblatenes at end of step - real(DP), dimension(NDIM) :: xb = 0.0_DP !! Barycentric position (units DU) + real(DP), dimension(NDIM) :: rb = 0.0_DP !! Barycentric position (units DU) real(DP), dimension(NDIM) :: vb = 0.0_DP !! Barycentric velocity (units DU / TU) real(DP), dimension(NDIM) :: agr = 0.0_DP !! Acceleration due to post-Newtonian correction real(DP), dimension(NDIM) :: Ip = 0.0_DP !! Unitless principal moments of inertia (I1, I2, I3) / (MR**2). Principal axis rotation assumed. @@ -349,7 +349,7 @@ module swiftest_classes real(DP), dimension(:), allocatable :: mu !! G * (Mcb + [m]) 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 :: rb !! Barycentric position real(DP), dimension(:,:), allocatable :: vb !! Barycentric velocity real(DP), dimension(:,:), allocatable :: ah !! Total heliocentric acceleration real(DP), dimension(:,:), allocatable :: aobl !! Barycentric accelerations of bodies due to central body oblatenes @@ -402,7 +402,7 @@ module swiftest_classes real(DP), dimension(:), allocatable :: rhill !! Body mass (units MU) real(DP), dimension(:), allocatable :: renc !! Critical radius for close encounters real(DP), dimension(:), allocatable :: radius !! Body radius (units DU) - real(DP), dimension(:,:), allocatable :: xbeg !! Position at beginning of step + real(DP), dimension(:,:), allocatable :: rbeg !! Position at beginning of step real(DP), dimension(:,:), allocatable :: xend !! Position at end of step real(DP), dimension(:,:), allocatable :: vbeg !! Velocity at beginning of step real(DP), dimension(:), allocatable :: density !! Body mass density - calculated internally (units MU / DU**3) @@ -429,7 +429,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_rh2xb_pl !! Convert massive bodies from heliocentric to barycentric coordinates (position only) + procedure :: rh2rb => util_coord_rh2rb_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. @@ -469,7 +469,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_rh2xb_tp !! Convert test particles from heliocentric to barycentric coordinates (position only) + procedure :: rh2rb => util_coord_rh2rb_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 @@ -928,12 +928,12 @@ module subroutine kick_getacch_int_pl(self, param) class(swiftest_parameters), intent(inout) :: param !! Current swiftest run configuration parameters end subroutine kick_getacch_int_pl - module subroutine kick_getacch_int_tp(self, param, GMpl, xhp, npl) + module subroutine kick_getacch_int_tp(self, param, GMpl, rhp, npl) implicit none class(swiftest_tp), intent(inout) :: self !! Swiftest test particle object class(swiftest_parameters), intent(inout) :: param !! Current swiftest run configuration parameters real(DP), dimension(:), intent(in) :: GMpl !! Massive body masses - real(DP), dimension(:,:), intent(in) :: xhp !! Massive body position vectors + real(DP), dimension(:,:), intent(in) :: rhp !! Massive body position vectors integer(I4B), intent(in) :: npl !! Number of active massive bodies end subroutine kick_getacch_int_tp @@ -1350,17 +1350,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_rh2xb_pl(self, cb) + module subroutine util_coord_rh2rb_pl(self, cb) implicit none class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object class(swiftest_cb), intent(inout) :: cb !! Swiftest central body object - end subroutine util_coord_rh2xb_pl + end subroutine util_coord_rh2rb_pl - module subroutine util_coord_rh2xb_tp(self, cb) + module subroutine util_coord_rh2rb_tp(self, cb) implicit none class(swiftest_tp), intent(inout) :: self !! Swiftest test particle object class(swiftest_cb), intent(in) :: cb !! Swiftest central body object - end subroutine util_coord_rh2xb_tp + end subroutine util_coord_rh2rb_tp module subroutine util_copy_particle_info(self, source) implicit none @@ -1627,10 +1627,10 @@ module subroutine util_get_idvalues_system(self, idvals) integer(I4B), dimension(:), allocatable, intent(out) :: idvals !! Array of all id values saved in this snapshot end subroutine util_get_idvalues_system - module subroutine util_set_beg_end_pl(self, xbeg, xend, vbeg) + module subroutine util_set_beg_end_pl(self, rbeg, xend, vbeg) implicit none class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object - real(DP), dimension(:,:), intent(in), optional :: xbeg !! Position vectors at beginning of step + real(DP), dimension(:,:), intent(in), optional :: rbeg !! Position vectors at beginning of step real(DP), dimension(:,:), intent(in), optional :: xend !! Positions vectors at end of step real(DP), dimension(:,:), intent(in), optional :: vbeg !! vbeg is an unused variable to keep this method forward compatible with RMVS end subroutine util_set_beg_end_pl diff --git a/src/rmvs/rmvs_encounter_check.f90 b/src/rmvs/rmvs_encounter_check.f90 index 860bcacfb..be0c8ba62 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%rh, tp%vh, pl%renc, dt, & + call encounter_check_all_pltp(param, npl, ntp, pl%rbeg, pl%vbeg, tp%rh, tp%vh, pl%renc, dt, & nenc, index1, index2, lvdotr) lencounter = (nenc > 0_I8B) diff --git a/src/rmvs/rmvs_kick.f90 b/src/rmvs/rmvs_kick.f90 index bb43aba94..88b71d0a9 100644 --- a/src/rmvs/rmvs_kick.f90 +++ b/src/rmvs/rmvs_kick.f90 @@ -27,7 +27,7 @@ module subroutine rmvs_kick_getacch_tp(self, system, param, t, lbeg) logical, intent(in) :: lbeg !! Logical flag that determines whether or not this is the beginning or end of the step ! Internals class(swiftest_parameters), allocatable :: param_planetocen - real(DP), dimension(:, :), allocatable :: xh_original + real(DP), dimension(:, :), allocatable :: rh_original real(DP) :: GMcb_original integer(I4B) :: i @@ -46,7 +46,7 @@ module subroutine rmvs_kick_getacch_tp(self, system, param, t, lbeg) system_planetocen%lbeg = lbeg ! Save the original heliocentric position for later - allocate(xh_original, source=tp%rh) + allocate(rh_original, source=tp%rh) ! Temporarily turn off the heliocentric-dependent acceleration terms during an inner encounter using a copy of the parameter list with all of the heliocentric-specific acceleration terms turned off allocate(param_planetocen, source=param) @@ -60,17 +60,17 @@ module subroutine rmvs_kick_getacch_tp(self, system, param, t, lbeg) ! Now compute any heliocentric values of acceleration if (tp%lfirst) then do concurrent(i = 1:ntp, tp%lmask(i)) - tp%xheliocentric(:,i) = tp%rh(:,i) + cb%inner(inner_index - 1)%x(:,1) + tp%rheliocentric(:,i) = tp%rh(:,i) + cb%inner(inner_index - 1)%x(:,1) end do else do concurrent(i = 1:ntp, tp%lmask(i)) - tp%xheliocentric(:,i) = tp%rh(:,i) + cb%inner(inner_index )%x(:,1) + tp%rheliocentric(:,i) = tp%rh(:,i) + cb%inner(inner_index )%x(:,1) end do end if ! Swap the planetocentric and heliocentric position vectors and central body masses do concurrent(i = 1:ntp, tp%lmask(i)) - tp%rh(:, i) = tp%xheliocentric(:, i) + tp%rh(:, i) = tp%rheliocentric(:, 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%rh) + call move_alloc(rh_original, tp%rh) cb%Gmass = GMcb_original end associate diff --git a/src/rmvs/rmvs_setup.f90 b/src/rmvs/rmvs_setup.f90 index 2c5a0faea..9c0b88876 100644 --- a/src/rmvs/rmvs_setup.f90 +++ b/src/rmvs/rmvs_setup.f90 @@ -156,7 +156,7 @@ module subroutine rmvs_setup_tp(self, n, param) allocate(self%plperP(n)) allocate(self%plencP(n)) - if (self%lplanetocentric) allocate(self%xheliocentric(NDIM, n)) + if (self%lplanetocentric) allocate(self%rheliocentric(NDIM, n)) self%lperi(:) = .false. diff --git a/src/rmvs/rmvs_step.f90 b/src/rmvs/rmvs_step.f90 index 132139e33..ab39e6f31 100644 --- a/src/rmvs/rmvs_step.f90 +++ b/src/rmvs/rmvs_step.f90 @@ -26,7 +26,7 @@ module subroutine rmvs_step_system(self, param, t, dt) real(DP), intent(in) :: dt !! Current stepsiz ! Internals logical :: lencounter, lfirstpl - real(DP), dimension(:,:), allocatable :: xbeg, xend, vbeg + real(DP), dimension(:,:), allocatable :: rbeg, xend, vbeg if (self%tp%nbody == 0) then call whm_step_system(self, param, t, dt) @@ -38,15 +38,15 @@ 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%rh) + allocate(rbeg, source=pl%rh) allocate(vbeg, source=pl%vh) - call pl%set_beg_end(xbeg = xbeg, vbeg = vbeg) + call pl%set_beg_end(rbeg = rbeg, vbeg = vbeg) ! ****** Check for close encounters ***** ! call pl%set_renc(RHSCALE) lencounter = tp%encounter_check(param, system, dt) if (lencounter) then lfirstpl = pl%lfirst - pl%outer(0)%x(:, 1:npl) = xbeg(:, 1:npl) + pl%outer(0)%x(:, 1:npl) = rbeg(:, 1:npl) pl%outer(0)%v(:, 1:npl) = vbeg(:, 1:npl) call pl%step(system, param, t, dt) pl%outer(NTENC)%x(:, 1:npl) = pl%rh(:, 1:npl) @@ -54,7 +54,7 @@ module subroutine rmvs_step_system(self, param, t, dt) call rmvs_interp_out(cb, pl, dt) call rmvs_step_out(cb, pl, tp, system, param, t, dt) tp%lmask(1:ntp) = .not. tp%lmask(1:ntp) - call pl%set_beg_end(xbeg = xbeg, xend = xend) + call pl%set_beg_end(rbeg = rbeg, xend = xend) tp%lfirst = .true. call tp%step(system, param, t, dt) tp%lmask(1:ntp) = .true. @@ -185,7 +185,7 @@ subroutine rmvs_step_out(cb, pl, tp, system, param, t, dt) call pl%set_renc(RHPSCALE) do outer_index = 1, NTENC outer_time = t + (outer_index - 1) * dto - call pl%set_beg_end(xbeg = pl%outer(outer_index - 1)%x(:, 1:npl), & + call pl%set_beg_end(rbeg = pl%outer(outer_index - 1)%x(:, 1:npl), & vbeg = pl%outer(outer_index - 1)%v(:, 1:npl), & xend = pl%outer(outer_index )%x(:, 1:npl)) lencounter = tp%encounter_check(param, system, dto) @@ -234,7 +234,7 @@ subroutine rmvs_interp_in(cb, pl, system, param, dt, outer_index) ! Internals integer(I4B) :: i, inner_index real(DP) :: frac, dntphenc - real(DP), dimension(:,:), allocatable :: xtmp, vtmp, xh_original, ah_original + real(DP), dimension(:,:), allocatable :: xtmp, vtmp, rh_original, ah_original real(DP), dimension(:), allocatable :: GMcb, dti integer(I4B), dimension(:), allocatable :: iflag @@ -258,7 +258,7 @@ 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%rh) + allocate(rh_original, source=pl%rh) allocate(ah_original, source=pl%ah) pl%rh(:, 1:npl) = xtmp(:, 1:npl) ! Temporarily replace heliocentric position with inner substep values to calculate the oblateness terms 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%rh) + if (allocated(rh_original)) call move_alloc(rh_original, pl%rh) if (allocated(ah_original)) call move_alloc(ah_original, pl%ah) end associate return @@ -389,7 +389,7 @@ subroutine rmvs_step_in(cb, pl, tp, param, outer_time, dto) lfirsttp = .true. do inner_index = 1, NTPHENC ! Integrate over the encounter region, using the "substitute" planetocentric systems at each level plenci%rh(:, 1:npl) = plenci%inner(inner_index - 1)%x(:, 1:npl) - call plenci%set_beg_end(xbeg = plenci%inner(inner_index - 1)%x, & + call plenci%set_beg_end(rbeg = plenci%inner(inner_index - 1)%x, & xend = plenci%inner(inner_index)%x) if (param%loblatecb) then @@ -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%rh(:, j) + pl%inner(inner_index)%x(:,i) + tpenci%rheliocentric(:, j) = tpenci%rh(:, j) + pl%inner(inner_index)%x(:,i) end do inner_time = outer_time + j * dti call rmvs_peri_tp(tpenci, pl, inner_time, dti, .false., inner_index, i, param) @@ -464,8 +464,8 @@ subroutine rmvs_make_planetocentric(param, cb, pl, tp) ! Grab all the encountering test particles and convert them to a planetocentric frame tpenci%id(1:nenci) = pack(tp%id(1:ntp), encmask(1:ntp)) do j = 1, NDIM - tpenci%xheliocentric(j, 1:nenci) = pack(tp%rh(j,1:ntp), encmask(:)) - tpenci%rh(j, 1:nenci) = tpenci%xheliocentric(j, 1:nenci) - pl%inner(0)%x(j, i) + tpenci%rheliocentric(j, 1:nenci) = pack(tp%rh(j,1:ntp), encmask(:)) + tpenci%rh(j, 1:nenci) = tpenci%rheliocentric(j, 1:nenci) - pl%inner(0)%x(j, i) tpenci%vh(j, 1:nenci) = pack(tp%vh(j, 1:ntp), encmask(1:ntp)) - pl%inner(0)%v(j, i) end do tpenci%lperi(1:nenci) = pack(tp%lperi(1:ntp), encmask(1:ntp)) @@ -534,7 +534,7 @@ subroutine rmvs_peri_tp(tp, pl, t, dt, lfirst, inner_index, ipleP, param) ! Internals integer(I4B) :: i, id1, id2 real(DP) :: r2, mu, rhill2, vdotr, a, peri, capm, tperi, rpl - real(DP), dimension(NDIM) :: xh1, xh2, vh1, vh2 + real(DP), dimension(NDIM) :: rh1, rh2, vh1, vh2 rhill2 = pl%rhill(ipleP)**2 mu = pl%Gmass(ipleP) diff --git a/src/rmvs/rmvs_util.f90 b/src/rmvs/rmvs_util.f90 index eb31db53d..b62c3ad88 100644 --- a/src/rmvs/rmvs_util.f90 +++ b/src/rmvs/rmvs_util.f90 @@ -137,7 +137,7 @@ module subroutine rmvs_util_dealloc_tp(self) if (allocated(self%lperi)) deallocate(self%lperi) if (allocated(self%plperP)) deallocate(self%plperP) if (allocated(self%plencP)) deallocate(self%plencP) - if (allocated(self%xheliocentric)) deallocate(self%xheliocentric) + if (allocated(self%rheliocentric)) deallocate(self%rheliocentric) call self%cb_heliocentric%dealloc() call util_dealloc_tp(self) @@ -319,7 +319,7 @@ module subroutine rmvs_util_resize_tp(self, nnew) call util_resize(self%lperi, nnew) call util_resize(self%plperP, nnew) call util_resize(self%plencP, nnew) - call util_resize(self%xheliocentric, nnew) + call util_resize(self%rheliocentric, nnew) call util_resize_tp(self, nnew) @@ -399,7 +399,7 @@ module subroutine rmvs_util_sort_tp(self, sortby, ascending) call util_sort(direction * tp%plperP(1:ntp), ind) case("plencP") call util_sort(direction * tp%plencP(1:ntp), ind) - case("lperi", "cb_heliocentric", "xheliocentric", "index", "ipleP", "lplanetocentric") + case("lperi", "cb_heliocentric", "rheliocentric", "index", "ipleP", "lplanetocentric") write(*,*) 'Cannot sort by ' // trim(adjustl(sortby)) // '. Component not sortable!' case default ! Look for components in the parent class (*NOTE whm_tp does not need its own sort method, so we go straight to the swiftest_tp method) call util_sort_tp(tp, sortby, ascending) @@ -451,7 +451,7 @@ module subroutine rmvs_util_sort_rearrange_tp(self, ind) call util_sort_rearrange(tp%lperi, ind, ntp) call util_sort_rearrange(tp%plperP, ind, ntp) call util_sort_rearrange(tp%plencP, ind, ntp) - call util_sort_rearrange(tp%xheliocentric, ind, ntp) + call util_sort_rearrange(tp%rheliocentric, ind, ntp) call util_sort_rearrange_tp(tp,ind) end associate diff --git a/src/setup/setup.f90 b/src/setup/setup.f90 index 64c63b390..36a131611 100644 --- a/src/setup/setup.f90 +++ b/src/setup/setup.f90 @@ -230,7 +230,7 @@ module subroutine setup_body(self, n, param) allocate(self%mu(n)) allocate(self%rh(NDIM, n)) allocate(self%vh(NDIM, n)) - allocate(self%xb(NDIM, n)) + allocate(self%rb(NDIM, n)) allocate(self%vb(NDIM, n)) allocate(self%ah(NDIM, n)) allocate(self%ir3h(n)) @@ -260,7 +260,7 @@ module subroutine setup_body(self, n, param) self%mu(:) = 0.0_DP self%rh(:,:) = 0.0_DP self%vh(:,:) = 0.0_DP - self%xb(:,:) = 0.0_DP + self%rb(:,:) = 0.0_DP self%vb(:,:) = 0.0_DP self%ah(:,:) = 0.0_DP self%ir3h(:) = 0.0_DP diff --git a/src/symba/symba_collision.f90 b/src/symba/symba_collision.f90 index ab2962054..a32a18c7c 100644 --- a/src/symba/symba_collision.f90 +++ b/src/symba/symba_collision.f90 @@ -184,7 +184,7 @@ module function symba_collision_casemerge(system, param) result(status) call fragments%set_mass_dist(colliders, param) ibiggest = colliders%idx(maxloc(pl%Gmass(colliders%idx(:)), dim=1)) fragments%id(1) = pl%id(ibiggest) - fragments%xb(:,1) = fragments%xbcom(:) + fragments%rb(:,1) = fragments%rbcom(:) fragments%vb(:,1) = fragments%vbcom(:) if (param%lrotation) then @@ -201,7 +201,7 @@ module function symba_collision_casemerge(system, param) result(status) pe = 0.0_DP do j = 1, colliders%ncoll do i = j + 1, colliders%ncoll - pe = pe - pl%Gmass(i) * pl%mass(j) / norm2(pl%xb(:, i) - pl%xb(:, j)) + pe = pe - pl%Gmass(i) * pl%mass(j) / norm2(pl%rb(:, i) - pl%rb(:, j)) end do end do system%Ecollisions = system%Ecollisions + pe @@ -340,16 +340,16 @@ module function symba_collision_check_encounter(self, system, param, t, dt, irec lany_collision = any(lcollision(:)) if (lany_collision) then - call pl%xh2xb(system%cb) ! Update the central body barycenteric position vector to get us out of DH and into bary + call pl%rh2rb(system%cb) ! Update the central body barycenteric position vector to get us out of DH and into bary do k = 1, nenc i = self%index1(k) j = self%index2(k) if (lcollision(k)) self%status(k) = COLLISION self%tcollision(k) = t - self%x1(:,k) = pl%rh(:,i) + system%cb%xb(:) + self%x1(:,k) = pl%rh(:,i) + system%cb%rb(:) self%v1(:,k) = pl%vb(:,i) if (isplpl) then - self%x2(:,k) = pl%rh(:,j) + system%cb%xb(:) + self%x2(:,k) = pl%rh(:,j) + system%cb%rb(:) self%v2(:,k) = pl%vb(:,j) if (lcollision(k)) then ! Check to see if either of these bodies has been involved with a collision before, and if so, make this a collisional colliders%idx @@ -362,7 +362,7 @@ module function symba_collision_check_encounter(self, system, param, t, dt, irec 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%rh(:,j) + system%cb%xb(:) + self%x2(:,k) = tp%rh(:,j) + system%cb%rb(:) self%v2(:,k) = tp%vb(:,j) if (lcollision(k)) then tp%status(j) = DISCARDED_PLR @@ -513,7 +513,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%rh(:, idx_parent(j)) + cb%xb(:) + colliders%rb(:, j) = pl%rh(:, idx_parent(j)) + cb%rb(:) 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 @@ -526,16 +526,16 @@ 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%rh(:, idx_child) + cb%xb(:) + xchild(:) = pl%rh(:, idx_child) + cb%rb(:) vchild(:) = pl%vb(:, idx_child) volchild = (4.0_DP / 3.0_DP) * PI * pl%radius(idx_child)**3 volume(j) = volume(j) + volchild ! Get angular momentum of the child-parent pair and add that to the spin ! Add the child's spin if (param%lrotation) then - xcom(:) = (colliders%mass(j) * colliders%xb(:,j) + mchild * xchild(:)) / (colliders%mass(j) + mchild) + xcom(:) = (colliders%mass(j) * colliders%rb(:,j) + mchild * xchild(:)) / (colliders%mass(j) + mchild) vcom(:) = (colliders%mass(j) * colliders%vb(:,j) + mchild * vchild(:)) / (colliders%mass(j) + mchild) - xc(:) = colliders%xb(:, j) - xcom(:) + xc(:) = colliders%rb(:, j) - xcom(:) vc(:) = colliders%vb(:, j) - vcom(:) xcrossv(:) = xc(:) .cross. vc(:) colliders%L_spin(:, j) = colliders%L_spin(:, j) + colliders%mass(j) * xcrossv(:) @@ -553,7 +553,7 @@ function symba_collision_consolidate_colliders(pl, cb, param, idx_parent, collid ! Merge the child and parent colliders%mass(j) = colliders%mass(j) + mchild - colliders%xb(:, j) = xcom(:) + colliders%rb(:, j) = xcom(:) colliders%vb(:, j) = vcom(:) end do end if @@ -563,10 +563,10 @@ function symba_collision_consolidate_colliders(pl, cb, param, idx_parent, collid end do lflag = .true. - xcom(:) = (colliders%mass(1) * colliders%xb(:, 1) + colliders%mass(2) * colliders%xb(:, 2)) / sum(colliders%mass(:)) + xcom(:) = (colliders%mass(1) * colliders%rb(:, 1) + colliders%mass(2) * colliders%rb(:, 2)) / sum(colliders%mass(:)) vcom(:) = (colliders%mass(1) * colliders%vb(:, 1) + colliders%mass(2) * colliders%vb(:, 2)) / sum(colliders%mass(:)) - mxc(:, 1) = colliders%mass(1) * (colliders%xb(:, 1) - xcom(:)) - mxc(:, 2) = colliders%mass(2) * (colliders%xb(:, 2) - xcom(:)) + mxc(:, 1) = colliders%mass(1) * (colliders%rb(:, 1) - xcom(:)) + mxc(:, 2) = colliders%mass(2) * (colliders%rb(:, 2) - xcom(:)) vcc(:, 1) = colliders%vb(:, 1) - vcom(:) vcc(:, 2) = colliders%vb(:, 2) - vcom(:) colliders%L_orbit(:,:) = mxc(:,:) .cross. vcc(:,:) @@ -745,12 +745,12 @@ subroutine symba_collision_mergeaddsub(system, param, status) ! Copy over identification, information, and physical properties of the new bodies from the fragment list plnew%id(1:nfrag) = fragments%id(1:nfrag) - plnew%xb(:, 1:nfrag) = fragments%xb(:, 1:nfrag) + plnew%rb(:, 1:nfrag) = fragments%rb(:, 1:nfrag) plnew%vb(:, 1:nfrag) = fragments%vb(:, 1:nfrag) call pl%vb2vh(cb) - call pl%xh2xb(cb) + call pl%rh2rb(cb) do i = 1, nfrag - plnew%rh(:,i) = fragments%xb(:, i) - cb%xb(:) + plnew%rh(:,i) = fragments%rb(:, i) - cb%rb(:) plnew%vh(:,i) = fragments%vb(:, i) - cb%vb(:) end do plnew%mass(1:nfrag) = fragments%mass(1:nfrag) @@ -955,7 +955,7 @@ module subroutine symba_resolve_collision_mergers(self, system, param) fragments%mass_dist(1) = fragments%mtot fragments%mass_dist(2) = 0.0_DP fragments%mass_dist(3) = 0.0_DP - fragments%xbcom(:) = (colliders%mass(1) * colliders%xb(:,1) + colliders%mass(2) * colliders%xb(:,2)) / fragments%mtot + fragments%rbcom(:) = (colliders%mass(1) * colliders%rb(:,1) + colliders%mass(2) * colliders%rb(:,2)) / fragments%mtot fragments%vbcom(:) = (colliders%mass(1) * colliders%vb(:,1) + colliders%mass(2) * colliders%vb(:,2)) / fragments%mtot plplcollision_list%status(i) = symba_collision_casemerge(system, param) end do @@ -994,7 +994,7 @@ module subroutine symba_resolve_collision_plplenc(self, system, param, t, dt, ir if (plplcollision_list%nenc == 0) return ! No collisions to resolve ! Make sure that the heliocentric and barycentric coordinates are consistent with each other call pl%vb2vh(system%cb) - call pl%xh2xb(system%cb) + call pl%rh2rb(system%cb) ! Get the energy before the collision is resolved if (param%lenergy) then diff --git a/src/symba/symba_discard.f90 b/src/symba/symba_discard.f90 index a380487f7..82741d695 100644 --- a/src/symba/symba_discard.f90 +++ b/src/symba/symba_discard.f90 @@ -74,7 +74,7 @@ subroutine symba_discard_cb_pl(pl, system, param) 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)) + rb2 = dot_product(pl%rb(:,i), pl%rb(:,i)) vb2 = dot_product(pl%vb(:,i), pl%vb(:,i)) energy = 0.5_DP * vb2 - system%Gmtot / sqrt(rb2) if ((energy > 0.0_DP) .and. (rb2 > rmaxu2)) then @@ -124,7 +124,7 @@ subroutine symba_discard_conserve_mtm(pl, system, param, ipl, lescape_body) class is (symba_cb) ! Add the potential and kinetic energy of the lost body to the records - pe = -cb%Gmass * pl%mass(ipl) / norm2(pl%xb(:, ipl) - cb%xb(:)) + pe = -cb%Gmass * pl%mass(ipl) / norm2(pl%rb(:, ipl) - cb%rb(:)) ke_orbit = 0.5_DP * pl%mass(ipl) * dot_product(pl%vb(:, ipl), pl%vb(:, ipl)) if (param%lrotation) then ke_spin = 0.5_DP * pl%mass(ipl) * pl%radius(ipl)**2 * pl%Ip(3, ipl) * dot_product(pl%rot(:, ipl), pl%rot(:, ipl)) @@ -138,15 +138,15 @@ subroutine symba_discard_conserve_mtm(pl, system, param, ipl, lescape_body) system%GMescape = system%GMescape + pl%Gmass(ipl) do i = 1, pl%nbody if (i == ipl) cycle - pe = pe - pl%Gmass(i) * pl%mass(ipl) / norm2(pl%xb(:, ipl) - pl%xb(:, i)) + pe = pe - pl%Gmass(i) * pl%mass(ipl) / norm2(pl%rb(:, ipl) - pl%rb(:, i)) end do Ltot(:) = 0.0_DP do i = 1, pl%nbody - Lpl(:) = pL%mass(i) * (pl%xb(:,i) .cross. pl%vb(:, i)) + Lpl(:) = pL%mass(i) * (pl%rb(:,i) .cross. pl%vb(:, i)) Ltot(:) = Ltot(:) + Lpl(:) end do - Ltot(:) = Ltot(:) + cb%mass * (cb%xb(:) .cross. cb%vb(:)) + Ltot(:) = Ltot(:) + cb%mass * (cb%rb(:) .cross. cb%vb(:)) call pl%b2h(cb) oldstat = pl%status(ipl) pl%status(ipl) = INACTIVE @@ -154,21 +154,21 @@ subroutine symba_discard_conserve_mtm(pl, system, param, ipl, lescape_body) pl%status(ipl) = oldstat do i = 1, pl%nbody if (i == ipl) cycle - Lpl(:) = pl%mass(i) * (pl%xb(:,i) .cross. pl%vb(:, i)) + Lpl(:) = pl%mass(i) * (pl%rb(:,i) .cross. pl%vb(:, i)) Ltot(:) = Ltot(:) - Lpl(:) end do - Ltot(:) = Ltot(:) - cb%mass * (cb%xb(:) .cross. cb%vb(:)) + Ltot(:) = Ltot(:) - cb%mass * (cb%rb(:) .cross. cb%vb(:)) system%Lescape(:) = system%Lescape(:) + Ltot(:) if (param%lrotation) system%Lescape(:) = system%Lescape + pl%mass(ipl) * pl%radius(ipl)**2 & * pl%Ip(3, ipl) * pl%rot(:, ipl) else - xcom(:) = (pl%mass(ipl) * pl%xb(:, ipl) + cb%mass * cb%xb(:)) / (cb%mass + pl%mass(ipl)) + xcom(:) = (pl%mass(ipl) * pl%rb(:, ipl) + cb%mass * cb%rb(:)) / (cb%mass + pl%mass(ipl)) vcom(:) = (pl%mass(ipl) * pl%vb(:, ipl) + cb%mass * cb%vb(:)) / (cb%mass + pl%mass(ipl)) - Lpl(:) = (pl%xb(:,ipl) - xcom(:)) .cross. (pL%vb(:,ipl) - vcom(:)) + Lpl(:) = (pl%rb(:,ipl) - xcom(:)) .cross. (pL%vb(:,ipl) - vcom(:)) if (param%lrotation) Lpl(:) = pl%mass(ipl) * (Lpl(:) + pl%radius(ipl)**2 * pl%Ip(3,ipl) * pl%rot(:, ipl)) - Lcb(:) = cb%mass * ((cb%xb(:) - xcom(:)) .cross. (cb%vb(:) - vcom(:))) + Lcb(:) = cb%mass * ((cb%rb(:) - xcom(:)) .cross. (cb%vb(:) - vcom(:))) ke_orbit = ke_orbit + 0.5_DP * cb%mass * dot_product(cb%vb(:), cb%vb(:)) if (param%lrotation) ke_spin = ke_spin + 0.5_DP * cb%mass * cb%radius**2 * cb%Ip(3) * dot_product(cb%rot(:), cb%rot(:)) @@ -186,7 +186,7 @@ subroutine symba_discard_conserve_mtm(pl, system, param, ipl, lescape_body) cb%rot(:) = (cb%L0(:) + cb%dL(:)) / (cb%Ip(3) * cb%mass * cb%radius**2) ke_spin = ke_spin - 0.5_DP * cb%mass * cb%radius**2 * cb%Ip(3) * dot_product(cb%rot(:), cb%rot(:)) end if - cb%xb(:) = xcom(:) + cb%rb(:) = xcom(:) cb%vb(:) = vcom(:) ke_orbit = ke_orbit - 0.5_DP * cb%mass * dot_product(cb%vb(:), cb%vb(:)) end if @@ -360,7 +360,7 @@ module subroutine symba_discard_pl(self, system, param) class is (symba_parameters) associate(pl => self, plplenc_list => system%plplenc_list, plplcollision_list => system%plplcollision_list) call pl%vb2vh(system%cb) - call pl%xh2xb(system%cb) + call pl%rh2rb(system%cb) !call plplenc_list%write(pl, pl, param) TODO: write the encounter list writer for NetCDF call symba_discard_nonplpl(self, system, param) diff --git a/src/symba/symba_kick.f90 b/src/symba/symba_kick.f90 index 114160f9a..cdad09045 100644 --- a/src/symba/symba_kick.f90 +++ b/src/symba/symba_kick.f90 @@ -129,7 +129,7 @@ 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%rh(:,j) - pl%xbeg(:,i) + dx(:) = tp%rh(:,j) - pl%rbeg(:,i) else dx(:) = tp%rh(:,j) - pl%xend(:,i) end if diff --git a/src/symba/symba_util.f90 b/src/symba/symba_util.f90 index 9443d658c..8874be49b 100644 --- a/src/symba/symba_util.f90 +++ b/src/symba/symba_util.f90 @@ -532,7 +532,7 @@ module subroutine symba_util_peri_pl(self, system, param) else do i = 1, npl if (pl%status(i) == ACTIVE) then - vdotr = dot_product(pl%xb(:,i), pl%vb(:,i)) + vdotr = dot_product(pl%rb(:,i), pl%vb(:,i)) if (vdotr > 0.0_DP) then pl%isperi(i) = 1 else @@ -564,11 +564,11 @@ module subroutine symba_util_peri_pl(self, system, param) else do i = 1, npl if (pl%status(i) == ACTIVE) then - vdotr = dot_product(pl%xb(:,i), pl%vb(:,i)) + vdotr = dot_product(pl%rb(:,i), pl%vb(:,i)) if (pl%isperi(i) == -1) then if (vdotr >= 0.0_DP) then pl%isperi(i) = 0 - CALL orbel_xv2aeq(system%Gmtot, pl%xb(1,i), pl%xb(2,i), pl%xb(3,i), pl%vb(1,i), pl%vb(2,i), pl%vb(3,i),& + CALL orbel_xv2aeq(system%Gmtot, pl%rb(1,i), pl%rb(2,i), pl%rb(3,i), pl%vb(1,i), pl%vb(2,i), pl%vb(3,i),& pl%atp(i), e, pl%peri(i)) end if else @@ -612,7 +612,7 @@ module subroutine symba_util_rearray_pl(self, system, param) nadd = pl_adds%nbody if (npl == 0) return ! Deallocate any temporary variables - if (allocated(pl%xbeg)) deallocate(pl%xbeg) + if (allocated(pl%rbeg)) deallocate(pl%rbeg) if (allocated(pl%xend)) deallocate(pl%xend) ! Remove the discards and destroy the list, as the system already tracks pl_discards elsewhere diff --git a/src/tides/tides_spin_step.f90 b/src/tides/tides_spin_step.f90 index 576aff8d7..ee4309eb6 100644 --- a/src/tides/tides_spin_step.f90 +++ b/src/tides/tides_spin_step.f90 @@ -4,7 +4,7 @@ type, extends(lambda_obj_tvar) :: tides_derivs_func !! Base class for an lambda function object. This object takes no additional arguments other than the dependent variable x, an array of real numbers procedure(tidederiv), pointer, nopass :: lambdaptr_tides_deriv - real(DP), dimension(:,:), allocatable :: xbeg + real(DP), dimension(:,:), allocatable :: rbeg real(DP), dimension(:,:), allocatable :: xend real(DP) :: dt contains @@ -16,13 +16,13 @@ module procedure tides_derivs_init end interface abstract interface - function tidederiv(x, t, dt, xbeg, xend) result(y) + function tidederiv(x, t, dt, rbeg, xend) result(y) ! Template for a 0 argument function import DP, swiftest_nbody_system real(DP), dimension(:), intent(in) :: x real(DP), intent(in) :: t real(DP), intent(in) :: dt - real(DP), dimension(:,:), intent(in) :: xbeg + real(DP), dimension(:,:), intent(in) :: rbeg real(DP), dimension(:,:), intent(in) :: xend real(DP), dimension(:), allocatable :: y end function @@ -51,7 +51,7 @@ module subroutine tides_step_spin_system(self, param, t, dt) rot0 = [pack(pl%rot(:,1:npl),.true.), pack(cb%rot(:),.true.)] ! Use this space call the ode_solver, passing tides_spin_derivs as the function: subdt = dt / 20._DP - !rot1(:) = util_solve_rkf45(lambda_obj(tides_spin_derivs, subdt, pl%xbeg, pl%xend), rot0, dt, subdt tol) + !rot1(:) = util_solve_rkf45(lambda_obj(tides_spin_derivs, subdt, pl%rbeg, pl%xend), rot0, dt, subdt tol) ! Recover with unpack !pl%rot(:,1:npl) = unpack(rot1... !cb%rot(:) = unpack(rot1... @@ -61,7 +61,7 @@ module subroutine tides_step_spin_system(self, param, t, dt) end subroutine tides_step_spin_system - function tides_spin_derivs(rot_pl_cb, t, dt, xbeg, xend) result(drot) !! Need to add more arguments so we can pull in mass, radius, Ip, J2, etc... + function tides_spin_derivs(rot_pl_cb, t, dt, rbeg, xend) result(drot) !! Need to add more arguments so we can pull in mass, radius, Ip, J2, etc... !! author: Jennifer L.L. Pouplin and David A. Minton !! !! function used to calculate the derivatives that are fed to the ODE solver @@ -70,7 +70,7 @@ function tides_spin_derivs(rot_pl_cb, t, dt, xbeg, xend) result(drot) !! Need to real(DP), dimension(:,:), intent(in) :: rot_pl_cb !! Array of rotations. The last element is the central body, and all others are massive bodies real(DP), intent(in) :: t !! Current time, which is used to interpolate the massive body positions real(DP), intent(in) :: dt !! Total step size - real(DP), dimension(:,:), intent(in) :: xbeg + real(DP), dimension(:,:), intent(in) :: rbeg real(DP), dimension(:,:), intent(in) :: xend ! Internals real(DP), dimension(:,:), allocatable :: drot @@ -85,7 +85,7 @@ function tides_spin_derivs(rot_pl_cb, t, dt, xbeg, xend) result(drot) !! Need to allocate(drot, mold=rot_pl_cb) drot(:,:) = 0.0_DP do i = 1,n-1 - xinterp(:) = xbeg(:,i) + t / dt * (xend(:,i) - xbeg(:,i)) + xinterp(:) = rbeg(:,i) + t / dt * (xend(:,i) - rbeg(:,i)) ! Calculate Ncb and Npl as a function of xinterp !drot(:,i) = -Mcb / (Mcb + Mpl(i)) * (N_Tpl + N_Rpl) !drot(:,n) = drot(:,n) - Mcb / (Mcb + Mpl(i) * (N_Tcb + N_Rcb) @@ -104,7 +104,7 @@ function tides_derivs_eval(self, x, t) result(y) ! Result real(DP), dimension(:), allocatable :: y if (associated(self%lambdaptr_tides_deriv)) then - y = self%lambdaptr_tides_deriv(x, t, self%dt, self%xbeg, self%xend) + y = self%lambdaptr_tides_deriv(x, t, self%dt, self%rbeg, self%xend) else error stop "Lambda function was not initialized" end if @@ -112,18 +112,18 @@ function tides_derivs_eval(self, x, t) result(y) return end function tides_derivs_eval - function tides_derivs_init(lambda, dt, xbeg, xend) result(f) + function tides_derivs_init(lambda, dt, rbeg, xend) result(f) implicit none ! Arguments procedure(tidederiv) :: lambda real(DP), intent(in) :: dt - real(DP), dimension(:,:), intent(in) :: xbeg + real(DP), dimension(:,:), intent(in) :: rbeg real(DP), dimension(:,:), intent(in) :: xend ! Result type(tides_derivs_func) :: f f%lambdaptr_tides_deriv => lambda f%dt = dt - allocate(f%xbeg, source = xbeg) + allocate(f%rbeg, source = rbeg) allocate(f%xend, source = xend) return diff --git a/src/util/util_append.f90 b/src/util/util_append.f90 index a02b28f2b..7470bace4 100644 --- a/src/util/util_append.f90 +++ b/src/util/util_append.f90 @@ -211,7 +211,7 @@ module subroutine util_append_body(self, source, lsource_mask) call util_append(self%mu, source%mu, 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%rb, source%rb, nold, nsrc, lsource_mask) call util_append(self%vb, source%vb, nold, nsrc, lsource_mask) call util_append(self%ah, source%ah, nold, nsrc, lsource_mask) call util_append(self%aobl, source%aobl, nold, nsrc, lsource_mask) @@ -250,7 +250,7 @@ module subroutine util_append_pl(self, source, lsource_mask) call util_append(self%rhill, source%rhill, nold, nsrc, lsource_mask) call util_append(self%renc, source%renc, nold, nsrc, lsource_mask) call util_append(self%radius, source%radius, nold, nsrc, lsource_mask) - call util_append(self%xbeg, source%xbeg, nold, nsrc, lsource_mask) + call util_append(self%rbeg, source%rbeg, nold, nsrc, lsource_mask) call util_append(self%xend, source%xend, nold, nsrc, lsource_mask) call util_append(self%vbeg, source%vbeg, nold, nsrc, lsource_mask) call util_append(self%density, source%density, nold, nsrc, lsource_mask) diff --git a/src/util/util_coord.f90 b/src/util/util_coord.f90 index 98a5549ac..78c2eca83 100644 --- a/src/util/util_coord.f90 +++ b/src/util/util_coord.f90 @@ -38,11 +38,11 @@ module subroutine util_coord_h2b_pl(self, cb) xtmp(:) = xtmp(:) + pl%Gmass(i) * pl%rh(:,i) vtmp(:) = vtmp(:) + pl%Gmass(i) * pl%vh(:,i) end do - cb%xb(:) = -xtmp(:) / Gmtot + cb%rb(:) = -xtmp(:) / Gmtot cb%vb(:) = -vtmp(:) / Gmtot do i = 1, npl if (pl%status(i) == INACTIVE) cycle - pl%xb(:,i) = pl%rh(:,i) + cb%xb(:) + pl%rb(:,i) = pl%rh(:,i) + cb%rb(:) 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%rh(:, i) + cb%xb(:) + tp%rb(:, i) = tp%rh(:, i) + cb%rb(:) 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%rh(:, i) = pl%xb(:, i) - cb%xb(:) + pl%rh(:, i) = pl%rb(:, i) - cb%rb(:) 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%rh(:, i) = tp%xb(:, i) - cb%xb(:) + tp%rh(:, i) = tp%rb(:, i) - cb%rb(:) 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_rh2xb_pl(self, cb) + module subroutine util_coord_rh2rb_pl(self, cb) !! author: David A. Minton !! !! Convert position vectors of massive bodies from heliocentric to barycentric coordinates (position only) @@ -271,18 +271,18 @@ module subroutine util_coord_rh2xb_pl(self, cb) Gmtot = Gmtot + pl%Gmass(i) xtmp(:) = xtmp(:) + pl%Gmass(i) * pl%rh(:,i) end do - cb%xb(:) = -xtmp(:) / Gmtot + cb%rb(:) = -xtmp(:) / Gmtot do i = 1, npl if (pl%status(i) == INACTIVE) cycle - pl%xb(:,i) = pl%rh(:,i) + cb%xb(:) + pl%rb(:,i) = pl%rh(:,i) + cb%rb(:) end do end associate return - end subroutine util_coord_rh2xb_pl + end subroutine util_coord_rh2rb_pl - module subroutine util_coord_rh2xb_tp(self, cb) + module subroutine util_coord_rh2rb_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_rh2xb_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%rh(:, i) + cb%xb(:) + tp%rb(:, i) = tp%rh(:, i) + cb%rb(:) end do end associate return - end subroutine util_coord_rh2xb_tp + end subroutine util_coord_rh2rb_tp end submodule s_util_coord \ No newline at end of file diff --git a/src/util/util_dealloc.f90 b/src/util/util_dealloc.f90 index 54151f567..14309d2a6 100644 --- a/src/util/util_dealloc.f90 +++ b/src/util/util_dealloc.f90 @@ -27,7 +27,7 @@ module subroutine util_dealloc_body(self) if (allocated(self%mu)) deallocate(self%mu) if (allocated(self%rh)) deallocate(self%rh) if (allocated(self%vh)) deallocate(self%vh) - if (allocated(self%xb)) deallocate(self%xb) + if (allocated(self%rb)) deallocate(self%rb) if (allocated(self%vb)) deallocate(self%vb) if (allocated(self%ah)) deallocate(self%ah) if (allocated(self%aobl)) deallocate(self%aobl) diff --git a/src/util/util_fill.f90 b/src/util/util_fill.f90 index 9b542d19c..265138238 100644 --- a/src/util/util_fill.f90 +++ b/src/util/util_fill.f90 @@ -162,7 +162,7 @@ module subroutine util_fill_body(self, inserts, lfill_list) call util_fill(keeps%mu, inserts%mu, 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%rb, inserts%rb, lfill_list) call util_fill(keeps%vb, inserts%vb, lfill_list) call util_fill(keeps%ah, inserts%ah, lfill_list) call util_fill(keeps%aobl, inserts%aobl, lfill_list) @@ -208,7 +208,7 @@ module subroutine util_fill_pl(self, inserts, lfill_list) call util_fill(keeps%k2, inserts%k2, lfill_list) call util_fill(keeps%Q, inserts%Q, lfill_list) call util_fill(keeps%tlag, inserts%tlag, lfill_list) - call util_fill(keeps%xbeg, inserts%xbeg, lfill_list) + call util_fill(keeps%rbeg, inserts%rbeg, lfill_list) call util_fill(keeps%vbeg, inserts%vbeg, lfill_list) call util_fill(keeps%Ip, inserts%Ip, lfill_list) call util_fill(keeps%rot, inserts%rot, lfill_list) diff --git a/src/util/util_get_energy_momentum.f90 b/src/util/util_get_energy_momentum.f90 index ed7119d8b..cc1e64d15 100644 --- a/src/util/util_get_energy_momentum.f90 +++ b/src/util/util_get_energy_momentum.f90 @@ -49,12 +49,12 @@ module subroutine util_get_energy_momentum_system(self, param) system%GMtot = cb%Gmass + sum(pl%Gmass(1:npl), pl%lmask(1:npl)) kecb = cb%mass * dot_product(cb%vb(:), cb%vb(:)) - Lcborbit(:) = cb%mass * (cb%xb(:) .cross. cb%vb(:)) + Lcborbit(:) = cb%mass * (cb%rb(:) .cross. cb%vb(:)) do concurrent (i = 1:npl, pl%lmask(i)) - hx = pl%xb(2,i) * pl%vb(3,i) - pl%xb(3,i) * pl%vb(2,i) - hy = pl%xb(3,i) * pl%vb(1,i) - pl%xb(1,i) * pl%vb(3,i) - hz = pl%xb(1,i) * pl%vb(2,i) - pl%xb(2,i) * pl%vb(1,i) + hx = pl%rb(2,i) * pl%vb(3,i) - pl%rb(3,i) * pl%vb(2,i) + hy = pl%rb(3,i) * pl%vb(1,i) - pl%rb(1,i) * pl%vb(3,i) + hz = pl%rb(1,i) * pl%vb(2,i) - pl%rb(2,i) * pl%vb(1,i) ! Angular momentum from orbit Lplorbitx(i) = pl%mass(i) * hx @@ -87,9 +87,9 @@ module subroutine util_get_energy_momentum_system(self, param) end if if (param%lflatten_interactions) then - call util_get_energy_potential_flat(npl, pl%nplpl, pl%k_plpl, pl%lmask, cb%Gmass, pl%Gmass, pl%mass, pl%xb, system%pe) + call util_get_energy_potential_flat(npl, pl%nplpl, pl%k_plpl, pl%lmask, cb%Gmass, pl%Gmass, pl%mass, pl%rb, system%pe) else - call util_get_energy_potential_triangular(npl, pl%lmask, cb%Gmass, pl%Gmass, pl%mass, pl%xb, system%pe) + call util_get_energy_potential_triangular(npl, pl%lmask, cb%Gmass, pl%Gmass, pl%mass, pl%rb, system%pe) end if ! Potential energy from the oblateness term @@ -119,7 +119,7 @@ module subroutine util_get_energy_momentum_system(self, param) end subroutine util_get_energy_momentum_system - subroutine util_get_energy_potential_flat(npl, nplpl, k_plpl, lmask, GMcb, Gmass, mass, xb, pe) + subroutine util_get_energy_potential_flat(npl, nplpl, k_plpl, lmask, GMcb, Gmass, mass, rb, pe) !! author: David A. Minton !! !! Compute total system potential energy @@ -132,7 +132,7 @@ subroutine util_get_energy_potential_flat(npl, nplpl, k_plpl, lmask, GMcb, Gmass real(DP), intent(in) :: GMcb real(DP), dimension(:), intent(in) :: Gmass real(DP), dimension(:), intent(in) :: mass - real(DP), dimension(:,:), intent(in) :: xb + real(DP), dimension(:,:), intent(in) :: rb real(DP), intent(out) :: pe ! Internals integer(I4B) :: i, j @@ -147,18 +147,18 @@ subroutine util_get_energy_potential_flat(npl, nplpl, k_plpl, lmask, GMcb, Gmass end where do concurrent(i = 1:npl, lmask(i)) - pecb(i) = -GMcb * mass(i) / norm2(xb(:,i)) + pecb(i) = -GMcb * mass(i) / norm2(rb(:,i)) end do !$omp parallel do default(private) schedule(static)& - !$omp shared(k_plpl, xb, mass, Gmass, pepl, lstatpl, lmask) & + !$omp shared(k_plpl, rb, mass, Gmass, pepl, lstatpl, lmask) & !$omp firstprivate(nplpl) do k = 1, nplpl i = k_plpl(1,k) j = k_plpl(2,k) lstatpl(k) = (lmask(i) .and. lmask(j)) if (lstatpl(k)) then - pepl(k) = -(Gmass(i) * mass(j)) / norm2(xb(:, i) - xb(:, j)) + pepl(k) = -(Gmass(i) * mass(j)) / norm2(rb(:, i) - rb(:, j)) else pepl(k) = 0.0_DP end if @@ -171,7 +171,7 @@ subroutine util_get_energy_potential_flat(npl, nplpl, k_plpl, lmask, GMcb, Gmass end subroutine util_get_energy_potential_flat - subroutine util_get_energy_potential_triangular(npl, lmask, GMcb, Gmass, mass, xb, pe) + subroutine util_get_energy_potential_triangular(npl, lmask, GMcb, Gmass, mass, rb, pe) !! author: David A. Minton !! !! Compute total system potential energy @@ -182,7 +182,7 @@ subroutine util_get_energy_potential_triangular(npl, lmask, GMcb, Gmass, mass, x real(DP), intent(in) :: GMcb real(DP), dimension(:), intent(in) :: Gmass real(DP), dimension(:), intent(in) :: mass - real(DP), dimension(:,:), intent(in) :: xb + real(DP), dimension(:,:), intent(in) :: rb real(DP), intent(out) :: pe ! Internals integer(I4B) :: i, j @@ -194,18 +194,18 @@ subroutine util_get_energy_potential_triangular(npl, lmask, GMcb, Gmass, mass, x end where do concurrent(i = 1:npl, lmask(i)) - pecb(i) = -GMcb * mass(i) / norm2(xb(:,i)) + pecb(i) = -GMcb * mass(i) / norm2(rb(:,i)) end do pe = 0.0_DP !$omp parallel do default(private) schedule(static)& - !$omp shared(lmask, Gmass, mass, xb) & + !$omp shared(lmask, Gmass, mass, rb) & !$omp firstprivate(npl) & !$omp reduction(+:pe) do i = 1, npl if (lmask(i)) then do concurrent(j = i+1:npl, lmask(i) .and. lmask(j)) - pepl(j) = - (Gmass(i) * mass(j)) / norm2(xb(:, i) - xb(:, j)) + pepl(j) = - (Gmass(i) * mass(j)) / norm2(rb(:, i) - rb(:, j)) end do pe = pe + sum(pepl(i+1:npl), lmask(i+1:npl)) end if diff --git a/src/util/util_peri.f90 b/src/util/util_peri.f90 index badd0e328..76252828e 100644 --- a/src/util/util_peri.f90 +++ b/src/util/util_peri.f90 @@ -51,11 +51,11 @@ module subroutine util_peri_tp(self, system, param) end do else do i = 1, ntp - vdotr(i) = dot_product(tp%xb(:, i), tp%vb(:, i)) + vdotr(i) = dot_product(tp%rb(:, i), tp%vb(:, i)) if (tp%isperi(i) == -1) then if (vdotr(i) >= 0.0_DP) then tp%isperi(i) = 0 - call orbel_xv2aeq(system%Gmtot, tp%xb(1,i), tp%xb(2,i), tp%xb(3,i), tp%vb(1,i), tp%vb(2,i), tp%vb(3,i), & + call orbel_xv2aeq(system%Gmtot, tp%rb(1,i), tp%rb(2,i), tp%rb(3,i), tp%vb(1,i), tp%vb(2,i), tp%vb(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 deb3e0e1e..372edd3fb 100644 --- a/src/util/util_rescale.f90 +++ b/src/util/util_rescale.f90 @@ -42,7 +42,7 @@ module subroutine util_rescale_system(self, param, mscale, dscale, tscale) cb%mass = cb%mass / mscale cb%Gmass = param%GU * cb%mass cb%radius = cb%radius / dscale - cb%xb(:) = cb%xb(:) / dscale + cb%rb(:) = cb%rb(:) / dscale cb%vb(:) = cb%vb(:) / vscale cb%rot(:) = cb%rot(:) * tscale pl%mass(1:npl) = pl%mass(1:npl) / mscale @@ -50,7 +50,7 @@ module subroutine util_rescale_system(self, param, mscale, dscale, tscale) pl%radius(1:npl) = pl%radius(1:npl) / dscale pl%rh(:,1:npl) = pl%rh(:,1:npl) / dscale pl%vh(:,1:npl) = pl%vh(:,1:npl) / vscale - pl%xb(:,1:npl) = pl%xb(:,1:npl) / dscale + pl%rb(:,1:npl) = pl%rb(:,1:npl) / dscale pl%vb(:,1:npl) = pl%vb(:,1:npl) / vscale pl%rot(:,1:npl) = pl%rot(:,1:npl) * tscale diff --git a/src/util/util_resize.f90 b/src/util/util_resize.f90 index eee6b0e4c..4963fd689 100644 --- a/src/util/util_resize.f90 +++ b/src/util/util_resize.f90 @@ -299,7 +299,7 @@ module subroutine util_resize_body(self, nnew) call util_resize(self%mu, nnew) call util_resize(self%rh, nnew) call util_resize(self%vh, nnew) - call util_resize(self%xb, nnew) + call util_resize(self%rb, nnew) call util_resize(self%vb, nnew) call util_resize(self%ah, nnew) call util_resize(self%aobl, nnew) @@ -334,7 +334,7 @@ module subroutine util_resize_pl(self, nnew) call util_resize(self%rhill, nnew) call util_resize(self%renc, nnew) call util_resize(self%radius, nnew) - call util_resize(self%xbeg, nnew) + call util_resize(self%rbeg, nnew) call util_resize(self%xend, nnew) call util_resize(self%vbeg, nnew) call util_resize(self%density, nnew) diff --git a/src/util/util_set.f90 b/src/util/util_set.f90 index 05e4b41f9..3e7719bff 100644 --- a/src/util/util_set.f90 +++ b/src/util/util_set.f90 @@ -13,18 +13,18 @@ use swiftest contains - module subroutine util_set_beg_end_pl(self, xbeg, xend, vbeg) + module subroutine util_set_beg_end_pl(self, rbeg, xend, vbeg) !! author: David A. Minton !! - !! Sets one or more of the values of xbeg, xend, and vbeg + !! Sets one or more of the values of rbeg, xend, and vbeg implicit none ! Arguments class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object - real(DP), dimension(:,:), intent(in), optional :: xbeg, xend, vbeg + real(DP), dimension(:,:), intent(in), optional :: rbeg, xend, vbeg - if (present(xbeg)) then - if (allocated(self%xbeg)) deallocate(self%xbeg) - allocate(self%xbeg, source=xbeg) + if (present(rbeg)) then + if (allocated(self%rbeg)) deallocate(self%rbeg) + allocate(self%rbeg, source=rbeg) end if if (present(xend)) then if (allocated(self%xend)) deallocate(self%xend) diff --git a/src/util/util_sort.f90 b/src/util/util_sort.f90 index b1500afab..6b48103d5 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", "rh", "vh", "xb", "vb", "ah", "aobl", "atide", "agr") + case("lfirst", "nbody", "ldiscard", "rh", "vh", "rb", "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!' @@ -687,7 +687,7 @@ module subroutine util_sort_pl(self, sortby, ascending) call util_sort(direction * pl%Q(1:npl), ind) case("tlag") call util_sort(direction * pl%tlag(1:npl), ind) - case("xbeg", "xend", "vbeg", "Ip", "rot", "k_plpl", "nplpl") + case("rbeg", "xend", "vbeg", "Ip", "rot", "k_plpl", "nplpl") write(*,*) 'Cannot sort by ' // trim(adjustl(sortby)) // '. Component not sortable!' case default ! Look for components in the parent class call util_sort_body(pl, sortby, ascending) @@ -762,7 +762,7 @@ module subroutine util_sort_rearrange_body(self, ind) call util_sort_rearrange(self%ldiscard, 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%rb, ind, n) call util_sort_rearrange(self%vb, ind, n) call util_sort_rearrange(self%ah, ind, n) call util_sort_rearrange(self%ir3h, ind, n) @@ -964,7 +964,7 @@ module subroutine util_sort_rearrange_pl(self, ind) call util_sort_rearrange(pl%mass, ind, npl) call util_sort_rearrange(pl%Gmass, ind, npl) call util_sort_rearrange(pl%rhill, ind, npl) - call util_sort_rearrange(pl%xbeg, ind, npl) + call util_sort_rearrange(pl%rbeg, ind, npl) call util_sort_rearrange(pl%vbeg, ind, npl) call util_sort_rearrange(pl%radius, ind, npl) call util_sort_rearrange(pl%density, ind, npl) diff --git a/src/util/util_spill.f90 b/src/util/util_spill.f90 index 9b9208252..1ba4b4a2f 100644 --- a/src/util/util_spill.f90 +++ b/src/util/util_spill.f90 @@ -341,7 +341,7 @@ module subroutine util_spill_body(self, discards, lspill_list, ldestructive) call util_spill(keeps%mu, discards%mu, 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%rb, discards%rb, lspill_list, ldestructive) call util_spill(keeps%vb, discards%vb, lspill_list, ldestructive) call util_spill(keeps%ah, discards%ah, lspill_list, ldestructive) call util_spill(keeps%aobl, discards%aobl, lspill_list, ldestructive) @@ -391,7 +391,7 @@ module subroutine util_spill_pl(self, discards, lspill_list, ldestructive) call util_spill(keeps%k2, discards%k2, lspill_list, ldestructive) call util_spill(keeps%Q, discards%Q, lspill_list, ldestructive) call util_spill(keeps%tlag, discards%tlag, lspill_list, ldestructive) - call util_spill(keeps%xbeg, discards%xbeg, lspill_list, ldestructive) + call util_spill(keeps%rbeg, discards%rbeg, lspill_list, ldestructive) call util_spill(keeps%vbeg, discards%vbeg, lspill_list, ldestructive) call util_spill(keeps%Ip, discards%Ip, lspill_list, ldestructive) call util_spill(keeps%rot, discards%rot, lspill_list, ldestructive) diff --git a/src/whm/whm_kick.f90 b/src/whm/whm_kick.f90 index d782c89f4..b675e4370 100644 --- a/src/whm/whm_kick.f90 +++ b/src/whm/whm_kick.f90 @@ -90,11 +90,11 @@ module subroutine whm_kick_getacch_tp(self, system, param, t, lbeg) system%lbeg = lbeg if (lbeg) then - ah0(:) = whm_kick_getacch_ah0(pl%Gmass(1:npl), pl%xbeg(:, 1:npl), npl) + ah0(:) = whm_kick_getacch_ah0(pl%Gmass(1:npl), pl%rbeg(:, 1:npl), npl) do concurrent(i = 1:ntp, tp%lmask(i)) tp%ah(:, i) = tp%ah(:, i) + ah0(:) end do - call tp%accel_int(param, pl%Gmass(1:npl), pl%xbeg(:, 1:npl), npl) + call tp%accel_int(param, pl%Gmass(1:npl), pl%rbeg(:, 1:npl), npl) else ah0(:) = whm_kick_getacch_ah0(pl%Gmass(1:npl), pl%xend(:, 1:npl), npl) do concurrent(i = 1:ntp, tp%lmask(i)) @@ -112,14 +112,14 @@ module subroutine whm_kick_getacch_tp(self, system, param, t, lbeg) end subroutine whm_kick_getacch_tp - function whm_kick_getacch_ah0(mu, xhp, n) result(ah0) + function whm_kick_getacch_ah0(mu, rhp, n) result(ah0) !! author: David A. Minton !! !! Compute zeroth term heliocentric accelerations of planets implicit none ! Arguments real(DP), dimension(:), intent(in) :: mu - real(DP), dimension(:,:), intent(in) :: xhp + real(DP), dimension(:,:), intent(in) :: rhp integer(I4B), intent(in) :: n ! Result real(DP), dimension(NDIM) :: ah0 @@ -129,11 +129,11 @@ function whm_kick_getacch_ah0(mu, xhp, n) result(ah0) ah0(:) = 0.0_DP do i = 1, n - r2 = dot_product(xhp(:, i), xhp(:, i)) + r2 = dot_product(rhp(:, i), rhp(:, i)) irh = 1.0_DP / sqrt(r2) ir3h = irh / r2 fac = mu(i) * ir3h - ah0(:) = ah0(:) - fac * xhp(:, i) + ah0(:) = ah0(:) - fac * rhp(:, i) end do return @@ -227,7 +227,7 @@ 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%rh) + call pl%set_beg_end(rbeg = pl%rh) else pl%ah(:, 1:npl) = 0.0_DP call pl%accel(system, param, t, lbeg) From b862fb4b99f7007afcdb288105a103e2b5846e7e Mon Sep 17 00:00:00 2001 From: David A Minton Date: Tue, 13 Dec 2022 06:14:49 -0500 Subject: [PATCH 395/569] Added a check to see if a non-collision is a closest approach (reimplementing an old Swifter feature) --- src/symba/symba_collision.f90 | 27 ++++++++++++++++----------- 1 file changed, 16 insertions(+), 11 deletions(-) diff --git a/src/symba/symba_collision.f90 b/src/symba/symba_collision.f90 index a32a18c7c..222320588 100644 --- a/src/symba/symba_collision.f90 +++ b/src/symba/symba_collision.f90 @@ -279,9 +279,9 @@ module function symba_collision_check_encounter(self, system, param, t, dt, irec real(DP), intent(in) :: dt !! step size integer(I4B), intent(in) :: irec !! Current recursion level ! Result - logical :: lany_collision !! Returns true if cany pair of encounters resulted in a collision + logical :: lany_collision, lany_closest !! Returns true if cany pair of encounters resulted in a collision ! Internals - logical, dimension(:), allocatable :: lcollision, lmask + logical, dimension(:), allocatable :: lcollision, lclosest, lmask real(DP), dimension(NDIM) :: xr, vr integer(I4B) :: i, j, k, nenc real(DP) :: rlim, Gmtot @@ -290,6 +290,7 @@ module function symba_collision_check_encounter(self, system, param, t, dt, irec class(symba_encounter), allocatable :: tmp lany_collision = .false. + lany_closest = .false. if (self%nenc == 0) return select type(self) @@ -315,6 +316,8 @@ module function symba_collision_check_encounter(self, system, param, t, dt, irec allocate(lcollision(nenc)) lcollision(:) = .false. + allocate(lclosest(nenc)) + lclosest(:) = .false. if (isplpl) then do concurrent(k = 1:nenc, lmask(k)) @@ -324,8 +327,7 @@ module function symba_collision_check_encounter(self, system, param, t, dt, irec vr(:) = pl%vb(:, i) - pl%vb(:, j) rlim = pl%radius(i) + pl%radius(j) Gmtot = pl%Gmass(i) + pl%Gmass(j) - lcollision(k) = symba_collision_check_one(xr(1), xr(2), xr(3), vr(1), vr(2), vr(3), & - Gmtot, rlim, dt, self%lvdotr(k)) + call symba_collision_check_one(xr(1), xr(2), xr(3), vr(1), vr(2), vr(3), Gmtot, rlim, dt, self%lvdotr(k), lcollision(k), lclosest(k)) end do else do concurrent(k = 1:nenc, lmask(k)) @@ -333,12 +335,13 @@ module function symba_collision_check_encounter(self, system, param, t, dt, irec j = self%index2(k) 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)) + call 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), lcollision(k), lclosest(k)) end do end if lany_collision = any(lcollision(:)) + lany_closest = any(lclosest(:)) + if (lany_collision) then call pl%rh2rb(system%cb) ! Update the central body barycenteric position vector to get us out of DH and into bary do k = 1, nenc @@ -379,6 +382,7 @@ module function symba_collision_check_encounter(self, system, param, t, dt, irec end if end do end if + end select end select @@ -397,7 +401,7 @@ module function symba_collision_check_encounter(self, system, param, t, dt, irec end function symba_collision_check_encounter - pure elemental function symba_collision_check_one(xr, yr, zr, vxr, vyr, vzr, Gmtot, rlim, dt, lvdotr) result(lcollision) + pure elemental subroutine symba_collision_check_one(xr, yr, zr, vxr, vyr, vzr, Gmtot, rlim, dt, lvdotr, lcollision, lclosest) !! author: David A. Minton !! !! Check for a merger between a single pair of particles @@ -413,14 +417,14 @@ pure elemental function symba_collision_check_one(xr, yr, zr, vxr, vyr, vzr, Gmt real(DP), intent(in) :: rlim !! Collision limit - Typically the sum of the radii of colliding bodies real(DP), intent(in) :: dt !! Step size logical, intent(in) :: lvdotr !! Logical flag indicating that these two bodies are approaching in the current substep - ! Result - logical :: lcollision !! Logical flag indicating whether these two bodies will collide or not + logical, intent(out) :: lcollision !! Logical flag indicating whether these two bodies will collide or not + logical, intent(out) :: lclosest !! Logical flag indicating that, while not a collision, this is the closest approach for this pair of bodies ! Internals real(DP) :: r2, rlim2, a, e, q, vdotr, tcr2, dt2 r2 = xr**2 + yr**2 + zr**2 rlim2 = rlim**2 - + lclosest = .false. if (r2 <= rlim2) then ! checks if bodies are actively colliding in this time step lcollision = .true. else ! if they are not actively colliding in this time step, checks if they are going to collide next time step based on velocities and q @@ -432,12 +436,13 @@ pure elemental function symba_collision_check_one(xr, yr, zr, vxr, vyr, vzr, Gmt if (tcr2 <= dt2) then call orbel_xv2aeq(Gmtot, xr, yr, zr, vxr, vyr, vzr, a, e, q) lcollision = (q < rlim) + lclosest = .not. lcollision end if end if end if return - end function symba_collision_check_one + end subroutine symba_collision_check_one function symba_collision_consolidate_colliders(pl, cb, param, idx_parent, colliders) result(lflag) From ecdce0b5be1c5b3f031e5eb812b06c738be70e45 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Tue, 13 Dec 2022 06:23:35 -0500 Subject: [PATCH 396/569] Minor restructuring --- src/symba/symba_collision.f90 | 20 +++++++++----------- 1 file changed, 9 insertions(+), 11 deletions(-) diff --git a/src/symba/symba_collision.f90 b/src/symba/symba_collision.f90 index 222320588..405c3855d 100644 --- a/src/symba/symba_collision.f90 +++ b/src/symba/symba_collision.f90 @@ -381,22 +381,20 @@ module function symba_collision_check_encounter(self, system, param, t, dt, irec end if end if end do + + ! Extract the pl-pl or pl-tp encounter list and return the pl-pl or pl-tp collision_list + select type(self) + class is (symba_plplenc) + call self%extract_collisions(system, param) + class is (symba_pltpenc) + allocate(tmp, mold=self) + call self%spill(tmp, lcollision, ldestructive=.true.) ! Remove this encounter pair from the encounter list + end select end if end select end select - ! Extract the pl-pl or pl-tp encounter list and return the pl-pl or pl-tp collision_list - if (lany_collision) then - select type(self) - class is (symba_plplenc) - call self%extract_collisions(system, param) - class default - allocate(tmp, mold=self) - call self%spill(tmp, lcollision, ldestructive=.true.) ! Remove this encounter pair from the encounter list - end select - end if - return end function symba_collision_check_encounter From befa1a6f72421dbe3d26a652ed083b89e3d7ace0 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Tue, 13 Dec 2022 06:32:51 -0500 Subject: [PATCH 397/569] Fixed a typo that would prevent test particle collisions from being resolved. Added close approach flags to encounter check in SyMBA --- src/modules/symba_classes.f90 | 7 ++++--- src/symba/symba_collision.f90 | 11 +++++------ src/symba/symba_step.f90 | 6 +++--- 3 files changed, 12 insertions(+), 12 deletions(-) diff --git a/src/modules/symba_classes.f90 b/src/modules/symba_classes.f90 index 3dbcfb90f..47d9c9997 100644 --- a/src/modules/symba_classes.f90 +++ b/src/modules/symba_classes.f90 @@ -207,7 +207,7 @@ module symba_classes interface - module function symba_collision_check_encounter(self, system, param, t, dt, irec) result(lany_collision) + module subroutine symba_collision_check_encounter(self, system, param, t, dt, irec, lany_collision, lany_closest) use swiftest_classes, only : swiftest_parameters implicit none class(symba_encounter), intent(inout) :: self !! SyMBA pl-tp encounter list object @@ -216,8 +216,9 @@ module function symba_collision_check_encounter(self, system, param, t, dt, irec real(DP), intent(in) :: t !! current time real(DP), intent(in) :: dt !! step size integer(I4B), intent(in) :: irec !! Current recursion level - logical :: lany_collision !! Returns true if cany pair of encounters resulted in a collision n - end function symba_collision_check_encounter + logical, intent(out) :: lany_collision !! Returns true if any pair of encounters resulted in a collision + logical, intent(out) :: lany_closest !! Returns true if any pair of encounters reached their closest approach without colliding + end subroutine symba_collision_check_encounter module subroutine symba_collision_encounter_extract_collisions(self, system, param) implicit none diff --git a/src/symba/symba_collision.f90 b/src/symba/symba_collision.f90 index 405c3855d..8534237c2 100644 --- a/src/symba/symba_collision.f90 +++ b/src/symba/symba_collision.f90 @@ -262,7 +262,7 @@ subroutine symba_collision_collider_message(pl, collidx, collider_message) end subroutine symba_collision_collider_message - module function symba_collision_check_encounter(self, system, param, t, dt, irec) result(lany_collision) + module subroutine symba_collision_check_encounter(self, system, param, t, dt, irec, lany_collision, lany_closest) !! author: David A. Minton !! !! Check for merger between massive bodies and test particles in SyMBA @@ -278,8 +278,7 @@ module function symba_collision_check_encounter(self, system, param, t, dt, irec real(DP), intent(in) :: t !! current time real(DP), intent(in) :: dt !! step size integer(I4B), intent(in) :: irec !! Current recursion level - ! Result - logical :: lany_collision, lany_closest !! Returns true if cany pair of encounters resulted in a collision + logical, intent(out) :: lany_collision, lany_closest !! Returns true if cany pair of encounters resulted in a collision ! Internals logical, dimension(:), allocatable :: lcollision, lclosest, lmask real(DP), dimension(NDIM) :: xr, vr @@ -396,7 +395,7 @@ module function symba_collision_check_encounter(self, system, param, t, dt, irec end select return - end function symba_collision_check_encounter + end subroutine symba_collision_check_encounter pure elemental subroutine symba_collision_check_one(xr, yr, zr, vxr, vyr, vzr, Gmtot, rlim, dt, lvdotr, lcollision, lclosest) @@ -985,7 +984,7 @@ module subroutine symba_resolve_collision_plplenc(self, system, param, t, dt, ir integer(I4B), intent(in) :: irec !! Current recursion level ! Internals real(DP) :: Eorbit_before, Eorbit_after - logical :: lplpl_collision + logical :: lplpl_collision, lplpl_closest character(len=STRMAX) :: timestr class(symba_parameters), allocatable :: tmp_param @@ -1038,7 +1037,7 @@ module subroutine symba_resolve_collision_plplenc(self, system, param, t, dt, ir deallocate(tmp_param) ! Check whether or not any of the particles that were just added are themselves in a collision state. This will generate a new plplcollision_list - lplpl_collision = plplenc_list%collision_check(system, param, t, dt, irec) + call plplenc_list%collision_check(system, param, t, dt, irec, lplpl_collision, lplpl_closest) if (.not.lplpl_collision) exit end do diff --git a/src/symba/symba_step.f90 b/src/symba/symba_step.f90 index 54e2464d1..ba61844e5 100644 --- a/src/symba/symba_step.f90 +++ b/src/symba/symba_step.f90 @@ -180,7 +180,7 @@ recursive module subroutine symba_step_recur_system(self, param, t, ireci) ! Internals integer(I4B) :: j, irecp, nloops real(DP) :: dtl, dth - logical :: lencounter + logical :: lencounter, lplpl_closest, lpltp_closest select type(param) class is (symba_parameters) @@ -241,8 +241,8 @@ recursive module subroutine symba_step_recur_system(self, param, t, ireci) end if if (param%lclose) then - lplpl_collision = plplenc_list%collision_check(system, param, t+dtl, dtl, ireci) - lpltp_collision = pltpenc_list%collision_check(system, param, t+dtl, dtl, ireci) + call plplenc_list%collision_check(system, param, t+dtl, dtl, ireci, lplpl_collision, lplpl_closest) + call pltpenc_list%collision_check(system, param, t+dtl, dtl, ireci, lpltp_collision, lpltp_closest) if (lplpl_collision) call plplenc_list%resolve_collision(system, param, t+dtl, dtl, ireci) if (lpltp_collision) call pltpenc_list%resolve_collision(system, param, t+dtl, dtl, ireci) From 52ecbefd61460c837178dddd2d5754f6424da7b8 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Tue, 13 Dec 2022 08:18:05 -0500 Subject: [PATCH 398/569] Restructuring so that the saving collisions is not a user option (collision info should always be saved when collisions are turned on) --- examples/Basic_Simulation/output_reader.py | 2 +- examples/Fragmentation/Fragmentation_Movie.py | 2 +- python/swiftest/swiftest/io.py | 5 +- python/swiftest/swiftest/simulation_class.py | 50 +++---------------- src/io/io.f90 | 2 +- src/modules/symba_classes.f90 | 10 ++-- src/symba/symba_collision.f90 | 19 ++++--- src/symba/symba_io.f90 | 12 +---- src/symba/symba_step.f90 | 6 +-- 9 files changed, 32 insertions(+), 76 deletions(-) diff --git a/examples/Basic_Simulation/output_reader.py b/examples/Basic_Simulation/output_reader.py index a41103ccd..fc332af0c 100644 --- a/examples/Basic_Simulation/output_reader.py +++ b/examples/Basic_Simulation/output_reader.py @@ -28,7 +28,7 @@ import matplotlib.pyplot as plt # Read in the simulation output and store it as an Xarray dataset. -sim = swiftest.Simulation(read_old_output_file=True) +sim = swiftest.Simulation(read_old_output=True) # Plot of the data and save the output plot. colors = ['white' if x == 'Massive Body' else 'black' for x in sim.data['particle_type']] diff --git a/examples/Fragmentation/Fragmentation_Movie.py b/examples/Fragmentation/Fragmentation_Movie.py index 090a4f4a3..a068205fb 100644 --- a/examples/Fragmentation/Fragmentation_Movie.py +++ b/examples/Fragmentation/Fragmentation_Movie.py @@ -202,7 +202,7 @@ def data_stream(self, frame=0): # 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, collision_save="TRAJECTORY", encounter_save="TRAJECTORY", gmtiny=gmtiny, minimum_fragment_gmass=minimum_fragment_gmass, verbose=False) + sim.set_parameter(fragmentation=True, encounter_save="TRAJECTORY", gmtiny=gmtiny, minimum_fragment_gmass=minimum_fragment_gmass, verbose=False) sim.run(dt=1e-4, tstop=1.0e-3, istep_out=1, dump_cadence=1) print("Generating animation") diff --git a/python/swiftest/swiftest/io.py b/python/swiftest/swiftest/io.py index be70cae50..029672ec7 100644 --- a/python/swiftest/swiftest/io.py +++ b/python/swiftest/swiftest/io.py @@ -32,8 +32,7 @@ "ENCOUNTER_CHECK", "TSTART", "DUMP_CADENCE", - "ENCOUNTER_SAVE", - "COLLISION_SAVE") + "ENCOUNTER_SAVE") @@ -55,7 +54,7 @@ float_param = ["T0", "TSTART", "TSTOP", "DT", "CHK_RMIN", "CHK_RMAX", "CHK_EJECT", "CHK_QMIN", "DU2M", "MU2KG", "TU2S", "MIN_GMFRAG", "GMTINY"] -upper_str_param = ["OUT_TYPE","OUT_FORM","OUT_STAT","IN_TYPE","IN_FORM","ENCOUNTER_SAVE","COLLISION_SAVE", "CHK_QMIN_COORD"] +upper_str_param = ["OUT_TYPE","OUT_FORM","OUT_STAT","IN_TYPE","IN_FORM","ENCOUNTER_SAVE", "CHK_QMIN_COORD"] lower_str_param = ["NC_IN", "PL_IN", "TP_IN", "CB_IN", "CHK_QMIN_RANGE"] param_keys = ['! VERSION'] + int_param + float_param + upper_str_param + lower_str_param+ bool_param diff --git a/python/swiftest/swiftest/simulation_class.py b/python/swiftest/swiftest/simulation_class.py index 1bedfeba4..a239b9293 100644 --- a/python/swiftest/swiftest/simulation_class.py +++ b/python/swiftest/swiftest/simulation_class.py @@ -43,7 +43,7 @@ class Simulation: This is a class that defines the basic Swift/Swifter/Swiftest simulation object """ - def __init__(self,read_param: bool = False, read_old_output_file: bool = False, simdir: os.PathLike | str = "simdata", **kwargs: Any): + def __init__(self,read_param: bool = False, read_old_output: bool = False, simdir: os.PathLike | str = "simdata", **kwargs: Any): """ Parameters @@ -65,7 +65,7 @@ def __init__(self,read_param: bool = False, read_old_output_file: bool = False, inside the current working directory, which can be changed by passing `param_file` as an argument. - The argument has an equivalent parameter or set of parameters in the parameter input file. 3. Default values (see below) - read_old_output_file : bool, default False + read_old_output : bool, default False If true, read in a pre-existing binary input file given by the argument `output_file_name` if it exists. Parameter input file equivalent: None simdir : PathLike, default `"simdir"` @@ -227,12 +227,6 @@ def __init__(self,read_param: bool = False, read_old_output_file: bool = False, If set to True, this turns on the Fraggle fragment generation code and `rotation` must also be True. This argument only applies to Swiftest-SyMBA simulations. It will be ignored otherwise. Parameter input file equivalent: `FRAGMENTATION` - collision_save : {"NONE","TRAJECTORY","CLOSEST"}, default "NONE" - Indicate if and how fragmentation data should be saved. If set to "TRAJECTORY" the full close encounter - trajectories associated with each collision are saved to file. If set to "CLOSEST" only the trajectories - at a the time the collision occurs are saved. If set to "NONE" no trajectory information is saved (collision - details are still logged fraggle.log). - *WARNING*: Enabling this feature could lead to very large files. minimum_fragment_gmass : float, optional If fragmentation is turned on, this sets the mimimum G*mass of a collisional fragment that can be generated. *Note.* Only set one of minimum_fragment_gmass or minimum_fragment_mass @@ -329,7 +323,7 @@ def __init__(self,read_param: bool = False, read_old_output_file: bool = False, msg += "\nDelete the file or change the location of param_file" raise NotADirectoryError(msg) else: - if read_old_output_file or read_param: + if read_old_output or read_param: raise NotADirectoryError(f"Cannot find directory {self.simdir.resolve()} ") else: self.simdir.mkdir(parents=True, exist_ok=False) @@ -354,8 +348,8 @@ def __init__(self,read_param: bool = False, read_old_output_file: bool = False, # If the user asks to read in an old parameter file or output file, override any default parameters with values from the file # If the file doesn't exist, flag it for now so we know to create it param_file_found = False - if read_param or read_old_output_file: - if self.read_param(read_init_cond = not read_old_output_file): + if read_param or read_old_output: + if self.read_param(read_init_cond = not read_old_output): # We will add the parameter file to the kwarg list. This will keep the set_parameter method from # overriding everything with defaults when there are no arguments passed to Simulation() kwargs['param_file'] = self.param_file @@ -375,7 +369,7 @@ def __init__(self,read_param: bool = False, read_old_output_file: bool = False, self.write_param() # Read in an old simulation file if requested - if read_old_output_file: + if read_old_output: binpath = os.path.join(self.simdir, self.param['BIN_OUT']) if os.path.exists(binpath): self.read_output_file() @@ -762,7 +756,7 @@ def set_parameter(self, verbose: bool = True, **kwargs): "init_cond_file_type": "NETCDF_DOUBLE", "init_cond_file_name": None, "init_cond_format": "EL", - "read_old_output_file": False, + "read_old_output": False, "output_file_type": "NETCDF_DOUBLE", "output_file_name": None, "output_format": "XVEL", @@ -794,8 +788,7 @@ def set_parameter(self, verbose: bool = True, **kwargs): "encounter_check_loops": "TRIANGULAR", "ephemeris_date": "MBCL", "restart": False, - "encounter_save" : "NONE", - "collision_save" : "NONE" + "encounter_save" : "NONE" } param_file = kwargs.pop("param_file",None) @@ -1032,7 +1025,6 @@ def set_feature(self, interaction_loops: Literal["TRIANGULAR", "FLAT", "ADAPTIVE"] | None = None, encounter_check_loops: Literal["TRIANGULAR", "SORTSWEEP", "ADAPTIVE"] | None = None, encounter_save: Literal["NONE", "TRAJECTORY", "CLOSEST"] | None = None, - collision_save: Literal["NONE", "TRAJECTORY", "CLOSEST"] | None = None, verbose: bool | None = None, **kwargs: Any ): @@ -1054,12 +1046,6 @@ def set_feature(self, fragmentation : bool, optional If set to True, this turns on the Fraggle fragment generation code and `rotation` must also be True. This argument only applies to Swiftest-SyMBA simulations. It will be ignored otherwise. - collision_save : {"NONE","TRAJECTORY","CLOSEST"}, default "NONE" - Indicate if and how fragmentation data should be saved. If set to "TRAJECTORY" the full close encounter - trajectories associated with each collision are saved to file. If set to "CLOSEST" only the trajectories - at a the time the collision occurs are saved. If set to "NONE" no trajectory information is saved (collision - details are still logged fraggle.log). - *WARNING*: Enabling this feature could lead to very large files. minimum_fragment_gmass : float, optional If fragmentation is turned on, this sets the mimimum G*mass of a collisional fragment that can be generated. *Note.* Only set one of minimum_fragment_gmass or minimum_fragment_mass @@ -1226,20 +1212,6 @@ def set_feature(self, self.param["ENCOUNTER_SAVE"] = encounter_save update_list.append("encounter_save") - - if collision_save is not None: - collision_save = collision_save.upper() - valid_vals = ["NONE", "TRAJECTORY", "CLOSEST"] - if collision_save not in valid_vals: - msg = f"{collision_save} is not a valid option for collision_save." - msg += f"\nMust be one of {valid_vals}" - warnings.warn(msg,stacklevel=2) - if "COLLISION_SAVE" not in self.param: - self.param["COLLISION_SAVE"] = valid_vals[0] - else: - self.param["COLLISION_SAVE"] = collision_save - update_list.append("collision_save") - self.param["TIDES"] = False feature_dict = self.get_feature(update_list, verbose) @@ -1272,7 +1244,6 @@ def get_feature(self, arg_list: str | List[str] | None = None, verbose: bool | N valid_var = {"close_encounter_check": "CHK_CLOSE", "fragmentation": "FRAGMENTATION", "encounter_save": "ENCOUNTER_SAVE", - "collision_save": "COLLISION_SAVE", "minimum_fragment_gmass": "MIN_GMFRAG", "rotation": "ROTATION", "general_relativity": "GR", @@ -2740,11 +2711,6 @@ def read_output_file(self,read_init_cond : bool = True): else: read_encounters = False - if "COLLISION_SAVE" in self.param: - read_collisions = self.param["COLLISION_SAVE"] != "NONE" - else: - read_collisions = False - param_tmp = self.param.copy() param_tmp['BIN_OUT'] = os.path.join(self.simdir, self.param['BIN_OUT']) if self.codename == "Swiftest": diff --git a/src/io/io.f90 b/src/io/io.f90 index c58eb4dbb..f159e6ac7 100644 --- a/src/io/io.f90 +++ b/src/io/io.f90 @@ -682,7 +682,7 @@ module subroutine io_param_reader(self, unit, iotype, v_list, iostat, iomsg) param%lrestart = .true. end if ! Ignore SyMBA-specific, not-yet-implemented, or obsolete input parameters - case ("NPLMAX", "NTPMAX", "GMTINY", "MIN_GMFRAG", "FRAGMENTATION", "SEED", "YARKOVSKY", "YORP", "ENCOUNTER_SAVE", "COLLISION_SAVE") + case ("NPLMAX", "NTPMAX", "GMTINY", "MIN_GMFRAG", "FRAGMENTATION", "SEED", "YARKOVSKY", "YORP", "ENCOUNTER_SAVE") case default write(*,*) "Ignoring unknown parameter -> ",param_name end select diff --git a/src/modules/symba_classes.f90 b/src/modules/symba_classes.f90 index 47d9c9997..ef3297cde 100644 --- a/src/modules/symba_classes.f90 +++ b/src/modules/symba_classes.f90 @@ -31,8 +31,7 @@ module symba_classes integer(I4B), dimension(:), allocatable :: seed !! Random seeds logical :: lfragmentation = .false. !! Do fragmentation modeling instead of simple merger. character(STRMAX) :: encounter_save = "NONE" !! Indicate if and how encounter data should be saved - character(STRMAX) :: collision_save = "NONE" !! Indicate if and how fragmentation data should be saved - logical :: lencounter_save = .false. !! Turns on encounter saving + logical :: lencounter_save type(encounter_storage(nframes=:)), allocatable :: encounter_history !! Stores encounter history for later retrieval and saving to file type(collision_storage(nframes=:)), allocatable :: collision_history !! Stores encounter history for later retrieval and saving to file contains @@ -175,7 +174,7 @@ module symba_classes !> SyMBA class for tracking pl-pl close encounters in a step type, extends(symba_encounter) :: symba_plplenc contains - procedure :: extract_collisions => symba_collision_encounter_extract_collisions !! Processes the pl-pl encounter list remove only those encounters that led to a collision + procedure :: extract_collisions => symba_collision_extract_collisions_from_encounters !! Processes the pl-pl encounter list remove only those encounters that led to a collision procedure :: resolve_fragmentations => symba_resolve_collision_fragmentations !! Process list of collisions, determine the collisional regime, and then create fragments procedure :: resolve_mergers => symba_resolve_collision_mergers !! Process list of collisions and merge colliding bodies together procedure :: resolve_collision => symba_resolve_collision_plplenc !! Process the pl-pl collision list, then modifiy the massive bodies based on the outcome of the c @@ -207,7 +206,7 @@ module symba_classes interface - module subroutine symba_collision_check_encounter(self, system, param, t, dt, irec, lany_collision, lany_closest) + module subroutine symba_collision_check_encounter(self, system, param, t, dt, irec, lany_collision) use swiftest_classes, only : swiftest_parameters implicit none class(symba_encounter), intent(inout) :: self !! SyMBA pl-tp encounter list object @@ -217,10 +216,9 @@ module subroutine symba_collision_check_encounter(self, system, param, t, dt, ir real(DP), intent(in) :: dt !! step size integer(I4B), intent(in) :: irec !! Current recursion level logical, intent(out) :: lany_collision !! Returns true if any pair of encounters resulted in a collision - logical, intent(out) :: lany_closest !! Returns true if any pair of encounters reached their closest approach without colliding end subroutine symba_collision_check_encounter - module subroutine symba_collision_encounter_extract_collisions(self, system, param) + module subroutine symba_collision_extract_collisions_from_encounters(self, system, param) implicit none class(symba_plplenc), intent(inout) :: self !! SyMBA pl-pl encounter list class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object diff --git a/src/symba/symba_collision.f90 b/src/symba/symba_collision.f90 index 8534237c2..96ab905a0 100644 --- a/src/symba/symba_collision.f90 +++ b/src/symba/symba_collision.f90 @@ -262,7 +262,7 @@ subroutine symba_collision_collider_message(pl, collidx, collider_message) end subroutine symba_collision_collider_message - module subroutine symba_collision_check_encounter(self, system, param, t, dt, irec, lany_collision, lany_closest) + module subroutine symba_collision_check_encounter(self, system, param, t, dt, irec, lany_collision) !! author: David A. Minton !! !! Check for merger between massive bodies and test particles in SyMBA @@ -278,7 +278,7 @@ module subroutine symba_collision_check_encounter(self, system, param, t, dt, ir real(DP), intent(in) :: t !! current time real(DP), intent(in) :: dt !! step size integer(I4B), intent(in) :: irec !! Current recursion level - logical, intent(out) :: lany_collision, lany_closest !! Returns true if cany pair of encounters resulted in a collision + logical, intent(out) :: lany_collision !! Returns true if cany pair of encounters resulted in a collision ! Internals logical, dimension(:), allocatable :: lcollision, lclosest, lmask real(DP), dimension(NDIM) :: xr, vr @@ -289,7 +289,6 @@ module subroutine symba_collision_check_encounter(self, system, param, t, dt, ir class(symba_encounter), allocatable :: tmp lany_collision = .false. - lany_closest = .false. if (self%nenc == 0) return select type(self) @@ -339,7 +338,6 @@ module subroutine symba_collision_check_encounter(self, system, param, t, dt, ir end if lany_collision = any(lcollision(:)) - lany_closest = any(lclosest(:)) if (lany_collision) then call pl%rh2rb(system%cb) ! Update the central body barycenteric position vector to get us out of DH and into bary @@ -391,6 +389,11 @@ module subroutine symba_collision_check_encounter(self, system, param, t, dt, ir end select end if + ! Take snapshots of pairs of bodies at close approach (but not collision) if requested + if (any(lclosest(:))) then + + end if + end select end select @@ -580,7 +583,7 @@ function symba_collision_consolidate_colliders(pl, cb, param, idx_parent, collid end function symba_collision_consolidate_colliders - module subroutine symba_collision_encounter_extract_collisions(self, system, param) + module subroutine symba_collision_extract_collisions_from_encounters(self, system, param) !! author: David A. Minton !! !! Processes the pl-pl encounter list remove only those encounters that led to a collision @@ -646,7 +649,7 @@ module subroutine symba_collision_encounter_extract_collisions(self, system, par end select return - end subroutine symba_collision_encounter_extract_collisions + end subroutine symba_collision_extract_collisions_from_encounters module subroutine symba_collision_make_colliders_pl(self, idx) @@ -984,7 +987,7 @@ module subroutine symba_resolve_collision_plplenc(self, system, param, t, dt, ir integer(I4B), intent(in) :: irec !! Current recursion level ! Internals real(DP) :: Eorbit_before, Eorbit_after - logical :: lplpl_collision, lplpl_closest + logical :: lplpl_collision character(len=STRMAX) :: timestr class(symba_parameters), allocatable :: tmp_param @@ -1037,7 +1040,7 @@ module subroutine symba_resolve_collision_plplenc(self, system, param, t, dt, ir deallocate(tmp_param) ! Check whether or not any of the particles that were just added are themselves in a collision state. This will generate a new plplcollision_list - call plplenc_list%collision_check(system, param, t, dt, irec, lplpl_collision, lplpl_closest) + call plplenc_list%collision_check(system, param, t, dt, irec, lplpl_collision) if (.not.lplpl_collision) exit end do diff --git a/src/symba/symba_io.f90 b/src/symba/symba_io.f90 index 4f19bfd30..27a455062 100644 --- a/src/symba/symba_io.f90 +++ b/src/symba/symba_io.f90 @@ -68,9 +68,6 @@ module subroutine symba_io_param_reader(self, unit, iotype, v_list, iostat, ioms case ("ENCOUNTER_SAVE") call io_toupper(param_value) read(param_value, *) param%encounter_save - case ("COLLISION_SAVE") - call io_toupper(param_value) - read(param_value, *) param%collision_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 @@ -128,14 +125,7 @@ module subroutine symba_io_param_reader(self, unit, iotype, v_list, iostat, ioms return end if - if ((param%collision_save /= "NONE") .and. (param%collision_save /= "TRAJECTORY") .and. (param%collision_save /= "CLOSEST")) then - write(iomsg,*) 'Invalid collision_save parameter: ',trim(adjustl(param%out_type)) - write(iomsg,*) 'Valid options are NONE, TRAJECTORY, or CLOSEST' - iostat = -1 - return - end if - param%lencounter_save = (param%encounter_save == "TRAJECTORY") .or. (param%encounter_save == "CLOSEST") .or. & - (param%collision_save == "TRAJECTORY") .or. (param%collision_save == "CLOSEST") + param%lencounter_save = (param%encounter_save == "TRAJECTORY") .or. (param%encounter_save == "CLOSEST") ! Call the base method (which also prints the contents to screen) call io_param_reader(param, unit, iotype, v_list, iostat, iomsg) diff --git a/src/symba/symba_step.f90 b/src/symba/symba_step.f90 index ba61844e5..eb37c718b 100644 --- a/src/symba/symba_step.f90 +++ b/src/symba/symba_step.f90 @@ -180,7 +180,7 @@ recursive module subroutine symba_step_recur_system(self, param, t, ireci) ! Internals integer(I4B) :: j, irecp, nloops real(DP) :: dtl, dth - logical :: lencounter, lplpl_closest, lpltp_closest + logical :: lencounter select type(param) class is (symba_parameters) @@ -241,8 +241,8 @@ recursive module subroutine symba_step_recur_system(self, param, t, ireci) end if if (param%lclose) then - call plplenc_list%collision_check(system, param, t+dtl, dtl, ireci, lplpl_collision, lplpl_closest) - call pltpenc_list%collision_check(system, param, t+dtl, dtl, ireci, lpltp_collision, lpltp_closest) + call plplenc_list%collision_check(system, param, t+dtl, dtl, ireci, lplpl_collision) + call pltpenc_list%collision_check(system, param, t+dtl, dtl, ireci, lpltp_collision) if (lplpl_collision) call plplenc_list%resolve_collision(system, param, t+dtl, dtl, ireci) if (lpltp_collision) call pltpenc_list%resolve_collision(system, param, t+dtl, dtl, ireci) From 92f1d8e48484309865af93e26ef043d5e1a30f4f Mon Sep 17 00:00:00 2001 From: David A Minton Date: Tue, 13 Dec 2022 08:34:05 -0500 Subject: [PATCH 399/569] Lots of refactoring. Changed bin.nc to data.nc. Changed .ic to .init_cond. Changed the way encounter and collisions are read in (always read the files in if they exist) --- .../Basic_Simulation/initial_conditions.py | 2 +- examples/Basic_Simulation/output_reader.py | 2 +- .../Fragmentation/swiftest_fragmentation.py | 6 +-- examples/helio_gr_test/helio_gr_test.py | 4 +- examples/whm_gr_test/whm_gr_test.py | 4 +- python/swiftest/swiftest/simulation_class.py | 47 +++++++++---------- src/modules/swiftest_globals.f90 | 2 +- 7 files changed, 33 insertions(+), 34 deletions(-) diff --git a/examples/Basic_Simulation/initial_conditions.py b/examples/Basic_Simulation/initial_conditions.py index 861556958..b58522824 100644 --- a/examples/Basic_Simulation/initial_conditions.py +++ b/examples/Basic_Simulation/initial_conditions.py @@ -20,7 +20,7 @@ Output ------ -bin.nc : A NetCDF file containing the simulation output. +data.nc : A NetCDF file containing the simulation output. dump_bin1.nc : A NetCDF file containing the necessary inputs to restart a simulation from t!=0. dump_bin2.nc : A NetCDF file containing the necessary inputs to restart a simulation from t!=0. dump_param1.in : An ASCII file containing the necessary parameters to restart a simulation. diff --git a/examples/Basic_Simulation/output_reader.py b/examples/Basic_Simulation/output_reader.py index fc332af0c..977c2a393 100644 --- a/examples/Basic_Simulation/output_reader.py +++ b/examples/Basic_Simulation/output_reader.py @@ -15,7 +15,7 @@ Input ------ -bin.nc : A NetCDF file containing the simulation output. +data.nc : A NetCDF file containing the simulation output. Output ------ diff --git a/examples/Fragmentation/swiftest_fragmentation.py b/examples/Fragmentation/swiftest_fragmentation.py index 067c53710..3ee13cb2a 100644 --- a/examples/Fragmentation/swiftest_fragmentation.py +++ b/examples/Fragmentation/swiftest_fragmentation.py @@ -21,7 +21,7 @@ Output ------ -disruption/bin.nc : A NetCDF file containing the simulation output. +disruption/data.nc : A NetCDF file containing the simulation output. disruption/dump_bin1.nc : A NetCDF file containing the necessary inputs to restart a simulation from t!=0. disruption/dump_bin2.nc : A NetCDF file containing the necessary inputs to restart a simulation from t!=0. disruption/dump_param1.in : An ASCII file containing the necessary parameters to restart a simulation. @@ -30,7 +30,7 @@ disruption/init_cond.nc : A NetCDF file containing the initial conditions for the simulation. disruption/param.in : An ASCII file containing the parameters for the simulation. disruption/swiftest.log : An ASCII file containing the information on the status of the simulation as it runs. -hitandrun/bin.nc : A NetCDF file containing the simulation output. +hitandrun/data.nc : A NetCDF file containing the simulation output. hitandrun/dump_bin1.nc : A NetCDF file containing the necessary inputs to restart a simulation from t!=0. hitandrun/dump_bin2.nc : A NetCDF file containing the necessary inputs to restart a simulation from t!=0. hitandrun/dump_param1.in : An ASCII file containing the necessary parameters to restart a simulation. @@ -39,7 +39,7 @@ hitandrun/init_cond.nc : A NetCDF file containing the initial conditions for the simulation. hitandrun/param.in : An ASCII file containing the parameters for the simulation. hitandrun/swiftest.log : An ASCII file containing the information on the status of the simulation as it runs. -supercat/bin.nc : A NetCDF file containing the simulation output. +supercat/data.nc : A NetCDF file containing the simulation output. supercat/dump_bin1.nc : A NetCDF file containing the necessary inputs to restart a simulation from t!=0. supercat/dump_bin2.nc : A NetCDF file containing the necessary inputs to restart a simulation from t!=0. supercat/dump_param1.in : An ASCII file containing the necessary parameters to restart a simulation. diff --git a/examples/helio_gr_test/helio_gr_test.py b/examples/helio_gr_test/helio_gr_test.py index c627be7f4..77ae66740 100644 --- a/examples/helio_gr_test/helio_gr_test.py +++ b/examples/helio_gr_test/helio_gr_test.py @@ -24,7 +24,7 @@ helio_gr_mercury_precession.png : Portable Network Graphic file depicting the precession of Mercury's perihelion over time with data sourced from the JPL Horizons database, Swiftest run with general relativity, and Swiftest run without general relativity. -gr/bin.nc : A NetCDF file containing the simulation output. +gr/data.nc : A NetCDF file containing the simulation output. gr/dump_bin1.nc : A NetCDF file containing the necessary inputs to restart a simulation from t!=0. gr/dump_bin2.nc : A NetCDF file containing the necessary inputs to restart a simulation from t!=0. gr/dump_param1.in : An ASCII file containing the necessary parameters to restart a simulation. @@ -32,7 +32,7 @@ gr/init_cond.nc : A NetCDF file containing the initial conditions for the simulation. gr/param.in : An ASCII file containing the parameters for the simulation. gr/swiftest.log : An ASCII file containing the information on the status of the simulation as it runs. -nogr/bin.nc : A NetCDF file containing the simulation output. +nogr/data.nc : A NetCDF file containing the simulation output. nogr/dump_bin1.nc : A NetCDF file containing the necessary inputs to restart a simulation from t!=0. nogr/dump_bin2.nc : A NetCDF file containing the necessary inputs to restart a simulation from t!=0. nogr/dump_param1.in : An ASCII file containing the necessary parameters to restart a simulation. diff --git a/examples/whm_gr_test/whm_gr_test.py b/examples/whm_gr_test/whm_gr_test.py index d0d2ade69..f4dc185ab 100644 --- a/examples/whm_gr_test/whm_gr_test.py +++ b/examples/whm_gr_test/whm_gr_test.py @@ -24,7 +24,7 @@ whm_gr_mercury_precession.png : Portable Network Graphic file depicting the precession of Mercury's perihelion over time with data sourced from the JPL Horizons database, Swiftest run with general relativity, and Swiftest run without general relativity. -gr/bin.nc : A NetCDF file containing the simulation output. +gr/data.nc : A NetCDF file containing the simulation output. gr/dump_bin1.nc : A NetCDF file containing the necessary inputs to restart a simulation from t!=0. gr/dump_bin2.nc : A NetCDF file containing the necessary inputs to restart a simulation from t!=0. gr/dump_param1.in : An ASCII file containing the necessary parameters to restart a simulation. @@ -32,7 +32,7 @@ gr/init_cond.nc : A NetCDF file containing the initial conditions for the simulation. gr/param.in : An ASCII file containing the parameters for the simulation. gr/swiftest.log : An ASCII file containing the information on the status of the simulation as it runs. -nogr/bin.nc : A NetCDF file containing the simulation output. +nogr/data.nc : A NetCDF file containing the simulation output. nogr/dump_bin1.nc : A NetCDF file containing the necessary inputs to restart a simulation from t!=0. nogr/dump_bin2.nc : A NetCDF file containing the necessary inputs to restart a simulation from t!=0. nogr/dump_param1.in : An ASCII file containing the necessary parameters to restart a simulation. diff --git a/python/swiftest/swiftest/simulation_class.py b/python/swiftest/swiftest/simulation_class.py index a239b9293..f5517678f 100644 --- a/python/swiftest/swiftest/simulation_class.py +++ b/python/swiftest/swiftest/simulation_class.py @@ -141,8 +141,7 @@ def __init__(self,read_param: bool = False, read_old_output: bool = False, simdi Parameter input file equivalent: `OUT_TYPE` output_file_name : str or path-like, optional Name of output file to generate. If not supplied, then one of the default file names are used, depending on - the value passed to `output_file_type`. If one of the NetCDF types are used, the default is "bin.nc". - Otherwise, the default is "bin.dat". + the value passed to `output_file_type`. The default is "data.nc". Parameter input file equivalent: `BIN_OUT` output_format : {"XV","XVEL"}, default "XVEL" Specifies the format for the data saved to the output file. If "XV" then cartesian position and velocity @@ -312,7 +311,7 @@ def __init__(self,read_param: bool = False, read_old_output: bool = False, simdi self.param = {} self.data = xr.Dataset() - self.ic = xr.Dataset() + self.init_cond = xr.Dataset() self.encounters = xr.Dataset() self.collisions = xr.Dataset() @@ -1508,7 +1507,7 @@ def set_output_files(self, * Swift: Only "REAL4" supported. output_file_name : str or path-like, optional Name of output file to generate. If not supplied, then one of the default file names are used, depending on - the value passed to `output_file_type`. If one of the NetCDF types are used, the default is "bin.nc". + the value passed to `output_file_type`. If one of the NetCDF types are used, the default is "data.nc". Otherwise, the default is "bin.dat". output_format : {"XV","XVEL"}, optional Specifies the format for the data saved to the output file. If "XV" then cartesian position and velocity @@ -1568,7 +1567,7 @@ def set_output_files(self, self.param['OUT_TYPE'] = output_file_type if output_file_name is None: if output_file_type in ["NETCDF_DOUBLE", "NETCDF_FLOAT"]: - self.param['BIN_OUT'] = "bin.nc" + self.param['BIN_OUT'] = "data.nc" else: self.param['BIN_OUT'] = "bin.dat" else: @@ -2157,7 +2156,7 @@ def add_solar_system_body(self, if dsnew['npl'] > 0 or dsnew['ntp'] > 0: self.save(verbose=False) - self.ic = self.data.copy(deep=True) + self.init_cond = self.data.copy(deep=True) return @@ -2456,7 +2455,7 @@ def input_to_array_3d(val,n=None): dsnew = self._combine_and_fix_dsnew(dsnew) self.save(verbose=False) - self.ic = self.data.copy(deep=True) + self.init_cond = self.data.copy(deep=True) return @@ -2563,7 +2562,7 @@ def read_param(self, 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) + self.init_cond = self.data.copy(deep=True) else: warnings.warn(f"Initial conditions file file {init_cond_file} not found.", stacklevel=2) else: @@ -2706,11 +2705,6 @@ def read_output_file(self,read_init_cond : bool = True): # This is done to handle cases where the method is called from a different working directory than the simulation # results - if "ENCOUNTER_SAVE" in self.param: - read_encounters = self.param["ENCOUNTER_SAVE"] != "NONE" - else: - read_encounters = False - param_tmp = self.param.copy() param_tmp['BIN_OUT'] = os.path.join(self.simdir, self.param['BIN_OUT']) if self.codename == "Swiftest": @@ -2718,17 +2712,15 @@ def read_output_file(self,read_init_cond : bool = True): if self.verbose: print('Swiftest simulation data stored as xarray DataSet .data') if read_init_cond: if self.verbose: - print("Reading initial conditions file as .ic") + print("Reading initial conditions file as .init_cond") if "NETCDF" in self.param['IN_TYPE']: param_tmp['BIN_OUT'] = self.simdir / self.param['NC_IN'] - - self.ic = io.swiftest2xr(param_tmp, verbose=self.verbose) + self.init_cond = io.swiftest2xr(param_tmp, verbose=False) else: - self.ic = self.data.isel(time=0) - if read_encounters: - self.read_encounters() - if read_collisions: - self.read_collisions() + self.init_cond = self.data.isel(time=0) + + self.read_encounters() + self.read_collisions() elif self.codename == "Swifter": self.data = io.swifter2xr(param_tmp, verbose=self.verbose) @@ -2740,9 +2732,13 @@ def read_output_file(self,read_init_cond : bool = True): return def read_encounters(self): + enc_files = glob(f"{self.simdir}{os.path.sep}encounter_*.nc") + if len(enc_files) == 0: + return + if self.verbose: print("Reading encounter history file as .encounters") - enc_files = glob(f"{self.simdir}{os.path.sep}encounter_*.nc") + enc_files.sort() # This is needed in order to pass the param argument down to the io.process_netcdf_input function @@ -2760,10 +2756,13 @@ def _preprocess(ds, param): def read_collisions(self): - if self.verbose: - print("Reading collision history file as .collisions") col_files = glob(f"{self.simdir}{os.path.sep}collision_*.nc") + if len(col_files) == 0: + return + col_files.sort() + if self.verbose: + print("Reading collision history file as .collisions") # This is needed in order to pass the param argument down to the io.process_netcdf_input function def _preprocess(ds, param): diff --git a/src/modules/swiftest_globals.f90 b/src/modules/swiftest_globals.f90 index 25f355152..d9590b59e 100644 --- a/src/modules/swiftest_globals.f90 +++ b/src/modules/swiftest_globals.f90 @@ -122,7 +122,7 @@ module swiftest_globals character(*), parameter :: PL_INFILE = 'pl.in' character(*), parameter :: TP_INFILE = 'tp.in' character(*), parameter :: NC_INFILE = 'in.nc' - character(*), parameter :: BIN_OUTFILE = 'bin.nc' + character(*), parameter :: BIN_OUTFILE = 'data.nc' integer(I4B), parameter :: BINUNIT = 20 !! File unit number for the binary output file integer(I4B), parameter :: PARTICLEUNIT = 44 !! File unit number for the binary particle info output file integer(I4B), parameter :: LUN = 42 !! File unit number for files that are opened and closed within a single subroutine call, and therefore should not collide From c0adfd83dbe7224f4a5ef63ba0df620588dd4b6b Mon Sep 17 00:00:00 2001 From: David A Minton Date: Tue, 13 Dec 2022 09:47:13 -0500 Subject: [PATCH 400/569] Started implementing the CLOSEST vs. TRAJECTORY user options --- src/modules/symba_classes.f90 | 13 +++++++------ src/setup/setup.f90 | 7 ++++--- src/symba/symba_collision.f90 | 4 ++-- src/symba/symba_io.f90 | 3 ++- src/symba/symba_step.f90 | 6 +++--- 5 files changed, 18 insertions(+), 15 deletions(-) diff --git a/src/modules/symba_classes.f90 b/src/modules/symba_classes.f90 index ef3297cde..ce95269e2 100644 --- a/src/modules/symba_classes.f90 +++ b/src/modules/symba_classes.f90 @@ -26,12 +26,13 @@ module symba_classes 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. - character(STRMAX) :: encounter_save = "NONE" !! Indicate if and how encounter data should be saved - logical :: lencounter_save + real(DP) :: GMTINY = -1.0_DP !! Smallest G*mass that is fully gravitating + real(DP) :: min_GMfrag = -1.0_DP !! Smallest G*mass that can be produced in a fragmentation event + integer(I4B), dimension(:), allocatable :: seed !! Random seeds for fragmentation modeling + logical :: lfragmentation = .false. !! Do fragmentation modeling instead of simple merger. + character(STRMAX) :: encounter_save = "NONE" !! Indicate if and how encounter data should be saved + logical :: lenc_trajectory_save = .false. !! Indicates that when encounters are saved, the full trajectory through recursion steps are saved + logical :: lenc_closest_save = .false. !! Indicates that when encounters are saved, the closest approach distance between pairs of bodies is saved type(encounter_storage(nframes=:)), allocatable :: encounter_history !! Stores encounter history for later retrieval and saving to file type(collision_storage(nframes=:)), allocatable :: collision_history !! Stores encounter history for later retrieval and saving to file contains diff --git a/src/setup/setup.f90 b/src/setup/setup.f90 index 36a131611..b840528a0 100644 --- a/src/setup/setup.f90 +++ b/src/setup/setup.f90 @@ -75,7 +75,7 @@ module subroutine setup_construct_system(system, param) select type(param) class is (symba_parameters) - if (param%lencounter_save) then + if (param%lenc_trajectory_save .or. param%lenc_closest_save) then allocate(encounter_storage :: param%encounter_history) associate (encounter_history => param%encounter_history) allocate(encounter_io_parameters :: encounter_history%nc) @@ -85,7 +85,9 @@ module subroutine setup_construct_system(system, param) nc%file_number = param%iloop / param%dump_cadence end select end associate - + end if + + if (param%lclose) then allocate(collision_storage :: param%collision_history) associate (collision_history => param%collision_history) allocate(fraggle_io_parameters :: collision_history%nc) @@ -98,7 +100,6 @@ module subroutine setup_construct_system(system, param) end if end select - end select case (RINGMOONS) write(*,*) 'RINGMOONS-SyMBA integrator not yet enabled' diff --git a/src/symba/symba_collision.f90 b/src/symba/symba_collision.f90 index 96ab905a0..637efa412 100644 --- a/src/symba/symba_collision.f90 +++ b/src/symba/symba_collision.f90 @@ -905,7 +905,7 @@ module subroutine symba_resolve_collision_fragmentations(self, system, param) call system%colliders%regime(system%fragments, system, param) - if (param%lencounter_save) call collision_history%take_snapshot(param,system, t, "before") + if (param%lenc_trajectory_save) call collision_history%take_snapshot(param,system, t, "before") select case (system%fragments%regime) case (COLLRESOLVE_REGIME_DISRUPTION, COLLRESOLVE_REGIME_SUPERCATASTROPHIC) plplcollision_list%status(i) = symba_collision_casedisruption(system, param) @@ -917,7 +917,7 @@ module subroutine symba_resolve_collision_fragmentations(self, system, param) write(*,*) "Error in symba_collision, unrecognized collision regime" call util_exit(FAILURE) end select - if (param%lencounter_save) call collision_history%take_snapshot(param,system, t, "after") + if (param%lenc_trajectory_save) call collision_history%take_snapshot(param,system, t, "after") deallocate(system%colliders,system%fragments) end do end select diff --git a/src/symba/symba_io.f90 b/src/symba/symba_io.f90 index 27a455062..46fa3dfd5 100644 --- a/src/symba/symba_io.f90 +++ b/src/symba/symba_io.f90 @@ -125,7 +125,8 @@ module subroutine symba_io_param_reader(self, unit, iotype, v_list, iostat, ioms return end if - param%lencounter_save = (param%encounter_save == "TRAJECTORY") .or. (param%encounter_save == "CLOSEST") + param%lenc_trajectory_save = (param%encounter_save == "TRAJECTORY") + param%lenc_closest_save = (param%encounter_save == "CLOSEST") .or. param%lenc_trajectory_save ! Closest approaches are always saved when trajectories are saved ! Call the base method (which also prints the contents to screen) call io_param_reader(param, unit, iotype, v_list, iostat, iomsg) diff --git a/src/symba/symba_step.f90 b/src/symba/symba_step.f90 index eb37c718b..68548bdbe 100644 --- a/src/symba/symba_step.f90 +++ b/src/symba/symba_step.f90 @@ -38,9 +38,9 @@ module subroutine symba_step_system(self, param, t, dt) call self%reset(param) lencounter = pl%encounter_check(param, self, dt, 0) .or. tp%encounter_check(param, self, dt, 0) if (lencounter) then - if (param%lencounter_save) call encounter_history%take_snapshot(param, self, t) + if (param%lenc_trajectory_save) call encounter_history%take_snapshot(param, self, t) call self%interp(param, t, dt) - if (param%lencounter_save) call encounter_history%take_snapshot(param, self, t+dt) + if (param%lenc_trajectory_save) call encounter_history%take_snapshot(param, self, t+dt) else self%irec = -1 call helio_step_system(self, param, t, dt) @@ -247,7 +247,7 @@ recursive module subroutine symba_step_recur_system(self, param, t, ireci) if (lplpl_collision) call plplenc_list%resolve_collision(system, param, t+dtl, dtl, ireci) if (lpltp_collision) call pltpenc_list%resolve_collision(system, param, t+dtl, dtl, ireci) end if - if (param%lencounter_save) call encounter_history%take_snapshot(param, self, t+dtl) + if (param%lenc_trajectory_save) call encounter_history%take_snapshot(param, self, t+dtl) call self%set_recur_levels(ireci) From 64909af626beeb85141c87f367ecf95b0ba3b2cf Mon Sep 17 00:00:00 2001 From: David A Minton Date: Tue, 13 Dec 2022 11:12:23 -0500 Subject: [PATCH 401/569] More restructruing anc getting close approach saving infrastructure in place --- python/swiftest/swiftest/io.py | 11 +- src/encounter/encounter_setup.f90 | 14 +- src/encounter/encounter_util.f90 | 219 ++++++++++++++++-------------- src/modules/encounter_classes.f90 | 3 +- src/modules/swiftest_classes.f90 | 2 +- src/modules/symba_classes.f90 | 8 +- src/setup/setup.f90 | 2 +- src/symba/symba_collision.f90 | 180 ++++++++++++------------ src/symba/symba_io.f90 | 4 +- src/symba/symba_step.f90 | 6 +- src/symba/symba_util.f90 | 11 +- 11 files changed, 237 insertions(+), 223 deletions(-) diff --git a/python/swiftest/swiftest/io.py b/python/swiftest/swiftest/io.py index 029672ec7..c002978b9 100644 --- a/python/swiftest/swiftest/io.py +++ b/python/swiftest/swiftest/io.py @@ -900,15 +900,14 @@ def string_converter(da): ------- da : xarray dataset with the strings cleaned up """ - if da.dtype == np.dtype(object): - da = da.astype(' self) call util_spill(keeps%lvdotr, discards%lvdotr, lspill_list, ldestructive) + call util_spill(keeps%lclosest, discards%lclosest, lspill_list, ldestructive) call util_spill(keeps%status, discards%status, lspill_list, ldestructive) call util_spill(keeps%index1, discards%index1, lspill_list, ldestructive) call util_spill(keeps%index2, discards%index2, lspill_list, ldestructive) @@ -398,7 +403,7 @@ end subroutine encounter_util_spill_list - subroutine encounter_util_save_collision(param, snapshot) + subroutine encounter_util_save_collision(collision_history, snapshot) !! author: David A. Minton !! !! Checks the current size of the encounter storage against the required size and extends it by a factor of 2 more than requested if it is too small. @@ -407,18 +412,18 @@ subroutine encounter_util_save_collision(param, snapshot) !! Memory usage grows by a factor of 2 each time it fills up, but no more. implicit none ! Arguments - class(symba_parameters), intent(inout) :: param !! SyMBA parameter object - class(encounter_snapshot), intent(in) :: snapshot !! Encounter snapshot object + type(collision_storage(*)), allocatable, intent(inout) :: collision_history !! Collision history object + class(encounter_snapshot), intent(in) :: snapshot !! Encounter snapshot object ! Internals type(collision_storage(nframes=:)), allocatable :: tmp integer(I4B) :: i, nnew, nold, nbig ! Advance the snapshot frame counter - param%collision_history%iframe = param%collision_history%iframe + 1 + collision_history%iframe = collision_history%iframe + 1 ! Check to make sure the current encounter_history object is big enough. If not, grow it by a factor of 2 - nnew = param%collision_history%iframe - nold = param%collision_history%nframes + nnew = collision_history%iframe + nold = collision_history%nframes if (nnew > nold) then nbig = nold @@ -426,24 +431,24 @@ subroutine encounter_util_save_collision(param, snapshot) nbig = nbig * 2 end do allocate(collision_storage(nbig) :: tmp) - tmp%iframe = param%collision_history%iframe - call move_alloc(param%collision_history%nc, tmp%nc) + tmp%iframe = collision_history%iframe + call move_alloc(collision_history%nc, tmp%nc) do i = 1, nold - if (allocated(param%collision_history%frame(i)%item)) call move_alloc(param%collision_history%frame(i)%item, tmp%frame(i)%item) + if (allocated(collision_history%frame(i)%item)) call move_alloc(collision_history%frame(i)%item, tmp%frame(i)%item) end do - deallocate(param%collision_history) - call move_alloc(tmp,param%collision_history) + deallocate(collision_history) + call move_alloc(tmp,collision_history) nnew = nbig end if - param%collision_history%frame(nnew) = snapshot + collision_history%frame(nnew) = snapshot return end subroutine encounter_util_save_collision - subroutine encounter_util_save_encounter(param, snapshot, t) + subroutine encounter_util_save_encounter(encounter_history, snapshot, t) !! 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. @@ -452,19 +457,19 @@ subroutine encounter_util_save_encounter(param, snapshot, t) !! Memory usage grows by a factor of 2 each time it fills up, but no more. implicit none ! Arguments - class(symba_parameters), intent(inout) :: param !! SyMBA parameter object - class(encounter_snapshot), intent(in) :: snapshot !! Encounter snapshot object - real(DP), intent(in) :: t !! The time of the snapshot + type(encounter_storage(*)), allocatable, intent(inout) :: encounter_history !! SyMBA encounter storage object + class(encounter_snapshot), intent(in) :: snapshot !! Encounter snapshot object + real(DP), intent(in) :: t !! The time of the snapshot ! Internals type(encounter_storage(nframes=:)), allocatable :: tmp integer(I4B) :: i, nnew, nold, nbig ! Advance the snapshot frame counter - param%encounter_history%iframe = param%encounter_history%iframe + 1 + encounter_history%iframe = encounter_history%iframe + 1 ! Check to make sure the current encounter_history object is big enough. If not, grow it by a factor of 2 - nnew = param%encounter_history%iframe - nold = param%encounter_history%nframes + nnew = encounter_history%iframe + nold = encounter_history%nframes if (nnew > nold) then nbig = nold @@ -472,20 +477,20 @@ subroutine encounter_util_save_encounter(param, snapshot, t) nbig = nbig * 2 end do allocate(encounter_storage(nbig) :: tmp) - tmp%iframe = param%encounter_history%iframe - call move_alloc(param%encounter_history%nc, tmp%nc) + tmp%iframe = encounter_history%iframe + call move_alloc(encounter_history%nc, tmp%nc) do i = 1, nold - if (allocated(param%encounter_history%frame(i)%item)) call move_alloc(param%encounter_history%frame(i)%item, tmp%frame(i)%item) + if (allocated(encounter_history%frame(i)%item)) call move_alloc(encounter_history%frame(i)%item, tmp%frame(i)%item) end do - deallocate(param%encounter_history) - call move_alloc(tmp,param%encounter_history) + deallocate(encounter_history) + call move_alloc(tmp,encounter_history) nnew = nbig end if ! Find out which time slot this belongs in by searching for an existing slot ! with the same value of time or the first available one - param%encounter_history%frame(nnew) = snapshot + encounter_history%frame(nnew) = snapshot return end subroutine encounter_util_save_encounter @@ -502,13 +507,11 @@ module subroutine encounter_util_snapshot_collision(self, param, system, t, arg) class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object to store real(DP), intent(in), optional :: t !! Time of snapshot if different from system time - character(*), intent(in), optional :: arg !! Optional argument (needed for extended storage type used in collision snapshots) + character(*), intent(in), optional :: arg !! "before": takes a snapshot just before the collision. "after" takes the snapshot just after the collision. ! Arguments class(fraggle_snapshot), allocatable :: snapshot type(symba_pl) :: pl character(len=:), allocatable :: stage - integer(I4B) :: i,j - if (present(arg)) then stage = arg @@ -539,10 +542,10 @@ module subroutine encounter_util_snapshot_collision(self, param, system, t, arg) allocate(fraggle_snapshot :: snapshot) allocate(snapshot%colliders, source=system%colliders) allocate(snapshot%fragments, source=system%fragments) - select type (param) + select type(param) class is (symba_parameters) - call encounter_util_save_collision(param,snapshot) - end select + call encounter_util_save_collision(param%collision_history,snapshot) + end select case default write(*,*) "encounter_util_snapshot_collision requies either 'before' or 'after' passed to 'arg'" end select @@ -571,87 +574,99 @@ module subroutine encounter_util_snapshot_encounter(self, param, system, t, arg) if (.not.present(t)) then write(*,*) "encounter_util_snapshot_encounter requires `t` to be passed" + return end if + + if (.not.present(arg)) then + write(*,*) "encounter_util_snapshot_encounter requires `arg` to be passed" + return + end if + select type (system) class is (symba_nbody_system) - select type(pl => system%pl) - class is (symba_pl) - select type (tp => system%tp) - class is (symba_tp) - associate(npl => pl%nbody, ntp => tp%nbody) - - allocate(encounter_snapshot :: snapshot) - snapshot%t = t - snapshot%iloop = param%iloop - - if (npl + ntp == 0) return - npl_snap = npl - ntp_snap = ntp - - allocate(snapshot%pl, mold=pl) - allocate(snapshot%tp, mold=tp) - select type(pl_snap => snapshot%pl) - class is (symba_pl) - if (npl > 0) then - pl%lmask(1:npl) = pl%status(1:npl) /= INACTIVE .and. pl%levelg(1:npl) == system%irec - npl_snap = count(pl%lmask(1:npl)) - end if - if (ntp > 0) then - tp%lmask(1:ntp) = tp%status(1:ntp) /= INACTIVE .and. tp%levelg(1:ntp) == system%irec - ntp_snap = count(tp%lmask(1:ntp)) - end if - pl_snap%nbody = npl_snap - end select - - select type(pl_snap => snapshot%pl) - class is (symba_pl) - ! Take snapshot of the currently encountering massive bodies - if (npl_snap > 0) then - call pl_snap%setup(npl_snap, param) - pl_snap%levelg(:) = pack(pl%levelg(1:npl), pl%lmask(1:npl)) - pl_snap%id(:) = pack(pl%id(1:npl), pl%lmask(1:npl)) - pl_snap%info(:) = pack(pl%info(1:npl), pl%lmask(1:npl)) - pl_snap%Gmass(:) = pack(pl%Gmass(1:npl), pl%lmask(1:npl)) - do i = 1, NDIM - pl_snap%rh(i,:) = pack(pl%rh(i,1:npl), pl%lmask(1:npl)) - pl_snap%vh(i,:) = pack(pl%vb(i,1:npl), pl%lmask(1:npl)) - end do - if (param%lclose) then - pl_snap%radius(:) = pack(pl%radius(1:npl), pl%lmask(1:npl)) + select case(arg) + case("trajectory") + select type(pl => system%pl) + class is (symba_pl) + select type (tp => system%tp) + class is (symba_tp) + associate(npl => pl%nbody, ntp => tp%nbody) + allocate(encounter_snapshot :: snapshot) + snapshot%t = t + snapshot%iloop = param%iloop + + if (npl + ntp == 0) return + npl_snap = npl + ntp_snap = ntp + + allocate(snapshot%pl, mold=pl) + allocate(snapshot%tp, mold=tp) + select type(pl_snap => snapshot%pl) + class is (symba_pl) + if (npl > 0) then + pl%lmask(1:npl) = pl%status(1:npl) /= INACTIVE .and. pl%levelg(1:npl) == system%irec + npl_snap = count(pl%lmask(1:npl)) end if - - if (param%lrotation) then + if (ntp > 0) then + tp%lmask(1:ntp) = tp%status(1:ntp) /= INACTIVE .and. tp%levelg(1:ntp) == system%irec + ntp_snap = count(tp%lmask(1:ntp)) + end if + pl_snap%nbody = npl_snap + end select + + select type(pl_snap => snapshot%pl) + class is (symba_pl) + ! Take snapshot of the currently encountering massive bodies + if (npl_snap > 0) then + call pl_snap%setup(npl_snap, param) + pl_snap%levelg(:) = pack(pl%levelg(1:npl), pl%lmask(1:npl)) + pl_snap%id(:) = pack(pl%id(1:npl), pl%lmask(1:npl)) + pl_snap%info(:) = pack(pl%info(1:npl), pl%lmask(1:npl)) + pl_snap%Gmass(:) = pack(pl%Gmass(1:npl), pl%lmask(1:npl)) do i = 1, NDIM - pl_snap%Ip(i,:) = pack(pl%Ip(i,1:npl), pl%lmask(1:npl)) - pl_snap%rot(i,:) = pack(pl%rot(i,1:npl), pl%lmask(1:npl)) + pl_snap%rh(i,:) = pack(pl%rh(i,1:npl), pl%lmask(1:npl)) + pl_snap%vh(i,:) = pack(pl%vb(i,1:npl), pl%lmask(1:npl)) end do + if (param%lclose) then + pl_snap%radius(:) = pack(pl%radius(1:npl), pl%lmask(1:npl)) + end if + + if (param%lrotation) then + do i = 1, NDIM + pl_snap%Ip(i,:) = pack(pl%Ip(i,1:npl), pl%lmask(1:npl)) + pl_snap%rot(i,:) = pack(pl%rot(i,1:npl), pl%lmask(1:npl)) + end do + end if + call pl_snap%sort("id", ascending=.true.) end if - call pl_snap%sort("id", ascending=.true.) - end if - end select - - select type(tp_snap => snapshot%tp) - class is (symba_tp) - ! Take snapshot of the currently encountering test particles - tp_snap%nbody = ntp_snap - if (ntp_snap > 0) then - call tp_snap%setup(ntp_snap, param) - tp_snap%id(:) = pack(tp%id(1:ntp), tp%lmask(1:ntp)) - tp_snap%info(:) = pack(tp%info(1:ntp), tp%lmask(1:ntp)) - do i = 1, NDIM - tp_snap%rh(i,:) = pack(tp%rh(i,1:ntp), tp%lmask(1:ntp)) - tp_snap%vh(i,:) = pack(tp%vh(i,1:ntp), tp%lmask(1:ntp)) - end do - end if + end select + + select type(tp_snap => snapshot%tp) + class is (symba_tp) + ! Take snapshot of the currently encountering test particles + tp_snap%nbody = ntp_snap + if (ntp_snap > 0) then + call tp_snap%setup(ntp_snap, param) + tp_snap%id(:) = pack(tp%id(1:ntp), tp%lmask(1:ntp)) + tp_snap%info(:) = pack(tp%info(1:ntp), tp%lmask(1:ntp)) + do i = 1, NDIM + tp_snap%rh(i,:) = pack(tp%rh(i,1:ntp), tp%lmask(1:ntp)) + tp_snap%vh(i,:) = pack(tp%vh(i,1:ntp), tp%lmask(1:ntp)) + end do + end if + end select + end associate + ! Save the snapshot + select type(param) + class is (symba_parameters) + param%encounter_history%nid = param%encounter_history%nid + ntp_snap + npl_snap + call encounter_util_save_encounter(param%encounter_history,snapshot,t) end select - end associate - ! Save the snapshot - select type(param) - class is (symba_parameters) - param%encounter_history%nid = param%encounter_history%nid + ntp_snap + npl_snap - call encounter_util_save_encounter(param,snapshot,t) end select end select + case("closest") + case default + write(*,*) "encounter_util_snapshot_encounter requires `arg` to be either `trajectory` or `closest`" end select end select diff --git a/src/modules/encounter_classes.f90 b/src/modules/encounter_classes.f90 index 8e74913ed..f566a8070 100644 --- a/src/modules/encounter_classes.f90 +++ b/src/modules/encounter_classes.f90 @@ -22,6 +22,7 @@ module encounter_classes integer(I8B) :: nenc = 0 !! Total number of encounters logical :: lcollision !! Indicates if the encounter resulted in at least one collision real(DP) :: t !! Time of encounter + logical, dimension(:), allocatable :: lclosest !! indicates that thie pair of bodies is in currently at its closest approach point logical, dimension(:), allocatable :: lvdotr !! relative vdotr flag integer(I4B), dimension(:), allocatable :: status !! status of the interaction integer(I4B), dimension(:), allocatable :: index1 !! position of the first body in the encounter @@ -329,7 +330,7 @@ module subroutine encounter_util_snapshot_collision(self, param, system, t, arg) class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object to store real(DP), intent(in), optional :: t !! Time of snapshot if different from system time - character(*), intent(in), optional :: arg !! Optional argument (needed for extended storage type used in collision snapshots) + character(*), intent(in), optional :: arg !! "before": takes a snapshot just before the collision. "after" takes the snapshot just after the collision. end subroutine encounter_util_snapshot_collision module subroutine encounter_util_snapshot_encounter(self, param, system, t, arg) diff --git a/src/modules/swiftest_classes.f90 b/src/modules/swiftest_classes.f90 index d86a742b2..2e32f8c1d 100644 --- a/src/modules/swiftest_classes.f90 +++ b/src/modules/swiftest_classes.f90 @@ -1705,7 +1705,7 @@ module subroutine util_snapshot_system(self, param, system, t, arg) class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object to store real(DP), intent(in), optional :: t !! Time of snapshot if different from system time - character(*), intent(in), optional :: arg !! Optional argument (needed for extended storage type used in collision snapshots) + character(*), intent(in), optional :: arg !! Optional argument (needed for extended storage type used in encounter snapshots) end subroutine util_snapshot_system end interface diff --git a/src/modules/symba_classes.f90 b/src/modules/symba_classes.f90 index ce95269e2..1d5a708b3 100644 --- a/src/modules/symba_classes.f90 +++ b/src/modules/symba_classes.f90 @@ -16,7 +16,7 @@ module symba_classes use swiftest_classes, only : swiftest_parameters, swiftest_base, swiftest_particle_info, swiftest_storage, 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, encounter_snapshot, encounter_storage, collision_storage + use encounter_classes, only : encounter_list, encounter_storage, collision_storage implicit none public @@ -31,8 +31,8 @@ module symba_classes integer(I4B), dimension(:), allocatable :: seed !! Random seeds for fragmentation modeling logical :: lfragmentation = .false. !! Do fragmentation modeling instead of simple merger. character(STRMAX) :: encounter_save = "NONE" !! Indicate if and how encounter data should be saved - logical :: lenc_trajectory_save = .false. !! Indicates that when encounters are saved, the full trajectory through recursion steps are saved - logical :: lenc_closest_save = .false. !! Indicates that when encounters are saved, the closest approach distance between pairs of bodies is saved + logical :: lenc_save_trajectory = .false. !! Indicates that when encounters are saved, the full trajectory through recursion steps are saved + logical :: lenc_save_closest = .false. !! Indicates that when encounters are saved, the closest approach distance between pairs of bodies is saved type(encounter_storage(nframes=:)), allocatable :: encounter_history !! Stores encounter history for later retrieval and saving to file type(collision_storage(nframes=:)), allocatable :: collision_history !! Stores encounter history for later retrieval and saving to file contains @@ -212,7 +212,7 @@ module subroutine symba_collision_check_encounter(self, system, param, t, dt, ir implicit none class(symba_encounter), intent(inout) :: self !! SyMBA pl-tp encounter list object class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object - class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! current time real(DP), intent(in) :: dt !! step size integer(I4B), intent(in) :: irec !! Current recursion level diff --git a/src/setup/setup.f90 b/src/setup/setup.f90 index b840528a0..ef8558aef 100644 --- a/src/setup/setup.f90 +++ b/src/setup/setup.f90 @@ -75,7 +75,7 @@ module subroutine setup_construct_system(system, param) select type(param) class is (symba_parameters) - if (param%lenc_trajectory_save .or. param%lenc_closest_save) then + if (param%lenc_save_trajectory .or. param%lenc_save_closest) then allocate(encounter_storage :: param%encounter_history) associate (encounter_history => param%encounter_history) allocate(encounter_io_parameters :: encounter_history%nc) diff --git a/src/symba/symba_collision.f90 b/src/symba/symba_collision.f90 index 637efa412..9015d3403 100644 --- a/src/symba/symba_collision.f90 +++ b/src/symba/symba_collision.f90 @@ -274,7 +274,7 @@ module subroutine symba_collision_check_encounter(self, system, param, t, dt, ir ! Arguments class(symba_encounter), intent(inout) :: self !! SyMBA pl-tp encounter list object class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object - class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! current time real(DP), intent(in) :: dt !! step size integer(I4B), intent(in) :: irec !! Current recursion level @@ -302,97 +302,99 @@ module subroutine symba_collision_check_encounter(self, system, param, t, dt, ir class is (symba_pl) select type(tp => system%tp) class is (symba_tp) - nenc = self%nenc - allocate(lmask(nenc)) - lmask(:) = ((self%status(1:nenc) == ACTIVE) .and. (pl%levelg(self%index1(1:nenc)) >= irec)) - if (isplpl) then - lmask(:) = lmask(:) .and. (pl%levelg(self%index2(1:nenc)) >= irec) - else - lmask(:) = lmask(:) .and. (tp%levelg(self%index2(1:nenc)) >= irec) - end if - if (.not.any(lmask(:))) return - - allocate(lcollision(nenc)) - lcollision(:) = .false. - allocate(lclosest(nenc)) - lclosest(:) = .false. - - if (isplpl) then - do concurrent(k = 1:nenc, lmask(k)) - i = self%index1(k) - j = self%index2(k) - xr(:) = pl%rh(:, i) - pl%rh(:, j) - vr(:) = pl%vb(:, i) - pl%vb(:, j) - rlim = pl%radius(i) + pl%radius(j) - Gmtot = pl%Gmass(i) + pl%Gmass(j) - call symba_collision_check_one(xr(1), xr(2), xr(3), vr(1), vr(2), vr(3), Gmtot, rlim, dt, self%lvdotr(k), lcollision(k), lclosest(k)) - end do - else - do concurrent(k = 1:nenc, lmask(k)) - i = self%index1(k) - j = self%index2(k) - xr(:) = pl%rh(:, i) - tp%rh(:, j) - vr(:) = pl%vb(:, i) - tp%vb(:, j) - call 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), lcollision(k), lclosest(k)) - end do - end if + select type (param) + class is (symba_parameters) + nenc = self%nenc + allocate(lmask(nenc)) + lmask(:) = ((self%status(1:nenc) == ACTIVE) .and. (pl%levelg(self%index1(1:nenc)) >= irec)) + if (isplpl) then + lmask(:) = lmask(:) .and. (pl%levelg(self%index2(1:nenc)) >= irec) + else + lmask(:) = lmask(:) .and. (tp%levelg(self%index2(1:nenc)) >= irec) + end if + if (.not.any(lmask(:))) return + + allocate(lcollision(nenc)) + lcollision(:) = .false. + allocate(lclosest(nenc)) + lclosest(:) = .false. + + if (isplpl) then + do concurrent(k = 1:nenc, lmask(k)) + i = self%index1(k) + j = self%index2(k) + xr(:) = pl%rh(:, i) - pl%rh(:, j) + vr(:) = pl%vb(:, i) - pl%vb(:, j) + rlim = pl%radius(i) + pl%radius(j) + Gmtot = pl%Gmass(i) + pl%Gmass(j) + call symba_collision_check_one(xr(1), xr(2), xr(3), vr(1), vr(2), vr(3), Gmtot, rlim, dt, self%lvdotr(k), lcollision(k), lclosest(k)) + end do + else + do concurrent(k = 1:nenc, lmask(k)) + i = self%index1(k) + j = self%index2(k) + xr(:) = pl%rh(:, i) - tp%rh(:, j) + vr(:) = pl%vb(:, i) - tp%vb(:, j) + call 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), lcollision(k), lclosest(k)) + end do + end if - lany_collision = any(lcollision(:)) - - if (lany_collision) then - call pl%rh2rb(system%cb) ! Update the central body barycenteric position vector to get us out of DH and into bary - do k = 1, nenc - i = self%index1(k) - j = self%index2(k) - if (lcollision(k)) self%status(k) = COLLISION - self%tcollision(k) = t - self%x1(:,k) = pl%rh(:,i) + system%cb%rb(:) - self%v1(:,k) = pl%vb(:,i) - if (isplpl) then - self%x2(:,k) = pl%rh(:,j) + system%cb%rb(:) - self%v2(:,k) = pl%vb(:,j) - if (lcollision(k)) then - ! Check to see if either of these bodies has been involved with a collision before, and if so, make this a collisional colliders%idx - if (pl%lcollision(i) .or. pl%lcollision(j)) call pl%make_colliders([i,j]) - - ! Set the collision flag for these to bodies to true in case they become involved in another collision later in the step - pl%lcollision([i, j]) = .true. - pl%status([i, j]) = COLLISION - call pl%info(i)%set_value(status="COLLISION", discard_time=t, discard_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%rh(:,j) + system%cb%rb(:) - self%v2(:,k) = tp%vb(:,j) - if (lcollision(k)) then - tp%status(j) = DISCARDED_PLR - tp%ldiscard(j) = .true. - write(idstri, *) pl%id(i) - write(idstrj, *) tp%id(j) - write(timestr, *) t - call tp%info(j)%set_value(status="DISCARDED_PLR", discard_time=t, discard_rh=tp%rh(:,j), discard_vh=tp%vh(:,j)) - write(message, *) "Particle " // trim(adjustl(tp%info(j)%name)) // " (" // trim(adjustl(idstrj)) // ")" & - // " collided with massive body " // trim(adjustl(pl%info(i)%name)) // " (" // trim(adjustl(idstri)) // ")" & - // " at t = " // trim(adjustl(timestr)) - call io_log_one_message(FRAGGLE_LOG_OUT, message) + lany_collision = any(lcollision(:)) + + if (lany_collision) then + call pl%rh2rb(system%cb) ! Update the central body barycenteric position vector to get us out of DH and into bary + do k = 1, nenc + i = self%index1(k) + j = self%index2(k) + if (lcollision(k)) self%status(k) = COLLISION + self%tcollision(k) = t + self%x1(:,k) = pl%rh(:,i) + system%cb%rb(:) + self%v1(:,k) = pl%vb(:,i) + if (isplpl) then + self%x2(:,k) = pl%rh(:,j) + system%cb%rb(:) + self%v2(:,k) = pl%vb(:,j) + if (lcollision(k)) then + ! Check to see if either of these bodies has been involved with a collision before, and if so, make this a collider pair + if (pl%lcollision(i) .or. pl%lcollision(j)) call pl%make_colliders([i,j]) + + ! Set the collision flag for these to bodies to true in case they become involved in another collision later in the step + pl%lcollision([i, j]) = .true. + pl%status([i, j]) = COLLISION + call pl%info(i)%set_value(status="COLLISION", discard_time=t, discard_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%rh(:,j) + system%cb%rb(:) + self%v2(:,k) = tp%vb(:,j) + if (lcollision(k)) then + tp%status(j) = DISCARDED_PLR + tp%ldiscard(j) = .true. + write(idstri, *) pl%id(i) + write(idstrj, *) tp%id(j) + write(timestr, *) t + call tp%info(j)%set_value(status="DISCARDED_PLR", discard_time=t, discard_rh=tp%rh(:,j), discard_vh=tp%vh(:,j)) + write(message, *) "Particle " // trim(adjustl(tp%info(j)%name)) // " (" // trim(adjustl(idstrj)) // ")" & + // " collided with massive body " // trim(adjustl(pl%info(i)%name)) // " (" // trim(adjustl(idstri)) // ")" & + // " at t = " // trim(adjustl(timestr)) + call io_log_one_message(FRAGGLE_LOG_OUT, message) + end if end if - end if - end do + end do - ! Extract the pl-pl or pl-tp encounter list and return the pl-pl or pl-tp collision_list - select type(self) - class is (symba_plplenc) - call self%extract_collisions(system, param) - class is (symba_pltpenc) - allocate(tmp, mold=self) - call self%spill(tmp, lcollision, ldestructive=.true.) ! Remove this encounter pair from the encounter list - end select - end if + ! Extract the pl-pl or pl-tp encounter list and return the pl-pl or pl-tp collision_list + select type(self) + class is (symba_plplenc) + call self%extract_collisions(system, param) + class is (symba_pltpenc) + allocate(tmp, mold=self) + call self%spill(tmp, lcollision, ldestructive=.true.) ! Remove this encounter pair from the encounter list + end select + end if - ! Take snapshots of pairs of bodies at close approach (but not collision) if requested - if (any(lclosest(:))) then + ! Take snapshots of pairs of bodies at close approach (but not collision) if requested + if (param%lenc_save_closest .and. any(lclosest(:))) call param%encounter_history%take_snapshot(param, system, t, "closest") - end if + end select end select end select @@ -905,7 +907,7 @@ module subroutine symba_resolve_collision_fragmentations(self, system, param) call system%colliders%regime(system%fragments, system, param) - if (param%lenc_trajectory_save) call collision_history%take_snapshot(param,system, t, "before") + if (param%lenc_save_trajectory) call collision_history%take_snapshot(param,system, t, "before") select case (system%fragments%regime) case (COLLRESOLVE_REGIME_DISRUPTION, COLLRESOLVE_REGIME_SUPERCATASTROPHIC) plplcollision_list%status(i) = symba_collision_casedisruption(system, param) @@ -917,7 +919,7 @@ module subroutine symba_resolve_collision_fragmentations(self, system, param) write(*,*) "Error in symba_collision, unrecognized collision regime" call util_exit(FAILURE) end select - if (param%lenc_trajectory_save) call collision_history%take_snapshot(param,system, t, "after") + if (param%lenc_save_trajectory) call collision_history%take_snapshot(param,system, t, "after") deallocate(system%colliders,system%fragments) end do end select diff --git a/src/symba/symba_io.f90 b/src/symba/symba_io.f90 index 46fa3dfd5..916fb1a4c 100644 --- a/src/symba/symba_io.f90 +++ b/src/symba/symba_io.f90 @@ -125,8 +125,8 @@ module subroutine symba_io_param_reader(self, unit, iotype, v_list, iostat, ioms return end if - param%lenc_trajectory_save = (param%encounter_save == "TRAJECTORY") - param%lenc_closest_save = (param%encounter_save == "CLOSEST") .or. param%lenc_trajectory_save ! Closest approaches are always saved when trajectories are saved + param%lenc_save_trajectory = (param%encounter_save == "TRAJECTORY") + param%lenc_save_closest = (param%encounter_save == "CLOSEST") .or. param%lenc_save_trajectory ! Closest approaches are always saved when trajectories are saved ! Call the base method (which also prints the contents to screen) call io_param_reader(param, unit, iotype, v_list, iostat, iomsg) diff --git a/src/symba/symba_step.f90 b/src/symba/symba_step.f90 index 68548bdbe..3b217305f 100644 --- a/src/symba/symba_step.f90 +++ b/src/symba/symba_step.f90 @@ -38,9 +38,9 @@ module subroutine symba_step_system(self, param, t, dt) call self%reset(param) lencounter = pl%encounter_check(param, self, dt, 0) .or. tp%encounter_check(param, self, dt, 0) if (lencounter) then - if (param%lenc_trajectory_save) call encounter_history%take_snapshot(param, self, t) + if (param%lenc_save_trajectory) call encounter_history%take_snapshot(param, self, t, "trajectory") call self%interp(param, t, dt) - if (param%lenc_trajectory_save) call encounter_history%take_snapshot(param, self, t+dt) + if (param%lenc_save_trajectory) call encounter_history%take_snapshot(param, self, t+dt, "trajectory") else self%irec = -1 call helio_step_system(self, param, t, dt) @@ -247,7 +247,7 @@ recursive module subroutine symba_step_recur_system(self, param, t, ireci) if (lplpl_collision) call plplenc_list%resolve_collision(system, param, t+dtl, dtl, ireci) if (lpltp_collision) call pltpenc_list%resolve_collision(system, param, t+dtl, dtl, ireci) end if - if (param%lenc_trajectory_save) call encounter_history%take_snapshot(param, self, t+dtl) + if (param%lenc_save_trajectory) call encounter_history%take_snapshot(param, self, t+dtl, "trajectory") call self%set_recur_levels(ireci) diff --git a/src/symba/symba_util.f90 b/src/symba/symba_util.f90 index 8874be49b..74b555bce 100644 --- a/src/symba/symba_util.f90 +++ b/src/symba/symba_util.f90 @@ -204,6 +204,8 @@ module subroutine symba_util_dealloc_encounter_list(self) if (allocated(self%level)) deallocate(self%level) if (allocated(self%tcollision)) deallocate(self%tcollision) + call self%encounter_list%dealloc() + return end subroutine symba_util_dealloc_encounter_list @@ -232,7 +234,7 @@ module subroutine symba_util_dealloc_merger(self) if (allocated(self%ncomp)) deallocate(self%ncomp) - call symba_util_dealloc_pl(self) + call self%symba_pl%dealloc() return end subroutine symba_util_dealloc_merger @@ -266,7 +268,7 @@ module subroutine symba_util_dealloc_pl(self) deallocate(self%kin) end if - call util_dealloc_pl(self) + call self%helio_pl%dealloc() return end subroutine symba_util_dealloc_pl @@ -284,7 +286,7 @@ module subroutine symba_util_dealloc_tp(self) if (allocated(self%levelg)) deallocate(self%levelg) if (allocated(self%levelm)) deallocate(self%levelm) - call util_dealloc_tp(self) + call self%helio_tp%dealloc() return end subroutine symba_util_dealloc_tp @@ -712,6 +714,7 @@ module subroutine symba_util_rearray_pl(self, system, param) if ((idnew1 == idold1) .and. (idnew2 == idold2)) then ! This is an encounter we already know about, so save the old information system%plplenc_list%lvdotr(k) = plplenc_old%lvdotr(k) + system%plplenc_list%lclosest(k) = plplenc_old%lclosest(k) system%plplenc_list%status(k) = plplenc_old%status(k) system%plplenc_list%x1(:,k) = plplenc_old%x1(:,k) system%plplenc_list%x2(:,k) = plplenc_old%x2(:,k) @@ -722,6 +725,7 @@ module subroutine symba_util_rearray_pl(self, system, param) 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%lclosest(k) = plplenc_old%lclosest(k) system%plplenc_list%status(k) = plplenc_old%status(k) system%plplenc_list%x1(:,k) = plplenc_old%x2(:,k) system%plplenc_list%x2(:,k) = plplenc_old%x1(:,k) @@ -749,6 +753,7 @@ module subroutine symba_util_rearray_pl(self, system, param) system%plplenc_list%id1(1:nencmin) = pack(system%plplenc_list%id1(1:nenc_old), lmask(1:nenc_old)) system%plplenc_list%id2(1:nencmin) = pack(system%plplenc_list%id2(1:nenc_old), lmask(1:nenc_old)) system%plplenc_list%lvdotr(1:nencmin) = pack(system%plplenc_list%lvdotr(1:nenc_old), lmask(1:nenc_old)) + system%plplenc_list%lclosest(1:nencmin) = pack(system%plplenc_list%lclosest(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%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)) From 75c3a6a2fbb20519b619a135fe1a7a6287689dfb Mon Sep 17 00:00:00 2001 From: Carlisle Wishard Date: Tue, 13 Dec 2022 12:13:21 -0500 Subject: [PATCH 402/569] added an outline of how to create and run a simulation with Python --- README.md | 14 ++++++++++++++ 1 file changed, 14 insertions(+) diff --git a/README.md b/README.md index 8309f911c..0ef0ad79f 100644 --- a/README.md +++ b/README.md @@ -133,6 +133,20 @@ $ ipython kernel install --user --name EnvName --display-name "Swiftest Kernel" Swiftest is built to make running a Swiftest simulation a streamlined and user friendly experience, even for a new user. As a result, Swiftest is highly flexible and a simulation can be created, run, and processed in a number of different ways. The first choice the user must make is if they would prefer ASCII input files or NetCDF input files. We recommend NetCDF input files, however we include documentation for ASCII input files for completeness. +**Brief Outline** +To create and run a Swiftest simulation using the Swiftest Python package, follow the general script below. For more details on the input files and user options, continue reading this section. + +``` +import swiftest # Import the Swiftest Python package +sim = swiftest.Simulation(**kwargs) # Initialize a Swiftest simulation +sim.add_solar_system_body(**kwargs) # Add any desired named Solar System bodies +sim.add_body(**kwargs) # Add any desired user defined bodies +sim.get_parameter(**kwargs) # View the default simulation parameters +sim.set_parameter(**kwargs) # Set any desired simulation parameters +sim.write_param(**kwargs) # Write simulation parameters to the param.in +sim.run(**kwargs) # Run the simulation (ignore if running from the terminal) +``` + **NetCDF Input Files (Recommended)** Swiftest accepts a single NetCDF input file. This file can be created using the Swiftest Python Package through a few simple steps. From 67548b646fc881d27ae8baf2d819f666e507e42b Mon Sep 17 00:00:00 2001 From: Carlisle Wishard Date: Tue, 13 Dec 2022 12:14:29 -0500 Subject: [PATCH 403/569] updated the restarting section --- README.md | 39 +++++++++++++++++++-------------------- 1 file changed, 19 insertions(+), 20 deletions(-) diff --git a/README.md b/README.md index 0ef0ad79f..cace0244c 100644 --- a/README.md +++ b/README.md @@ -424,40 +424,39 @@ Integration steps: Total wall time: 2.99848E+02; Interval wall time: 9.36192E+ The first line includes the simulation time, the fraction of the simulation that is complete relative to ```tstop```, the number of fully-interactive massive bodies (```plm```) (SyMBA only), the total number of massive bodies (```pl```) including fully-interactive and semi-interactive bodies, and the number of test particles (```tp```) remaining in the system at that time. The second line includes the angular momentum error, the change in energy as a result of collisions only, the total change in energy, and the change in mass up to this point in the simulation (error analysis included only if ```ENERGY```/```compute_conservation_values``` is set to ```YES```/```True```). The third line contains the total wall time elapsed since the start of the simulation, the wall time elapsed since the start of the last step, and the average wall time per step since the start of the simulation. -**NOTHING IS CHECKED BELOW HERE** - **Restarting a Simulation From t $\neq$ 0** -Just like Swiftest allows the user to run a simulation through the terminal or through Python, Swiftest also allows the user to restart a simulation in the same two manners. - -In case of accidental termination of a simulation, such as through a power outage or computer failure, Swiftest generates a series of dump files. Every ```ISTEP_DUMP``` timesteps, Swiftest dumps all simulation information to the dump files. Every ```ISTEP_DUMP``` timestep, Swiftest alternates which set of dump files to dump to (either set "1" or set "2"). This way, even if Swiftest is terminated during the writing stage, at least one set of dump files is preserved and the information is not lost. When Swiftest is restarted from a dump file, it automatically determines which set of dump files has proceeded further in simulation time, and picks up from that point. +Just like Swiftest allows the user to run a simulation through the terminal or through Python, Swiftest also allows the user to restart a simulation from t $\neq$ 0 in the same two manners. This can be useful in the case of an accidental termination of a simulation, such as through a power outage or computer failure. In many cases, it is also necessary to run a simulation to a new end point, past the original ```TSTOP```. -The Dump Files: -- **dump_param1.in** - The file storing all simulation parameters for set 1 of the dump files, ASCII file format only -- **dump_param2.in** - The file storing all simulation parameters for set 2 of the dump files, ASCII file format only -- **dump_bin1.nc** or **dump_bin1.dat** - The file storing all simulation information for set 1 of the dump files, NetCDF file format -- **dump_bin2.nc** or **dump_bin2.dat** - The file storing all simulation information for set 2 of the dump files, NetCDF file format +**Restarting via Python** -To run Swiftest from a dump file, simply type the following command into the terminal: +To restart a Swiftest simulation via the Swiftest Python package, follow the outline below: ``` -$ ./swiftest_driver INTEGRATOR DUMP_PARAM +import swiftest +sim = swiftest.Simulation(read_param=True, param_file='path/to/param.in') +sim.set_parameter(tstop=VAL) # Set a new stop time +sim.write_param() # Write simulation parameters to the param.in +sim.run() ``` -Where ```INTEGRATOR``` is your integrator of choice, either ```whm```, ```rmvs```, ```helio```, or ```symba```, and ```DUMP_PARAM``` is either **dump_param1.in** or **dump_param2.in**. The option of specifying **dump_param1.in** or **dump_param2.in** is included for backwards compatibility. Swiftest will still automatically check which dump file has progressed further and select that dump file, regardless of your choice of dump parameter file. If you would like to force Swiftest to select one dump parameter file over the other, simply delete the set of dump files that you do not want. +Note that Swiftest will look in the ```/simdata``` subdirectory for the initial conditions by default. You may set a new path to the initial conditions using the ```param_file``` keyword argument. -While the dump files allow the user to restart only from the last recorded step, Swiftest also allows the user to restart a run from an earlier point. This can be useful if the user wishes to clone the number of test particles in a simulation at a certain time or isolate a particular event. To generate a new set of initial conditions from a set time in a preexisting run, use the Swiftest Python package to read in the **out.nc** output file (see the **Swiftest Python Package** section for more details). Next, use the ```initial_conditions_from_bin``` method, part of the ```swiftest.Simulation``` class. This method takes the frame number from which to generate a set of initial conditions as the sole argument. An example of this process is shown below: +**Restarting via a Terminal** -``` -import swiftest # Import the Swiftest Python package. -sim = swiftest.Simulation(param_file="param.in") # Read in the output of a past simulation and store it in the sim object. -sim.initial_conditions_from_bin(framenum=3) # Generate a new set of initial conditions from frame 3 of the past simulation stored in sim. -``` +Every ```DUMP_CADENCE``` X ```ISTEP_OUT``` timesteps, Swiftest writes all simulation information from memory to the output files. At the same time, Swiftest also writes all simulation information to one of two sets of dump files, alternating between sets at each subsequent dump. This way, even if Swiftest is terminated during the writing stage, at least one set of dump files is preserved and the information is not lost. When Swiftest is restarted from a dump file, it automatically determines which set of dump files has proceeded further in simulation time, and picks up from that point. -To calculate the frame number that correlates to a particular time in a simulation, the simulation's output cadence (```ISTEP_OUT```) and timestep (```DT```) must be considered. New initial conditions can only be generated from old output frames, so if the desired time falls between output steps, it is necessary to generate initial conditions from the previous output step. For example, a simulation that ran from 0 to 100 years, where ```DT``` = 1 year and ```ISTEP_OUT``` = 10, will output every 10 timesteps, or every 10 years. If the user wishes to generate new initial conditions at 34 years, it is necessary to select frame number 3, which correlates to 30 years. The new simulation can then be run with shorter a output cadence and/or timestep if desired. +The Dump Files: +- **dump_param1.in** - The file storing all simulation parameters for set 1 of the dump files, ASCII file format only +- **dump_param2.in** - The file storing all simulation parameters for set 2 of the dump files, ASCII file format only +- **dump_bin1.nc** or **dump_bin1.dat** - The file storing all simulation information for set 1 of the dump files, NetCDF file format +- **dump_bin2.nc** or **dump_bin2.dat** - The file storing all simulation information for set 2 of the dump files, NetCDF file format + +To restart Swiftest from a dump file, simply follow the instructions detailed in the **Running via a Terminal** section, replacing ```PARAM``` with either **dump_param1.in** or **dump_param2.in**. The option of specifying **dump_param1.in** or **dump_param2.in** is included for backwards compatibility. Swiftest will still automatically check which dump file has progressed further and select that dump file, regardless of your choice of dump parameter file. If you would like to force Swiftest to select one dump parameter file over the other, simply delete the set of dump files that you do not want. --- +**NOTHING IS CHECKED BELOW HERE** #### Updates to Swifter Included in Swiftest **Fraggle** From 43af549fa49c7941af77def22c4f21dbe9d73d79 Mon Sep 17 00:00:00 2001 From: Carlisle Wishard Date: Tue, 13 Dec 2022 12:35:20 -0500 Subject: [PATCH 404/569] rearranged and simplified the output section --- README.md | 112 +++++++----------------------------------------------- 1 file changed, 14 insertions(+), 98 deletions(-) diff --git a/README.md b/README.md index cace0244c..caadef2d3 100644 --- a/README.md +++ b/README.md @@ -414,6 +414,15 @@ Swiftest generates between 1 and 6 output files, depending on the input paramete - **interaction_timer.log** - The log containing the interaction loop timer for each interacting pair of bodies, only if ```INTERACTION_LOOPS``` is ```ADAPTIVE```, ASCII file format only - **swiftest.log** - A log containing the input parameters and a brief updated on the status of the run. Only generated if Swiftest is run through the Python package. If Swiftest is run through the terminal, these updates are output directly to the terminal. +To read in a Swiftest output file, simply create a new Python script in the simulation directory. + +``` +import swiftest +sim = swiftest.Simulation(param_file="PATH/TO/param.in") +``` + +All Swiftest data is now stored in the Xarray dataset ```sim.data``` and is easily processed, manipulated, and analyzed. + Regardless of whether the status outputs are recorded in the **swiftest.log** or in the terminal, the output format is the same. Below is an example of a single status output: `````` @@ -456,14 +465,13 @@ To restart Swiftest from a dump file, simply follow the instructions detailed in --- -**NOTHING IS CHECKED BELOW HERE** #### Updates to Swifter Included in Swiftest **Fraggle** -To activate the Fraggle algorithm, set ```FRAGMENTATION``` in the **param.in** to ```YES```. When resolving a close encounter that results in a collision, Fraggle determines the regime of the collision as well as the mass, number, position, velocity, and rotation of all resulting bodies. This is distinct from Swiftest SyMBA's predecessor, Swifter SyMBA, which assumes that all collisions result in perfect mergers. +To activate the Fraggle algorithm, set ```FRAGMENTATION```/```fragmentation``` to ```YES```/```True```, depending on the mode in which Swiftest is being run. When resolving a close encounter that results in a collision, Fraggle determines the regime of the collision as well as the mass, number, position, velocity, and rotation of all resulting bodies. This is distinct from Swiftest SyMBA's predecessor, Swifter SyMBA, which assumes that all collisions result in perfect mergers. -Fraggle distinguishes the following collisional regimes: (1) perfect merging, which includes the cratering, partial accretion, and graze-and-merge regimes of Leinhardt & Stewart 2012, (2) disruption, which includes the partial erosion regime of Leinhardt & Stewart 2012, (3) super-catastrophic disruption, and (4) hit-and-run events which can be either ‘pure’ or ‘disruptive’. For more details on the collisional regimes used in Fraggle, please see Wishard et al. 2023 (in preparation). +Fraggle distinguishes the following collisional regimes: (1) perfect merging, which includes the cratering, partial accretion, and graze-and-merge regimes of Leinhardt & Stewart 2012, (2) disruption, which includes the partial erosion regime of Leinhardt & Stewart 2012, (3) super-catastrophic disruption, and (4) hit-and-run events which can be either ‘pure’ or ‘disruptive’. For every collision throughout the course of a simulation, Fraggle writes all details of the collision to the **fraggle.log** output file. An example of a collision, stored in the **fraggle.log** output file, is as follows: @@ -651,101 +659,7 @@ Together, adaptive interaction calculations and encounter checking are idea for The NetCDF (Network Common Data Form) file format is a cross-platform method of creating, accessing, and sharing data. Due to its self-describing nature, NetCDF is ideal for archiving multidimensional scientific data. NetCDF files are also appendable, allowing for data to be added to a file after creation, making the NetCDF file format well suited for handling simulation output. NetCDF is maintained by the University Corporation for Atmospheric Research (UCAR) and is a standard file format across much of the atmospheric modeling community. In Swifter SyMBA, simulation outputs were stored in a flat binary file. These binary files could only be easily accessed through [SwiftVis](https://cs.trinity.edu/~mlewis/SwiftVis/), a data analysis and visualization software package designed to process Swifter data. In accordance with modern data management practices and industry standards, Swiftest incorporates a NetCDF output file format for all simulation types. NetCDF is compatible with many of today's most widely-used programming languages including Fortran, Python, Java, C++, and more. By writing simulation data to a NetCDF output file, Swiftest provides the user with the flexibility to analyze and visualize data in any language they choose. The NetCDF file format is also adaptable such that any future additions to Swiftest can be seamlessly incorporated into the output file. - - - - - - - - - - - - - - - - - - - - - -To read in a Swiftest output file, create a new Python script in the simulation directory. We recommend using [Xarray](https://docs.xarray.dev/en/stable/index.html) to manage and process output files. - -``` -import swiftest # Importing Swiftest -import xarray as xr # Importing Xarray -ds = swiftest.Simulation(param_file="PATH/TO/param.in").ds # Storing all simulation data to an Xarray dataset. -``` - -All Swiftest data is now stored in the Xarray dataset ```ds``` and is easily processed, manipulated, and analyzed. The NetCDF output file stores data in two dimensions: simulation time (```time```) and particle ID (```id```). The NetCDF output file contains a maximum of 60 data variables. Below is a list of all data variables and their associated dimension. - -| Data Variable Name | Data Variable Description | Data Variable Dimension | -|------------------------|------------------------------------------------------------------------------------------------------------------------------------------------------------|-------------------------| -| ```npl``` | Number of massive bodies | time | -| ```ntp``` | Number of test particles | time | -| ```nplm``` | Number of massive bodies above the ```GMTINY``` cutoff value | time | -| ```name``` | Name of particle | id | -| ```particle_type``` | Particle type (Central Body, Massive Body, or Test Particle) | id | -| ```status``` | Particle status (Active, collisional regime, discard fate etc.) | id | -| ```xhx``` | Heliocentric x-coordinate of position in distance units, only if ```OUT_FORM``` in the **param.in** is set to ```XV``` or ```XVEL``` | time, id | -| ```xhy``` | Heliocentric y-coordinate of position in distance units, only if ```OUT_FORM``` in the **param.in** is set to ```XV``` or ```XVEL``` | time, id | -| ```xhz``` | Heliocentric z-coordinate of position in distance units, only if ```OUT_FORM``` in the **param.in** is set to ```XV``` or ```XVEL``` | time, id | -| ```vhx``` | Heliocentric x-coordinate of velocity in distance and time units, only if ```OUT_FORM``` in the **param.in** is set to ```XV``` or ```XVEL``` | time, id | -| ```vhy``` | Heliocentric y-coordinate of velocity in distance and time units, only if ```OUT_FORM``` in the **param.in** is set to ```XV``` or ```XVEL``` | time, id | -| ```vhz``` | Heliocentric z-coordinate of velocity in distance and time units, only if ```OUT_FORM``` in the **param.in** is set to ```XV``` or ```XVEL``` | time, id | -| ```a``` | Semi-major axis in distance units, only if ```OUT_FORM``` in the **param.in** is set to ```EL``` or ```XVEL``` | time, id | -| ```e``` | Eccentricity, only if ```OUT_FORM``` in the **param.in** is set to ```EL``` or ```XVEL``` | time, id | -| ```inc``` | Inclination in degrees, only if ```OUT_FORM``` in the **param.in** is set to ```EL``` or ```XVEL``` | time, id | -| ```capom``` | Longitude of ascending node, only if ```OUT_FORM``` in the **param.in** is set to ```EL``` or ```XVEL``` | time, id | -| ```omega``` | Argument of pericenter, only if ```OUT_FORM``` in the **param.in** is set to ```EL``` or ```XVEL``` | time, id | -| ```capm``` | Mean anomaly, only if ```OUT_FORM``` in the **param.in** is set to ```EL``` or ```XVEL``` | time, id | -| ```Gmass``` | G * mass in mass units | time, id | -| ```rhill``` | Hill Radius in distance units | time, id | -| ```radius``` | Radius in distance units | time, id | -| ```origin_time``` | Time of particle creation in simulation time in time units | id | -| ```origin_type``` | Type of creation (Initial conditions, Hit and run fragment etc.) | id | -| ```origin_xhx``` | Heliocentric x-coordinate of origin position in distance units | id | -| ```origin_xhy``` | Heliocentric y-coordinate of origin position in distance units | id | -| ```origin_xhz``` | Heliocentric z-coordinate of origin position in distance units | id | -| ```origin_vhx``` | Heliocentric x-coordinate of origin velocity in distance units | id | -| ```origin_vhy``` | Heliocentric y-coordinate of origin velocity in distance units | id | -| ```origin_vhz``` | Heliocentric z-coordinate of origin velocity in distance units | id | -| ```collision_id``` | Collision number in which particle was formed | id | -| ```discard_time``` | Time of particle discard in simulation time in time units | id | -| ```discard_xhx``` | Heliocentric x-coordinate of discard position in distance units | id | -| ```discard_xhy``` | Heliocentric y-coordinate of discard position in distance units | id | -| ```discard_xhz``` | Heliocentric z-coordinate of discard position in distance units | id | -| ```discard_vhx``` | Heliocentric x-coordinate of discard velocity in distance units | id | -| ```discard_vhy``` | Heliocentric y-coordinate of discard velocity in distance units | id | -| ```discard_vhz``` | Heliocentric z-coordinate of discard velocity in distance units | id | -| ```discard_body_id``` | ID of the other body involved in the discard, 0 if no other body involved | id | -| ```Ip1``` | Principal moment of inertia axis 1, only if ```ROTATION``` in the **param.in** is set to ```YES``` | time, id | -| ```Ip2``` | Principal moment of inertia axis 2, only if ```ROTATION``` in the **param.in** is set to ```YES``` | time, id | -| ```Ip3``` | Principal moment of inertia axis 3, only if ```ROTATION``` in the **param.in** is set to ```YES``` | time, id | -| ```rotx``` | X-coordinate of particle rotation in radians / second, only if ```ROTATION``` in the **param.in** is set to ```YES``` | time, id | -| ```roty``` | Y-coordinate of particle rotation in radians / second, only if ```ROTATION``` in the **param.in** is set to ```YES``` | time, id | -| ```rotz``` | Z-coordinate of particle rotation in radians / second, only if ```ROTATION``` in the **param.in** is set to ```YES``` | time, id | -| ```KE_orb``` | Orbital kinetic energy of the system | time | -| ```KE_spin``` | Rotational kinetic energy of the system | time | -| ```PE``` | Potential energy of the system | time | -| ```L_orbx``` | Heliocentric x-coordinate of orbital angular momentum of the system | time | -| ```L_orby``` | Heliocentric y-coordinate of orbital angular momentum of the system | time | -| ```L_orbz``` | Heliocentric z-coordinate of orbital angular momentum of the system | time | -| ```L_spinx``` | Heliocentric x-coordinate of rotational angular momentum of the system | time | -| ```L_spiny``` | Heliocentric y-coordinate of rotational angular momentum of the system | time | -| ```L_spinz``` | Heliocentric z-coordinate of rotational angular momentum of the system | time | -| ```L_escapex``` | Heliocentric x-coordinate of orbital angular momentum of bodies that were discarded from the system due to being too far from the central body | time | -| ```L_escapey``` | Heliocentric y-coordinate of orbital angular momentum of bodies that were discarded from the system due to being too far from the central body | time | -| ```L_escapez``` | Heliocentric z-coordinate of orbital angular momentum of bodies that were discarded from the system due to being too far from the central body | time | -| ```Ecollisions``` | Energy lost due to collisions | time | -| ```Euntracked``` | Energy of bodies that were discarded from the system due to being too far from the central body, untracked potential energy due to merging bodies | time | -| ```GMescape``` | G * mass of particles that were discarded from the system due to being too far from the central body | time | -| ```j2rp2``` | The J2 / R^2 term of the central body | time | -| ```j4rp4``` | The J4 / R^2 term of the central body | time | - + **Object-Oriented Programming** The 2003 version of Fortran introduced object-oriented programming, with Fortran 2008 providing further updates. Swiftest is written in modern Fortran and takes advantage of many of the object-oriented programming features included in Fortran 2003. In doing so, Swiftest is a complete restructure of its predecessor, Swifter. The reusability and simplification of code in Swiftest through object-oriented programming is a modern and flexible approach that allows for future enhancements and additions to the Swiftest package. @@ -756,6 +670,8 @@ Parallelization using OpenMP is still under development in Swiftest. For prelimi --- +**NOTHING IS CHECKED BELOW HERE** + #### Examples All examples are included in the ```/swiftest/examples/``` directory. To run the initial conditions, follow the steps included in the **Usage** section. See the **README.txt** included in each example directory for more details. From 5dd16278bf580d81a1e3947e06bbbb6a2a927be1 Mon Sep 17 00:00:00 2001 From: Carlisle Wishard Date: Tue, 13 Dec 2022 12:44:41 -0500 Subject: [PATCH 405/569] updated example section --- README.md | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/README.md b/README.md index caadef2d3..bf77ba858 100644 --- a/README.md +++ b/README.md @@ -670,13 +670,11 @@ Parallelization using OpenMP is still under development in Swiftest. For prelimi --- -**NOTHING IS CHECKED BELOW HERE** - #### Examples -All examples are included in the ```/swiftest/examples/``` directory. To run the initial conditions, follow the steps included in the **Usage** section. See the **README.txt** included in each example directory for more details. +All examples are included in the ```/swiftest/examples/``` directory. Simply run the script(s) included in the directory as you would normally run a Python script. See the **README.txt** included in each example directory for more details. -**Standard Simulation Setup** +**Basic_Simulation** This example walks through how to set up a standard solar system simulation. It can be found in the ```/swiftest/examples/Basic_Simulation``` directory. It is intended to be run using the SyMBA integrator. It contains three classes of bodies: - Fully-Interacting Massive Bodies - Gravitational affect and are affected by other massive bodies. @@ -693,7 +691,9 @@ This example highlights the functionality of the Fraggle algorithm. It can be fo - An Off-Axis Supercatastrophic Disruptive Collision - A Disruptive Hit and Run Collision -For more details on the collisional regimes used in Fraggle, please see Wishard et al. 2023 (in preparation). +To generate a movide depicting the collision and results of each test case, run the Python script titled **Fragmentation_Movie.py**. + +**NOTHING IS CHECKED BELOW HERE** **Comparison with Swifter SyMBA** From 0d649db80908c8af642e73bdf6283a4dca9aee12 Mon Sep 17 00:00:00 2001 From: Carlisle Wishard Date: Tue, 13 Dec 2022 13:07:11 -0500 Subject: [PATCH 406/569] updated FAQ section --- README.md | 16 ++++++---------- 1 file changed, 6 insertions(+), 10 deletions(-) diff --git a/README.md b/README.md index bf77ba858..70c9fcad8 100644 --- a/README.md +++ b/README.md @@ -693,8 +693,6 @@ This example highlights the functionality of the Fraggle algorithm. It can be fo To generate a movide depicting the collision and results of each test case, run the Python script titled **Fragmentation_Movie.py**. -**NOTHING IS CHECKED BELOW HERE** - **Comparison with Swifter SyMBA** This example demonstrates that Swiftest SyMBA produces results that are in good agreement with Swifter SyMBA. It can be found in the ```/swiftest/examples/Swifter_Swiftest``` directory. It is intended to be run using the SyMBA integrator. It contains two sets of identical initial conditions, one formated to be compatable with Swifter and the other with Swiftest. This example contains the 8 fully-interacting modern planets, 50 additional fully-interacting massive bodies, 50 semi-interacting massive bodies, and 50 test particles. For the purposes of comparison, fragmentation, rotation, and general relativity were turned off in Swiftest SyMBA. All bodies were also assumed to be spherical. @@ -713,19 +711,17 @@ After 1 My, there is good agreement between Swiftest SyMBA and Swifter SyMBA in A good rule is to set ```dt``` equal to one tenth the orbit of the inner-most body in your simulation. For example, if Mercury is your inner-most body, ```dt``` should be set to one tenth Mercury's orbit. Mercury's orbit is ~0.24 years (~88 days) so a timestep of 0.024 years should be sufficiently small to accurately model the orbit of Mercury. You can always go smaller to increase resolution. -**How often should I output (**```ISTEP_OUT```**)?** - -Depending on your simulation, you may want to write to the output file more or less frequently. Writing takes a considerable amount of computational time, so it is important to set a output cadence that is manageable. Writing too frequently can also create extremely large and unwieldy output files, making data processing difficult. There is no hard and fast rule for how often you should output, however it is dependent on your total simulation length (```tmax```) and your timestep (```dt```). For example, an appropriate output cadence for run with a timestep of 0.005 years and a total simulation length of 100 My might be 2e5. This means that the output file will be written to every 2e5 timesteps. Based on our value of ```dt```, this is every 1,000 years. Our total simulation length tells us that we will output 100,000 times over the course of the simulation. For longer simulations, the output cadence may be less frequent to save computational space. For shorter simulations, the output cadence may be more frequent to increase resolution. +**How often should I output (**```ISTEP_OUT``` **and** ```DUMP_CADENCE```**)?** -**How often should I write to the dump files (**```ISTEP_DUMP```**)?** +Depending on your simulation, you may want to write to the output file more or less frequently. Writing takes a considerable amount of computational time, so it is important to set a output cadence that is manageable. Conversely, storing data in memory may not be reasonable for all simualtion configurations or hardware, so writing more frequently may be necessary. There is no hard and fast rule for how often you should output, however it is dependent on your total simulation length (```tmax```) and your timestep (```dt```). Think of ```ISTEP_OUT``` as the number of timesteps between writing to memory, and ```DUMP_CADENCE``` as the number of write to memory operations between writing to file. -Similar to your output cadence, your dump cadence is also dependent on your simulation length and timestep size. Writing to a dump file allows you to restart a simulation after a computer crash, a power outage, a node failure, or after a simulation has finished. This is especially necessary for runs that take weeks or months to finish. It is often convenient to set the dump cadence to the same frequency as the output cadence. This makes intuitive sense and can make restarting a run simple. However, it may be desirable to set the dump cadence higher than the output cadence if you are particularly concerned about interuptions. If you have a simulation that is quick to run and you don't forsee needing to restart it, it may be desirable to simply set the dump cadence such that it only writes to the dump file at the end of the simulation. This way, performance is improved and the dump files are not taking up computational space and memory. +For example, an appropriate output cadence for run with a timestep of 0.005 years and a total simulation length of 100 My might be ```ISTEP_OUT = 2e5``` and ```DUMP_CADENCE = 10```. This means that data will be stores to memory every 2e5 timesteps and written to file every 2e6 timesteps. Based on our value of ```dt```, this is every 1,000 years and every 10,000 years, respectiely. Our total simulation length tells us that we will write to file 10,000 times over the course of the simulation. For longer simulations, the output cadence may be less frequent to save computational space. For shorter simulations, the output cadence may be more frequent to increase resolution. -**What mass threshold should I set to differentiate fully-interactive and semi-interactive bodies (**```GMTINY```**)?** +**What mass threshold should I set to differentiate fully-interactive and semi-interactive bodies (**```GMTINY``` **or** ```MTINY```**)?** Semi-interacting bodies are useful because the integrator is not required to calculate gravitational interactions between pairs of semi-interacting particles. This can result in significant performance improvements, especially for systems that require hundreds or thousands of massive bodies. If your system only has a few tens of massive bodies, semi-interacting bodies may not be necessary. If you would like to differentiate between these two classes of bodies, simply set the mass threshold to be some value between the mass of the smallest fully-interacting body and the mass of the largest semi-interacting body that you choose. Semi-interacting bodies can collide with each other and grow to become fully interacting bodies once they pass the mass threshold. -**What should minimum fragment mass should I use (**```MIN_GMFRAG```**)?** +**What should minimum fragment mass should I use (**```MIN_GMFRAG``` **or** ```MIN_MFRAG```**)?** This mass threshold is necessary to ensure that Swiftest SyMBA does not generate huge amounts of very small fragments, grinding the model to a halt. While this value is largely empirical and dependent on each specific set of initial conditions, a good place to start is to set the minimum fragment mass threshold to be one tenth the size of the smallest body in your simulation. @@ -733,7 +729,7 @@ This mass threshold is necessary to ensure that Swiftest SyMBA does not generate While Swifest SyMBA is a powerful tool for modeling gravitational interactions between massive bodies, it does have its limits. While Swiftest SyMBA is capable of modeling systems containing thousands of massive bodies, the code does slow down significantly. For this reason, Swiftest SyMBA is best used for systems containing tens to hundreds of fully-interacting massive bodies. It is also best used for timescales on the order of a few hundred million years or less. While it is possible to model systems on a billion year timescale, the computational power required may be beyond what is available to the average user. In these cases, it is recommended that the user consider modeling with test particles instead of massive bodies. For systems that contain mainly test particles, with few to no close encounters between massive bodies, Swiftest RMVS is likely a more appropriate tool. An overview of the performance capabilities of Swiftest SyMBA is included in **Figure 3**. -To get a sense of the scope of your desired simulation, it is recommended that you run your initial conditions and parameters for a just few steps. Make sure that you set ```ISTEP_OUT``` and ```ISTEP_DUMP``` to output only once the simulation is complete, not between steps. Because writing to the output files takes a significant amount of computational time compared to integrating the step, we want to avoid counting writing time in our diagnostic information. The terminal output contains information about the total wall time and the wall time per integration step. To get a sense of how long your run will take to complete your desired ```tmax```, simply scale up the wall time per integration step to the number of steps necessary for ```tmax``` to be reached. Remember that writing to the output files will take a considerable amount of time. Adjust your intitial conditions and parameters accordingly. +To get a sense of the scope of your desired simulation, it is recommended that you run your initial conditions and parameters for a just few steps. Make sure that you set ```ISTEP_OUT``` and ```DUMP_CADENCE``` to output only once the simulation is complete, not between steps. Because writing to the output files and memory takes a significant amount of computational time compared to integrating the step, we want to avoid counting writing time in our diagnostic information. The terminal output contains information about the total wall time and the wall time per integration step. To get a sense of how long your run will take to complete your desired ```tmax```, simply scale up the wall time per integration step to the number of steps necessary for ```tmax``` to be reached. Remember that writing to the output files will take a considerable amount of time. Adjust your intitial conditions and parameters accordingly. |![Swiftest SyMBA Performance](README_figs/performance.png "Swiftest SyMBA Performance")| |:--:| From 8af4da899d43ffe810e0bbb3a9aa392148f1fe26 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Tue, 13 Dec 2022 14:08:43 -0500 Subject: [PATCH 407/569] Refactored x1,2 -> r1,2 --- src/encounter/encounter_check.f90 | 24 ++-- src/encounter/encounter_setup.f90 | 8 +- src/encounter/encounter_util.f90 | 209 +++++++++++++++++----------- src/modules/encounter_classes.f90 | 10 +- src/symba/symba_collision.f90 | 30 ++-- src/symba/symba_encounter_check.f90 | 4 +- src/symba/symba_util.f90 | 12 +- 7 files changed, 176 insertions(+), 121 deletions(-) diff --git a/src/encounter/encounter_check.f90 b/src/encounter/encounter_check.f90 index 6d866fb50..4e60ecf4f 100644 --- a/src/encounter/encounter_check.f90 +++ b/src/encounter/encounter_check.f90 @@ -891,7 +891,7 @@ pure module subroutine encounter_check_sort_aabb_1D(self, n, extent_arr) end subroutine encounter_check_sort_aabb_1D - module subroutine encounter_check_sweep_aabb_double_list(self, n1, n2, x1, v1, x2, v2, renc1, renc2, dt, & + module subroutine encounter_check_sweep_aabb_double_list(self, n1, n2, r1, v1, r2, v2, renc1, renc2, dt, & nenc, index1, index2, lvdotr) !! author: David A. Minton !! @@ -902,8 +902,8 @@ module subroutine encounter_check_sweep_aabb_double_list(self, n1, n2, x1, v1, x class(encounter_bounding_box), intent(inout) :: self !! Multi-dimensional bounding box structure integer(I4B), intent(in) :: n1 !! Number of bodies 1 integer(I4B), intent(in) :: n2 !! Number of bodies 2 - real(DP), dimension(:,:), intent(in) :: x1, v1 !! Array of position and velocity vectorrs for bodies 1 - real(DP), dimension(:,:), intent(in) :: x2, v2 !! Array of position and velocity vectorrs for bodies 2 + real(DP), dimension(:,:), intent(in) :: r1, v1 !! Array of position and velocity vectorrs for bodies 1 + real(DP), dimension(:,:), intent(in) :: r2, v2 !! Array of position and velocity vectorrs for bodies 2 real(DP), dimension(:), intent(in) :: renc1 !! Radius of encounter regions of bodies 1 real(DP), dimension(:), intent(in) :: renc2 !! Radius of encounter regions of bodies 2 real(DP), intent(in) :: dt !! Step size @@ -943,17 +943,17 @@ module subroutine encounter_check_sweep_aabb_double_list(self, n1, n2, x1, v1, x dim = 1 where(llist1(dim,:)) - xind(:) = x1(1,ext_ind(dim,:)) - yind(:) = x1(2,ext_ind(dim,:)) - zind(:) = x1(3,ext_ind(dim,:)) + xind(:) = r1(1,ext_ind(dim,:)) + yind(:) = r1(2,ext_ind(dim,:)) + zind(:) = r1(3,ext_ind(dim,:)) vxind(:) = v1(1,ext_ind(dim,:)) vyind(:) = v1(2,ext_ind(dim,:)) vzind(:) = v1(3,ext_ind(dim,:)) rencind(:) = renc1(ext_ind(dim,:)) elsewhere - xind(:) = x2(1,ext_ind(dim,:)) - yind(:) = x2(2,ext_ind(dim,:)) - zind(:) = x2(3,ext_ind(dim,:)) + xind(:) = r2(1,ext_ind(dim,:)) + yind(:) = r2(2,ext_ind(dim,:)) + zind(:) = r2(3,ext_ind(dim,:)) vxind(:) = v2(1,ext_ind(dim,:)) vyind(:) = v2(2,ext_ind(dim,:)) vzind(:) = v2(3,ext_ind(dim,:)) @@ -962,7 +962,7 @@ module subroutine encounter_check_sweep_aabb_double_list(self, n1, n2, x1, v1, x where(.not.loverlap(:)) lenc(:)%nenc = 0 !$omp parallel default(private) & - !$omp shared(self, ext_ind, lenc, loverlap, x1, v1, x2, v2, renc1, renc2, xind, yind, zind, vxind, vyind, vzind, rencind, llist1) & + !$omp shared(self, ext_ind, lenc, loverlap, r1, v1, r2, v2, renc1, renc2, xind, yind, zind, vxind, vyind, vzind, rencind, llist1) & !$omp firstprivate(ntot, n1, n2, dt, dim) ! Do the first group of bodies (i is in list 1, all the others are from list 2) @@ -972,7 +972,7 @@ module subroutine encounter_check_sweep_aabb_double_list(self, n1, n2, x1, v1, x ibeg = self%aabb(dim)%ibeg(i) + 1_I8B iend = self%aabb(dim)%iend(i) - 1_I8B nbox = iend - ibeg + 1 - call encounter_check_all_sweep_one(i, nbox, x1(1,i), x1(2,i), x1(3,i), v1(1,i), v1(2,i), v1(3,i), & + call encounter_check_all_sweep_one(i, nbox, r1(1,i), r1(2,i), r1(3,i), v1(1,i), v1(2,i), v1(3,i), & xind(ibeg:iend), yind(ibeg:iend), zind(ibeg:iend),& vxind(ibeg:iend), vyind(ibeg:iend), vzind(ibeg:iend), & renc1(i), rencind(ibeg:iend), dt, ext_ind(dim,ibeg:iend), & @@ -989,7 +989,7 @@ module subroutine encounter_check_sweep_aabb_double_list(self, n1, n2, x1, v1, x iend = self%aabb(dim)%iend(i) - 1_I8B nbox = iend - ibeg + 1 ii = i - n1 - call encounter_check_all_sweep_one(ii, nbox, x2(1,ii), x2(2,ii), x2(3,ii), v2(1,ii), v2(2,ii), v2(3,ii), & + call encounter_check_all_sweep_one(ii, nbox, r1(1,ii), r1(2,ii), r1(3,ii), v2(1,ii), v2(2,ii), v2(3,ii), & xind(ibeg:iend), yind(ibeg:iend), zind(ibeg:iend),& vxind(ibeg:iend), vyind(ibeg:iend), vzind(ibeg:iend), & renc2(ii), rencind(ibeg:iend), dt, ext_ind(dim,ibeg:iend), & diff --git a/src/encounter/encounter_setup.f90 b/src/encounter/encounter_setup.f90 index 4423952cd..18b60d229 100644 --- a/src/encounter/encounter_setup.f90 +++ b/src/encounter/encounter_setup.f90 @@ -79,8 +79,8 @@ module subroutine encounter_setup_list(self, n) allocate(self%index2(n)) allocate(self%id1(n)) allocate(self%id2(n)) - allocate(self%x1(NDIM,n)) - allocate(self%x2(NDIM,n)) + allocate(self%r1(NDIM,n)) + allocate(self%r2(NDIM,n)) allocate(self%v1(NDIM,n)) allocate(self%v2(NDIM,n)) @@ -91,8 +91,8 @@ module subroutine encounter_setup_list(self, n) self%index2(:) = 0 self%id1(:) = 0 self%id2(:) = 0 - self%x1(:,:) = 0.0_DP - self%x2(:,:) = 0.0_DP + self%r1(:,:) = 0.0_DP + self%r2(:,:) = 0.0_DP self%v1(:,:) = 0.0_DP self%v2(:,:) = 0.0_DP diff --git a/src/encounter/encounter_util.f90 b/src/encounter/encounter_util.f90 index 4386ec530..5d9e93a2e 100644 --- a/src/encounter/encounter_util.f90 +++ b/src/encounter/encounter_util.f90 @@ -33,8 +33,8 @@ module subroutine encounter_util_append_list(self, source, lsource_mask) call util_append(self%index2, source%index2, nold, nsrc, lsource_mask) call util_append(self%id1, source%id1, nold, nsrc, lsource_mask) call util_append(self%id2, source%id2, nold, nsrc, lsource_mask) - call util_append(self%x1, source%x1, nold, nsrc, lsource_mask) - call util_append(self%x2, source%x2, nold, nsrc, lsource_mask) + call util_append(self%r1, source%r1, nold, nsrc, lsource_mask) + call util_append(self%r2, source%r2, 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) self%nenc = nold + count(lsource_mask(1:nsrc)) @@ -62,8 +62,8 @@ module subroutine encounter_util_copy_list(self, source) self%index2(1:n) = source%index2(1:n) self%id1(1:n) = source%id1(1:n) self%id2(1:n) = source%id2(1:n) - self%x1(:,1:n) = source%x1(:,1:n) - self%x2(:,1:n) = source%x2(:,1:n) + self%r1(:,1:n) = source%r1(:,1:n) + self%r2(:,1:n) = source%r2(:,1:n) self%v1(:,1:n) = source%v1(:,1:n) self%v2(:,1:n) = source%v2(:,1:n) end associate @@ -103,8 +103,8 @@ module subroutine encounter_util_dealloc_list(self) if (allocated(self%index2)) deallocate(self%index2) if (allocated(self%id1)) deallocate(self%id1) if (allocated(self%id2)) deallocate(self%id2) - if (allocated(self%x1)) deallocate(self%x1) - if (allocated(self%x2)) deallocate(self%x2) + if (allocated(self%r1)) deallocate(self%r1) + if (allocated(self%r2)) deallocate(self%r2) if (allocated(self%v1)) deallocate(self%v1) if (allocated(self%v2)) deallocate(self%v2) @@ -385,8 +385,8 @@ module subroutine encounter_util_spill_list(self, discards, lspill_list, ldestru call util_spill(keeps%index2, discards%index2, lspill_list, ldestructive) call util_spill(keeps%id1, discards%id1, lspill_list, ldestructive) call util_spill(keeps%id2, discards%id2, lspill_list, ldestructive) - call util_spill(keeps%x1, discards%x1, lspill_list, ldestructive) - call util_spill(keeps%x2, discards%x2, lspill_list, ldestructive) + call util_spill(keeps%r1, discards%r1, lspill_list, ldestructive) + call util_spill(keeps%r2, discards%r2, lspill_list, ldestructive) call util_spill(keeps%v1, discards%v1, lspill_list, ldestructive) call util_spill(keeps%v2, discards%v2, lspill_list, ldestructive) @@ -570,7 +570,10 @@ module subroutine encounter_util_snapshot_encounter(self, param, system, t, arg) character(*), intent(in), optional :: arg !! Optional argument (needed for extended storage type used in collision snapshots) ! Arguments class(encounter_snapshot), allocatable :: snapshot - integer(I4B) :: i, npl_snap, ntp_snap + integer(I4B) :: i, j, k, npl_snap, ntp_snap + real(DP), dimension(NDIM) :: rrel, vrel, rcom, vcom + real(DP) :: mu, a, q, capm, tperi + real(DP), dimension(NDIM,2) :: rb,vb if (.not.present(t)) then write(*,*) "encounter_util_snapshot_encounter requires `t` to be passed" @@ -582,91 +585,139 @@ module subroutine encounter_util_snapshot_encounter(self, param, system, t, arg) return end if - select type (system) - class is (symba_nbody_system) - select case(arg) - case("trajectory") + select type(param) + class is (symba_parameters) + select type (system) + class is (symba_nbody_system) select type(pl => system%pl) class is (symba_pl) select type (tp => system%tp) class is (symba_tp) associate(npl => pl%nbody, ntp => tp%nbody) - allocate(encounter_snapshot :: snapshot) - snapshot%t = t - snapshot%iloop = param%iloop - if (npl + ntp == 0) return - npl_snap = npl - ntp_snap = ntp - + allocate(encounter_snapshot :: snapshot) allocate(snapshot%pl, mold=pl) allocate(snapshot%tp, mold=tp) - select type(pl_snap => snapshot%pl) - class is (symba_pl) - if (npl > 0) then - pl%lmask(1:npl) = pl%status(1:npl) /= INACTIVE .and. pl%levelg(1:npl) == system%irec - npl_snap = count(pl%lmask(1:npl)) - end if - if (ntp > 0) then - tp%lmask(1:ntp) = tp%status(1:ntp) /= INACTIVE .and. tp%levelg(1:ntp) == system%irec - ntp_snap = count(tp%lmask(1:ntp)) - end if - pl_snap%nbody = npl_snap - end select + snapshot%iloop = param%iloop select type(pl_snap => snapshot%pl) class is (symba_pl) - ! Take snapshot of the currently encountering massive bodies - if (npl_snap > 0) then - call pl_snap%setup(npl_snap, param) - pl_snap%levelg(:) = pack(pl%levelg(1:npl), pl%lmask(1:npl)) - pl_snap%id(:) = pack(pl%id(1:npl), pl%lmask(1:npl)) - pl_snap%info(:) = pack(pl%info(1:npl), pl%lmask(1:npl)) - pl_snap%Gmass(:) = pack(pl%Gmass(1:npl), pl%lmask(1:npl)) - do i = 1, NDIM - pl_snap%rh(i,:) = pack(pl%rh(i,1:npl), pl%lmask(1:npl)) - pl_snap%vh(i,:) = pack(pl%vb(i,1:npl), pl%lmask(1:npl)) - end do - if (param%lclose) then - pl_snap%radius(:) = pack(pl%radius(1:npl), pl%lmask(1:npl)) - end if - - if (param%lrotation) then - do i = 1, NDIM - pl_snap%Ip(i,:) = pack(pl%Ip(i,1:npl), pl%lmask(1:npl)) - pl_snap%rot(i,:) = pack(pl%rot(i,1:npl), pl%lmask(1:npl)) - end do - end if - call pl_snap%sort("id", ascending=.true.) - end if - end select - - select type(tp_snap => snapshot%tp) - class is (symba_tp) - ! Take snapshot of the currently encountering test particles - tp_snap%nbody = ntp_snap - if (ntp_snap > 0) then - call tp_snap%setup(ntp_snap, param) - tp_snap%id(:) = pack(tp%id(1:ntp), tp%lmask(1:ntp)) - tp_snap%info(:) = pack(tp%info(1:ntp), tp%lmask(1:ntp)) - do i = 1, NDIM - tp_snap%rh(i,:) = pack(tp%rh(i,1:ntp), tp%lmask(1:ntp)) - tp_snap%vh(i,:) = pack(tp%vh(i,1:ntp), tp%lmask(1:ntp)) - end do - end if + select type(tp_snap => snapshot%tp) + class is (symba_tp) + + select case(arg) + case("trajectory") + snapshot%t = t + + npl_snap = npl + ntp_snap = ntp + + if (npl > 0) then + pl%lmask(1:npl) = pl%status(1:npl) /= INACTIVE .and. pl%levelg(1:npl) == system%irec + npl_snap = count(pl%lmask(1:npl)) + end if + if (ntp > 0) then + tp%lmask(1:ntp) = tp%status(1:ntp) /= INACTIVE .and. tp%levelg(1:ntp) == system%irec + ntp_snap = count(tp%lmask(1:ntp)) + end if + + pl_snap%nbody = npl_snap + + ! Take snapshot of the currently encountering massive bodies + if (npl_snap > 0) then + call pl_snap%setup(npl_snap, param) + pl_snap%levelg(:) = pack(pl%levelg(1:npl), pl%lmask(1:npl)) + pl_snap%id(:) = pack(pl%id(1:npl), pl%lmask(1:npl)) + pl_snap%info(:) = pack(pl%info(1:npl), pl%lmask(1:npl)) + pl_snap%Gmass(:) = pack(pl%Gmass(1:npl), pl%lmask(1:npl)) + do i = 1, NDIM + pl_snap%rh(i,:) = pack(pl%rh(i,1:npl), pl%lmask(1:npl)) + pl_snap%vh(i,:) = pack(pl%vb(i,1:npl), pl%lmask(1:npl)) + end do + if (param%lclose) then + pl_snap%radius(:) = pack(pl%radius(1:npl), pl%lmask(1:npl)) + end if + + if (param%lrotation) then + do i = 1, NDIM + pl_snap%Ip(i,:) = pack(pl%Ip(i,1:npl), pl%lmask(1:npl)) + pl_snap%rot(i,:) = pack(pl%rot(i,1:npl), pl%lmask(1:npl)) + end do + end if + call pl_snap%sort("id", ascending=.true.) + end if + + ! Take snapshot of the currently encountering test particles + tp_snap%nbody = ntp_snap + if (ntp_snap > 0) then + call tp_snap%setup(ntp_snap, param) + tp_snap%id(:) = pack(tp%id(1:ntp), tp%lmask(1:ntp)) + tp_snap%info(:) = pack(tp%info(1:ntp), tp%lmask(1:ntp)) + do i = 1, NDIM + tp_snap%rh(i,:) = pack(tp%rh(i,1:ntp), tp%lmask(1:ntp)) + tp_snap%vh(i,:) = pack(tp%vh(i,1:ntp), tp%lmask(1:ntp)) + end do + end if + + ! Save the snapshot + param%encounter_history%nid = param%encounter_history%nid + ntp_snap + npl_snap + call encounter_util_save_encounter(param%encounter_history,snapshot,t) + case("closest") + associate(plplenc_list => system%plplenc_list, pltpenc_list => system%pltpenc_list) + if (any(plplenc_list%lclosest(:))) then + call pl_snap%setup(2, param) + do k = 1, plplenc_list%nenc + if (plplenc_list%lclosest(k)) then + i = plplenc_list%index1(k) + j = plplenc_list%index2(k) + pl_snap%levelg(:) = pl%levelg([i,j]) + pl_snap%id(:) = pl%id([i,j]) + pl_snap%info(:) = pl%info([i,j]) + pl_snap%Gmass(:) = pl%Gmass([i,j]) + mu = sum(pl_snap%Gmass(:)) + if (param%lclose) pl_snap%radius(:) = pl%radius([i,j]) + if (param%lrotation) then + do i = 1, NDIM + pl_snap%Ip(i,:) = pl%Ip(i,[i,j]) + pl_snap%rot(i,:) = pl%rot(i,[i,j]) + end do + end if + + ! Compute pericenter passage time to get the closest approach parameters + rrel(:) = plplenc_list%r2(:,k) - plplenc_list%r1(:,k) + vrel(:) = plplenc_list%v2(:,k) - plplenc_list%v1(:,k) + call orbel_xv2aqt(mu, rrel(1), rrel(2), rrel(3), vrel(1), vrel(2), vrel(3), a, q, capm, tperi) + snapshot%t = t + tperi + + ! Computer the center mass of the pair + + ! do i = 1, NDIM + ! pl_snap%rh(i,:) = pl%rh(i,[i,j]) + ! pl_snap%vh(i,:) = pl%vb(i,1:npl), pl%lmask(1:npl)) + ! end do + + call pl_snap%sort("id", ascending=.true.) + call encounter_util_save_encounter(param%encounter_history,snapshot,snapshot%t) + end if + end do + + plplenc_list%lclosest(:) = .false. + end if + + if (any(pltpenc_list%lclosest(:))) then + do k = 1, pltpenc_list%nenc + end do + pltpenc_list%lclosest(:) = .false. + end if + end associate + case default + write(*,*) "encounter_util_snapshot_encounter requires `arg` to be either `trajectory` or `closest`" + end select + end select end select end associate - ! Save the snapshot - select type(param) - class is (symba_parameters) - param%encounter_history%nid = param%encounter_history%nid + ntp_snap + npl_snap - call encounter_util_save_encounter(param%encounter_history,snapshot,t) - end select end select end select - case("closest") - case default - write(*,*) "encounter_util_snapshot_encounter requires `arg` to be either `trajectory` or `closest`" end select end select diff --git a/src/modules/encounter_classes.f90 b/src/modules/encounter_classes.f90 index f566a8070..2b313eeb5 100644 --- a/src/modules/encounter_classes.f90 +++ b/src/modules/encounter_classes.f90 @@ -29,8 +29,8 @@ module encounter_classes 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 :: r1 !! the position of body 1 in the encounter + real(DP), dimension(:,:), allocatable :: r2 !! the position of body 2 in the encounter real(DP), dimension(:,:), allocatable :: v1 !! the velocity of body 1 in the encounter real(DP), dimension(:,:), allocatable :: v2 !! the velocity of body 2 in the encounter contains @@ -186,14 +186,14 @@ pure module subroutine encounter_check_sort_aabb_1D(self, n, extent_arr) real(DP), dimension(:), intent(in) :: extent_arr !! Array of extents of size 2*n end subroutine encounter_check_sort_aabb_1D - module subroutine encounter_check_sweep_aabb_double_list(self, n1, n2, x1, v1, x2, v2, renc1, renc2, dt, & + module subroutine encounter_check_sweep_aabb_double_list(self, n1, n2, r1, v1, r2, v2, renc1, renc2, dt, & nenc, index1, index2, lvdotr) implicit none class(encounter_bounding_box), intent(inout) :: self !! Multi-dimensional bounding box structure integer(I4B), intent(in) :: n1 !! Number of bodies 1 integer(I4B), intent(in) :: n2 !! Number of bodies 2 - real(DP), dimension(:,:), intent(in) :: x1, v1 !! Array of indices of bodies 1 - real(DP), dimension(:,:), intent(in) :: x2, v2 !! Array of indices of bodies 2 + real(DP), dimension(:,:), intent(in) :: r1, v1 !! Array of indices of bodies 1 + real(DP), dimension(:,:), intent(in) :: r2, v2 !! Array of indices of bodies 2 real(DP), dimension(:), intent(in) :: renc1 !! Radius of encounter regions of bodies 1 real(DP), dimension(:), intent(in) :: renc2 !! Radius of encounter regions of bodies 2 real(DP), intent(in) :: dt !! Step size diff --git a/src/symba/symba_collision.f90 b/src/symba/symba_collision.f90 index 9015d3403..abfec217d 100644 --- a/src/symba/symba_collision.f90 +++ b/src/symba/symba_collision.f90 @@ -280,11 +280,11 @@ module subroutine symba_collision_check_encounter(self, system, param, t, dt, ir integer(I4B), intent(in) :: irec !! Current recursion level logical, intent(out) :: lany_collision !! Returns true if cany pair of encounters resulted in a collision ! Internals - logical, dimension(:), allocatable :: lcollision, lclosest, lmask + logical, dimension(:), allocatable :: lcollision, lmask real(DP), dimension(NDIM) :: xr, vr integer(I4B) :: i, j, k, nenc real(DP) :: rlim, Gmtot - logical :: isplpl + logical :: isplpl, lany_closest character(len=STRMAX) :: timestr, idstri, idstrj, message class(symba_encounter), allocatable :: tmp @@ -316,8 +316,7 @@ module subroutine symba_collision_check_encounter(self, system, param, t, dt, ir allocate(lcollision(nenc)) lcollision(:) = .false. - allocate(lclosest(nenc)) - lclosest(:) = .false. + self%lclosest(:) = .false. if (isplpl) then do concurrent(k = 1:nenc, lmask(k)) @@ -327,7 +326,7 @@ module subroutine symba_collision_check_encounter(self, system, param, t, dt, ir vr(:) = pl%vb(:, i) - pl%vb(:, j) rlim = pl%radius(i) + pl%radius(j) Gmtot = pl%Gmass(i) + pl%Gmass(j) - call symba_collision_check_one(xr(1), xr(2), xr(3), vr(1), vr(2), vr(3), Gmtot, rlim, dt, self%lvdotr(k), lcollision(k), lclosest(k)) + call symba_collision_check_one(xr(1), xr(2), xr(3), vr(1), vr(2), vr(3), Gmtot, rlim, dt, self%lvdotr(k), lcollision(k), self%lclosest(k)) end do else do concurrent(k = 1:nenc, lmask(k)) @@ -335,23 +334,28 @@ module subroutine symba_collision_check_encounter(self, system, param, t, dt, ir j = self%index2(k) xr(:) = pl%rh(:, i) - tp%rh(:, j) vr(:) = pl%vb(:, i) - tp%vb(:, j) - call 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), lcollision(k), lclosest(k)) + call 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), lcollision(k), self%lclosest(k)) end do end if lany_collision = any(lcollision(:)) + lany_closest = (param%lenc_save_closest .and. any(self%lclosest(:))) - if (lany_collision) then + + if (lany_collision .or. lany_closest) then call pl%rh2rb(system%cb) ! Update the central body barycenteric position vector to get us out of DH and into bary do k = 1, nenc + if (.not.lcollision(k) .and. .not. self%lclosest(k)) cycle i = self%index1(k) j = self%index2(k) - if (lcollision(k)) self%status(k) = COLLISION - self%tcollision(k) = t - self%x1(:,k) = pl%rh(:,i) + system%cb%rb(:) + self%r1(:,k) = pl%rh(:,i) + system%cb%rb(:) self%v1(:,k) = pl%vb(:,i) + if (lcollision(k)) then + self%status(k) = COLLISION + self%tcollision(k) = t + end if if (isplpl) then - self%x2(:,k) = pl%rh(:,j) + system%cb%rb(:) + self%r2(:,k) = pl%rh(:,j) + system%cb%rb(:) self%v2(:,k) = pl%vb(:,j) if (lcollision(k)) then ! Check to see if either of these bodies has been involved with a collision before, and if so, make this a collider pair @@ -364,7 +368,7 @@ module subroutine symba_collision_check_encounter(self, system, param, t, dt, ir 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%rh(:,j) + system%cb%rb(:) + self%r2(:,k) = tp%rh(:,j) + system%cb%rb(:) self%v2(:,k) = tp%vb(:,j) if (lcollision(k)) then tp%status(j) = DISCARDED_PLR @@ -392,7 +396,7 @@ module subroutine symba_collision_check_encounter(self, system, param, t, dt, ir end if ! Take snapshots of pairs of bodies at close approach (but not collision) if requested - if (param%lenc_save_closest .and. any(lclosest(:))) call param%encounter_history%take_snapshot(param, system, t, "closest") + if (lany_closest) call param%encounter_history%take_snapshot(param, system, t, "closest") end select diff --git a/src/symba/symba_encounter_check.f90 b/src/symba/symba_encounter_check.f90 index dd60f2e00..f016af9d9 100644 --- a/src/symba/symba_encounter_check.f90 +++ b/src/symba/symba_encounter_check.f90 @@ -65,8 +65,8 @@ 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%r1(:,k) = pl%rh(:,i) + plplenc_list%r2(:,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. diff --git a/src/symba/symba_util.f90 b/src/symba/symba_util.f90 index 74b555bce..06d75bac8 100644 --- a/src/symba/symba_util.f90 +++ b/src/symba/symba_util.f90 @@ -716,8 +716,8 @@ module subroutine symba_util_rearray_pl(self, system, param) system%plplenc_list%lvdotr(k) = plplenc_old%lvdotr(k) system%plplenc_list%lclosest(k) = plplenc_old%lclosest(k) system%plplenc_list%status(k) = plplenc_old%status(k) - system%plplenc_list%x1(:,k) = plplenc_old%x1(:,k) - system%plplenc_list%x2(:,k) = plplenc_old%x2(:,k) + system%plplenc_list%r1(:,k) = plplenc_old%r1(:,k) + system%plplenc_list%r2(:,k) = plplenc_old%r2(:,k) system%plplenc_list%v1(:,k) = plplenc_old%v1(:,k) system%plplenc_list%v2(:,k) = plplenc_old%v2(:,k) system%plplenc_list%tcollision(k) = plplenc_old%tcollision(k) @@ -727,8 +727,8 @@ module subroutine symba_util_rearray_pl(self, system, param) system%plplenc_list%lvdotr(k) = plplenc_old%lvdotr(k) system%plplenc_list%lclosest(k) = plplenc_old%lclosest(k) system%plplenc_list%status(k) = plplenc_old%status(k) - system%plplenc_list%x1(:,k) = plplenc_old%x2(:,k) - system%plplenc_list%x2(:,k) = plplenc_old%x1(:,k) + system%plplenc_list%r1(:,k) = plplenc_old%r2(:,k) + system%plplenc_list%r2(:,k) = plplenc_old%r1(:,k) system%plplenc_list%v1(:,k) = plplenc_old%v2(:,k) system%plplenc_list%v2(:,k) = plplenc_old%v1(:,k) system%plplenc_list%tcollision(k) = plplenc_old%tcollision(k) @@ -758,8 +758,8 @@ module subroutine symba_util_rearray_pl(self, system, param) 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)) - system%plplenc_list%x2(i, 1:nencmin) = pack(system%plplenc_list%x2(i, 1:nenc_old), lmask(1:nenc_old)) + system%plplenc_list%r1(i, 1:nencmin) = pack(system%plplenc_list%r1(i, 1:nenc_old), lmask(1:nenc_old)) + system%plplenc_list%r2(i, 1:nencmin) = pack(system%plplenc_list%r2(i, 1:nenc_old), lmask(1:nenc_old)) system%plplenc_list%v1(i, 1:nencmin) = pack(system%plplenc_list%v1(i, 1:nenc_old), lmask(1:nenc_old)) system%plplenc_list%v2(i, 1:nencmin) = pack(system%plplenc_list%v2(i, 1:nenc_old), lmask(1:nenc_old)) end do From 5719f38ba0ae121e254f81bacd5fb665e19ffb54 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Tue, 13 Dec 2022 16:18:35 -0500 Subject: [PATCH 408/569] Got close encounter saves in place. Now just troubleshooting --- examples/Fragmentation/Fragmentation_Movie.py | 4 +- python/swiftest/swiftest/simulation_class.py | 24 ++++++----- src/encounter/encounter_util.f90 | 41 +++++++++++++++---- src/symba/symba_io.f90 | 11 +++-- 4 files changed, 55 insertions(+), 25 deletions(-) diff --git a/examples/Fragmentation/Fragmentation_Movie.py b/examples/Fragmentation/Fragmentation_Movie.py index a068205fb..84488ca14 100644 --- a/examples/Fragmentation/Fragmentation_Movie.py +++ b/examples/Fragmentation/Fragmentation_Movie.py @@ -41,7 +41,7 @@ movie_titles = dict(zip(available_movie_styles, movie_title_list)) # These initial conditions were generated by trial and error -pos_vectors = {"disruption_headon" : [np.array([1.0, -5.0e-05, 0.0]), +pos_vectors = {"disruption_headon" : [np.array([1.0005, -5.0e-05, 0.0]), np.array([1.0, 5.0e-05 ,0.0])], "supercatastrophic_off_axis": [np.array([1.0, -4.2e-05, 0.0]), np.array([1.0, 4.2e-05, 0.0])], @@ -202,7 +202,7 @@ def data_stream(self, frame=0): # 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, encounter_save="TRAJECTORY", gmtiny=gmtiny, minimum_fragment_gmass=minimum_fragment_gmass, verbose=False) + sim.set_parameter(fragmentation=True, encounter_save="both", gmtiny=gmtiny, minimum_fragment_gmass=minimum_fragment_gmass, verbose=False) sim.run(dt=1e-4, tstop=1.0e-3, istep_out=1, dump_cadence=1) print("Generating animation") diff --git a/python/swiftest/swiftest/simulation_class.py b/python/swiftest/swiftest/simulation_class.py index f5517678f..9edf289b3 100644 --- a/python/swiftest/swiftest/simulation_class.py +++ b/python/swiftest/swiftest/simulation_class.py @@ -214,10 +214,12 @@ def __init__(self,read_param: bool = False, read_old_output: bool = False, simdi Check for close encounters between bodies. If set to True, then the radii of massive bodies must be included in initial conditions. Parameter input file equivalent: `CHK_CLOSE` - encounter_save : {"NONE","TRAJECTORY","CLOSEST"}, default "NONE" - Indicate if and how encounter data should be saved. If set to "TRAJECTORY" the full close encounter - trajectories are saved to file. If set to "CLOSEST" only the trajectories at the time of closest approach - are saved. If set to "NONE" no trajectory information is saved. + encounter_save : {"NONE","TRAJECTORY","CLOSEST", "BOTH"}, default "NONE" + Indicate if and how encounter data should be saved. If set to "TRAJECTORY", the position and velocity vectors + of all bodies undergoing close encounters are saved at each intermediate step to the encounter files. + If set to "CLOSEST", the position and velocities at the point of closest approach between pairs of bodies are + computed and stored to the encounter files. If set to "BOTH", then this stores the values that would be computed + in "TRAJECTORY" and "CLOSEST". If set to "NONE" no trajectory information is saved. *WARNING*: Enabling this feature could lead to very large files. general_relativity : bool, default True Include the post-Newtonian correction in acceleration calculations. @@ -1023,7 +1025,7 @@ def set_feature(self, tides: bool | None = None, interaction_loops: Literal["TRIANGULAR", "FLAT", "ADAPTIVE"] | None = None, encounter_check_loops: Literal["TRIANGULAR", "SORTSWEEP", "ADAPTIVE"] | None = None, - encounter_save: Literal["NONE", "TRAJECTORY", "CLOSEST"] | None = None, + encounter_save: Literal["NONE", "TRAJECTORY", "CLOSEST", "BOTH"] | None = None, verbose: bool | None = None, **kwargs: Any ): @@ -1035,10 +1037,12 @@ def set_feature(self, close_encounter_check : bool, optional Check for close encounters between bodies. If set to True, then the radii of massive bodies must be included in initial conditions. - encounter_save : {"NONE","TRAJECTORY","CLOSEST"}, default "NONE" - Indicate if and how encounter data should be saved. If set to "TRAJECTORY" the full close encounter - trajectories are saved to file. If set to "CLOSEST" only the trajectories at the time of closest approach - are saved. If set to "NONE" no trajectory information is saved. + encounter_save : {"NONE","TRAJECTORY","CLOSEST","BOTH"}, default "NONE" + Indicate if and how encounter data should be saved. If set to "TRAJECTORY", the position and velocity vectors + of all bodies undergoing close encounters are saved at each intermediate step to the encounter files. + If set to "CLOSEST", the position and velocities at the point of closest approach between pairs of bodies are + computed and stored to the encounter files. If set to "BOTH", then this stores the values that would be computed + in "TRAJECTORY" and "CLOSEST". If set to "NONE" no trajectory information is saved. *WARNING*: Enabling this feature could lead to very large files. general_relativity : bool, optional Include the post-Newtonian correction in acceleration calculations. @@ -1199,7 +1203,7 @@ def set_feature(self, update_list.append("encounter_check_loops") if encounter_save is not None: - valid_vals = ["NONE", "TRAJECTORY", "CLOSEST"] + valid_vals = ["NONE", "TRAJECTORY", "CLOSEST", "BOTH"] encounter_save = encounter_save.upper() if encounter_save not in valid_vals: msg = f"{encounter_save} is not a valid option for encounter_save." diff --git a/src/encounter/encounter_util.f90 b/src/encounter/encounter_util.f90 index 5d9e93a2e..33689dba2 100644 --- a/src/encounter/encounter_util.f90 +++ b/src/encounter/encounter_util.f90 @@ -570,9 +570,9 @@ module subroutine encounter_util_snapshot_encounter(self, param, system, t, arg) character(*), intent(in), optional :: arg !! Optional argument (needed for extended storage type used in collision snapshots) ! Arguments class(encounter_snapshot), allocatable :: snapshot - integer(I4B) :: i, j, k, npl_snap, ntp_snap + integer(I4B) :: i, j, k, npl_snap, ntp_snap, iflag real(DP), dimension(NDIM) :: rrel, vrel, rcom, vcom - real(DP) :: mu, a, q, capm, tperi + real(DP) :: Gmtot, a, q, capm, tperi real(DP), dimension(NDIM,2) :: rb,vb if (.not.present(t)) then @@ -621,6 +621,8 @@ module subroutine encounter_util_snapshot_encounter(self, param, system, t, arg) ntp_snap = count(tp%lmask(1:ntp)) end if + if (npl_snap + ntp_snap == 0) return ! Nothing to snapshot + pl_snap%nbody = npl_snap ! Take snapshot of the currently encountering massive bodies @@ -674,7 +676,7 @@ module subroutine encounter_util_snapshot_encounter(self, param, system, t, arg) pl_snap%id(:) = pl%id([i,j]) pl_snap%info(:) = pl%info([i,j]) pl_snap%Gmass(:) = pl%Gmass([i,j]) - mu = sum(pl_snap%Gmass(:)) + Gmtot = sum(pl_snap%Gmass(:)) if (param%lclose) pl_snap%radius(:) = pl%radius([i,j]) if (param%lrotation) then do i = 1, NDIM @@ -686,15 +688,36 @@ module subroutine encounter_util_snapshot_encounter(self, param, system, t, arg) ! Compute pericenter passage time to get the closest approach parameters rrel(:) = plplenc_list%r2(:,k) - plplenc_list%r1(:,k) vrel(:) = plplenc_list%v2(:,k) - plplenc_list%v1(:,k) - call orbel_xv2aqt(mu, rrel(1), rrel(2), rrel(3), vrel(1), vrel(2), vrel(3), a, q, capm, tperi) + call orbel_xv2aqt(Gmtot, rrel(1), rrel(2), rrel(3), vrel(1), vrel(2), vrel(3), a, q, capm, tperi) snapshot%t = t + tperi ! Computer the center mass of the pair - - ! do i = 1, NDIM - ! pl_snap%rh(i,:) = pl%rh(i,[i,j]) - ! pl_snap%vh(i,:) = pl%vb(i,1:npl), pl%lmask(1:npl)) - ! end do + rcom(:) = (plplenc_list%r1(:,k) * pl_snap%Gmass(1) + plplenc_list%r2(:,k) * pl_snap%Gmass(2)) / Gmtot + vcom(:) = (plplenc_list%v1(:,k) * pl_snap%Gmass(1) + plplenc_list%v2(:,k) * pl_snap%Gmass(2)) / Gmtot + rb(:,1) = plplenc_list%r1(:,k) - rcom(:) + rb(:,2) = plplenc_list%r2(:,k) - rcom(:) + vb(:,1) = plplenc_list%v1(:,k) - vcom(:) + vb(:,2) = plplenc_list%v2(:,k) - vcom(:) + + ! Drift the relative orbit to get the new relative position and velocity + call drift_one(Gmtot, rrel(1), rrel(2), rrel(3), vrel(1), vrel(2), vrel(3), tperi, iflag) + if (iflag /= 0) write(*,*) "Danby error in encounter_util_snapshot_encounter. Closest approach positions and vectors may not be accurate." + + ! Get the new position and velocity vectors + rb(:,1) = -(pl_snap%Gmass(2) / Gmtot) * rrel(:) + rb(:,2) = (pl_snap%Gmass(1)) / Gmtot * rrel(:) + + vb(:,1) = -(pl_snap%Gmass(2) / Gmtot) * vrel(:) + vb(:,2) = (pl_snap%Gmass(1)) / Gmtot * vrel(:) + + ! Move the CoM assuming constant velocity over the time it takes to reach periapsis + !rcom(:) = rcom(:) + vcom(:) * tperi + + ! Compute the heliocentric position and velocity vector at periapsis + pl_snap%rh(:,1) = rb(:,1) + rcom(:) + pl_snap%rh(:,2) = rb(:,2) + rcom(:) + pl_snap%vh(:,1) = vb(:,1) + vcom(:) + pl_snap%vh(:,2) = vb(:,2) + vcom(:) call pl_snap%sort("id", ascending=.true.) call encounter_util_save_encounter(param%encounter_history,snapshot,snapshot%t) diff --git a/src/symba/symba_io.f90 b/src/symba/symba_io.f90 index 916fb1a4c..29f1c1fbe 100644 --- a/src/symba/symba_io.f90 +++ b/src/symba/symba_io.f90 @@ -118,15 +118,18 @@ 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 /= "TRAJECTORY") .and. (param%encounter_save /= "CLOSEST")) then + if ((param%encounter_save /= "NONE") .and. & + (param%encounter_save /= "TRAJECTORY") .and. & + (param%encounter_save /= "CLOSEST") .and. & + (param%encounter_save /= "BOTH")) then write(iomsg,*) 'Invalid encounter_save parameter: ',trim(adjustl(param%out_type)) - write(iomsg,*) 'Valid options are NONE, TRAJECTORY, or CLOSEST' + write(iomsg,*) 'Valid options are NONE, TRAJECTORY, CLOSEST, or BOTH' iostat = -1 return end if - param%lenc_save_trajectory = (param%encounter_save == "TRAJECTORY") - param%lenc_save_closest = (param%encounter_save == "CLOSEST") .or. param%lenc_save_trajectory ! Closest approaches are always saved when trajectories are saved + param%lenc_save_trajectory = (param%encounter_save == "TRAJECTORY") .or. (param%encounter_save == "BOTH") + param%lenc_save_closest = (param%encounter_save == "CLOSEST") .or. (param%encounter_save == "BOTH") ! Call the base method (which also prints the contents to screen) call io_param_reader(param, unit, iotype, v_list, iostat, iomsg) From 44d0a75118cda903a654e966fbf0bfb27a3c96fb Mon Sep 17 00:00:00 2001 From: David A Minton Date: Tue, 13 Dec 2022 17:08:20 -0500 Subject: [PATCH 409/569] Fixed bugs that were preventing close encounters without collision from being recorded --- examples/Fragmentation/Fragmentation_Movie.py | 4 ++-- src/encounter/encounter_util.f90 | 20 +++++++++---------- src/symba/symba_collision.f90 | 2 +- 3 files changed, 13 insertions(+), 13 deletions(-) diff --git a/examples/Fragmentation/Fragmentation_Movie.py b/examples/Fragmentation/Fragmentation_Movie.py index 84488ca14..af8fa377c 100644 --- a/examples/Fragmentation/Fragmentation_Movie.py +++ b/examples/Fragmentation/Fragmentation_Movie.py @@ -41,8 +41,8 @@ movie_titles = dict(zip(available_movie_styles, movie_title_list)) # These initial conditions were generated by trial and error -pos_vectors = {"disruption_headon" : [np.array([1.0005, -5.0e-05, 0.0]), - np.array([1.0, 5.0e-05 ,0.0])], +pos_vectors = {"disruption_headon" : [np.array([1.0000055, -1.0e-03, 0.0]), + np.array([1.0, 1.0e-03 ,0.0])], "supercatastrophic_off_axis": [np.array([1.0, -4.2e-05, 0.0]), np.array([1.0, 4.2e-05, 0.0])], "hitandrun" : [np.array([1.0, -2.0e-05, 0.0]), diff --git a/src/encounter/encounter_util.f90 b/src/encounter/encounter_util.f90 index 33689dba2..10f8acda4 100644 --- a/src/encounter/encounter_util.f90 +++ b/src/encounter/encounter_util.f90 @@ -570,7 +570,7 @@ module subroutine encounter_util_snapshot_encounter(self, param, system, t, arg) character(*), intent(in), optional :: arg !! Optional argument (needed for extended storage type used in collision snapshots) ! Arguments class(encounter_snapshot), allocatable :: snapshot - integer(I4B) :: i, j, k, npl_snap, ntp_snap, iflag + integer(I4B) :: i, pi, pj, k, npl_snap, ntp_snap, iflag real(DP), dimension(NDIM) :: rrel, vrel, rcom, vcom real(DP) :: Gmtot, a, q, capm, tperi real(DP), dimension(NDIM,2) :: rb,vb @@ -670,18 +670,18 @@ module subroutine encounter_util_snapshot_encounter(self, param, system, t, arg) call pl_snap%setup(2, param) do k = 1, plplenc_list%nenc if (plplenc_list%lclosest(k)) then - i = plplenc_list%index1(k) - j = plplenc_list%index2(k) - pl_snap%levelg(:) = pl%levelg([i,j]) - pl_snap%id(:) = pl%id([i,j]) - pl_snap%info(:) = pl%info([i,j]) - pl_snap%Gmass(:) = pl%Gmass([i,j]) + pi = plplenc_list%index1(k) + pj = plplenc_list%index2(k) + pl_snap%levelg(:) = pl%levelg([pi,pj]) + pl_snap%id(:) = pl%id([pi,pj]) + pl_snap%info(:) = pl%info([pi,pj]) + pl_snap%Gmass(:) = pl%Gmass([pi,pj]) Gmtot = sum(pl_snap%Gmass(:)) - if (param%lclose) pl_snap%radius(:) = pl%radius([i,j]) + if (param%lclose) pl_snap%radius(:) = pl%radius([pi,pj]) if (param%lrotation) then do i = 1, NDIM - pl_snap%Ip(i,:) = pl%Ip(i,[i,j]) - pl_snap%rot(i,:) = pl%rot(i,[i,j]) + pl_snap%Ip(i,:) = pl%Ip(i,[pi,pj]) + pl_snap%rot(i,:) = pl%rot(i,[pi,pj]) end do end if diff --git a/src/symba/symba_collision.f90 b/src/symba/symba_collision.f90 index abfec217d..67540bfa3 100644 --- a/src/symba/symba_collision.f90 +++ b/src/symba/symba_collision.f90 @@ -442,8 +442,8 @@ pure elemental subroutine symba_collision_check_one(xr, yr, zr, vxr, vyr, vzr, G if (tcr2 <= dt2) then call orbel_xv2aeq(Gmtot, xr, yr, zr, vxr, vyr, vzr, a, e, q) lcollision = (q < rlim) - lclosest = .not. lcollision end if + lclosest = .not. lcollision end if end if From 7911210d059fc9dffa1a349e0dbec9f4635522ec Mon Sep 17 00:00:00 2001 From: David A Minton Date: Tue, 13 Dec 2022 18:31:51 -0500 Subject: [PATCH 410/569] Fixed issue with time keeping during recursion steps --- examples/Fragmentation/Fragmentation_Movie.py | 6 ++---- src/symba/symba_encounter_check.f90 | 1 + src/symba/symba_step.f90 | 12 ++++++------ 3 files changed, 9 insertions(+), 10 deletions(-) diff --git a/examples/Fragmentation/Fragmentation_Movie.py b/examples/Fragmentation/Fragmentation_Movie.py index af8fa377c..6822c71de 100644 --- a/examples/Fragmentation/Fragmentation_Movie.py +++ b/examples/Fragmentation/Fragmentation_Movie.py @@ -148,20 +148,18 @@ def setup_plot(self): ax.set_title(self.title) fig.add_axes(ax) - self.scatter_artist = ax.scatter([], [], animated=True) + self.scatter_artist = ax.scatter([], [], animated=True, c='k', edgecolors='face') return fig, ax def update_plot(self, frame): # Define a function to calculate the center of mass of the system. def center(Gmass, x, y): - x = x[~np.isnan(x)] - y = y[~np.isnan(y)] - Gmass = Gmass[~np.isnan(Gmass)] x_com = np.sum(Gmass * x) / np.sum(Gmass) y_com = np.sum(Gmass * y) / np.sum(Gmass) return x_com, y_com Gmass, rh, point_rad = next(self.data_stream(frame)) + point_rad*=2 x_com, y_com = center(Gmass, rh[:,0], rh[:,1]) self.scatter_artist.set_offsets(np.c_[rh[:,0] - x_com, rh[:,1] - y_com]) self.scatter_artist.set_sizes(point_rad**2) diff --git a/src/symba/symba_encounter_check.f90 b/src/symba/symba_encounter_check.f90 index f016af9d9..f53061b93 100644 --- a/src/symba/symba_encounter_check.f90 +++ b/src/symba/symba_encounter_check.f90 @@ -59,6 +59,7 @@ module function symba_encounter_check_pl(self, param, system, dt, irec) result(l if (lany_encounter) then do k = 1_I8B, nenc + plplenc_list%t = system%t i = plplenc_list%index1(k) j = plplenc_list%index2(k) plplenc_list%id1(k) = pl%id(i) diff --git a/src/symba/symba_step.f90 b/src/symba/symba_step.f90 index 3b217305f..216855118 100644 --- a/src/symba/symba_step.f90 +++ b/src/symba/symba_step.f90 @@ -225,7 +225,7 @@ recursive module subroutine symba_step_recur_system(self, param, t, ireci) call pl%drift(system, param, dtl) call tp%drift(system, param, dtl) - if (lencounter) call system%recursive_step(param, t+dth,irecp) + if (lencounter) call system%recursive_step(param, t + (j-1)*dtl, irecp) system%irec = ireci if (param%lgr) then @@ -241,13 +241,13 @@ recursive module subroutine symba_step_recur_system(self, param, t, ireci) end if if (param%lclose) then - call plplenc_list%collision_check(system, param, t+dtl, dtl, ireci, lplpl_collision) - call pltpenc_list%collision_check(system, param, t+dtl, dtl, ireci, lpltp_collision) + call plplenc_list%collision_check(system, param, t+j*dtl, dtl, ireci, lplpl_collision) + call pltpenc_list%collision_check(system, param, t+j*dtl, dtl, ireci, lpltp_collision) - if (lplpl_collision) call plplenc_list%resolve_collision(system, param, t+dtl, dtl, ireci) - if (lpltp_collision) call pltpenc_list%resolve_collision(system, param, t+dtl, dtl, ireci) + if (lplpl_collision) call plplenc_list%resolve_collision(system, param, t+j*dtl, dtl, ireci) + if (lpltp_collision) call pltpenc_list%resolve_collision(system, param, t+j*dtl, dtl, ireci) end if - if (param%lenc_save_trajectory) call encounter_history%take_snapshot(param, self, t+dtl, "trajectory") + if (param%lenc_save_trajectory) call encounter_history%take_snapshot(param, self, t+j*dtl, "trajectory") call self%set_recur_levels(ireci) From c9aee22b89971652f603f0cdd6dc9bf2ad63f80e Mon Sep 17 00:00:00 2001 From: David A Minton Date: Tue, 13 Dec 2022 20:18:28 -0500 Subject: [PATCH 411/569] Finally able to make a collision movie again --- examples/Fragmentation/Fragmentation_Movie.py | 12 +++++++----- src/encounter/encounter_util.f90 | 2 +- src/symba/symba_step.f90 | 2 +- 3 files changed, 9 insertions(+), 7 deletions(-) diff --git a/examples/Fragmentation/Fragmentation_Movie.py b/examples/Fragmentation/Fragmentation_Movie.py index 6822c71de..4a0d3b80d 100644 --- a/examples/Fragmentation/Fragmentation_Movie.py +++ b/examples/Fragmentation/Fragmentation_Movie.py @@ -41,8 +41,8 @@ movie_titles = dict(zip(available_movie_styles, movie_title_list)) # These initial conditions were generated by trial and error -pos_vectors = {"disruption_headon" : [np.array([1.0000055, -1.0e-03, 0.0]), - np.array([1.0, 1.0e-03 ,0.0])], +pos_vectors = {"disruption_headon" : [np.array([1.0, -5.0e-05, 0.0]), + np.array([1.0, 5.0e-05 ,0.0])], "supercatastrophic_off_axis": [np.array([1.0, -4.2e-05, 0.0]), np.array([1.0, 4.2e-05, 0.0])], "hitandrun" : [np.array([1.0, -2.0e-05, 0.0]), @@ -154,12 +154,14 @@ def setup_plot(self): def update_plot(self, frame): # Define a function to calculate the center of mass of the system. def center(Gmass, x, y): + x = x[~np.isnan(x)] + y = y[~np.isnan(y)] + Gmass = Gmass[~np.isnan(Gmass)] x_com = np.sum(Gmass * x) / np.sum(Gmass) y_com = np.sum(Gmass * y) / np.sum(Gmass) return x_com, y_com Gmass, rh, point_rad = next(self.data_stream(frame)) - point_rad*=2 x_com, y_com = center(Gmass, rh[:,0], rh[:,1]) self.scatter_artist.set_offsets(np.c_[rh[:,0] - x_com, rh[:,1] - y_com]) self.scatter_artist.set_sizes(point_rad**2) @@ -172,7 +174,7 @@ def data_stream(self, frame=0): radius = ds['radius'].values Gmass = ds['Gmass'].values rh = ds['rh'].values - point_rad = 2 * radius * self.ax_pt_size + point_rad = radius * self.ax_pt_size yield Gmass, rh, point_rad if __name__ == "__main__": @@ -200,7 +202,7 @@ def data_stream(self, frame=0): # 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, encounter_save="both", gmtiny=gmtiny, minimum_fragment_gmass=minimum_fragment_gmass, verbose=False) + sim.set_parameter(fragmentation=True, encounter_save="trajectory", gmtiny=gmtiny, minimum_fragment_gmass=minimum_fragment_gmass, verbose=False) sim.run(dt=1e-4, tstop=1.0e-3, istep_out=1, dump_cadence=1) print("Generating animation") diff --git a/src/encounter/encounter_util.f90 b/src/encounter/encounter_util.f90 index 10f8acda4..e4f0c1fbc 100644 --- a/src/encounter/encounter_util.f90 +++ b/src/encounter/encounter_util.f90 @@ -711,7 +711,7 @@ module subroutine encounter_util_snapshot_encounter(self, param, system, t, arg) vb(:,2) = (pl_snap%Gmass(1)) / Gmtot * vrel(:) ! Move the CoM assuming constant velocity over the time it takes to reach periapsis - !rcom(:) = rcom(:) + vcom(:) * tperi + rcom(:) = rcom(:) + vcom(:) * tperi ! Compute the heliocentric position and velocity vector at periapsis pl_snap%rh(:,1) = rb(:,1) + rcom(:) diff --git a/src/symba/symba_step.f90 b/src/symba/symba_step.f90 index 216855118..68645d7b8 100644 --- a/src/symba/symba_step.f90 +++ b/src/symba/symba_step.f90 @@ -225,7 +225,7 @@ recursive module subroutine symba_step_recur_system(self, param, t, ireci) call pl%drift(system, param, dtl) call tp%drift(system, param, dtl) - if (lencounter) call system%recursive_step(param, t + (j-1)*dtl, irecp) + if (lencounter) call system%recursive_step(param, t+(j-1)*dtl, irecp) system%irec = ireci if (param%lgr) then From 4355baedff458f9001fd16f381f82c90b697e221 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Tue, 13 Dec 2022 23:12:07 -0500 Subject: [PATCH 412/569] Made sure to set the recursion level correctly when creating collisional fragments --- src/symba/symba_util.f90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/symba/symba_util.f90 b/src/symba/symba_util.f90 index 06d75bac8..157c3f5af 100644 --- a/src/symba/symba_util.f90 +++ b/src/symba/symba_util.f90 @@ -683,7 +683,7 @@ module subroutine symba_util_rearray_pl(self, system, param) allocate(levelg_orig_pl, source=pl%levelg) allocate(levelm_orig_pl, source=pl%levelm) allocate(nplenc_orig_pl, source=pl%nplenc) - lencounter = pl%encounter_check(param, system, param%dt, 0) + lencounter = pl%encounter_check(param, system, param%dt, system%irec) if (system%tp%nbody > 0) then select type(tp => system%tp) class is (symba_tp) @@ -691,7 +691,7 @@ module subroutine symba_util_rearray_pl(self, system, param) allocate(levelg_orig_tp, source=tp%levelg) allocate(levelm_orig_tp, source=tp%levelm) allocate(nplenc_orig_tp, source=tp%nplenc) - lencounter = tp%encounter_check(param, system, param%dt, 0) + lencounter = tp%encounter_check(param, system, param%dt, system%irec) call move_alloc(levelg_orig_tp, tp%levelg) call move_alloc(levelm_orig_tp, tp%levelm) call move_alloc(nplenc_orig_tp, tp%nplenc) From 241b325eb3bfc49906df1236c2910113fdfabdb6 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Tue, 13 Dec 2022 23:17:35 -0500 Subject: [PATCH 413/569] Set the step size for the disruption movie to be an order of magnitude larger to make the movies faster --- examples/Fragmentation/Fragmentation_Movie.py | 5 +++-- python/swiftest/swiftest/io.py | 9 +-------- 2 files changed, 4 insertions(+), 10 deletions(-) diff --git a/examples/Fragmentation/Fragmentation_Movie.py b/examples/Fragmentation/Fragmentation_Movie.py index 4a0d3b80d..57f58e930 100644 --- a/examples/Fragmentation/Fragmentation_Movie.py +++ b/examples/Fragmentation/Fragmentation_Movie.py @@ -95,6 +95,8 @@ def encounter_combiner(sim): # Remove any encounter data at the same time steps that appear in the data to prevent duplicates t_not_duplicate = ~enc['time'].isin(data['time']) enc = enc.where(t_not_duplicate,drop=True) + tgood=enc.time.where(~np.isnan(enc.time),drop=True) + enc = enc.sel(time=tgood) # The following will combine the two datasets along the time dimension, sort the time dimension, and then fill in any time gaps with interpolation ds = xr.combine_nested([data,enc],concat_dim='time').sortby("time").interpolate_na(dim="time") @@ -107,7 +109,6 @@ class AnimatedScatter(object): def __init__(self, sim, animfile, title, style, nskip=1): self.ds = encounter_combiner(sim) - nframes = int(self.ds['time'].size) self.sim = sim self.title = title @@ -203,7 +204,7 @@ def data_stream(self, frame=0): 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, encounter_save="trajectory", gmtiny=gmtiny, minimum_fragment_gmass=minimum_fragment_gmass, verbose=False) - sim.run(dt=1e-4, tstop=1.0e-3, istep_out=1, dump_cadence=1) + sim.run(dt=1e-3, tstop=1.0e-3, istep_out=1, dump_cadence=1) print("Generating animation") anim = AnimatedScatter(sim,movie_filename,movie_titles[style],style,nskip=1) \ No newline at end of file diff --git a/python/swiftest/swiftest/io.py b/python/swiftest/swiftest/io.py index c002978b9..ade7cac00 100644 --- a/python/swiftest/swiftest/io.py +++ b/python/swiftest/swiftest/io.py @@ -816,19 +816,12 @@ def process_netcdf_input(ds, param): ds : xarray dataset """ # - #ds = ds.where(ds.id >=0,drop=True) + if param['OUT_TYPE'] == "NETCDF_DOUBLE": ds = fix_types(ds,ftype=np.float64) elif param['OUT_TYPE'] == "NETCDF_FLOAT": ds = fix_types(ds,ftype=np.float32) - # # Check if the name variable contains unique values. If so, make name the dimension instead of id - # if "id" in ds.dims: - # if len(np.unique(ds['name'])) == len(ds['name']): - # ds = ds.swap_dims({"id" : "name"}) - # if "id" in ds: - # ds = ds.reset_coords("id") - return ds def swiftest2xr(param, verbose=True): From 60277ba5d46a912c408650a49d93ba50afce68fa Mon Sep 17 00:00:00 2001 From: David A Minton Date: Tue, 13 Dec 2022 23:24:16 -0500 Subject: [PATCH 414/569] Tweaks to movie script --- examples/Fragmentation/Fragmentation_Movie.py | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/examples/Fragmentation/Fragmentation_Movie.py b/examples/Fragmentation/Fragmentation_Movie.py index 57f58e930..88e275d1d 100644 --- a/examples/Fragmentation/Fragmentation_Movie.py +++ b/examples/Fragmentation/Fragmentation_Movie.py @@ -43,8 +43,8 @@ # These initial conditions were generated by trial and error pos_vectors = {"disruption_headon" : [np.array([1.0, -5.0e-05, 0.0]), np.array([1.0, 5.0e-05 ,0.0])], - "supercatastrophic_off_axis": [np.array([1.0, -4.2e-05, 0.0]), - np.array([1.0, 4.2e-05, 0.0])], + "supercatastrophic_off_axis": [np.array([1.0, -5.0e-05, 0.0]), + np.array([1.0, 5.0e-05, 0.0])], "hitandrun" : [np.array([1.0, -2.0e-05, 0.0]), np.array([0.999999, 2.0e-05, 0.0])] } @@ -52,7 +52,7 @@ vel_vectors = {"disruption_headon" : [np.array([-2.562596e-04, 6.280005, 0.0]), np.array([-2.562596e-04, -6.280005, 0.0])], "supercatastrophic_off_axis": [np.array([0.0, 6.28, 0.0]), - np.array([1.0, -6.28, 0.0])], + np.array([0.5, -6.28, 0.0])], "hitandrun" : [np.array([0.0, 6.28, 0.0]), np.array([-0.1, -6.28, 0.0])] } @@ -139,7 +139,7 @@ def setup_plot(self): scale_frame = abs(rhy1) + abs(rhy2) ax = plt.Axes(fig, [0.1, 0.1, 0.8, 0.8]) - self.ax_pt_size = self.figsize[0] * 0.8 * 72 / (2 * scale_frame) + self.ax_pt_size = self.figsize[0] * 0.8 * 72 / (np.sqrt(2)*scale_frame) ax.set_xlim(-scale_frame, scale_frame) ax.set_ylim(-scale_frame, scale_frame) ax.set_xticks([]) From 00e517314952e33f5b449d41b7ab85adf83706da Mon Sep 17 00:00:00 2001 From: David A Minton Date: Wed, 14 Dec 2022 08:38:59 -0500 Subject: [PATCH 415/569] Fixed it so particles can only have closest encounters after their origin time. Also ensured that the actual collision time gets communicated down the chain. --- src/encounter/encounter_util.f90 | 1 + src/modules/symba_classes.f90 | 31 ++++++++------- src/symba/symba_collision.f90 | 66 +++++++++++++++++--------------- 3 files changed, 55 insertions(+), 43 deletions(-) diff --git a/src/encounter/encounter_util.f90 b/src/encounter/encounter_util.f90 index e4f0c1fbc..0da74cae7 100644 --- a/src/encounter/encounter_util.f90 +++ b/src/encounter/encounter_util.f90 @@ -690,6 +690,7 @@ module subroutine encounter_util_snapshot_encounter(self, param, system, t, arg) vrel(:) = plplenc_list%v2(:,k) - plplenc_list%v1(:,k) call orbel_xv2aqt(Gmtot, rrel(1), rrel(2), rrel(3), vrel(1), vrel(2), vrel(3), a, q, capm, tperi) snapshot%t = t + tperi + if (snapshot%t < maxval(pl_snap%info(:)%origin_time)) cycle ! Computer the center mass of the pair rcom(:) = (plplenc_list%r1(:,k) * pl_snap%Gmass(1) + plplenc_list%r2(:,k) * pl_snap%Gmass(2)) / Gmtot diff --git a/src/modules/symba_classes.f90 b/src/modules/symba_classes.f90 index 1d5a708b3..1a2c2ef8e 100644 --- a/src/modules/symba_classes.f90 +++ b/src/modules/symba_classes.f90 @@ -232,18 +232,20 @@ module subroutine symba_collision_make_colliders_pl(self,idx) 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_resolve_collision_fragmentations(self, system, param) + module subroutine symba_resolve_collision_fragmentations(self, system, param, t) implicit none class(symba_plplenc), intent(inout) :: self !! SyMBA pl-pl encounter list class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object class(symba_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions + real(DP), intent(in) :: t !! Time of collision end subroutine symba_resolve_collision_fragmentations - module subroutine symba_resolve_collision_mergers(self, system, param) + module subroutine symba_resolve_collision_mergers(self, system, param, t) implicit none class(symba_plplenc), intent(inout) :: self !! SyMBA pl-pl encounter list class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object class(symba_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions + real(DP), intent(in) :: t !! Time of collision end subroutine symba_resolve_collision_mergers module subroutine symba_resolve_collision_plplenc(self, system, param, t, dt, irec) @@ -343,25 +345,28 @@ pure module subroutine symba_gr_p4_tp(self, system, param, dt) real(DP), intent(in) :: dt !! Step size end subroutine symba_gr_p4_tp - module function symba_collision_casedisruption(system, param) result(status) + module function symba_collision_casedisruption(system, param, t) result(status) implicit none - class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object - class(symba_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions - integer(I4B) :: status !! Status flag assigned to this outcome + class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object + class(symba_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions + real(DP), intent(in) :: t !! Time of collision + integer(I4B) :: status !! Status flag assigned to this outcome end function symba_collision_casedisruption - module function symba_collision_casehitandrun(system, param) result(status) + module function symba_collision_casehitandrun(system, param, t) result(status) implicit none class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object - class(symba_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions - integer(I4B) :: status !! Status flag assigned to this outcome + class(symba_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions + real(DP), intent(in) :: t !! Time of collision + integer(I4B) :: status !! Status flag assigned to this outcome end function symba_collision_casehitandrun - module function symba_collision_casemerge(system, param) result(status) + module function symba_collision_casemerge(system, param, t) result(status) implicit none - class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object - class(symba_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions - integer(I4B) :: status !! Status flag assigned to this outcome + class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object + class(symba_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions + real(DP), intent(in) :: t !! Time of collision + integer(I4B) :: status !! Status flag assigned to this outcome end function symba_collision_casemerge module subroutine symba_util_set_renc(self, scale) diff --git a/src/symba/symba_collision.f90 b/src/symba/symba_collision.f90 index 67540bfa3..8d554f018 100644 --- a/src/symba/symba_collision.f90 +++ b/src/symba/symba_collision.f90 @@ -12,15 +12,16 @@ contains - module function symba_collision_casedisruption(system, param) result(status) + module function symba_collision_casedisruption(system, param, t) result(status) !! author: Jennifer L.L. Pouplin, Carlisle A. Wishard, and David A. Minton !! !! Create the fragments resulting from a non-catastrophic disruption collision !! implicit none ! Arguments - class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object - class(symba_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions + class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object + class(symba_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions + real(DP), intent(in) :: t !! Time of collision ! Result integer(I4B) :: status !! Status flag assigned to this outcome ! Internals @@ -73,7 +74,7 @@ module function symba_collision_casedisruption(system, param) result(status) param%maxid = fragments%id(nfrag) end select - call symba_collision_mergeaddsub(system, param, status) + call symba_collision_mergeaddsub(system, param, t, status) end if end associate @@ -81,15 +82,16 @@ module function symba_collision_casedisruption(system, param) result(status) end function symba_collision_casedisruption - module function symba_collision_casehitandrun(system, param) result(status) + module function symba_collision_casehitandrun(system, param, t) result(status) !! author: Jennifer L.L. Pouplin, Carlisle A. Wishard, and David A. Minton !! !! Create the fragments resulting from a non-catastrophic hit-and-run collision !! implicit none ! Arguments - class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object - class(symba_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions + class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object + class(symba_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions + real(DP), intent(in) :: t !! Time of collision ! Result integer(I4B) :: status !! Status flag assigned to this outcom ! Internals @@ -144,7 +146,7 @@ module function symba_collision_casehitandrun(system, param) result(status) fragments%id(2:nfrag) = [(i, i = param%maxid + 1, param%maxid + nfrag - 1)] param%maxid = fragments%id(nfrag) status = HIT_AND_RUN_DISRUPT - call symba_collision_mergeaddsub(system, param, status) + call symba_collision_mergeaddsub(system, param, t, status) end if end associate @@ -153,7 +155,7 @@ module function symba_collision_casehitandrun(system, param) result(status) end function symba_collision_casehitandrun - module function symba_collision_casemerge(system, param) result(status) + module function symba_collision_casemerge(system, param, t) result(status) !! author: Jennifer L.L. Pouplin, Carlisle A. Wishard, and David A. Minton !! !! Merge massive bodies. @@ -163,8 +165,9 @@ module function symba_collision_casemerge(system, param) result(status) !! Adapted from Hal Levison's Swift routines symba5_merge.f and discard_mass_merge.f implicit none ! Arguments - class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object - class(symba_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions + class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object + class(symba_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions + real(DP), intent(in) :: t !! Time of collision ! Result integer(I4B) :: status !! Status flag assigned to this outcome ! Internals @@ -226,7 +229,7 @@ module function symba_collision_casemerge(system, param) result(status) status = MERGED - call symba_collision_mergeaddsub(system, param, status) + call symba_collision_mergeaddsub(system, param, t, status) end select end associate @@ -719,16 +722,17 @@ module subroutine symba_collision_make_colliders_pl(self, idx) end subroutine symba_collision_make_colliders_pl - subroutine symba_collision_mergeaddsub(system, param, status) + subroutine symba_collision_mergeaddsub(system, param, t, status) !! author: David A. Minton !! !! Fills the pl_discards and pl_adds with removed and added bodies !! implicit none ! Arguments - class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object - class(symba_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions - integer(I4B), intent(in) :: status !! Status flag to assign to adds + class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object + class(symba_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions + real(DP), intent(in) :: t !! Time of collision + integer(I4B), intent(in) :: status !! Status flag to assign to adds ! Internals integer(I4B) :: i, ibiggest, ismallest, iother, nstart, nend, ncolliders, nfrag logical, dimension(system%pl%nbody) :: lmask @@ -775,7 +779,7 @@ subroutine symba_collision_mergeaddsub(system, param, status) plnew%status(1:nfrag) = NEW_PARTICLE do i = 1, nfrag write(newname, FRAGFMT) fragments%id(i) - call plnew%info(i)%set_value(origin_type="Supercatastrophic", origin_time=system%t, name=newname, & + call plnew%info(i)%set_value(origin_type="Supercatastrophic", origin_time=t, name=newname, & origin_rh=plnew%rh(:,i), origin_vh=plnew%vh(:,i), & collision_id=param%maxid_collision) end do @@ -785,7 +789,7 @@ subroutine symba_collision_mergeaddsub(system, param, status) else iother = ibiggest end if - call pl%info(colliders%idx(i))%set_value(status="Supercatastrophic", discard_time=system%t, & + call pl%info(colliders%idx(i))%set_value(status="Supercatastrophic", discard_time=t, & discard_rh=pl%rh(:,i), discard_vh=pl%vh(:,i), & discard_body_id=iother) end do @@ -799,14 +803,14 @@ subroutine symba_collision_mergeaddsub(system, param, status) plnew%status(1) = OLD_PARTICLE do i = 2, nfrag write(newname, FRAGFMT) fragments%id(i) - call plnew%info(i)%set_value(origin_type=origin_type, origin_time=system%t, name=newname, & + call plnew%info(i)%set_value(origin_type=origin_type, origin_time=t, name=newname, & origin_rh=plnew%rh(:,i), origin_vh=plnew%vh(:,i), & collision_id=param%maxid_collision) end do do i = 1, ncolliders if (colliders%idx(i) == ibiggest) cycle iother = ibiggest - call pl%info(colliders%idx(i))%set_value(status=origin_type, discard_time=system%t, & + call pl%info(colliders%idx(i))%set_value(status=origin_type, discard_time=t, & discard_rh=pl%rh(:,i), discard_vh=pl%vh(:,i), & discard_body_id=iother) end do @@ -817,7 +821,7 @@ subroutine symba_collision_mergeaddsub(system, param, status) if (colliders%idx(i) == ibiggest) cycle iother = ibiggest - call pl%info(colliders%idx(i))%set_value(status="MERGED", discard_time=system%t, discard_rh=pl%rh(:,i), & + call pl%info(colliders%idx(i))%set_value(status="MERGED", discard_time=t, discard_rh=pl%rh(:,i), & discard_vh=pl%vh(:,i), discard_body_id=iother) end do end select @@ -880,7 +884,7 @@ subroutine symba_collision_mergeaddsub(system, param, status) end subroutine symba_collision_mergeaddsub - module subroutine symba_resolve_collision_fragmentations(self, system, param) + module subroutine symba_resolve_collision_fragmentations(self, system, param, t) !! author: David A. Minton !! !! Process list of collisions, determine the collisional regime, and then create fragments. @@ -890,13 +894,14 @@ module subroutine symba_resolve_collision_fragmentations(self, system, param) class(symba_plplenc), intent(inout) :: self !! SyMBA pl-pl encounter list class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object class(symba_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions + real(DP), intent(in) :: t !! Time of collision ! Internals ! Internals integer(I4B), dimension(2) :: idx_parent !! Index of the two bodies considered the "parents" of the collision logical :: lgoodcollision integer(I4B) :: i - associate(plplcollision_list => self, ncollisions => self%nenc, idx1 => self%index1, idx2 => self%index2, t => system%t, collision_history => param%collision_history) + associate(plplcollision_list => self, ncollisions => self%nenc, idx1 => self%index1, idx2 => self%index2, collision_history => param%collision_history) select type(pl => system%pl) class is (symba_pl) select type (cb => system%cb) @@ -914,11 +919,11 @@ module subroutine symba_resolve_collision_fragmentations(self, system, param) if (param%lenc_save_trajectory) call collision_history%take_snapshot(param,system, t, "before") select case (system%fragments%regime) case (COLLRESOLVE_REGIME_DISRUPTION, COLLRESOLVE_REGIME_SUPERCATASTROPHIC) - plplcollision_list%status(i) = symba_collision_casedisruption(system, param) + plplcollision_list%status(i) = symba_collision_casedisruption(system, param, t) case (COLLRESOLVE_REGIME_HIT_AND_RUN) - plplcollision_list%status(i) = symba_collision_casehitandrun(system, param) + plplcollision_list%status(i) = symba_collision_casehitandrun(system, param, t) case (COLLRESOLVE_REGIME_MERGE, COLLRESOLVE_REGIME_GRAZE_AND_MERGE) - plplcollision_list%status(i) = symba_collision_casemerge(system, param) + plplcollision_list%status(i) = symba_collision_casemerge(system, param, t) case default write(*,*) "Error in symba_collision, unrecognized collision regime" call util_exit(FAILURE) @@ -934,7 +939,7 @@ module subroutine symba_resolve_collision_fragmentations(self, system, param) end subroutine symba_resolve_collision_fragmentations - module subroutine symba_resolve_collision_mergers(self, system, param) + module subroutine symba_resolve_collision_mergers(self, system, param, t) !! author: David A. Minton !! !! Process list of collisions and merge colliding bodies together. @@ -944,6 +949,7 @@ module subroutine symba_resolve_collision_mergers(self, system, param) class(symba_plplenc), intent(inout) :: self !! SyMBA pl-pl encounter list class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object class(symba_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions + real(DP), intent(in) :: t !! Time of collision ! Internals integer(I4B), dimension(2) :: idx_parent !! Index of the two bodies considered the "parents" of the collision logical :: lgoodcollision @@ -968,7 +974,7 @@ module subroutine symba_resolve_collision_mergers(self, system, param) fragments%mass_dist(3) = 0.0_DP fragments%rbcom(:) = (colliders%mass(1) * colliders%rb(:,1) + colliders%mass(2) * colliders%rb(:,2)) / fragments%mtot fragments%vbcom(:) = (colliders%mass(1) * colliders%vb(:,1) + colliders%mass(2) * colliders%vb(:,2)) / fragments%mtot - plplcollision_list%status(i) = symba_collision_casemerge(system, param) + plplcollision_list%status(i) = symba_collision_casemerge(system, param, t) end do end select end select @@ -1024,9 +1030,9 @@ module subroutine symba_resolve_collision_plplenc(self, system, param, t, dt, ir "***********************************************************") allocate(tmp_param, source=param) if (param%lfragmentation) then - call plplcollision_list%resolve_fragmentations(system, param) + call plplcollision_list%resolve_fragmentations(system, param, t) else - call plplcollision_list%resolve_mergers(system, param) + call plplcollision_list%resolve_mergers(system, param, t) end if ! Destroy the collision list now that the collisions are resolved From 632d6dc5a02eb8728b0fd9a1270f4d9ef23c464c Mon Sep 17 00:00:00 2001 From: David A Minton Date: Wed, 14 Dec 2022 10:45:03 -0500 Subject: [PATCH 416/569] Fixed issues with time-keeping and indexing of storage frames --- src/encounter/encounter_io.f90 | 11 ++++++----- src/encounter/encounter_util.f90 | 3 ++- src/fraggle/fraggle_io.f90 | 11 ++++++----- src/io/io.f90 | 6 +++--- src/netcdf/netcdf.f90 | 26 ++++++++++++++++++++------ src/setup/setup.f90 | 2 +- src/symba/symba_collision.f90 | 4 ++-- src/symba/symba_util.f90 | 15 ++++++--------- 8 files changed, 46 insertions(+), 32 deletions(-) diff --git a/src/encounter/encounter_io.f90 b/src/encounter/encounter_io.f90 index 22827f611..60748c5b0 100644 --- a/src/encounter/encounter_io.f90 +++ b/src/encounter/encounter_io.f90 @@ -112,9 +112,10 @@ module subroutine encounter_io_initialize(self, param) integer(I4B) :: nvar, varid, vartype real(DP) :: dfill real(SP) :: sfill + integer(I4B), parameter :: NO_FILL = 0 logical :: fileExists character(len=STRMAX) :: errmsg - integer(I4B) :: ndims, i + integer(I4B) :: ndims associate(nc => self) dfill = ieee_value(dfill, IEEE_QUIET_NAN) @@ -167,13 +168,13 @@ module subroutine encounter_io_initialize(self, param) call check( nf90_inquire_variable(nc%id, varid, xtype=vartype, ndims=ndims), "encounter_io_initialize nf90_inquire_variable" ) select case(vartype) case(NF90_INT) - call check( nf90_def_var_fill(nc%id, varid, 0, NF90_FILL_INT), "encounter_io_initialize nf90_def_var_fill NF90_INT" ) + call check( nf90_def_var_fill(nc%id, varid, NO_FILL, NF90_FILL_INT), "encounter_io_initialize nf90_def_var_fill NF90_INT" ) case(NF90_FLOAT) - call check( nf90_def_var_fill(nc%id, varid, 0, sfill), "encounter_io_initialize nf90_def_var_fill NF90_FLOAT" ) + call check( nf90_def_var_fill(nc%id, varid, NO_FILL, sfill), "encounter_io_initialize nf90_def_var_fill NF90_FLOAT" ) case(NF90_DOUBLE) - call check( nf90_def_var_fill(nc%id, varid, 0, dfill), "encounter_io_initialize nf90_def_var_fill NF90_DOUBLE" ) + call check( nf90_def_var_fill(nc%id, varid, NO_FILL, dfill), "encounter_io_initialize nf90_def_var_fill NF90_DOUBLE" ) case(NF90_CHAR) - call check( nf90_def_var_fill(nc%id, varid, 0, 0), "encounter_io_initialize nf90_def_var_fill NF90_CHAR" ) + call check( nf90_def_var_fill(nc%id, varid, NO_FILL, 0), "encounter_io_initialize nf90_def_var_fill NF90_CHAR" ) end select end do diff --git a/src/encounter/encounter_util.f90 b/src/encounter/encounter_util.f90 index 0da74cae7..9a1be2901 100644 --- a/src/encounter/encounter_util.f90 +++ b/src/encounter/encounter_util.f90 @@ -690,7 +690,8 @@ module subroutine encounter_util_snapshot_encounter(self, param, system, t, arg) vrel(:) = plplenc_list%v2(:,k) - plplenc_list%v1(:,k) call orbel_xv2aqt(Gmtot, rrel(1), rrel(2), rrel(3), vrel(1), vrel(2), vrel(3), a, q, capm, tperi) snapshot%t = t + tperi - if (snapshot%t < maxval(pl_snap%info(:)%origin_time)) cycle + if ((snapshot%t < maxval(pl_snap%info(:)%origin_time)) .or. & + (snapshot%t > minval(pl_snap%info(:)%discard_time))) cycle ! Computer the center mass of the pair rcom(:) = (plplenc_list%r1(:,k) * pl_snap%Gmass(1) + plplenc_list%r2(:,k) * pl_snap%Gmass(2)) / Gmtot diff --git a/src/fraggle/fraggle_io.f90 b/src/fraggle/fraggle_io.f90 index f47a64047..6f75c7d01 100644 --- a/src/fraggle/fraggle_io.f90 +++ b/src/fraggle/fraggle_io.f90 @@ -26,9 +26,10 @@ module subroutine fraggle_io_initialize_output(self, param) integer(I4B) :: nvar, varid, vartype real(DP) :: dfill real(SP) :: sfill + integer(I4B), parameter :: NO_FILL = 0 logical :: fileExists character(len=STRMAX) :: errmsg - integer(I4B) :: i, ndims + integer(I4B) :: ndims select type(param) class is (symba_parameters) @@ -120,13 +121,13 @@ module subroutine fraggle_io_initialize_output(self, param) call check( nf90_inquire_variable(nc%id, varid, xtype=vartype, ndims=ndims), "fraggle_io_initialize nf90_inquire_variable" ) select case(vartype) case(NF90_INT) - call check( nf90_def_var_fill(nc%id, varid, 0, NF90_FILL_INT), "fraggle_io_initialize nf90_def_var_fill NF90_INT" ) + call check( nf90_def_var_fill(nc%id, varid, NO_FILL, NF90_FILL_INT), "fraggle_io_initialize nf90_def_var_fill NF90_INT" ) case(NF90_FLOAT) - call check( nf90_def_var_fill(nc%id, varid, 0, sfill), "fraggle_io_initialize nf90_def_var_fill NF90_FLOAT" ) + call check( nf90_def_var_fill(nc%id, varid, NO_FILL, sfill), "fraggle_io_initialize nf90_def_var_fill NF90_FLOAT" ) case(NF90_DOUBLE) - call check( nf90_def_var_fill(nc%id, varid, 0, dfill), "fraggle_io_initialize nf90_def_var_fill NF90_DOUBLE" ) + call check( nf90_def_var_fill(nc%id, varid, NO_FILL, dfill), "fraggle_io_initialize nf90_def_var_fill NF90_DOUBLE" ) case(NF90_CHAR) - call check( nf90_def_var_fill(nc%id, varid, 0, 0), "fraggle_io_initialize nf90_def_var_fill NF90_CHAR" ) + call check( nf90_def_var_fill(nc%id, varid, NO_FILL, 0), "fraggle_io_initialize nf90_def_var_fill NF90_CHAR" ) end select end do ! Take the file out of define mode diff --git a/src/io/io.f90 b/src/io/io.f90 index f159e6ac7..54f99e42b 100644 --- a/src/io/io.f90 +++ b/src/io/io.f90 @@ -294,11 +294,11 @@ module subroutine io_dump_storage(self, param) integer(I8B) :: iloop_start if (self%iframe == 0) return - iloop_start = param%iloop - int(param%istep_out * param%dump_cadence, kind=I8B) + 1 + iloop_start = max(param%iloop - int(param%istep_out * param%dump_cadence, kind=I8B) + 1_I8B,0_I8B) call self%make_index_map() - do i = 1, param%dump_cadence - param%ioutput = iloop_start + self%tmap(i) + do i = 1, self%iframe if (allocated(self%frame(i)%item)) then + param%ioutput = iloop_start + self%tmap(i) select type(system => self%frame(i)%item) class is (swiftest_nbody_system) call system%write_frame(param) diff --git a/src/netcdf/netcdf.f90 b/src/netcdf/netcdf.f90 index 588a138d6..4ce217124 100644 --- a/src/netcdf/netcdf.f90 +++ b/src/netcdf/netcdf.f90 @@ -157,6 +157,7 @@ module subroutine netcdf_initialize_output(self, param) integer(I4B) :: nvar, varid, vartype real(DP) :: dfill real(SP) :: sfill + integer(I4B), parameter :: NO_FILL = 0 logical :: fileExists character(len=STRMAX) :: errmsg integer(I4B) :: ndims @@ -281,16 +282,24 @@ module subroutine netcdf_initialize_output(self, param) call check( nf90_inquire_variable(nc%id, varid, xtype=vartype, ndims=ndims), "netcdf_initialize_output nf90_inquire_variable" ) select case(vartype) case(NF90_INT) - call check( nf90_def_var_fill(nc%id, varid, 0, NF90_FILL_INT), "netcdf_initialize_output nf90_def_var_fill NF90_INT" ) + call check( nf90_def_var_fill(nc%id, varid, NO_FILL, NF90_FILL_INT), "netcdf_initialize_output nf90_def_var_fill NF90_INT" ) case(NF90_FLOAT) - call check( nf90_def_var_fill(nc%id, varid, 0, sfill), "netcdf_initialize_output nf90_def_var_fill NF90_FLOAT" ) + call check( nf90_def_var_fill(nc%id, varid, NO_FILL, sfill), "netcdf_initialize_output nf90_def_var_fill NF90_FLOAT" ) case(NF90_DOUBLE) - call check( nf90_def_var_fill(nc%id, varid, 0, dfill), "netcdf_initialize_output nf90_def_var_fill NF90_DOUBLE" ) + call check( nf90_def_var_fill(nc%id, varid, NO_FILL, dfill), "netcdf_initialize_output nf90_def_var_fill NF90_DOUBLE" ) case(NF90_CHAR) - call check( nf90_def_var_fill(nc%id, varid, 0, 0), "netcdf_initialize_output nf90_def_var_fill NF90_CHAR" ) + call check( nf90_def_var_fill(nc%id, varid, NO_FILL, 0), "netcdf_initialize_output nf90_def_var_fill NF90_CHAR" ) end select end do + ! Set special fill mode for discard time so that we can make use of it for non-discarded bodies. + select case (vartype) + case(NF90_FLOAT) + call check( nf90_def_var_fill(nc%id, nc%discard_time_varid, NO_FILL, huge(1.0_SP)), "netcdf_initialize_output nf90_def_var_fill discard_time NF90_FLOAT" ) + case(NF90_DOUBLE) + call check( nf90_def_var_fill(nc%id, nc%discard_time_varid, NO_FILL, huge(1.0_DP)), "netcdf_initialize_output nf90_def_var_fill discard_time NF90_DOUBLE" ) + end select + ! Take the file out of define mode call check( nf90_enddef(nc%id), "netcdf_initialize_output nf90_enddef" ) @@ -944,7 +953,7 @@ module subroutine netcdf_read_particle_info_system(self, nc, param, plmask, tpma if (status == nf90_noerr) then call check( nf90_get_var(nc%id, nc%collision_id_varid, itemp), "netcdf_read_particle_info_system nf90_getvar collision_id_varid" ) else - itemp = 0.0_DP + itemp = 0 end if do i = 1, npl @@ -958,7 +967,12 @@ module subroutine netcdf_read_particle_info_system(self, nc, param, plmask, tpma if (status == nf90_noerr) then call check( nf90_get_var(nc%id, nc%discard_time_varid, rtemp), "netcdf_read_particle_info_system nf90_getvar discard_time_varid" ) else - rtemp = 0.0_DP + select case (param%out_type) + case("NETCDF_FLOAT") + rtemp(:) = huge(0.0_SP) + case("NETCDF_DOUBLE") + rtemp(:) = huge(0.0_DP) + end select end if call cb%info%set_value(discard_time=rtemp(1)) diff --git a/src/setup/setup.f90 b/src/setup/setup.f90 index ef8558aef..57679f622 100644 --- a/src/setup/setup.f90 +++ b/src/setup/setup.f90 @@ -248,7 +248,7 @@ module subroutine setup_body(self, n, param) origin_time = -huge(1.0_DP), & origin_rh = [0.0_DP, 0.0_DP, 0.0_DP], & origin_vh = [0.0_DP, 0.0_DP, 0.0_DP], & - discard_time = -huge(1.0_DP), & + discard_time = huge(1.0_DP), & discard_rh = [0.0_DP, 0.0_DP, 0.0_DP], & discard_vh = [0.0_DP, 0.0_DP, 0.0_DP], & discard_body_id = -1 & diff --git a/src/symba/symba_collision.f90 b/src/symba/symba_collision.f90 index 8d554f018..0353cc7d5 100644 --- a/src/symba/symba_collision.f90 +++ b/src/symba/symba_collision.f90 @@ -367,8 +367,8 @@ module subroutine symba_collision_check_encounter(self, system, param, t, dt, ir ! 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_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)) + call pl%info(i)%set_value(status="COLLISION") + call pl%info(j)%set_value(status="COLLISION") end if else self%r2(:,k) = tp%rh(:,j) + system%cb%rb(:) diff --git a/src/symba/symba_util.f90 b/src/symba/symba_util.f90 index 157c3f5af..cf817622e 100644 --- a/src/symba/symba_util.f90 +++ b/src/symba/symba_util.f90 @@ -659,15 +659,12 @@ module subroutine symba_util_rearray_pl(self, system, param) pl%lcollision(1:npl) = .false. pl%lmask(1:npl) = .true. - select type(param) - class is (symba_parameters) - pl%lmtiny(1:npl) = pl%Gmass(1:npl) < param%GMTINY - where(pl%lmtiny(1:npl)) - pl%info(1:npl)%particle_type = PL_TINY_TYPE_NAME - elsewhere - pl%info(1:npl)%particle_type = PL_TYPE_NAME - end where - end select + pl%lmtiny(1:npl) = pl%Gmass(1:npl) < param%GMTINY + where(pl%lmtiny(1:npl)) + pl%info(1:npl)%particle_type = PL_TINY_TYPE_NAME + elsewhere + pl%info(1:npl)%particle_type = PL_TYPE_NAME + end where call pl%write_info(param%system_history%nc, param) deallocate(ldump_mask) From 67e03eab8c77b906c74cf20730f611a3376f5a64 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Wed, 14 Dec 2022 11:02:19 -0500 Subject: [PATCH 417/569] Fixed radius in movie animation --- examples/Fragmentation/Fragmentation_Movie.py | 10 +++++----- python/swiftest/swiftest/simulation_class.py | 5 ++++- 2 files changed, 9 insertions(+), 6 deletions(-) diff --git a/examples/Fragmentation/Fragmentation_Movie.py b/examples/Fragmentation/Fragmentation_Movie.py index 88e275d1d..43822bf25 100644 --- a/examples/Fragmentation/Fragmentation_Movie.py +++ b/examples/Fragmentation/Fragmentation_Movie.py @@ -54,7 +54,7 @@ "supercatastrophic_off_axis": [np.array([0.0, 6.28, 0.0]), np.array([0.5, -6.28, 0.0])], "hitandrun" : [np.array([0.0, 6.28, 0.0]), - np.array([-0.1, -6.28, 0.0])] + np.array([-0.9, -6.28, 0.0])] } rot_vectors = {"disruption_headon" : [np.array([0.0, 0.0, 0.0]), @@ -67,7 +67,7 @@ body_Gmass = {"disruption_headon" : [1e-7, 1e-10], "supercatastrophic_off_axis": [1e-7, 1e-8], - "hitandrun" : [1e-7, 7e-10] + "hitandrun" : [1e-7, 1e-10] } density = 3000 * swiftest.AU2M**3 / swiftest.MSun @@ -139,7 +139,7 @@ def setup_plot(self): scale_frame = abs(rhy1) + abs(rhy2) ax = plt.Axes(fig, [0.1, 0.1, 0.8, 0.8]) - self.ax_pt_size = self.figsize[0] * 0.8 * 72 / (np.sqrt(2)*scale_frame) + self.ax_pt_size = self.figsize[0] * 0.7 * 72 / scale_frame ax.set_xlim(-scale_frame, scale_frame) ax.set_ylim(-scale_frame, scale_frame) ax.set_xticks([]) @@ -203,8 +203,8 @@ def data_stream(self, frame=0): # 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, encounter_save="trajectory", gmtiny=gmtiny, minimum_fragment_gmass=minimum_fragment_gmass, verbose=False) - sim.run(dt=1e-3, tstop=1.0e-3, istep_out=1, dump_cadence=1) + sim.set_parameter(fragmentation=True, encounter_save="both", gmtiny=gmtiny, minimum_fragment_gmass=minimum_fragment_gmass, verbose=False) + sim.run(dt=1e-3, tstop=1.0e-3, istep_out=1, dump_cadence=0) print("Generating animation") anim = AnimatedScatter(sim,movie_filename,movie_titles[style],style,nskip=1) \ No newline at end of file diff --git a/python/swiftest/swiftest/simulation_class.py b/python/swiftest/swiftest/simulation_class.py index 9edf289b3..ad816344e 100644 --- a/python/swiftest/swiftest/simulation_class.py +++ b/python/swiftest/swiftest/simulation_class.py @@ -2713,7 +2713,8 @@ def read_output_file(self,read_init_cond : bool = True): 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 self.verbose: + print('Swiftest simulation data stored as xarray DataSet .data') if read_init_cond: if self.verbose: print("Reading initial conditions file as .init_cond") @@ -2725,6 +2726,8 @@ def read_output_file(self,read_init_cond : bool = True): self.read_encounters() self.read_collisions() + if self.verbose: + print("Finished reading Swiftest dataset files.") elif self.codename == "Swifter": self.data = io.swifter2xr(param_tmp, verbose=self.verbose) From 784995c0eff0c98e58d159b9c48f7754493da5f7 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Wed, 14 Dec 2022 11:20:39 -0500 Subject: [PATCH 418/569] Fixed problem where the particle type was not being set early enough to make it into the collision file --- src/fraggle/fraggle_io.f90 | 18 ------------------ src/modules/fraggle_classes.f90 | 6 ------ src/symba/symba_collision.f90 | 8 +++++++- 3 files changed, 7 insertions(+), 25 deletions(-) diff --git a/src/fraggle/fraggle_io.f90 b/src/fraggle/fraggle_io.f90 index 6f75c7d01..4ed16f137 100644 --- a/src/fraggle/fraggle_io.f90 +++ b/src/fraggle/fraggle_io.f90 @@ -219,24 +219,6 @@ module subroutine fraggle_io_write_frame(self, nc, param) end subroutine fraggle_io_write_frame - module subroutine fraggle_io_log_pl(pl, param) - !! author: David A. Minton - !! - !! Writes a single message to the fraggle log file - implicit none - ! Arguments - class(swiftest_pl), intent(in) :: pl !! Swiftest massive body object (only the new bodies generated in a collision) - class(swiftest_parameters), intent(in) :: param !! Current swiftest run configuration parameters - ! Internals - integer(I4B) :: i - character(STRMAX) :: errmsg - - return - 667 continue - write(*,*) "Error writing Fraggle message to log file: " // trim(adjustl(errmsg)) - end subroutine fraggle_io_log_pl - - module subroutine fraggle_io_log_regime(colliders, frag) !! author: David A. Minton !! diff --git a/src/modules/fraggle_classes.f90 b/src/modules/fraggle_classes.f90 index 8c75a3fc6..00b791f71 100644 --- a/src/modules/fraggle_classes.f90 +++ b/src/modules/fraggle_classes.f90 @@ -166,12 +166,6 @@ module subroutine fraggle_io_write_frame(self, nc, param) class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters end subroutine fraggle_io_write_frame - module subroutine fraggle_io_log_pl(pl, param) - implicit none - class(swiftest_pl), intent(in) :: pl !! Swiftest massive body object (only the new bodies generated in a collision) - class(swiftest_parameters), intent(in) :: param !! Current swiftest run configuration parameters - end subroutine fraggle_io_log_pl - module subroutine fraggle_io_log_regime(colliders, frag) implicit none class(fraggle_colliders), intent(in) :: colliders diff --git a/src/symba/symba_collision.f90 b/src/symba/symba_collision.f90 index 0353cc7d5..52324c5a3 100644 --- a/src/symba/symba_collision.f90 +++ b/src/symba/symba_collision.f90 @@ -843,8 +843,14 @@ subroutine symba_collision_mergeaddsub(system, param, t, status) plnew%levelg(1:nfrag) = pl%levelg(ibiggest) plnew%levelm(1:nfrag) = pl%levelm(ibiggest) + plnew%lmtiny(1:nfrag) = plnew%Gmass(1:nfrag) < param%GMTINY + where(plnew%lmtiny(1:nfrag)) + plnew%info(1:nfrag)%particle_type = PL_TINY_TYPE_NAME + elsewhere + plnew%info(1:nfrag)%particle_type = PL_TYPE_NAME + end where + ! Log the properties of the new bodies - call fraggle_io_log_pl(plnew, param) allocate(system%fragments%pl, source=plnew) ! Append the new merged body to the list From 86872fcf888f2297563d52668c390ae7a565f354 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Wed, 14 Dec 2022 11:30:54 -0500 Subject: [PATCH 419/569] Added missing KE_spin variable to collision file output --- src/fraggle/fraggle_io.f90 | 18 ++++++++++-------- 1 file changed, 10 insertions(+), 8 deletions(-) diff --git a/src/fraggle/fraggle_io.f90 b/src/fraggle/fraggle_io.f90 index 4ed16f137..c2b60f98d 100644 --- a/src/fraggle/fraggle_io.f90 +++ b/src/fraggle/fraggle_io.f90 @@ -202,14 +202,16 @@ module subroutine fraggle_io_write_frame(self, nc, param) call check( nf90_put_var(nc%id, nc%rot_varid, pl%rot(:,i), start=[1, idslot, stage, eslot], count=[NDIM,1,1,1]), "fraggle_io_write_frame nf90_put_var rotx_varid" ) end do end do - call check( nf90_put_var(nc%id, nc%ke_orb_varid, fragments%ke_orbit_before, start=[ 1, eslot]), "fraggle_io_write_frame nf90_put_var ke_orb_varid before" ) - call check( nf90_put_var(nc%id, nc%ke_orb_varid, fragments%ke_orbit_after, start=[ 2, eslot]), "fraggle_io_write_frame nf90_put_var ke_orb_varid after" ) - call check( nf90_put_var(nc%id, nc%pe_varid, fragments%pe_before, start=[ 1, eslot]), "fraggle_io_write_frame nf90_put_var pe_varid before" ) - call check( nf90_put_var(nc%id, nc%pe_varid, fragments%pe_after, start=[ 2, eslot]), "fraggle_io_write_frame nf90_put_var pe_varid after" ) - call check( nf90_put_var(nc%id, nc%L_orb_varid, fragments%Lorbit_before(:), start=[1, 1, eslot], count=[NDIM, 1, 1]), "fraggle_io_write_frame nf90_put_var L_orb_varid before" ) - call check( nf90_put_var(nc%id, nc%L_orb_varid, fragments%Lorbit_after(:), start=[1, 2, eslot], count=[NDIM, 1, 1]), "fraggle_io_write_frame nf90_put_var L_orb_varid after" ) - call check( nf90_put_var(nc%id, nc%L_spin_varid, fragments%Lspin_before(:), start=[1, 1, eslot], count=[NDIM, 1, 1]), "fraggle_io_write_frame nf90_put_var L_spin_varid before" ) - call check( nf90_put_var(nc%id, nc%L_spin_varid, fragments%Lspin_after(:), start=[1, 2, eslot], count=[NDIM, 1, 1]), "fraggle_io_write_frame nf90_put_var L_spin_varid after" ) + call check( nf90_put_var(nc%id, nc%ke_orb_varid, fragments%ke_orbit_before, start=[ 1, eslot]), "fraggle_io_write_frame nf90_put_var ke_orb_varid before" ) + call check( nf90_put_var(nc%id, nc%ke_orb_varid, fragments%ke_orbit_after, start=[ 2, eslot]), "fraggle_io_write_frame nf90_put_var ke_orb_varid after" ) + call check( nf90_put_var(nc%id, nc%ke_spin_varid, fragments%ke_orbit_before, start=[ 1, eslot]), "fraggle_io_write_frame nf90_put_var ke_spin_varid before" ) + call check( nf90_put_var(nc%id, nc%ke_spin_varid, fragments%ke_orbit_after, start=[ 2, eslot]), "fraggle_io_write_frame nf90_put_var ke_spin_varid after" ) + call check( nf90_put_var(nc%id, nc%pe_varid, fragments%pe_before, start=[ 1, eslot]), "fraggle_io_write_frame nf90_put_var pe_varid before" ) + call check( nf90_put_var(nc%id, nc%pe_varid, fragments%pe_after, start=[ 2, eslot]), "fraggle_io_write_frame nf90_put_var pe_varid after" ) + call check( nf90_put_var(nc%id, nc%L_orb_varid, fragments%Lorbit_before(:), start=[1, 1, eslot], count=[NDIM, 1, 1]), "fraggle_io_write_frame nf90_put_var L_orb_varid before" ) + call check( nf90_put_var(nc%id, nc%L_orb_varid, fragments%Lorbit_after(:), start=[1, 2, eslot], count=[NDIM, 1, 1]), "fraggle_io_write_frame nf90_put_var L_orb_varid after" ) + call check( nf90_put_var(nc%id, nc%L_spin_varid, fragments%Lspin_before(:), start=[1, 1, eslot], count=[NDIM, 1, 1]), "fraggle_io_write_frame nf90_put_var L_spin_varid before" ) + call check( nf90_put_var(nc%id, nc%L_spin_varid, fragments%Lspin_after(:), start=[1, 2, eslot], count=[NDIM, 1, 1]), "fraggle_io_write_frame nf90_put_var L_spin_varid after" ) call check( nf90_set_fill(nc%id, old_mode, old_mode) ) end associate From 278292ff89dfd80dc430d1f83ca65bedacb17ab2 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Wed, 14 Dec 2022 11:47:15 -0500 Subject: [PATCH 420/569] Made sure energy and momentum units are correct after fraggle. Also fixed typo that saved ke orbit to spin by accident. --- src/fraggle/fraggle_io.f90 | 4 ++-- src/fraggle/fraggle_set.f90 | 16 ++++++++++++++++ 2 files changed, 18 insertions(+), 2 deletions(-) diff --git a/src/fraggle/fraggle_io.f90 b/src/fraggle/fraggle_io.f90 index c2b60f98d..e37adf13d 100644 --- a/src/fraggle/fraggle_io.f90 +++ b/src/fraggle/fraggle_io.f90 @@ -204,8 +204,8 @@ module subroutine fraggle_io_write_frame(self, nc, param) end do call check( nf90_put_var(nc%id, nc%ke_orb_varid, fragments%ke_orbit_before, start=[ 1, eslot]), "fraggle_io_write_frame nf90_put_var ke_orb_varid before" ) call check( nf90_put_var(nc%id, nc%ke_orb_varid, fragments%ke_orbit_after, start=[ 2, eslot]), "fraggle_io_write_frame nf90_put_var ke_orb_varid after" ) - call check( nf90_put_var(nc%id, nc%ke_spin_varid, fragments%ke_orbit_before, start=[ 1, eslot]), "fraggle_io_write_frame nf90_put_var ke_spin_varid before" ) - call check( nf90_put_var(nc%id, nc%ke_spin_varid, fragments%ke_orbit_after, start=[ 2, eslot]), "fraggle_io_write_frame nf90_put_var ke_spin_varid after" ) + call check( nf90_put_var(nc%id, nc%ke_spin_varid, fragments%ke_spin_before, start=[ 1, eslot]), "fraggle_io_write_frame nf90_put_var ke_spin_varid before" ) + call check( nf90_put_var(nc%id, nc%ke_spin_varid, fragments%ke_spin_after, start=[ 2, eslot]), "fraggle_io_write_frame nf90_put_var ke_spin_varid after" ) call check( nf90_put_var(nc%id, nc%pe_varid, fragments%pe_before, start=[ 1, eslot]), "fraggle_io_write_frame nf90_put_var pe_varid before" ) call check( nf90_put_var(nc%id, nc%pe_varid, fragments%pe_after, start=[ 2, eslot]), "fraggle_io_write_frame nf90_put_var pe_varid after" ) call check( nf90_put_var(nc%id, nc%L_orb_varid, fragments%Lorbit_before(:), start=[1, 1, eslot], count=[NDIM, 1, 1]), "fraggle_io_write_frame nf90_put_var L_orb_varid before" ) diff --git a/src/fraggle/fraggle_set.f90 b/src/fraggle/fraggle_set.f90 index 4a70130b6..dfa0f64e6 100644 --- a/src/fraggle/fraggle_set.f90 +++ b/src/fraggle/fraggle_set.f90 @@ -300,6 +300,22 @@ module subroutine fraggle_set_original_scale_factors(self, colliders) frag%rb(:, i) = frag%x_coll(:, i) + frag%rbcom(:) frag%vb(:, i) = frag%v_coll(:, i) + frag%vbcom(:) end do + + frag%Lorbit_before(:) = frag%Lorbit_before * frag%Lscale + frag%Lspin_before(:) = frag%Lspin_before * frag%Lscale + frag%Ltot_before(:) = frag%Ltot_before * frag%Lscale + frag%ke_orbit_before = frag%ke_orbit_before * frag%Escale + frag%ke_spin_before = frag%ke_spin_before * frag%Escale + frag%pe_before = frag%pe_before * frag%Escale + frag%Etot_before = frag%Etot_before * frag%Escale + + frag%Lorbit_after(:) = frag%Lorbit_after * frag%Lscale + frag%Lspin_after(:) = frag%Lspin_after * frag%Lscale + frag%Ltot_after(:) = frag%Ltot_after * frag%Lscale + frag%ke_orbit_after = frag%ke_orbit_after * frag%Escale + frag%ke_spin_after = frag%ke_spin_after * frag%Escale + frag%pe_after = frag%pe_after * frag%Escale + frag%Etot_after = frag%Etot_after * frag%Escale frag%mscale = 1.0_DP frag%dscale = 1.0_DP From df0be083dcc844cbaf7ce7eb563d6c249b444e4f Mon Sep 17 00:00:00 2001 From: David A Minton Date: Wed, 14 Dec 2022 12:21:21 -0500 Subject: [PATCH 421/569] Consolidated redundant collision_resolve subroutines for mergers and fragmentations --- src/fraggle/fraggle_io.f90 | 47 ++++++++++---------- src/modules/symba_classes.f90 | 18 -------- src/symba/symba_collision.f90 | 80 ++++++++++------------------------- 3 files changed, 47 insertions(+), 98 deletions(-) diff --git a/src/fraggle/fraggle_io.f90 b/src/fraggle/fraggle_io.f90 index e37adf13d..61650e700 100644 --- a/src/fraggle/fraggle_io.f90 +++ b/src/fraggle/fraggle_io.f90 @@ -98,23 +98,24 @@ module subroutine fraggle_io_initialize_output(self, param) call check( nf90_def_var(nc%id, nc%rot_varname, nc%out_type,& [ nc%space_dimid, nc%name_dimid, nc%stage_dimid, nc%event_dimid], nc%rot_varid), "fraggle_io_initialize nf90_def_var rot_varid") + + if (param%lenergy) then - call check( nf90_def_var(nc%id, nc%ke_orb_varname, nc%out_type,& - [ nc%stage_dimid, nc%event_dimid], nc%KE_orb_varid), "fraggle_io_initialize_output nf90_def_var KE_orb_varid") - - call check( nf90_def_var(nc%id, nc%ke_spin_varname, nc%out_type,& - [ nc%stage_dimid, nc%event_dimid], nc%KE_spin_varid), "fraggle_io_initialize_output nf90_def_var KE_spin_varid" ) - - call check( nf90_def_var(nc%id, nc%pe_varname, nc%out_type,& - [ nc%stage_dimid, nc%event_dimid], nc%PE_varid), "fraggle_io_initialize_output nf90_def_var PE_varid" ) + call check( nf90_def_var(nc%id, nc%ke_orb_varname, nc%out_type,& + [ nc%stage_dimid, nc%event_dimid], nc%KE_orb_varid), "fraggle_io_initialize_output nf90_def_var KE_orb_varid") - call check( nf90_def_var(nc%id, nc%L_orb_varname, nc%out_type, & - [ nc%space_dimid, nc%stage_dimid, nc%event_dimid], nc%L_orb_varid), "fraggle_io_initialize_output nf90_def_var L_orb_varid" ) + call check( nf90_def_var(nc%id, nc%ke_spin_varname, nc%out_type,& + [ nc%stage_dimid, nc%event_dimid], nc%KE_spin_varid), "fraggle_io_initialize_output nf90_def_var KE_spin_varid" ) - call check( nf90_def_var(nc%id, nc%L_spin_varname, nc%out_type,& - [ nc%space_dimid, nc%stage_dimid, nc%event_dimid], nc%L_spin_varid), "fraggle_io_initialize_output nf90_def_var L_spin_varid" ) + call check( nf90_def_var(nc%id, nc%pe_varname, nc%out_type,& + [ nc%stage_dimid, nc%event_dimid], nc%PE_varid), "fraggle_io_initialize_output nf90_def_var PE_varid" ) + call check( nf90_def_var(nc%id, nc%L_orb_varname, nc%out_type, & + [ nc%space_dimid, nc%stage_dimid, nc%event_dimid], nc%L_orb_varid), "fraggle_io_initialize_output nf90_def_var L_orb_varid" ) + call check( nf90_def_var(nc%id, nc%L_spin_varname, nc%out_type,& + [ nc%space_dimid, nc%stage_dimid, nc%event_dimid], nc%L_spin_varid), "fraggle_io_initialize_output nf90_def_var L_spin_varid" ) + end if call check( nf90_inquire(nc%id, nVariables=nvar), "fraggle_io_initialize nf90_inquire nVariables" ) do varid = 1, nvar @@ -202,16 +203,18 @@ module subroutine fraggle_io_write_frame(self, nc, param) call check( nf90_put_var(nc%id, nc%rot_varid, pl%rot(:,i), start=[1, idslot, stage, eslot], count=[NDIM,1,1,1]), "fraggle_io_write_frame nf90_put_var rotx_varid" ) end do end do - call check( nf90_put_var(nc%id, nc%ke_orb_varid, fragments%ke_orbit_before, start=[ 1, eslot]), "fraggle_io_write_frame nf90_put_var ke_orb_varid before" ) - call check( nf90_put_var(nc%id, nc%ke_orb_varid, fragments%ke_orbit_after, start=[ 2, eslot]), "fraggle_io_write_frame nf90_put_var ke_orb_varid after" ) - call check( nf90_put_var(nc%id, nc%ke_spin_varid, fragments%ke_spin_before, start=[ 1, eslot]), "fraggle_io_write_frame nf90_put_var ke_spin_varid before" ) - call check( nf90_put_var(nc%id, nc%ke_spin_varid, fragments%ke_spin_after, start=[ 2, eslot]), "fraggle_io_write_frame nf90_put_var ke_spin_varid after" ) - call check( nf90_put_var(nc%id, nc%pe_varid, fragments%pe_before, start=[ 1, eslot]), "fraggle_io_write_frame nf90_put_var pe_varid before" ) - call check( nf90_put_var(nc%id, nc%pe_varid, fragments%pe_after, start=[ 2, eslot]), "fraggle_io_write_frame nf90_put_var pe_varid after" ) - call check( nf90_put_var(nc%id, nc%L_orb_varid, fragments%Lorbit_before(:), start=[1, 1, eslot], count=[NDIM, 1, 1]), "fraggle_io_write_frame nf90_put_var L_orb_varid before" ) - call check( nf90_put_var(nc%id, nc%L_orb_varid, fragments%Lorbit_after(:), start=[1, 2, eslot], count=[NDIM, 1, 1]), "fraggle_io_write_frame nf90_put_var L_orb_varid after" ) - call check( nf90_put_var(nc%id, nc%L_spin_varid, fragments%Lspin_before(:), start=[1, 1, eslot], count=[NDIM, 1, 1]), "fraggle_io_write_frame nf90_put_var L_spin_varid before" ) - call check( nf90_put_var(nc%id, nc%L_spin_varid, fragments%Lspin_after(:), start=[1, 2, eslot], count=[NDIM, 1, 1]), "fraggle_io_write_frame nf90_put_var L_spin_varid after" ) + if (param%lenergy) then + call check( nf90_put_var(nc%id, nc%ke_orb_varid, fragments%ke_orbit_before, start=[ 1, eslot]), "fraggle_io_write_frame nf90_put_var ke_orb_varid before" ) + call check( nf90_put_var(nc%id, nc%ke_orb_varid, fragments%ke_orbit_after, start=[ 2, eslot]), "fraggle_io_write_frame nf90_put_var ke_orb_varid after" ) + call check( nf90_put_var(nc%id, nc%ke_spin_varid, fragments%ke_spin_before, start=[ 1, eslot]), "fraggle_io_write_frame nf90_put_var ke_spin_varid before" ) + call check( nf90_put_var(nc%id, nc%ke_spin_varid, fragments%ke_spin_after, start=[ 2, eslot]), "fraggle_io_write_frame nf90_put_var ke_spin_varid after" ) + call check( nf90_put_var(nc%id, nc%pe_varid, fragments%pe_before, start=[ 1, eslot]), "fraggle_io_write_frame nf90_put_var pe_varid before" ) + call check( nf90_put_var(nc%id, nc%pe_varid, fragments%pe_after, start=[ 2, eslot]), "fraggle_io_write_frame nf90_put_var pe_varid after" ) + call check( nf90_put_var(nc%id, nc%L_orb_varid, fragments%Lorbit_before(:), start=[1, 1, eslot], count=[NDIM, 1, 1]), "fraggle_io_write_frame nf90_put_var L_orb_varid before" ) + call check( nf90_put_var(nc%id, nc%L_orb_varid, fragments%Lorbit_after(:), start=[1, 2, eslot], count=[NDIM, 1, 1]), "fraggle_io_write_frame nf90_put_var L_orb_varid after" ) + call check( nf90_put_var(nc%id, nc%L_spin_varid, fragments%Lspin_before(:), start=[1, 1, eslot], count=[NDIM, 1, 1]), "fraggle_io_write_frame nf90_put_var L_spin_varid before" ) + call check( nf90_put_var(nc%id, nc%L_spin_varid, fragments%Lspin_after(:), start=[1, 2, eslot], count=[NDIM, 1, 1]), "fraggle_io_write_frame nf90_put_var L_spin_varid after" ) + end if call check( nf90_set_fill(nc%id, old_mode, old_mode) ) end associate diff --git a/src/modules/symba_classes.f90 b/src/modules/symba_classes.f90 index 1a2c2ef8e..507b16745 100644 --- a/src/modules/symba_classes.f90 +++ b/src/modules/symba_classes.f90 @@ -176,8 +176,6 @@ module symba_classes type, extends(symba_encounter) :: symba_plplenc contains procedure :: extract_collisions => symba_collision_extract_collisions_from_encounters !! Processes the pl-pl encounter list remove only those encounters that led to a collision - procedure :: resolve_fragmentations => symba_resolve_collision_fragmentations !! Process list of collisions, determine the collisional regime, and then create fragments - procedure :: resolve_mergers => symba_resolve_collision_mergers !! Process list of collisions and merge colliding bodies together procedure :: resolve_collision => symba_resolve_collision_plplenc !! Process the pl-pl collision list, then modifiy the massive bodies based on the outcome of the c end type symba_plplenc @@ -232,22 +230,6 @@ module subroutine symba_collision_make_colliders_pl(self,idx) 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_resolve_collision_fragmentations(self, system, param, t) - implicit none - class(symba_plplenc), intent(inout) :: self !! SyMBA pl-pl encounter list - class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object - class(symba_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions - real(DP), intent(in) :: t !! Time of collision - end subroutine symba_resolve_collision_fragmentations - - module subroutine symba_resolve_collision_mergers(self, system, param, t) - implicit none - class(symba_plplenc), intent(inout) :: self !! SyMBA pl-pl encounter list - class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object - class(symba_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions - real(DP), intent(in) :: t !! Time of collision - end subroutine symba_resolve_collision_mergers - module subroutine symba_resolve_collision_plplenc(self, system, param, t, dt, irec) implicit none class(symba_plplenc), intent(inout) :: self !! SyMBA pl-pl encounter list diff --git a/src/symba/symba_collision.f90 b/src/symba/symba_collision.f90 index 52324c5a3..d9808f5cd 100644 --- a/src/symba/symba_collision.f90 +++ b/src/symba/symba_collision.f90 @@ -890,24 +890,24 @@ subroutine symba_collision_mergeaddsub(system, param, t, status) end subroutine symba_collision_mergeaddsub - module subroutine symba_resolve_collision_fragmentations(self, system, param, t) + subroutine symba_resolve_collision(plplcollision_list , system, param, t) !! author: David A. Minton !! !! Process list of collisions, determine the collisional regime, and then create fragments. !! implicit none ! Arguments - class(symba_plplenc), intent(inout) :: self !! SyMBA pl-pl encounter list - class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object - class(symba_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions - real(DP), intent(in) :: t !! Time of collision + class(symba_plplenc), intent(inout) :: plplcollision_list !! SyMBA pl-pl encounter list + class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object + class(symba_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions + real(DP), intent(in) :: t !! Time of collision ! Internals ! Internals integer(I4B), dimension(2) :: idx_parent !! Index of the two bodies considered the "parents" of the collision logical :: lgoodcollision integer(I4B) :: i - associate(plplcollision_list => self, ncollisions => self%nenc, idx1 => self%index1, idx2 => self%index2, collision_history => param%collision_history) + associate(ncollisions => plplcollision_list%nenc, idx1 => plplcollision_list%index1, idx2 => plplcollision_list%index2, collision_history => param%collision_history) select type(pl => system%pl) class is (symba_pl) select type (cb => system%cb) @@ -920,7 +920,19 @@ module subroutine symba_resolve_collision_fragmentations(self, system, param, t) lgoodcollision = symba_collision_consolidate_colliders(pl, cb, param, idx_parent, system%colliders) if ((.not. lgoodcollision) .or. any(pl%status(idx_parent(:)) /= COLLISION)) cycle - call system%colliders%regime(system%fragments, system, param) + if (param%lfragmentation) then + call system%colliders%regime(system%fragments, system, param) + else + associate(fragments => system%fragments, colliders => system%colliders) + fragments%regime = COLLRESOLVE_REGIME_MERGE + fragments%mtot = sum(colliders%mass(:)) + fragments%mass_dist(1) = fragments%mtot + fragments%mass_dist(2) = 0.0_DP + fragments%mass_dist(3) = 0.0_DP + fragments%rbcom(:) = (colliders%mass(1) * colliders%rb(:,1) + colliders%mass(2) * colliders%rb(:,2)) / fragments%mtot + fragments%vbcom(:) = (colliders%mass(1) * colliders%vb(:,1) + colliders%mass(2) * colliders%vb(:,2)) / fragments%mtot + end associate + end if if (param%lenc_save_trajectory) call collision_history%take_snapshot(param,system, t, "before") select case (system%fragments%regime) @@ -942,52 +954,7 @@ module subroutine symba_resolve_collision_fragmentations(self, system, param, t) end associate return - end subroutine symba_resolve_collision_fragmentations - - - module subroutine symba_resolve_collision_mergers(self, system, param, t) - !! author: David A. Minton - !! - !! Process list of collisions and merge colliding bodies together. - !! - implicit none - ! Arguments - class(symba_plplenc), intent(inout) :: self !! SyMBA pl-pl encounter list - class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object - class(symba_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions - real(DP), intent(in) :: t !! Time of collision - ! Internals - integer(I4B), dimension(2) :: idx_parent !! Index of the two bodies considered the "parents" of the collision - logical :: lgoodcollision - integer(I4B) :: i - - associate(plplcollision_list => self, ncollisions => self%nenc, idx1 => self%index1, idx2 => self%index2, fragments => system%fragments, colliders => system%colliders) - select type(pl => system%pl) - class is (symba_pl) - select type(cb => system%cb) - class is (symba_cb) - do i = 1, ncollisions - idx_parent(1) = pl%kin(idx1(i))%parent - idx_parent(2) = pl%kin(idx2(i))%parent - lgoodcollision = symba_collision_consolidate_colliders(pl, cb, param, idx_parent, colliders) - if (.not. lgoodcollision) cycle - if (any(pl%status(idx_parent(:)) /= COLLISION)) cycle ! One of these two bodies has already been resolved - - fragments%regime = COLLRESOLVE_REGIME_MERGE - fragments%mtot = sum(colliders%mass(:)) - fragments%mass_dist(1) = fragments%mtot - fragments%mass_dist(2) = 0.0_DP - fragments%mass_dist(3) = 0.0_DP - fragments%rbcom(:) = (colliders%mass(1) * colliders%rb(:,1) + colliders%mass(2) * colliders%rb(:,2)) / fragments%mtot - fragments%vbcom(:) = (colliders%mass(1) * colliders%vb(:,1) + colliders%mass(2) * colliders%vb(:,2)) / fragments%mtot - plplcollision_list%status(i) = symba_collision_casemerge(system, param, t) - end do - end select - end select - end associate - - return - end subroutine symba_resolve_collision_mergers + end subroutine symba_resolve_collision module subroutine symba_resolve_collision_plplenc(self, system, param, t, dt, irec) @@ -1035,11 +1002,8 @@ module subroutine symba_resolve_collision_plplenc(self, system, param, t, dt, ir call io_log_one_message(FRAGGLE_LOG_OUT, "***********************************************************" // & "***********************************************************") allocate(tmp_param, source=param) - if (param%lfragmentation) then - call plplcollision_list%resolve_fragmentations(system, param, t) - else - call plplcollision_list%resolve_mergers(system, param, t) - end if + + call symba_resolve_collision(plplcollision_list, system, param, t) ! Destroy the collision list now that the collisions are resolved call plplcollision_list%setup(0_I8B) From d556d8a337b1982ae5b83a0f520bac48b53ecfa7 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Wed, 14 Dec 2022 12:44:47 -0500 Subject: [PATCH 422/569] Fixed a bunch of issues to get energy values computed in mergers --- src/fraggle/fraggle_set.f90 | 5 +++-- src/modules/fraggle_classes.f90 | 12 ++++++------ src/symba/symba_collision.f90 | 20 +++++++++++--------- 3 files changed, 20 insertions(+), 17 deletions(-) diff --git a/src/fraggle/fraggle_set.f90 b/src/fraggle/fraggle_set.f90 index dfa0f64e6..a8e61130d 100644 --- a/src/fraggle/fraggle_set.f90 +++ b/src/fraggle/fraggle_set.f90 @@ -287,7 +287,6 @@ module subroutine fraggle_set_original_scale_factors(self, colliders) do i = 1, 2 colliders%rot(:,i) = colliders%L_spin(:,i) * (colliders%mass(i) * colliders%radius(i)**2 * colliders%Ip(3, i)) end do - frag%Qloss = frag%Qloss * frag%Escale frag%mtot = frag%mtot * frag%mscale frag%mass = frag%mass * frag%mscale @@ -300,7 +299,9 @@ module subroutine fraggle_set_original_scale_factors(self, colliders) frag%rb(:, i) = frag%x_coll(:, i) + frag%rbcom(:) frag%vb(:, i) = frag%v_coll(:, i) + frag%vbcom(:) end do - + + frag%Qloss = frag%Qloss * frag%Escale + frag%Lorbit_before(:) = frag%Lorbit_before * frag%Lscale frag%Lspin_before(:) = frag%Lspin_before * frag%Lscale frag%Ltot_before(:) = frag%Ltot_before * frag%Lscale diff --git a/src/modules/fraggle_classes.f90 b/src/modules/fraggle_classes.f90 index 00b791f71..8f6cd4310 100644 --- a/src/modules/fraggle_classes.f90 +++ b/src/modules/fraggle_classes.f90 @@ -86,12 +86,12 @@ module fraggle_classes real(DP) :: Etot_before, Etot_after !! Before/after total system energy ! Scale factors used to scale dimensioned quantities to a more "natural" system where important quantities (like kinetic energy, momentum) are of order ~1 - real(DP) :: dscale !! Distance dimension scale factor - real(DP) :: mscale !! Mass scale factor - real(DP) :: tscale !! Time scale factor - real(DP) :: vscale !! Velocity scale factor (a convenience unit that is derived from dscale and tscale) - real(DP) :: Escale !! Energy scale factor (a convenience unit that is derived from dscale, tscale, and mscale) - real(DP) :: Lscale !! Angular momentum scale factor (a convenience unit that is derived from dscale, tscale, and mscale) + real(DP) :: dscale = 1.0_DP !! Distance dimension scale factor + real(DP) :: mscale = 1.0_DP !! Mass scale factor + real(DP) :: tscale = 1.0_DP !! Time scale factor + real(DP) :: vscale = 1.0_DP !! Velocity scale factor (a convenience unit that is derived from dscale and tscale) + real(DP) :: Escale = 1.0_DP !! Energy scale factor (a convenience unit that is derived from dscale, tscale, and mscale) + real(DP) :: Lscale = 1.0_DP !! Angular momentum scale factor (a convenience unit that is derived from dscale, tscale, and mscale) contains procedure :: generate_fragments => fraggle_generate_fragments !! Generates a system of fragments in barycentric coordinates that conserves energy and momentum. procedure :: accel => fraggle_placeholder_accel !! Placeholder subroutine to fulfill requirement for an accel method diff --git a/src/symba/symba_collision.f90 b/src/symba/symba_collision.f90 index d9808f5cd..c6ad292c4 100644 --- a/src/symba/symba_collision.f90 +++ b/src/symba/symba_collision.f90 @@ -185,6 +185,10 @@ module function symba_collision_casemerge(system, param, t) result(status) class is (symba_pl) call fragments%set_mass_dist(colliders, param) + + ! Calculate the initial energy of the system without the collisional family + call fragments%get_energy_and_momentum(colliders, system, param, lbefore=.true.) + ibiggest = colliders%idx(maxloc(pl%Gmass(colliders%idx(:)), dim=1)) fragments%id(1) = pl%id(ibiggest) fragments%rb(:,1) = fragments%rbcom(:) @@ -197,18 +201,16 @@ module function symba_collision_casemerge(system, param, t) result(status) ! Assume prinicpal axis rotation on 3rd Ip axis fragments%rot(:,1) = L_spin_new(:) / (fragments%Ip(3,1) * fragments%mass(1) * fragments%radius(1)**2) else ! If spin is not enabled, we will consider the lost pre-collision angular momentum as "escaped" and add it to our bookkeeping variable - param%Lescape(:) = param%Lescape(:) + colliders%L_orbit(:,1) + colliders%L_orbit(:,2) + system%Lescape(:) = system%Lescape(:) + colliders%L_orbit(:,1) + colliders%L_orbit(:,2) end if ! Keep track of the component of potential energy due to the pre-impact colliders%idx for book-keeping - pe = 0.0_DP - do j = 1, colliders%ncoll - do i = j + 1, colliders%ncoll - pe = pe - pl%Gmass(i) * pl%mass(j) / norm2(pl%rb(:, i) - pl%rb(:, j)) - end do - end do - system%Ecollisions = system%Ecollisions + pe - system%Euntracked = system%Euntracked - pe + ! Get the energy of the system after the collision + call fragments%get_energy_and_momentum(colliders, system, param, lbefore=.false.) + pe = fragments%pe_after - fragments%pe_before + system%Ecollisions = system%Ecollisions - pe + system%Euntracked = system%Euntracked + pe + ! Update any encounter lists that have the removed bodies in them so that they instead point to the new do k = 1, system%plplenc_list%nenc From 1c252ba86e851c01cb5a601fe8a117ba4c61646f Mon Sep 17 00:00:00 2001 From: David A Minton Date: Wed, 14 Dec 2022 12:55:09 -0500 Subject: [PATCH 423/569] Got correct time value into collision snapshot history files --- src/encounter/encounter_util.f90 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/encounter/encounter_util.f90 b/src/encounter/encounter_util.f90 index 9a1be2901..9d9c97f11 100644 --- a/src/encounter/encounter_util.f90 +++ b/src/encounter/encounter_util.f90 @@ -448,7 +448,7 @@ subroutine encounter_util_save_collision(collision_history, snapshot) end subroutine encounter_util_save_collision - subroutine encounter_util_save_encounter(encounter_history, snapshot, t) + subroutine encounter_util_save_encounter(encounter_history, snapshot) !! author: David A. Minton !! !! Checks the current size of the encounter storage against the required size and extends it by a factor of 2 more than requested if it is too small. @@ -459,7 +459,6 @@ subroutine encounter_util_save_encounter(encounter_history, snapshot, t) ! Arguments type(encounter_storage(*)), allocatable, intent(inout) :: encounter_history !! SyMBA encounter storage object class(encounter_snapshot), intent(in) :: snapshot !! Encounter snapshot object - real(DP), intent(in) :: t !! The time of the snapshot ! Internals type(encounter_storage(nframes=:)), allocatable :: tmp integer(I4B) :: i, nnew, nold, nbig @@ -542,6 +541,7 @@ module subroutine encounter_util_snapshot_collision(self, param, system, t, arg) allocate(fraggle_snapshot :: snapshot) allocate(snapshot%colliders, source=system%colliders) allocate(snapshot%fragments, source=system%fragments) + snapshot%t = t select type(param) class is (symba_parameters) call encounter_util_save_collision(param%collision_history,snapshot) @@ -663,7 +663,7 @@ module subroutine encounter_util_snapshot_encounter(self, param, system, t, arg) ! Save the snapshot param%encounter_history%nid = param%encounter_history%nid + ntp_snap + npl_snap - call encounter_util_save_encounter(param%encounter_history,snapshot,t) + call encounter_util_save_encounter(param%encounter_history,snapshot) case("closest") associate(plplenc_list => system%plplenc_list, pltpenc_list => system%pltpenc_list) if (any(plplenc_list%lclosest(:))) then @@ -722,7 +722,7 @@ module subroutine encounter_util_snapshot_encounter(self, param, system, t, arg) pl_snap%vh(:,2) = vb(:,2) + vcom(:) call pl_snap%sort("id", ascending=.true.) - call encounter_util_save_encounter(param%encounter_history,snapshot,snapshot%t) + call encounter_util_save_encounter(param%encounter_history,snapshot) end if end do From 79f359f0e790d77dd161354a12396ef9ede9e854 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Wed, 14 Dec 2022 13:46:42 -0500 Subject: [PATCH 424/569] Fixed hit and run initial conditions --- examples/Fragmentation/Fragmentation_Movie.py | 29 ++++++++++--------- 1 file changed, 16 insertions(+), 13 deletions(-) diff --git a/examples/Fragmentation/Fragmentation_Movie.py b/examples/Fragmentation/Fragmentation_Movie.py index 43822bf25..cdfe03c06 100644 --- a/examples/Fragmentation/Fragmentation_Movie.py +++ b/examples/Fragmentation/Fragmentation_Movie.py @@ -41,12 +41,13 @@ movie_titles = dict(zip(available_movie_styles, movie_title_list)) # These initial conditions were generated by trial and error +names = ["Target","Projectile"] pos_vectors = {"disruption_headon" : [np.array([1.0, -5.0e-05, 0.0]), np.array([1.0, 5.0e-05 ,0.0])], - "supercatastrophic_off_axis": [np.array([1.0, -5.0e-05, 0.0]), - np.array([1.0, 5.0e-05, 0.0])], - "hitandrun" : [np.array([1.0, -2.0e-05, 0.0]), - np.array([0.999999, 2.0e-05, 0.0])] + "supercatastrophic_off_axis": [np.array([1.0, -5.0e-05, 0.0]), + np.array([1.0, 5.0e-05, 0.0])], + "hitandrun" : [np.array([1.0, -4.2e-05, 0.0]), + np.array([1.0, 4.2e-05, 0.0])] } vel_vectors = {"disruption_headon" : [np.array([-2.562596e-04, 6.280005, 0.0]), @@ -54,7 +55,7 @@ "supercatastrophic_off_axis": [np.array([0.0, 6.28, 0.0]), np.array([0.5, -6.28, 0.0])], "hitandrun" : [np.array([0.0, 6.28, 0.0]), - np.array([-0.9, -6.28, 0.0])] + np.array([-1.5, -6.28, 0.00])] } rot_vectors = {"disruption_headon" : [np.array([0.0, 0.0, 0.0]), @@ -67,7 +68,7 @@ body_Gmass = {"disruption_headon" : [1e-7, 1e-10], "supercatastrophic_off_axis": [1e-7, 1e-8], - "hitandrun" : [1e-7, 1e-10] + "hitandrun" : [1e-7, 7e-10] } density = 3000 * swiftest.AU2M**3 / swiftest.MSun @@ -76,6 +77,8 @@ for k,v in body_Gmass.items(): body_radius[k] = [((Gmass/GU)/(4./3.*np.pi*density))**(1./3.) for Gmass in v] +body_radius["hitandrun"] = [7e-6, 3.25e-6] + # ---------------------------------------------------------------------------------------------------------------------- # Define the animation class that will generate the movies of the fragmentation outcomes # ---------------------------------------------------------------------------------------------------------------------- @@ -134,8 +137,8 @@ def setup_plot(self): # Calculate the distance along the y-axis between the colliding bodies at the start of the simulation. # This will be used to scale the axis limits on the movie. - rhy1 = self.ds['rh'].sel(name="Body1",space='y').isel(time=0).values[()] - rhy2 = self.ds['rh'].sel(name="Body2",space='y').isel(time=0).values[()] + rhy1 = self.ds['rh'].sel(name="Target",space='y').isel(time=0).values[()] + rhy2 = self.ds['rh'].sel(name="Projectile",space='y').isel(time=0).values[()] scale_frame = abs(rhy1) + abs(rhy2) ax = plt.Axes(fig, [0.1, 0.1, 0.8, 0.8]) @@ -188,18 +191,18 @@ def data_stream(self, frame=0): user_selection = int(input("? ")) if user_selection > 0 and user_selection < 4: - movie_styles = [available_movie_styles[user_selection-1]] + movie_styles = [available_movie_styles[user_selection-1]] else: - print("Generating all movie styles") - movie_styles = available_movie_styles.copy() + print("Generating all movie styles") + movie_styles = available_movie_styles.copy() for style in movie_styles: movie_filename = f"{style}.mp4" # Pull in the Swiftest output data from the parameter file and store it as a Xarray dataset. sim = swiftest.Simulation(simdir=style, rotation=True, init_cond_format = "XV", compute_conservation_values=True) sim.add_solar_system_body("Sun") - sim.add_body(Gmass=body_Gmass[style], radius=body_radius[style], rh=pos_vectors[style], vh=vel_vectors[style]) #, rot=rot_vectors[style]) - # + sim.add_body(name=names, Gmass=body_Gmass[style], radius=body_radius[style], rh=pos_vectors[style], vh=vel_vectors[style]) #, rot=rot_vectors[style]) + # Set fragmentation parameters minimum_fragment_gmass = 0.2 * body_Gmass[style][1] # Make the minimum fragment mass a fraction of the smallest body gmtiny = 0.99 * body_Gmass[style][1] # Make GMTINY just smaller than the smallest original body. This will prevent runaway collisional cascades From 5624f371ae22a1f7bda62bd3c2702ed4da9df476 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Wed, 14 Dec 2022 17:30:36 -0500 Subject: [PATCH 425/569] Made sure not to try to dump the encounter or collision history file if they don't exist because those features are not enabled. --- src/io/io.f90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/io/io.f90 b/src/io/io.f90 index 54f99e42b..79b72bb77 100644 --- a/src/io/io.f90 +++ b/src/io/io.f90 @@ -267,8 +267,8 @@ module subroutine io_dump_system(self, param) ! Dump the encounter history if necessary select type(param) class is (symba_parameters) - call param%encounter_history%dump(param) - call param%collision_history%dump(param) + if (param%lenc_save_trajectory .or. param%lenc_save_closest) call param%encounter_history%dump(param) + if (param%lfragmentation) call param%collision_history%dump(param) end select ! Dump the system history to file From a87ef23ad6c61a5653d6e3a432a7c10d92071bac Mon Sep 17 00:00:00 2001 From: David A Minton Date: Wed, 14 Dec 2022 17:50:58 -0500 Subject: [PATCH 426/569] Added some more code to sanitize inputs to add_body to give it a bit more flexibility in input array shapes --- python/swiftest/swiftest/simulation_class.py | 77 +++++++++++--------- 1 file changed, 41 insertions(+), 36 deletions(-) diff --git a/python/swiftest/swiftest/simulation_class.py b/python/swiftest/swiftest/simulation_class.py index e517e7366..2241ae5c8 100644 --- a/python/swiftest/swiftest/simulation_class.py +++ b/python/swiftest/swiftest/simulation_class.py @@ -2259,14 +2259,14 @@ def _get_instance_var(self, arg_list: str | List[str], valid_arg: Dict, verbose: Parameters ---------- arg_list: str | List[str] - A single string or list of strings containing the names of the the instance variable to get. + A single string or list of strings containing the names of the the instance variable to get. valid_arg: dict - A dictionary where the key is the parameter argument and the value is the equivalent instance variable value. + A dictionary where the key is the parameter argument and the value is the equivalent instance variable value. verbose: bool, optional - If passed, it will override the Simulation object's verbose flag + If passed, it will override the Simulation object's verbose flag **kwargs - A dictionary of additional keyword argument. This allows this method to be called by the more general - get_parameter method, which takes all possible Simulation parameters as arguments, so these are ignored. + A dictionary of additional keyword argument. This allows this method to be called by the more general + get_parameter method, which takes all possible Simulation parameters as arguments, so these are ignored. Returns ------- @@ -2315,45 +2315,43 @@ def add_body(self, Parameters ---------- name : str or array-like of str, optional - Name or names of Bodies. If none passed, name will be "Body" + Name or names of Bodies. If none passed, name will be "Body" id : int or array-like of int, optional - Unique id values. If not passed, an id will be assigned in ascending order starting from the pre-existing - Dataset ids. + 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" + semimajor axis for param['IN_FORM'] == "EL" e : float or array-like of float, optional - eccentricity for param['IN_FORM'] == "EL" + eccentricity for param['IN_FORM'] == "EL" inc : float or array-like of float, optional - inclination for param['IN_FORM'] == "EL" + inclination for param['IN_FORM'] == "EL" capom : float or array-like of float, optional - longitude of ascending node for param['IN_FORM'] == "EL" + longitude of ascending node for param['IN_FORM'] == "EL" omega : float or array-like of float, optional - argument of periapsis for param['IN_FORM'] == "EL" + argument of periapsis for param['IN_FORM'] == "EL" capm : float or array-like of float, optional - mean anomaly for param['IN_FORM'] == "EL" + 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 + Position vector array. 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 + Velocity vector array. mass : float or array-like of float, optional - mass values if these are massive bodies (only one of mass or Gmass can be passed) + mass values if these are massive bodies (only one of mass or Gmass can be passed) Gmass : float or array-like of float, optional - G*mass values if these are massive bodies (only one of mass or Gmass can be passed) + 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 + Radius values if these are massive bodies rhill : float or array-like of float, optional - Hill's radius values if these are massive bodies + Hill's radius values if these are massive bodies rot: (3) or (n,3) array-like of float, optional - Rotation rate vectors if these are massive bodies with rotation enabled. This can be used instead of passing - rotx, roty, and rotz separately + Rotation rate vectors if these are massive bodies with rotation enabled. Ip: (3) or (n,3) array-like of flaot, optional - Principal axes moments of inertia vectors if these are massive bodies with rotation enabled. This can be used - instead of passing Ip1, Ip2, and Ip3 separately + Principal axes moments of inertia vectors if these are massive bodies with rotation enabled. Returns ------- data : Xarray Dataset - Dasaset containing the body or bodies that were added + Dasaset containing the body or bodies that were added """ @@ -2395,18 +2393,25 @@ def input_to_array_3d(val,n=None): val = np.array(val,dtype=np.float64) except: raise ValueError(f"{val} cannot be converted to a numpy array") - if n is None: - if val.dim > 2 or val.dim == 0: - raise ValueError(f"Argument must be an (n,3) array. This one is {val.shape}") - else: - if val.shape[-1] != 3: - raise ValueError(f"Argument must be a 3-dimensional vector. This one has {val.shape[0]}!") - if val.dim == 1: - n = 1 + if n is None: + ndims = len(val.shape) + if ndims > 2 or ndims == 0: + raise ValueError(f"Argument must be an (n,3) or (3,) array. This one is {val.shape}") else: - n = val.shape[0] - elif val.shape != (n,3): - raise ValueError(f"Argument is an incorrect shape. Expected {(n,3)}. Got {val.shape} instead") + if val.shape[-1] != 3: + raise ValueError(f"Argument must be a 3-dimensional vector. This one has {val.shape[0]}!") + if val.dim == 1: + n = 1 + else: + n = val.shape[0] + elif n == 1: + if val.shape != (1,3) and val.shape != (3,): + raise ValueError(f"Argument is an incorrect shape. Expected {(n,3)} or {(3,1)}. Got {val.shape} instead") + elif val.shape != (n,3) or val.shape != (3,n): + raise ValueError(f"Argument is an incorrect shape. Expected {(n,3)} or {(3,n)}. Got {val.shape} instead") + elif val.shape == (3,n): + val = val.T + return val, n nbodies = None From c3583b81a1900602f7a1b49a36e3f3f7d7fd5b40 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Wed, 14 Dec 2022 18:00:29 -0500 Subject: [PATCH 427/569] More help getting (3,) arrays into (1,3) form --- python/swiftest/swiftest/simulation_class.py | 2 ++ 1 file changed, 2 insertions(+) diff --git a/python/swiftest/swiftest/simulation_class.py b/python/swiftest/swiftest/simulation_class.py index 2241ae5c8..169bc1c0c 100644 --- a/python/swiftest/swiftest/simulation_class.py +++ b/python/swiftest/swiftest/simulation_class.py @@ -2407,6 +2407,8 @@ def input_to_array_3d(val,n=None): elif n == 1: if val.shape != (1,3) and val.shape != (3,): raise ValueError(f"Argument is an incorrect shape. Expected {(n,3)} or {(3,1)}. Got {val.shape} instead") + elif val.shape == (3,): + val = np.expand_dims(val,axis=0) elif val.shape != (n,3) or val.shape != (3,n): raise ValueError(f"Argument is an incorrect shape. Expected {(n,3)} or {(3,n)}. Got {val.shape} instead") elif val.shape == (3,n): From b03bd9933b9775f684f9b7c6b253001ed24f82a7 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Wed, 14 Dec 2022 18:00:48 -0500 Subject: [PATCH 428/569] Simplified the swiftest_fragmentation script. Got rid of (some) redundancy --- .../Fragmentation/swiftest_fragmentation.py | 20 ++++++++++--------- 1 file changed, 11 insertions(+), 9 deletions(-) diff --git a/examples/Fragmentation/swiftest_fragmentation.py b/examples/Fragmentation/swiftest_fragmentation.py index 3ee13cb2a..06e968e62 100644 --- a/examples/Fragmentation/swiftest_fragmentation.py +++ b/examples/Fragmentation/swiftest_fragmentation.py @@ -53,31 +53,33 @@ import numpy as np from numpy.random import default_rng +run_arguments = {"tstart": 0.0, "tstop":1e-5, "dt": 1e-5, "istep_out": 1, "fragmentation":True, "minimum_fragment_gmass":1.0e-11, "gmtiny":1.0e-11, "output_format":"XVEL", "init_cond_format":"XV"} + # Initialize the simulation object as a variable with arguments. -sim_disruption = swiftest.Simulation(simdir="disruption", tstart=0.0, tstop=1.0e-5, dt=1.0e-8, istep_out=1.0, fragmentation=True, minimum_fragment_gmass=1.0e-11, gmtiny=1.0e-11, output_format="XVEL", init_cond_format="XV") +sim_disruption = swiftest.Simulation(simdir="disruption", **run_arguments) # Add the Sun using the JPL Horizons Database. sim_disruption.add_solar_system_body(["Sun"]) # Add a user-defined target body. -sim_disruption.add_body(name="Target", rh=[[1.0, -1.807993e-05, 0.0]], vh=[[-2.562596e-04, 6.280005, 0.0]], Gmass=1e-7, radius=7e-6, rhill=9e-4, Ip=[[0.4, 0.4, 0.4]], rot=[[0.0, 0.0, 0.0]]) +sim_disruption.add_body(name="Target", rh=[1.0, -1.807993e-05, 0.0], vh=[-2.562596e-04, 6.280005, 0.0], Gmass=1e-7, radius=7e-6) # Add a user-defined projectile body. -sim_disruption.add_body(name="Projectile", rh=[[1.0, 1.807993e-05, 0.0]], vh=[[-2.562596e-04, -6.280005, 0.0]], Gmass=7e-10, radius=3.25e-6, rhill=4e-4, Ip=[[0.4, 0.4, 0.4]], rot=[[0.0, 0.0, 0.0]]) +sim_disruption.add_body(name="Projectile", rh=[1.0, 1.807993e-05, 0.0], vh=[-2.562596e-04, -6.280005, 0.0], Gmass=7e-10, radius=3.25e-6) # Display the run configuration parameters. sim_disruption.get_parameter() # Run the simulation. sim_disruption.run() # Do the same as above for the hit and run case. -sim_hitandrun = swiftest.Simulation(simdir="hitandrun", tstart=0.0, tstop=1.0e-5, dt=1.0e-8, istep_out=1.0, fragmentation=True, minimum_fragment_gmass=1.0e-11, gmtiny=1.0e-11, output_format="XVEL", init_cond_format="XV") +sim_hitandrun = swiftest.Simulation(simdir="hitandrun", **run_arguments) sim_hitandrun.add_solar_system_body(["Sun"]) -sim_hitandrun.add_body(name="Target", rh=[[1.0, -4.2e-05, 0.0]], vh=[[0.0, 6.28, 0.0]], Gmass=1e-7, radius=7e-6, rhill=9e-4, Ip=[[0.4, 0.4, 0.4]], rot=[[0.0, 0.0, 6.0e4]]) -sim_hitandrun.add_body(name="Projectile", rh=[[1.0, 4.2e-05, 0.0]], vh=[[-1.5, -6.28, 0.0]], Gmass=7e-10, radius=3.25e-6, rhill=4e-4, Ip=[[0.4, 0.4, 0.4]], rot=[[0.0, 0.0, 1.0e5]]) +sim_hitandrun.add_body(name="Target", rh=[1.0, -4.2e-05, 0.0], vh=[[0.0, 6.28, 0.0]], Gmass=1e-7, radius=7e-6, rot=[0.0, 0.0, 6.0e4]) +sim_hitandrun.add_body(name="Projectile", rh=[1.0, 4.2e-05, 0.0], vh=[-1.5, -6.28, 0.0], Gmass=7e-10, radius=3.25e-6, rot=[0.0, 0.0, 1.0e5]) sim_hitandrun.get_parameter() sim_hitandrun.run() # Do the same as above for the super-catastrophic disruption case. -sim_supercat = swiftest.Simulation(simdir="supercat", tstart=0.0, tstop=1.0e-5, dt=1.0e-8, istep_out=1.0, fragmentation=True, minimum_fragment_gmass=1.0e-11, gmtiny=1.0e-11, output_format="XVEL", init_cond_format="XV") +sim_supercat = swiftest.Simulation(simdir="supercat", **run_arguments) sim_supercat.add_solar_system_body(["Sun"]) -sim_supercat.add_body(name="Target", rh=[[1.0, -4.2e-05, 0.0]], vh=[[0.0, 6.28, 0.0]], Gmass=1e-7, radius=7e-6, rhill=9e-4, Ip=[[0.4, 0.4, 0.4]], rot=[[0.0, 0.0, -6.0e4]]) -sim_supercat.add_body(name="Projectile", rh=[[1.0, 4.2e-05, 0.0]], vh=[[1.0, -6.28, 0.0]], Gmass=1e-8, radius=3.25e-6, rhill=4e-4, Ip=[[0.4, 0.4, 0.4]], rot=[[0.0, 0.0, 1.0e5]]) +sim_supercat.add_body(name="Target", rh=[1.0, -4.2e-05, 0.0], vh=[0.0, 6.28, 0.0], Gmass=1e-7, radius=7e-6, rot=[0.0, 0.0, -6.0e4]) +sim_supercat.add_body(name="Projectile", rh=[1.0, 4.2e-05, 0.0], vh=[1.0, -6.28, 0.0], Gmass=1e-8, radius=3.25e-6, rot=[0.0, 0.0, 1.0e5]) sim_supercat.get_parameter() sim_supercat.run() From cfe545da6c13c2e2f9c360d94920053660c045e9 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Wed, 14 Dec 2022 18:10:28 -0500 Subject: [PATCH 429/569] Got rid of flag that turns of collision tracking when encounter tracking is turned off. --- src/symba/symba_collision.f90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/symba/symba_collision.f90 b/src/symba/symba_collision.f90 index c6ad292c4..d7542d854 100644 --- a/src/symba/symba_collision.f90 +++ b/src/symba/symba_collision.f90 @@ -936,7 +936,7 @@ subroutine symba_resolve_collision(plplcollision_list , system, param, t) end associate end if - if (param%lenc_save_trajectory) call collision_history%take_snapshot(param,system, t, "before") + call collision_history%take_snapshot(param,system, t, "before") select case (system%fragments%regime) case (COLLRESOLVE_REGIME_DISRUPTION, COLLRESOLVE_REGIME_SUPERCATASTROPHIC) plplcollision_list%status(i) = symba_collision_casedisruption(system, param, t) @@ -948,7 +948,7 @@ subroutine symba_resolve_collision(plplcollision_list , system, param, t) write(*,*) "Error in symba_collision, unrecognized collision regime" call util_exit(FAILURE) end select - if (param%lenc_save_trajectory) call collision_history%take_snapshot(param,system, t, "after") + call collision_history%take_snapshot(param,system, t, "after") deallocate(system%colliders,system%fragments) end do end select From 27a2d524a90c009fed665a7f263aa6fd8f7e860f Mon Sep 17 00:00:00 2001 From: David A Minton Date: Wed, 14 Dec 2022 18:12:29 -0500 Subject: [PATCH 430/569] turn encounter tracking on for the swiftest_fragmentation script --- examples/Fragmentation/swiftest_fragmentation.py | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/examples/Fragmentation/swiftest_fragmentation.py b/examples/Fragmentation/swiftest_fragmentation.py index 06e968e62..4298f9580 100644 --- a/examples/Fragmentation/swiftest_fragmentation.py +++ b/examples/Fragmentation/swiftest_fragmentation.py @@ -53,7 +53,7 @@ import numpy as np from numpy.random import default_rng -run_arguments = {"tstart": 0.0, "tstop":1e-5, "dt": 1e-5, "istep_out": 1, "fragmentation":True, "minimum_fragment_gmass":1.0e-11, "gmtiny":1.0e-11, "output_format":"XVEL", "init_cond_format":"XV"} +run_arguments = {"tstart": 0.0, "tstop":1e-5, "dt": 1e-5, "istep_out": 1, "fragmentation":True, "encounter_save":"both", "minimum_fragment_gmass":1.0e-11, "gmtiny":1.0e-11, "output_format":"XVEL", "init_cond_format":"XV"} # Initialize the simulation object as a variable with arguments. sim_disruption = swiftest.Simulation(simdir="disruption", **run_arguments) From d20f5584f8552807dd3ef6e67987c77049a55aeb Mon Sep 17 00:00:00 2001 From: David A Minton Date: Wed, 14 Dec 2022 18:18:44 -0500 Subject: [PATCH 431/569] Ensured that collision tracking is always turned on in SyMBA --- src/io/io.f90 | 2 +- src/setup/setup.f90 | 20 +++++++++----------- 2 files changed, 10 insertions(+), 12 deletions(-) diff --git a/src/io/io.f90 b/src/io/io.f90 index 79b72bb77..1f7852ea2 100644 --- a/src/io/io.f90 +++ b/src/io/io.f90 @@ -268,7 +268,7 @@ module subroutine io_dump_system(self, param) select type(param) class is (symba_parameters) if (param%lenc_save_trajectory .or. param%lenc_save_closest) call param%encounter_history%dump(param) - if (param%lfragmentation) call param%collision_history%dump(param) + call param%collision_history%dump(param) end select ! Dump the system history to file diff --git a/src/setup/setup.f90 b/src/setup/setup.f90 index 57679f622..c9ff0dc7d 100644 --- a/src/setup/setup.f90 +++ b/src/setup/setup.f90 @@ -87,17 +87,15 @@ module subroutine setup_construct_system(system, param) end associate end if - if (param%lclose) then - allocate(collision_storage :: param%collision_history) - associate (collision_history => param%collision_history) - allocate(fraggle_io_parameters :: collision_history%nc) - call collision_history%reset() - select type(nc => collision_history%nc) - class is (fraggle_io_parameters) - nc%file_number = param%iloop / param%dump_cadence - end select - end associate - end if + allocate(collision_storage :: param%collision_history) + associate (collision_history => param%collision_history) + allocate(fraggle_io_parameters :: collision_history%nc) + call collision_history%reset() + select type(nc => collision_history%nc) + class is (fraggle_io_parameters) + nc%file_number = param%iloop / param%dump_cadence + end select + end associate end select end select From 71211953e635f7bdfb210d86e395b06331916755 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Wed, 14 Dec 2022 18:35:24 -0500 Subject: [PATCH 432/569] Fixed typo --- python/swiftest/swiftest/simulation_class.py | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/python/swiftest/swiftest/simulation_class.py b/python/swiftest/swiftest/simulation_class.py index 169bc1c0c..9666ca298 100644 --- a/python/swiftest/swiftest/simulation_class.py +++ b/python/swiftest/swiftest/simulation_class.py @@ -2409,7 +2409,7 @@ def input_to_array_3d(val,n=None): raise ValueError(f"Argument is an incorrect shape. Expected {(n,3)} or {(3,1)}. Got {val.shape} instead") elif val.shape == (3,): val = np.expand_dims(val,axis=0) - elif val.shape != (n,3) or val.shape != (3,n): + elif val.shape != (n,3) and val.shape != (3,n): raise ValueError(f"Argument is an incorrect shape. Expected {(n,3)} or {(3,n)}. Got {val.shape} instead") elif val.shape == (3,n): val = val.T From e8762737f3b83b9f25cdc59f9cae2884fe609a93 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Wed, 14 Dec 2022 18:39:24 -0500 Subject: [PATCH 433/569] Turned conservation reporting on and rotation back on in the two frag scripts --- examples/Fragmentation/Fragmentation_Movie.py | 2 +- examples/Fragmentation/swiftest_fragmentation.py | 3 ++- 2 files changed, 3 insertions(+), 2 deletions(-) diff --git a/examples/Fragmentation/Fragmentation_Movie.py b/examples/Fragmentation/Fragmentation_Movie.py index cdfe03c06..dc443eccc 100644 --- a/examples/Fragmentation/Fragmentation_Movie.py +++ b/examples/Fragmentation/Fragmentation_Movie.py @@ -201,7 +201,7 @@ def data_stream(self, frame=0): # Pull in the Swiftest output data from the parameter file and store it as a Xarray dataset. sim = swiftest.Simulation(simdir=style, rotation=True, init_cond_format = "XV", compute_conservation_values=True) sim.add_solar_system_body("Sun") - sim.add_body(name=names, Gmass=body_Gmass[style], radius=body_radius[style], rh=pos_vectors[style], vh=vel_vectors[style]) #, rot=rot_vectors[style]) + sim.add_body(name=names, Gmass=body_Gmass[style], radius=body_radius[style], rh=pos_vectors[style], vh=vel_vectors[style], rot=rot_vectors[style]) # Set fragmentation parameters minimum_fragment_gmass = 0.2 * body_Gmass[style][1] # Make the minimum fragment mass a fraction of the smallest body diff --git a/examples/Fragmentation/swiftest_fragmentation.py b/examples/Fragmentation/swiftest_fragmentation.py index 4298f9580..e5a518896 100644 --- a/examples/Fragmentation/swiftest_fragmentation.py +++ b/examples/Fragmentation/swiftest_fragmentation.py @@ -53,7 +53,8 @@ import numpy as np from numpy.random import default_rng -run_arguments = {"tstart": 0.0, "tstop":1e-5, "dt": 1e-5, "istep_out": 1, "fragmentation":True, "encounter_save":"both", "minimum_fragment_gmass":1.0e-11, "gmtiny":1.0e-11, "output_format":"XVEL", "init_cond_format":"XV"} +run_arguments = {"tstart": 0.0, "tstop":1e-5, "dt": 1e-5, "istep_out": 1, "fragmentation":True, "encounter_save":"both", "compute_conservation_values":True, + "minimum_fragment_gmass":1.0e-11, "gmtiny":1.0e-11, "output_format":"XVEL", "init_cond_format":"XV"} # Initialize the simulation object as a variable with arguments. sim_disruption = swiftest.Simulation(simdir="disruption", **run_arguments) From caf03004d53072a920dd2ad446b30944e2483018 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Thu, 15 Dec 2022 06:46:45 -0500 Subject: [PATCH 434/569] Tweaked Fraggle so that disruption fragments act like ejecta and fly away from the impact point --- src/fraggle/fraggle_generate.f90 | 16 ++++++++++++---- src/fraggle/fraggle_regime.f90 | 7 ++++++- src/fraggle/fraggle_set.f90 | 9 +++++++-- src/fraggle/fraggle_util.f90 | 4 ++-- src/modules/fraggle_classes.f90 | 1 + src/symba/symba_collision.f90 | 18 ++++++++++++++---- 6 files changed, 42 insertions(+), 13 deletions(-) diff --git a/src/fraggle/fraggle_generate.f90 b/src/fraggle/fraggle_generate.f90 index 8253fb12a..54b431287 100644 --- a/src/fraggle/fraggle_generate.f90 +++ b/src/fraggle/fraggle_generate.f90 @@ -72,7 +72,7 @@ module subroutine fraggle_generate_fragments(self, colliders, system, param, lfa call frag%get_energy_and_momentum(colliders, system, param, lbefore=.true.) ! Start out the fragments close to the initial separation distance. This will be increased if there is any overlap or we fail to find a solution - r_max_start = 1 * norm2(colliders%rb(:,2) - colliders%rb(:,1)) + r_max_start = 2 * norm2(colliders%rb(:,2) - colliders%rb(:,1)) lfailure = .false. try = 1 do while (try < MAXTRY) @@ -177,8 +177,10 @@ subroutine fraggle_generate_pos_vec(frag, colliders, r_max_start) real(DP), intent(in) :: r_max_start !! Initial guess for the starting maximum radial distance of fragments ! Internals real(DP) :: dis, rad, r_max + real(DP), dimension(NDIM) :: runit logical, dimension(:), allocatable :: loverlap integer(I4B) :: i, j + logical :: lfixdir associate(nfrag => frag%nbody) allocate(loverlap(nfrag)) @@ -188,9 +190,13 @@ subroutine fraggle_generate_pos_vec(frag, colliders, r_max_start) r_max = r_max_start rad = sum(colliders%radius(:)) + lfixdir = (frag%regime /= COLLRESOLVE_REGIME_SUPERCATASTROPHIC) ! For this style of impact, make the fragments act like eject and point away from the impact point + + runit(:) = colliders%rb(:,2) - colliders%rb(:,1) + runit(:) = runit(:) / (.mag. runit(:)) + ! We will treat the first two fragments of the list as special cases. They get initialized the maximum distances apart along the original impactor distance vector. ! This is done because in a regular disruption, the first body is the largest, the second the second largest, and the rest are smaller equal-mass fragments. - call random_number(frag%x_coll(:,3:nfrag)) loverlap(:) = .true. do while (any(loverlap(3:nfrag))) @@ -201,6 +207,8 @@ subroutine fraggle_generate_pos_vec(frag, colliders, r_max_start) if (loverlap(i)) then call random_number(frag%x_coll(:,i)) frag%x_coll(:, i) = 2 * (frag%x_coll(:, i) - 0.5_DP) * r_max + frag%x_coll(:, i) = frag%x_coll(:, i) + (frag%rbimp(:) - frag%rbcom(:)) ! Shift the center of the fragment cloud to the impact point rather than the CoM + if (lfixdir .and. dot_product(frag%x_coll(:,i), runit(:)) < 0.0_DP) frag%x_coll(:, i) = -frag%x_coll(:, i) ! Make sure the fragment cloud points away from the impact point end if end do loverlap(:) = .false. @@ -214,12 +222,12 @@ subroutine fraggle_generate_pos_vec(frag, colliders, r_max_start) call fraggle_util_shift_vector_to_origin(frag%mass, frag%x_coll) call frag%set_coordinate_system(colliders) - do i = 1, nfrag + do concurrent(i = 1:nfrag) frag%rb(:,i) = frag%x_coll(:,i) + frag%rbcom(:) end do frag%rbcom(:) = 0.0_DP - do i = 1, nfrag + do concurrent(i = 1:nfrag) frag%rbcom(:) = frag%rbcom(:) + frag%mass(i) * frag%rb(:,i) end do frag%rbcom(:) = frag%rbcom(:) / frag%mtot diff --git a/src/fraggle/fraggle_regime.f90 b/src/fraggle/fraggle_regime.f90 index 7b3191149..7962e6c25 100644 --- a/src/fraggle/fraggle_regime.f90 +++ b/src/fraggle/fraggle_regime.f90 @@ -27,7 +27,7 @@ module subroutine fraggle_regime_colliders(self, frag, system, param) integer(I4B) :: jtarg, jproj real(DP), dimension(2) :: radius_si, mass_si, density_si real(DP) :: min_mfrag_si, Mcb_si - real(DP), dimension(NDIM) :: x1_si, v1_si, x2_si, v2_si + real(DP), dimension(NDIM) :: x1_si, v1_si, x2_si, v2_si, runit real(DP) :: mlr, mslr, mtot, dentot associate(colliders => self) @@ -71,6 +71,11 @@ module subroutine fraggle_regime_colliders(self, frag, system, param) frag%rbcom(:) = (colliders%mass(1) * colliders%rb(:,1) + colliders%mass(2) * colliders%rb(:,2)) / frag%mtot frag%vbcom(:) = (colliders%mass(1) * colliders%vb(:,1) + colliders%mass(2) * colliders%vb(:,2)) / frag%mtot + ! Find the point of impact between the two bodies + runit(:) = colliders%rb(:,2) - colliders%rb(:,1) + runit(:) = runit(:) / (.mag. runit(:)) + frag%rbimp(:) = colliders%rb(:,1) + colliders%radius(1) * runit(:) + ! Convert quantities back to the system units and save them into the fragment system frag%mass_dist(:) = (frag%mass_dist(:) / param%MU2KG) frag%Qloss = frag%Qloss * (param%TU2S / param%DU2M)**2 / param%MU2KG diff --git a/src/fraggle/fraggle_set.f90 b/src/fraggle/fraggle_set.f90 index a8e61130d..45cf41a92 100644 --- a/src/fraggle/fraggle_set.f90 +++ b/src/fraggle/fraggle_set.f90 @@ -185,10 +185,11 @@ module subroutine fraggle_set_coordinate_system(self, colliders) Ltot = colliders%L_orbit(:,1) + colliders%L_orbit(:,2) + colliders%L_spin(:,1) + colliders%L_spin(:,2) frag%y_coll_unit(:) = delta_r(:) / r_col_norm L_mag = .mag.Ltot(:) - if (L_mag > tiny(L_mag)) then + if (L_mag > sqrt(tiny(L_mag))) then frag%z_coll_unit(:) = Ltot(:) / L_mag else - frag%z_coll_unit(:) = 0.0_DP + call random_number(frag%z_coll_unit(:)) + frag%z_coll_unit(:) = frag%z_coll_unit(:) / (.mag.frag%z_coll_unit(:)) end if ! The cross product of the y- by z-axis will give us the x-axis frag%x_coll_unit(:) = frag%y_coll_unit(:) .cross. frag%z_coll_unit(:) @@ -198,6 +199,7 @@ module subroutine fraggle_set_coordinate_system(self, colliders) call random_number(L_sigma(:,:)) ! Randomize the tangential velocity direction. This helps to ensure that the tangential velocity doesn't completely line up with the angular momentum vector, ! otherwise we can get an ill-conditioned system + do concurrent(i = 1:nfrag, frag%rmag(i) > 0.0_DP) frag%v_r_unit(:, i) = frag%x_coll(:, i) / frag%rmag(i) frag%v_n_unit(:, i) = frag%z_coll_unit(:) + 2e-1_DP * (L_sigma(:,i) - 0.5_DP) @@ -205,6 +207,7 @@ module subroutine fraggle_set_coordinate_system(self, colliders) frag%v_t_unit(:, i) = frag%v_n_unit(:, i) .cross. frag%v_r_unit(:, i) frag%v_t_unit(:, i) = frag%v_t_unit(:, i) / (.mag. frag%v_t_unit(:, i)) end do + end associate return @@ -236,6 +239,7 @@ module subroutine fraggle_set_natural_scale_factors(self, colliders) ! Scale all dimensioned quantities of colliders and fragments frag%rbcom(:) = frag%rbcom(:) / frag%dscale frag%vbcom(:) = frag%vbcom(:) / frag%vscale + frag%rbimp(:) = frag%rbimp(:) / frag%dscale colliders%rb(:,:) = colliders%rb(:,:) / frag%dscale colliders%vb(:,:) = colliders%vb(:,:) / frag%vscale colliders%mass(:) = colliders%mass(:) / frag%mscale @@ -278,6 +282,7 @@ module subroutine fraggle_set_original_scale_factors(self, colliders) ! Restore scale factors frag%rbcom(:) = frag%rbcom(:) * frag%dscale frag%vbcom(:) = frag%vbcom(:) * frag%vscale + frag%rbimp(:) = frag%rbimp(:) * frag%dscale colliders%mass = colliders%mass * frag%mscale colliders%radius = colliders%radius * frag%dscale diff --git a/src/fraggle/fraggle_util.f90 b/src/fraggle/fraggle_util.f90 index 038b3c1a5..3ed18f32d 100644 --- a/src/fraggle/fraggle_util.f90 +++ b/src/fraggle/fraggle_util.f90 @@ -241,7 +241,7 @@ module subroutine fraggle_util_get_energy_momentum(self, colliders, system, para frag%ke_orbit_before = tmpsys%ke_orbit frag%ke_spin_before = tmpsys%ke_spin frag%pe_before = tmpsys%pe - frag%Etot_before = tmpsys%te + frag%Etot_before = tmpsys%te else frag%Lorbit_after(:) = tmpsys%Lorbit(:) frag%Lspin_after(:) = tmpsys%Lspin(:) @@ -249,7 +249,7 @@ module subroutine fraggle_util_get_energy_momentum(self, colliders, system, para frag%ke_orbit_after = tmpsys%ke_orbit frag%ke_spin_after = tmpsys%ke_spin frag%pe_after = tmpsys%pe - frag%Etot_after = tmpsys%te + frag%Etot_after = tmpsys%te - (frag%pe_after - frag%pe_before) ! Gotta be careful with PE when number of bodies changes. end if end associate diff --git a/src/modules/fraggle_classes.f90 b/src/modules/fraggle_classes.f90 index 8f6cd4310..ebd5212cf 100644 --- a/src/modules/fraggle_classes.f90 +++ b/src/modules/fraggle_classes.f90 @@ -54,6 +54,7 @@ module fraggle_classes ! Values in a coordinate frame centered on the collider barycenter and collisional system unit vectors (these are used internally by the fragment generation subroutine) real(DP), dimension(NDIM) :: rbcom !! Center of mass position vector of the collider system in system barycentric coordinates real(DP), dimension(NDIM) :: vbcom !! Velocity vector of the center of mass of the collider system in system barycentric coordinates + real(DP), dimension(NDIM) :: rbimp !! Impact point position vector of the collider system in system barycentric coordinates real(DP), dimension(NDIM) :: x_coll_unit !! x-direction unit vector of collisional system real(DP), dimension(NDIM) :: y_coll_unit !! y-direction unit vector of collisional system real(DP), dimension(NDIM) :: z_coll_unit !! z-direction unit vector of collisional system diff --git a/src/symba/symba_collision.f90 b/src/symba/symba_collision.f90 index d7542d854..b5ed877c3 100644 --- a/src/symba/symba_collision.f90 +++ b/src/symba/symba_collision.f90 @@ -28,6 +28,7 @@ module function symba_collision_casedisruption(system, param, t) result(status) integer(I4B) :: i, ibiggest, nfrag logical :: lfailure character(len=STRMAX) :: message + real(DP) :: dpe associate(colliders => system%colliders, fragments => system%fragments) @@ -46,6 +47,10 @@ module function symba_collision_casedisruption(system, param, t) result(status) ! Generate the position and velocity distributions of the fragments call fragments%generate_fragments(colliders, system, param, lfailure) + dpe = fragments%pe_after - fragments%pe_before + system%Ecollisions = system%Ecollisions - dpe + system%Euntracked = system%Euntracked + dpe + if (lfailure) then call io_log_one_message(FRAGGLE_LOG_OUT, "No fragment solution found, so treat as a pure hit-and-run") status = ACTIVE @@ -98,6 +103,7 @@ module function symba_collision_casehitandrun(system, param, t) result(status) integer(I4B) :: i, ibiggest, nfrag, jtarg, jproj logical :: lpure character(len=STRMAX) :: message + real(DP) :: dpe associate(colliders => system%colliders, fragments => system%fragments) message = "Hit and run between" @@ -123,6 +129,10 @@ module function symba_collision_casehitandrun(system, param, t) result(status) ! Generate the position and velocity distributions of the fragments call fragments%generate_fragments(colliders, system, param, lpure) + dpe = fragments%pe_after - fragments%pe_before + system%Ecollisions = system%Ecollisions - dpe + system%Euntracked = system%Euntracked + dpe + if (lpure) then call io_log_one_message(FRAGGLE_LOG_OUT, "Should have been a pure hit and run instead") nfrag = 0 @@ -172,8 +182,8 @@ module function symba_collision_casemerge(system, param, t) result(status) integer(I4B) :: status !! Status flag assigned to this outcome ! Internals integer(I4B) :: i, j, k, ibiggest - real(DP) :: pe real(DP), dimension(NDIM) :: L_spin_new + real(DP) :: dpe character(len=STRMAX) :: message associate(colliders => system%colliders, fragments => system%fragments) @@ -207,9 +217,9 @@ module function symba_collision_casemerge(system, param, t) result(status) ! Keep track of the component of potential energy due to the pre-impact colliders%idx for book-keeping ! Get the energy of the system after the collision call fragments%get_energy_and_momentum(colliders, system, param, lbefore=.false.) - pe = fragments%pe_after - fragments%pe_before - system%Ecollisions = system%Ecollisions - pe - system%Euntracked = system%Euntracked + pe + dpe = fragments%pe_after - fragments%pe_before + system%Ecollisions = system%Ecollisions - dpe + system%Euntracked = system%Euntracked + dpe ! Update any encounter lists that have the removed bodies in them so that they instead point to the new From bab38bbfcb23733ad66c3cb9ed5277038eb5269f Mon Sep 17 00:00:00 2001 From: David A Minton Date: Thu, 15 Dec 2022 07:02:17 -0500 Subject: [PATCH 435/569] Fixed bug that prevented pure hit and runs from being recorded properly in the collision snapshot --- examples/Fragmentation/swiftest_fragmentation.py | 2 +- src/symba/symba_collision.f90 | 1 + 2 files changed, 2 insertions(+), 1 deletion(-) diff --git a/examples/Fragmentation/swiftest_fragmentation.py b/examples/Fragmentation/swiftest_fragmentation.py index e5a518896..2f4685929 100644 --- a/examples/Fragmentation/swiftest_fragmentation.py +++ b/examples/Fragmentation/swiftest_fragmentation.py @@ -72,7 +72,7 @@ # Do the same as above for the hit and run case. sim_hitandrun = swiftest.Simulation(simdir="hitandrun", **run_arguments) sim_hitandrun.add_solar_system_body(["Sun"]) -sim_hitandrun.add_body(name="Target", rh=[1.0, -4.2e-05, 0.0], vh=[[0.0, 6.28, 0.0]], Gmass=1e-7, radius=7e-6, rot=[0.0, 0.0, 6.0e4]) +sim_hitandrun.add_body(name="Target", rh=[1.0, -4.2e-05, 0.0], vh=[0.0, 6.28, 0.0], Gmass=1e-7, radius=7e-6, rot=[0.0, 0.0, 6.0e4]) sim_hitandrun.add_body(name="Projectile", rh=[1.0, 4.2e-05, 0.0], vh=[-1.5, -6.28, 0.0], Gmass=7e-10, radius=3.25e-6, rot=[0.0, 0.0, 1.0e5]) sim_hitandrun.get_parameter() sim_hitandrun.run() diff --git a/src/symba/symba_collision.f90 b/src/symba/symba_collision.f90 index b5ed877c3..e9c619d02 100644 --- a/src/symba/symba_collision.f90 +++ b/src/symba/symba_collision.f90 @@ -150,6 +150,7 @@ module function symba_collision_casehitandrun(system, param, t) result(status) pl%ldiscard(colliders%idx(:)) = .false. pl%lcollision(colliders%idx(:)) = .false. end select + allocate(system%fragments%pl, source=system%colliders%pl) ! Be sure to save the pl so that snapshots still work else ibiggest = colliders%idx(maxloc(system%pl%Gmass(colliders%idx(:)), dim=1)) fragments%id(1) = system%pl%id(ibiggest) From de628396e9dd8a73b711ab2b7f4218041f6d2854 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Thu, 15 Dec 2022 07:05:27 -0500 Subject: [PATCH 436/569] Finally got a non-pure hit and run! --- examples/Fragmentation/Fragmentation_Movie.py | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/examples/Fragmentation/Fragmentation_Movie.py b/examples/Fragmentation/Fragmentation_Movie.py index dc443eccc..e8d2b9fce 100644 --- a/examples/Fragmentation/Fragmentation_Movie.py +++ b/examples/Fragmentation/Fragmentation_Movie.py @@ -55,7 +55,7 @@ "supercatastrophic_off_axis": [np.array([0.0, 6.28, 0.0]), np.array([0.5, -6.28, 0.0])], "hitandrun" : [np.array([0.0, 6.28, 0.0]), - np.array([-1.5, -6.28, 0.00])] + np.array([-1.45, -6.28, 0.00])] } rot_vectors = {"disruption_headon" : [np.array([0.0, 0.0, 0.0]), From 979910f8506ca4b799dbadb55544ae5042914713 Mon Sep 17 00:00:00 2001 From: Carlisle Wishard Date: Thu, 15 Dec 2022 11:42:51 -0500 Subject: [PATCH 437/569] moved all tables to separate markdown files for clarity. links can later be replaced with links to docstring files if we choose --- .gitignore | 2 + README.md | 138 +---------------------------- README_tables/add_body_kwargs.md | 21 +++++ README_tables/param_options.md | 54 +++++++++++ README_tables/simulation_kwargs.md | 59 ++++++++++++ 5 files changed, 139 insertions(+), 135 deletions(-) create mode 100644 README_tables/add_body_kwargs.md create mode 100644 README_tables/param_options.md create mode 100644 README_tables/simulation_kwargs.md diff --git a/.gitignore b/.gitignore index 2d50953b7..2233adc6b 100644 --- a/.gitignore +++ b/.gitignore @@ -9,6 +9,8 @@ !*.cmake !CHANGELOG !README.md +!README_figs/** +!README_tables/** !paper/paper.md !paper/paper.bib !README.swifter diff --git a/README.md b/README.md index 70c9fcad8..509b99fe8 100644 --- a/README.md +++ b/README.md @@ -165,64 +165,7 @@ sim = swiftest.Simulation(**kwargs) The key word arguments available to the user, along with the default values for these arguments, are as follows: -| Key Word Name | Key Word Description | Options | Compatible Integrators | -|---------------------------------|----------------------------------------------------------------------------------------------------|----------------------------------------------------------------------------------------------------|------------------------| -|```simdir``` | Path to subdirectory in which to store data. Default is ```/simdir```. | pathlike string (ex. ```path/to/directory```) | all -|```read_param``` | Read in a pre-existing parameter input file. Default is ```False```. | ```True```, ```False``` | all -|```param_file``` | Name of the pre-existing parameter input file. Only used if ```read_param``` is set to ```True```. | string (ex. ```param.in```) | all -|```read_old_output_file``` | Read in a pre-existing simulation output file. Default is ```False```. | ```True```, ```False``` | all -|```codename``` | Name of the N-body code to use. Default is ```Swiftest```. | ```Swiftest```, ```Swifter```, ```Swift``` | all -|```integrator``` | Name of the N-body integrator to use. Default is ```symba```. | ```symba```, ```helio```, ```rmvs```, ```whm``` | all -|```t0``` | The reference time for the start of the simulation in time units. Default is ```0.0```. | floating point (ex. ```0.0```) | all -|```tstart``` | Simulation start time for a restarted run in time units. Default is ```0.0```. | floating point (ex. ```0.0```) | all -|```tstop``` | Simulation end time in time units. Must be greater than ```tstart```. | floating point (ex. ```100.0```) | all -|```dt``` | Simulation step size in time units. Must be less than or equal to ```tstop```-```tstart```. | floating point (ex. ```0.005```) | all -|```istep_out``` | The number of time steps (```dt```) between output saves to memory. Either ```istep_out``` **OR** ```tstep_out``` may be set. Default is ```1```. | integer (ex. ```200```) | all -|```dump_cadence``` | The number of output steps between when data saved to memory is written to file. Setting to ```0``` results in writing data to file only at the completion of the simulation. Default is ```10```. | integer (ex. ```10```) | all -|```tstep_out``` | The approximate time between when outputs saved in memory are written to file in time units. Either ```istep_out``` **OR** ```tstep_out``` may be set. | floating point (ex. ```10.0```) that calculates ```istep_out = floor(tstep_out / dt)``` | all -|```init_cond_file_type``` | Input file format. Default is ```NETCDF_DOUBLE```. | ```NETCDF_DOUBLE```, ```NETCDF_FLOAT```, ```ASCII``` | all -|```init_cond_file_name``` | Input file name(s). If ```init_cond_file_type``` is set to ```NETCDF_DOUBLE``` or ```NETCDF_FLOAT```, default is ```init_cond.nc```. If ```init_cond_file_type``` is set to ```ASCII```, default is a dictionary: ```{"CB" : "cb.in", "PL" : "pl.in", "TP" : "tp.in"}```. | string (ex. ```my_init_cond.nc```) or dictionary ```{"CB" : "mycb.in", "PL" : "mypl.in", "TP" : "mytp.in"}``` | all -|```init_cond_format``` | Input format. Default is ```EL```. | ```EL```, ```XV``` | all -|```output_file_type``` | Output file format. Default is ```NETCDF_DOUBLE```. ```REAL4```, ```REAL8```, ```XDR4```, ```XDR8``` Swifter/Swift only. | ```NETCDF_DOUBLE```, ```NETCDF_FLOAT```, ```REAL4```, ```REAL8```, ```XDR4```, ```XDR8``` | all -|```output_file_name``` | Output file name. Default is ```bin.nc```. | string (ex. ```mydata.nc```) | all -|```output_format``` | Output format. Default is ```XVEL```. | ```XV```, ```XVEL``` | all -|```MU``` | Mass unit system to use in the simulation. Default is ```Msun```. | ```Msun```, ```Mearth```, ```kg```, ```g``` (case-insensitive) | all -|```DU``` | Distance unit system to use in the simulation. Default is ```AU```. | ```AU```, ```Rearth```, ```m```, ```cm``` (case-insensitive) | all -|```TU``` | Time unit system to use in the simulation. Default is ```Y```. | ```Y```, ```YR```, ```DAY``` (Julian day), ```d``` (Julian day), ```JD``` (Julian day), ```s``` (case-insensitive) | all -|```MU2KG``` | Mass units to kilogram conversion factor. Overrides ```MU```. | floating point (ex. ```1.988409870698051e+30```) | all -|```DU2M``` | Distance units to meters conversion factor. Overrides ```DU```. | floating point (ex. ```31557600.0```) | all -|```TU2S``` | Time units to seconds conversion factor. Overrides ```TU```. | floating point (ex. ```149597870700.0```) | all -|```rmin``` | Heliocentric distance at which a test particle is considered merged with the central body in distance units. Default is the radius of the central body in system units. | floating point (ex. ```0.3```) | all -|```rmax``` | Heliocentric distance at which a test particle is too distant from the central body in distance units. Default is ```10000.0 AU```. | floating point (ex. ```10000.0```) | all -|```qmin_coord``` | Coordinate frame used to check for minimum pericenter distance. Default is ```HELIO```. | ```HELIO```, ```BARY``` | all -|```mtiny``` | Mass cutoff between fully and semi-interacting massive bodies in mass units. Either ```mtiny``` **OR** ```gmtiny``` may be set. | floating point (ex. ```1e23```) | all -|```gmtiny``` | Mass cutoff between fully and semi-interacting massive bodies in gravitational mass units. Default is ```0.0```. Either ```mtiny``` **OR** ```gmtiny``` may be set. | floating point (ex. ```4e-6```) | all -|```close_encounter_check``` | Check for close encounters. Default is ```True```. Requires radius of massive bodies to be provided in initial conditions. | ```True```, ```False``` | all -|```general_relativity``` | General relativity. Default is ```True```. | ```True```, ```False``` | all -|```fragmentation``` | Resolve collisions with fragmentation. Default is ```False```. | ```True```, ```False``` | SyMBA -|```minimum_fragment_gmass``` | Minimum fragment mass in gravitational mass units. Default is ```0.0```. Either ```minimum_fragment_gmass``` **OR** ```minimum_fragment_mass``` may be set. | floating point (ex. ```1e-9```) | SyMBA -|```minimum_fragment_mass``` | Minimum fragment mass in mass units. Either ```minimum_fragment_gmass``` **OR** ```minimum_fragment_mass``` may be set. | floating point (ex. ```1e20```) | SyMBA -|```rotation``` | Rotation of massive bodies. Requires rotation vectors, radii, and moments of inertia to be provided in initial conditions. Default is ```False```. | ```True```, ```False``` | SyMBA -|```compute_conservation_values```| Track and report the total energy, angular momentum, and mass of the system. Default is ```False```. | ```True```, ```False``` | SyMBA -|```rhill_present``` | Hill Radius present in massive body input file. Default is ```False```. | ```True```, ```False``` | SyMBA -|```extra_force``` | Additional user defined force routines provided. Default is ```False```. | ```True```, ```False``` | all -|```big_discard``` | Include data for all fully-interacting bodies (above GMTINY) in each discard. Swifter only. Default is ```False```. | ```True```, ```False``` | all -|```restart``` | If ```True```, the simulation given by ```output_file_name``` will be restarted from ```t0```. Default is ```False```. | ```True```, ```False``` | all -|```interaction_loops``` | Method for checking for interactions between bodies. Default is ```TRIANGULAR```. | ```TRIANGULAR```, ```FLAT```, ```ADAPTIVE``` | all -|```encounter_check_loops``` | Method for checking for close encounters between bodies. Default is ```TRIANGULAR```. | ```TRIANGULAR```, ```SORTSWEEP```, ```ADAPTIVE``` | all - -In the above list, the following are defined as: -- ```HELIO``` - Use the heliocentric coordinate frame. -- ```BARY``` - Use the barycentric coordinate frame. -- ```XV``` - Heliocentric position and velocity components. -- ```EL``` - Osculating orbital elements. -- ```XVEL``` - Heliocentric position and velocity components and osculating orbital elements. -- ```NETCDF_FLOAT``` - Single precision NetCDF format. -- ```NETCDF_DOUBLE``` - Double precision NetCDF format. -- ```REAL4``` - Single precision 4-byte native Fortran binary format (Swifter/Swift only) -- ```REAL8``` - Double precision 8-byte native Fortran binary format (Swifter/Swift only) -- ```XDR4``` - Single precision 4-byte XDR format (Swifter/Swift only) -- ```XDR8``` - Double precision 8-byte XDR format (Swifter/Swift only) +The key word arguments available to the user, along with the default values for these arguments, are described in [simulation_kwargs](README_tables/simulation_kwargs.md). After creating the simulation and defining all desired parameters as keyword arguments, it is time to add bodies to the simulation. The Swiftest Python package interfaces with the [NASA JPL Horizons database](https://ssd.jpl.nasa.gov/horizons/), allowing a user to easily import the initial conditions of known solar system bodies using the ```add_solar_system_body``` method. @@ -236,28 +179,7 @@ User defined bodies can also be added to a Swiftest simulation through the Pytho sim.add_body(**kwargs**) ``` -The ```add_body``` method accepts the following keyword arguments: - -| Key Word Name | Key Word Description | Options | -|-----------------|-----------------------------------------------------------------------------------------------------------------------------------------|--------------------------------| -| ```name``` | Name(s) of bodies. | string or array-like of strings -| ```id``` | Unique identification value(s) of bodies. | float or array-like of floats -| ```a``` | Semi-major axis value(s) of bodies. Only used if ```init_cond_format``` is set to ```EL```. | float or array-like of floats -| ```e``` | Eccentricity value(s) of bodies. Only used if ```init_cond_format``` is set to ```EL```. | float or array-like of floats -| ```inc``` | Inclination value(s) of bodies. Only used if ```init_cond_format``` is set to ```EL```. | float or array-like of floats -| ```capom``` | Longitude of the ascending node value(s) of bodies. Only used if ```init_cond_format``` is set to ```EL```. | float or array-like of floats -| ```omega``` | Argument of pericenter value(s) of bodies. Only used if ```init_cond_format``` is set to ```EL```. | float or array-like of floats -| ```capm``` | Mean anomaly value(s) of bodies. Only used if ```init_cond_format``` is set to ```EL```. | float or array-like of floats -| ```rh``` | Position vector(s) of bodies. Only used if ```init_cond_format``` is set to ```XV```. | (n,3) array-like of floats -| ```vh``` | Velocity vector(s) of bodies. Only used if ```init_cond_format``` is set to ```XV```. | (n,3) array-like of floats -| ```mass``` | Mass value(s) of bodies. Only for massive bodies. Only ```mass``` **OR** ```Gmass``` may be set. | float or array-like of floats -| ```Gmass``` | Gravitational mass value(s) of bodies. Only for massive bodies. Only ```mass``` **OR** ```Gmass``` may be set. | float or array-like of floats -| ```radius``` | Radius value(s) of bodies. Only for massive bodies. | float or array-like of floats -| ```rhill``` | Hill Radius value(s) of bodies. Only for massive bodies. | float or array-like of floats -| ```rot``` | Rotation rate vector(s) of bodies. Only for massive bodies. Only used if ```rotation``` is set to ```True```. | (n,3) array-like of floats -| ```Ip``` | Principal axes moments of inertia vector(s) of bodies. Only for massive bodies. Only used if ```rotation``` is set to ```True```. | (n,3) array-like of floats -| ```J2``` | The J2 term of the central body. | float or array-like of floats -| ```J4``` | The J4 term of the central body. | float or array-like of floats +The key word arguments available to the user for the ```add_body``` method are described in [add_body_kwargs](README_tables/add_body_kwargs.md). All desired bodies and parameters are added to the simulation object and the information is saved to a NetCDF input file (**init_cond.nc**) and an ASCII parameter file (**param.in**) automatically. The parameter file is not necessary to run a Swiftest simulation, it is simply a convenient reference for the user. These files are stored in the ```/simdata``` subdirectory. @@ -269,61 +191,7 @@ Swiftest accepts 4 ASCII input files. All four input files are necessary, howeve - **pl.in** - The massive body input file. - **tp.in** - The test particle input file. -The parameter options used in the **param.in** are as follows: - -| Parameter Name | Parameter Description | Input Format | Compatible Integrators | -|-------------------------|------------------------------------------------------------------------------------------------------------------------------|---------------------------------------------------------------------------------------------------------|------------------------| -| ```T0``` | The reference time for the start of the simulation in time units. | floating point (ex. ```0.0```) | all -| ```TSTART``` | Simulation start time for a restarted run in time units. | floating point (ex. ```0.0```) | all -| ```TSTOP``` | Simulation end time in time units. Must be greater than ```TSTART```. | floating point (ex. ```100.0```) | all -| ```DT``` | Simulation step size in time units. Must be less than or equal to ```TSTOP```-```TSTART```. | floating point (ex. ```0.005```) | all -| ```ISTEP_OUT``` | The number of time steps (```DT```) between output saves to memory. | integer (ex. ```200```) | all -| ```DUMP_CADENCE``` | The number of output steps between when data saved to memory is written to file. Setting to ```0``` results in writing data to file only at the completion of the simulation. | integer (ex. ```100```) | all -| ```IN_TYPE``` | Input file format. | ```ASCII```, ```NETCDF_FLOAT```, and ```NETCDF_DOUBLE``` | all -| ```NC_IN``` | NetCDF input file name. Only if ```IN_TYPE``` is set to ```NETCDF_FLOAT``` or ```NETCDF_DOUBLE```. | string (ex. ```init_cond.nc```) | all -| ```PL_IN``` | Massive body input file name. Only if ```IN_TYPE``` is set to ```ASCII```. | string (ex. ```pl.in```) | all -| ```TP_IN``` | Test particle input file name. Only if ```IN_TYPE``` is set to ```ASCII```. | string (ex. ```tp.in```) | all -| ```CB_IN ``` | Central body input file name. Only if ```IN_TYPE``` is set to ```ASCII```. | string (ex. ```cb.in```) | all -| ```IN_FORM``` | Input format. | ```EL```, ```XV``` | all -| ```OUT_TYPE``` | Output file format. | ```NETCDF_FLOAT```, ```NETCDF_DOUBLE``` | all -| ```BIN_OUT``` | Output file name. | string (ex. ```bin.nc```) | all -| ```OUT_FORM``` | Output format. | ```XV```, ```XVEL``` | all -| ```OUT_STAT``` | Output status. | ```NEW```, ```APPEND```, ```REPLACE```, ```UNKNOWN``` | all -| ```CHK_QMIN``` | Pericenter distance at which a test particle is too close to the pericenter of the system in distance units. | floating point, turn off using ```-1.0``` | all -| ```CHK_RMIN``` | Heliocentric distance at which a test particle is considered merged with the central body in distance units. | floating point, turn off using ```-1.0``` | all -| ```CHK_RMAX``` | Heliocentric distance at which a test particle is too distant from the central body in distance units. | floating point (ex. ```1000.0```) | all -| ```CHK_EJECT``` | Heliocentric distance at which an unbound test particle is too distant from the central body in distance units. | floating point (ex. ```1000.0```) | all -| ```CHK_QMIN_COORD``` | Coordinate frame used to check for minimum pericenter distance. | ```HELIO```, ```BARY``` | all -| ```CHK_QMIN_RANGE``` | Upper and lower bounds of the semimajor axis range used to check the pericenter distance. | two floating points, turn off using ```-1.0 -1.0``` | all -| ```EXTRA_FORCE``` | Additional user defined force routines provided. | ```YES```, ```NO``` | all -| ```CHK_CLOSE``` | Check for close encounters. Requires radius of massive bodies to be provided in initial conditions. | ```YES```, ```NO``` | all -| ```INTERACTION_LOOPS``` | Method for checking for interactions between bodies. | ```TRIANGULAR```, ```FLAT```, ```ADAPTIVE``` | all -| ```ENCOUNTER_CHECK``` | Method for checking for close encounters between bodies. | ```TRIANGULAR```, ```SORTSWEEP```, ```ADAPTIVE``` | all -| ```MU2KG``` | Mass units to kilogram conversion factor. | floating point (ex. ```1.988409870698051e+30```) | all -| ```TU2S``` | Time units to seconds conversion factor. | floating point (ex. ```31557600.0```) | all -| ```DU2M``` | Distance units to meters conversion factor. | floating point (ex. ```149597870700.0```) | all -| ```BIG_DISCARD``` | Include data for all fully-interacting bodies (above GMTINY) in each discard. Swifter only. | ```YES```, ```NO``` | all -| ```GR``` | General relativity. | ```YES```, ```NO``` | all -| ```RHILL_PRESENT``` | Hill Radius present in massive body input file. | ```YES```, ```NO``` | SyMBA -| ```ENERGY``` | Track and report the total energy, angular momentum, and mass of the system. | ```YES```, ```NO``` | SyMBA -| ```FRAGMENTATION``` | Resolve collisions with fragmentation. | ```YES```, ```NO``` | SyMBA -| ```ROTATION``` | Rotation of massive bodies. Requires rotation vectors, radii, and moments of inertia to be provided in initial conditions. | ```YES```, ```NO``` | SyMBA -| ```GMTINY``` | Mass cutoff between fully and semi-interacting massive bodies in gravitational mass units. | floating point (ex. ```4e-06```) | SyMBA -| ```MIN_GMFRAG``` | Minimum fragment mass in gravitational mass units. | floating point (ex. ```1e-09```) | SyMBA -| ```TIDES``` | Tidal dissipation model. | ```YES```, ```NO``` | *(under development)* -| ```YORP``` | YORP effect. | ```YES```, ```NO``` | *(under development)* -| ```YARKOVSKY``` | Yarkovsky effect. | ```YES```, ```NO``` | *(under development)* - -In the above list, the following are defined as: -- ```HELIO``` - Use the heliocentric coordinate frame for ```CHK_QMIN``` -- ```BARY``` - Use the barycentric coordinate frame for ```CHK_QMIN``` -- ```XV``` - Heliocentric position and velocity components for ```IN_FORM``` and/or ```OUT_FORM``` -- ```EL``` - Osculating orbital elements for ```IN_FORM``` and/or ```OUT_FORM``` -- ```XVEL``` - Heliocentric position and velocity components and osculating orbital elements for ```OUT_FORM``` -- ```NETCDF_FLOAT``` - Single precision NetCDF format for ```OUT_TYPE``` -- ```NETCDF_DOUBLE``` - Double precision NetCDF format for ```OUT_TYPE``` - -For more details on the ```INTERACTION_LOOPS``` and ```ENCOUNTER_CHECK``` options, see the **Updates to Swifter SyMBA** section below. +The parameter options used in the parameter input file are as described in [param_options](README_tables/param_options.md). The **cb.in** includes all central body initial conditions. The structure of the **cb.in** is as follows: diff --git a/README_tables/add_body_kwargs.md b/README_tables/add_body_kwargs.md new file mode 100644 index 000000000..d24dd051b --- /dev/null +++ b/README_tables/add_body_kwargs.md @@ -0,0 +1,21 @@ +# swiftest.add_body(**kwargs) +| Key Word Name | Key Word Description | Options | +|-----------------|-----------------------------------------------------------------------------------------------------------------------------------------|--------------------------------| +| ```name``` | Name(s) of bodies. | string or array-like of strings +| ```id``` | Unique identification value(s) of bodies. | float or array-like of floats +| ```a``` | Semi-major axis value(s) of bodies. Only used if ```init_cond_format``` is set to ```EL```. | float or array-like of floats +| ```e``` | Eccentricity value(s) of bodies. Only used if ```init_cond_format``` is set to ```EL```. | float or array-like of floats +| ```inc``` | Inclination value(s) of bodies. Only used if ```init_cond_format``` is set to ```EL```. | float or array-like of floats +| ```capom``` | Longitude of the ascending node value(s) of bodies. Only used if ```init_cond_format``` is set to ```EL```. | float or array-like of floats +| ```omega``` | Argument of pericenter value(s) of bodies. Only used if ```init_cond_format``` is set to ```EL```. | float or array-like of floats +| ```capm``` | Mean anomaly value(s) of bodies. Only used if ```init_cond_format``` is set to ```EL```. | float or array-like of floats +| ```rh``` | Position vector(s) of bodies. Only used if ```init_cond_format``` is set to ```XV```. | (n,3) array-like of floats +| ```vh``` | Velocity vector(s) of bodies. Only used if ```init_cond_format``` is set to ```XV```. | (n,3) array-like of floats +| ```mass``` | Mass value(s) of bodies. Only for massive bodies. Only ```mass``` **OR** ```Gmass``` may be set. | float or array-like of floats +| ```Gmass``` | Gravitational mass value(s) of bodies. Only for massive bodies. Only ```mass``` **OR** ```Gmass``` may be set. | float or array-like of floats +| ```radius``` | Radius value(s) of bodies. Only for massive bodies. | float or array-like of floats +| ```rhill``` | Hill Radius value(s) of bodies. Only for massive bodies. | float or array-like of floats +| ```rot``` | Rotation rate vector(s) of bodies. Only for massive bodies. Only used if ```rotation``` is set to ```True```. | (n,3) array-like of floats +| ```Ip``` | Principal axes moments of inertia vector(s) of bodies. Only for massive bodies. Only used if ```rotation``` is set to ```True```. | (n,3) array-like of floats +| ```J2``` | The J2 term of the central body. | float or array-like of floats +| ```J4``` | The J4 term of the central body. | float or array-like of floats \ No newline at end of file diff --git a/README_tables/param_options.md b/README_tables/param_options.md new file mode 100644 index 000000000..5f63f3cf8 --- /dev/null +++ b/README_tables/param_options.md @@ -0,0 +1,54 @@ +# **param.in** options +| Parameter Name | Parameter Description | Input Format | Compatible Integrators | +|-------------------------|------------------------------------------------------------------------------------------------------------------------------|---------------------------------------------------------------------------------------------------------|------------------------| +| ```T0``` | The reference time for the start of the simulation in time units. | floating point (ex. ```0.0```) | all +| ```TSTART``` | Simulation start time for a restarted run in time units. | floating point (ex. ```0.0```) | all +| ```TSTOP``` | Simulation end time in time units. Must be greater than ```TSTART```. | floating point (ex. ```100.0```) | all +| ```DT``` | Simulation step size in time units. Must be less than or equal to ```TSTOP```-```TSTART```. | floating point (ex. ```0.005```) | all +| ```ISTEP_OUT``` | The number of time steps (```DT```) between output saves to memory. | integer (ex. ```200```) | all +| ```DUMP_CADENCE``` | The number of output steps between when data saved to memory is written to file. Setting to ```0``` results in writing data to file only at the completion of the simulation. | integer (ex. ```100```) | all +| ```IN_TYPE``` | Input file format. | ```ASCII```, ```NETCDF_FLOAT```, and ```NETCDF_DOUBLE``` | all +| ```NC_IN``` | NetCDF input file name. Only if ```IN_TYPE``` is set to ```NETCDF_FLOAT``` or ```NETCDF_DOUBLE```. | string (ex. ```init_cond.nc```) | all +| ```PL_IN``` | Massive body input file name. Only if ```IN_TYPE``` is set to ```ASCII```. | string (ex. ```pl.in```) | all +| ```TP_IN``` | Test particle input file name. Only if ```IN_TYPE``` is set to ```ASCII```. | string (ex. ```tp.in```) | all +| ```CB_IN ``` | Central body input file name. Only if ```IN_TYPE``` is set to ```ASCII```. | string (ex. ```cb.in```) | all +| ```IN_FORM``` | Input format. | ```EL```, ```XV``` | all +| ```OUT_TYPE``` | Output file format. | ```NETCDF_FLOAT```, ```NETCDF_DOUBLE``` | all +| ```BIN_OUT``` | Output file name. | string (ex. ```bin.nc```) | all +| ```OUT_FORM``` | Output format. | ```XV```, ```XVEL``` | all +| ```OUT_STAT``` | Output status. | ```NEW```, ```APPEND```, ```REPLACE```, ```UNKNOWN``` | all +| ```CHK_QMIN``` | Pericenter distance at which a test particle is too close to the pericenter of the system in distance units. | floating point, turn off using ```-1.0``` | all +| ```CHK_RMIN``` | Heliocentric distance at which a test particle is considered merged with the central body in distance units. | floating point, turn off using ```-1.0``` | all +| ```CHK_RMAX``` | Heliocentric distance at which a test particle is too distant from the central body in distance units. | floating point (ex. ```1000.0```) | all +| ```CHK_EJECT``` | Heliocentric distance at which an unbound test particle is too distant from the central body in distance units. | floating point (ex. ```1000.0```) | all +| ```CHK_QMIN_COORD``` | Coordinate frame used to check for minimum pericenter distance. | ```HELIO```, ```BARY``` | all +| ```CHK_QMIN_RANGE``` | Upper and lower bounds of the semimajor axis range used to check the pericenter distance. | two floating points, turn off using ```-1.0 -1.0``` | all +| ```EXTRA_FORCE``` | Additional user defined force routines provided. | ```YES```, ```NO``` | all +| ```CHK_CLOSE``` | Check for close encounters. Requires radius of massive bodies to be provided in initial conditions. | ```YES```, ```NO``` | all +| ```INTERACTION_LOOPS``` | Method for checking for interactions between bodies. | ```TRIANGULAR```, ```FLAT```, ```ADAPTIVE``` | all +| ```ENCOUNTER_CHECK``` | Method for checking for close encounters between bodies. | ```TRIANGULAR```, ```SORTSWEEP```, ```ADAPTIVE``` | all +| ```MU2KG``` | Mass units to kilogram conversion factor. | floating point (ex. ```1.988409870698051e+30```) | all +| ```TU2S``` | Time units to seconds conversion factor. | floating point (ex. ```31557600.0```) | all +| ```DU2M``` | Distance units to meters conversion factor. | floating point (ex. ```149597870700.0```) | all +| ```BIG_DISCARD``` | Include data for all fully-interacting bodies (above GMTINY) in each discard. Swifter only. | ```YES```, ```NO``` | all +| ```GR``` | General relativity. | ```YES```, ```NO``` | all +| ```RHILL_PRESENT``` | Hill Radius present in massive body input file. | ```YES```, ```NO``` | SyMBA +| ```ENERGY``` | Track and report the total energy, angular momentum, and mass of the system. | ```YES```, ```NO``` | SyMBA +| ```FRAGMENTATION``` | Resolve collisions with fragmentation. | ```YES```, ```NO``` | SyMBA +| ```ROTATION``` | Rotation of massive bodies. Requires rotation vectors, radii, and moments of inertia to be provided in initial conditions. | ```YES```, ```NO``` | SyMBA +| ```GMTINY``` | Mass cutoff between fully and semi-interacting massive bodies in gravitational mass units. | floating point (ex. ```4e-06```) | SyMBA +| ```MIN_GMFRAG``` | Minimum fragment mass in gravitational mass units. | floating point (ex. ```1e-09```) | SyMBA +| ```TIDES``` | Tidal dissipation model. | ```YES```, ```NO``` | *(under development)* +| ```YORP``` | YORP effect. | ```YES```, ```NO``` | *(under development)* +| ```YARKOVSKY``` | Yarkovsky effect. | ```YES```, ```NO``` | *(under development)* + +In the above list, the following are defined as: +- ```HELIO``` - Use the heliocentric coordinate frame for ```CHK_QMIN``` +- ```BARY``` - Use the barycentric coordinate frame for ```CHK_QMIN``` +- ```XV``` - Heliocentric position and velocity components for ```IN_FORM``` and/or ```OUT_FORM``` +- ```EL``` - Osculating orbital elements for ```IN_FORM``` and/or ```OUT_FORM``` +- ```XVEL``` - Heliocentric position and velocity components and osculating orbital elements for ```OUT_FORM``` +- ```NETCDF_FLOAT``` - Single precision NetCDF format for ```OUT_TYPE``` +- ```NETCDF_DOUBLE``` - Double precision NetCDF format for ```OUT_TYPE``` + +For more details on the ```INTERACTION_LOOPS``` and ```ENCOUNTER_CHECK``` options, see the **Updates to Swifter SyMBA** section below. \ No newline at end of file diff --git a/README_tables/simulation_kwargs.md b/README_tables/simulation_kwargs.md new file mode 100644 index 000000000..02a49af9b --- /dev/null +++ b/README_tables/simulation_kwargs.md @@ -0,0 +1,59 @@ +# swiftest.Simulation(**kwargs) +| Key Word Name | Key Word Description | Options | Compatible Integrators | +|---------------------------------|----------------------------------------------------------------------------------------------------|----------------------------------------------------------------------------------------------------|------------------------| +|```simdir``` | Path to subdirectory in which to store data. Default is ```/simdir```. | pathlike string (ex. ```path/to/directory```) | all +|```read_param``` | Read in a pre-existing parameter input file. Default is ```False```. | ```True```, ```False``` | all +|```param_file``` | Name of the pre-existing parameter input file. Only used if ```read_param``` is set to ```True```. | string (ex. ```param.in```) | all +|```read_old_output``` | Read in a pre-existing simulation output file. Default is ```False```. | ```True```, ```False``` | all +|```codename``` | Name of the N-body code to use. Default is ```Swiftest```. | ```Swiftest```, ```Swifter```, ```Swift``` | all +|```integrator``` | Name of the N-body integrator to use. Default is ```symba```. | ```symba```, ```helio```, ```rmvs```, ```whm``` | all +|```t0``` | The reference time for the start of the simulation in time units. Default is ```0.0```. | floating point (ex. ```0.0```) | all +|```tstart``` | Simulation start time for a restarted run in time units. Default is ```0.0```. | floating point (ex. ```0.0```) | all +|```tstop``` | Simulation end time in time units. Must be greater than ```tstart```. | floating point (ex. ```100.0```) | all +|```dt``` | Simulation step size in time units. Must be less than or equal to ```tstop```-```tstart```. | floating point (ex. ```0.005```) | all +|```istep_out``` | The number of time steps (```dt```) between output saves to memory. Either ```istep_out``` **OR** ```tstep_out``` may be set. Default is ```1```. | integer (ex. ```200```) | all +|```dump_cadence``` | The number of output steps between when data saved to memory is written to file. Setting to ```0``` results in writing data to file only at the completion of the simulation. Default is ```10```. | integer (ex. ```10```) | all +|```tstep_out``` | The approximate time between when outputs saved in memory are written to file in time units. Either ```istep_out``` **OR** ```tstep_out``` may be set. | floating point (ex. ```10.0```) that calculates ```istep_out = floor(tstep_out / dt)``` | all +|```init_cond_file_type``` | Input file format. Default is ```NETCDF_DOUBLE```. | ```NETCDF_DOUBLE```, ```NETCDF_FLOAT```, ```ASCII``` | all +|```init_cond_file_name``` | Input file name(s). If ```init_cond_file_type``` is set to ```NETCDF_DOUBLE``` or ```NETCDF_FLOAT```, default is ```init_cond.nc```. If ```init_cond_file_type``` is set to ```ASCII```, default is a dictionary: ```{"CB" : "cb.in", "PL" : "pl.in", "TP" : "tp.in"}```. | string (ex. ```my_init_cond.nc```) or dictionary ```{"CB" : "mycb.in", "PL" : "mypl.in", "TP" : "mytp.in"}``` | all +|```init_cond_format``` | Input format. Default is ```EL```. | ```EL```, ```XV``` | all +|```output_file_type``` | Output file format. Default is ```NETCDF_DOUBLE```. ```REAL4```, ```REAL8```, ```XDR4```, ```XDR8``` Swifter/Swift only. | ```NETCDF_DOUBLE```, ```NETCDF_FLOAT```, ```REAL4```, ```REAL8```, ```XDR4```, ```XDR8``` | all +|```output_file_name``` | Output file name. Default is ```bin.nc```. | string (ex. ```mydata.nc```) | all +|```output_format``` | Output format. Default is ```XVEL```. | ```XV```, ```XVEL``` | all +|```MU``` | Mass unit system to use in the simulation. Default is ```Msun```. | ```Msun```, ```Mearth```, ```kg```, ```g``` (case-insensitive) | all +|```DU``` | Distance unit system to use in the simulation. Default is ```AU```. | ```AU```, ```Rearth```, ```m```, ```cm``` (case-insensitive) | all +|```TU``` | Time unit system to use in the simulation. Default is ```Y```. | ```Y```, ```YR```, ```DAY``` (Julian day), ```d``` (Julian day), ```JD``` (Julian day), ```s``` (case-insensitive) | all +|```MU2KG``` | Mass units to kilogram conversion factor. Overrides ```MU```. | floating point (ex. ```1.988409870698051e+30```) | all +|```DU2M``` | Distance units to meters conversion factor. Overrides ```DU```. | floating point (ex. ```31557600.0```) | all +|```TU2S``` | Time units to seconds conversion factor. Overrides ```TU```. | floating point (ex. ```149597870700.0```) | all +|```rmin``` | Heliocentric distance at which a test particle is considered merged with the central body in distance units. Default is the radius of the central body in system units. | floating point (ex. ```0.3```) | all +|```rmax``` | Heliocentric distance at which a test particle is too distant from the central body in distance units. Default is ```10000.0 AU```. | floating point (ex. ```10000.0```) | all +|```qmin_coord``` | Coordinate frame used to check for minimum pericenter distance. Default is ```HELIO```. | ```HELIO```, ```BARY``` | all +|```mtiny``` | Mass cutoff between fully and semi-interacting massive bodies in mass units. Either ```mtiny``` **OR** ```gmtiny``` may be set. | floating point (ex. ```1e23```) | all +|```gmtiny``` | Mass cutoff between fully and semi-interacting massive bodies in gravitational mass units. Default is ```0.0```. Either ```mtiny``` **OR** ```gmtiny``` may be set. | floating point (ex. ```4e-6```) | all +|```close_encounter_check``` | Check for close encounters. Default is ```True```. Requires radius of massive bodies to be provided in initial conditions. | ```True```, ```False``` | all +|```general_relativity``` | General relativity. Default is ```True```. | ```True```, ```False``` | all +|```fragmentation``` | Resolve collisions with fragmentation. Default is ```False```. | ```True```, ```False``` | SyMBA +|```minimum_fragment_gmass``` | Minimum fragment mass in gravitational mass units. Default is ```0.0```. Either ```minimum_fragment_gmass``` **OR** ```minimum_fragment_mass``` may be set. | floating point (ex. ```1e-9```) | SyMBA +|```minimum_fragment_mass``` | Minimum fragment mass in mass units. Either ```minimum_fragment_gmass``` **OR** ```minimum_fragment_mass``` may be set. | floating point (ex. ```1e20```) | SyMBA +|```rotation``` | Rotation of massive bodies. Requires rotation vectors, radii, and moments of inertia to be provided in initial conditions. Default is ```False```. | ```True```, ```False``` | SyMBA +|```compute_conservation_values```| Track and report the total energy, angular momentum, and mass of the system. Default is ```False```. | ```True```, ```False``` | SyMBA +|```rhill_present``` | Hill Radius present in massive body input file. Default is ```False```. | ```True```, ```False``` | SyMBA +|```extra_force``` | Additional user defined force routines provided. Default is ```False```. | ```True```, ```False``` | all +|```big_discard``` | Include data for all fully-interacting bodies (above GMTINY) in each discard. Swifter only. Default is ```False```. | ```True```, ```False``` | all +|```restart``` | If ```True```, the simulation given by ```output_file_name``` will be restarted from ```t0```. Default is ```False```. | ```True```, ```False``` | all +|```interaction_loops``` | Method for checking for interactions between bodies. Default is ```TRIANGULAR```. | ```TRIANGULAR```, ```FLAT```, ```ADAPTIVE``` | all +|```encounter_check_loops``` | Method for checking for close encounters between bodies. Default is ```TRIANGULAR```. | ```TRIANGULAR```, ```SORTSWEEP```, ```ADAPTIVE``` | all + +In the above list, the following are defined as: +- ```HELIO``` - Use the heliocentric coordinate frame. +- ```BARY``` - Use the barycentric coordinate frame. +- ```XV``` - Heliocentric position and velocity components. +- ```EL``` - Osculating orbital elements. +- ```XVEL``` - Heliocentric position and velocity components and osculating orbital elements. +- ```NETCDF_FLOAT``` - Single precision NetCDF format. +- ```NETCDF_DOUBLE``` - Double precision NetCDF format. +- ```REAL4``` - Single precision 4-byte native Fortran binary format (Swifter/Swift only) +- ```REAL8``` - Double precision 8-byte native Fortran binary format (Swifter/Swift only) +- ```XDR4``` - Single precision 4-byte XDR format (Swifter/Swift only) +- ```XDR8``` - Double precision 8-byte XDR format (Swifter/Swift only) \ No newline at end of file From 46b519f6cf05a6f45947bd4d3d62d0d0129a4f3f Mon Sep 17 00:00:00 2001 From: Carlisle Wishard Date: Thu, 15 Dec 2022 11:43:53 -0500 Subject: [PATCH 438/569] updated the brief outline at the start of the Usage section to include reading in files --- README.md | 28 ++++++++++++++++++++-------- 1 file changed, 20 insertions(+), 8 deletions(-) diff --git a/README.md b/README.md index 509b99fe8..2c1ddeeb0 100644 --- a/README.md +++ b/README.md @@ -137,16 +137,28 @@ Swiftest is built to make running a Swiftest simulation a streamlined and user f To create and run a Swiftest simulation using the Swiftest Python package, follow the general script below. For more details on the input files and user options, continue reading this section. ``` -import swiftest # Import the Swiftest Python package -sim = swiftest.Simulation(**kwargs) # Initialize a Swiftest simulation -sim.add_solar_system_body(**kwargs) # Add any desired named Solar System bodies -sim.add_body(**kwargs) # Add any desired user defined bodies -sim.get_parameter(**kwargs) # View the default simulation parameters -sim.set_parameter(**kwargs) # Set any desired simulation parameters -sim.write_param(**kwargs) # Write simulation parameters to the param.in -sim.run(**kwargs) # Run the simulation (ignore if running from the terminal) +import swiftest # Import the Swiftest Python package +sim = swiftest.Simulation(simdir = "directory_name", **kwargs) # Initialize a Swiftest simulation +sim.add_solar_system_body(**kwargs) # Add any desired named Solar System bodies +sim.add_body(**kwargs) # Add any desired user defined bodies +sim.get_parameter(**kwargs) # View the default simulation parameters +sim.set_parameter(**kwargs) # Set any desired simulation parameters +sim.write_param(**kwargs) # Write simulation parameters to the param.in +sim.run(**kwargs) # Run the simulation (ignore if running from the terminal) ``` +To read in a set of Swiftest output files using the Swiftest Python package, follow the general script below. For more details on the output files and user options, continue reading this section. + +``` +import swiftest # Import the Swiftest Python package +sim = swiftest.Simulation(simdir = "directory_name", read_old_output=True) # Initialize a Swiftest simulation +sim.data # Body data over time +sim.init_cond # The initial conditions for the simulation +sim.encounters # Encounter data for all close encountering pairs +sim.collisions # Collision data for all colliders and collisional fragments +``` + + **NetCDF Input Files (Recommended)** Swiftest accepts a single NetCDF input file. This file can be created using the Swiftest Python Package through a few simple steps. From 7df01a549b0a26577ffa65a58fe3146705b27dfb Mon Sep 17 00:00:00 2001 From: Carlisle Wishard Date: Thu, 15 Dec 2022 11:44:59 -0500 Subject: [PATCH 439/569] added simdir argument to all swiftest.Simulation examples --- README.md | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/README.md b/README.md index 2c1ddeeb0..203062473 100644 --- a/README.md +++ b/README.md @@ -172,10 +172,10 @@ import swiftest Next, we initialize the Swiftest simulation object. Various parameters can be provided to the simulation via key word arguments at this stage. ``` -sim = swiftest.Simulation(**kwargs) +sim = swiftest.Simulation(simdir = "directory_name", **kwargs) ``` -The key word arguments available to the user, along with the default values for these arguments, are as follows: +The argument ```simdir``` is the name of the subdirectory in which to store all simulation data. This does not have to exist at the time the simulation object is initialized. The key word arguments available to the user, along with the default values for these arguments, are described in [simulation_kwargs](README_tables/simulation_kwargs.md). @@ -264,7 +264,7 @@ sim.run() To run a previously created set of initial conditions, first read the old output file into Python, and then run it. Note that Swiftest will look in the ```/simdata``` subdirectory for the initial conditions by default. You may set a new path to the initial conditions using the ```param_file``` keyword argument. ``` -sim = swiftest.Simulation(read_param=True, param_file='path/to/param.in') +sim = swiftest.Simulation(simdir = "directory_name", read_old_output=True) sim.run() ``` @@ -298,7 +298,7 @@ To read in a Swiftest output file, simply create a new Python script in the simu ``` import swiftest -sim = swiftest.Simulation(param_file="PATH/TO/param.in") +sim = swiftest.Simulation(simdir = "directory_name", read_old_output=True) ``` All Swiftest data is now stored in the Xarray dataset ```sim.data``` and is easily processed, manipulated, and analyzed. @@ -323,8 +323,8 @@ To restart a Swiftest simulation via the Swiftest Python package, follow the out ``` import swiftest -sim = swiftest.Simulation(read_param=True, param_file='path/to/param.in') -sim.set_parameter(tstop=VAL) # Set a new stop time +sim = swiftest.Simulation(simdir = "directory_name", read_old_output=True) +sim.set_parameter(tstop=VAL) # Set a new stop time if desired sim.write_param() # Write simulation parameters to the param.in sim.run() ``` From 346dab05f9a247b2bbe8b681c6dcf96280cfa629 Mon Sep 17 00:00:00 2001 From: Carlisle Wishard Date: Thu, 15 Dec 2022 11:45:07 -0500 Subject: [PATCH 440/569] fixed typo --- README.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/README.md b/README.md index 203062473..79879b803 100644 --- a/README.md +++ b/README.md @@ -188,7 +188,7 @@ sim.add_solar_system_body(["Sun","Mercury","Venus","Earth","Mars","Jupiter","Sat User defined bodies can also be added to a Swiftest simulation through the Python package. Massive bodies and test particles can both be added using the ```add_body``` method. ``` -sim.add_body(**kwargs**) +sim.add_body(**kwargs) ``` The key word arguments available to the user for the ```add_body``` method are described in [add_body_kwargs](README_tables/add_body_kwargs.md). From f834e2ff029efc673af5e542edb1b7ea9e9ae037 Mon Sep 17 00:00:00 2001 From: Carlisle Wishard Date: Thu, 15 Dec 2022 11:45:42 -0500 Subject: [PATCH 441/569] added collision and encounter files to output list --- README.md | 17 ++++++++++------- 1 file changed, 10 insertions(+), 7 deletions(-) diff --git a/README.md b/README.md index 79879b803..b4d67bbbe 100644 --- a/README.md +++ b/README.md @@ -286,13 +286,16 @@ Where ```INTEGRATOR``` is your integrator of choice, either ```whm```, ```rmvs`` **Outputs** -Swiftest generates between 1 and 6 output files, depending on the input parameters selected and the method through which Swiftest was run. The output files are as follows: -- **bin.nc** - Always generated, the output file containing the information for every body in the system, recorded every ```ISTEP_OUT``` timesteps and written every ```DUMP_CADENCE```. -- **fraggle.log** - The log containing the record of each fragmentation event, including the properties of the colliding bodies, the collisional regime, and the properties of the fragments created, only if ```FRAGMENTATION``` is ```YES```, Swiftest SyMBA only, ASCII file format only -- **encounter_check_plpl_timer.log** - The log containing the encounter check timer for each massive body/massive body encounter, only if ```CHK_CLOSE```/```close_encounter_check``` is ```YES```/```True``` and ```ENCOUNTER_CHECK```/```encounter_check_loops``` is ```ADAPTIVE```, ASCII file format only -- **encounter_check_pltp_time.log** - The log containing the encounter check timer for each massive body/test particle encounter, only if ```CHK_CLOSE```/```close_encounter_check``` is ```YES```/```True``` and ```ENCOUNTER_CHECK```/```encounter_check_loops``` is ```ADAPTIVE```, ASCII file format only -- **interaction_timer.log** - The log containing the interaction loop timer for each interacting pair of bodies, only if ```INTERACTION_LOOPS``` is ```ADAPTIVE```, ASCII file format only -- **swiftest.log** - A log containing the input parameters and a brief updated on the status of the run. Only generated if Swiftest is run through the Python package. If Swiftest is run through the terminal, these updates are output directly to the terminal. +The number and type of output files generated by Swiftest depends on the input parameters selected and the method through which Swiftest was run. The standard output files are as follows: +- **data.nc** - Always generated, the output file containing the information for every body in the system, recorded every ```ISTEP_OUT``` timesteps and written every ```DUMP_CADENCE```. This file can be analyzed using the Swiftest Python package (```sim.data```). +- **fraggle.log** - The log containing the record of each fragmentation event, including the collisional regime, and the number of the fragments created, only if ```FRAGMENTATION``` is ```YES```, Swiftest SyMBA only. +- **swiftest.log** - A log containing a brief updated on the status of the run. Only generated if Swiftest is run through the Python package. If Swiftest is run through the terminal, these updates are output directly to the terminal. +- **collision_xxxxxx.nc** - The details of each collision that occurs in a simulation are recorded in a NetCDF file. Each collision receives its own file. These files are consolidated and can be analyzed using the Swiftest Python package (```sim.collisions```). Only if ```CHK_CLOSE```/```close_encounter_check``` is ```YES```/```True```. +- **encounter_xxxxxx.nc** - The details of each close encounter that occurs in a simulation are recorded in a NetCDF file. Each encounter receives its own file. These files are consolidated and can be analyzed using the Swiftest Python package (```sim.encounters```). Only if ```CHK_CLOSE```/```close_encounter_check``` is ```YES```/```True```. +- **init_cond.nc** - The initial conditions used to run the simulation. This file can be analyzed using the Swiftest Python package (```sim.init_cond```). +- **encounter_check_plpl_timer.log** - The log containing the encounter check timer for each massive body/massive body encounter, only if ```CHK_CLOSE```/```close_encounter_check``` is ```YES```/```True``` and ```ENCOUNTER_CHECK```/```encounter_check_loops``` is ```ADAPTIVE```. +- **encounter_check_pltp_time.log** - The log containing the encounter check timer for each massive body/test particle encounter, only if ```CHK_CLOSE```/```close_encounter_check``` is ```YES```/```True``` and ```ENCOUNTER_CHECK```/```encounter_check_loops``` is ```ADAPTIVE```. +- **interaction_timer.log** - The log containing the interaction loop timer for each interacting pair of bodies, only if ```INTERACTION_LOOPS``` is ```ADAPTIVE```. To read in a Swiftest output file, simply create a new Python script in the simulation directory. From d4afacf9ef70101e2b56123006f1092ac4bebcfb Mon Sep 17 00:00:00 2001 From: Carlisle Wishard Date: Thu, 15 Dec 2022 11:46:44 -0500 Subject: [PATCH 442/569] updated the fraggle.log format --- README.md | 126 ++++++------------------------------------------------ 1 file changed, 14 insertions(+), 112 deletions(-) diff --git a/README.md b/README.md index b4d67bbbe..2199f4565 100644 --- a/README.md +++ b/README.md @@ -356,133 +356,35 @@ To activate the Fraggle algorithm, set ```FRAGMENTATION```/```fragmentation``` t Fraggle distinguishes the following collisional regimes: (1) perfect merging, which includes the cratering, partial accretion, and graze-and-merge regimes of Leinhardt & Stewart 2012, (2) disruption, which includes the partial erosion regime of Leinhardt & Stewart 2012, (3) super-catastrophic disruption, and (4) hit-and-run events which can be either ‘pure’ or ‘disruptive’. -For every collision throughout the course of a simulation, Fraggle writes all details of the collision to the **fraggle.log** output file. An example of a collision, stored in the **fraggle.log** output file, is as follows: +For every collision throughout the course of a simulation, Fraggle writes a brief description of the collision to the **fraggle.log** output file. An example of a collision, stored in the **fraggle.log** output file, is as follows: ``` Fraggle logfile - ********************************************************************************************************************** - Collision between massive bodies detected at time t = 53287.8837501905 + ********************************************************************************************************************** + Collision between massive bodies detected at time t = 2.063709800335315E-006 ********************************************************************************************************************** -------------------------------------------------------------------- Fraggle collisional regime determination results -------------------------------------------------------------------- - ----------------------- Collider information ----------------------- - True number of colliders : 2 - Index list of true colliders : 46 59 - -------------------- Two-body equivalent values --------------------- - mass1 : 7.279963439341357E-008 - radius1 : 1.509673399450197E-005 - xb1 : -0.164526979999547 0.274220676062862 -1.874872430483121E-003 - vb1 : -10.3604371489563 -6.86832326672301 0.784240412278650 - rot1 : 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - Ip1 : 0.400000000000000 0.400000000000000 0.400000000000000 - L_spin1 : 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - L_orbit1 : 2.025082559023084E-013 -4.805611941169830E-014 8.130853354510135E-014 - mass2 : 3.639981719670679E-008 - radius2 : 1.198228571207825E-005 - xb2 : -0.164537935569248 0.274203936567747 -1.857479937042359E-003 - vb2 : -9.62196685949397 -6.65749989216304 -0.930400979141005 - rot2 : 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - Ip2 : 0.400000000000000 0.400000000000000 0.400000000000000 - L_spin2 : 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - L_orbit2 : 4.050165118023079E-013 -9.611223882570558E-014 1.626170670889251E-013 - ------------------------------ Regime ----------------------------- - Supercatastrophic disruption - ----------------------- Fragment information ---------------------- - Total mass of fragments : 1.091994515901204E-007 - Largest fragment mass : 6.712252746514322E-009 - Second-largest fragment mass : 2.697031548515946E-009 - Remaining fragment mass : 9.979016729509007E-008 - Center of mass position : -0.164530631856114 0.274215096231157 -1.869074932669534E-003 - Center of mass velocity : -10.1142803858022 -6.79804880853635 0.212693281805431 - Energy loss : 4.042796382680678E-021 + True number of colliders : 2 + Index list of true colliders : 1 2 + Regime: Disruption + Energy loss : 2.298848838233116E-022 -------------------------------------------------------------------- - Supercatastrophic disruption between Embryo_108 (17) and Planetesimal_165 (74) - Fraggle generating 25 fragments. - Fraggle try 1 - Fraggle failed due to high energy error: 2.228292487416184E-006 222.829248791199 + Disruption between Target (1) and Projectile (2) + Fraggle generating 28 fragments. Fraggle try 1 - Fraggle fragment generation succeeded after 2 tries + Fraggle fragment generation succeeded after 1 tries + Generating 28 fragments +``` - -------------------------------------------------------------------- - Fraggle fragment generation results - -------------------------------------------------------------------- - dL_tot should be very small - dL_tot | 4.7581E-18 - dE_tot should be negative and equal to Qloss - dE_tot |-6.4291E-16 - Qloss |-1.4019E-18 - dE - Qloss |-6.4151E-16 - ------------------------------------------------------------------------------------- - Individual fragment values (collisional system natural units) - mass - 1 6.146782468934672E-002 - ... - 25 9.385003231486798E-003 - x_coll - 1 0.316962058114018 -3.455343819627035E-002 -0.300006155462737 - ... - 25 -0.815265667032389 0.366308046064501 -2.21749663921913 - v_coll - 1 5.313828153210731E-002 -4.301810302840381E-003 -4.677161223686286E-002 - ... - 25 -6.377609897296144E-002 6.344417215259035E-002 -0.181654563778228 - xb - 1 -6075.62794432757 10126.4434063427 -69.3229971249382 - ... - 25 -6076.76017205272 10126.8442678270 -71.2404876086946 - vb - 1 -1.11732916805166 -0.791000868225230 -2.215784303111038E-002 - ... - 25 -1.23424354855673 -0.723254885769800 -0.157040794572475 - rot - 1 1.524406714701067E-002 -3.617486407307866E-003 6.120533573657602E-003 - ... - 25 0.349507539640067 -8.293972741700310E-002 0.140328208343859 - Generating 25 fragments +The details of the collision are stored in the simulation object (```sim.collisions```) which can be accessed using the Swiftest Python package. -------------------------------------------------------------------- - Fraggle fragment final body properties + -------------------------------------------------------------------- - id, name - 1 159 Newbody0000159 - ... - 25 183 Newbody0000183 - mass, Gmass - 1 6.712252746514322E-009 2.649791077120669E-007 - ... - 25 1.024837206049866E-009 4.045742296433080E-008 - radius - 1 6.820183146057143E-006 - ... - 25 3.645229682479472E-006 - xb - 1 -0.164522048834296 0.274214160557923 -1.877198805265405E-003 - ... - 25 -0.164552708451177 0.274225015493955 -1.929122567862225E-003 - vb - 1 -9.65510018491191 -6.83522174793328 -0.191471054783233 - ... - 25 -10.6653844315872 -6.24981301930138 -1.35702588643539 - xh - 1 -0.163736684665089 0.275484908115360 -1.873622658345619E-003 - ... - 25 -0.163767344281971 0.275495763051392 -1.925546420942439E-003 -vh - 1 -9.65588432804781 -6.83327438044371 -0.191474942854245 - ... - 25 -10.6661685747231 -6.24786565181180 -1.35702977450640 - rot - 1 4864.55998519625 -1154.38219041380 1953.13379450074 - ... - 25 111531.940620641 -26467.0363417388 44780.3713090889 - Ip - 1 0.400000000000000 0.400000000000000 0.400000000000000 - ... - 25 0.400000000000000 0.400000000000000 0.400000000000000 -``` **General Relativity** From bcf9787d168b1802c91d33cd81450e0eab51e959 Mon Sep 17 00:00:00 2001 From: Carlisle Wishard Date: Thu, 15 Dec 2022 11:47:04 -0500 Subject: [PATCH 443/569] added placeholder for encounter trajectory saving description --- README.md | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/README.md b/README.md index 2199f4565..6e6b17a0b 100644 --- a/README.md +++ b/README.md @@ -382,9 +382,9 @@ Fraggle logfile The details of the collision are stored in the simulation object (```sim.collisions```) which can be accessed using the Swiftest Python package. - -------------------------------------------------------------------- +**Encounter Trajectory Saving** - -------------------------------------------------------------------- +DO THIS **General Relativity** From 87339f3340d4ab5fe5b38e14292346c2d6993585 Mon Sep 17 00:00:00 2001 From: Carlisle April Wishard Date: Thu, 15 Dec 2022 12:28:18 -0500 Subject: [PATCH 444/569] tweaked the Basic_Simulation example to try to isolate bug --- examples/Basic_Simulation/initial_conditions.py | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/examples/Basic_Simulation/initial_conditions.py b/examples/Basic_Simulation/initial_conditions.py index b58522824..693e61f33 100644 --- a/examples/Basic_Simulation/initial_conditions.py +++ b/examples/Basic_Simulation/initial_conditions.py @@ -36,7 +36,8 @@ from numpy.random import default_rng # Initialize the simulation object as a variable. Arguments may be defined here or through the sim.run() method. -sim = swiftest.Simulation(fragmentation=True, minimum_fragment_mass = 2.5e-11, mtiny=2.5e-8) +#sim = swiftest.Simulation(fragmentation=True, minimum_fragment_mass = 2.5e-11, mtiny=2.5e-8) +sim = swiftest.Simulation() # 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"]) @@ -73,7 +74,8 @@ sim.add_body(name=name_tp, a=a_tp, e=e_tp, inc=inc_tp, capom=capom_tp, omega=omega_tp, capm=capm_tp) # Display the run configuration parameters. +sim.write_param() sim.get_parameter() # Run the simulation. Arguments may be defined here or thorugh the swiftest.Simulation() method. -sim.run(tstart=0.0, tstop=1.0e3, dt=0.01, tstep_out=1.0e0, dump_cadence=0) +sim.run(tstart=0.0, tstop=1.0e3, dt=0.01, istep_out=100, dump_cadence=10) From d395773fb5437359e51068333b40a6b5dbb2d929 Mon Sep 17 00:00:00 2001 From: Carlisle April Wishard Date: Thu, 15 Dec 2022 12:50:51 -0500 Subject: [PATCH 445/569] updated headers for python examples --- .../Fragmentation/swiftest_fragmentation.py | 49 +++++++++---------- examples/helio_gr_test/helio_gr_test.py | 29 +++++------ examples/whm_gr_test/whm_gr_test.py | 30 ++++++------ 3 files changed, 49 insertions(+), 59 deletions(-) diff --git a/examples/Fragmentation/swiftest_fragmentation.py b/examples/Fragmentation/swiftest_fragmentation.py index 2f4685929..d533bee0a 100644 --- a/examples/Fragmentation/swiftest_fragmentation.py +++ b/examples/Fragmentation/swiftest_fragmentation.py @@ -21,33 +21,24 @@ Output ------ -disruption/data.nc : A NetCDF file containing the simulation output. -disruption/dump_bin1.nc : A NetCDF file containing the necessary inputs to restart a simulation from t!=0. -disruption/dump_bin2.nc : A NetCDF file containing the necessary inputs to restart a simulation from t!=0. -disruption/dump_param1.in : An ASCII file containing the necessary parameters to restart a simulation. -disruption/dump_param2.in : An ASCII file containing the necessary parameters to restart a simulation. -disruption/fraggle.log : An ASCII file containing the information of any collisional events that occured. -disruption/init_cond.nc : A NetCDF file containing the initial conditions for the simulation. -disruption/param.in : An ASCII file containing the parameters for the simulation. -disruption/swiftest.log : An ASCII file containing the information on the status of the simulation as it runs. -hitandrun/data.nc : A NetCDF file containing the simulation output. -hitandrun/dump_bin1.nc : A NetCDF file containing the necessary inputs to restart a simulation from t!=0. -hitandrun/dump_bin2.nc : A NetCDF file containing the necessary inputs to restart a simulation from t!=0. -hitandrun/dump_param1.in : An ASCII file containing the necessary parameters to restart a simulation. -hitandrun/dump_param2.in : An ASCII file containing the necessary parameters to restart a simulation. -hitandrun/fraggle.log : An ASCII file containing the information of any collisional events that occured. -hitandrun/init_cond.nc : A NetCDF file containing the initial conditions for the simulation. -hitandrun/param.in : An ASCII file containing the parameters for the simulation. -hitandrun/swiftest.log : An ASCII file containing the information on the status of the simulation as it runs. -supercat/data.nc : A NetCDF file containing the simulation output. -supercat/dump_bin1.nc : A NetCDF file containing the necessary inputs to restart a simulation from t!=0. -supercat/dump_bin2.nc : A NetCDF file containing the necessary inputs to restart a simulation from t!=0. -supercat/dump_param1.in : An ASCII file containing the necessary parameters to restart a simulation. -supercat/dump_param2.in : An ASCII file containing the necessary parameters to restart a simulation. -supercat/fraggle.log : An ASCII file containing the information of any collisional events that occured. -supercat/init_cond.nc : A NetCDF file containing the initial conditions for the simulation. -supercat/param.in : An ASCII file containing the parameters for the simulation. -supercat/swiftest.log : An ASCII file containing the information on the status of the simulation as it runs. +Three subdirectories: +disruption/ +hitandrun/ +supercat/ + +Each subdirectory contains: +data.nc : A NetCDF file containing the simulation output. +init_cond.nc : A NetCDF file containing the initial conditions for the simulation. +collision_000001.nc : A NetCDF file containing the data for the collision. +encounter_000001.nc : A NetCDF file containing the data for the close encounter. +dump_bin1.nc : A NetCDF file containing the necessary inputs to restart a simulation from t!=0. +dump_bin2.nc : A NetCDF file containing the necessary inputs to restart a simulation from t!=0. +dump_param1.in : An ASCII file containing the necessary parameters to restart a simulation. +dump_param2.in : An ASCII file containing the necessary parameters to restart a simulation. +fraggle.log : An ASCII file containing the information of any collisional events that occured. +param.in : An ASCII file containing the parameters for the simulation. +swiftest.log : An ASCII file containing the information on the status of the simulation as it runs. + """ import swiftest import numpy as np @@ -66,6 +57,8 @@ sim_disruption.add_body(name="Projectile", rh=[1.0, 1.807993e-05, 0.0], vh=[-2.562596e-04, -6.280005, 0.0], Gmass=7e-10, radius=3.25e-6) # Display the run configuration parameters. sim_disruption.get_parameter() +# Write the parameters to the param.in +sim_disruption.write_param() # Run the simulation. sim_disruption.run() @@ -75,6 +68,7 @@ sim_hitandrun.add_body(name="Target", rh=[1.0, -4.2e-05, 0.0], vh=[0.0, 6.28, 0.0], Gmass=1e-7, radius=7e-6, rot=[0.0, 0.0, 6.0e4]) sim_hitandrun.add_body(name="Projectile", rh=[1.0, 4.2e-05, 0.0], vh=[-1.5, -6.28, 0.0], Gmass=7e-10, radius=3.25e-6, rot=[0.0, 0.0, 1.0e5]) sim_hitandrun.get_parameter() +sim_hitandrun.write_param() sim_hitandrun.run() # Do the same as above for the super-catastrophic disruption case. @@ -83,4 +77,5 @@ sim_supercat.add_body(name="Target", rh=[1.0, -4.2e-05, 0.0], vh=[0.0, 6.28, 0.0], Gmass=1e-7, radius=7e-6, rot=[0.0, 0.0, -6.0e4]) sim_supercat.add_body(name="Projectile", rh=[1.0, 4.2e-05, 0.0], vh=[1.0, -6.28, 0.0], Gmass=1e-8, radius=3.25e-6, rot=[0.0, 0.0, 1.0e5]) sim_supercat.get_parameter() +sim_supercat.write_param() sim_supercat.run() diff --git a/examples/helio_gr_test/helio_gr_test.py b/examples/helio_gr_test/helio_gr_test.py index 77ae66740..64ad2e388 100644 --- a/examples/helio_gr_test/helio_gr_test.py +++ b/examples/helio_gr_test/helio_gr_test.py @@ -24,22 +24,19 @@ helio_gr_mercury_precession.png : Portable Network Graphic file depicting the precession of Mercury's perihelion over time with data sourced from the JPL Horizons database, Swiftest run with general relativity, and Swiftest run without general relativity. -gr/data.nc : A NetCDF file containing the simulation output. -gr/dump_bin1.nc : A NetCDF file containing the necessary inputs to restart a simulation from t!=0. -gr/dump_bin2.nc : A NetCDF file containing the necessary inputs to restart a simulation from t!=0. -gr/dump_param1.in : An ASCII file containing the necessary parameters to restart a simulation. -gr/dump_param2.in : An ASCII file containing the necessary parameters to restart a simulation. -gr/init_cond.nc : A NetCDF file containing the initial conditions for the simulation. -gr/param.in : An ASCII file containing the parameters for the simulation. -gr/swiftest.log : An ASCII file containing the information on the status of the simulation as it runs. -nogr/data.nc : A NetCDF file containing the simulation output. -nogr/dump_bin1.nc : A NetCDF file containing the necessary inputs to restart a simulation from t!=0. -nogr/dump_bin2.nc : A NetCDF file containing the necessary inputs to restart a simulation from t!=0. -nogr/dump_param1.in : An ASCII file containing the necessary parameters to restart a simulation. -nogr/dump_param2.in : An ASCII file containing the necessary parameters to restart a simulation. -nogr/init_cond.nc : A NetCDF file containing the initial conditions for the simulation. -nogr/param.in : An ASCII file containing the parameters for the simulation. -nogr/swiftest.log : An ASCII file containing the information on the status of the simulation as it runs. +Two subdirectories: +gr/ +nogr/ + +Each subdirecotry contains: +data.nc : A NetCDF file containing the simulation output. +dump_bin1.nc : A NetCDF file containing the necessary inputs to restart a simulation from t!=0. +dump_bin2.nc : A NetCDF file containing the necessary inputs to restart a simulation from t!=0. +init_cond.nc : A NetCDF file containing the initial conditions for the simulation. +dump_param1.in : An ASCII file containing the necessary parameters to restart a simulation. +dump_param2.in : An ASCII file containing the necessary parameters to restart a simulation. +param.in : An ASCII file containing the parameters for the simulation. +swiftest.log : An ASCII file containing the information on the status of the simulation as it runs. """ import swiftest diff --git a/examples/whm_gr_test/whm_gr_test.py b/examples/whm_gr_test/whm_gr_test.py index f4dc185ab..ee66558d2 100644 --- a/examples/whm_gr_test/whm_gr_test.py +++ b/examples/whm_gr_test/whm_gr_test.py @@ -24,22 +24,20 @@ whm_gr_mercury_precession.png : Portable Network Graphic file depicting the precession of Mercury's perihelion over time with data sourced from the JPL Horizons database, Swiftest run with general relativity, and Swiftest run without general relativity. -gr/data.nc : A NetCDF file containing the simulation output. -gr/dump_bin1.nc : A NetCDF file containing the necessary inputs to restart a simulation from t!=0. -gr/dump_bin2.nc : A NetCDF file containing the necessary inputs to restart a simulation from t!=0. -gr/dump_param1.in : An ASCII file containing the necessary parameters to restart a simulation. -gr/dump_param2.in : An ASCII file containing the necessary parameters to restart a simulation. -gr/init_cond.nc : A NetCDF file containing the initial conditions for the simulation. -gr/param.in : An ASCII file containing the parameters for the simulation. -gr/swiftest.log : An ASCII file containing the information on the status of the simulation as it runs. -nogr/data.nc : A NetCDF file containing the simulation output. -nogr/dump_bin1.nc : A NetCDF file containing the necessary inputs to restart a simulation from t!=0. -nogr/dump_bin2.nc : A NetCDF file containing the necessary inputs to restart a simulation from t!=0. -nogr/dump_param1.in : An ASCII file containing the necessary parameters to restart a simulation. -nogr/dump_param2.in : An ASCII file containing the necessary parameters to restart a simulation. -nogr/init_cond.nc : A NetCDF file containing the initial conditions for the simulation. -nogr/param.in : An ASCII file containing the parameters for the simulation. -nogr/swiftest.log : An ASCII file containing the information on the status of the simulation as it runs. + +Two subdirectories: +gr/ +nogr/ + +Each subdirecotry contains: +data.nc : A NetCDF file containing the simulation output. +dump_bin1.nc : A NetCDF file containing the necessary inputs to restart a simulation from t!=0. +dump_bin2.nc : A NetCDF file containing the necessary inputs to restart a simulation from t!=0. +init_cond.nc : A NetCDF file containing the initial conditions for the simulation. +dump_param1.in : An ASCII file containing the necessary parameters to restart a simulation. +dump_param2.in : An ASCII file containing the necessary parameters to restart a simulation. +param.in : An ASCII file containing the parameters for the simulation. +swiftest.log : An ASCII file containing the information on the status of the simulation as it runs. """ import swiftest From de53408189560f83566670d68cd8096ff4acd491 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Fri, 16 Dec 2022 08:07:34 -0500 Subject: [PATCH 446/569] Refactored and restructured Fraggle --- src/fraggle/fraggle_generate.f90 | 401 ++++++++++++++++++------------- src/fraggle/fraggle_io.f90 | 8 +- src/fraggle/fraggle_regime.f90 | 26 +- src/fraggle/fraggle_set.f90 | 214 ++++++++--------- src/fraggle/fraggle_setup.f90 | 6 +- src/fraggle/fraggle_util.f90 | 84 +++---- src/modules/fraggle_classes.f90 | 36 +-- src/modules/swiftest_classes.f90 | 6 +- src/util/util_minimize_bfgs.f90 | 7 +- 9 files changed, 422 insertions(+), 366 deletions(-) diff --git a/src/fraggle/fraggle_generate.f90 b/src/fraggle/fraggle_generate.f90 index 54b431287..bd1df3227 100644 --- a/src/fraggle/fraggle_generate.f90 +++ b/src/fraggle/fraggle_generate.f90 @@ -38,6 +38,7 @@ module subroutine fraggle_generate_fragments(self, colliders, system, param, lfa logical, dimension(size(IEEE_ALL)) :: fpe_halting_modes, fpe_quiet_modes logical, dimension(size(IEEE_USUAL)) :: fpe_flag character(len=STRMAX) :: message + real(DP), dimension(NDIM) :: runit, vunit ! The minimization and linear solvers can sometimes lead to floating point exceptions. Rather than halting the code entirely if this occurs, we ! can simply fail the attempt and try again. So we need to turn off any floating point exception halting modes temporarily @@ -45,7 +46,7 @@ module subroutine fraggle_generate_fragments(self, colliders, system, param, lfa fpe_quiet_modes(:) = .false. call ieee_set_halting_mode(IEEE_ALL,fpe_quiet_modes) - associate(frag => self, nfrag => self%nbody, pl => system%pl) + associate(fragments => self, nfrag => self%nbody, pl => system%pl) write(message,*) nfrag call io_log_one_message(FRAGGLE_LOG_OUT, "Fraggle generating " // trim(adjustl(message)) // " fragments.") @@ -55,7 +56,16 @@ module subroutine fraggle_generate_fragments(self, colliders, system, param, lfa lfailure = .true. return end if - f_spin = F_SPIN_FIRST + + ! Get the unit vectors for the relative position and velocity vectors. These are used to shift the fragment cloud depending on the + runit(:) = colliders%rb(:,2) - colliders%rb(:,1) + runit(:) = runit(:) / (.mag. runit(:)) + + vunit(:) = colliders%vb(:,2) - colliders%vb(:,1) + vunit(:) = vunit(:) / (.mag. vunit(:)) + + ! This is a factor that will "distort" the shape of the frgment cloud in the direction of the impact velocity + f_spin= .mag. (runit(:) .cross. vunit(:)) if (param%lflatten_interactions) then lk_plpl = allocated(pl%k_plpl) @@ -64,73 +74,74 @@ module subroutine fraggle_generate_fragments(self, colliders, system, param, lfa lk_plpl = .false. end if - call frag%set_natural_scale(colliders) + call fragments%set_natural_scale(colliders) - call frag%reset() + call fragments%reset() ! Calculate the initial energy of the system without the collisional family - call frag%get_energy_and_momentum(colliders, system, param, lbefore=.true.) + call fragments%get_energy_and_momentum(colliders, system, param, lbefore=.true.) ! Start out the fragments close to the initial separation distance. This will be increased if there is any overlap or we fail to find a solution - r_max_start = 2 * norm2(colliders%rb(:,2) - colliders%rb(:,1)) + r_max_start = 1.2_DP * (norm2(colliders%rb(:,2) - colliders%rb(:,1))) lfailure = .false. try = 1 do while (try < MAXTRY) write(message,*) try call io_log_one_message(FRAGGLE_LOG_OUT, "Fraggle try " // trim(adjustl(message))) if (lfailure) then - call frag%restructure(colliders, try, f_spin, r_max_start) - call frag%reset() + call fragments%restructure(colliders, try, f_spin, r_max_start) + call fragments%reset() try = try + 1 end if lfailure = .false. call ieee_set_flag(ieee_all, .false.) ! Set all fpe flags to quiet - call fraggle_generate_pos_vec(frag, colliders, r_max_start) - call frag%set_coordinate_system(colliders) + call fraggle_generate_pos_vec(fragments, colliders, r_max_start) + call fragments%set_coordinate_system(colliders) ! Initial velocity guess will be the barycentric velocity of the colliding system so that the budgets are based on the much smaller collisional-frame velocities do concurrent (i = 1:nfrag) - frag%vb(:, i) = frag%vbcom(:) + fragments%vb(:, i) = fragments%vbcom(:) end do - call frag%get_energy_and_momentum(colliders, system, param, lbefore=.false.) - call frag%set_budgets() + call fragments%get_energy_and_momentum(colliders, system, param, lbefore=.false.) + call fragments%set_budgets() - call fraggle_generate_spins(frag, f_spin, lfailure) + call fraggle_generate_spins(fragments, colliders, f_spin, lfailure) if (lfailure) then call io_log_one_message(FRAGGLE_LOG_OUT, "Fraggle failed to find spins") cycle end if - call fraggle_generate_tan_vel(frag, lfailure) + call fraggle_generate_tan_vel(fragments, colliders, lfailure) if (lfailure) then call io_log_one_message(FRAGGLE_LOG_OUT, "Fraggle failed to find tangential velocities") cycle end if - call fraggle_generate_rad_vel(frag, lfailure) + call fraggle_generate_rad_vel(fragments, colliders, lfailure) if (lfailure) then call io_log_one_message(FRAGGLE_LOG_OUT, "Fraggle failed to find radial velocities") cycle end if - call frag%get_energy_and_momentum(colliders, system, param, lbefore=.false.) - dEtot = frag%Etot_after - frag%Etot_before - dLmag = .mag. (frag%Ltot_after(:) - frag%Ltot_before(:)) + call fragments%get_energy_and_momentum(colliders, system, param, lbefore=.false.) + dEtot = fragments%Etot_after - fragments%Etot_before + dLmag = .mag. (fragments%Ltot_after(:) - fragments%Ltot_before(:)) + exit - lfailure = ((abs(dEtot + frag%Qloss) > FRAGGLE_ETOL) .or. (dEtot > 0.0_DP)) + lfailure = ((abs(dEtot + fragments%Qloss) > FRAGGLE_ETOL) .or. (dEtot > 0.0_DP)) if (lfailure) then - write(message, *) dEtot, abs(dEtot + frag%Qloss) / FRAGGLE_ETOL + write(message, *) dEtot, abs(dEtot + fragments%Qloss) / FRAGGLE_ETOL call io_log_one_message(FRAGGLE_LOG_OUT, "Fraggle failed due to high energy error: " // & trim(adjustl(message))) cycle end if - lfailure = ((abs(dLmag) / (.mag.frag%Ltot_before)) > FRAGGLE_LTOL) + lfailure = ((abs(dLmag) / (.mag.fragments%Ltot_before)) > FRAGGLE_LTOL) if (lfailure) then - write(message,*) dLmag / (.mag.frag%Ltot_before(:)) + write(message,*) dLmag / (.mag.fragments%Ltot_before(:)) call io_log_one_message(FRAGGLE_LOG_OUT, "Fraggle failed due to high angular momentum error: " // & trim(adjustl(message))) cycle @@ -142,8 +153,8 @@ module subroutine fraggle_generate_fragments(self, colliders, system, param, lfa if (.not.lfailure) exit write(message,*) "Fraggle failed due to a floating point exception: ", fpe_flag call io_log_one_message(FRAGGLE_LOG_OUT, message) - end do + end do write(message,*) try if (lfailure) then call io_log_one_message(FRAGGLE_LOG_OUT, "Fraggle fragment generation failed after " // & @@ -153,7 +164,7 @@ module subroutine fraggle_generate_fragments(self, colliders, system, param, lfa trim(adjustl(message)) // " tries") end if - call frag%set_original_scale(colliders) + call fragments%set_original_scale(colliders) ! Restore the big array if (lk_plpl) call pl%flatten(param) @@ -164,7 +175,7 @@ module subroutine fraggle_generate_fragments(self, colliders, system, param, lfa end subroutine fraggle_generate_fragments - subroutine fraggle_generate_pos_vec(frag, colliders, r_max_start) + subroutine fraggle_generate_pos_vec(fragments, colliders, r_max_start) !! Author: Jennifer L.L. Pouplin, Carlisle A. Wishard, and David A. Minton !! !! Initializes the orbits of the fragments around the center of mass. The fragments are initially placed on a plane defined by the @@ -172,72 +183,83 @@ subroutine fraggle_generate_pos_vec(frag, colliders, r_max_start) !! The initial positions do not conserve energy or momentum, so these need to be adjusted later. implicit none ! Arguments - class(fraggle_fragments), intent(inout) :: frag !! Fraggle fragment system object + class(fraggle_fragments), intent(inout) :: fragments !! Fraggle fragment system object class(fraggle_colliders), intent(inout) :: colliders !! Fraggle collider system object real(DP), intent(in) :: r_max_start !! Initial guess for the starting maximum radial distance of fragments ! Internals - real(DP) :: dis, rad, r_max - real(DP), dimension(NDIM) :: runit + real(DP) :: dis, rad, r_max, fdistort + real(DP), dimension(NDIM) :: runit, vunit logical, dimension(:), allocatable :: loverlap integer(I4B) :: i, j - logical :: lfixdir + logical :: lnoncat, lhitandrun - associate(nfrag => frag%nbody) + associate(nfrag => fragments%nbody) allocate(loverlap(nfrag)) + lnoncat = (fragments%regime /= COLLRESOLVE_REGIME_SUPERCATASTROPHIC) ! For non-catastrophic impacts, make the fragments act like ejecta and point away from the impact point + lhitandrun = (fragments%regime == COLLRESOLVE_REGIME_HIT_AND_RUN) ! Disruptive hit and runs have their own fragment distribution + ! Place the fragments into a region that is big enough that we should usually not have overlapping bodies ! An overlapping bodies will collide in the next time step, so it's not a major problem if they do (it just slows the run down) r_max = r_max_start rad = sum(colliders%radius(:)) - lfixdir = (frag%regime /= COLLRESOLVE_REGIME_SUPERCATASTROPHIC) ! For this style of impact, make the fragments act like eject and point away from the impact point - runit(:) = colliders%rb(:,2) - colliders%rb(:,1) + ! Get the unit vectors for the relative position and velocity vectors. These are used to shift the fragment cloud depending on the + runit(:) = colliders%rb(:,2) - colliders%rb(:,1) runit(:) = runit(:) / (.mag. runit(:)) + vunit(:) = colliders%vb(:,2) - colliders%vb(:,1) + vunit(:) = vunit(:) / (.mag. vunit(:)) + + ! This is a factor that will "distort" the shape of the frgment cloud in the direction of the impact velocity + fdistort = .mag. (runit(:) .cross. vunit(:)) + ! We will treat the first two fragments of the list as special cases. They get initialized the maximum distances apart along the original impactor distance vector. ! This is done because in a regular disruption, the first body is the largest, the second the second largest, and the rest are smaller equal-mass fragments. - call random_number(frag%x_coll(:,3:nfrag)) + call random_number(fragments%r_coll(:,3:nfrag)) loverlap(:) = .true. do while (any(loverlap(3:nfrag))) - frag%x_coll(:, 1) = colliders%rb(:, 1) - frag%rbcom(:) - frag%x_coll(:, 2) = colliders%rb(:, 2) - frag%rbcom(:) + fragments%r_coll(:, 1) = colliders%rb(:, 1) - fragments%rbcom(:) + fragments%r_coll(:, 2) = colliders%rb(:, 2) - fragments%rbcom(:) r_max = r_max + 0.1_DP * rad do i = 3, nfrag if (loverlap(i)) then - call random_number(frag%x_coll(:,i)) - frag%x_coll(:, i) = 2 * (frag%x_coll(:, i) - 0.5_DP) * r_max - frag%x_coll(:, i) = frag%x_coll(:, i) + (frag%rbimp(:) - frag%rbcom(:)) ! Shift the center of the fragment cloud to the impact point rather than the CoM - if (lfixdir .and. dot_product(frag%x_coll(:,i), runit(:)) < 0.0_DP) frag%x_coll(:, i) = -frag%x_coll(:, i) ! Make sure the fragment cloud points away from the impact point + call random_number(fragments%r_coll(:,i)) + fragments%r_coll(:,i) = 2 * (fragments%r_coll(:, i) - 0.5_DP) + fragments%r_coll(:, i) = fragments%r_coll(:,i) + fdistort * vunit(:) + fragments%r_coll(:, i) = r_max * fragments%r_coll(:, i) + fragments%r_coll(:, i) = fragments%r_coll(:, i) + (fragments%rbimp(:) - fragments%rbcom(:)) ! Shift the center of the fragment cloud to the impact point rather than the CoM + !if (lnoncat .and. dot_product(fragments%r_coll(:,i), runit(:)) < 0.0_DP) fragments%r_coll(:, i) = -fragments%r_coll(:, i) ! Make sure the fragment cloud points away from the impact point end if end do loverlap(:) = .false. do j = 1, nfrag do i = j + 1, nfrag - dis = norm2(frag%x_coll(:,j) - frag%x_coll(:,i)) - loverlap(i) = loverlap(i) .or. (dis <= (frag%radius(i) + frag%radius(j))) + dis = norm2(fragments%r_coll(:,j) - fragments%r_coll(:,i)) + loverlap(i) = loverlap(i) .or. (dis <= (fragments%radius(i) + fragments%radius(j))) end do end do end do - call fraggle_util_shift_vector_to_origin(frag%mass, frag%x_coll) - call frag%set_coordinate_system(colliders) + call fraggle_util_shift_vector_to_origin(fragments%mass, fragments%r_coll) + call fragments%set_coordinate_system(colliders) do concurrent(i = 1:nfrag) - frag%rb(:,i) = frag%x_coll(:,i) + frag%rbcom(:) + fragments%rb(:,i) = fragments%r_coll(:,i) + fragments%rbcom(:) end do - frag%rbcom(:) = 0.0_DP + fragments%rbcom(:) = 0.0_DP do concurrent(i = 1:nfrag) - frag%rbcom(:) = frag%rbcom(:) + frag%mass(i) * frag%rb(:,i) + fragments%rbcom(:) = fragments%rbcom(:) + fragments%mass(i) * fragments%rb(:,i) end do - frag%rbcom(:) = frag%rbcom(:) / frag%mtot + fragments%rbcom(:) = fragments%rbcom(:) / fragments%mtot end associate return end subroutine fraggle_generate_pos_vec - subroutine fraggle_generate_spins(frag, f_spin, lfailure) + subroutine fraggle_generate_spins(fragments, colliders, f_spin, lfailure) !! Author: Jennifer L.L. Pouplin, Carlisle A. Wishard, and David A. Minton !! !! Calculates the spins of a collection of fragments such that they conserve angular momentum without blowing the fragment kinetic energy budget. @@ -245,51 +267,77 @@ subroutine fraggle_generate_spins(frag, f_spin, lfailure) !! A failure will trigger a restructuring of the fragments so we will try new values of the radial position distribution. implicit none ! Arguments - class(fraggle_fragments), intent(inout) :: frag !! Fraggle fragment system object + class(fraggle_fragments), intent(inout) :: fragments !! Fraggle fragment system object + class(fraggle_colliders), intent(inout) :: colliders !! Fraggle collider system object real(DP), intent(in) :: f_spin !! Fraction of energy or momentum that goes into spin (whichever gives the lowest kinetic energy) logical, intent(out) :: lfailure !! Logical flag indicating whether this step fails or succeeds! ! Internals - real(DP), dimension(NDIM) :: L_remainder, rot_L, rot_ke + real(DP), dimension(NDIM) :: L_remainder, rot_L, rot_ke, L + real(DP), dimension(NDIM,fragments%nbody) :: frot_rand ! The random rotation factor applied to fragments + real(DP), parameter :: frot_rand_mag = 1.50_DP ! The magnitude of the rotation variation to apply to the fragments integer(I4B) :: i character(len=STRMAX) :: message + real(DP) :: ke_remainder, ke - associate(nfrag => frag%nbody) + associate(nfrag => fragments%nbody) lfailure = .false. + L_remainder(:) = fragments%L_budget(:) + ke_remainder = fragments%ke_budget - ! Start the first two bodies with the same rotation as the original two impactors, then distribute the remaining angular momentum among the rest - L_remainder(:) = frag%L_budget(:) - frag%rot(:,:) = 0.0_DP + ! Add a fraction of the orbit angular momentum of the second body to the spin of the first body to kick things off + L(:) = colliders%L_spin(:,1) + f_spin * (colliders%L_orbit(:,2) + colliders%L_spin(:,2)) + fragments%rot(:,1) = L(:) / (fragments%mass(1) * fragments%radius(1)**2 * fragments%Ip(3,1)) + L_remainder(:) = L_remainder(:) - L(:) - frag%ke_spin = 0.0_DP + ! Partition the spin momentum of the second body into the spin of the fragments, with some random variation + L(:) = colliders%L_spin(:,2) / (nfrag - 1) + + call random_number(frot_rand(:,2:nfrag)) + frot_rand(:,2:nfrag) = 2 * (frot_rand(:,2:nfrag) - 0.5_DP) * frot_rand_mag + + do i = 2, nfrag + rot_L(:) = L(:) + frot_rand(:,i) * .mag.L(:) + fragments%rot(:,i) = rot_L(:) / (fragments%mass(i) * fragments%radius(i)**2 * fragments%Ip(3,1)) + L_remainder(:) = L_remainder(:) - rot_L(:) + end do + + ! Make sure we didn't blow our kinetic energy budget + do i = 1, nfrag + ke_remainder = ke_remainder - 0.5_DP * fragments%mass(i) * fragments%Ip(3, i) * fragments%radius(i)**2 * norm2(fragments%rot(:, i)) + end do + + ! Distributed most of the remaining angular momentum amongst all the particles + fragments%ke_spin = 0.0_DP if (norm2(L_remainder(:)) > FRAGGLE_LTOL) then - do i = 1, nfrag + do i = nfrag, 1, -1 ! Convert a fraction (f_spin) of either the remaining angular momentum or kinetic energy budget into spin, whichever gives the smaller rotation so as not to blow any budgets - rot_ke(:) = sqrt(2 * f_spin * frag%ke_budget / (nfrag * frag%mass(i) * frag%radius(i)**2 * frag%Ip(3, i))) & - * L_remainder(:) / norm2(L_remainder(:)) - rot_L(:) = f_spin * L_remainder(:) / (nfrag * frag%mass(i) * frag%radius(i)**2 * frag%Ip(3, i)) + rot_ke(:) = sqrt(2 * f_spin * ke_remainder / (i * fragments%mass(i) * fragments%radius(i)**2 * fragments%Ip(3, i))) * L_remainder(:) / norm2(L_remainder(:)) + rot_L(:) = f_spin * L_remainder(:) / (i * fragments%mass(i) * fragments%radius(i)**2 * fragments%Ip(3, i)) if (norm2(rot_ke) < norm2(rot_L)) then - frag%rot(:,i) = rot_ke(:) + fragments%rot(:,i) = fragments%rot(:,i) + rot_ke(:) else - frag%rot(:, i) = rot_L(:) + fragments%rot(:, i) = fragments%rot(:,i) + rot_L(:) end if - frag%ke_spin = frag%ke_spin + frag%mass(i) * frag%Ip(3, i) * frag%radius(i)**2 & - * dot_product(frag%rot(:, i), frag%rot(:, i)) + ke = 0.5_DP * fragments%mass(i) * fragments%Ip(3, i) * fragments%radius(i)**2 * norm2(fragments%rot(:, i)) + L(:) = fragments%mass(i) * fragments%radius(i)**2 * fragments%Ip(3, i) * fragments%rot(:, i) + ke_remainder = ke_remainder - ke + L_remainder(:) = L_remainder(:) - L(:) + fragments%ke_spin = fragments%ke_spin + ke end do end if - frag%ke_spin = 0.5_DP * frag%ke_spin - lfailure = ((frag%ke_budget - frag%ke_spin - frag%ke_orbit) < 0.0_DP) + lfailure = ((fragments%ke_budget - fragments%ke_spin - fragments%ke_orbit) < 0.0_DP) if (lfailure) then call io_log_one_message(FRAGGLE_LOG_OUT, " ") call io_log_one_message(FRAGGLE_LOG_OUT, "Spin failure diagnostics") - write(message, *) frag%ke_budget + write(message, *) fragments%ke_budget call io_log_one_message(FRAGGLE_LOG_OUT, "ke_budget : " // trim(adjustl(message))) - write(message, *) frag%ke_spin + write(message, *) fragments%ke_spin call io_log_one_message(FRAGGLE_LOG_OUT, "ke_spin : " // trim(adjustl(message))) - write(message, *) frag%ke_orbit + write(message, *) fragments%ke_orbit call io_log_one_message(FRAGGLE_LOG_OUT, "ke_orbit : " // trim(adjustl(message))) - write(message, *) frag%ke_budget - frag%ke_spin - frag%ke_orbit + write(message, *) fragments%ke_budget - fragments%ke_spin - fragments%ke_orbit call io_log_one_message(FRAGGLE_LOG_OUT, "ke_remainder : " // trim(adjustl(message))) end if @@ -299,12 +347,12 @@ subroutine fraggle_generate_spins(frag, f_spin, lfailure) end subroutine fraggle_generate_spins - subroutine fraggle_generate_tan_vel(frag, lfailure) + subroutine fraggle_generate_tan_vel(fragments, colliders, lfailure) !! Author: Jennifer L.L. Pouplin, Carlisle A. Wishard, and David A. Minton !! !! Adjusts the tangential velocities and spins of a collection of fragments such that they conserve angular momentum without blowing the fragment kinetic energy budget. !! This procedure works in several stages, with a goal to solve the angular and linear momentum constraints on the fragments, while still leaving a positive balance of - !! our fragment kinetic energy (frag%ke_budget) that we can put into the radial velocity distribution. + !! our fragment kinetic energy (fragments%ke_budget) that we can put into the radial velocity distribution. !! !! The first thing we'll try to do is solve for the tangential velocities of the first 6 fragments, using angular and linear momentum as constraints and an initial !! tangential velocity distribution for the remaining bodies (if there are any) that distributes their angular momentum equally between them. @@ -314,86 +362,86 @@ subroutine fraggle_generate_tan_vel(frag, lfailure) !! A failure will trigger a restructuring of the fragments so we will try new values of the radial position distribution. implicit none ! Arguments - class(fraggle_fragments), intent(inout) :: frag !! Fraggle fragment system object + class(fraggle_fragments), intent(inout) :: fragments !! Fraggle fragment system object + class(fraggle_colliders), intent(inout) :: colliders !! Fraggle collider system object logical, intent(out) :: lfailure !! Logical flag indicating whether this step fails or succeeds ! Internals - integer(I4B) :: i - real(DP), parameter :: TOL_MIN = 1e-1_DP ! This doesn't have to be very accurate, as we really just want a tangential velocity distribution with less kinetic energy than our initial guess. - real(DP), parameter :: TOL_INIT = 1e-14_DP - real(DP), parameter :: VNOISE_MAG = 1e-3_DP !! Magnitude of the noise to apply to initial conditions to help minimizer find a solution in case of failure + integer(I4B) :: i, try + real(DP), parameter :: TOL_MIN = 1e0_DP ! This doesn't have to be very accurate, as we really just want a tangential velocity distribution with less kinetic energy than our initial guess. + real(DP), parameter :: TOL_INIT = 1e-12_DP + real(DP), parameter :: VNOISE_MAG = 1e-1_DP !! Magnitude of the noise to apply to initial conditions to help minimizer find a solution in case of failure integer(I4B), parameter :: MAXLOOP = 10 + integer(I4B), parameter :: MAXTRY = 100 real(DP) :: tol - real(DP), dimension(:), allocatable :: v_t_initial - real(DP), dimension(frag%nbody) :: kefrag, vnoise + real(DP), dimension(:), allocatable :: v_t_initial, v_t_output + real(DP), dimension(fragments%nbody) :: kefrag, vnoise type(lambda_obj_err) :: objective_function - real(DP), dimension(NDIM) :: Li, L_remainder, L_frag_tot + real(DP), dimension(NDIM) :: L_frag_tot character(len=STRMAX) :: message + real(DP) :: ke_diff - associate(nfrag => frag%nbody) + associate(nfrag => fragments%nbody) lfailure = .false. - allocate(v_t_initial, mold=frag%v_t_mag) - v_t_initial(:) = 0.0_DP - frag%v_coll(:,:) = 0.0_DP + allocate(v_t_initial, mold=fragments%v_t_mag) + do try = 1, MAXTRY + v_t_initial(1) = dot_product(colliders%vb(:,1),fragments%v_t_unit(:,1)) + do i = 2, nfrag + v_t_initial(i) = dot_product(colliders%vb(:,2), fragments%v_t_unit(:,i)) + end do + fragments%v_t_mag(:) = v_t_initial + + ! Find the local kinetic energy minimum for the system that conserves linear and angular momentum + objective_function = lambda_obj(tangential_objective_function, lfailure) + + tol = TOL_INIT + do while(tol < TOL_MIN) + call util_minimize_bfgs(objective_function, nfrag-6, v_t_initial(7:nfrag), tol, MAXLOOP, lfailure, v_t_output) + fragments%v_t_mag(7:nfrag) = v_t_output(:) + ! Now that the KE-minimized values of the i>6 fragments are found, calculate the momentum-conserving solution for tangential velociteis + v_t_initial(7:nfrag) = fragments%v_t_mag(7:nfrag) + if (.not.lfailure) exit + tol = tol * 2_DP ! Keep increasing the tolerance until we converge on a solution + call random_number(vnoise(1:nfrag)) ! Adding a bit of noise to the initial conditions helps it find a solution more often + vnoise(:) = 1.0_DP + VNOISE_MAG * (2 * vnoise(:) - 1._DP) + v_t_initial(:) = v_t_initial(:) * vnoise(:) + end do + fragments%v_t_mag(1:nfrag) = solve_fragment_tan_vel(v_t_mag_input=v_t_initial(7:nfrag), lfailure=lfailure) - ! Next we will solve for the tangential component of the velocities that both conserves linear momentum and uses the remaining angular momentum not used in spin. - ! This will be done using a linear solver that solves for the tangential velocities of the first 6 fragments, constrained by the linear and angular momentum vectors, - ! which is embedded in a non-linear minimizer that will adjust the tangential velocities of the remaining i>6 fragments to minimize kinetic energy for a given momentum solution - ! The initial conditions fed to the minimizer for the fragments will be the remaining angular momentum distributed between the fragments. - call frag%get_ang_mtm() - L_remainder(:) = frag%L_budget(:) - frag%L_spin(:) - do i = 1, nfrag - v_t_initial(i) = norm2(L_remainder(:)) / ((nfrag - i + 1) * frag%mass(i) * norm2(frag%x_coll(:,i))) - Li(:) = frag%mass(i) * (frag%x_coll(:,i) .cross. (v_t_initial(i) * frag%v_t_unit(:, i))) - L_remainder(:) = L_remainder(:) - Li(:) - end do + ! Perform one final shift of the radial velocity vectors to align with the center of mass of the collisional system (the origin) + fragments%vb(:,1:nfrag) = fraggle_util_vmag_to_vb(fragments%v_r_mag(1:nfrag), fragments%v_r_unit(:,1:nfrag), fragments%v_t_mag(1:nfrag), & + fragments%v_t_unit(:,1:nfrag), fragments%mass(1:nfrag), fragments%vbcom(:)) + do concurrent (i = 1:nfrag) + fragments%v_coll(:,i) = fragments%vb(:,i) - fragments%vbcom(:) + end do - ! Find the local kinetic energy minimum for the system that conserves linear and angular momentum - objective_function = lambda_obj(tangential_objective_function, lfailure) + ! Now do a kinetic energy budget check to make sure we are still within the budget. + kefrag = 0.0_DP + do concurrent(i = 1:nfrag) + kefrag(i) = fragments%mass(i) * dot_product(fragments%vb(:, i), fragments%vb(:, i)) + end do + fragments%ke_orbit = 0.5_DP * sum(kefrag(:)) - tol = TOL_INIT - do while(tol < TOL_MIN) - frag%v_t_mag(7:nfrag) = util_minimize_bfgs(objective_function, nfrag-6, v_t_initial(7:nfrag), tol, MAXLOOP, lfailure) - ! Now that the KE-minimized values of the i>6 fragments are found, calculate the momentum-conserving solution for tangential velociteis - v_t_initial(7:nfrag) = frag%v_t_mag(7:nfrag) + ! If we are over the energy budget, flag this as a failure so we can try again + ke_diff = fragments%ke_budget - fragments%ke_spin - fragments%ke_orbit + lfailure = ke_diff < 0.0_DP if (.not.lfailure) exit - tol = tol * 2_DP ! Keep increasing the tolerance until we converge on a solution - call random_number(vnoise(1:nfrag)) ! Adding a bit of noise to the initial conditions helps it find a solution more often - vnoise(:) = 1.0_DP + VNOISE_MAG * (2 * vnoise(:) - 1._DP) - v_t_initial(:) = v_t_initial(:) * vnoise(:) - end do - frag%v_t_mag(1:nfrag) = solve_fragment_tan_vel(v_t_mag_input=v_t_initial(7:nfrag), lfailure=lfailure) - - ! Perform one final shift of the radial velocity vectors to align with the center of mass of the collisional system (the origin) - frag%vb(:,1:nfrag) = fraggle_util_vmag_to_vb(frag%v_r_mag(1:nfrag), frag%v_r_unit(:,1:nfrag), frag%v_t_mag(1:nfrag), & - frag%v_t_unit(:,1:nfrag), frag%mass(1:nfrag), frag%vbcom(:)) - do concurrent (i = 1:nfrag) - frag%v_coll(:,i) = frag%vb(:,i) - frag%vbcom(:) + fragments%r_coll(:,:) = fragments%r_coll(:,:) * 1.1_DP end do - - ! Now do a kinetic energy budget check to make sure we are still within the budget. - kefrag = 0.0_DP - do concurrent(i = 1:nfrag) - kefrag(i) = frag%mass(i) * dot_product(frag%vb(:, i), frag%vb(:, i)) - end do - frag%ke_orbit = 0.5_DP * sum(kefrag(:)) - - ! If we are over the energy budget, flag this as a failure so we can try again - lfailure = ((frag%ke_budget - frag%ke_spin - frag%ke_orbit) < 0.0_DP) if (lfailure) then call io_log_one_message(FRAGGLE_LOG_OUT, " ") call io_log_one_message(FRAGGLE_LOG_OUT, "Tangential velocity failure diagnostics") - call frag%get_ang_mtm() - L_frag_tot = frag%L_spin(:) + frag%L_orbit(:) - write(message, *) .mag.(frag%L_budget(:) - L_frag_tot(:)) / (.mag.frag%Ltot_before(:)) + call fragments%get_ang_mtm() + L_frag_tot = fragments%L_spin(:) + fragments%L_orbit(:) + write(message, *) .mag.(fragments%L_budget(:) - L_frag_tot(:)) / (.mag.fragments%Ltot_before(:)) call io_log_one_message(FRAGGLE_LOG_OUT, "|L_remainder| : " // trim(adjustl(message))) - write(message, *) frag%ke_budget + write(message, *) fragments%ke_budget call io_log_one_message(FRAGGLE_LOG_OUT, "ke_budget : " // trim(adjustl(message))) - write(message, *) frag%ke_spin + write(message, *) fragments%ke_spin call io_log_one_message(FRAGGLE_LOG_OUT, "ke_spin : " // trim(adjustl(message))) - write(message, *) frag%ke_orbit + write(message, *) fragments%ke_orbit call io_log_one_message(FRAGGLE_LOG_OUT, "ke_tangential : " // trim(adjustl(message))) - write(message, *) frag%ke_budget - frag%ke_spin - frag%ke_orbit + write(message, *) fragments%ke_budget - fragments%ke_spin - fragments%ke_orbit call io_log_one_message(FRAGGLE_LOG_OUT, "ke_radial : " // trim(adjustl(message))) end if end associate @@ -418,7 +466,7 @@ function solve_fragment_tan_vel(lfailure, v_t_mag_input) result(v_t_mag_output) real(DP), dimension(2 * NDIM) :: b ! RHS of linear equation used to solve for momentum constraint in Gauss elimination code real(DP), dimension(NDIM) :: L_lin_others, L_orb_others, L, vtmp - associate(nfrag => frag%nbody) + associate(nfrag => fragments%nbody) lfailure = .false. ! We have 6 constraint equations (2 vector constraints in 3 dimensions each) ! The first 3 are that the linear momentum of the fragments is zero with respect to the collisional barycenter @@ -427,17 +475,17 @@ function solve_fragment_tan_vel(lfailure, v_t_mag_input) result(v_t_mag_output) L_orb_others(:) = 0.0_DP do i = 1, nfrag if (i <= 2 * NDIM) then ! The tangential velocities of the first set of bodies will be the unknowns we will solve for to satisfy the constraints - A(1:3, i) = frag%mass(i) * frag%v_t_unit(:, i) - A(4:6, i) = frag%mass(i) * frag%rmag(i) * (frag%v_r_unit(:, i) .cross. frag%v_t_unit(:, i)) + A(1:3, i) = fragments%mass(i) * fragments%v_t_unit(:, i) + A(4:6, i) = fragments%mass(i) * fragments%rmag(i) * (fragments%v_r_unit(:, i) .cross. fragments%v_t_unit(:, i)) else if (present(v_t_mag_input)) then - vtmp(:) = v_t_mag_input(i - 6) * frag%v_t_unit(:, i) - L_lin_others(:) = L_lin_others(:) + frag%mass(i) * vtmp(:) - L(:) = frag%mass(i) * (frag%x_coll(:, i) .cross. vtmp(:)) + vtmp(:) = v_t_mag_input(i - 6) * fragments%v_t_unit(:, i) + L_lin_others(:) = L_lin_others(:) + fragments%mass(i) * vtmp(:) + L(:) = fragments%mass(i) * (fragments%r_coll(:, i) .cross. vtmp(:)) L_orb_others(:) = L_orb_others(:) + L(:) end if end do b(1:3) = -L_lin_others(:) - b(4:6) = frag%L_budget(:) - frag%L_spin(:) - L_orb_others(:) + b(4:6) = fragments%L_budget(:) - fragments%L_spin(:) - L_orb_others(:) allocate(v_t_mag_output(nfrag)) v_t_mag_output(1:6) = util_solve_linear_system(A, b, 6, lfailure) if (present(v_t_mag_input)) v_t_mag_output(7:nfrag) = v_t_mag_input(:) @@ -458,19 +506,19 @@ function tangential_objective_function(v_t_mag_input, lfailure) result(fval) real(DP) :: fval ! Internals integer(I4B) :: i - real(DP), dimension(NDIM,frag%nbody) :: v_shift - real(DP), dimension(frag%nbody) :: v_t_new, kearr + real(DP), dimension(NDIM,fragments%nbody) :: v_shift + real(DP), dimension(fragments%nbody) :: v_t_new, kearr real(DP) :: keo - associate(nfrag => frag%nbody) + associate(nfrag => fragments%nbody) lfailure = .false. v_t_new(:) = solve_fragment_tan_vel(v_t_mag_input=v_t_mag_input(:), lfailure=lfailure) - v_shift(:,:) = fraggle_util_vmag_to_vb(frag%v_r_mag, frag%v_r_unit, v_t_new, frag%v_t_unit, frag%mass, frag%vbcom) + v_shift(:,:) = fraggle_util_vmag_to_vb(fragments%v_r_mag, fragments%v_r_unit, v_t_new, fragments%v_t_unit, fragments%mass, fragments%vbcom) kearr = 0.0_DP do concurrent(i = 1:nfrag) - kearr(i) = frag%mass(i) * dot_product(v_shift(:, i), v_shift(:, i)) + kearr(i) = fragments%mass(i) * dot_product(v_shift(:, i), v_shift(:, i)) end do keo = 0.5_DP * sum(kearr(:)) fval = keo @@ -483,14 +531,15 @@ end function tangential_objective_function end subroutine fraggle_generate_tan_vel - subroutine fraggle_generate_rad_vel(frag, lfailure) + subroutine fraggle_generate_rad_vel(fragments, colliders, lfailure) !! Author: Jennifer L.L. Pouplin, Carlisle A. Wishard, and David A. Minton !! !! !! Adjust the fragment velocities to set the fragment orbital kinetic energy. This will minimize the difference between the fragment kinetic energy and the energy budget implicit none ! Arguments - class(fraggle_fragments), intent(inout) :: frag !! Fraggle fragment system object + class(fraggle_fragments), intent(inout) :: fragments !! Fraggle fragment system object + class(fraggle_colliders), intent(inout) :: colliders !! Fraggle collider system object logical, intent(out) :: lfailure !! Logical flag indicating whether this step fails or succeeds! ! Internals real(DP), parameter :: TOL_MIN = FRAGGLE_ETOL ! This needs to be more accurate than the tangential step, as we are trying to minimize the total residual energy @@ -500,55 +549,61 @@ subroutine fraggle_generate_rad_vel(frag, lfailure) real(DP) :: ke_radial, tol integer(I4B) :: i real(DP), dimension(:), allocatable :: v_r_initial - real(DP), dimension(frag%nbody) :: vnoise + real(DP), dimension(fragments%nbody) :: vnoise type(lambda_obj) :: objective_function character(len=STRMAX) :: message - associate(nfrag => frag%nbody) + associate(nfrag => fragments%nbody) ! Set the "target" ke for the radial component - ke_radial = frag%ke_budget - frag%ke_spin - frag%ke_orbit - allocate(v_r_initial, source=frag%v_r_mag) - ! Initialize radial velocity magnitudes with a random value that related to equipartition of kinetic energy with some noise + allocate(v_r_initial, source=fragments%v_r_mag) + ! Initialize radial velocity magnitudes with a random value that related to equipartition of kinetic energy with some noise and scaled with respect to the initial distance + v_r_initial(1) = dot_product(colliders%vb(:,1),fragments%v_r_unit(:,1)) + fragments%ke_orbit = 0.5_DP * fragments%mass(1) * v_r_initial(1)**2 + + ke_radial = fragments%ke_budget - fragments%ke_spin - fragments%ke_orbit call random_number(vnoise(1:nfrag)) vnoise(:) = 1.0_DP + VNOISE_MAG * (2 * vnoise(:) - 1.0_DP) - v_r_initial(1:nfrag) = sqrt(abs(2 * ke_radial) / (frag%mass(1:nfrag) * nfrag)) * vnoise(1:nfrag) + v_r_initial(2:nfrag) = -sqrt(abs(2 * ke_radial) / (fragments%mass(1:nfrag) * nfrag)) * vnoise(1:nfrag) ! Initialize the lambda function using a structure constructor that calls the init method ! Minimize the ke objective function using the BFGS optimizer objective_function = lambda_obj(radial_objective_function) tol = TOL_INIT do while(tol < TOL_MIN) - frag%v_r_mag = util_minimize_bfgs(objective_function, nfrag, v_r_initial, tol, MAXLOOP, lfailure) + call util_minimize_bfgs(objective_function, nfrag, v_r_initial, tol, MAXLOOP, lfailure, fragments%v_r_mag) if (.not.lfailure) exit tol = tol * 2 ! Keep increasing the tolerance until we converge on a solution - v_r_initial(:) = frag%v_r_mag(:) + v_r_initial(:) = fragments%v_r_mag(:) call random_number(vnoise(1:nfrag)) ! Adding a bit of noise to the initial conditions helps it find a solution more often vnoise(:) = 1.0_DP + VNOISE_MAG * (2 * vnoise(:) - 1._DP) v_r_initial(:) = v_r_initial(:) * vnoise(:) end do ! Shift the radial velocity vectors to align with the center of mass of the collisional system (the origin) - frag%ke_orbit = 0.0_DP - frag%vb(:,1:nfrag) = fraggle_util_vmag_to_vb(frag%v_r_mag(1:nfrag), frag%v_r_unit(:,1:nfrag), & - frag%v_t_mag(1:nfrag), frag%v_t_unit(:,1:nfrag), frag%mass(1:nfrag), frag%vbcom(:)) + fragments%ke_orbit = 0.0_DP + fragments%ke_spin = 0.0_DP + fragments%vb(:,1:nfrag) = fraggle_util_vmag_to_vb(fragments%v_r_mag(1:nfrag), fragments%v_r_unit(:,1:nfrag), & + fragments%v_t_mag(1:nfrag), fragments%v_t_unit(:,1:nfrag), fragments%mass(1:nfrag), fragments%vbcom(:)) do i = 1, nfrag - frag%v_coll(:, i) = frag%vb(:, i) - frag%vbcom(:) - frag%ke_orbit = frag%ke_orbit + frag%mass(i) * dot_product(frag%vb(:, i), frag%vb(:, i)) + fragments%v_coll(:, i) = fragments%vb(:, i) - fragments%vbcom(:) + fragments%ke_orbit = fragments%ke_orbit + fragments%mass(i) * norm2(fragments%vb(:, i)) + fragments%ke_spin = fragments%ke_spin + fragments%mass(i) * fragments%radius(i)**2 * fragments%Ip(3,i) * norm2(fragments%rot(:,i)) end do - frag%ke_orbit = 0.5_DP * frag%ke_orbit + fragments%ke_orbit = 0.5_DP * fragments%ke_orbit + fragments%ke_spin = 0.5_DP * fragments%ke_spin - lfailure = abs((frag%ke_budget - (frag%ke_orbit + frag%ke_spin)) / frag%ke_budget) > FRAGGLE_ETOL + lfailure = abs((fragments%ke_budget - (fragments%ke_orbit + fragments%ke_spin)) / fragments%ke_budget) > FRAGGLE_ETOL if (lfailure) then call io_log_one_message(FRAGGLE_LOG_OUT, " ") call io_log_one_message(FRAGGLE_LOG_OUT, "Radial velocity failure diagnostics") - write(message, *) frag%ke_budget + write(message, *) fragments%ke_budget call io_log_one_message(FRAGGLE_LOG_OUT, "ke_budget : " // trim(adjustl(message))) - write(message, *) frag%ke_spin + write(message, *) fragments%ke_spin call io_log_one_message(FRAGGLE_LOG_OUT, "ke_spin : " // trim(adjustl(message))) - write(message, *) frag%ke_orbit + write(message, *) fragments%ke_orbit call io_log_one_message(FRAGGLE_LOG_OUT, "ke_orbit : " // trim(adjustl(message))) - write(message, *) frag%ke_budget - (frag%ke_orbit + frag%ke_spin) + write(message, *) fragments%ke_budget - (fragments%ke_orbit + fragments%ke_spin) call io_log_one_message(FRAGGLE_LOG_OUT, "ke_remainder : " // trim(adjustl(message))) end if @@ -569,20 +624,20 @@ function radial_objective_function(v_r_mag_input) result(fval) ! Internals integer(I4B) :: i real(DP), dimension(:,:), allocatable :: v_shift - real(DP), dimension(frag%nbody) :: kearr + real(DP), dimension(fragments%nbody) :: kearr real(DP) :: keo, ke_radial, rotmag2, vmag2 - allocate(v_shift, mold=frag%vb) - v_shift(:,:) = fraggle_util_vmag_to_vb(v_r_mag_input, frag%v_r_unit, frag%v_t_mag, frag%v_t_unit, frag%mass, frag%vbcom) - !$omp do simd firstprivate(frag) - do i = 1,frag%nbody - rotmag2 = frag%rot(1,i)**2 + frag%rot(2,i)**2 + frag%rot(3,i)**2 + allocate(v_shift, mold=fragments%vb) + v_shift(:,:) = fraggle_util_vmag_to_vb(v_r_mag_input, fragments%v_r_unit, fragments%v_t_mag, fragments%v_t_unit, fragments%mass, fragments%vbcom) + !$omp do simd firstprivate(fragments) + do i = 1,fragments%nbody + rotmag2 = fragments%rot(1,i)**2 + fragments%rot(2,i)**2 + fragments%rot(3,i)**2 vmag2 = v_shift(1,i)**2 + v_shift(2,i)**2 + v_shift(3,i)**2 - kearr(i) = frag%mass(i) * (frag%Ip(3, i) * frag%radius(i)**2 * rotmag2 + vmag2) + kearr(i) = fragments%mass(i) * (fragments%Ip(3, i) * fragments%radius(i)**2 * rotmag2 + vmag2) end do !$omp end do simd - keo = 2 * frag%ke_budget - sum(kearr(:)) - ke_radial = frag%ke_budget - frag%ke_orbit - frag%ke_spin + keo = 2 * fragments%ke_budget - sum(kearr(:)) + ke_radial = fragments%ke_budget - fragments%ke_orbit - fragments%ke_spin ! The following ensures that fval = 0 is a local minimum, which is what the BFGS method is searching for fval = (keo / (2 * ke_radial))**2 diff --git a/src/fraggle/fraggle_io.f90 b/src/fraggle/fraggle_io.f90 index 61650e700..3253bcdb2 100644 --- a/src/fraggle/fraggle_io.f90 +++ b/src/fraggle/fraggle_io.f90 @@ -224,14 +224,14 @@ module subroutine fraggle_io_write_frame(self, nc, param) end subroutine fraggle_io_write_frame - module subroutine fraggle_io_log_regime(colliders, frag) + module subroutine fraggle_io_log_regime(colliders, fragments) !! author: David A. Minton !! !! Writes a log of the results of the collisional regime determination implicit none ! Arguments class(fraggle_colliders), intent(in) :: colliders !! Fraggle collider system object - class(fraggle_fragments), intent(in) :: frag !! Fraggle fragment object + class(fraggle_fragments), intent(in) :: fragments !! Fraggle fragment object ! Internals character(STRMAX) :: errmsg @@ -242,7 +242,7 @@ module subroutine fraggle_io_log_regime(colliders, frag) write(LUN, *) "--------------------------------------------------------------------" write(LUN, *) "True number of colliders : ",colliders%ncoll write(LUN, *) "Index list of true colliders : ",colliders%idx(1:colliders%ncoll) - select case(frag%regime) + select case(fragments%regime) case(COLLRESOLVE_REGIME_MERGE) write(LUN, *) "Regime: Merge" case(COLLRESOLVE_REGIME_DISRUPTION) @@ -254,7 +254,7 @@ module subroutine fraggle_io_log_regime(colliders, frag) case(COLLRESOLVE_REGIME_HIT_AND_RUN) write(LUN, *) "Regime: Hit and run" end select - write(LUN, *) "Energy loss : ", frag%Qloss + write(LUN, *) "Energy loss : ", fragments%Qloss write(LUN, *) "--------------------------------------------------------------------" close(LUN) diff --git a/src/fraggle/fraggle_regime.f90 b/src/fraggle/fraggle_regime.f90 index 7962e6c25..dc5b07f58 100644 --- a/src/fraggle/fraggle_regime.f90 +++ b/src/fraggle/fraggle_regime.f90 @@ -12,7 +12,7 @@ contains - module subroutine fraggle_regime_colliders(self, frag, system, param) + module subroutine fraggle_regime_colliders(self, fragments, system, param) !! Author: Jennifer L.L. Pouplin, Carlisle A. Wishard, and David A. Minton !! !! Determine which fragmentation regime the set of colliders will be. This subroutine is a wrapper for the non-polymorphic raggle_regime_collresolve subroutine. @@ -20,7 +20,7 @@ module subroutine fraggle_regime_colliders(self, frag, system, param) implicit none ! Arguments class(fraggle_colliders), intent(inout) :: self !! Fraggle colliders object - class(fraggle_fragments), intent(inout) :: frag !! Fraggle fragment system object + class(fraggle_fragments), intent(inout) :: fragments !! Fraggle fragment system object class(swiftest_nbody_system), intent(in) :: system !! Swiftest nbody system object class(swiftest_parameters), intent(in) :: param !! Current Swiftest run configuration parameters ! Internals @@ -60,27 +60,27 @@ module subroutine fraggle_regime_colliders(self, frag, system, param) !! Use the positions and velocities of the parents from indside the step (at collision) to calculate the collisional regime call fraggle_regime_collresolve(Mcb_si, mass_si(jtarg), mass_si(jproj), radius_si(jtarg), radius_si(jproj), & x1_si(:), x2_si(:), v1_si(:), v2_si(:), density_si(jtarg), density_si(jproj), & - min_mfrag_si, frag%regime, mlr, mslr, frag%Qloss) + min_mfrag_si, fragments%regime, mlr, mslr, fragments%Qloss) - frag%mass_dist(1) = min(max(mlr, 0.0_DP), mtot) - frag%mass_dist(2) = min(max(mslr, 0.0_DP), mtot) - frag%mass_dist(3) = min(max(mtot - mlr - mslr, 0.0_DP), mtot) + fragments%mass_dist(1) = min(max(mlr, 0.0_DP), mtot) + fragments%mass_dist(2) = min(max(mslr, 0.0_DP), mtot) + fragments%mass_dist(3) = min(max(mtot - mlr - mslr, 0.0_DP), mtot) ! Find the center of mass of the collisional system - frag%mtot = sum(colliders%mass(:)) - frag%rbcom(:) = (colliders%mass(1) * colliders%rb(:,1) + colliders%mass(2) * colliders%rb(:,2)) / frag%mtot - frag%vbcom(:) = (colliders%mass(1) * colliders%vb(:,1) + colliders%mass(2) * colliders%vb(:,2)) / frag%mtot + fragments%mtot = sum(colliders%mass(:)) + fragments%rbcom(:) = (colliders%mass(1) * colliders%rb(:,1) + colliders%mass(2) * colliders%rb(:,2)) / fragments%mtot + fragments%vbcom(:) = (colliders%mass(1) * colliders%vb(:,1) + colliders%mass(2) * colliders%vb(:,2)) / fragments%mtot ! Find the point of impact between the two bodies runit(:) = colliders%rb(:,2) - colliders%rb(:,1) runit(:) = runit(:) / (.mag. runit(:)) - frag%rbimp(:) = colliders%rb(:,1) + colliders%radius(1) * runit(:) + fragments%rbimp(:) = colliders%rb(:,1) + colliders%radius(1) * runit(:) ! Convert quantities back to the system units and save them into the fragment system - frag%mass_dist(:) = (frag%mass_dist(:) / param%MU2KG) - frag%Qloss = frag%Qloss * (param%TU2S / param%DU2M)**2 / param%MU2KG + fragments%mass_dist(:) = (fragments%mass_dist(:) / param%MU2KG) + fragments%Qloss = fragments%Qloss * (param%TU2S / param%DU2M)**2 / param%MU2KG - call fraggle_io_log_regime(colliders, frag) + call fraggle_io_log_regime(colliders, fragments) end associate return diff --git a/src/fraggle/fraggle_set.f90 b/src/fraggle/fraggle_set.f90 index 45cf41a92..3fbe50d2f 100644 --- a/src/fraggle/fraggle_set.f90 +++ b/src/fraggle/fraggle_set.f90 @@ -22,13 +22,13 @@ module subroutine fraggle_set_budgets_fragments(self) real(DP) :: dEtot real(DP), dimension(NDIM) :: dL - associate(frag => self) + associate(fragments => self) - dEtot = frag%Etot_after - frag%Etot_before - dL(:) = frag%Ltot_after(:) - frag%Ltot_before(:) + dEtot = fragments%Etot_after - fragments%Etot_before + dL(:) = fragments%Ltot_after(:) - fragments%Ltot_before(:) - frag%L_budget(:) = -dL(:) - frag%ke_budget = -(dEtot - 0.5_DP * frag%mtot * dot_product(frag%vbcom(:), frag%vbcom(:))) - frag%Qloss + fragments%L_budget(:) = -dL(:) + fragments%ke_budget = -(dEtot - 0.5_DP * fragments%mtot * dot_product(fragments%vbcom(:), fragments%vbcom(:))) - fragments%Qloss end associate return @@ -59,10 +59,10 @@ module subroutine fraggle_set_mass_dist_fragments(self, colliders, param) integer(I4B), parameter :: iMslr = 2 integer(I4B), parameter :: iMrem = 3 - associate(frag => self) + associate(fragments => self) ! Get mass weighted mean of Ip and density volume(1:2) = 4._DP / 3._DP * PI * colliders%radius(1:2)**3 - Ip_avg(:) = (colliders%mass(1) * colliders%Ip(:,1) + colliders%mass(2) * colliders%Ip(:,2)) / frag%mtot + Ip_avg(:) = (colliders%mass(1) * colliders%Ip(:,1) + colliders%mass(2) * colliders%Ip(:,2)) / fragments%mtot if (colliders%mass(1) > colliders%mass(2)) then jtarg = 1 jproj = 2 @@ -71,7 +71,7 @@ module subroutine fraggle_set_mass_dist_fragments(self, colliders, param) jproj = 1 end if - select case(frag%regime) + select case(fragments%regime) case(COLLRESOLVE_REGIME_DISRUPTION, COLLRESOLVE_REGIME_SUPERCATASTROPHIC, COLLRESOLVE_REGIME_HIT_AND_RUN) ! The first two bins of the mass_dist are the largest and second-largest fragments that came out of fraggle_regime. ! The remainder from the third bin will be distributed among nfrag-2 bodies. The following code will determine nfrag based on @@ -84,7 +84,7 @@ module subroutine fraggle_set_mass_dist_fragments(self, colliders, param) ! The number of fragments we generate is bracked by the minimum required by fraggle_generate (7) and the ! maximum set by the NFRAG_SIZE_MULTIPLIER which limits the total number of fragments to prevent the nbody ! code from getting an overwhelmingly large number of fragments - nfrag = ceiling(NFRAG_SIZE_MULTIPLIER * log(frag%mtot / min_mfrag)) + nfrag = ceiling(NFRAG_SIZE_MULTIPLIER * log(fragments%mtot / min_mfrag)) nfrag = max(min(nfrag, NFRAGMAX), NFRAGMIN) class default min_mfrag = 0.0_DP @@ -92,36 +92,36 @@ module subroutine fraggle_set_mass_dist_fragments(self, colliders, param) end select i = iMrem - mremaining = frag%mass_dist(iMrem) + mremaining = fragments%mass_dist(iMrem) do while (i <= nfrag) - mfrag = (1 + i - iMslr)**(-3._DP / BETA) * frag%mass_dist(iMslr) + mfrag = (1 + i - iMslr)**(-3._DP / BETA) * fragments%mass_dist(iMslr) if (mremaining - mfrag < 0.0_DP) exit mremaining = mremaining - mfrag i = i + 1 end do if (i < nfrag) nfrag = max(i, NFRAGMIN) ! The sfd would actually give us fewer fragments than our maximum - call frag%setup(nfrag, param) + call fragments%setup(nfrag, param) case (COLLRESOLVE_REGIME_MERGE, COLLRESOLVE_REGIME_GRAZE_AND_MERGE) - call frag%setup(1, param) - frag%mass(1) = frag%mass_dist(1) - frag%radius(1) = colliders%radius(jtarg) - frag%density(1) = frag%mass_dist(1) / volume(jtarg) - if (param%lrotation) frag%Ip(:, 1) = colliders%Ip(:,1) + call fragments%setup(1, param) + fragments%mass(1) = fragments%mass_dist(1) + fragments%radius(1) = colliders%radius(jtarg) + fragments%density(1) = fragments%mass_dist(1) / volume(jtarg) + if (param%lrotation) fragments%Ip(:, 1) = colliders%Ip(:,1) return case default - write(*,*) "fraggle_set_mass_dist_fragments error: Unrecognized regime code",frag%regime + write(*,*) "fraggle_set_mass_dist_fragments error: Unrecognized regime code",fragments%regime end select ! Make the first two bins the same as the Mlr and Mslr values that came from fraggle_regime - frag%mass(1) = frag%mass_dist(iMlr) - frag%mass(2) = frag%mass_dist(iMslr) + fragments%mass(1) = fragments%mass_dist(iMlr) + fragments%mass(2) = fragments%mass_dist(iMslr) ! Distribute the remaining mass the 3:nfrag bodies following the model SFD given by slope BETA - mremaining = frag%mass_dist(iMrem) + mremaining = fragments%mass_dist(iMrem) do i = iMrem, nfrag - mfrag = (1 + i - iMslr)**(-3._DP / BETA) * frag%mass_dist(iMslr) - frag%mass(i) = mfrag + mfrag = (1 + i - iMslr)**(-3._DP / BETA) * fragments%mass_dist(iMslr) + fragments%mass(i) = mfrag mremaining = mremaining - mfrag end do @@ -131,27 +131,27 @@ module subroutine fraggle_set_mass_dist_fragments(self, colliders, param) else ! If the remainder is postiive, this means that the number of fragments required by the SFD is larger than our upper limit set by computational expediency. istart = iMslr ! We will increase the mass of the 2:nfrag bodies to compensate, which ensures that the second largest fragment remains the second largest end if - mfrag = 1._DP + mremaining / sum(frag%mass(istart:nfrag)) - frag%mass(istart:nfrag) = frag%mass(istart:nfrag) * mfrag + mfrag = 1._DP + mremaining / sum(fragments%mass(istart:nfrag)) + fragments%mass(istart:nfrag) = fragments%mass(istart:nfrag) * mfrag ! There may still be some small residual due to round-off error. If so, simply add it to the last bin of the mass distribution. - mremaining = frag%mtot - sum(frag%mass(1:nfrag)) - frag%mass(nfrag) = frag%mass(nfrag) + mremaining + mremaining = fragments%mtot - sum(fragments%mass(1:nfrag)) + fragments%mass(nfrag) = fragments%mass(nfrag) + mremaining ! Compute physical properties of the new fragments - select case(frag%regime) + select case(fragments%regime) case(COLLRESOLVE_REGIME_HIT_AND_RUN) ! The hit and run case always preserves the largest body intact, so there is no need to recompute the physical properties of the first fragment - frag%radius(1) = colliders%radius(jtarg) - frag%density(1) = frag%mass_dist(iMlr) / volume(jtarg) - frag%Ip(:, 1) = colliders%Ip(:,1) + fragments%radius(1) = colliders%radius(jtarg) + fragments%density(1) = fragments%mass_dist(iMlr) / volume(jtarg) + fragments%Ip(:, 1) = colliders%Ip(:,1) istart = 2 case default istart = 1 end select - frag%density(istart:nfrag) = frag%mtot / sum(volume(:)) - frag%radius(istart:nfrag) = (3 * frag%mass(istart:nfrag) / (4 * PI * frag%density(istart:nfrag)))**(1.0_DP / 3.0_DP) + fragments%density(istart:nfrag) = fragments%mtot / sum(volume(:)) + fragments%radius(istart:nfrag) = (3 * fragments%mass(istart:nfrag) / (4 * PI * fragments%density(istart:nfrag)))**(1.0_DP / 3.0_DP) do i = istart, nfrag - frag%Ip(:, i) = Ip_avg(:) + fragments%Ip(:, i) = Ip_avg(:) end do end associate @@ -174,7 +174,7 @@ module subroutine fraggle_set_coordinate_system(self, colliders) real(DP) :: r_col_norm, v_col_norm, L_mag real(DP), dimension(NDIM, self%nbody) :: L_sigma - associate(frag => self, nfrag => self%nbody) + associate(fragments => self, nfrag => self%nbody) delta_v(:) = colliders%vb(:, 2) - colliders%vb(:, 1) v_col_norm = .mag. delta_v(:) delta_r(:) = colliders%rb(:, 2) - colliders%rb(:, 1) @@ -183,29 +183,29 @@ module subroutine fraggle_set_coordinate_system(self, colliders) ! We will initialize fragments on a plane defined by the pre-impact system, with the z-axis aligned with the angular momentum vector ! and the y-axis aligned with the pre-impact distance vector. Ltot = colliders%L_orbit(:,1) + colliders%L_orbit(:,2) + colliders%L_spin(:,1) + colliders%L_spin(:,2) - frag%y_coll_unit(:) = delta_r(:) / r_col_norm + fragments%y_coll_unit(:) = delta_r(:) / r_col_norm L_mag = .mag.Ltot(:) if (L_mag > sqrt(tiny(L_mag))) then - frag%z_coll_unit(:) = Ltot(:) / L_mag + fragments%z_coll_unit(:) = Ltot(:) / L_mag else - call random_number(frag%z_coll_unit(:)) - frag%z_coll_unit(:) = frag%z_coll_unit(:) / (.mag.frag%z_coll_unit(:)) + call random_number(fragments%z_coll_unit(:)) + fragments%z_coll_unit(:) = fragments%z_coll_unit(:) / (.mag.fragments%z_coll_unit(:)) end if ! The cross product of the y- by z-axis will give us the x-axis - frag%x_coll_unit(:) = frag%y_coll_unit(:) .cross. frag%z_coll_unit(:) + fragments%x_coll_unit(:) = fragments%y_coll_unit(:) .cross. fragments%z_coll_unit(:) - if (.not.any(frag%x_coll(:,:) > 0.0_DP)) return - frag%rmag(:) = .mag. frag%x_coll(:,:) + if (.not.any(fragments%r_coll(:,:) > 0.0_DP)) return + fragments%rmag(:) = .mag. fragments%r_coll(:,:) call random_number(L_sigma(:,:)) ! Randomize the tangential velocity direction. This helps to ensure that the tangential velocity doesn't completely line up with the angular momentum vector, ! otherwise we can get an ill-conditioned system - do concurrent(i = 1:nfrag, frag%rmag(i) > 0.0_DP) - frag%v_r_unit(:, i) = frag%x_coll(:, i) / frag%rmag(i) - frag%v_n_unit(:, i) = frag%z_coll_unit(:) + 2e-1_DP * (L_sigma(:,i) - 0.5_DP) - frag%v_n_unit(:, i) = frag%v_n_unit(:, i) / (.mag. frag%v_n_unit(:, i)) - frag%v_t_unit(:, i) = frag%v_n_unit(:, i) .cross. frag%v_r_unit(:, i) - frag%v_t_unit(:, i) = frag%v_t_unit(:, i) / (.mag. frag%v_t_unit(:, i)) + do concurrent(i = 1:nfrag, fragments%rmag(i) > 0.0_DP) + fragments%v_r_unit(:, i) = fragments%r_coll(:, i) / fragments%rmag(i) + fragments%v_n_unit(:, i) = fragments%z_coll_unit(:) + 2e-1_DP * (L_sigma(:,i) - 0.5_DP) + fragments%v_n_unit(:, i) = fragments%v_n_unit(:, i) / (.mag. fragments%v_n_unit(:, i)) + fragments%v_t_unit(:, i) = fragments%v_n_unit(:, i) .cross. fragments%v_r_unit(:, i) + fragments%v_t_unit(:, i) = fragments%v_t_unit(:, i) / (.mag. fragments%v_t_unit(:, i)) end do end associate @@ -226,35 +226,35 @@ module subroutine fraggle_set_natural_scale_factors(self, colliders) ! Internals integer(I4B) :: i - associate(frag => self) + associate(fragments => self) ! Set scale factors - frag%Escale = 0.5_DP * (colliders%mass(1) * dot_product(colliders%vb(:,1), colliders%vb(:,1)) & + fragments%Escale = 0.5_DP * (colliders%mass(1) * dot_product(colliders%vb(:,1), colliders%vb(:,1)) & + colliders%mass(2) * dot_product(colliders%vb(:,2), colliders%vb(:,2))) - frag%dscale = sum(colliders%radius(:)) - frag%mscale = frag%mtot - frag%vscale = sqrt(frag%Escale / frag%mscale) - frag%tscale = frag%dscale / frag%vscale - frag%Lscale = frag%mscale * frag%dscale * frag%vscale + fragments%dscale = sum(colliders%radius(:)) + fragments%mscale = fragments%mtot + fragments%vscale = sqrt(fragments%Escale / fragments%mscale) + fragments%tscale = fragments%dscale / fragments%vscale + fragments%Lscale = fragments%mscale * fragments%dscale * fragments%vscale ! Scale all dimensioned quantities of colliders and fragments - frag%rbcom(:) = frag%rbcom(:) / frag%dscale - frag%vbcom(:) = frag%vbcom(:) / frag%vscale - frag%rbimp(:) = frag%rbimp(:) / frag%dscale - colliders%rb(:,:) = colliders%rb(:,:) / frag%dscale - colliders%vb(:,:) = colliders%vb(:,:) / frag%vscale - colliders%mass(:) = colliders%mass(:) / frag%mscale - colliders%radius(:) = colliders%radius(:) / frag%dscale - colliders%L_spin(:,:) = colliders%L_spin(:,:) / frag%Lscale - colliders%L_orbit(:,:) = colliders%L_orbit(:,:) / frag%Lscale + fragments%rbcom(:) = fragments%rbcom(:) / fragments%dscale + fragments%vbcom(:) = fragments%vbcom(:) / fragments%vscale + fragments%rbimp(:) = fragments%rbimp(:) / fragments%dscale + colliders%rb(:,:) = colliders%rb(:,:) / fragments%dscale + colliders%vb(:,:) = colliders%vb(:,:) / fragments%vscale + colliders%mass(:) = colliders%mass(:) / fragments%mscale + colliders%radius(:) = colliders%radius(:) / fragments%dscale + colliders%L_spin(:,:) = colliders%L_spin(:,:) / fragments%Lscale + colliders%L_orbit(:,:) = colliders%L_orbit(:,:) / fragments%Lscale do i = 1, 2 colliders%rot(:,i) = colliders%L_spin(:,i) / (colliders%mass(i) * colliders%radius(i)**2 * colliders%Ip(3, i)) end do - frag%mtot = frag%mtot / frag%mscale - frag%mass = frag%mass / frag%mscale - frag%radius = frag%radius / frag%dscale - frag%Qloss = frag%Qloss / frag%Escale + fragments%mtot = fragments%mtot / fragments%mscale + fragments%mass = fragments%mass / fragments%mscale + fragments%radius = fragments%radius / fragments%dscale + fragments%Qloss = fragments%Qloss / fragments%Escale end associate return @@ -277,58 +277,58 @@ module subroutine fraggle_set_original_scale_factors(self, colliders) call ieee_get_halting_mode(IEEE_ALL,fpe_halting_modes) ! Save the current halting modes so we can turn them off temporarily call ieee_set_halting_mode(IEEE_ALL,.false.) - associate(frag => self) + associate(fragments => self) ! Restore scale factors - frag%rbcom(:) = frag%rbcom(:) * frag%dscale - frag%vbcom(:) = frag%vbcom(:) * frag%vscale - frag%rbimp(:) = frag%rbimp(:) * frag%dscale + fragments%rbcom(:) = fragments%rbcom(:) * fragments%dscale + fragments%vbcom(:) = fragments%vbcom(:) * fragments%vscale + fragments%rbimp(:) = fragments%rbimp(:) * fragments%dscale - colliders%mass = colliders%mass * frag%mscale - colliders%radius = colliders%radius * frag%dscale - colliders%rb = colliders%rb * frag%dscale - colliders%vb = colliders%vb * frag%vscale - colliders%L_spin = colliders%L_spin * frag%Lscale + colliders%mass = colliders%mass * fragments%mscale + colliders%radius = colliders%radius * fragments%dscale + colliders%rb = colliders%rb * fragments%dscale + colliders%vb = colliders%vb * fragments%vscale + colliders%L_spin = colliders%L_spin * fragments%Lscale do i = 1, 2 colliders%rot(:,i) = colliders%L_spin(:,i) * (colliders%mass(i) * colliders%radius(i)**2 * colliders%Ip(3, i)) end do - frag%mtot = frag%mtot * frag%mscale - frag%mass = frag%mass * frag%mscale - frag%radius = frag%radius * frag%dscale - frag%rot = frag%rot / frag%tscale - frag%x_coll = frag%x_coll * frag%dscale - frag%v_coll = frag%v_coll * frag%vscale + fragments%mtot = fragments%mtot * fragments%mscale + fragments%mass = fragments%mass * fragments%mscale + fragments%radius = fragments%radius * fragments%dscale + fragments%rot = fragments%rot / fragments%tscale + fragments%r_coll = fragments%r_coll * fragments%dscale + fragments%v_coll = fragments%v_coll * fragments%vscale - do i = 1, frag%nbody - frag%rb(:, i) = frag%x_coll(:, i) + frag%rbcom(:) - frag%vb(:, i) = frag%v_coll(:, i) + frag%vbcom(:) + do i = 1, fragments%nbody + fragments%rb(:, i) = fragments%r_coll(:, i) + fragments%rbcom(:) + fragments%vb(:, i) = fragments%v_coll(:, i) + fragments%vbcom(:) end do - frag%Qloss = frag%Qloss * frag%Escale + fragments%Qloss = fragments%Qloss * fragments%Escale - frag%Lorbit_before(:) = frag%Lorbit_before * frag%Lscale - frag%Lspin_before(:) = frag%Lspin_before * frag%Lscale - frag%Ltot_before(:) = frag%Ltot_before * frag%Lscale - frag%ke_orbit_before = frag%ke_orbit_before * frag%Escale - frag%ke_spin_before = frag%ke_spin_before * frag%Escale - frag%pe_before = frag%pe_before * frag%Escale - frag%Etot_before = frag%Etot_before * frag%Escale + fragments%Lorbit_before(:) = fragments%Lorbit_before * fragments%Lscale + fragments%Lspin_before(:) = fragments%Lspin_before * fragments%Lscale + fragments%Ltot_before(:) = fragments%Ltot_before * fragments%Lscale + fragments%ke_orbit_before = fragments%ke_orbit_before * fragments%Escale + fragments%ke_spin_before = fragments%ke_spin_before * fragments%Escale + fragments%pe_before = fragments%pe_before * fragments%Escale + fragments%Etot_before = fragments%Etot_before * fragments%Escale - frag%Lorbit_after(:) = frag%Lorbit_after * frag%Lscale - frag%Lspin_after(:) = frag%Lspin_after * frag%Lscale - frag%Ltot_after(:) = frag%Ltot_after * frag%Lscale - frag%ke_orbit_after = frag%ke_orbit_after * frag%Escale - frag%ke_spin_after = frag%ke_spin_after * frag%Escale - frag%pe_after = frag%pe_after * frag%Escale - frag%Etot_after = frag%Etot_after * frag%Escale + fragments%Lorbit_after(:) = fragments%Lorbit_after * fragments%Lscale + fragments%Lspin_after(:) = fragments%Lspin_after * fragments%Lscale + fragments%Ltot_after(:) = fragments%Ltot_after * fragments%Lscale + fragments%ke_orbit_after = fragments%ke_orbit_after * fragments%Escale + fragments%ke_spin_after = fragments%ke_spin_after * fragments%Escale + fragments%pe_after = fragments%pe_after * fragments%Escale + fragments%Etot_after = fragments%Etot_after * fragments%Escale - frag%mscale = 1.0_DP - frag%dscale = 1.0_DP - frag%vscale = 1.0_DP - frag%tscale = 1.0_DP - frag%Lscale = 1.0_DP - frag%Escale = 1.0_DP + fragments%mscale = 1.0_DP + fragments%dscale = 1.0_DP + fragments%vscale = 1.0_DP + fragments%tscale = 1.0_DP + fragments%Lscale = 1.0_DP + fragments%Escale = 1.0_DP end associate call ieee_set_halting_mode(IEEE_ALL,fpe_halting_modes) diff --git a/src/fraggle/fraggle_setup.f90 b/src/fraggle/fraggle_setup.f90 index ab31af995..bd660dc98 100644 --- a/src/fraggle/fraggle_setup.f90 +++ b/src/fraggle/fraggle_setup.f90 @@ -22,7 +22,7 @@ module subroutine fraggle_setup_reset_fragments(self) self%rb(:,:) = 0.0_DP self%vb(:,:) = 0.0_DP self%rot(:,:) = 0.0_DP - self%x_coll(:,:) = 0.0_DP + self%r_coll(:,:) = 0.0_DP self%v_coll(:,:) = 0.0_DP self%v_r_unit(:,:) = 0.0_DP self%v_t_unit(:,:) = 0.0_DP @@ -55,7 +55,7 @@ module subroutine fraggle_setup_fragments(self, n, param) call setup_pl(self, n, param) if (n < 0) return - if (allocated(self%x_coll)) deallocate(self%x_coll) + if (allocated(self%r_coll)) deallocate(self%r_coll) if (allocated(self%v_coll)) deallocate(self%v_coll) if (allocated(self%v_r_unit)) deallocate(self%v_r_unit) if (allocated(self%v_t_unit)) deallocate(self%v_t_unit) @@ -67,7 +67,7 @@ module subroutine fraggle_setup_fragments(self, n, param) if (n == 0) return - allocate(self%x_coll(NDIM,n)) + allocate(self%r_coll(NDIM,n)) allocate(self%v_coll(NDIM,n)) allocate(self%v_r_unit(NDIM,n)) allocate(self%v_t_unit(NDIM,n)) diff --git a/src/fraggle/fraggle_util.f90 b/src/fraggle/fraggle_util.f90 index 3ed18f32d..c4fffe4a6 100644 --- a/src/fraggle/fraggle_util.f90 +++ b/src/fraggle/fraggle_util.f90 @@ -11,13 +11,13 @@ use swiftest contains - module subroutine fraggle_util_add_fragments_to_system(frag, colliders, system, param) + module subroutine fraggle_util_add_fragments_to_system(fragments, colliders, system, param) !! Author: David A. Minton !! !! Adds fragments to the temporary system pl object implicit none ! Arguments - class(fraggle_fragments), intent(in) :: frag !! Fraggle fragment system object + class(fraggle_fragments), intent(in) :: fragments !! Fraggle fragment system object class(fraggle_colliders), intent(in) :: colliders !! Fraggle collider system object class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object class(swiftest_parameters), intent(in) :: param !! Current swiftest run configuration parameters @@ -25,24 +25,24 @@ module subroutine fraggle_util_add_fragments_to_system(frag, colliders, system, integer(I4B) :: i, npl_before, npl_after logical, dimension(:), allocatable :: lexclude - associate(nfrag => frag%nbody, pl => system%pl, cb => system%cb) + associate(nfrag => fragments%nbody, pl => system%pl, cb => system%cb) npl_after = pl%nbody npl_before = npl_after - nfrag allocate(lexclude(npl_after)) pl%status(npl_before+1:npl_after) = ACTIVE - pl%mass(npl_before+1:npl_after) = frag%mass(1:nfrag) - pl%Gmass(npl_before+1:npl_after) = frag%mass(1:nfrag) * param%GU - pl%radius(npl_before+1:npl_after) = frag%radius(1:nfrag) + pl%mass(npl_before+1:npl_after) = fragments%mass(1:nfrag) + pl%Gmass(npl_before+1:npl_after) = fragments%mass(1:nfrag) * param%GU + pl%radius(npl_before+1:npl_after) = fragments%radius(1:nfrag) do concurrent (i = 1:nfrag) - pl%rb(:,npl_before+i) = frag%rb(:,i) - pl%vb(:,npl_before+i) = frag%vb(:,i) - pl%rh(:,npl_before+i) = frag%rb(:,i) - cb%rb(:) - pl%vh(:,npl_before+i) = frag%vb(:,i) - cb%vb(:) + pl%rb(:,npl_before+i) = fragments%rb(:,i) + pl%vb(:,npl_before+i) = fragments%vb(:,i) + pl%rh(:,npl_before+i) = fragments%rb(:,i) - cb%rb(:) + pl%vh(:,npl_before+i) = fragments%vb(:,i) - cb%vb(:) end do if (param%lrotation) then - pl%Ip(:,npl_before+1:npl_after) = frag%Ip(:,1:nfrag) - pl%rot(:,npl_before+1:npl_after) = frag%rot(:,1:nfrag) + pl%Ip(:,npl_before+1:npl_after) = fragments%Ip(:,1:nfrag) + pl%rot(:,npl_before+1:npl_after) = fragments%rot(:,1:nfrag) end if ! This will remove the colliders from the system since we've replaced them with fragments lexclude(1:npl_after) = .false. @@ -69,13 +69,13 @@ module subroutine fraggle_util_ang_mtm(self) ! Internals integer(I4B) :: i - associate(frag => self, nfrag => self%nbody) - frag%L_orbit(:) = 0.0_DP - frag%L_spin(:) = 0.0_DP + associate(fragments => self, nfrag => self%nbody) + fragments%L_orbit(:) = 0.0_DP + fragments%L_spin(:) = 0.0_DP do i = 1, nfrag - frag%L_orbit(:) = frag%L_orbit(:) + frag%mass(i) * (frag%x_coll(:, i) .cross. frag%v_coll(:, i)) - frag%L_spin(:) = frag%L_spin(:) + frag%mass(i) * frag%radius(i)**2 * frag%Ip(:, i) * frag%rot(:, i) + fragments%L_orbit(:) = fragments%L_orbit(:) + fragments%mass(i) * (fragments%r_coll(:, i) .cross. fragments%v_coll(:, i)) + fragments%L_spin(:) = fragments%L_spin(:) + fragments%mass(i) * fragments%radius(i)**2 * fragments%Ip(:, i) * fragments%rot(:, i) end do end associate @@ -83,13 +83,13 @@ module subroutine fraggle_util_ang_mtm(self) end subroutine fraggle_util_ang_mtm - module subroutine fraggle_util_construct_temporary_system(frag, system, param, tmpsys, tmpparam) + module subroutine fraggle_util_construct_temporary_system(fragments, system, param, tmpsys, tmpparam) !! Author: David A. Minton !! !! Constructs a temporary internal system consisting of active bodies and additional fragments. This internal temporary system is used to calculate system energy with and without fragments implicit none ! Arguments - class(fraggle_fragments), intent(in) :: frag !! Fraggle fragment system object + class(fraggle_fragments), intent(in) :: fragments !! Fraggle fragment system object class(swiftest_nbody_system), intent(in) :: system !! Original swiftest nbody system object class(swiftest_parameters), intent(in) :: param !! Current swiftest run configuration parameters class(swiftest_nbody_system), allocatable, intent(out) :: tmpsys !! Output temporary swiftest nbody system object @@ -98,7 +98,7 @@ module subroutine fraggle_util_construct_temporary_system(frag, system, param, t logical, dimension(:), allocatable :: linclude integer(I4B) :: npl_tot - associate(nfrag => frag%nbody, pl => system%pl, npl => system%pl%nbody, cb => system%cb) + associate(nfrag => fragments%nbody, pl => system%pl, npl => system%pl%nbody, cb => system%cb) ! Set up a new system based on the original if (allocated(tmpparam)) deallocate(tmpparam) if (allocated(tmpsys)) deallocate(tmpsys) @@ -123,7 +123,7 @@ module subroutine fraggle_util_construct_temporary_system(frag, system, param, t call tmpsys%pl%fill(pl, linclude) ! Scale the temporary system to the natural units of the current Fraggle calculation - call tmpsys%rescale(tmpparam, frag%mscale, frag%dscale, frag%tscale) + call tmpsys%rescale(tmpparam, fragments%mscale, fragments%dscale, fragments%tscale) end associate @@ -154,7 +154,7 @@ module subroutine fraggle_util_final_fragments(self) ! Arguments type(fraggle_fragments), intent(inout) :: self !! Fraggle encountar storage object - if (allocated(self%x_coll)) deallocate(self%x_coll) + if (allocated(self%r_coll)) deallocate(self%r_coll) if (allocated(self%v_coll)) deallocate(self%v_coll) if (allocated(self%v_r_unit)) deallocate(self%v_r_unit) if (allocated(self%v_t_unit)) deallocate(self%v_t_unit) @@ -201,7 +201,7 @@ module subroutine fraggle_util_get_energy_momentum(self, colliders, system, para class(swiftest_parameters), allocatable, save :: tmpparam integer(I4B) :: npl_before, npl_after - associate(frag => self, nfrag => self%nbody, pl => system%pl, cb => system%cb) + associate(fragments => self, nfrag => self%nbody, pl => system%pl, cb => system%cb) ! Because we're making a copy of the massive body object with the excludes/fragments appended, we need to deallocate the ! big k_plpl array and recreate it when we're done, otherwise we run the risk of blowing up the memory by @@ -212,7 +212,7 @@ module subroutine fraggle_util_get_energy_momentum(self, colliders, system, para npl_after = npl_before + nfrag if (lbefore) then - call fraggle_util_construct_temporary_system(frag, system, param, tmpsys, tmpparam) + call fraggle_util_construct_temporary_system(fragments, system, param, tmpsys, tmpparam) ! Build the exluded body logical mask for the *before* case: Only the original bodies are used to compute energy and momentum tmpsys%pl%status(colliders%idx(1:colliders%ncoll)) = ACTIVE tmpsys%pl%status(npl_before+1:npl_after) = INACTIVE @@ -223,7 +223,7 @@ module subroutine fraggle_util_get_energy_momentum(self, colliders, system, para call util_exit(FAILURE) end if ! Build the exluded body logical mask for the *after* case: Only the new bodies are used to compute energy and momentum - call fraggle_util_add_fragments_to_system(frag, colliders, tmpsys, tmpparam) + call fraggle_util_add_fragments_to_system(fragments, colliders, tmpsys, tmpparam) tmpsys%pl%status(colliders%idx(1:colliders%ncoll)) = INACTIVE tmpsys%pl%status(npl_before+1:npl_after) = ACTIVE end if @@ -235,21 +235,21 @@ module subroutine fraggle_util_get_energy_momentum(self, colliders, system, para ! Calculate the current fragment energy and momentum balances if (lbefore) then - frag%Lorbit_before(:) = tmpsys%Lorbit(:) - frag%Lspin_before(:) = tmpsys%Lspin(:) - frag%Ltot_before(:) = tmpsys%Ltot(:) - frag%ke_orbit_before = tmpsys%ke_orbit - frag%ke_spin_before = tmpsys%ke_spin - frag%pe_before = tmpsys%pe - frag%Etot_before = tmpsys%te + fragments%Lorbit_before(:) = tmpsys%Lorbit(:) + fragments%Lspin_before(:) = tmpsys%Lspin(:) + fragments%Ltot_before(:) = tmpsys%Ltot(:) + fragments%ke_orbit_before = tmpsys%ke_orbit + fragments%ke_spin_before = tmpsys%ke_spin + fragments%pe_before = tmpsys%pe + fragments%Etot_before = tmpsys%te else - frag%Lorbit_after(:) = tmpsys%Lorbit(:) - frag%Lspin_after(:) = tmpsys%Lspin(:) - frag%Ltot_after(:) = tmpsys%Ltot(:) - frag%ke_orbit_after = tmpsys%ke_orbit - frag%ke_spin_after = tmpsys%ke_spin - frag%pe_after = tmpsys%pe - frag%Etot_after = tmpsys%te - (frag%pe_after - frag%pe_before) ! Gotta be careful with PE when number of bodies changes. + fragments%Lorbit_after(:) = tmpsys%Lorbit(:) + fragments%Lspin_after(:) = tmpsys%Lspin(:) + fragments%Ltot_after(:) = tmpsys%Ltot(:) + fragments%ke_orbit_after = tmpsys%ke_orbit + fragments%ke_spin_after = tmpsys%ke_spin + fragments%pe_after = tmpsys%pe + fragments%Etot_after = tmpsys%te - (fragments%pe_after - fragments%pe_before) ! Gotta be careful with PE when number of bodies changes. end if end associate @@ -308,16 +308,16 @@ module subroutine fraggle_util_restructure(self, colliders, try, f_spin, r_max_s real(DP), parameter :: ke_avg_deficit_target = 0.0_DP ! Introduce a bit of noise in the radius determination so we don't just flip flop between similar failed positions - associate(frag => self) + associate(fragments => self) call random_number(delta_r_max) delta_r_max = sum(colliders%radius(:)) * (1.0_DP + 2e-1_DP * (delta_r_max - 0.5_DP)) if (try == 1) then - ke_tot_deficit = - (frag%ke_budget - frag%ke_orbit - frag%ke_spin) + ke_tot_deficit = - (fragments%ke_budget - fragments%ke_orbit - fragments%ke_spin) ke_avg_deficit = ke_tot_deficit delta_r = delta_r_max else ! Linearly interpolate the last two failed solution ke deficits to find a new distance value to try - ke_tot_deficit = ke_tot_deficit - (frag%ke_budget - frag%ke_orbit - frag%ke_spin) + ke_tot_deficit = ke_tot_deficit - (fragments%ke_budget - fragments%ke_orbit - fragments%ke_spin) ke_avg_deficit = ke_tot_deficit / try delta_r = (r_max_start - r_max_start_old) * (ke_avg_deficit_target - ke_avg_deficit_old) & / (ke_avg_deficit - ke_avg_deficit_old) diff --git a/src/modules/fraggle_classes.f90 b/src/modules/fraggle_classes.f90 index ebd5212cf..235451379 100644 --- a/src/modules/fraggle_classes.f90 +++ b/src/modules/fraggle_classes.f90 @@ -10,7 +10,7 @@ module fraggle_classes !! author: The Purdue Swiftest Team - David A. Minton, Carlisle A. Wishard, Jennifer L.L. Pouplin, and Jacob R. Elliott !! - !! Definition of classes and methods specific to Fraggle: *Frag*ment *g*eneration that conserves angular momentum (*L*) and energy (*E*) + !! Definition of classes and methods specific to Fraggle: *Fragment* *g*eneration that conserves angular momentum (*L*) and energy (*E*) use swiftest_globals use swiftest_classes, only : swiftest_parameters, swiftest_nbody_system, swiftest_cb, swiftest_pl, swiftest_storage, netcdf_parameters use encounter_classes, only : encounter_snapshot, encounter_io_parameters, encounter_storage @@ -58,7 +58,7 @@ module fraggle_classes real(DP), dimension(NDIM) :: x_coll_unit !! x-direction unit vector of collisional system real(DP), dimension(NDIM) :: y_coll_unit !! y-direction unit vector of collisional system real(DP), dimension(NDIM) :: z_coll_unit !! z-direction unit vector of collisional system - real(DP), dimension(:,:), allocatable :: x_coll !! Array of fragment position vectors in the collisional coordinate frame + real(DP), dimension(:,:), allocatable :: r_coll !! Array of fragment position vectors in the collisional coordinate frame real(DP), dimension(:,:), allocatable :: v_coll !! Array of fragment velocity vectors in the collisional coordinate frame real(DP), dimension(:,:), allocatable :: v_r_unit !! Array of radial direction unit vectors of individual fragments in the collisional coordinate frame real(DP), dimension(:,:), allocatable :: v_t_unit !! Array of tangential direction unit vectors of individual fragments in the collisional coordinate frame @@ -114,9 +114,9 @@ module fraggle_classes !! NetCDF dimension and variable names for the enounter save object type, extends(encounter_io_parameters) :: fraggle_io_parameters - integer(I4B) :: stage_dimid !! ID for the stage dimension - integer(I4B) :: stage_varid !! ID for the stage variable - character(NAMELEN) :: stage_dimname = "stage" !! name of the stage dimension (before/after) + integer(I4B) :: stage_dimid !! ID for the stage dimension + integer(I4B) :: stage_varid !! ID for the stage variable + character(NAMELEN) :: stage_dimname = "stage" !! name of the stage dimension (before/after) character(len=6), dimension(2) :: stage_coords = ["before", "after"] !! The stage coordinate labels character(NAMELEN) :: event_dimname = "collision" !! Name of collision event dimension @@ -156,28 +156,28 @@ end subroutine fraggle_generate_fragments module subroutine fraggle_io_initialize_output(self, param) implicit none - class(fraggle_io_parameters), intent(inout) :: self !! Parameters used to identify a particular NetCDF dataset - class(swiftest_parameters), intent(in) :: param + class(fraggle_io_parameters), intent(inout) :: self !! Parameters used to identify a particular NetCDF dataset + class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters end subroutine fraggle_io_initialize_output module subroutine fraggle_io_write_frame(self, nc, param) implicit none - class(fraggle_snapshot), intent(in) :: self !! Swiftest encounter structure + class(fraggle_snapshot), intent(in) :: self !! Swiftest encounter structure class(netcdf_parameters), intent(inout) :: nc !! Parameters used to identify a particular encounter io NetCDF dataset class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters end subroutine fraggle_io_write_frame - module subroutine fraggle_io_log_regime(colliders, frag) + module subroutine fraggle_io_log_regime(colliders, fragments) implicit none class(fraggle_colliders), intent(in) :: colliders - class(fraggle_fragments), intent(in) :: frag + class(fraggle_fragments), intent(in) :: fragments end subroutine fraggle_io_log_regime !> The following interfaces are placeholders intended to satisfy the required abstract methods given by the parent class module subroutine fraggle_placeholder_accel(self, system, param, t, lbeg) use swiftest_classes, only : swiftest_nbody_system, swiftest_parameters implicit none - class(fraggle_fragments), intent(inout) :: self !! Fraggle fragment system object + class(fraggle_fragments), intent(inout) :: self !! Fraggle fragment system object class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! Current simulation time @@ -205,17 +205,17 @@ module subroutine fraggle_placeholder_step(self, system, param, t, dt) real(DP), intent(in) :: dt !! Stepsiz end subroutine fraggle_placeholder_step - module subroutine fraggle_regime_colliders(self, frag, system, param) + module subroutine fraggle_regime_colliders(self, fragments, system, param) implicit none class(fraggle_colliders), intent(inout) :: self !! Fraggle colliders object - class(fraggle_fragments), intent(inout) :: frag !! Fraggle fragment system object + class(fraggle_fragments), intent(inout) :: fragments !! Fraggle fragment system object class(swiftest_nbody_system), intent(in) :: system !! Swiftest nbody system object class(swiftest_parameters), intent(in) :: param !! Current Swiftest run configuration parameters end subroutine fraggle_regime_colliders module subroutine fraggle_set_budgets_fragments(self) implicit none - class(fraggle_fragments), intent(inout) :: self !! Fraggle fragment system object + class(fraggle_fragments), intent(inout) :: self !! Fraggle fragment system object end subroutine fraggle_set_budgets_fragments module subroutine fraggle_set_coordinate_system(self, colliders) @@ -255,10 +255,10 @@ module subroutine fraggle_setup_reset_fragments(self) class(fraggle_fragments), intent(inout) :: self end subroutine fraggle_setup_reset_fragments - module subroutine fraggle_util_add_fragments_to_system(frag, colliders, system, param) + module subroutine fraggle_util_add_fragments_to_system(fragments, colliders, system, param) use swiftest_classes, only : swiftest_nbody_system, swiftest_parameters implicit none - class(fraggle_fragments), intent(in) :: frag !! Fraggle fragment system object + class(fraggle_fragments), intent(in) :: fragments !! Fraggle fragment system object class(fraggle_colliders), intent(in) :: colliders !! Fraggle collider system object class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object class(swiftest_parameters), intent(in) :: param !! Current swiftest run configuration parameters @@ -269,10 +269,10 @@ module subroutine fraggle_util_ang_mtm(self) class(fraggle_fragments), intent(inout) :: self !! Fraggle fragment system object end subroutine fraggle_util_ang_mtm - module subroutine fraggle_util_construct_temporary_system(frag, system, param, tmpsys, tmpparam) + module subroutine fraggle_util_construct_temporary_system(fragments, system, param, tmpsys, tmpparam) use swiftest_classes, only : swiftest_nbody_system, swiftest_parameters implicit none - class(fraggle_fragments), intent(in) :: frag !! Fraggle fragment system object + class(fraggle_fragments), intent(in) :: fragments !! Fraggle fragment system object class(swiftest_nbody_system), intent(in) :: system !! Original swiftest nbody system object class(swiftest_parameters), intent(in) :: param !! Current swiftest run configuration parameters class(swiftest_nbody_system), allocatable, intent(out) :: tmpsys !! Output temporary swiftest nbody system object diff --git a/src/modules/swiftest_classes.f90 b/src/modules/swiftest_classes.f90 index 2e32f8c1d..a3bf66ad7 100644 --- a/src/modules/swiftest_classes.f90 +++ b/src/modules/swiftest_classes.f90 @@ -1525,7 +1525,7 @@ module subroutine util_index_map_storage(self) class(swiftest_storage(*)), intent(inout) :: self !! Swiftest storage object end subroutine util_index_map_storage - module function util_minimize_bfgs(f, N, x0, eps, maxloop, lerr) result(x1) + module subroutine util_minimize_bfgs(f, N, x0, eps, maxloop, lerr, x1) use lambda_function implicit none integer(I4B), intent(in) :: N @@ -1534,8 +1534,8 @@ module function util_minimize_bfgs(f, N, x0, eps, maxloop, lerr) result(x1) real(DP), intent(in) :: eps logical, intent(out) :: lerr integer(I4B), intent(in) :: maxloop - real(DP), dimension(:), allocatable :: x1 - end function util_minimize_bfgs + real(DP), dimension(:), allocatable, intent(out) :: x1 + end subroutine util_minimize_bfgs module subroutine util_peri_tp(self, system, param) implicit none diff --git a/src/util/util_minimize_bfgs.f90 b/src/util/util_minimize_bfgs.f90 index cd9e8f8bc..970a0ae45 100644 --- a/src/util/util_minimize_bfgs.f90 +++ b/src/util/util_minimize_bfgs.f90 @@ -10,7 +10,7 @@ submodule (swiftest_classes) s_util_minimize_bfgs use swiftest contains - module function util_minimize_bfgs(f, N, x0, eps, maxloop, lerr) result(x1) + module subroutine util_minimize_bfgs(f, N, x0, eps, maxloop, lerr, x1) !! author: David A. Minton !! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - !! This function implements the Broyden-Fletcher-Goldfarb-Shanno method to determine the minimum of a function of N variables. @@ -36,7 +36,7 @@ module function util_minimize_bfgs(f, N, x0, eps, maxloop, lerr) result(x1) integer(I4B), intent(in) :: maxloop logical, intent(out) :: lerr ! Result - real(DP), dimension(:), allocatable :: x1 + real(DP), dimension(:), intent(out), allocatable :: x1 ! Internals integer(I4B) :: i, j, k, l, conv real(DP), parameter :: graddelta = 1e-4_DP !! Delta x for gradient calculations @@ -227,6 +227,7 @@ function minimize1D(f, x0, S, N, eps, lerr) result(astar) call bracket(f, x0, S, N, gam, step, alo, ahi, lerr) if (lerr) then !write(*,*) "BFGS bracketing step failed!" + !write(*,*) "alo: ",alo, "ahi: ", ahi return end if if (abs(alo - ahi) < eps) then @@ -588,5 +589,5 @@ subroutine quadfit(f, x0, S, N, eps, lo, hi, lerr) return end subroutine quadfit - end function util_minimize_bfgs + end subroutine util_minimize_bfgs end submodule s_util_minimize_bfgs \ No newline at end of file From 149189f6465dfa571cdbfc88c8b032eddb15ff81 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Fri, 16 Dec 2022 08:38:59 -0500 Subject: [PATCH 447/569] Added new .unit. operator for computing unit vectors --- src/CMakeLists.txt | 1 + src/fraggle/fraggle_generate.f90 | 6 -- src/modules/swiftest_operators.f90 | 71 +++++++++++++--- src/operators/operator_cross.f90 | 1 + src/operators/operator_mag.f90 | 1 + src/operators/operator_unit.f90 | 129 +++++++++++++++++++++++++++++ 6 files changed, 191 insertions(+), 18 deletions(-) create mode 100644 src/operators/operator_unit.f90 diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index 594850a50..c74ea07a0 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -50,6 +50,7 @@ SET(FAST_MATH_FILES ${SRC}/obl/obl.f90 ${SRC}/operators/operator_cross.f90 ${SRC}/operators/operator_mag.f90 + ${SRC}/operators/operator_unit.f90 ${SRC}/orbel/orbel.f90 ${SRC}/rmvs/rmvs_discard.f90 ${SRC}/rmvs/rmvs_encounter_check.f90 diff --git a/src/fraggle/fraggle_generate.f90 b/src/fraggle/fraggle_generate.f90 index bd1df3227..ac5f166ba 100644 --- a/src/fraggle/fraggle_generate.f90 +++ b/src/fraggle/fraggle_generate.f90 @@ -57,12 +57,6 @@ module subroutine fraggle_generate_fragments(self, colliders, system, param, lfa return end if - ! Get the unit vectors for the relative position and velocity vectors. These are used to shift the fragment cloud depending on the - runit(:) = colliders%rb(:,2) - colliders%rb(:,1) - runit(:) = runit(:) / (.mag. runit(:)) - - vunit(:) = colliders%vb(:,2) - colliders%vb(:,1) - vunit(:) = vunit(:) / (.mag. vunit(:)) ! This is a factor that will "distort" the shape of the frgment cloud in the direction of the impact velocity f_spin= .mag. (runit(:) .cross. vunit(:)) diff --git a/src/modules/swiftest_operators.f90 b/src/modules/swiftest_operators.f90 index 30e5b26a6..165c7b283 100644 --- a/src/modules/swiftest_operators.f90 +++ b/src/modules/swiftest_operators.f90 @@ -1,7 +1,7 @@ !! Copyright 2022 - David Minton, Carlisle Wishard, Jennifer Pouplin, Jake Elliott, & Dana Singh !! This file is part of Swiftest. !! Swiftest is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License -!! as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. +!! as published by the Free Software Foundation, either version NDIM of the License, or (at your option) any later version. !! Swiftest is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty !! of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. !! You should have received a copy of the GNU General Public License along with Swiftest. @@ -11,15 +11,15 @@ module swiftest_operators !! author: David A. Minton !! !! Custom operators, including - !! A .cross. B = Cross product of A(1:3) and B(1:3) + !! A .cross. B = Cross product of A(1:NDIM) and B(1:NDIM) !! - !! Each operator can also do element-wise computation on arrays of the form .mag. A(1:3, 1:n) + !! Each operator can also do element-wise computation on arrays of the form .mag. A(1:NDIM, 1:n) use swiftest_globals implicit none public !******************************************************************************************************************************** - ! Interfaces for .cross. operator + ! Interfaces for .cross. operator: Computes the cross product of two (NDIM) vectors or (NDIM,:) arrays !******************************************************************************************************************************** interface operator(.cross.) @@ -27,49 +27,49 @@ pure module function operator_cross_sp(A, B) result(C) !$omp declare simd(operator_cross_sp) implicit none real(SP), dimension(:), intent(in) :: A, B - real(SP), dimension(3) :: C + real(SP), dimension(NDIM) :: C end function operator_cross_sp pure module function operator_cross_dp(A, B) result(C) !$omp declare simd(operator_cross_dp) implicit none real(DP), dimension(:), intent(in) :: A, B - real(DP), dimension(3) :: C + real(DP), dimension(NDIM) :: C end function operator_cross_dp pure module function operator_cross_qp(A, B) result(C) !$omp declare simd(operator_cross_qp) implicit none real(QP), dimension(:), intent(in) :: A, B - real(QP), dimension(3) :: C + real(QP), dimension(NDIM) :: C end function operator_cross_qp pure module function operator_cross_i1b(A, B) result(C) !$omp declare simd(operator_cross_i1b) implicit none integer(I1B), dimension(:), intent(in) :: A, B - integer(I1B), dimension(3) :: C + integer(I1B), dimension(NDIM) :: C end function operator_cross_i1b pure module function operator_cross_i2b(A, B) result(C) !$omp declare simd(operator_cross_i2b) implicit none integer(I2B), dimension(:), intent(in) :: A, B - integer(I2B), dimension(3) :: C + integer(I2B), dimension(NDIM) :: C end function operator_cross_i2b pure module function operator_cross_i4b(A, B) result(C) !$omp declare simd(operator_cross_i4b) implicit none integer(I4B), dimension(:), intent(in) :: A, B - integer(I4B), dimension(3) :: C + integer(I4B), dimension(NDIM) :: C end function operator_cross_i4b pure module function operator_cross_i8b(A, B) result(C) !$omp declare simd(operator_cross_i8b) implicit none integer(I8B), dimension(:), intent(in) :: A, B - integer(I8B), dimension(3) :: C + integer(I8B), dimension(NDIM) :: C end function operator_cross_i8b pure module function operator_cross_el_sp(A, B) result(C) @@ -116,7 +116,7 @@ end function operator_cross_el_i8b end interface !******************************************************************************************************************************** - ! Interfaces for .mag. operator + ! Interfaces for .mag. operator: Computes the magnitude of a vector or array of vectors using norm2 !******************************************************************************************************************************** interface operator(.mag.) @@ -160,4 +160,51 @@ pure module function operator_mag_el_qp(A) result(B) end function operator_mag_el_qp end interface + + !******************************************************************************************************************************** + ! Interfaces for .unit. operator: Returns a unit vector or array of unit vectors from an input vector or array of vectors + !******************************************************************************************************************************** + + interface operator(.unit.) + pure module function operator_unit_sp(A) result(B) + !$omp declare simd(operator_unit_sp) + implicit none + real(SP), dimension(:), intent(in) :: A + real(SP), dimension(NDIM) :: B + end function operator_unit_sp + + pure module function operator_unit_dp(A) result(B) + !$omp declare simd(operator_unit_dp) + implicit none + real(DP), dimension(:), intent(in) :: A + real(DP), dimension(NDIM) :: B + end function operator_unit_dp + + pure module function operator_unit_qp(A) result(B) + !$omp declare simd(operator_unit_qp) + implicit none + real(QP), dimension(:), intent(in) :: A + real(QP), dimension(NDIM) :: B + end function operator_unit_qp + + pure module function operator_unit_el_sp(A) result(B) + implicit none + real(SP), dimension(:,:), intent(in) :: A + real(SP), dimension(:,:), allocatable :: B + end function operator_unit_el_sp + + pure module function operator_unit_el_dp(A) result(B) + implicit none + real(DP), dimension(:,:), intent(in) :: A + real(DP), dimension(:,:), allocatable :: B + end function operator_unit_el_dp + + pure module function operator_unit_el_qp(A) result(B) + implicit none + real(QP), dimension(:,:), intent(in) :: A + real(QP), dimension(:,:), allocatable :: B + end function operator_unit_el_qp + end interface + + end module swiftest_operators diff --git a/src/operators/operator_cross.f90 b/src/operators/operator_cross.f90 index ba9582828..2a9af1ecf 100644 --- a/src/operators/operator_cross.f90 +++ b/src/operators/operator_cross.f90 @@ -12,6 +12,7 @@ !! author: David A. Minton !! !! Contains implementations for the .cross. operator for all defined integer and real types + !! Computes the cross product of two (3) vectors or (3,:) arrays !! Single vector implementations: C(1:3) = A(1:3) .cross. B(1:3) !! Vector list implementations: C(1:3, :) = A(1:3, :) .cross. B(1:3, :) contains diff --git a/src/operators/operator_mag.f90 b/src/operators/operator_mag.f90 index bea89d55b..2cf9e643c 100644 --- a/src/operators/operator_mag.f90 +++ b/src/operators/operator_mag.f90 @@ -11,6 +11,7 @@ !! author: David A. Minton !! !! Contains implementations for the .mag. operator for all defined real types + !! Computes the magnitude of a vector or array of vectors using norm2 !! Single vector implementations: B = .mag. A(1:3) !! Vector list implementations: B(:) = .mag. A(1:3, :) contains diff --git a/src/operators/operator_unit.f90 b/src/operators/operator_unit.f90 new file mode 100644 index 000000000..e9c68f28f --- /dev/null +++ b/src/operators/operator_unit.f90 @@ -0,0 +1,129 @@ +!! Copyright 2022 - David Minton, Carlisle Wishard, Jennifer Pouplin, Jake Elliott, & Dana Singh +!! This file is part of Swiftest. +!! Swiftest is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License +!! as published by the Free Software Foundation, either version NDIM of the License, or (at your option) any later version. +!! Swiftest is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty +!! of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. +!! You should have received a copy of the GNU General Public License along with Swiftest. +!! If not, see: https://www.gnu.org/licenses. + +submodule(swiftest_operators) s_operator_unit + !! author: David A. Minton + !! + !! Contains implementations for the .unit. operator for all defined real types + !! Returns a unit vector or array of unit vectors from an input vector or array of vectors + !! Single vector implementations: B = .unit. A(1:NDIM) + !! Vector list implementations: B(:) = .unit. A(1:NDIM, :) + contains + + pure module function operator_unit_sp(A) result(B) + implicit none + ! Arguments + real(SP), dimension(:), intent(in) :: A + real(SP), dimension(NDIM) :: B + ! Internals + real(SP) :: Amag + + Amag = norm2(A(:)) + B(:) = A(:) / Amag + + return + end function operator_unit_sp + + + pure module function operator_unit_dp(A) result(B) + implicit none + ! Arguments + real(DP), dimension(:), intent(in) :: A + real(DP), dimension(NDIM) :: B + ! Internals + real(DP) :: Amag + + Amag = norm2(A(:)) + B(:) = A(:) / Amag + + return + end function operator_unit_dp + + + pure module function operator_unit_qp(A) result(B) + implicit none + ! Arguments + real(QP), dimension(:), intent(in) :: A + real(QP), dimension(NDIM) :: B + ! Internals + real(QP) :: Amag + + Amag = norm2(A(:)) + B(:) = A(:) / Amag + + return + end function operator_unit_qp + + + pure module function operator_unit_el_sp(A) result(B) + implicit none + ! Arguments + real(SP), dimension(:,:), intent(in) :: A + real(SP), dimension(:,:), allocatable :: B + ! Internals + real(SP) :: Amag + integer(I4B) :: i,n + + n = size(A, 2) + if (allocated(B)) deallocate(B) + allocate(B(NDIM,n)) + + do concurrent (i=1:n) + Amag = norm2(A(:, i)) + B(:,i) = A(:,i) / Amag + end do + + return + end function operator_unit_el_sp + + + pure module function operator_unit_el_dp(A) result(B) + implicit none + ! Arguments + real(DP), dimension(:,:), intent(in) :: A + real(DP), dimension(:,:), allocatable :: B + ! Internals + real(DP) :: Amag + integer(I4B) :: i,n + + n = size(A, 2) + if (allocated(B)) deallocate(B) + allocate(B(NDIM,n)) + + do concurrent (i=1:n) + Amag = norm2(A(:, i)) + B(:,i) = A(:,i) / Amag + end do + + return + end function operator_unit_el_dp + + pure module function operator_unit_el_qp(A) result(B) + implicit none + ! Arguments + real(QP), dimension(:,:), intent(in) :: A + real(QP), dimension(:,:), allocatable :: B + ! Internals + real(QP) :: Amag + integer(I4B) :: i,n + + n = size(A, 2) + if (allocated(B)) deallocate(B) + allocate(B(NDIM,n)) + + do concurrent (i=1:n) + Amag = norm2(A(:, i)) + B(:,i) = A(:,i) / Amag + end do + + return + end function operator_unit_el_qp + +end submodule s_operator_unit + From 96bd172d98fb1ec7f4a181f8e180784e30a5257d Mon Sep 17 00:00:00 2001 From: David A Minton Date: Fri, 16 Dec 2022 13:10:32 -0500 Subject: [PATCH 448/569] Embarked on a major restructuring of the encounter, collision, and fragment system. Created a new top-level module specializing in collisions. Wrote it so other collision models besides Fraggle can easily be implemented. --- src/CMakeLists.txt | 18 +- src/collision/collision_io.f90 | 227 ++++++++++++ .../collision_placeholder.f90} | 28 +- src/collision/collision_setup.f90 | 73 ++++ src/collision/collision_util.f90 | 341 +++++++++++++++++ src/encounter/encounter_io.f90 | 50 +-- src/encounter/encounter_placeholder.f90 | 53 +++ src/encounter/encounter_util.f90 | 347 +----------------- src/fraggle/fraggle_generate.f90 | 78 ++-- src/fraggle/fraggle_io.f90 | 220 +---------- src/fraggle/fraggle_regime.f90 | 46 +-- src/fraggle/fraggle_set.f90 | 113 +++--- src/fraggle/fraggle_setup.f90 | 17 +- src/fraggle/fraggle_util.f90 | 143 +------- src/modules/collision_classes.f90 | 305 +++++++++++++++ src/modules/encounter_classes.f90 | 83 +---- src/modules/fraggle_classes.f90 | 215 ++--------- src/modules/swiftest.f90 | 5 +- src/modules/swiftest_classes.f90 | 11 +- src/modules/swiftest_globals.f90 | 8 - src/modules/symba_classes.f90 | 10 +- src/operators/operator_unit.f90 | 32 +- src/setup/setup.f90 | 26 +- src/symba/symba_collision.f90 | 218 +++++------ 24 files changed, 1371 insertions(+), 1296 deletions(-) create mode 100644 src/collision/collision_io.f90 rename src/{fraggle/fraggle_placeholder.f90 => collision/collision_placeholder.f90} (74%) create mode 100644 src/collision/collision_setup.f90 create mode 100644 src/collision/collision_util.f90 create mode 100644 src/encounter/encounter_placeholder.f90 create mode 100644 src/modules/collision_classes.f90 diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index c74ea07a0..5aa3c4f8f 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -13,18 +13,23 @@ # Add the source files SET(FAST_MATH_FILES + ${SRC}/modules/swiftest_globals.f90 + ${SRC}/modules/lambda_function.f90 + ${SRC}/modules/swiftest_operators.f90 + ${SRC}/modules/walltime_classes.f90 + ${SRC}/modules/swiftest_classes.f90 ${SRC}/modules/encounter_classes.f90 + ${SRC}/modules/collision_classes.f90 ${SRC}/modules/fraggle_classes.f90 ${SRC}/modules/helio_classes.f90 - ${SRC}/modules/lambda_function.f90 ${SRC}/modules/rmvs_classes.f90 - ${SRC}/modules/swiftest_classes.f90 - ${SRC}/modules/swiftest_globals.f90 - ${SRC}/modules/swiftest_operators.f90 - ${SRC}/modules/swiftest.f90 ${SRC}/modules/symba_classes.f90 - ${SRC}/modules/walltime_classes.f90 ${SRC}/modules/whm_classes.f90 + ${SRC}/modules/swiftest.f90 + ${SRC}/fraggle/collision_io.f90 + ${SRC}/fraggle/collision_placeholder.f90 + ${SRC}/fraggle/collision_setup.f90 + ${SRC}/fraggle/collision_util.f90 ${SRC}/discard/discard.f90 ${SRC}/drift/drift.f90 ${SRC}/encounter/encounter_check.f90 @@ -33,7 +38,6 @@ SET(FAST_MATH_FILES ${SRC}/encounter/encounter_io.f90 ${SRC}/fraggle/fraggle_generate.f90 ${SRC}/fraggle/fraggle_io.f90 - ${SRC}/fraggle/fraggle_placeholder.f90 ${SRC}/fraggle/fraggle_regime.f90 ${SRC}/fraggle/fraggle_set.f90 ${SRC}/fraggle/fraggle_setup.f90 diff --git a/src/collision/collision_io.f90 b/src/collision/collision_io.f90 new file mode 100644 index 000000000..88c37cbbc --- /dev/null +++ b/src/collision/collision_io.f90 @@ -0,0 +1,227 @@ +!! Copyright 2022 - David Minton, Carlisle Wishard, Jennifer Pouplin, Jake Elliott, & Dana Singh +!! This file is part of Swiftest. +!! Swiftest is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License +!! as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. +!! Swiftest is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty +!! of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. +!! You should have received a copy of the GNU General Public License along with Swiftest. +!! If not, see: https://www.gnu.org/licenses. + +submodule(collision_classes) s_collision_io + use swiftest + +contains + + module subroutine collision_io_initialize(self, param) + !! author: David A. Minton + !! + !! Initialize a NetCDF fragment history file system. This is a simplified version of the main simulation output NetCDF file, but with fewer variables. + use, intrinsic :: ieee_arithmetic + use netcdf + implicit none + ! Arguments + class(collision_io_parameters), intent(inout) :: self !! Parameters used to identify a particular NetCDF dataset + class(swiftest_parameters), intent(in) :: param + ! Internals + integer(I4B) :: nvar, varid, vartype + real(DP) :: dfill + real(SP) :: sfill + integer(I4B), parameter :: NO_FILL = 0 + logical :: fileExists + character(len=STRMAX) :: errmsg + integer(I4B) :: ndims + + select type(param) + class is (symba_parameters) + associate(nc => self, collision_history => param%collision_history) + dfill = ieee_value(dfill, IEEE_QUIET_NAN) + sfill = ieee_value(sfill, IEEE_QUIET_NAN) + + select case (param%out_type) + case("NETCDF_FLOAT") + self%out_type = NF90_FLOAT + case("NETCDF_DOUBLE") + self%out_type = NF90_DOUBLE + end select + + ! Check if the file exists, and if it does, delete it + inquire(file=nc%file_name, exist=fileExists) + if (fileExists) then + open(unit=LUN, file=nc%file_name, status="old", err=667, iomsg=errmsg) + close(unit=LUN, status="delete") + end if + + call check( nf90_create(nc%file_name, NF90_NETCDF4, nc%id), "collision_io_initialize nf90_create" ) + + ! Dimensions + call check( nf90_def_dim(nc%id, nc%event_dimname, nc%event_dimsize, nc%event_dimid), "collision_io_initialize nf90_def_dim event_dimid" ) ! Dimension to store individual collision events + call check( nf90_def_dim(nc%id, nc%space_dimname, NDIM, nc%space_dimid), "collision_io_initialize nf90_def_dim space_dimid" ) ! 3D space dimension + call check( nf90_def_dim(nc%id, nc%name_dimname, nc%name_dimsize, nc%name_dimid), "collision_io_initialize nf90_def_dim name_dimid" ) ! Dimension to store particle id numbers + call check( nf90_def_dim(nc%id, nc%str_dimname, NAMELEN, nc%str_dimid), "collision_io_initialize nf90_def_dim str_dimid" ) ! Dimension for string variables (aka character arrays) + call check( nf90_def_dim(nc%id, nc%stage_dimname, 2, nc%stage_dimid), "collision_io_initialize nf90_def_dim stage_dimid" ) ! Dimension for stage variables (aka "before" vs. "after" + + ! Dimension coordinates + call check( nf90_def_var(nc%id, nc%space_dimname, NF90_CHAR, nc%space_dimid, nc%space_varid), "collision_io_initialize nf90_def_var space_varid" ) + call check( nf90_def_var(nc%id, nc%name_dimname, NF90_CHAR, [nc%str_dimid, nc%name_dimid], nc%name_varid), "collision_io_initialize nf90_def_var name_varid") + call check( nf90_def_var(nc%id, nc%stage_dimname, NF90_CHAR, [nc%str_dimid, nc%stage_dimid], nc%stage_varid), "collision_io_initialize nf90_def_var stage_varid" ) + + ! Variables + call check( nf90_def_var(nc%id, nc%id_varname, NF90_INT, nc%name_dimid, nc%id_varid), "collision_io_initialize nf90_def_var id_varid" ) + call check( nf90_def_var(nc%id, nc%time_dimname, nc%out_type, & + nc%event_dimid, nc%time_varid), "collision_io_initialize nf90_def_var time_varid" ) + call check( nf90_def_var(nc%id, nc%regime_varname, NF90_CHAR, & + [nc%str_dimid, nc%event_dimid], nc%regime_varid), "collision_io_initialize nf90_def_var regime_varid") + call check( nf90_def_var(nc%id, nc%Qloss_varname, nc%out_type, & + [ nc%event_dimid], nc%Qloss_varid), "collision_io_initialize nf90_def_var Qloss_varid") + + call check( nf90_def_var(nc%id, nc%ptype_varname, NF90_CHAR, & + [nc%str_dimid, nc%name_dimid, nc%stage_dimid, nc%event_dimid], nc%ptype_varid), "collision_io_initialize nf90_def_var ptype_varid") + + call check( nf90_def_var(nc%id, nc%loop_varname, NF90_INT, & + [ nc%event_dimid], nc%loop_varid), "collision_io_initialize nf90_def_var loop_varid") + + call check( nf90_def_var(nc%id, nc%rh_varname, nc%out_type,& + [ nc%space_dimid, nc%name_dimid, nc%stage_dimid, nc%event_dimid], nc%rh_varid), "collision_io_initialize nf90_def_var rh_varid") + + call check( nf90_def_var(nc%id, nc%vh_varname, nc%out_type,& + [ nc%space_dimid, nc%name_dimid, nc%stage_dimid, nc%event_dimid], nc%vh_varid), "collision_io_initialize nf90_def_var vh_varid") + + call check( nf90_def_var(nc%id, nc%Gmass_varname, nc%out_type,& + [ nc%name_dimid, nc%stage_dimid, nc%event_dimid], nc%Gmass_varid), "collision_io_initialize nf90_def_var Gmass_varid") + + + call check( nf90_def_var(nc%id, nc%radius_varname, nc%out_type,& + [ nc%name_dimid, nc%stage_dimid, nc%event_dimid], nc%radius_varid), "collision_io_initialize nf90_def_var radius_varid") + + call check( nf90_def_var(nc%id, nc%Ip_varname, nc%out_type,& + [ nc%space_dimid, nc%name_dimid, nc%stage_dimid, nc%event_dimid], nc%Ip_varid), "collision_io_initialize nf90_def_var Ip_varid") + + call check( nf90_def_var(nc%id, nc%rot_varname, nc%out_type,& + [ nc%space_dimid, nc%name_dimid, nc%stage_dimid, nc%event_dimid], nc%rot_varid), "collision_io_initialize nf90_def_var rot_varid") + + if (param%lenergy) then + + call check( nf90_def_var(nc%id, nc%ke_orb_varname, nc%out_type,& + [ nc%stage_dimid, nc%event_dimid], nc%KE_orb_varid), "collision_io_initialize nf90_def_var KE_orb_varid") + + call check( nf90_def_var(nc%id, nc%ke_spin_varname, nc%out_type,& + [ nc%stage_dimid, nc%event_dimid], nc%KE_spin_varid), "collision_io_initialize nf90_def_var KE_spin_varid" ) + + call check( nf90_def_var(nc%id, nc%pe_varname, nc%out_type,& + [ nc%stage_dimid, nc%event_dimid], nc%PE_varid), "collision_io_initialize nf90_def_var PE_varid" ) + + call check( nf90_def_var(nc%id, nc%L_orb_varname, nc%out_type, & + [ nc%space_dimid, nc%stage_dimid, nc%event_dimid], nc%L_orb_varid), "collision_io_initialize nf90_def_var L_orb_varid" ) + + call check( nf90_def_var(nc%id, nc%L_spin_varname, nc%out_type,& + [ nc%space_dimid, nc%stage_dimid, nc%event_dimid], nc%L_spin_varid), "collision_io_initialize nf90_def_var L_spin_varid" ) + end if + + call check( nf90_inquire(nc%id, nVariables=nvar), "collision_io_initialize nf90_inquire nVariables" ) + do varid = 1, nvar + call check( nf90_inquire_variable(nc%id, varid, xtype=vartype, ndims=ndims), "collision_io_initialize nf90_inquire_variable" ) + select case(vartype) + case(NF90_INT) + call check( nf90_def_var_fill(nc%id, varid, NO_FILL, NF90_FILL_INT), "collision_io_initialize nf90_def_var_fill NF90_INT" ) + case(NF90_FLOAT) + call check( nf90_def_var_fill(nc%id, varid, NO_FILL, sfill), "collision_io_initialize nf90_def_var_fill NF90_FLOAT" ) + case(NF90_DOUBLE) + call check( nf90_def_var_fill(nc%id, varid, NO_FILL, dfill), "collision_io_initialize nf90_def_var_fill NF90_DOUBLE" ) + case(NF90_CHAR) + call check( nf90_def_var_fill(nc%id, varid, NO_FILL, 0), "collision_io_initialize nf90_def_var_fill NF90_CHAR" ) + end select + end do + ! Take the file out of define mode + call check( nf90_enddef(nc%id), "collision_io_initialize nf90_enddef" ) + + ! Add in the space and stage dimension coordinates + call check( nf90_put_var(nc%id, nc%space_varid, nc%space_coords, start=[1], count=[NDIM]), "collision_io_initialize nf90_put_var space" ) + call check( nf90_put_var(nc%id, nc%stage_varid, nc%stage_coords(1), start=[1,1], count=[len(nc%stage_coords(1)),1]), "collision_io_initialize nf90_put_var stage 1" ) + call check( nf90_put_var(nc%id, nc%stage_varid, nc%stage_coords(2), start=[1,2], count=[len(nc%stage_coords(2)),1]), "collision_io_initialize nf90_put_var stage 2" ) + + end associate + end select + + return + + 667 continue + write(*,*) "Error creating fragmentation output file. " // trim(adjustl(errmsg)) + call util_exit(FAILURE) + end subroutine collision_io_initialize + + + module subroutine collision_io_write_frame_snapshot(self, nc, param) + !! author: David A. Minton + !! + !! Write a frame of output of a collision result + use netcdf + implicit none + ! Arguments + class(collision_snapshot), intent(in) :: self !! Swiftest encounter structure + class(netcdf_parameters), intent(inout) :: nc !! Parameters used to identify a particular encounter io NetCDF dataset + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + ! Internals + integer(I4B) :: i, idslot, old_mode, npl, stage + character(len=:), allocatable :: charstring + class(swiftest_pl), allocatable :: pl + + select type(nc) + class is (collision_io_parameters) + select type (param) + class is (symba_parameters) + associate(impactors => self%impactors, fragments => self%fragments, collision_history => param%collision_history, eslot => param%ioutput) + call check( nf90_set_fill(nc%id, nf90_nofill, old_mode), "collision_io_write_frame_snapshot nf90_set_fill" ) + + call check( nf90_put_var(nc%id, nc%time_varid, self%t, start=[eslot]), "collision_io_write_frame_snapshot nf90_put_var time_varid" ) + call check( nf90_put_var(nc%id, nc%loop_varid, int(self%iloop,kind=I4B), start=[eslot]), "collision_io_write_frame_snapshot nf90_put_varloop_varid" ) + + charstring = trim(adjustl(REGIME_NAMES(fragments%regime))) + call check( nf90_put_var(nc%id, nc%regime_varid, charstring, start=[1, eslot], count=[len(charstring), 1]), "collision_io_write_frame_snapshot nf90_put_var regime_varid" ) + call check( nf90_put_var(nc%id, nc%Qloss_varid, fragments%Qloss, start=[eslot] ), "collision_io_write_frame_snapshot nf90_put_var Qloss_varid" ) + + do stage = 1,2 + if (allocated(pl)) deallocate(pl) + select case(stage) + case(1) + allocate(pl, source=impactors%pl) + case(2) + allocate(pl, source=fragments%pl) + end select + npl = pl%nbody + do i = 1, npl + idslot = findloc(collision_history%idvals,pl%id(i),dim=1) + call check( nf90_put_var(nc%id, nc%id_varid, pl%id(i), start=[ idslot ]), "collision_io_write_frame_snapshot nf90_put_var id_varid" ) + charstring = trim(adjustl(pl%info(i)%name)) + call check( nf90_put_var(nc%id, nc%name_varid, charstring, start=[1, idslot ], count=[len(charstring), 1]), "collision_io_write_frame_snapshot nf90_put_var name_varid" ) + charstring = trim(adjustl(pl%info(i)%particle_type)) + call check( nf90_put_var(nc%id, nc%ptype_varid, charstring, start=[1, idslot, stage, eslot], count=[len(charstring), 1, 1]), "collision_io_write_frame_snapshot nf90_put_var particle_type_varid" ) + call check( nf90_put_var(nc%id, nc%rh_varid, pl%rh(:,i), start=[1, idslot, stage, eslot], count=[NDIM,1,1,1]), "collision_io_write_frame_snapshot nf90_put_var rh_varid" ) + call check( nf90_put_var(nc%id, nc%vh_varid, pl%vh(:,i), start=[1, idslot, stage, eslot], count=[NDIM,1,1,1]), "collision_io_write_frame_snapshot nf90_put_var vh_varid" ) + call check( nf90_put_var(nc%id, nc%Gmass_varid, pl%Gmass(i), start=[ idslot, stage, eslot]), "collision_io_write_frame_snapshot nf90_put_var Gmass_varid" ) + call check( nf90_put_var(nc%id, nc%radius_varid, pl%radius(i), start=[ idslot, stage, eslot]), "collision_io_write_frame_snapshot nf90_put_var radius_varid" ) + call check( nf90_put_var(nc%id, nc%Ip_varid, pl%Ip(:,i), start=[1, idslot, stage, eslot], count=[NDIM,1,1,1]), "collision_io_write_frame_snapshot nf90_put_var Ip_varid" ) + call check( nf90_put_var(nc%id, nc%rot_varid, pl%rot(:,i), start=[1, idslot, stage, eslot], count=[NDIM,1,1,1]), "collision_io_write_frame_snapshot nf90_put_var rotx_varid" ) + end do + end do + if (param%lenergy) then + call check( nf90_put_var(nc%id, nc%ke_orb_varid, fragments%ke_orbit_before, start=[ 1, eslot]), "collision_io_write_frame_snapshot nf90_put_var ke_orb_varid before" ) + call check( nf90_put_var(nc%id, nc%ke_orb_varid, fragments%ke_orbit_after, start=[ 2, eslot]), "collision_io_write_frame_snapshot nf90_put_var ke_orb_varid after" ) + call check( nf90_put_var(nc%id, nc%ke_spin_varid, fragments%ke_spin_before, start=[ 1, eslot]), "collision_io_write_frame_snapshot nf90_put_var ke_spin_varid before" ) + call check( nf90_put_var(nc%id, nc%ke_spin_varid, fragments%ke_spin_after, start=[ 2, eslot]), "collision_io_write_frame_snapshot nf90_put_var ke_spin_varid after" ) + call check( nf90_put_var(nc%id, nc%pe_varid, fragments%pe_before, start=[ 1, eslot]), "collision_io_write_frame_snapshot nf90_put_var pe_varid before" ) + call check( nf90_put_var(nc%id, nc%pe_varid, fragments%pe_after, start=[ 2, eslot]), "collision_io_write_frame_snapshot nf90_put_var pe_varid after" ) + call check( nf90_put_var(nc%id, nc%L_orb_varid, fragments%Lorbit_before(:), start=[1, 1, eslot], count=[NDIM, 1, 1]), "collision_io_write_frame_snapshot nf90_put_var L_orb_varid before" ) + call check( nf90_put_var(nc%id, nc%L_orb_varid, fragments%Lorbit_after(:), start=[1, 2, eslot], count=[NDIM, 1, 1]), "collision_io_write_frame_snapshot nf90_put_var L_orb_varid after" ) + call check( nf90_put_var(nc%id, nc%L_spin_varid, fragments%Lspin_before(:), start=[1, 1, eslot], count=[NDIM, 1, 1]), "collision_io_write_frame_snapshot nf90_put_var L_spin_varid before" ) + call check( nf90_put_var(nc%id, nc%L_spin_varid, fragments%Lspin_after(:), start=[1, 2, eslot], count=[NDIM, 1, 1]), "collision_io_write_frame_snapshot nf90_put_var L_spin_varid after" ) + end if + + call check( nf90_set_fill(nc%id, old_mode, old_mode) ) + end associate + end select + end select + return + end subroutine collision_io_write_frame_snapshot + + +end submodule s_collision_io \ No newline at end of file diff --git a/src/fraggle/fraggle_placeholder.f90 b/src/collision/collision_placeholder.f90 similarity index 74% rename from src/fraggle/fraggle_placeholder.f90 rename to src/collision/collision_placeholder.f90 index 35d5ea960..61ae6eebd 100644 --- a/src/fraggle/fraggle_placeholder.f90 +++ b/src/collision/collision_placeholder.f90 @@ -7,47 +7,47 @@ !! You should have received a copy of the GNU General Public License along with Swiftest. !! If not, see: https://www.gnu.org/licenses. -submodule(fraggle_classes) s_fraggle_placeholder +submodule(collision_classes) s_collision_placeholder use swiftest contains !> The following interfaces are placeholders intended to satisfy the required abstract methods given by the parent class - module subroutine fraggle_placeholder_accel(self, system, param, t, lbeg) + module subroutine collision_placeholder_accel(self, system, param, t, lbeg) implicit none - class(fraggle_fragments), intent(inout) :: self !! Fraggle fragment system object + class(collision_fragments), intent(inout) :: self !! Fraggle fragment system object class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! Current simulation time logical, intent(in) :: lbeg !! Optional argument that determines whether or not this is the beginning or end of the step - write(*,*) "The type-bound procedure 'accel' is not defined for type fraggle_fragments" + write(*,*) "The type-bound procedure 'accel' is not defined for the collision_fragments class" return - end subroutine fraggle_placeholder_accel + end subroutine collision_placeholder_accel - module subroutine fraggle_placeholder_kick(self, system, param, t, dt, lbeg) + module subroutine collision_placeholder_kick(self, system, param, t, dt, lbeg) implicit none - class(fraggle_fragments), intent(inout) :: self !! Fraggle fragment system object + class(collision_fragments), intent(inout) :: self !! Fraggle fragment system object class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system objec class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! Current time real(DP), intent(in) :: dt !! Stepsize logical, intent(in) :: lbeg !! Logical flag indicating whether this is the beginning of the half step or not. - write(*,*) "The type-bound procedure 'kick' is not defined for type fraggle_fragments" + write(*,*) "The type-bound procedure 'kick' is not defined for the collision_fragments class" return - end subroutine fraggle_placeholder_kick + end subroutine collision_placeholder_kick - module subroutine fraggle_placeholder_step(self, system, param, t, dt) + module subroutine collision_placeholder_step(self, system, param, t, dt) implicit none - class(fraggle_fragments), intent(inout) :: self !! Swiftest body object + class(collision_fragments), intent(inout) :: self !! Swiftest body object class(swiftest_nbody_system), intent(inout) :: system !! Swiftest system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! Simulation time real(DP), intent(in) :: dt !! Current stepsize - write(*,*) "The type-bound procedure 'step' is not defined for type fraggle_fragments" + write(*,*) "The type-bound procedure 'step' is not defined for the collision_fragments class" return - end subroutine fraggle_placeholder_step + end subroutine collision_placeholder_step -end submodule s_fraggle_placeholder \ No newline at end of file +end submodule s_collision_placeholder \ No newline at end of file diff --git a/src/collision/collision_setup.f90 b/src/collision/collision_setup.f90 new file mode 100644 index 000000000..24d565472 --- /dev/null +++ b/src/collision/collision_setup.f90 @@ -0,0 +1,73 @@ +!! Copyright 2022 - David Minton, Carlisle Wishard, Jennifer Pouplin, Jake Elliott, & Dana Singh +!! This file is part of Swiftest. +!! Swiftest is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License +!! as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. +!! Swiftest is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty +!! of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. +!! You should have received a copy of the GNU General Public License along with Swiftest. +!! If not, see: https://www.gnu.org/licenses. + +submodule (collision_classes) s_collision_setup + use swiftest +contains + + module subroutine collision_setup_system(self, system, param) + !! author: David A. Minton + !! + !! Initializer for the encounter collision system. Allocates the collider and fragments classes and the before/after snapshots + implicit none + ! Arguments + class(collision_system), intent(inout) :: self !! Encounter collision system object + class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + ! Internals + + + return + end subroutine collision_setup_system + + module subroutine collision_setup_fragments(self, n, param) + !! author: David A. Minton + !! + !! Allocates arrays for n fragments in a collision system. Passing n = 0 deallocates all arrays. + implicit none + ! Arguments + class(collision_fragments), intent(inout) :: self + integer(I4B), intent(in) :: n + class(swiftest_parameters), intent(in) :: param + + + call self%swiftest_pl%setup(n, param) + if (n < 0) return + + call self%dealloc() + + if (n == 0) return + + ! allocate(self%rotmag(n)) + ! allocate(self%v_r_mag(n)) + ! allocate(self%v_t_mag(n)) + ! allocate(self%v_n_mag(n)) + + call self%reset() + + return + end subroutine collision_setup_fragments + + + module subroutine collision_setup_impactors(self, system, param) + !! author: David A. Minton + !! + !! Initializes a collider object + implicit none + ! Arguments + class(collision_impactors), intent(inout) :: self !! Fragment system object + class(swiftest_nbody_system), intent(in) :: system + class(swiftest_parameters), intent(in) :: param !! Current swiftest run configuration parameters + + return + end subroutine collision_setup_impactors + +end submodule s_collision_setup + + \ No newline at end of file diff --git a/src/collision/collision_util.f90 b/src/collision/collision_util.f90 new file mode 100644 index 000000000..fc0926c91 --- /dev/null +++ b/src/collision/collision_util.f90 @@ -0,0 +1,341 @@ +!! 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_util + use swiftest +contains + + module subroutine collision_util_final_impactors(self) + !! author: David A. Minton + !! + !! Finalizer will deallocate all allocatables + implicit none + ! Arguments + type(collision_impactors), intent(inout) :: self !! Collision impactors storage object + + call self%reset() + + return + end subroutine collision_util_final_impactors + + + module subroutine collision_util_final_system(self) + !! author: David A. Minton + !! + !! Finalizer will deallocate all allocatables + implicit none + ! Arguments + type(collision_system), intent(inout) :: self !! Collision impactors storage object + + call self%reset() + + return + end subroutine collision_util_final_system + + + module subroutine collision_util_final_snapshot(self) + !! author: David A. Minton + !! + !! Finalizer will deallocate all allocatables + implicit none + ! Arguments + type(collision_snapshot), intent(inout) :: self !! Fraggle encountar storage object + + call encounter_util_final_snapshot(self%encounter_snapshot) + + return + end subroutine collision_util_final_snapshot + + + module subroutine collision_util_final_storage(self) + !! author: David A. Minton + !! + !! Finalizer will deallocate all allocatables + implicit none + ! Arguments + type(collision_storage(*)), intent(inout) :: self !! Collision storage object + + call util_final_storage(self%swiftest_storage) + + return + end subroutine collision_util_final_storage + + + module subroutine collision_util_final_system(self) + !! author: David A. Minton + !! + !! Finalizer will deallocate all allocatables + implicit none + ! Arguments + type(collision_system), intent(inout) :: self !! Collision system object + + call self%reset() + + return + end subroutine collision_util_final_storage + + + module subroutine collision_util_get_idvalues_snapshot(self, idvals) + !! author: David A. Minton + !! + !! Returns an array of all id values saved in this snapshot + implicit none + ! Arguments + class(collision_snapshot), intent(in) :: self !! Fraggle snapshot object + integer(I4B), dimension(:), allocatable, intent(out) :: idvals !! Array of all id values saved in this snapshot + ! Internals + integer(I4B) :: ncoll, nfrag + + if (allocated(self%impactors)) then + ncoll = self%impactors%pl%nbody + else + ncoll = 0 + end if + + if (allocated(self%fragments)) then + nfrag = self%fragments%pl%nbody + else + nfrag = 0 + end if + + if (ncoll + nfrag == 0) return + allocate(idvals(ncoll+nfrag)) + + if (ncoll > 0) idvals(1:ncoll) = self%impactors%pl%id(:) + if (nfrag > 0) idvals(ncoll+1:ncoll+nfrag) = self%fragments%pl%id(:) + + return + + end subroutine collision_util_get_idvalues_snapshot + + + module subroutine collision_util_get_energy_momentum(self, system, param, lbefore) + !! Author: David A. Minton + !! + !! Calculates total system energy in either the pre-collision outcome state (lbefore = .true.) or the post-collision outcome state (lbefore = .false.) + !! This subrourtine works by building a temporary internal massive body object out of the non-excluded bodies and optionally with fragments appended. + !! This will get passed to the energy calculation subroutine so that energy is computed exactly the same way is it is in the main program. + !! This will temporarily expand the massive body object in a temporary system object called tmpsys to feed it into symba_energy + implicit none + ! Arguments + class(collision_system), intent(inout) :: self !! Encounter collision system object + class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_parameters), intent(inout) :: param !! Current swiftest run configuration parameters + logical, intent(in) :: lbefore !! Flag indicating that this the "before" state of the system, with impactors included and fragments excluded or vice versa + ! Internals + class(swiftest_nbody_system), allocatable, save :: tmpsys + class(swiftest_parameters), allocatable, save :: tmpparam + integer(I4B) :: npl_before, npl_after + + associate(fragments => self%fragments, impactors => self%impactors, nfrag => self%fragments%nbody, pl => system%pl, cb => system%cb) + + ! Because we're making a copy of the massive body object with the excludes/fragments appended, we need to deallocate the + ! big k_plpl array and recreate it when we're done, otherwise we run the risk of blowing up the memory by + ! allocating two of these ginormous arrays simulteouously. This is not particularly efficient, but as this + ! subroutine should be called relatively infrequently, it shouldn't matter too much. + + npl_before = pl%nbody + npl_after = npl_before + nfrag + + if (lbefore) then + call encounter_util_construct_temporary_system(fragments, system, param, tmpsys, tmpparam) + ! Build the exluded body logical mask for the *before* case: Only the original bodies are used to compute energy and momentum + tmpsys%pl%status(impactors%idx(1:impactors%ncoll)) = ACTIVE + tmpsys%pl%status(npl_before+1:npl_after) = INACTIVE + else + if (.not.allocated(tmpsys)) then + write(*,*) "Error in collision_util_get_energy_momentum. " // & + " This must be called with lbefore=.true. at least once before calling it with lbefore=.false." + call util_exit(FAILURE) + end if + ! Build the exluded body logical mask for the *after* case: Only the new bodies are used to compute energy and momentum + call encounter_util_add_fragments_to_system(fragments, impactors, tmpsys, tmpparam) + tmpsys%pl%status(impactors%idx(1:impactors%ncoll)) = INACTIVE + tmpsys%pl%status(npl_before+1:npl_after) = ACTIVE + end if + + if (param%lflatten_interactions) call tmpsys%pl%flatten(param) + + call tmpsys%get_energy_and_momentum(param) + + ! Calculate the current fragment energy and momentum balances + if (lbefore) then + fragments%Lorbit_before(:) = tmpsys%Lorbit(:) + fragments%Lspin_before(:) = tmpsys%Lspin(:) + fragments%Ltot_before(:) = tmpsys%Ltot(:) + fragments%ke_orbit_before = tmpsys%ke_orbit + fragments%ke_spin_before = tmpsys%ke_spin + fragments%pe_before = tmpsys%pe + fragments%Etot_before = tmpsys%te + else + fragments%Lorbit_after(:) = tmpsys%Lorbit(:) + fragments%Lspin_after(:) = tmpsys%Lspin(:) + fragments%Ltot_after(:) = tmpsys%Ltot(:) + fragments%ke_orbit_after = tmpsys%ke_orbit + fragments%ke_spin_after = tmpsys%ke_spin + fragments%pe_after = tmpsys%pe + fragments%Etot_after = tmpsys%te - (fragments%pe_after - fragments%pe_before) ! Gotta be careful with PE when number of bodies changes. + end if + end associate + + return + end subroutine collision_util_get_energy_momentum + + + module subroutine collision_util_index_map(self) + !! author: David A. Minton + !! + !! Maps body id values to storage index values so we don't have to use unlimited dimensions for id + implicit none + ! Arguments + class(collision_storage(*)), intent(inout) :: self !! Swiftest storage object + ! Internals + integer(I4B), dimension(:), allocatable :: idvals + real(DP), dimension(:), allocatable :: tvals + + call encounter_util_get_vals_storage(self, idvals, tvals) + + ! Consolidate ids to only unique values + call util_unique(idvals,self%idvals,self%idmap) + self%nid = size(self%idvals) + + ! Don't consolidate time values (multiple collisions can happen in a single time step) + self%nt = size(self%tvals) + + return + end subroutine collision_util_index_map + + + module subroutine collision_util_reset_fragments(self) + !! author: David A. Minton + !! + !! Deallocates all allocatables + implicit none + ! Arguments + class(collision_fragments), intent(inout) :: self + + call self%swiftest_pl%dealloc() + + if (allocated(self%rc)) deallocate(self%rc) + if (allocated(self%vc)) deallocate(self%vc) + if (allocated(self%rmag)) deallocate(self%rmag) + if (allocated(self%rotmag)) deallocate(self%rotmag) + if (allocated(self%v_r_unit)) deallocate(self%v_r_unit) + if (allocated(self%v_t_unit)) deallocate(self%v_t_unit) + if (allocated(self%v_n_unit)) deallocate(self%v_n_unit) + + return + end subroutine collision_util_reset_fragments + + + module subroutine collision_util_reset_impactors(self) + !! author: David A. Minton + !! + !! Resets the collider object variables to 0 and deallocates the index and mass distributions + implicit none + ! Arguments + class(collision_impactors), intent(inout) :: self + + if (allocated(self%idx)) deallocate(self%idx) + if (allocated(self%mass_dist)) deallocate(self%mass_dist) + ncoll = 0 + rb(:,:) = 0.0_DP + vb(:,:) = 0.0_DP + rot(:,:) = 0.0_DP + L_spin(:,:) = 0.0_DP + L_orbit(:,:) = 0.0_DP + Ip(:,:) = 0.0_DP + mass(:) = 0.0_DP + radius(:) = 0.0_DP + Qloss = 0.0_DP + regime = 0 + + x_unit(:) = 0.0_DP + y_unit(:) = 0.0_DP + z_unit(:) = 0.0_DP + v_unit(:) = 0.0_DP + rbcom(:) = 0.0_DP + vbcom(:) = 0.0_DP + rbimp(:) = 0.0_DP + + return + end subroutine collision_util_reset_impactors + + + module subroutine collision_util_reset_system(self) + !! author: David A. Minton + !! + !! Resets the collider system and deallocates all allocatables + implicit none + ! Arguments + class(collision_system), intent(inout) :: self + + if (allocated(self%impactors)) deallocate(self%impactors) + if (allocated(self%fragments)) deallocate(self%fragments) + if (allocated(self%before)) deallocate(self%before) + if (allocated(self%after)) deallocate(self%after) + + Lorbit(:,:) = 0.0_DP + Lspin(:,:) = 0.0_DP + Ltot(:,:) = 0.0_DP + ke_orbit(:) = 0.0_DP + ke_spin(:) = 0.0_DP + pe(:) = 0.0_DP + Etot(:) = 0.0_DP + + return + end subroutine collision_util_reset_impactors + + + subroutine collision_util_save_snapshot(collision_history, snapshot) + !! author: David A. Minton + !! + !! Checks the current size of the encounter storage against the required size and extends it by a factor of 2 more than requested if it is too small. + !! Note: The reason to extend it by a factor of 2 is for performance. When there are many enounters per step, resizing every time you want to add an + !! encounter takes significant computational effort. Resizing by a factor of 2 is a tradeoff between performance (fewer resize calls) and memory managment + !! Memory usage grows by a factor of 2 each time it fills up, but no more. + implicit none + ! Arguments + type(collision_storage(*)), allocatable, intent(inout) :: collision_history !! Collision history object + class(encounter_snapshot), intent(in) :: snapshot !! Encounter snapshot object + ! Internals + type(collision_storage(nframes=:)), allocatable :: tmp + integer(I4B) :: i, nnew, nold, nbig + + ! Advance the snapshot frame counter + collision_history%iframe = collision_history%iframe + 1 + + ! Check to make sure the current encounter_history object is big enough. If not, grow it by a factor of 2 + nnew = collision_history%iframe + nold = collision_history%nframes + + if (nnew > nold) then + nbig = nold + do while (nbig < nnew) + nbig = nbig * 2 + end do + allocate(collision_storage(nbig) :: tmp) + tmp%iframe = collision_history%iframe + call move_alloc(collision_history%nc, tmp%nc) + + do i = 1, nold + if (allocated(collision_history%frame(i)%item)) call move_alloc(collision_history%frame(i)%item, tmp%frame(i)%item) + end do + deallocate(collision_history) + call move_alloc(tmp,collision_history) + nnew = nbig + end if + + collision_history%frame(nnew) = snapshot + + return + end subroutine collision_util_save_snapshot + + +end submodule s_encounter_util \ No newline at end of file diff --git a/src/encounter/encounter_io.f90 b/src/encounter/encounter_io.f90 index 60748c5b0..fb84067ca 100644 --- a/src/encounter/encounter_io.f90 +++ b/src/encounter/encounter_io.f90 @@ -12,7 +12,7 @@ contains - module subroutine encounter_io_dump_collision(self, param) + module subroutine collision_io_dump(self, param) !! author: David A. Minton !! !! Dumps the time history of an encounter to file. @@ -24,7 +24,7 @@ module subroutine encounter_io_dump_collision(self, param) integer(I4B) :: i select type(nc => self%nc) - class is (fraggle_io_parameters) + class is (collision_io_parameters) if (self%iframe > 0) then nc%file_number = nc%file_number + 1 call self%make_index_map() @@ -37,7 +37,7 @@ module subroutine encounter_io_dump_collision(self, param) do i = 1, self%nframes if (allocated(self%frame(i)%item)) then select type(snapshot => self%frame(i)%item) - class is (fraggle_snapshot) + class is (collision_snapshot) param%ioutput = i call snapshot%write_frame(nc,param) end select @@ -52,10 +52,10 @@ module subroutine encounter_io_dump_collision(self, param) end select return - end subroutine encounter_io_dump_collision + end subroutine collision_io_dump - module subroutine encounter_io_dump_encounter(self, param) + module subroutine encounter_io_dump(self, param) ! author: David A. Minton !! !! Dumps the time history of an encounter to file. @@ -95,7 +95,7 @@ module subroutine encounter_io_dump_encounter(self, param) end select return - end subroutine encounter_io_dump_encounter + end subroutine encounter_io_dump module subroutine encounter_io_initialize(self, param) @@ -194,7 +194,7 @@ module subroutine encounter_io_initialize(self, param) end subroutine encounter_io_initialize - module subroutine encounter_io_write_frame(self, nc, param) + module subroutine encounter_io_write_frame_snapshot(self, nc, param) !! author: David A. Minton !! !! Write a frame of output of an encounter trajectory. @@ -213,43 +213,43 @@ module subroutine encounter_io_write_frame(self, nc, param) select type (param) class is (symba_parameters) associate(pl => self%pl, tp => self%tp, encounter_history => param%encounter_history, tslot => param%ioutput) - call check( nf90_set_fill(nc%id, nf90_nofill, old_mode), "encounter_io_write_frame nf90_set_fill" ) + call check( nf90_set_fill(nc%id, nf90_nofill, old_mode), "encounter_io_write_frame_snapshot nf90_set_fill" ) - call check( nf90_put_var(nc%id, nc%time_varid, self%t, start=[tslot]), "encounter_io_write_frame nf90_put_var time_varid" ) - call check( nf90_put_var(nc%id, nc%loop_varid, int(self%iloop,kind=I4B), start=[tslot]), "encounter_io_write_frame nf90_put_var pl loop_varid" ) + call check( nf90_put_var(nc%id, nc%time_varid, self%t, start=[tslot]), "encounter_io_write_frame_snapshot nf90_put_var time_varid" ) + call check( nf90_put_var(nc%id, nc%loop_varid, int(self%iloop,kind=I4B), start=[tslot]), "encounter_io_write_frame_snapshot nf90_put_var pl loop_varid" ) npl = pl%nbody do i = 1, npl idslot = findloc(encounter_history%idvals,pl%id(i),dim=1) - call check( nf90_put_var(nc%id, nc%id_varid, pl%id(i), start=[idslot]), "encounter_io_write_frame nf90_put_var pl id_varid" ) - call check( nf90_put_var(nc%id, nc%rh_varid, pl%rh(:,i), start=[1,idslot,tslot], count=[NDIM,1,1]), "encounter_io_write_frame nf90_put_var pl rh_varid" ) - call check( nf90_put_var(nc%id, nc%vh_varid, pl%vh(:,i), start=[1,idslot,tslot], count=[NDIM,1,1]), "encounter_io_write_frame nf90_put_var pl vh_varid" ) - call check( nf90_put_var(nc%id, nc%Gmass_varid, pl%Gmass(i), start=[idslot, tslot]), "encounter_io_write_frame nf90_put_var pl Gmass_varid" ) + call check( nf90_put_var(nc%id, nc%id_varid, pl%id(i), start=[idslot]), "encounter_io_write_frame_snapshot nf90_put_var pl id_varid" ) + call check( nf90_put_var(nc%id, nc%rh_varid, pl%rh(:,i), start=[1,idslot,tslot], count=[NDIM,1,1]), "encounter_io_write_frame_snapshot nf90_put_var pl rh_varid" ) + call check( nf90_put_var(nc%id, nc%vh_varid, pl%vh(:,i), start=[1,idslot,tslot], count=[NDIM,1,1]), "encounter_io_write_frame_snapshot nf90_put_var pl vh_varid" ) + call check( nf90_put_var(nc%id, nc%Gmass_varid, pl%Gmass(i), start=[idslot, tslot]), "encounter_io_write_frame_snapshot nf90_put_var pl Gmass_varid" ) - if (param%lclose) call check( nf90_put_var(nc%id, nc%radius_varid, pl%radius(i), start=[idslot, tslot]), "encounter_io_write_frame nf90_put_var pl radius_varid" ) + if (param%lclose) call check( nf90_put_var(nc%id, nc%radius_varid, pl%radius(i), start=[idslot, tslot]), "encounter_io_write_frame_snapshot nf90_put_var pl radius_varid" ) if (param%lrotation) then - call check( nf90_put_var(nc%id, nc%Ip_varid, pl%Ip(:,i), start=[1, idslot, tslot], count=[NDIM,1,1]), "encounter_io_write_frame nf90_put_var pl Ip_varid" ) - call check( nf90_put_var(nc%id, nc%rot_varid, pl%rot(:,i), start=[1,idslot, tslot], count=[NDIM,1,1]), "encounter_io_write_frame nf90_put_var pl rotx_varid" ) + call check( nf90_put_var(nc%id, nc%Ip_varid, pl%Ip(:,i), start=[1, idslot, tslot], count=[NDIM,1,1]), "encounter_io_write_frame_snapshot nf90_put_var pl Ip_varid" ) + call check( nf90_put_var(nc%id, nc%rot_varid, pl%rot(:,i), start=[1,idslot, tslot], count=[NDIM,1,1]), "encounter_io_write_frame_snapshot nf90_put_var pl rotx_varid" ) end if charstring = trim(adjustl(pl%info(i)%name)) - call check( nf90_put_var(nc%id, nc%name_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "encounter_io_write_frame nf90_put_var pl name_varid" ) + call check( nf90_put_var(nc%id, nc%name_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "encounter_io_write_frame_snapshot nf90_put_var pl name_varid" ) charstring = trim(adjustl(pl%info(i)%particle_type)) - call check( nf90_put_var(nc%id, nc%ptype_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "encounter_io_write_frame nf90_put_var pl particle_type_varid" ) + call check( nf90_put_var(nc%id, nc%ptype_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "encounter_io_write_frame_snapshot nf90_put_var pl particle_type_varid" ) end do ntp = tp%nbody do i = 1, ntp idslot = findloc(param%encounter_history%idvals,tp%id(i),dim=1) - call check( nf90_put_var(nc%id, nc%id_varid, tp%id(i), start=[idslot]), "encounter_io_write_frame nf90_put_var tp id_varid" ) - call check( nf90_put_var(nc%id, nc%rh_varid, tp%rh(:,i), start=[1,idslot,tslot], count=[NDIM,1,1]), "encounter_io_write_frame nf90_put_var tp rh_varid" ) - call check( nf90_put_var(nc%id, nc%vh_varid, tp%vh(:,i), start=[1,idslot,tslot], count=[NDIM,1,1]), "encounter_io_write_frame nf90_put_var tp vh_varid" ) + call check( nf90_put_var(nc%id, nc%id_varid, tp%id(i), start=[idslot]), "encounter_io_write_frame_snapshot nf90_put_var tp id_varid" ) + call check( nf90_put_var(nc%id, nc%rh_varid, tp%rh(:,i), start=[1,idslot,tslot], count=[NDIM,1,1]), "encounter_io_write_frame_snapshot nf90_put_var tp rh_varid" ) + call check( nf90_put_var(nc%id, nc%vh_varid, tp%vh(:,i), start=[1,idslot,tslot], count=[NDIM,1,1]), "encounter_io_write_frame_snapshot nf90_put_var tp vh_varid" ) charstring = trim(adjustl(tp%info(i)%name)) - call check( nf90_put_var(nc%id, nc%name_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "encounter_io_write_frame nf90_put_var tp name_varid" ) + call check( nf90_put_var(nc%id, nc%name_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "encounter_io_write_frame_snapshot nf90_put_var tp name_varid" ) charstring = trim(adjustl(tp%info(i)%particle_type)) - call check( nf90_put_var(nc%id, nc%ptype_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "encounter_io_write_frame nf90_put_var tp particle_type_varid" ) + call check( nf90_put_var(nc%id, nc%ptype_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "encounter_io_write_frame_snapshot nf90_put_var tp particle_type_varid" ) end do call check( nf90_set_fill(nc%id, old_mode, old_mode) ) @@ -258,7 +258,7 @@ module subroutine encounter_io_write_frame(self, nc, param) end select return - end subroutine encounter_io_write_frame + end subroutine encounter_io_write_frame_snapshot diff --git a/src/encounter/encounter_placeholder.f90 b/src/encounter/encounter_placeholder.f90 new file mode 100644 index 000000000..61ae6eebd --- /dev/null +++ b/src/encounter/encounter_placeholder.f90 @@ -0,0 +1,53 @@ +!! Copyright 2022 - David Minton, Carlisle Wishard, Jennifer Pouplin, Jake Elliott, & Dana Singh +!! This file is part of Swiftest. +!! Swiftest is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License +!! as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. +!! Swiftest is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty +!! of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. +!! You should have received a copy of the GNU General Public License along with Swiftest. +!! If not, see: https://www.gnu.org/licenses. + +submodule(collision_classes) s_collision_placeholder + use swiftest + +contains + + !> The following interfaces are placeholders intended to satisfy the required abstract methods given by the parent class + module subroutine collision_placeholder_accel(self, system, param, t, lbeg) + implicit none + class(collision_fragments), intent(inout) :: self !! Fraggle fragment system object + class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + real(DP), intent(in) :: t !! Current simulation time + logical, intent(in) :: lbeg !! Optional argument that determines whether or not this is the beginning or end of the step + write(*,*) "The type-bound procedure 'accel' is not defined for the collision_fragments class" + return + end subroutine collision_placeholder_accel + + module subroutine collision_placeholder_kick(self, system, param, t, dt, lbeg) + implicit none + class(collision_fragments), intent(inout) :: self !! Fraggle fragment system object + class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system objec + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + real(DP), intent(in) :: t !! Current time + real(DP), intent(in) :: dt !! Stepsize + logical, intent(in) :: lbeg !! Logical flag indicating whether this is the beginning of the half step or not. + + write(*,*) "The type-bound procedure 'kick' is not defined for the collision_fragments class" + return + end subroutine collision_placeholder_kick + + module subroutine collision_placeholder_step(self, system, param, t, dt) + implicit none + class(collision_fragments), intent(inout) :: self !! Swiftest body object + class(swiftest_nbody_system), intent(inout) :: system !! Swiftest system object + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + real(DP), intent(in) :: t !! Simulation time + real(DP), intent(in) :: dt !! Current stepsize + + write(*,*) "The type-bound procedure 'step' is not defined for the collision_fragments class" + return + end subroutine collision_placeholder_step + + +end submodule s_collision_placeholder \ No newline at end of file diff --git a/src/encounter/encounter_util.f90 b/src/encounter/encounter_util.f90 index 9d9c97f11..c4acc1df9 100644 --- a/src/encounter/encounter_util.f90 +++ b/src/encounter/encounter_util.f90 @@ -156,20 +156,6 @@ module subroutine encounter_util_final_snapshot(self) end subroutine encounter_util_final_snapshot - module subroutine encounter_util_final_collision_storage(self) - !! author: David A. Minton - !! - !! Finalizer will deallocate all allocatables - implicit none - ! Arguments - type(collision_storage(*)), intent(inout) :: self !! SyMBA nbody system object - - call util_final_storage(self%swiftest_storage) - - return - end subroutine encounter_util_final_collision_storage - - module subroutine encounter_util_final_storage(self) !! author: David A. Minton !! @@ -275,7 +261,7 @@ subroutine encounter_util_get_vals_storage(storage, idvals, tvals) end subroutine encounter_util_get_vals_storage - module subroutine encounter_util_index_map_encounter(self) + module subroutine encounter_util_index_map(self) !! author: David A. Minton !! !! Maps body id values to storage index values so we don't have to use unlimited dimensions for id. @@ -298,32 +284,7 @@ module subroutine encounter_util_index_map_encounter(self) self%nt = size(self%tvals) return - end subroutine encounter_util_index_map_encounter - - - - module subroutine encounter_util_index_map_collision(self) - !! author: David A. Minton - !! - !! Maps body id values to storage index values so we don't have to use unlimited dimensions for id - implicit none - ! Arguments - class(collision_storage(*)), intent(inout) :: self !! Swiftest storage object - ! Internals - integer(I4B), dimension(:), allocatable :: idvals - real(DP), dimension(:), allocatable :: tvals - - call encounter_util_get_vals_storage(self, idvals, tvals) - - ! Consolidate ids to only unique values - call util_unique(idvals,self%idvals,self%idmap) - self%nid = size(self%idvals) - - ! Don't consolidate time values (multiple collisions can happen in a single time step) - self%nt = size(self%tvals) - - return - end subroutine encounter_util_index_map_collision + end subroutine encounter_util_index_map module subroutine encounter_util_resize_list(self, nnew) @@ -402,53 +363,7 @@ module subroutine encounter_util_spill_list(self, discards, lspill_list, ldestru end subroutine encounter_util_spill_list - - subroutine encounter_util_save_collision(collision_history, snapshot) - !! author: David A. Minton - !! - !! Checks the current size of the encounter storage against the required size and extends it by a factor of 2 more than requested if it is too small. - !! Note: The reason to extend it by a factor of 2 is for performance. When there are many enounters per step, resizing every time you want to add an - !! encounter takes significant computational effort. Resizing by a factor of 2 is a tradeoff between performance (fewer resize calls) and memory managment - !! Memory usage grows by a factor of 2 each time it fills up, but no more. - implicit none - ! Arguments - type(collision_storage(*)), allocatable, intent(inout) :: collision_history !! Collision history object - class(encounter_snapshot), intent(in) :: snapshot !! Encounter snapshot object - ! Internals - type(collision_storage(nframes=:)), allocatable :: tmp - integer(I4B) :: i, nnew, nold, nbig - - ! Advance the snapshot frame counter - collision_history%iframe = collision_history%iframe + 1 - - ! Check to make sure the current encounter_history object is big enough. If not, grow it by a factor of 2 - nnew = collision_history%iframe - nold = collision_history%nframes - - if (nnew > nold) then - nbig = nold - do while (nbig < nnew) - nbig = nbig * 2 - end do - allocate(collision_storage(nbig) :: tmp) - tmp%iframe = collision_history%iframe - call move_alloc(collision_history%nc, tmp%nc) - - do i = 1, nold - if (allocated(collision_history%frame(i)%item)) call move_alloc(collision_history%frame(i)%item, tmp%frame(i)%item) - end do - deallocate(collision_history) - call move_alloc(tmp,collision_history) - nnew = nbig - end if - - collision_history%frame(nnew) = snapshot - - return - end subroutine encounter_util_save_collision - - - subroutine encounter_util_save_encounter(encounter_history, snapshot) + subroutine encounter_util_save_snapshot(encounter_history, snapshot) !! author: David A. Minton !! !! Checks the current size of the encounter storage against the required size and extends it by a factor of 2 more than requested if it is too small. @@ -492,261 +407,7 @@ subroutine encounter_util_save_encounter(encounter_history, snapshot) encounter_history%frame(nnew) = snapshot return - end subroutine encounter_util_save_encounter - - - module subroutine encounter_util_snapshot_collision(self, param, system, t, arg) - !! author: David A. Minton - !! - !! Takes a minimal snapshot of the state of the system during an encounter so that the trajectories - !! can be played back through the encounter - implicit none - ! Internals - class(collision_storage(*)), intent(inout) :: self !! Swiftest storage object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object to store - real(DP), intent(in), optional :: t !! Time of snapshot if different from system time - character(*), intent(in), optional :: arg !! "before": takes a snapshot just before the collision. "after" takes the snapshot just after the collision. - ! Arguments - class(fraggle_snapshot), allocatable :: snapshot - type(symba_pl) :: pl - character(len=:), allocatable :: stage - - if (present(arg)) then - stage = arg - else - stage = "" - end if - - select type (system) - class is (symba_nbody_system) - - select case(stage) - case("before") - ! Saves the states of the bodies involved in the collision before the collision is resolved - associate (idx => system%colliders%idx, ncoll => system%colliders%ncoll) - call pl%setup(ncoll, param) - pl%id(:) = system%pl%id(idx(:)) - pl%Gmass(:) = system%pl%Gmass(idx(:)) - pl%radius(:) = system%pl%radius(idx(:)) - pl%rot(:,:) = system%pl%rot(:,idx(:)) - pl%Ip(:,:) = system%pl%Ip(:,idx(:)) - pl%rh(:,:) = system%pl%rh(:,idx(:)) - pl%vh(:,:) = system%pl%vh(:,idx(:)) - pl%info(:) = system%pl%info(idx(:)) - !end select - allocate(system%colliders%pl, source=pl) - end associate - case("after") - allocate(fraggle_snapshot :: snapshot) - allocate(snapshot%colliders, source=system%colliders) - allocate(snapshot%fragments, source=system%fragments) - snapshot%t = t - select type(param) - class is (symba_parameters) - call encounter_util_save_collision(param%collision_history,snapshot) - end select - case default - write(*,*) "encounter_util_snapshot_collision requies either 'before' or 'after' passed to 'arg'" - end select - - end select - - return - end subroutine encounter_util_snapshot_collision - - - module subroutine encounter_util_snapshot_encounter(self, param, system, t, arg) - !! author: David A. Minton - !! - !! Takes a minimal snapshot of the state of the system during an encounter so that the trajectories - !! can be played back through the encounter - implicit none - ! Internals - class(encounter_storage(*)), intent(inout) :: self !! Swiftest storage object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object to store - real(DP), intent(in), optional :: t !! Time of snapshot if different from system time - character(*), intent(in), optional :: arg !! Optional argument (needed for extended storage type used in collision snapshots) - ! Arguments - class(encounter_snapshot), allocatable :: snapshot - integer(I4B) :: i, pi, pj, k, npl_snap, ntp_snap, iflag - real(DP), dimension(NDIM) :: rrel, vrel, rcom, vcom - real(DP) :: Gmtot, a, q, capm, tperi - real(DP), dimension(NDIM,2) :: rb,vb - - if (.not.present(t)) then - write(*,*) "encounter_util_snapshot_encounter requires `t` to be passed" - return - end if + end subroutine encounter_util_save_snapshot - if (.not.present(arg)) then - write(*,*) "encounter_util_snapshot_encounter requires `arg` to be passed" - return - end if - - select type(param) - class is (symba_parameters) - select type (system) - class is (symba_nbody_system) - select type(pl => system%pl) - class is (symba_pl) - select type (tp => system%tp) - class is (symba_tp) - associate(npl => pl%nbody, ntp => tp%nbody) - if (npl + ntp == 0) return - allocate(encounter_snapshot :: snapshot) - allocate(snapshot%pl, mold=pl) - allocate(snapshot%tp, mold=tp) - snapshot%iloop = param%iloop - - select type(pl_snap => snapshot%pl) - class is (symba_pl) - select type(tp_snap => snapshot%tp) - class is (symba_tp) - - select case(arg) - case("trajectory") - snapshot%t = t - - npl_snap = npl - ntp_snap = ntp - - if (npl > 0) then - pl%lmask(1:npl) = pl%status(1:npl) /= INACTIVE .and. pl%levelg(1:npl) == system%irec - npl_snap = count(pl%lmask(1:npl)) - end if - if (ntp > 0) then - tp%lmask(1:ntp) = tp%status(1:ntp) /= INACTIVE .and. tp%levelg(1:ntp) == system%irec - ntp_snap = count(tp%lmask(1:ntp)) - end if - - if (npl_snap + ntp_snap == 0) return ! Nothing to snapshot - - pl_snap%nbody = npl_snap - - ! Take snapshot of the currently encountering massive bodies - if (npl_snap > 0) then - call pl_snap%setup(npl_snap, param) - pl_snap%levelg(:) = pack(pl%levelg(1:npl), pl%lmask(1:npl)) - pl_snap%id(:) = pack(pl%id(1:npl), pl%lmask(1:npl)) - pl_snap%info(:) = pack(pl%info(1:npl), pl%lmask(1:npl)) - pl_snap%Gmass(:) = pack(pl%Gmass(1:npl), pl%lmask(1:npl)) - do i = 1, NDIM - pl_snap%rh(i,:) = pack(pl%rh(i,1:npl), pl%lmask(1:npl)) - pl_snap%vh(i,:) = pack(pl%vb(i,1:npl), pl%lmask(1:npl)) - end do - if (param%lclose) then - pl_snap%radius(:) = pack(pl%radius(1:npl), pl%lmask(1:npl)) - end if - - if (param%lrotation) then - do i = 1, NDIM - pl_snap%Ip(i,:) = pack(pl%Ip(i,1:npl), pl%lmask(1:npl)) - pl_snap%rot(i,:) = pack(pl%rot(i,1:npl), pl%lmask(1:npl)) - end do - end if - call pl_snap%sort("id", ascending=.true.) - end if - - ! Take snapshot of the currently encountering test particles - tp_snap%nbody = ntp_snap - if (ntp_snap > 0) then - call tp_snap%setup(ntp_snap, param) - tp_snap%id(:) = pack(tp%id(1:ntp), tp%lmask(1:ntp)) - tp_snap%info(:) = pack(tp%info(1:ntp), tp%lmask(1:ntp)) - do i = 1, NDIM - tp_snap%rh(i,:) = pack(tp%rh(i,1:ntp), tp%lmask(1:ntp)) - tp_snap%vh(i,:) = pack(tp%vh(i,1:ntp), tp%lmask(1:ntp)) - end do - end if - - ! Save the snapshot - param%encounter_history%nid = param%encounter_history%nid + ntp_snap + npl_snap - call encounter_util_save_encounter(param%encounter_history,snapshot) - case("closest") - associate(plplenc_list => system%plplenc_list, pltpenc_list => system%pltpenc_list) - if (any(plplenc_list%lclosest(:))) then - call pl_snap%setup(2, param) - do k = 1, plplenc_list%nenc - if (plplenc_list%lclosest(k)) then - pi = plplenc_list%index1(k) - pj = plplenc_list%index2(k) - pl_snap%levelg(:) = pl%levelg([pi,pj]) - pl_snap%id(:) = pl%id([pi,pj]) - pl_snap%info(:) = pl%info([pi,pj]) - pl_snap%Gmass(:) = pl%Gmass([pi,pj]) - Gmtot = sum(pl_snap%Gmass(:)) - if (param%lclose) pl_snap%radius(:) = pl%radius([pi,pj]) - if (param%lrotation) then - do i = 1, NDIM - pl_snap%Ip(i,:) = pl%Ip(i,[pi,pj]) - pl_snap%rot(i,:) = pl%rot(i,[pi,pj]) - end do - end if - - ! Compute pericenter passage time to get the closest approach parameters - rrel(:) = plplenc_list%r2(:,k) - plplenc_list%r1(:,k) - vrel(:) = plplenc_list%v2(:,k) - plplenc_list%v1(:,k) - call orbel_xv2aqt(Gmtot, rrel(1), rrel(2), rrel(3), vrel(1), vrel(2), vrel(3), a, q, capm, tperi) - snapshot%t = t + tperi - if ((snapshot%t < maxval(pl_snap%info(:)%origin_time)) .or. & - (snapshot%t > minval(pl_snap%info(:)%discard_time))) cycle - - ! Computer the center mass of the pair - rcom(:) = (plplenc_list%r1(:,k) * pl_snap%Gmass(1) + plplenc_list%r2(:,k) * pl_snap%Gmass(2)) / Gmtot - vcom(:) = (plplenc_list%v1(:,k) * pl_snap%Gmass(1) + plplenc_list%v2(:,k) * pl_snap%Gmass(2)) / Gmtot - rb(:,1) = plplenc_list%r1(:,k) - rcom(:) - rb(:,2) = plplenc_list%r2(:,k) - rcom(:) - vb(:,1) = plplenc_list%v1(:,k) - vcom(:) - vb(:,2) = plplenc_list%v2(:,k) - vcom(:) - - ! Drift the relative orbit to get the new relative position and velocity - call drift_one(Gmtot, rrel(1), rrel(2), rrel(3), vrel(1), vrel(2), vrel(3), tperi, iflag) - if (iflag /= 0) write(*,*) "Danby error in encounter_util_snapshot_encounter. Closest approach positions and vectors may not be accurate." - - ! Get the new position and velocity vectors - rb(:,1) = -(pl_snap%Gmass(2) / Gmtot) * rrel(:) - rb(:,2) = (pl_snap%Gmass(1)) / Gmtot * rrel(:) - - vb(:,1) = -(pl_snap%Gmass(2) / Gmtot) * vrel(:) - vb(:,2) = (pl_snap%Gmass(1)) / Gmtot * vrel(:) - - ! Move the CoM assuming constant velocity over the time it takes to reach periapsis - rcom(:) = rcom(:) + vcom(:) * tperi - - ! Compute the heliocentric position and velocity vector at periapsis - pl_snap%rh(:,1) = rb(:,1) + rcom(:) - pl_snap%rh(:,2) = rb(:,2) + rcom(:) - pl_snap%vh(:,1) = vb(:,1) + vcom(:) - pl_snap%vh(:,2) = vb(:,2) + vcom(:) - - call pl_snap%sort("id", ascending=.true.) - call encounter_util_save_encounter(param%encounter_history,snapshot) - end if - end do - - plplenc_list%lclosest(:) = .false. - end if - - if (any(pltpenc_list%lclosest(:))) then - do k = 1, pltpenc_list%nenc - end do - pltpenc_list%lclosest(:) = .false. - end if - end associate - case default - write(*,*) "encounter_util_snapshot_encounter requires `arg` to be either `trajectory` or `closest`" - end select - end select - end select - end associate - end select - end select - end select - end select - - return - end subroutine encounter_util_snapshot_encounter end submodule s_encounter_util \ No newline at end of file diff --git a/src/fraggle/fraggle_generate.f90 b/src/fraggle/fraggle_generate.f90 index ac5f166ba..4ad5c75d1 100644 --- a/src/fraggle/fraggle_generate.f90 +++ b/src/fraggle/fraggle_generate.f90 @@ -17,7 +17,7 @@ contains - module subroutine fraggle_generate_fragments(self, colliders, system, param, lfailure) + module subroutine collision_generate_fragments(self, impactors, system, param, lfailure) !! Author: Jennifer L.L. Pouplin, Carlisle A. Wishard, and David A. Minton !! !! Generates a system of fragments in barycentric coordinates that conserves energy and momentum. @@ -25,7 +25,7 @@ module subroutine fraggle_generate_fragments(self, colliders, system, param, lfa implicit none ! Arguments class(fraggle_fragments), intent(inout) :: self !! Fraggle system object the outputs will be the fragmentation - class(fraggle_colliders), intent(inout) :: colliders !! Fraggle colliders object containing the two-body equivalent values of the colliding bodies + class(collision_impactors), intent(inout) :: impactors !! Fraggle impactors object containing the two-body equivalent values of the colliding bodies class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters logical, intent(out) :: lfailure !! Answers the question: Should this have been a merger instead? @@ -68,22 +68,22 @@ module subroutine fraggle_generate_fragments(self, colliders, system, param, lfa lk_plpl = .false. end if - call fragments%set_natural_scale(colliders) + call fragments%set_natural_scale(impactors) call fragments%reset() ! Calculate the initial energy of the system without the collisional family - call fragments%get_energy_and_momentum(colliders, system, param, lbefore=.true.) + call fragments%get_energy_and_momentum(impactors, system, param, lbefore=.true.) ! Start out the fragments close to the initial separation distance. This will be increased if there is any overlap or we fail to find a solution - r_max_start = 1.2_DP * (norm2(colliders%rb(:,2) - colliders%rb(:,1))) + r_max_start = 1.2_DP * .mag.(impactors%rb(:,2) - impactors%rb(:,1)) lfailure = .false. try = 1 do while (try < MAXTRY) write(message,*) try call io_log_one_message(FRAGGLE_LOG_OUT, "Fraggle try " // trim(adjustl(message))) if (lfailure) then - call fragments%restructure(colliders, try, f_spin, r_max_start) + call fragments%restructure(impactors, try, f_spin, r_max_start) call fragments%reset() try = try + 1 end if @@ -91,36 +91,36 @@ module subroutine fraggle_generate_fragments(self, colliders, system, param, lfa lfailure = .false. call ieee_set_flag(ieee_all, .false.) ! Set all fpe flags to quiet - call fraggle_generate_pos_vec(fragments, colliders, r_max_start) - call fragments%set_coordinate_system(colliders) + call fraggle_generate_pos_vec(fragments, impactors, r_max_start) + call fragments%set_coordinate_system(impactors) ! Initial velocity guess will be the barycentric velocity of the colliding system so that the budgets are based on the much smaller collisional-frame velocities do concurrent (i = 1:nfrag) fragments%vb(:, i) = fragments%vbcom(:) end do - call fragments%get_energy_and_momentum(colliders, system, param, lbefore=.false.) + call fragments%get_energy_and_momentum(impactors, system, param, lbefore=.false.) call fragments%set_budgets() - call fraggle_generate_spins(fragments, colliders, f_spin, lfailure) + call fraggle_generate_spins(fragments, impactors, f_spin, lfailure) if (lfailure) then call io_log_one_message(FRAGGLE_LOG_OUT, "Fraggle failed to find spins") cycle end if - call fraggle_generate_tan_vel(fragments, colliders, lfailure) + call fraggle_generate_tan_vel(fragments, impactors, lfailure) if (lfailure) then call io_log_one_message(FRAGGLE_LOG_OUT, "Fraggle failed to find tangential velocities") cycle end if - call fraggle_generate_rad_vel(fragments, colliders, lfailure) + call fraggle_generate_rad_vel(fragments, impactors, lfailure) if (lfailure) then call io_log_one_message(FRAGGLE_LOG_OUT, "Fraggle failed to find radial velocities") cycle end if - call fragments%get_energy_and_momentum(colliders, system, param, lbefore=.false.) + call fragments%get_energy_and_momentum(impactors, system, param, lbefore=.false.) dEtot = fragments%Etot_after - fragments%Etot_before dLmag = .mag. (fragments%Ltot_after(:) - fragments%Ltot_before(:)) exit @@ -158,7 +158,7 @@ module subroutine fraggle_generate_fragments(self, colliders, system, param, lfa trim(adjustl(message)) // " tries") end if - call fragments%set_original_scale(colliders) + call fragments%set_original_scale(impactors) ! Restore the big array if (lk_plpl) call pl%flatten(param) @@ -166,10 +166,10 @@ module subroutine fraggle_generate_fragments(self, colliders, system, param, lfa call ieee_set_halting_mode(IEEE_ALL,fpe_halting_modes) ! Save the current halting modes so we can turn them off temporarily return - end subroutine fraggle_generate_fragments + end subroutine collision_generate_fragments - subroutine fraggle_generate_pos_vec(fragments, colliders, r_max_start) + subroutine fraggle_generate_pos_vec(fragments, impactors, r_max_start) !! Author: Jennifer L.L. Pouplin, Carlisle A. Wishard, and David A. Minton !! !! Initializes the orbits of the fragments around the center of mass. The fragments are initially placed on a plane defined by the @@ -178,7 +178,7 @@ subroutine fraggle_generate_pos_vec(fragments, colliders, r_max_start) implicit none ! Arguments class(fraggle_fragments), intent(inout) :: fragments !! Fraggle fragment system object - class(fraggle_colliders), intent(inout) :: colliders !! Fraggle collider system object + class(collision_impactors), intent(inout) :: impactors !! Fraggle collider system object real(DP), intent(in) :: r_max_start !! Initial guess for the starting maximum radial distance of fragments ! Internals real(DP) :: dis, rad, r_max, fdistort @@ -196,14 +196,14 @@ subroutine fraggle_generate_pos_vec(fragments, colliders, r_max_start) ! Place the fragments into a region that is big enough that we should usually not have overlapping bodies ! An overlapping bodies will collide in the next time step, so it's not a major problem if they do (it just slows the run down) r_max = r_max_start - rad = sum(colliders%radius(:)) + rad = sum(impactors%radius(:)) ! Get the unit vectors for the relative position and velocity vectors. These are used to shift the fragment cloud depending on the - runit(:) = colliders%rb(:,2) - colliders%rb(:,1) + runit(:) = impactors%rb(:,2) - impactors%rb(:,1) runit(:) = runit(:) / (.mag. runit(:)) - vunit(:) = colliders%vb(:,2) - colliders%vb(:,1) + vunit(:) = impactors%vb(:,2) - impactors%vb(:,1) vunit(:) = vunit(:) / (.mag. vunit(:)) ! This is a factor that will "distort" the shape of the frgment cloud in the direction of the impact velocity @@ -214,8 +214,8 @@ subroutine fraggle_generate_pos_vec(fragments, colliders, r_max_start) call random_number(fragments%r_coll(:,3:nfrag)) loverlap(:) = .true. do while (any(loverlap(3:nfrag))) - fragments%r_coll(:, 1) = colliders%rb(:, 1) - fragments%rbcom(:) - fragments%r_coll(:, 2) = colliders%rb(:, 2) - fragments%rbcom(:) + fragments%r_coll(:, 1) = impactors%rb(:, 1) - fragments%rbcom(:) + fragments%r_coll(:, 2) = impactors%rb(:, 2) - fragments%rbcom(:) r_max = r_max + 0.1_DP * rad do i = 3, nfrag if (loverlap(i)) then @@ -230,13 +230,13 @@ subroutine fraggle_generate_pos_vec(fragments, colliders, r_max_start) loverlap(:) = .false. do j = 1, nfrag do i = j + 1, nfrag - dis = norm2(fragments%r_coll(:,j) - fragments%r_coll(:,i)) + dis = .mag.(fragments%r_coll(:,j) - fragments%r_coll(:,i)) loverlap(i) = loverlap(i) .or. (dis <= (fragments%radius(i) + fragments%radius(j))) end do end do end do call fraggle_util_shift_vector_to_origin(fragments%mass, fragments%r_coll) - call fragments%set_coordinate_system(colliders) + call fragments%set_coordinate_system(impactors) do concurrent(i = 1:nfrag) fragments%rb(:,i) = fragments%r_coll(:,i) + fragments%rbcom(:) @@ -253,7 +253,7 @@ subroutine fraggle_generate_pos_vec(fragments, colliders, r_max_start) end subroutine fraggle_generate_pos_vec - subroutine fraggle_generate_spins(fragments, colliders, f_spin, lfailure) + subroutine fraggle_generate_spins(fragments, impactors, f_spin, lfailure) !! Author: Jennifer L.L. Pouplin, Carlisle A. Wishard, and David A. Minton !! !! Calculates the spins of a collection of fragments such that they conserve angular momentum without blowing the fragment kinetic energy budget. @@ -262,7 +262,7 @@ subroutine fraggle_generate_spins(fragments, colliders, f_spin, lfailure) implicit none ! Arguments class(fraggle_fragments), intent(inout) :: fragments !! Fraggle fragment system object - class(fraggle_colliders), intent(inout) :: colliders !! Fraggle collider system object + class(collision_impactors), intent(inout) :: impactors !! Fraggle collider system object real(DP), intent(in) :: f_spin !! Fraction of energy or momentum that goes into spin (whichever gives the lowest kinetic energy) logical, intent(out) :: lfailure !! Logical flag indicating whether this step fails or succeeds! ! Internals @@ -279,12 +279,12 @@ subroutine fraggle_generate_spins(fragments, colliders, f_spin, lfailure) ke_remainder = fragments%ke_budget ! Add a fraction of the orbit angular momentum of the second body to the spin of the first body to kick things off - L(:) = colliders%L_spin(:,1) + f_spin * (colliders%L_orbit(:,2) + colliders%L_spin(:,2)) + L(:) = impactors%L_spin(:,1) + f_spin * (impactors%L_orbit(:,2) + impactors%L_spin(:,2)) fragments%rot(:,1) = L(:) / (fragments%mass(1) * fragments%radius(1)**2 * fragments%Ip(3,1)) L_remainder(:) = L_remainder(:) - L(:) ! Partition the spin momentum of the second body into the spin of the fragments, with some random variation - L(:) = colliders%L_spin(:,2) / (nfrag - 1) + L(:) = impactors%L_spin(:,2) / (nfrag - 1) call random_number(frot_rand(:,2:nfrag)) frot_rand(:,2:nfrag) = 2 * (frot_rand(:,2:nfrag) - 0.5_DP) * frot_rand_mag @@ -297,17 +297,17 @@ subroutine fraggle_generate_spins(fragments, colliders, f_spin, lfailure) ! Make sure we didn't blow our kinetic energy budget do i = 1, nfrag - ke_remainder = ke_remainder - 0.5_DP * fragments%mass(i) * fragments%Ip(3, i) * fragments%radius(i)**2 * norm2(fragments%rot(:, i)) + ke_remainder = ke_remainder - 0.5_DP * fragments%mass(i) * fragments%Ip(3, i) * fragments%radius(i)**2 * .mag.(fragments%rot(:, i)) end do ! Distributed most of the remaining angular momentum amongst all the particles fragments%ke_spin = 0.0_DP - if (norm2(L_remainder(:)) > FRAGGLE_LTOL) then + if (.mag.(L_remainder(:)) > FRAGGLE_LTOL) then do i = nfrag, 1, -1 ! Convert a fraction (f_spin) of either the remaining angular momentum or kinetic energy budget into spin, whichever gives the smaller rotation so as not to blow any budgets - rot_ke(:) = sqrt(2 * f_spin * ke_remainder / (i * fragments%mass(i) * fragments%radius(i)**2 * fragments%Ip(3, i))) * L_remainder(:) / norm2(L_remainder(:)) + rot_ke(:) = sqrt(2 * f_spin * ke_remainder / (i * fragments%mass(i) * fragments%radius(i)**2 * fragments%Ip(3, i))) * L_remainder(:) / .mag.(L_remainder(:)) rot_L(:) = f_spin * L_remainder(:) / (i * fragments%mass(i) * fragments%radius(i)**2 * fragments%Ip(3, i)) - if (norm2(rot_ke) < norm2(rot_L)) then + if (.mag.(rot_ke) < .mag.(rot_L)) then fragments%rot(:,i) = fragments%rot(:,i) + rot_ke(:) else fragments%rot(:, i) = fragments%rot(:,i) + rot_L(:) @@ -341,7 +341,7 @@ subroutine fraggle_generate_spins(fragments, colliders, f_spin, lfailure) end subroutine fraggle_generate_spins - subroutine fraggle_generate_tan_vel(fragments, colliders, lfailure) + subroutine fraggle_generate_tan_vel(fragments, impactors, lfailure) !! Author: Jennifer L.L. Pouplin, Carlisle A. Wishard, and David A. Minton !! !! Adjusts the tangential velocities and spins of a collection of fragments such that they conserve angular momentum without blowing the fragment kinetic energy budget. @@ -357,7 +357,7 @@ subroutine fraggle_generate_tan_vel(fragments, colliders, lfailure) implicit none ! Arguments class(fraggle_fragments), intent(inout) :: fragments !! Fraggle fragment system object - class(fraggle_colliders), intent(inout) :: colliders !! Fraggle collider system object + class(collision_impactors), intent(inout) :: impactors !! Fraggle collider system object logical, intent(out) :: lfailure !! Logical flag indicating whether this step fails or succeeds ! Internals integer(I4B) :: i, try @@ -379,9 +379,9 @@ subroutine fraggle_generate_tan_vel(fragments, colliders, lfailure) allocate(v_t_initial, mold=fragments%v_t_mag) do try = 1, MAXTRY - v_t_initial(1) = dot_product(colliders%vb(:,1),fragments%v_t_unit(:,1)) + v_t_initial(1) = dot_product(impactors%vb(:,1),fragments%v_t_unit(:,1)) do i = 2, nfrag - v_t_initial(i) = dot_product(colliders%vb(:,2), fragments%v_t_unit(:,i)) + v_t_initial(i) = dot_product(impactors%vb(:,2), fragments%v_t_unit(:,i)) end do fragments%v_t_mag(:) = v_t_initial @@ -525,7 +525,7 @@ end function tangential_objective_function end subroutine fraggle_generate_tan_vel - subroutine fraggle_generate_rad_vel(fragments, colliders, lfailure) + subroutine fraggle_generate_rad_vel(fragments, impactors, lfailure) !! Author: Jennifer L.L. Pouplin, Carlisle A. Wishard, and David A. Minton !! !! @@ -533,7 +533,7 @@ subroutine fraggle_generate_rad_vel(fragments, colliders, lfailure) implicit none ! Arguments class(fraggle_fragments), intent(inout) :: fragments !! Fraggle fragment system object - class(fraggle_colliders), intent(inout) :: colliders !! Fraggle collider system object + class(collision_impactors), intent(inout) :: impactors !! Fraggle collider system object logical, intent(out) :: lfailure !! Logical flag indicating whether this step fails or succeeds! ! Internals real(DP), parameter :: TOL_MIN = FRAGGLE_ETOL ! This needs to be more accurate than the tangential step, as we are trying to minimize the total residual energy @@ -552,7 +552,7 @@ subroutine fraggle_generate_rad_vel(fragments, colliders, lfailure) allocate(v_r_initial, source=fragments%v_r_mag) ! Initialize radial velocity magnitudes with a random value that related to equipartition of kinetic energy with some noise and scaled with respect to the initial distance - v_r_initial(1) = dot_product(colliders%vb(:,1),fragments%v_r_unit(:,1)) + v_r_initial(1) = dot_product(impactors%vb(:,1),fragments%v_r_unit(:,1)) fragments%ke_orbit = 0.5_DP * fragments%mass(1) * v_r_initial(1)**2 ke_radial = fragments%ke_budget - fragments%ke_spin - fragments%ke_orbit diff --git a/src/fraggle/fraggle_io.f90 b/src/fraggle/fraggle_io.f90 index 3253bcdb2..1ddc4b4e9 100644 --- a/src/fraggle/fraggle_io.f90 +++ b/src/fraggle/fraggle_io.f90 @@ -12,225 +12,13 @@ contains - module subroutine fraggle_io_initialize_output(self, param) - !! author: David A. Minton - !! - !! Initialize a NetCDF fragment history file system. This is a simplified version of the main simulation output NetCDF file, but with fewer variables. - use, intrinsic :: ieee_arithmetic - use netcdf - implicit none - ! Arguments - class(fraggle_io_parameters), intent(inout) :: self !! Parameters used to identify a particular NetCDF dataset - class(swiftest_parameters), intent(in) :: param - ! Internals - integer(I4B) :: nvar, varid, vartype - real(DP) :: dfill - real(SP) :: sfill - integer(I4B), parameter :: NO_FILL = 0 - logical :: fileExists - character(len=STRMAX) :: errmsg - integer(I4B) :: ndims - - select type(param) - class is (symba_parameters) - associate(nc => self, collision_history => param%collision_history) - dfill = ieee_value(dfill, IEEE_QUIET_NAN) - sfill = ieee_value(sfill, IEEE_QUIET_NAN) - - select case (param%out_type) - case("NETCDF_FLOAT") - self%out_type = NF90_FLOAT - case("NETCDF_DOUBLE") - self%out_type = NF90_DOUBLE - end select - - ! Check if the file exists, and if it does, delete it - inquire(file=nc%file_name, exist=fileExists) - if (fileExists) then - open(unit=LUN, file=nc%file_name, status="old", err=667, iomsg=errmsg) - close(unit=LUN, status="delete") - end if - - call check( nf90_create(nc%file_name, NF90_NETCDF4, nc%id), "fraggle_io_initialize nf90_create" ) - - ! Dimensions - call check( nf90_def_dim(nc%id, nc%event_dimname, nc%event_dimsize, nc%event_dimid), "fraggle_io_initialize nf90_def_dim event_dimid" ) ! Dimension to store individual collision events - call check( nf90_def_dim(nc%id, nc%space_dimname, NDIM, nc%space_dimid), "fraggle_io_initialize nf90_def_dim space_dimid" ) ! 3D space dimension - call check( nf90_def_dim(nc%id, nc%name_dimname, nc%name_dimsize, nc%name_dimid), "fraggle_io_initialize nf90_def_dim name_dimid" ) ! Dimension to store particle id numbers - call check( nf90_def_dim(nc%id, nc%str_dimname, NAMELEN, nc%str_dimid), "fraggle_io_initialize nf90_def_dim str_dimid" ) ! Dimension for string variables (aka character arrays) - call check( nf90_def_dim(nc%id, nc%stage_dimname, 2, nc%stage_dimid), "fraggle_io_initialize nf90_def_dim stage_dimid" ) ! Dimension for stage variables (aka "before" vs. "after" - - ! Dimension coordinates - call check( nf90_def_var(nc%id, nc%space_dimname, NF90_CHAR, nc%space_dimid, nc%space_varid), "fraggle_io_initialize nf90_def_var space_varid" ) - call check( nf90_def_var(nc%id, nc%name_dimname, NF90_CHAR, [nc%str_dimid, nc%name_dimid], nc%name_varid), "fraggle_io_initialize nf90_def_var name_varid") - call check( nf90_def_var(nc%id, nc%stage_dimname, NF90_CHAR, [nc%str_dimid, nc%stage_dimid], nc%stage_varid), "fraggle_io_initialize nf90_def_var stage_varid" ) - - ! Variables - call check( nf90_def_var(nc%id, nc%id_varname, NF90_INT, nc%name_dimid, nc%id_varid), "fraggle_io_initialize nf90_def_var id_varid" ) - call check( nf90_def_var(nc%id, nc%time_dimname, nc%out_type, & - nc%event_dimid, nc%time_varid), "fraggle_io_initialize nf90_def_var time_varid" ) - call check( nf90_def_var(nc%id, nc%regime_varname, NF90_CHAR, & - [nc%str_dimid, nc%event_dimid], nc%regime_varid), "fraggle_io_initialize nf90_def_var regime_varid") - call check( nf90_def_var(nc%id, nc%Qloss_varname, nc%out_type, & - [ nc%event_dimid], nc%Qloss_varid), "fraggle_io_initialize nf90_def_var Qloss_varid") - - call check( nf90_def_var(nc%id, nc%ptype_varname, NF90_CHAR, & - [nc%str_dimid, nc%name_dimid, nc%stage_dimid, nc%event_dimid], nc%ptype_varid), "fraggle_io_initialize nf90_def_var ptype_varid") - - call check( nf90_def_var(nc%id, nc%loop_varname, NF90_INT, & - [ nc%event_dimid], nc%loop_varid), "fraggle_io_initialize nf90_def_var loop_varid") - - call check( nf90_def_var(nc%id, nc%rh_varname, nc%out_type,& - [ nc%space_dimid, nc%name_dimid, nc%stage_dimid, nc%event_dimid], nc%rh_varid), "fraggle_io_initialize nf90_def_var rh_varid") - - call check( nf90_def_var(nc%id, nc%vh_varname, nc%out_type,& - [ nc%space_dimid, nc%name_dimid, nc%stage_dimid, nc%event_dimid], nc%vh_varid), "fraggle_io_initialize nf90_def_var vh_varid") - - call check( nf90_def_var(nc%id, nc%Gmass_varname, nc%out_type,& - [ nc%name_dimid, nc%stage_dimid, nc%event_dimid], nc%Gmass_varid), "fraggle_io_initialize nf90_def_var Gmass_varid") - - - call check( nf90_def_var(nc%id, nc%radius_varname, nc%out_type,& - [ nc%name_dimid, nc%stage_dimid, nc%event_dimid], nc%radius_varid), "fraggle_io_initialize nf90_def_var radius_varid") - - call check( nf90_def_var(nc%id, nc%Ip_varname, nc%out_type,& - [ nc%space_dimid, nc%name_dimid, nc%stage_dimid, nc%event_dimid], nc%Ip_varid), "fraggle_io_initialize nf90_def_var Ip_varid") - - call check( nf90_def_var(nc%id, nc%rot_varname, nc%out_type,& - [ nc%space_dimid, nc%name_dimid, nc%stage_dimid, nc%event_dimid], nc%rot_varid), "fraggle_io_initialize nf90_def_var rot_varid") - - if (param%lenergy) then - - call check( nf90_def_var(nc%id, nc%ke_orb_varname, nc%out_type,& - [ nc%stage_dimid, nc%event_dimid], nc%KE_orb_varid), "fraggle_io_initialize_output nf90_def_var KE_orb_varid") - - call check( nf90_def_var(nc%id, nc%ke_spin_varname, nc%out_type,& - [ nc%stage_dimid, nc%event_dimid], nc%KE_spin_varid), "fraggle_io_initialize_output nf90_def_var KE_spin_varid" ) - - call check( nf90_def_var(nc%id, nc%pe_varname, nc%out_type,& - [ nc%stage_dimid, nc%event_dimid], nc%PE_varid), "fraggle_io_initialize_output nf90_def_var PE_varid" ) - - call check( nf90_def_var(nc%id, nc%L_orb_varname, nc%out_type, & - [ nc%space_dimid, nc%stage_dimid, nc%event_dimid], nc%L_orb_varid), "fraggle_io_initialize_output nf90_def_var L_orb_varid" ) - - call check( nf90_def_var(nc%id, nc%L_spin_varname, nc%out_type,& - [ nc%space_dimid, nc%stage_dimid, nc%event_dimid], nc%L_spin_varid), "fraggle_io_initialize_output nf90_def_var L_spin_varid" ) - end if - - call check( nf90_inquire(nc%id, nVariables=nvar), "fraggle_io_initialize nf90_inquire nVariables" ) - do varid = 1, nvar - call check( nf90_inquire_variable(nc%id, varid, xtype=vartype, ndims=ndims), "fraggle_io_initialize nf90_inquire_variable" ) - select case(vartype) - case(NF90_INT) - call check( nf90_def_var_fill(nc%id, varid, NO_FILL, NF90_FILL_INT), "fraggle_io_initialize nf90_def_var_fill NF90_INT" ) - case(NF90_FLOAT) - call check( nf90_def_var_fill(nc%id, varid, NO_FILL, sfill), "fraggle_io_initialize nf90_def_var_fill NF90_FLOAT" ) - case(NF90_DOUBLE) - call check( nf90_def_var_fill(nc%id, varid, NO_FILL, dfill), "fraggle_io_initialize nf90_def_var_fill NF90_DOUBLE" ) - case(NF90_CHAR) - call check( nf90_def_var_fill(nc%id, varid, NO_FILL, 0), "fraggle_io_initialize nf90_def_var_fill NF90_CHAR" ) - end select - end do - ! Take the file out of define mode - call check( nf90_enddef(nc%id), "fraggle_io_initialize nf90_enddef" ) - - ! Add in the space and stage dimension coordinates - call check( nf90_put_var(nc%id, nc%space_varid, nc%space_coords, start=[1], count=[NDIM]), "fraggle_io_initialize nf90_put_var space" ) - call check( nf90_put_var(nc%id, nc%stage_varid, nc%stage_coords(1), start=[1,1], count=[len(nc%stage_coords(1)),1]), "fraggle_io_initialize nf90_put_var stage 1" ) - call check( nf90_put_var(nc%id, nc%stage_varid, nc%stage_coords(2), start=[1,2], count=[len(nc%stage_coords(2)),1]), "fraggle_io_initialize nf90_put_var stage 2" ) - - end associate - end select - - return - - 667 continue - write(*,*) "Error creating fragmentation output file. " // trim(adjustl(errmsg)) - call util_exit(FAILURE) - end subroutine fraggle_io_initialize_output - - - module subroutine fraggle_io_write_frame(self, nc, param) - !! author: David A. Minton - !! - !! Write a frame of output of a collision result - use netcdf - implicit none - ! Arguments - class(fraggle_snapshot), intent(in) :: self !! Swiftest encounter structure - class(netcdf_parameters), intent(inout) :: nc !! Parameters used to identify a particular encounter io NetCDF dataset - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - ! Internals - integer(I4B) :: i, idslot, old_mode, npl, stage - character(len=:), allocatable :: charstring - class(swiftest_pl), allocatable :: pl - - select type(nc) - class is (fraggle_io_parameters) - select type (param) - class is (symba_parameters) - associate(colliders => self%colliders, fragments => self%fragments, collision_history => param%collision_history, eslot => param%ioutput) - call check( nf90_set_fill(nc%id, nf90_nofill, old_mode), "fraggle_io_write_frame nf90_set_fill" ) - - call check( nf90_put_var(nc%id, nc%time_varid, self%t, start=[eslot]), "fraggle_io_write_frame nf90_put_var time_varid" ) - call check( nf90_put_var(nc%id, nc%loop_varid, int(self%iloop,kind=I4B), start=[eslot]), "fraggle_io_write_frame nf90_put_varloop_varid" ) - - charstring = trim(adjustl(REGIME_NAMES(fragments%regime))) - call check( nf90_put_var(nc%id, nc%regime_varid, charstring, start=[1, eslot], count=[len(charstring), 1]), "fraggle_io_write_frame nf90_put_var regime_varid" ) - call check( nf90_put_var(nc%id, nc%Qloss_varid, fragments%Qloss, start=[eslot] ), "fraggle_io_write_frame nf90_put_var Qloss_varid" ) - - do stage = 1,2 - if (allocated(pl)) deallocate(pl) - select case(stage) - case(1) - allocate(pl, source=colliders%pl) - case(2) - allocate(pl, source=fragments%pl) - end select - npl = pl%nbody - do i = 1, npl - idslot = findloc(collision_history%idvals,pl%id(i),dim=1) - call check( nf90_put_var(nc%id, nc%id_varid, pl%id(i), start=[ idslot ]), "fraggle_io_write_frame nf90_put_var id_varid" ) - charstring = trim(adjustl(pl%info(i)%name)) - call check( nf90_put_var(nc%id, nc%name_varid, charstring, start=[1, idslot ], count=[len(charstring), 1]), "fraggle_io_write_frame nf90_put_var name_varid" ) - charstring = trim(adjustl(pl%info(i)%particle_type)) - call check( nf90_put_var(nc%id, nc%ptype_varid, charstring, start=[1, idslot, stage, eslot], count=[len(charstring), 1, 1]), "fraggle_io_write_frame nf90_put_var particle_type_varid" ) - call check( nf90_put_var(nc%id, nc%rh_varid, pl%rh(:,i), start=[1, idslot, stage, eslot], count=[NDIM,1,1,1]), "fraggle_io_write_frame nf90_put_var rh_varid" ) - call check( nf90_put_var(nc%id, nc%vh_varid, pl%vh(:,i), start=[1, idslot, stage, eslot], count=[NDIM,1,1,1]), "fraggle_io_write_frame nf90_put_var vh_varid" ) - call check( nf90_put_var(nc%id, nc%Gmass_varid, pl%Gmass(i), start=[ idslot, stage, eslot]), "fraggle_io_write_frame nf90_put_var Gmass_varid" ) - call check( nf90_put_var(nc%id, nc%radius_varid, pl%radius(i), start=[ idslot, stage, eslot]), "fraggle_io_write_frame nf90_put_var radius_varid" ) - call check( nf90_put_var(nc%id, nc%Ip_varid, pl%Ip(:,i), start=[1, idslot, stage, eslot], count=[NDIM,1,1,1]), "fraggle_io_write_frame nf90_put_var Ip_varid" ) - call check( nf90_put_var(nc%id, nc%rot_varid, pl%rot(:,i), start=[1, idslot, stage, eslot], count=[NDIM,1,1,1]), "fraggle_io_write_frame nf90_put_var rotx_varid" ) - end do - end do - if (param%lenergy) then - call check( nf90_put_var(nc%id, nc%ke_orb_varid, fragments%ke_orbit_before, start=[ 1, eslot]), "fraggle_io_write_frame nf90_put_var ke_orb_varid before" ) - call check( nf90_put_var(nc%id, nc%ke_orb_varid, fragments%ke_orbit_after, start=[ 2, eslot]), "fraggle_io_write_frame nf90_put_var ke_orb_varid after" ) - call check( nf90_put_var(nc%id, nc%ke_spin_varid, fragments%ke_spin_before, start=[ 1, eslot]), "fraggle_io_write_frame nf90_put_var ke_spin_varid before" ) - call check( nf90_put_var(nc%id, nc%ke_spin_varid, fragments%ke_spin_after, start=[ 2, eslot]), "fraggle_io_write_frame nf90_put_var ke_spin_varid after" ) - call check( nf90_put_var(nc%id, nc%pe_varid, fragments%pe_before, start=[ 1, eslot]), "fraggle_io_write_frame nf90_put_var pe_varid before" ) - call check( nf90_put_var(nc%id, nc%pe_varid, fragments%pe_after, start=[ 2, eslot]), "fraggle_io_write_frame nf90_put_var pe_varid after" ) - call check( nf90_put_var(nc%id, nc%L_orb_varid, fragments%Lorbit_before(:), start=[1, 1, eslot], count=[NDIM, 1, 1]), "fraggle_io_write_frame nf90_put_var L_orb_varid before" ) - call check( nf90_put_var(nc%id, nc%L_orb_varid, fragments%Lorbit_after(:), start=[1, 2, eslot], count=[NDIM, 1, 1]), "fraggle_io_write_frame nf90_put_var L_orb_varid after" ) - call check( nf90_put_var(nc%id, nc%L_spin_varid, fragments%Lspin_before(:), start=[1, 1, eslot], count=[NDIM, 1, 1]), "fraggle_io_write_frame nf90_put_var L_spin_varid before" ) - call check( nf90_put_var(nc%id, nc%L_spin_varid, fragments%Lspin_after(:), start=[1, 2, eslot], count=[NDIM, 1, 1]), "fraggle_io_write_frame nf90_put_var L_spin_varid after" ) - end if - - call check( nf90_set_fill(nc%id, old_mode, old_mode) ) - end associate - end select - end select - return - end subroutine fraggle_io_write_frame - - - module subroutine fraggle_io_log_regime(colliders, fragments) + module subroutine fraggle_io_log_regime(impactors, fragments) !! author: David A. Minton !! !! Writes a log of the results of the collisional regime determination implicit none ! Arguments - class(fraggle_colliders), intent(in) :: colliders !! Fraggle collider system object + class(collision_impactors), intent(in) :: impactors !! Fraggle collider system object class(fraggle_fragments), intent(in) :: fragments !! Fraggle fragment object ! Internals character(STRMAX) :: errmsg @@ -240,8 +28,8 @@ module subroutine fraggle_io_log_regime(colliders, fragments) write(LUN, *) "--------------------------------------------------------------------" write(LUN, *) " Fraggle collisional regime determination results" write(LUN, *) "--------------------------------------------------------------------" - write(LUN, *) "True number of colliders : ",colliders%ncoll - write(LUN, *) "Index list of true colliders : ",colliders%idx(1:colliders%ncoll) + write(LUN, *) "True number of impactors : ",impactors%ncoll + write(LUN, *) "Index list of true impactors : ",impactors%idx(1:impactors%ncoll) select case(fragments%regime) case(COLLRESOLVE_REGIME_MERGE) write(LUN, *) "Regime: Merge" diff --git a/src/fraggle/fraggle_regime.f90 b/src/fraggle/fraggle_regime.f90 index dc5b07f58..1563a4ccf 100644 --- a/src/fraggle/fraggle_regime.f90 +++ b/src/fraggle/fraggle_regime.f90 @@ -7,19 +7,19 @@ !! You should have received a copy of the GNU General Public License along with Swiftest. !! If not, see: https://www.gnu.org/licenses. -submodule(fraggle_classes) s_fraggle_regime +submodule(fraggle_classes) s_encounter_regime use swiftest contains - module subroutine fraggle_regime_colliders(self, fragments, system, param) + module subroutine encounter_regime_impactors(self, fragments, system, param) !! Author: Jennifer L.L. Pouplin, Carlisle A. Wishard, and David A. Minton !! - !! Determine which fragmentation regime the set of colliders will be. This subroutine is a wrapper for the non-polymorphic raggle_regime_collresolve subroutine. + !! Determine which fragmentation regime the set of impactors will be. This subroutine is a wrapper for the non-polymorphic raggle_regime_collresolve subroutine. !! It converts to SI units prior to calling implicit none ! Arguments - class(fraggle_colliders), intent(inout) :: self !! Fraggle colliders object + class(collision_impactors), intent(inout) :: self !! Fraggle impactors object class(fraggle_fragments), intent(inout) :: fragments !! Fraggle fragment system object class(swiftest_nbody_system), intent(in) :: system !! Swiftest nbody system object class(swiftest_parameters), intent(in) :: param !! Current Swiftest run configuration parameters @@ -30,22 +30,22 @@ module subroutine fraggle_regime_colliders(self, fragments, system, param) real(DP), dimension(NDIM) :: x1_si, v1_si, x2_si, v2_si, runit real(DP) :: mlr, mslr, mtot, dentot - associate(colliders => self) + associate(impactors => self) ! Convert all quantities to SI units and determine which of the pair is the projectile vs. target before sending them to the regime determination subroutine - if (colliders%mass(1) > colliders%mass(2)) then + if (impactors%mass(1) > impactors%mass(2)) then jtarg = 1 jproj = 2 else jtarg = 2 jproj = 1 end if - mass_si(:) = colliders%mass([jtarg, jproj]) * param%MU2KG !! The two-body equivalent masses of the collider system - radius_si(:) = colliders%radius([jtarg, jproj]) * param%DU2M !! The two-body equivalent radii of the collider system + mass_si(:) = impactors%mass([jtarg, jproj]) * param%MU2KG !! The two-body equivalent masses of the collider system + radius_si(:) = impactors%radius([jtarg, jproj]) * param%DU2M !! The two-body equivalent radii of the collider system density_si(:) = mass_si(:) / (4.0_DP / 3._DP * PI * radius_si(:)**3) !! The two-body equivalent density of the collider system - x1_si(:) = colliders%rb(:,jtarg) * param%DU2M !! The first body of the two-body equivalent position vector the collider system - v1_si(:) = colliders%vb(:,jtarg) * param%DU2M / param%TU2S !! The first body of the two-body equivalent velocity vector the collider system - x2_si(:) = colliders%rb(:,jproj) * param%DU2M !! The second body of the two-body equivalent position vector the collider system - v2_si(:) = colliders%vb(:,jproj) * param%DU2M / param%TU2S !! The second body of the two-body equivalent velocity vector the collider system + x1_si(:) = impactors%rb(:,jtarg) * param%DU2M !! The first body of the two-body equivalent position vector the collider system + v1_si(:) = impactors%vb(:,jtarg) * param%DU2M / param%TU2S !! The first body of the two-body equivalent velocity vector the collider system + x2_si(:) = impactors%rb(:,jproj) * param%DU2M !! The second body of the two-body equivalent position vector the collider system + v2_si(:) = impactors%vb(:,jproj) * param%DU2M / param%TU2S !! The second body of the two-body equivalent velocity vector the collider system Mcb_si = system%cb%mass * param%MU2KG !! The central body mass of the system select type(param) class is (symba_parameters) @@ -58,7 +58,7 @@ module subroutine fraggle_regime_colliders(self, fragments, system, param) dentot = sum(mass_si(:) * density_si(:)) / mtot !! Use the positions and velocities of the parents from indside the step (at collision) to calculate the collisional regime - call fraggle_regime_collresolve(Mcb_si, mass_si(jtarg), mass_si(jproj), radius_si(jtarg), radius_si(jproj), & + call encounter_regime_collresolve(Mcb_si, mass_si(jtarg), mass_si(jproj), radius_si(jtarg), radius_si(jproj), & x1_si(:), x2_si(:), v1_si(:), v2_si(:), density_si(jtarg), density_si(jproj), & min_mfrag_si, fragments%regime, mlr, mslr, fragments%Qloss) @@ -67,27 +67,27 @@ module subroutine fraggle_regime_colliders(self, fragments, system, param) fragments%mass_dist(3) = min(max(mtot - mlr - mslr, 0.0_DP), mtot) ! Find the center of mass of the collisional system - fragments%mtot = sum(colliders%mass(:)) - fragments%rbcom(:) = (colliders%mass(1) * colliders%rb(:,1) + colliders%mass(2) * colliders%rb(:,2)) / fragments%mtot - fragments%vbcom(:) = (colliders%mass(1) * colliders%vb(:,1) + colliders%mass(2) * colliders%vb(:,2)) / fragments%mtot + fragments%mtot = sum(impactors%mass(:)) + fragments%rbcom(:) = (impactors%mass(1) * impactors%rb(:,1) + impactors%mass(2) * impactors%rb(:,2)) / fragments%mtot + fragments%vbcom(:) = (impactors%mass(1) * impactors%vb(:,1) + impactors%mass(2) * impactors%vb(:,2)) / fragments%mtot ! Find the point of impact between the two bodies - runit(:) = colliders%rb(:,2) - colliders%rb(:,1) + runit(:) = impactors%rb(:,2) - impactors%rb(:,1) runit(:) = runit(:) / (.mag. runit(:)) - fragments%rbimp(:) = colliders%rb(:,1) + colliders%radius(1) * runit(:) + fragments%rbimp(:) = impactors%rb(:,1) + impactors%radius(1) * runit(:) ! Convert quantities back to the system units and save them into the fragment system fragments%mass_dist(:) = (fragments%mass_dist(:) / param%MU2KG) fragments%Qloss = fragments%Qloss * (param%TU2S / param%DU2M)**2 / param%MU2KG - call fraggle_io_log_regime(colliders, fragments) + call fraggle_io_log_regime(impactors, fragments) end associate return - end subroutine fraggle_regime_colliders + end subroutine encounter_regime_impactors - subroutine fraggle_regime_collresolve(Mcb, m1, m2, rad1, rad2, rh1, rh2, vb1, vb2, den1, den2, min_mfrag, & + subroutine encounter_regime_collresolve(Mcb, m1, m2, rad1, rad2, rh1, rh2, vb1, vb2, den1, den2, min_mfrag, & regime, Mlr, Mslr, Qloss) !! Author: Jennifer L.L. Pouplin, Carlisle A. Wishard, and David A. Minton !! @@ -379,6 +379,6 @@ function calc_c_star(Rc1) result(c_star) return end function calc_c_star - end subroutine fraggle_regime_collresolve + end subroutine encounter_regime_collresolve -end submodule s_fraggle_regime \ No newline at end of file +end submodule s_encounter_regime \ No newline at end of file diff --git a/src/fraggle/fraggle_set.f90 b/src/fraggle/fraggle_set.f90 index 3fbe50d2f..122f593ab 100644 --- a/src/fraggle/fraggle_set.f90 +++ b/src/fraggle/fraggle_set.f90 @@ -35,7 +35,7 @@ module subroutine fraggle_set_budgets_fragments(self) end subroutine fraggle_set_budgets_fragments - module subroutine fraggle_set_mass_dist_fragments(self, colliders, param) + module subroutine fraggle_set_mass_dist_fragments(self, impactors, param) !! author: David A. Minton !! !! Sets the mass of fragments based on the mass distribution returned by the regime calculation. @@ -44,7 +44,7 @@ module subroutine fraggle_set_mass_dist_fragments(self, colliders, param) implicit none ! Arguments class(fraggle_fragments), intent(inout) :: self !! Fraggle fragment system object - class(fraggle_colliders), intent(inout) :: colliders !! Fraggle collider system object + class(collision_impactors), intent(inout) :: impactors !! Fraggle collider system object class(swiftest_parameters), intent(in) :: param !! Current Swiftest run configuration parameters ! Internals integer(I4B) :: i, jproj, jtarg, nfrag, istart @@ -61,9 +61,9 @@ module subroutine fraggle_set_mass_dist_fragments(self, colliders, param) associate(fragments => self) ! Get mass weighted mean of Ip and density - volume(1:2) = 4._DP / 3._DP * PI * colliders%radius(1:2)**3 - Ip_avg(:) = (colliders%mass(1) * colliders%Ip(:,1) + colliders%mass(2) * colliders%Ip(:,2)) / fragments%mtot - if (colliders%mass(1) > colliders%mass(2)) then + volume(1:2) = 4._DP / 3._DP * PI * impactors%radius(1:2)**3 + Ip_avg(:) = (impactors%mass(1) * impactors%Ip(:,1) + impactors%mass(2) * impactors%Ip(:,2)) / fragments%mtot + if (impactors%mass(1) > impactors%mass(2)) then jtarg = 1 jproj = 2 else @@ -73,7 +73,7 @@ module subroutine fraggle_set_mass_dist_fragments(self, colliders, param) select case(fragments%regime) case(COLLRESOLVE_REGIME_DISRUPTION, COLLRESOLVE_REGIME_SUPERCATASTROPHIC, COLLRESOLVE_REGIME_HIT_AND_RUN) - ! The first two bins of the mass_dist are the largest and second-largest fragments that came out of fraggle_regime. + ! The first two bins of the mass_dist are the largest and second-largest fragments that came out of encounter_regime. ! The remainder from the third bin will be distributed among nfrag-2 bodies. The following code will determine nfrag based on ! the limits bracketed above and the model size distribution of fragments. ! Check to see if our size distribution would give us a smaller number of fragments than the maximum number @@ -105,15 +105,15 @@ module subroutine fraggle_set_mass_dist_fragments(self, colliders, param) case (COLLRESOLVE_REGIME_MERGE, COLLRESOLVE_REGIME_GRAZE_AND_MERGE) call fragments%setup(1, param) fragments%mass(1) = fragments%mass_dist(1) - fragments%radius(1) = colliders%radius(jtarg) + fragments%radius(1) = impactors%radius(jtarg) fragments%density(1) = fragments%mass_dist(1) / volume(jtarg) - if (param%lrotation) fragments%Ip(:, 1) = colliders%Ip(:,1) + if (param%lrotation) fragments%Ip(:, 1) = impactors%Ip(:,1) return case default write(*,*) "fraggle_set_mass_dist_fragments error: Unrecognized regime code",fragments%regime end select - ! Make the first two bins the same as the Mlr and Mslr values that came from fraggle_regime + ! Make the first two bins the same as the Mlr and Mslr values that came from encounter_regime fragments%mass(1) = fragments%mass_dist(iMlr) fragments%mass(2) = fragments%mass_dist(iMslr) @@ -141,9 +141,9 @@ module subroutine fraggle_set_mass_dist_fragments(self, colliders, param) ! Compute physical properties of the new fragments select case(fragments%regime) case(COLLRESOLVE_REGIME_HIT_AND_RUN) ! The hit and run case always preserves the largest body intact, so there is no need to recompute the physical properties of the first fragment - fragments%radius(1) = colliders%radius(jtarg) + fragments%radius(1) = impactors%radius(jtarg) fragments%density(1) = fragments%mass_dist(iMlr) / volume(jtarg) - fragments%Ip(:, 1) = colliders%Ip(:,1) + fragments%Ip(:, 1) = impactors%Ip(:,1) istart = 2 case default istart = 1 @@ -160,61 +160,66 @@ module subroutine fraggle_set_mass_dist_fragments(self, colliders, param) end subroutine fraggle_set_mass_dist_fragments - module subroutine fraggle_set_coordinate_system(self, colliders) + module subroutine encounter_set_coordinate_system(self, impactors) !! author: David A. Minton !! !! Defines the collisional coordinate system, including the unit vectors of both the system and individual fragments. implicit none ! Arguments class(fraggle_fragments), intent(inout) :: self !! Fraggle fragment system object - class(fraggle_colliders), intent(inout) :: colliders !! Fraggle collider system object + class(collision_impactors), intent(inout) :: impactors !! Fraggle collider system object ! Internals integer(I4B) :: i real(DP), dimension(NDIM) :: delta_r, delta_v, Ltot - real(DP) :: r_col_norm, v_col_norm, L_mag + real(DP) :: L_mag real(DP), dimension(NDIM, self%nbody) :: L_sigma associate(fragments => self, nfrag => self%nbody) - delta_v(:) = colliders%vb(:, 2) - colliders%vb(:, 1) - v_col_norm = .mag. delta_v(:) - delta_r(:) = colliders%rb(:, 2) - colliders%rb(:, 1) - r_col_norm = .mag. delta_r(:) + delta_v(:) = impactors%vb(:, 2) - impactors%vb(:, 1) + delta_r(:) = impactors%rb(:, 2) - impactors%rb(:, 1) ! We will initialize fragments on a plane defined by the pre-impact system, with the z-axis aligned with the angular momentum vector ! and the y-axis aligned with the pre-impact distance vector. - Ltot = colliders%L_orbit(:,1) + colliders%L_orbit(:,2) + colliders%L_spin(:,1) + colliders%L_spin(:,2) - fragments%y_coll_unit(:) = delta_r(:) / r_col_norm + + ! y-axis is the separation distance + fragments%y_coll_unit(:) = .unit.delta_r(:) + Ltot = impactors%L_orbit(:,1) + impactors%L_orbit(:,2) + impactors%L_spin(:,1) + impactors%L_spin(:,2) + L_mag = .mag.Ltot(:) if (L_mag > sqrt(tiny(L_mag))) then - fragments%z_coll_unit(:) = Ltot(:) / L_mag - else + fragments%z_coll_unit(:) = .unit.Ltot(:) + else ! Not enough angular momentum to determine a z-axis direction. We'll just pick a random direction call random_number(fragments%z_coll_unit(:)) - fragments%z_coll_unit(:) = fragments%z_coll_unit(:) / (.mag.fragments%z_coll_unit(:)) + fragments%z_coll_unit(:) = .unit.fragments%z_coll_unit(:) end if + ! The cross product of the y- by z-axis will give us the x-axis fragments%x_coll_unit(:) = fragments%y_coll_unit(:) .cross. fragments%z_coll_unit(:) - + + fragments%v_coll_unit(:) = .unit.delta_v(:) + if (.not.any(fragments%r_coll(:,:) > 0.0_DP)) return fragments%rmag(:) = .mag. fragments%r_coll(:,:) - - call random_number(L_sigma(:,:)) ! Randomize the tangential velocity direction. This helps to ensure that the tangential velocity doesn't completely line up with the angular momentum vector, - ! otherwise we can get an ill-conditioned system - + + ! Randomize the tangential velocity direction. + ! This helps to ensure that the tangential velocity doesn't completely line up with the angular momentum vector, otherwise we can get an ill-conditioned system + call random_number(L_sigma(:,:)) do concurrent(i = 1:nfrag, fragments%rmag(i) > 0.0_DP) - fragments%v_r_unit(:, i) = fragments%r_coll(:, i) / fragments%rmag(i) fragments%v_n_unit(:, i) = fragments%z_coll_unit(:) + 2e-1_DP * (L_sigma(:,i) - 0.5_DP) - fragments%v_n_unit(:, i) = fragments%v_n_unit(:, i) / (.mag. fragments%v_n_unit(:, i)) - fragments%v_t_unit(:, i) = fragments%v_n_unit(:, i) .cross. fragments%v_r_unit(:, i) - fragments%v_t_unit(:, i) = fragments%v_t_unit(:, i) / (.mag. fragments%v_t_unit(:, i)) end do + ! Define the radial, normal, and tangential unit vectors for each individual fragment + fragments%v_r_unit(:,:) = .unit. fragments%r_coll(:,:) + fragments%v_n_unit(:,:) = .unit. fragments%v_n_unit(:,:) + fragments%v_t_unit(:,:) = .unit. (fragments%v_n_unit(:,:) .cross. fragments%v_r_unit(:,:)) + end associate return - end subroutine fraggle_set_coordinate_system + end subroutine encounter_set_coordinate_system - module subroutine fraggle_set_natural_scale_factors(self, colliders) + module subroutine fraggle_set_natural_scale_factors(self, impactors) !! author: David A. Minton !! !! Scales dimenional quantities to ~O(1) with respect to the collisional system. @@ -222,33 +227,33 @@ module subroutine fraggle_set_natural_scale_factors(self, colliders) implicit none ! Arguments class(fraggle_fragments), intent(inout) :: self !! Fraggle fragment system object - class(fraggle_colliders), intent(inout) :: colliders !! Fraggle collider system object + class(collision_impactors), intent(inout) :: impactors !! Fraggle collider system object ! Internals integer(I4B) :: i associate(fragments => self) ! Set scale factors - fragments%Escale = 0.5_DP * (colliders%mass(1) * dot_product(colliders%vb(:,1), colliders%vb(:,1)) & - + colliders%mass(2) * dot_product(colliders%vb(:,2), colliders%vb(:,2))) - fragments%dscale = sum(colliders%radius(:)) + fragments%Escale = 0.5_DP * (impactors%mass(1) * dot_product(impactors%vb(:,1), impactors%vb(:,1)) & + + impactors%mass(2) * dot_product(impactors%vb(:,2), impactors%vb(:,2))) + fragments%dscale = sum(impactors%radius(:)) fragments%mscale = fragments%mtot fragments%vscale = sqrt(fragments%Escale / fragments%mscale) fragments%tscale = fragments%dscale / fragments%vscale fragments%Lscale = fragments%mscale * fragments%dscale * fragments%vscale - ! Scale all dimensioned quantities of colliders and fragments + ! Scale all dimensioned quantities of impactors and fragments fragments%rbcom(:) = fragments%rbcom(:) / fragments%dscale fragments%vbcom(:) = fragments%vbcom(:) / fragments%vscale fragments%rbimp(:) = fragments%rbimp(:) / fragments%dscale - colliders%rb(:,:) = colliders%rb(:,:) / fragments%dscale - colliders%vb(:,:) = colliders%vb(:,:) / fragments%vscale - colliders%mass(:) = colliders%mass(:) / fragments%mscale - colliders%radius(:) = colliders%radius(:) / fragments%dscale - colliders%L_spin(:,:) = colliders%L_spin(:,:) / fragments%Lscale - colliders%L_orbit(:,:) = colliders%L_orbit(:,:) / fragments%Lscale + impactors%rb(:,:) = impactors%rb(:,:) / fragments%dscale + impactors%vb(:,:) = impactors%vb(:,:) / fragments%vscale + impactors%mass(:) = impactors%mass(:) / fragments%mscale + impactors%radius(:) = impactors%radius(:) / fragments%dscale + impactors%L_spin(:,:) = impactors%L_spin(:,:) / fragments%Lscale + impactors%L_orbit(:,:) = impactors%L_orbit(:,:) / fragments%Lscale do i = 1, 2 - colliders%rot(:,i) = colliders%L_spin(:,i) / (colliders%mass(i) * colliders%radius(i)**2 * colliders%Ip(3, i)) + impactors%rot(:,i) = impactors%L_spin(:,i) / (impactors%mass(i) * impactors%radius(i)**2 * impactors%Ip(3, i)) end do fragments%mtot = fragments%mtot / fragments%mscale @@ -261,7 +266,7 @@ module subroutine fraggle_set_natural_scale_factors(self, colliders) end subroutine fraggle_set_natural_scale_factors - module subroutine fraggle_set_original_scale_factors(self, colliders) + module subroutine fraggle_set_original_scale_factors(self, impactors) !! author: David A. Minton !! !! Restores dimenional quantities back to the system units @@ -269,7 +274,7 @@ module subroutine fraggle_set_original_scale_factors(self, colliders) implicit none ! Arguments class(fraggle_fragments), intent(inout) :: self !! Fraggle fragment system object - class(fraggle_colliders), intent(inout) :: colliders !! Fraggle collider system object + class(collision_impactors), intent(inout) :: impactors !! Fraggle collider system object ! Internals integer(I4B) :: i logical, dimension(size(IEEE_ALL)) :: fpe_halting_modes @@ -284,13 +289,13 @@ module subroutine fraggle_set_original_scale_factors(self, colliders) fragments%vbcom(:) = fragments%vbcom(:) * fragments%vscale fragments%rbimp(:) = fragments%rbimp(:) * fragments%dscale - colliders%mass = colliders%mass * fragments%mscale - colliders%radius = colliders%radius * fragments%dscale - colliders%rb = colliders%rb * fragments%dscale - colliders%vb = colliders%vb * fragments%vscale - colliders%L_spin = colliders%L_spin * fragments%Lscale + impactors%mass = impactors%mass * fragments%mscale + impactors%radius = impactors%radius * fragments%dscale + impactors%rb = impactors%rb * fragments%dscale + impactors%vb = impactors%vb * fragments%vscale + impactors%L_spin = impactors%L_spin * fragments%Lscale do i = 1, 2 - colliders%rot(:,i) = colliders%L_spin(:,i) * (colliders%mass(i) * colliders%radius(i)**2 * colliders%Ip(3, i)) + impactors%rot(:,i) = impactors%L_spin(:,i) * (impactors%mass(i) * impactors%radius(i)**2 * impactors%Ip(3, i)) end do fragments%mtot = fragments%mtot * fragments%mscale diff --git a/src/fraggle/fraggle_setup.f90 b/src/fraggle/fraggle_setup.f90 index bd660dc98..3d8916967 100644 --- a/src/fraggle/fraggle_setup.f90 +++ b/src/fraggle/fraggle_setup.f90 @@ -52,30 +52,19 @@ module subroutine fraggle_setup_fragments(self, n, param) integer(I4B), intent(in) :: n class(swiftest_parameters), intent(in) :: param - call setup_pl(self, n, param) + call self%collision_fragments%setup(n, param) if (n < 0) return - if (allocated(self%r_coll)) deallocate(self%r_coll) - if (allocated(self%v_coll)) deallocate(self%v_coll) - if (allocated(self%v_r_unit)) deallocate(self%v_r_unit) - if (allocated(self%v_t_unit)) deallocate(self%v_t_unit) - if (allocated(self%v_n_unit)) deallocate(self%v_n_unit) - if (allocated(self%rmag)) deallocate(self%rmag) - if (allocated(self%rotmag)) deallocate(self%rotmag) if (allocated(self%v_r_mag)) deallocate(self%v_r_mag) if (allocated(self%v_t_mag)) deallocate(self%v_t_mag) + if (allocated(self%v_n_mag)) deallocate(self%v_t_mag) if (n == 0) return - allocate(self%r_coll(NDIM,n)) - allocate(self%v_coll(NDIM,n)) - allocate(self%v_r_unit(NDIM,n)) - allocate(self%v_t_unit(NDIM,n)) - allocate(self%v_n_unit(NDIM,n)) - allocate(self%rmag(n)) allocate(self%rotmag(n)) allocate(self%v_r_mag(n)) allocate(self%v_t_mag(n)) + allocate(self%v_n_mag(n)) call self%reset() diff --git a/src/fraggle/fraggle_util.f90 b/src/fraggle/fraggle_util.f90 index c4fffe4a6..bb32167b1 100644 --- a/src/fraggle/fraggle_util.f90 +++ b/src/fraggle/fraggle_util.f90 @@ -11,14 +11,14 @@ use swiftest contains - module subroutine fraggle_util_add_fragments_to_system(fragments, colliders, system, param) + module subroutine fraggle_util_add_fragments_to_system(fragments, impactors, system, param) !! Author: David A. Minton !! !! Adds fragments to the temporary system pl object implicit none ! Arguments class(fraggle_fragments), intent(in) :: fragments !! Fraggle fragment system object - class(fraggle_colliders), intent(in) :: colliders !! Fraggle collider system object + class(collision_impactors), intent(in) :: impactors !! Fraggle collider system object class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object class(swiftest_parameters), intent(in) :: param !! Current swiftest run configuration parameters ! Internals @@ -44,9 +44,9 @@ module subroutine fraggle_util_add_fragments_to_system(fragments, colliders, sys pl%Ip(:,npl_before+1:npl_after) = fragments%Ip(:,1:nfrag) pl%rot(:,npl_before+1:npl_after) = fragments%rot(:,1:nfrag) end if - ! This will remove the colliders from the system since we've replaced them with fragments + ! This will remove the impactors from the system since we've replaced them with fragments lexclude(1:npl_after) = .false. - lexclude(colliders%idx(1:colliders%ncoll)) = .true. + lexclude(impactors%idx(1:impactors%ncoll)) = .true. where(lexclude(1:npl_after)) pl%status(1:npl_after) = INACTIVE elsewhere @@ -132,18 +132,18 @@ end subroutine fraggle_util_construct_temporary_system - module subroutine fraggle_util_final_colliders(self) + module subroutine fraggle_util_final_impactors(self) !! author: David A. Minton !! !! Finalizer will deallocate all allocatables implicit none ! Arguments - type(fraggle_colliders), intent(inout) :: self !! Fraggle encountar storage object + type(collision_impactors), intent(inout) :: self !! Fraggle encountar storage object if (allocated(self%idx)) deallocate(self%idx) return - end subroutine fraggle_util_final_colliders + end subroutine fraggle_util_final_impactors module subroutine fraggle_util_final_fragments(self) @@ -168,137 +168,14 @@ module subroutine fraggle_util_final_fragments(self) end subroutine fraggle_util_final_fragments - module subroutine fraggle_util_final_snapshot(self) - !! author: David A. Minton - !! - !! Finalizer will deallocate all allocatables - implicit none - ! Arguments - type(fraggle_snapshot), intent(inout) :: self !! Fraggle encountar storage object - - call encounter_util_final_snapshot(self%encounter_snapshot) - - return - end subroutine fraggle_util_final_snapshot - - - module subroutine fraggle_util_get_energy_momentum(self, colliders, system, param, lbefore) - !! Author: David A. Minton - !! - !! Calculates total system energy in either the pre-collision outcome state (lbefore = .true.) or the post-collision outcome state (lbefore = .false.) - !! This subrourtine works by building a temporary internal massive body object out of the non-excluded bodies and optionally with fragments appended. - !! This will get passed to the energy calculation subroutine so that energy is computed exactly the same way is it is in the main program. - !! This will temporarily expand the massive body object in a temporary system object called tmpsys to feed it into symba_energy - implicit none - ! Arguments - class(fraggle_fragments), intent(inout) :: self !! Fraggle fragment system object - class(fraggle_colliders), intent(inout) :: colliders !! Fraggle collider system object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object - class(swiftest_parameters), intent(inout) :: param !! Current swiftest run configuration parameters - logical, intent(in) :: lbefore !! Flag indicating that this the "before" state of the system, with colliders included and fragments excluded or vice versa - ! Internals - class(swiftest_nbody_system), allocatable, save :: tmpsys - class(swiftest_parameters), allocatable, save :: tmpparam - integer(I4B) :: npl_before, npl_after - - associate(fragments => self, nfrag => self%nbody, pl => system%pl, cb => system%cb) - - ! Because we're making a copy of the massive body object with the excludes/fragments appended, we need to deallocate the - ! big k_plpl array and recreate it when we're done, otherwise we run the risk of blowing up the memory by - ! allocating two of these ginormous arrays simulteouously. This is not particularly efficient, but as this - ! subroutine should be called relatively infrequently, it shouldn't matter too much. - - npl_before = pl%nbody - npl_after = npl_before + nfrag - - if (lbefore) then - call fraggle_util_construct_temporary_system(fragments, system, param, tmpsys, tmpparam) - ! Build the exluded body logical mask for the *before* case: Only the original bodies are used to compute energy and momentum - tmpsys%pl%status(colliders%idx(1:colliders%ncoll)) = ACTIVE - tmpsys%pl%status(npl_before+1:npl_after) = INACTIVE - else - if (.not.allocated(tmpsys)) then - write(*,*) "Error in fraggle_util_get_energy_momentum. " // & - " This must be called with lbefore=.true. at least once before calling it with lbefore=.false." - call util_exit(FAILURE) - end if - ! Build the exluded body logical mask for the *after* case: Only the new bodies are used to compute energy and momentum - call fraggle_util_add_fragments_to_system(fragments, colliders, tmpsys, tmpparam) - tmpsys%pl%status(colliders%idx(1:colliders%ncoll)) = INACTIVE - tmpsys%pl%status(npl_before+1:npl_after) = ACTIVE - end if - - if (param%lflatten_interactions) call tmpsys%pl%flatten(param) - - call tmpsys%get_energy_and_momentum(param) - - - ! Calculate the current fragment energy and momentum balances - if (lbefore) then - fragments%Lorbit_before(:) = tmpsys%Lorbit(:) - fragments%Lspin_before(:) = tmpsys%Lspin(:) - fragments%Ltot_before(:) = tmpsys%Ltot(:) - fragments%ke_orbit_before = tmpsys%ke_orbit - fragments%ke_spin_before = tmpsys%ke_spin - fragments%pe_before = tmpsys%pe - fragments%Etot_before = tmpsys%te - else - fragments%Lorbit_after(:) = tmpsys%Lorbit(:) - fragments%Lspin_after(:) = tmpsys%Lspin(:) - fragments%Ltot_after(:) = tmpsys%Ltot(:) - fragments%ke_orbit_after = tmpsys%ke_orbit - fragments%ke_spin_after = tmpsys%ke_spin - fragments%pe_after = tmpsys%pe - fragments%Etot_after = tmpsys%te - (fragments%pe_after - fragments%pe_before) ! Gotta be careful with PE when number of bodies changes. - end if - end associate - - return - end subroutine fraggle_util_get_energy_momentum - - - module subroutine fraggle_util_get_idvalues_snapshot(self, idvals) - !! author: David A. Minton - !! - !! Returns an array of all id values saved in this snapshot - implicit none - ! Arguments - class(fraggle_snapshot), intent(in) :: self !! Fraggle snapshot object - integer(I4B), dimension(:), allocatable, intent(out) :: idvals !! Array of all id values saved in this snapshot - ! Internals - integer(I4B) :: ncoll, nfrag - - if (allocated(self%colliders)) then - ncoll = self%colliders%pl%nbody - else - ncoll = 0 - end if - - if (allocated(self%fragments)) then - nfrag = self%fragments%pl%nbody - else - nfrag = 0 - end if - - if (ncoll + nfrag == 0) return - allocate(idvals(ncoll+nfrag)) - - if (ncoll > 0) idvals(1:ncoll) = self%colliders%pl%id(:) - if (nfrag > 0) idvals(ncoll+1:ncoll+nfrag) = self%fragments%pl%id(:) - - return - - end subroutine fraggle_util_get_idvalues_snapshot - - - module subroutine fraggle_util_restructure(self, colliders, try, f_spin, r_max_start) + module subroutine fraggle_util_restructure(self, impactors, try, f_spin, r_max_start) !! Author: David A. Minton !! !! Restructure the inputs after a failed attempt failed to find a set of positions and velocities that satisfy the energy and momentum constraints implicit none ! Arguments class(fraggle_fragments), intent(inout) :: self !! Fraggle fragment system object - class(fraggle_colliders), intent(in) :: colliders !! Fraggle collider system object + class(collision_impactors), intent(in) :: impactors !! Fraggle collider system object integer(I4B), intent(in) :: try !! The current number of times Fraggle has tried to find a solution real(DP), intent(inout) :: f_spin !! Fraction of energy/momentum that goes into spin. This decreases ater a failed attempt real(DP), intent(inout) :: r_max_start !! The maximum radial distance that the position calculation starts with. This increases after a failed attempt @@ -310,7 +187,7 @@ module subroutine fraggle_util_restructure(self, colliders, try, f_spin, r_max_s ! Introduce a bit of noise in the radius determination so we don't just flip flop between similar failed positions associate(fragments => self) call random_number(delta_r_max) - delta_r_max = sum(colliders%radius(:)) * (1.0_DP + 2e-1_DP * (delta_r_max - 0.5_DP)) + delta_r_max = sum(impactors%radius(:)) * (1.0_DP + 2e-1_DP * (delta_r_max - 0.5_DP)) if (try == 1) then ke_tot_deficit = - (fragments%ke_budget - fragments%ke_orbit - fragments%ke_spin) ke_avg_deficit = ke_tot_deficit diff --git a/src/modules/collision_classes.f90 b/src/modules/collision_classes.f90 new file mode 100644 index 000000000..d3ede5fcb --- /dev/null +++ b/src/modules/collision_classes.f90 @@ -0,0 +1,305 @@ +!! Copyright 2022 - David Minton, Carlisle Wishard, Jennifer Pouplin, Jake Elliott, & Dana Singh +!! This file is part of Swiftest. +!! Swiftest is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License +!! as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. +!! Swiftest is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty +!! of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. +!! You should have received a copy of the GNU General Public License along with Swiftest. +!! If not, see: https://www.gnu.org/licenses. + +module collision_classes + !! author: The Purdue Swiftest Team - David A. Minton, Carlisle A. Wishard, Jennifer L.L. Pouplin, and Jacob R. Elliott + !! + !! Definition of classes and methods used to determine close encounters + use swiftest_globals + use swiftest_classes, only : swiftest_parameters, swiftest_nbody_system, swiftest_pl, swiftest_storage, netcdf_parameters + use encounter_classes, only : encounter_snapshot, encounter_io_parameters, encounter_storage, encounter_io_parameters + implicit none + public + + + !>Symbolic names for collisional outcomes from collresolve_resolve: + integer(I4B), parameter :: COLLRESOLVE_REGIME_MERGE = 1 + integer(I4B), parameter :: COLLRESOLVE_REGIME_DISRUPTION = 2 + integer(I4B), parameter :: COLLRESOLVE_REGIME_SUPERCATASTROPHIC = 3 + integer(I4B), parameter :: COLLRESOLVE_REGIME_GRAZE_AND_MERGE = 4 + integer(I4B), parameter :: COLLRESOLVE_REGIME_HIT_AND_RUN = 5 + character(len=*),dimension(5), parameter :: REGIME_NAMES = ["Merge", "Disruption", "Supercatastrophic", "Graze and Merge", "Hit and Run"] + + !******************************************************************************************************************************** + ! collision_impactors class definitions and method interfaces + !******************************************************************************************************************************* + !> Class definition for the variables that describe the bodies involved in the collision + type :: collision_impactors + integer(I4B) :: ncoll !! Number of bodies involved in the collision + integer(I4B), dimension(:), allocatable :: idx !! Index of bodies involved in the collision + real(DP), dimension(NDIM,2) :: rb !! Two-body equivalent position vectors of the collider bodies prior to collision + real(DP), dimension(NDIM,2) :: vb !! Two-body equivalent velocity vectors of the collider bodies prior to collision + real(DP), dimension(NDIM,2) :: rot !! Two-body equivalent principal axes moments of inertia the collider bodies prior to collision + real(DP), dimension(NDIM,2) :: L_spin !! Two-body equivalent spin angular momentum vectors of the collider bodies prior to collision + real(DP), dimension(NDIM,2) :: L_orbit !! Two-body equivalent orbital angular momentum vectors of the collider bodies prior to collision + real(DP), dimension(NDIM,2) :: Ip !! Two-body equivalent principal axes moments of inertia the collider bodies prior to collision + real(DP), dimension(2) :: mass !! Two-body equivalent mass of the collider bodies prior to the collision + real(DP), dimension(2) :: radius !! Two-body equivalent radii of the collider bodies prior to the collision + real(DP) :: Qloss !! Energy lost during the collision + integer(I4B) :: regime !! Collresolve regime code for this collision + real(DP), dimension(:), allocatable :: mass_dist !! Distribution of fragment mass determined by the regime calculation (largest fragment, second largest, and remainder) + + ! Values in a coordinate frame centered on the collider barycenter and collisional system unit vectors + real(DP), dimension(NDIM) :: x_unit !! x-direction unit vector of collisional system + real(DP), dimension(NDIM) :: y_unit !! y-direction unit vector of collisional system + real(DP), dimension(NDIM) :: z_unit !! z-direction unit vector of collisional system + real(DP), dimension(NDIM) :: v_unit !! z-direction unit vector of collisional system + real(DP), dimension(NDIM) :: rbcom !! Center of mass position vector of the collider system in system barycentric coordinates + real(DP), dimension(NDIM) :: vbcom !! Velocity vector of the center of mass of the collider system in system barycentric coordinates + real(DP), dimension(NDIM) :: rbimp !! Impact point position vector of the collider system in system barycentric coordinates + + contains + procedure :: set_coordinate_system => collision_set_coordinate_impactors !! Defines the collisional coordinate system, including the unit vectors of both the system and individual fragments. + procedure :: setup => collision_setup_impactors !! Allocates arrays for n fragments in a fragment system. Passing n = 0 deallocates all arrays. + procedure :: reset => collision_util_reset_impactors !! Resets the collider object variables to 0 and deallocates the index and mass distributions + final :: collision_util_final_impactors !! Finalizer will deallocate all allocatables + end type collision_impactors + + !******************************************************************************************************************************** + ! collision_fragments class definitions and method interfaces + !******************************************************************************************************************************* + !> Class definition for the variables that describe a collection of fragments by Fraggle barycentric coordinates + type, abstract, extends(swiftest_pl) :: collision_fragments + real(DP) :: mtot !! Total mass of fragments + real(DP), dimension(:,:), allocatable :: rc !! Position vectors in the collision coordinate frame + real(DP), dimension(:,:), allocatable :: vc !! Velocity vectors in the collision coordinate frame + real(DP), dimension(:), allocatable :: rmag !! Array of radial distance magnitudes of individual fragments in the collisional coordinate frame + real(DP), dimension(:), allocatable :: vmag !! Array of radial distance magnitudes of individual fragments in the collisional coordinate frame + real(DP), dimension(:), allocatable :: rotmag !! Array of rotation magnitudes of individual fragments + real(DP), dimension(:,:), allocatable :: v_r_unit !! Array of radial direction unit vectors of individual fragments in the collisional coordinate frame + real(DP), dimension(:,:), allocatable :: v_t_unit !! Array of tangential direction unit vectors of individual fragments in the collisional coordinate frame + real(DP), dimension(:,:), allocatable :: v_n_unit !! Array of normal direction unit vectors of individual fragments in the collisional coordinate frame + + contains + procedure :: accel => collision_placeholder_accel !! Placeholder subroutine to fulfill requirement for an accel method + procedure :: kick => collision_placeholder_kick !! Placeholder subroutine to fulfill requirement for a kick method + procedure :: step => collision_placeholder_step !! Placeholder subroutine to fulfill requirement for a step method + procedure :: set_coordinate_system => collision_set_coordinate_fragments !! Defines the collisional coordinate system, including the unit vectors of both the system and individual fragments. + procedure :: setup => collision_setup_fragments !! Allocates arrays for n fragments in a Fraggle system. Passing n = 0 deallocates all arrays. + procedure :: reset => collision_util_reset_fragments !! Deallocates all allocatable arrays + end type collision_fragments + + type :: collision_system + !! This class defines a collisional system that stores impactors and fragments. This is written so that various collision models (i.e. Fraggle) could potentially be used + !! to resolve collision by defining extended types of encounters_impactors and/or encounetr_fragments + class(collision_impactors), allocatable :: impactors !! Object containing information on the pre-collision system + class(collision_fragments), allocatable :: fragments !! Object containing information on the post-collision system + class(swiftest_nbody_system), allocatable :: before !! A snapshot of the subset of the system involved in the collision + class(swiftest_nbody_system), allocatable :: after !! A snapshot of the subset of the system containing products of the collision + + ! For the following variables, index 1 refers to the *entire* n-body system in its pre-collisional state and index 2 refers to the system in its post-collisional state + real(DP), dimension(NDIM,2) :: Lorbit !! Before/after orbital angular momentum + real(DP), dimension(NDIM,2) :: Lspin !! Before/after spin angular momentum + real(DP), dimension(NDIM,2) :: Ltot !! Before/after total system angular momentum + real(DP), dimension(2) :: ke_orbit !! Before/after orbital kinetic energy + real(DP), dimension(2) :: ke_spin !! Before/after spin kinetic energy + real(DP), dimension(2) :: pe !! Before/after potential energy + real(DP), dimension(2) :: Etot !! Before/after total system energy + contains + procedure :: generate_fragments => collision_generate_fragment_system !! Generates a system of fragments in barycentric coordinates that conserves energy and momentum. + procedure :: regime => collision_regime_system !! Determine which fragmentation regime the set of impactors will be + procedure :: setup => collision_setup_system !! Initializer for the encounter collision system. Allocates the collider and fragments classes and the before/after snapshots + procedure :: get_energy_and_momentum => collision_util_get_energy_momentum !! Calculates total system energy in either the pre-collision outcome state (lbefore = .true.) or the post-collision outcome state (lbefore = .false.) + procedure :: reset => collision_util_reset_system !! Deallocates all allocatables + final :: collision_util_final_system !! Finalizer will deallocate all allocatables + end type collision_system + + + !> NetCDF dimension and variable names for the enounter save object + type, extends(encounter_io_parameters) :: collision_io_parameters + contains + procedure :: initialize => collision_io_initialize !! Initialize a set of parameters used to identify a NetCDF output object + end type collision_io_parameters + + type, extends(encounter_snapshot) :: collision_snapshot + logical :: lcollision !! Indicates that this snapshot contains at least one collision + class(collision_system), allocatable :: collision_system !! impactors object at this snapshot + contains + procedure :: write_frame => collision_io_write_frame_snapshot !! Writes a frame of encounter data to file + procedure :: get_idvals => collision_util_get_idvalues_snapshot !! Gets an array of all id values saved in this snapshot + final :: collision_util_final_snapshot !! Finalizer deallocates all allocatables + end type collision_snapshot + + !> A class that that is used to store simulation history data between file output + type, extends(swiftest_storage) :: collision_storage + contains + procedure :: dump => collision_io_dump !! Dumps contents of encounter history to file + procedure :: take_snapshot => collision_util_snapshot !! Take a minimal snapshot of the system through an encounter + procedure :: make_index_map => collision_util_index_map !! Maps body id values to storage index values so we don't have to use unlimited dimensions for id + final :: collision_util_final_storage !! Finalizer deallocates all allocatables + end type collision_storage + + interface + module subroutine collision_generate_fragment_system(self, system, param, lfailure) + use swiftest_classes, only : swiftest_nbody_system, swiftest_parameters + implicit none + class(collision_system), intent(inout) :: self !! Fraggle fragment system object + class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + logical, intent(out) :: lfailure !! Answers the question: Should this have been a merger instead? + end subroutine collision_generate_fragment_system + + module subroutine collision_io_dump(self, param) + implicit none + class(collision_storage(*)), intent(inout) :: self !! Collision storage object + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + end subroutine collision_io_dump + + module subroutine collision_io_initialize(self, param) + implicit none + class(collision_io_parameters), intent(inout) :: self !! Parameters used to identify a particular NetCDF dataset + class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters + end subroutine collision_io_initialize + + module subroutine collision_io_write_frame_snapshot(self, nc, param) + implicit none + class(collision_snapshot), intent(in) :: self !! Swiftest encounter structure + class(netcdf_parameters), intent(inout) :: nc !! Parameters used to identify a particular encounter io NetCDF dataset + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + end subroutine collision_io_write_frame_snapshot + + !> The following interfaces are placeholders intended to satisfy the required abstract methods given by the parent class + module subroutine collision_placeholder_accel(self, system, param, t, lbeg) + use swiftest_classes, only : swiftest_nbody_system, swiftest_parameters + implicit none + class(collision_fragments), intent(inout) :: self !! Fraggle fragment system object + class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + real(DP), intent(in) :: t !! Current simulation time + logical, intent(in) :: lbeg !! Optional argument that determines whether or not this is the beginning or end of the step + end subroutine collision_placeholder_accel + + module subroutine collision_placeholder_kick(self, system, param, t, dt, lbeg) + use swiftest_classes, only : swiftest_nbody_system, swiftest_parameters + implicit none + class(collision_fragments), intent(inout) :: self !! Fraggle fragment system object + class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system objec + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + real(DP), intent(in) :: t !! Current time + real(DP), intent(in) :: dt !! Stepsize + logical, intent(in) :: lbeg !! Logical flag indicating whether this is the beginning of the half step or not. + end subroutine collision_placeholder_kick + + module subroutine collision_placeholder_step(self, system, param, t, dt) + use swiftest_classes, only : swiftest_nbody_system, swiftest_parameters + implicit none + class(collision_fragments), intent(inout) :: self !! Helio massive body particle object + class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + real(DP), intent(in) :: t !! Current simulation time + real(DP), intent(in) :: dt !! Stepsiz + end subroutine collision_placeholder_step + + module subroutine collision_regime_system(self, system, param) + implicit none + class(collision_system), intent(inout) :: self !! Collision system object + class(swiftest_nbody_system), intent(in) :: system !! Swiftest nbody system object + class(swiftest_parameters), intent(in) :: param !! Current Swiftest run configuration parameters + end subroutine collision_regime_system + + module subroutine collision_set_coordinate_impactors(self) + implicit none + class(collision_impactors), intent(inout) :: self !! Collider system object + end subroutine collision_set_coordinate_impactors + + module subroutine collision_set_coordinate_fragments(self) + implicit none + class(collision_fragments), intent(inout) :: self !! Fragment system object + end subroutine collision_set_coordinate_fragments + + module subroutine collision_setup_fragments(self, n, param) + implicit none + class(collision_fragments), intent(inout) :: self !! Fragment system object + integer(I4B), intent(in) :: n !! Number of fragments + class(swiftest_parameters), intent(in) :: param !! Current swiftest run configuration parameters + end subroutine collision_setup_fragments + + module subroutine collision_setup_impactors(self, system, param) + implicit none + class(collision_impactors), intent(inout) :: self !! Fragment system object + class(swiftest_nbody_system), intent(in) :: system + class(swiftest_parameters), intent(in) :: param !! Current swiftest run configuration parameters + end subroutine collision_setup_impactors + + module subroutine collision_setup_system(self, system, param) + use swiftest_classes, only : swiftest_nbody_system, swiftest_parameters + implicit none + class(collision_system), intent(inout) :: self !! Encounter collision system object + class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + end subroutine collision_setup_system + + module subroutine collision_util_reset_fragments(self) + implicit none + class(collision_fragments), intent(inout) :: self + end subroutine collision_util_reset_fragments + + module subroutine collision_util_final_impactors(self) + implicit none + type(collision_impactors), intent(inout) :: self !! Collision impactors storage object + end subroutine collision_util_final_impactors + + module subroutine collision_util_final_storage(self) + implicit none + type(collision_storage(*)), intent(inout) :: self !! SyMBA nbody system object + end subroutine collision_util_final_storage + + module subroutine collision_util_final_snapshot(self) + implicit none + type(collision_snapshot), intent(inout) :: self !! Fraggle storage snapshot object + end subroutine collision_util_final_snapshot + + module subroutine collision_util_final_system(self) + implicit none + type(collision_system), intent(inout) :: self !! Collision system object + end subroutine collision_util_final_system + + module subroutine collision_util_get_idvalues_snapshot(self, idvals) + implicit none + class(collision_snapshot), intent(in) :: self !! Fraggle snapshot object + integer(I4B), dimension(:), allocatable, intent(out) :: idvals !! Array of all id values saved in this snapshot + end subroutine collision_util_get_idvalues_snapshot + + module subroutine collision_util_get_energy_momentum(self, system, param, lbefore) + use swiftest_classes, only : swiftest_nbody_system, swiftest_parameters + implicit none + class(collision_system), intent(inout) :: self !! Encounter collision system object + class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_parameters), intent(inout) :: param !! Current swiftest run configuration parameters + logical, intent(in) :: lbefore !! Flag indicating that this the "before" state of the system, with impactors included and fragments excluded or vice versa + end subroutine collision_util_get_energy_momentum + + module subroutine collision_util_index_map(self) + implicit none + class(collision_storage(*)), intent(inout) :: self !! Collision storage object + end subroutine collision_util_index_map + + module subroutine collision_util_reset_impactors(self) + implicit none + class(collision_impactors), intent(inout) :: self + end subroutine collision_util_reset_impactors + + module subroutine collision_util_reset_system(self) + implicit none + class(collision_system), intent(inout) :: self + end subroutine collision_util_reset_system + + module subroutine collision_util_snapshot(self, param, system, t, arg) + implicit none + class(collision_storage(*)), intent(inout) :: self !! Swiftest storage object + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object to store + real(DP), intent(in), optional :: t !! Time of snapshot if different from system time + character(*), intent(in), optional :: arg !! "before": takes a snapshot just before the collision. "after" takes the snapshot just after the collision. + end subroutine collision_util_snapshot + + end interface + +end module collision_classes + diff --git a/src/modules/encounter_classes.f90 b/src/modules/encounter_classes.f90 index 2b313eeb5..0eb0dc3f7 100644 --- a/src/modules/encounter_classes.f90 +++ b/src/modules/encounter_classes.f90 @@ -12,7 +12,7 @@ module encounter_classes !! !! Definition of classes and methods used to determine close encounters use swiftest_globals - use swiftest_classes + use swiftest_classes, only : swiftest_parameters, swiftest_nbody_system, swiftest_cb, swiftest_tp, swiftest_pl, swiftest_storage, netcdf_parameters implicit none public @@ -50,37 +50,17 @@ module encounter_classes real(DP) :: t !! Simulation time when snapshot was taken integer(I8B) :: iloop !! Loop number at time of snapshot contains - procedure :: write_frame => encounter_io_write_frame !! Writes a frame of encounter data to file - procedure :: get_idvals => encounter_util_get_idvalues_snapshot !! Gets an array of all id values saved in this snapshot + procedure :: write_frame => encounter_io_write_frame_snapshot !! Writes a frame of encounter data to file + procedure :: get_idvals => encounter_util_get_idvalues_snapshot !! Gets an array of all id values saved in this snapshot final :: encounter_util_final_snapshot end type encounter_snapshot - !> NetCDF dimension and variable names for the enounter save object - type, extends(netcdf_parameters) :: encounter_io_parameters - character(NAMELEN) :: loop_varname = "loopnum" !! Loop number for encounter - integer(I4B) :: loop_varid !! ID for the recursion level variable - integer(I4B) :: time_dimsize = 0 !! Number of time values in snapshot - integer(I4B) :: name_dimsize = 0 !! Number of potential id values in snapshot - integer(I4B) :: file_number = 1 !! The number to append on the output file - contains - procedure :: initialize => encounter_io_initialize !! Initialize a set of parameters used to identify a NetCDF output object - end type encounter_io_parameters - - !> A class that that is used to store simulation history data between file output - type, extends(swiftest_storage) :: collision_storage - contains - procedure :: dump => encounter_io_dump_collision !! Dumps contents of encounter history to file - procedure :: take_snapshot => encounter_util_snapshot_collision !! Take a minimal snapshot of the system through an encounter - procedure :: make_index_map => encounter_util_index_map_collision !! Maps body id values to storage index values so we don't have to use unlimited dimensions for id - final :: encounter_util_final_collision_storage - end type collision_storage - !> A class that that is used to store simulation history data between file output type, extends(swiftest_storage) :: encounter_storage contains - procedure :: dump => encounter_io_dump_encounter !! Dumps contents of encounter history to file - procedure :: make_index_map => encounter_util_index_map_encounter !! Maps body id values to storage index values so we don't have to use unlimited dimensions for id - procedure :: take_snapshot => encounter_util_snapshot_encounter !! Take a minimal snapshot of the system through an encounter + procedure :: dump => encounter_io_dump !! Dumps contents of encounter history to file + procedure :: make_index_map => encounter_util_index_map !! Maps body id values to storage index values so we don't have to use unlimited dimensions for id + procedure :: take_snapshot => encounter_util_snapshot !! Take a minimal snapshot of the system through an encounter final :: encounter_util_final_storage end type encounter_storage @@ -216,30 +196,18 @@ 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_dump_collision(self, param) - implicit none - class(collision_storage(*)), intent(inout) :: self !! Collision storage object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - end subroutine encounter_io_dump_collision - - module subroutine encounter_io_dump_encounter(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_encounter - - module subroutine encounter_io_initialize(self, param) + module subroutine encounter_io_dump(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 + class(encounter_storage(*)), intent(inout) :: self !! Encounter storage object + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + end subroutine encounter_io_dump - module subroutine encounter_io_write_frame(self, nc, param) + module subroutine encounter_io_write_frame_snapshot(self, nc, param) implicit none class(encounter_snapshot), intent(in) :: self !! Swiftest encounter structure class(netcdf_parameters), intent(inout) :: nc !! 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 + end subroutine encounter_io_write_frame_snapshot module subroutine encounter_setup_aabb(self, n, n_last) implicit none @@ -282,11 +250,6 @@ module subroutine encounter_util_final_aabb(self) type(encounter_bounding_box_1D), intent(inout) :: self !!Bounding box structure along a single dimension end subroutine encounter_util_final_aabb - module subroutine encounter_util_final_collision_storage(self) - implicit none - type(collision_storage(*)), intent(inout) :: self !! SyMBA nbody system object - end subroutine encounter_util_final_collision_storage - module subroutine encounter_util_final_list(self) implicit none type(encounter_list), intent(inout) :: self !! Swiftest encounter list object @@ -308,15 +271,10 @@ module subroutine encounter_util_get_idvalues_snapshot(self, idvals) integer(I4B), dimension(:), allocatable, intent(out) :: idvals !! Array of all id values saved in this snapshot end subroutine encounter_util_get_idvalues_snapshot - module subroutine encounter_util_index_map_collision(self) - implicit none - class(collision_storage(*)), intent(inout) :: self !! Collision storage object - end subroutine encounter_util_index_map_collision - - module subroutine encounter_util_index_map_encounter(self) + module subroutine encounter_util_index_map(self) implicit none class(encounter_storage(*)), intent(inout) :: self !! Encounter storage object - end subroutine encounter_util_index_map_encounter + end subroutine encounter_util_index_map module subroutine encounter_util_resize_list(self, nnew) implicit none @@ -324,23 +282,14 @@ module subroutine encounter_util_resize_list(self, nnew) integer(I8B), intent(in) :: nnew !! New size of list needed end subroutine encounter_util_resize_list - module subroutine encounter_util_snapshot_collision(self, param, system, t, arg) - implicit none - class(collision_storage(*)), intent(inout) :: self !! Swiftest storage object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object to store - real(DP), intent(in), optional :: t !! Time of snapshot if different from system time - character(*), intent(in), optional :: arg !! "before": takes a snapshot just before the collision. "after" takes the snapshot just after the collision. - end subroutine encounter_util_snapshot_collision - - module subroutine encounter_util_snapshot_encounter(self, param, system, t, arg) + module subroutine encounter_util_snapshot(self, param, system, t, arg) implicit none class(encounter_storage(*)), intent(inout) :: self !! Swiftest storage object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object to store real(DP), intent(in), optional :: t !! Time of snapshot if different from system time character(*), intent(in), optional :: arg !! Optional argument (needed for extended storage type used in collision snapshots) - end subroutine encounter_util_snapshot_encounter + end subroutine encounter_util_snapshot module subroutine encounter_util_spill_list(self, discards, lspill_list, ldestructive) diff --git a/src/modules/fraggle_classes.f90 b/src/modules/fraggle_classes.f90 index 235451379..6ef73ffb1 100644 --- a/src/modules/fraggle_classes.f90 +++ b/src/modules/fraggle_classes.f90 @@ -14,77 +14,23 @@ module fraggle_classes use swiftest_globals use swiftest_classes, only : swiftest_parameters, swiftest_nbody_system, swiftest_cb, swiftest_pl, swiftest_storage, netcdf_parameters use encounter_classes, only : encounter_snapshot, encounter_io_parameters, encounter_storage + use collision_classes, only : collision_impactors, collision_fragments, collision_system implicit none public integer(I4B), parameter :: FRAGGLE_NMASS_DIST = 3 !! Number of mass bins returned by the regime calculation (largest fragment, second largest, and remainder) character(len=*), parameter :: FRAGGLE_LOG_OUT = "fraggle.log" !! Name of log file for Fraggle diagnostic information - !******************************************************************************************************************************** - ! fraggle_colliders class definitions and method interfaces - !******************************************************************************************************************************* - !> Class definition for the variables that describe the bodies involved in the collision - type :: fraggle_colliders - integer(I4B) :: ncoll !! Number of bodies involved in the collision - integer(I4B), dimension(:), allocatable :: idx !! Index of bodies involved in the collision - real(DP), dimension(NDIM,2) :: rb !! Two-body equivalent position vectors of the collider bodies prior to collision - real(DP), dimension(NDIM,2) :: vb !! Two-body equivalent velocity vectors of the collider bodies prior to collision - real(DP), dimension(NDIM,2) :: rot !! Two-body equivalent principal axes moments of inertia the collider bodies prior to collision - real(DP), dimension(NDIM,2) :: L_spin !! Two-body equivalent spin angular momentum vectors of the collider bodies prior to collision - real(DP), dimension(NDIM,2) :: L_orbit !! Two-body equivalent orbital angular momentum vectors of the collider bodies prior to collision - real(DP), dimension(NDIM,2) :: Ip !! Two-body equivalent principal axes moments of inertia the collider bodies prior to collision - real(DP), dimension(2) :: mass !! Two-body equivalent mass of the collider bodies prior to the collision - real(DP), dimension(2) :: radius !! Two-body equivalent radii of the collider bodies prior to the collision - class(swiftest_pl), allocatable :: pl !! A snapshot of the planets involved in the collision - contains - procedure :: regime => fraggle_regime_colliders !! Determine which fragmentation regime the set of colliders will be - final :: fraggle_util_final_colliders !! Finalizer will deallocate all allocatables - end type fraggle_colliders - !******************************************************************************************************************************** ! fraggle_fragments class definitions and method interfaces !******************************************************************************************************************************* !> Class definition for the variables that describe a collection of fragments by Fraggle barycentric coordinates - type, extends(swiftest_pl) :: fraggle_fragments - real(DP) :: mtot !! Total mass of fragments - real(DP) :: Qloss !! Energy lost during the collision - real(DP), dimension(FRAGGLE_NMASS_DIST) :: mass_dist !! Distribution of fragment mass determined by the regime calculation (largest fragment, second largest, and remainder) - integer(I4B) :: regime !! Collresolve regime code for this collision - - ! Values in a coordinate frame centered on the collider barycenter and collisional system unit vectors (these are used internally by the fragment generation subroutine) - real(DP), dimension(NDIM) :: rbcom !! Center of mass position vector of the collider system in system barycentric coordinates - real(DP), dimension(NDIM) :: vbcom !! Velocity vector of the center of mass of the collider system in system barycentric coordinates - real(DP), dimension(NDIM) :: rbimp !! Impact point position vector of the collider system in system barycentric coordinates - real(DP), dimension(NDIM) :: x_coll_unit !! x-direction unit vector of collisional system - real(DP), dimension(NDIM) :: y_coll_unit !! y-direction unit vector of collisional system - real(DP), dimension(NDIM) :: z_coll_unit !! z-direction unit vector of collisional system - real(DP), dimension(:,:), allocatable :: r_coll !! Array of fragment position vectors in the collisional coordinate frame - real(DP), dimension(:,:), allocatable :: v_coll !! Array of fragment velocity vectors in the collisional coordinate frame - real(DP), dimension(:,:), allocatable :: v_r_unit !! Array of radial direction unit vectors of individual fragments in the collisional coordinate frame - real(DP), dimension(:,:), allocatable :: v_t_unit !! Array of tangential direction unit vectors of individual fragments in the collisional coordinate frame - real(DP), dimension(:,:), allocatable :: v_n_unit !! Array of normal direction unit vectors of individual fragments in the collisional coordinate frame - real(DP), dimension(:), allocatable :: rmag !! Array of radial distance magnitudes of individual fragments in the collisional coordinate frame - real(DP), dimension(:), allocatable :: rotmag !! Array of rotation magnitudes of individual fragments - real(DP), dimension(:), allocatable :: v_r_mag !! Array of radial direction velocity magnitudes of individual fragments - real(DP), dimension(:), allocatable :: v_t_mag !! Array of tangential direction velocity magnitudes of individual fragments - class(swiftest_pl), allocatable :: pl !! A snapshot of the fragments created in the collision + type, extends(collision_fragments) :: fraggle_fragments - ! Energy and momentum book-keeping variables that characterize the whole system of fragments - real(DP) :: ke_orbit !! Current orbital kinetic energy of the system of fragments in the collisional frame - real(DP) :: ke_spin !! Current spin kinetic energy of the system of fragments in the collisional frame - real(DP), dimension(NDIM) :: L_orbit !! Current orbital angular momentum of the system of fragments in the collisional frame - real(DP), dimension(NDIM) :: L_spin !! Current spin angular momentum of the system of fragments in the collisional frame - real(DP) :: ke_budget !! Total kinetic energy budget for the system of fragmens in the collisional frame - real(DP), dimension(NDIM) :: L_budget !! Total angular momentum budget for the system of fragmens in the collisional frame + real(DP), dimension(:), allocatable :: v_r_mag !! Array of radial direction velocity magnitudes of individual fragments + real(DP), dimension(:), allocatable :: v_t_mag !! Array of tangential direction velocity magnitudes of individual fragments + real(DP), dimension(:), allocatable :: v_n_mag !! Array of normal direction velocity magnitudes of individual fragments - ! For the following variables, "before" refers to the *entire* n-body system in its pre-collisional state and "after" refers to the system in its post-collisional state - real(DP), dimension(NDIM) :: Lorbit_before, Lorbit_after !! Before/after orbital angular momentum - real(DP), dimension(NDIM) :: Lspin_before, Lspin_after !! Before/after spin angular momentum - real(DP), dimension(NDIM) :: Ltot_before, Ltot_after !! Before/after total system angular momentum - real(DP) :: ke_orbit_before, ke_orbit_after !! Before/after orbital kinetic energy - real(DP) :: ke_spin_before, ke_spin_after !! Before/after spin kinetic energy - real(DP) :: pe_before, pe_after !! Before/after potential energy - real(DP) :: Etot_before, Etot_after !! Before/after total system energy ! Scale factors used to scale dimensioned quantities to a more "natural" system where important quantities (like kinetic energy, momentum) are of order ~1 real(DP) :: dscale = 1.0_DP !! Distance dimension scale factor @@ -95,159 +41,66 @@ module fraggle_classes real(DP) :: Lscale = 1.0_DP !! Angular momentum scale factor (a convenience unit that is derived from dscale, tscale, and mscale) contains procedure :: generate_fragments => fraggle_generate_fragments !! Generates a system of fragments in barycentric coordinates that conserves energy and momentum. - procedure :: accel => fraggle_placeholder_accel !! Placeholder subroutine to fulfill requirement for an accel method - procedure :: kick => fraggle_placeholder_kick !! Placeholder subroutine to fulfill requirement for a kick method - procedure :: step => fraggle_placeholder_step !! Placeholder subroutine to fulfill requirement for a step method procedure :: set_budgets => fraggle_set_budgets_fragments !! Sets the energy and momentum budgets of the fragments based on the collider value - procedure :: set_coordinate_system => fraggle_set_coordinate_system !! Defines the collisional coordinate system, including the unit vectors of both the system and individual fragments. procedure :: set_mass_dist => fraggle_set_mass_dist_fragments !! Sets the distribution of mass among the fragments depending on the regime type procedure :: set_natural_scale => fraggle_set_natural_scale_factors !! Scales dimenional quantities to ~O(1) with respect to the collisional system. procedure :: set_original_scale => fraggle_set_original_scale_factors !! Restores dimenional quantities back to the original system units procedure :: setup => fraggle_setup_fragments !! Allocates arrays for n fragments in a Fraggle system. Passing n = 0 deallocates all arrays. procedure :: reset => fraggle_setup_reset_fragments !! Resets all position and velocity-dependent fragment quantities in order to do a fresh calculation (does not reset mass, radius, or other values that get set prior to the call to fraggle_generate) procedure :: get_ang_mtm => fraggle_util_ang_mtm !! Calcualtes the current angular momentum of the fragments - procedure :: get_energy_and_momentum => fraggle_util_get_energy_momentum !! Calculates total system energy in either the pre-collision outcome state (lbefore = .true.) or the post-collision outcome state (lbefore = .false.) procedure :: restructure => fraggle_util_restructure !! Restructure the inputs after a failed attempt failed to find a set of positions and velocities that satisfy the energy and momentum constraints final :: fraggle_util_final_fragments !! Finalizer will deallocate all allocatables end type fraggle_fragments - !! NetCDF dimension and variable names for the enounter save object - type, extends(encounter_io_parameters) :: fraggle_io_parameters - integer(I4B) :: stage_dimid !! ID for the stage dimension - integer(I4B) :: stage_varid !! ID for the stage variable - character(NAMELEN) :: stage_dimname = "stage" !! name of the stage dimension (before/after) - character(len=6), dimension(2) :: stage_coords = ["before", "after"] !! The stage coordinate labels - - character(NAMELEN) :: event_dimname = "collision" !! Name of collision event dimension - integer(I4B) :: event_dimid !! ID for the collision event dimension - integer(I4B) :: event_varid !! ID for the collision event variable - integer(I4B) :: event_dimsize = 0 !! Number of events - - character(NAMELEN) :: Qloss_varname = "Qloss" !! name of the energy loss variable - integer(I4B) :: Qloss_varid !! ID for the energy loss variable - character(NAMELEN) :: regime_varname = "regime" !! name of the collision regime variable - integer(I4B) :: regime_varid !! ID for the collision regime variable - - contains - procedure :: initialize => fraggle_io_initialize_output !! Initialize a set of parameters used to identify a NetCDF output object - end type fraggle_io_parameters - - type, extends(encounter_snapshot) :: fraggle_snapshot - logical :: lcollision !! Indicates that this snapshot contains at least one collision - class(fraggle_colliders), allocatable :: colliders !! Colliders object at this snapshot - class(fraggle_fragments), allocatable :: fragments !! Fragments object at this snapshot - contains - procedure :: write_frame => fraggle_io_write_frame !! Writes a frame of encounter data to file - procedure :: get_idvals => fraggle_util_get_idvalues_snapshot !! Gets an array of all id values saved in this snapshot - final :: fraggle_util_final_snapshot - end type fraggle_snapshot interface module subroutine fraggle_generate_fragments(self, colliders, system, param, lfailure) use swiftest_classes, only : swiftest_nbody_system, swiftest_parameters implicit none class(fraggle_fragments), intent(inout) :: self !! Fraggle fragment system object - class(fraggle_colliders), intent(inout) :: colliders !! Fraggle colliders object containing the two-body equivalent values of the colliding bodies + class(collision_impactors), intent(inout) :: colliders !! Fraggle colliders object containing the two-body equivalent values of the colliding bodies class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters logical, intent(out) :: lfailure !! Answers the question: Should this have been a merger instead? end subroutine fraggle_generate_fragments - module subroutine fraggle_io_initialize_output(self, param) - implicit none - class(fraggle_io_parameters), intent(inout) :: self !! Parameters used to identify a particular NetCDF dataset - class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters - end subroutine fraggle_io_initialize_output - - module subroutine fraggle_io_write_frame(self, nc, param) - implicit none - class(fraggle_snapshot), intent(in) :: self !! Swiftest encounter structure - class(netcdf_parameters), intent(inout) :: nc !! Parameters used to identify a particular encounter io NetCDF dataset - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - end subroutine fraggle_io_write_frame - module subroutine fraggle_io_log_regime(colliders, fragments) + module subroutine fraggle_io_log_regime(impactors, fragments) implicit none - class(fraggle_colliders), intent(in) :: colliders + class(collision_impactors), intent(in) :: impactors class(fraggle_fragments), intent(in) :: fragments end subroutine fraggle_io_log_regime - !> The following interfaces are placeholders intended to satisfy the required abstract methods given by the parent class - module subroutine fraggle_placeholder_accel(self, system, param, t, lbeg) - use swiftest_classes, only : swiftest_nbody_system, swiftest_parameters - implicit none - class(fraggle_fragments), intent(inout) :: self !! Fraggle fragment system object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - real(DP), intent(in) :: t !! Current simulation time - logical, intent(in) :: lbeg !! Optional argument that determines whether or not this is the beginning or end of the step - end subroutine fraggle_placeholder_accel - - module subroutine fraggle_placeholder_kick(self, system, param, t, dt, lbeg) - use swiftest_classes, only : swiftest_nbody_system, swiftest_parameters - implicit none - class(fraggle_fragments), intent(inout) :: self !! Fraggle fragment system object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system objec - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - real(DP), intent(in) :: t !! Current time - real(DP), intent(in) :: dt !! Stepsize - logical, intent(in) :: lbeg !! Logical flag indicating whether this is the beginning of the half step or not. - end subroutine fraggle_placeholder_kick - - module subroutine fraggle_placeholder_step(self, system, param, t, dt) - use swiftest_classes, only : swiftest_nbody_system, swiftest_parameters - implicit none - class(fraggle_fragments), intent(inout) :: self !! Helio massive body particle object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - real(DP), intent(in) :: t !! Current simulation time - real(DP), intent(in) :: dt !! Stepsiz - end subroutine fraggle_placeholder_step - - module subroutine fraggle_regime_colliders(self, fragments, system, param) - implicit none - class(fraggle_colliders), intent(inout) :: self !! Fraggle colliders object - class(fraggle_fragments), intent(inout) :: fragments !! Fraggle fragment system object - class(swiftest_nbody_system), intent(in) :: system !! Swiftest nbody system object - class(swiftest_parameters), intent(in) :: param !! Current Swiftest run configuration parameters - end subroutine fraggle_regime_colliders - module subroutine fraggle_set_budgets_fragments(self) implicit none class(fraggle_fragments), intent(inout) :: self !! Fraggle fragment system object end subroutine fraggle_set_budgets_fragments - module subroutine fraggle_set_coordinate_system(self, colliders) - implicit none - class(fraggle_fragments), intent(inout) :: self !! Fraggle fragment system object - class(fraggle_colliders), intent(inout) :: colliders !! Fraggle collider system object - end subroutine fraggle_set_coordinate_system - - module subroutine fraggle_set_mass_dist_fragments(self, colliders, param) + module subroutine fraggle_set_mass_dist_fragments(self, impactors, param) implicit none class(fraggle_fragments), intent(inout) :: self !! Fraggle fragment system object - class(fraggle_colliders), intent(inout) :: colliders !! Fraggle collider system object + class(collision_impactors), intent(inout) :: impactors !! Fraggle collider system object class(swiftest_parameters), intent(in) :: param !! Current Swiftest run configuration parameters end subroutine fraggle_set_mass_dist_fragments - module subroutine fraggle_set_natural_scale_factors(self, colliders) + module subroutine fraggle_set_natural_scale_factors(self, impactors) implicit none class(fraggle_fragments), intent(inout) :: self !! Fraggle fragment system object - class(fraggle_colliders), intent(inout) :: colliders !! Fraggle collider system object + class(collision_impactors), intent(inout) :: impactors !! Fraggle collider system object end subroutine fraggle_set_natural_scale_factors - module subroutine fraggle_set_original_scale_factors(self, colliders) + module subroutine fraggle_set_original_scale_factors(self, impactors) implicit none class(fraggle_fragments), intent(inout) :: self !! Fraggle fragment system object - class(fraggle_colliders), intent(inout) :: colliders !! Fraggle collider system object + class(collision_impactors), intent(inout) :: impactors !! Fraggle collider system object end subroutine fraggle_set_original_scale_factors module subroutine fraggle_setup_fragments(self, n, param) implicit none - class(fraggle_fragments), intent(inout) :: self !! Fraggle fragment system object - integer(I4B), intent(in) :: n !! Number of fragments - class(swiftest_parameters), intent(in) :: param !! Current swiftest run configuration parameters + class(fraggle_fragments), intent(inout) :: self + integer(I4B), intent(in) :: n + class(swiftest_parameters), intent(in) :: param end subroutine fraggle_setup_fragments module subroutine fraggle_setup_reset_fragments(self) @@ -255,11 +108,11 @@ module subroutine fraggle_setup_reset_fragments(self) class(fraggle_fragments), intent(inout) :: self end subroutine fraggle_setup_reset_fragments - module subroutine fraggle_util_add_fragments_to_system(fragments, colliders, system, param) + module subroutine fraggle_util_add_fragments_to_system(fragments, impactors, system, param) use swiftest_classes, only : swiftest_nbody_system, swiftest_parameters implicit none class(fraggle_fragments), intent(in) :: fragments !! Fraggle fragment system object - class(fraggle_colliders), intent(in) :: colliders !! Fraggle collider system object + class(collision_impactors), intent(in) :: impactors !! Fraggle collider system object class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object class(swiftest_parameters), intent(in) :: param !! Current swiftest run configuration parameters end subroutine fraggle_util_add_fragments_to_system @@ -279,41 +132,21 @@ module subroutine fraggle_util_construct_temporary_system(fragments, system, par class(swiftest_parameters), allocatable, intent(out) :: tmpparam !! Output temporary configuration run parameters end subroutine fraggle_util_construct_temporary_system - module subroutine fraggle_util_final_colliders(self) + module subroutine fraggle_util_final_impactors(self) implicit none - type(fraggle_colliders), intent(inout) :: self !! Fraggle colliders object - end subroutine fraggle_util_final_colliders + type(collision_impactors), intent(inout) :: self !! Fraggle impactors object + end subroutine fraggle_util_final_impactors module subroutine fraggle_util_final_fragments(self) implicit none type(fraggle_fragments), intent(inout) :: self !! Fraggle frgments object end subroutine fraggle_util_final_fragments - module subroutine fraggle_util_final_snapshot(self) - implicit none - type(fraggle_snapshot), intent(inout) :: self !! Fraggle storage snapshot object - end subroutine fraggle_util_final_snapshot - - module subroutine fraggle_util_get_energy_momentum(self, colliders, system, param, lbefore) - use swiftest_classes, only : swiftest_nbody_system, swiftest_parameters - implicit none - class(fraggle_fragments), intent(inout) :: self !! Fraggle fragment system object - class(fraggle_colliders), intent(inout) :: colliders !! Fraggle collider system object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object - class(swiftest_parameters), intent(inout) :: param !! Current swiftest run configuration parameters - logical, intent(in) :: lbefore !! Flag indicating that this the "before" state of the system, with colliders included and fragments excluded or vice versa - end subroutine fraggle_util_get_energy_momentum - - module subroutine fraggle_util_get_idvalues_snapshot(self, idvals) - implicit none - class(fraggle_snapshot), intent(in) :: self !! Fraggle snapshot object - integer(I4B), dimension(:), allocatable, intent(out) :: idvals !! Array of all id values saved in this snapshot - end subroutine fraggle_util_get_idvalues_snapshot - module subroutine fraggle_util_restructure(self, colliders, try, f_spin, r_max_start) + module subroutine fraggle_util_restructure(self, impactors, try, f_spin, r_max_start) implicit none class(fraggle_fragments), intent(inout) :: self !! Fraggle fragment system object - class(fraggle_colliders), intent(in) :: colliders !! Fraggle collider system object + class(collision_impactors), intent(in) :: impactors !! Fraggle collider system object integer(I4B), intent(in) :: try !! The current number of times Fraggle has tried to find a solution real(DP), intent(inout) :: f_spin !! Fraction of energy/momentum that goes into spin. This decreases ater a failed attempt real(DP), intent(inout) :: r_max_start !! The maximum radial distance that the position calculation starts with. This increases after a failed attempt diff --git a/src/modules/swiftest.f90 b/src/modules/swiftest.f90 index edc41f134..8ca51ffdb 100644 --- a/src/modules/swiftest.f90 +++ b/src/modules/swiftest.f90 @@ -14,15 +14,16 @@ module swiftest !! This module serves to combine all of the Swiftest project modules under a single umbrella so that they can be accessed from individual submodule implementations with a simple "use swiftest" line. use swiftest_globals use swiftest_operators + use lambda_function use swiftest_classes use whm_classes use rmvs_classes use helio_classes use symba_classes + use encounter_classes + use collision_classes use fraggle_classes - use lambda_function use walltime_classes - use encounter_classes use io_progress_bar !use advisor_annotate !$ use omp_lib diff --git a/src/modules/swiftest_classes.f90 b/src/modules/swiftest_classes.f90 index a3bf66ad7..090446da8 100644 --- a/src/modules/swiftest_classes.f90 +++ b/src/modules/swiftest_classes.f90 @@ -347,8 +347,8 @@ 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 :: rh !! Swiftestcentric position - real(DP), dimension(:,:), allocatable :: vh !! Swiftestcentric velocity + real(DP), dimension(:,:), allocatable :: rh !! Heliocentric position + real(DP), dimension(:,:), allocatable :: vh !! Heliocentric velocity real(DP), dimension(:,:), allocatable :: rb !! Barycentric position real(DP), dimension(:,:), allocatable :: vb !! Barycentric velocity real(DP), dimension(:,:), allocatable :: ah !! Total heliocentric acceleration @@ -550,7 +550,6 @@ module swiftest_classes procedure :: read_in => io_read_in_system !! Reads the initial conditions for an nbody system procedure :: read_particle_info => netcdf_read_particle_info_system !! Read in particle metadata from file procedure :: obl_pot => obl_pot_system !! Compute the contribution to the total gravitational potential due solely to the oblateness of the central body - procedure :: finalize => setup_finalize_system !! Runs any finalization subroutines when ending the simulation. procedure :: initialize => setup_initialize_system !! Initialize the system from input files procedure :: init_particle_info => setup_initialize_particle_info_system !! Initialize the system from input files ! procedure :: step_spin => tides_step_spin_system !! Steps the spins of the massive & central bodies due to tides. @@ -1173,12 +1172,6 @@ module subroutine setup_construct_system(system, param) class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters end subroutine setup_construct_system - module subroutine setup_finalize_system(self, param) - implicit none - class(swiftest_nbody_system), intent(inout) :: self !! Swiftest system object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - end subroutine setup_finalize_system - module subroutine setup_initialize_particle_info_system(self, param) implicit none class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nbody system object diff --git a/src/modules/swiftest_globals.f90 b/src/modules/swiftest_globals.f90 index d9590b59e..fb669b559 100644 --- a/src/modules/swiftest_globals.f90 +++ b/src/modules/swiftest_globals.f90 @@ -95,14 +95,6 @@ module swiftest_globals integer(I4B), parameter :: NEW_PARTICLE = -15 integer(I4B), parameter :: OLD_PARTICLE = -16 - !>Symbolic names for collisional outcomes from collresolve_resolve: - integer(I4B), parameter :: COLLRESOLVE_REGIME_MERGE = 1 - integer(I4B), parameter :: COLLRESOLVE_REGIME_DISRUPTION = 2 - integer(I4B), parameter :: COLLRESOLVE_REGIME_SUPERCATASTROPHIC = 3 - integer(I4B), parameter :: COLLRESOLVE_REGIME_GRAZE_AND_MERGE = 4 - integer(I4B), parameter :: COLLRESOLVE_REGIME_HIT_AND_RUN = 5 - character(len=*),dimension(5), parameter :: REGIME_NAMES = ["Merge", "Disruption", "Supercatastrophic", "Graze and Merge", "Hit and Run"] - !> String labels for body/particle addition/subtraction in discard file character(*), parameter :: ADD = '+1' character(*), parameter :: SUB = '-1' diff --git a/src/modules/symba_classes.f90 b/src/modules/symba_classes.f90 index 507b16745..9e710c8fe 100644 --- a/src/modules/symba_classes.f90 +++ b/src/modules/symba_classes.f90 @@ -15,7 +15,7 @@ module symba_classes use swiftest_globals use swiftest_classes, only : swiftest_parameters, swiftest_base, swiftest_particle_info, swiftest_storage, netcdf_parameters use helio_classes, only : helio_cb, helio_pl, helio_tp, helio_nbody_system - use fraggle_classes, only : fraggle_colliders, fraggle_fragments + use fraggle_classes, only : collision_impactors, fraggle_fragments use encounter_classes, only : encounter_list, encounter_storage, collision_storage implicit none public @@ -84,7 +84,7 @@ module symba_classes real(DP), dimension(:), allocatable :: atp !! semimajor axis following perihelion passage type(symba_kinship), dimension(:), allocatable :: kin !! Array of merger relationship structures that can account for multiple pairwise mergers in a single step contains - procedure :: make_colliders => symba_collision_make_colliders_pl !! When a single body is involved in more than one collision in a single step, it becomes part of a family + procedure :: make_impactors => symba_collision_make_impactors_pl !! When a single body is involved in more than one collision in a single step, it becomes part of a family procedure :: flatten => symba_util_flatten_eucl_plpl !! Sets up the (i, j) -> k indexing used for the single-loop blocking Euclidean distance matrix procedure :: discard => symba_discard_pl !! Process massive body discards procedure :: drift => symba_drift_pl !! Method for Danby drift in Democratic Heliocentric coordinates. Sets the mask to the current recursion level @@ -189,7 +189,7 @@ module symba_classes 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(fraggle_colliders), allocatable :: colliders !! Fraggle colliders object + class(collision_impactors), allocatable :: impactors !! Fraggle impactors object class(fraggle_fragments), allocatable :: fragments !! Fraggle fragmentation system object contains procedure :: write_discard => symba_io_write_discard !! Write out information about discarded and merged planets and test particles in SyMBA @@ -224,11 +224,11 @@ module subroutine symba_collision_extract_collisions_from_encounters(self, syste class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters end subroutine - module subroutine symba_collision_make_colliders_pl(self,idx) + module subroutine symba_collision_make_impactors_pl(self,idx) implicit none class(symba_pl), intent(inout) :: self !! SyMBA massive body object integer(I4B), dimension(2), intent(in) :: idx !! Array holding the indices of the two bodies involved in the collision - end subroutine symba_collision_make_colliders_pl + end subroutine symba_collision_make_impactors_pl module subroutine symba_resolve_collision_plplenc(self, system, param, t, dt, irec) implicit none diff --git a/src/operators/operator_unit.f90 b/src/operators/operator_unit.f90 index e9c68f28f..8ba5d89e5 100644 --- a/src/operators/operator_unit.f90 +++ b/src/operators/operator_unit.f90 @@ -20,12 +20,16 @@ pure module function operator_unit_sp(A) result(B) implicit none ! Arguments real(SP), dimension(:), intent(in) :: A - real(SP), dimension(NDIM) :: B + real(SP), dimension(NDIM) :: B ! Internals real(SP) :: Amag Amag = norm2(A(:)) - B(:) = A(:) / Amag + if (Amag > tiny(1._SP)) then + B(:) = A(:) / Amag + else + B(:) = 0.0_SP + end if return end function operator_unit_sp @@ -40,7 +44,11 @@ pure module function operator_unit_dp(A) result(B) real(DP) :: Amag Amag = norm2(A(:)) - B(:) = A(:) / Amag + if (Amag > tiny(1._DP)) then + B(:) = A(:) / Amag + else + B(:) = 0.0_DP + end if return end function operator_unit_dp @@ -55,7 +63,11 @@ pure module function operator_unit_qp(A) result(B) real(QP) :: Amag Amag = norm2(A(:)) - B(:) = A(:) / Amag + if (Amag > tiny(1._QP)) then + B(:) = A(:) / Amag + else + B(:) = 0.0_QP + end if return end function operator_unit_qp @@ -67,7 +79,6 @@ pure module function operator_unit_el_sp(A) result(B) real(SP), dimension(:,:), intent(in) :: A real(SP), dimension(:,:), allocatable :: B ! Internals - real(SP) :: Amag integer(I4B) :: i,n n = size(A, 2) @@ -75,8 +86,7 @@ pure module function operator_unit_el_sp(A) result(B) allocate(B(NDIM,n)) do concurrent (i=1:n) - Amag = norm2(A(:, i)) - B(:,i) = A(:,i) / Amag + B(:,i) = operator_unit_sp(A(:,i)) end do return @@ -89,7 +99,6 @@ pure module function operator_unit_el_dp(A) result(B) real(DP), dimension(:,:), intent(in) :: A real(DP), dimension(:,:), allocatable :: B ! Internals - real(DP) :: Amag integer(I4B) :: i,n n = size(A, 2) @@ -97,8 +106,7 @@ pure module function operator_unit_el_dp(A) result(B) allocate(B(NDIM,n)) do concurrent (i=1:n) - Amag = norm2(A(:, i)) - B(:,i) = A(:,i) / Amag + B(:,i) = operator_unit_dp(A(:,i)) end do return @@ -110,7 +118,6 @@ pure module function operator_unit_el_qp(A) result(B) real(QP), dimension(:,:), intent(in) :: A real(QP), dimension(:,:), allocatable :: B ! Internals - real(QP) :: Amag integer(I4B) :: i,n n = size(A, 2) @@ -118,8 +125,7 @@ pure module function operator_unit_el_qp(A) result(B) allocate(B(NDIM,n)) do concurrent (i=1:n) - Amag = norm2(A(:, i)) - B(:,i) = A(:,i) / Amag + B(:,i) = operator_unit_qp(A(:,i)) end do return diff --git a/src/setup/setup.f90 b/src/setup/setup.f90 index c9ff0dc7d..353f60fb2 100644 --- a/src/setup/setup.f90 +++ b/src/setup/setup.f90 @@ -89,10 +89,10 @@ module subroutine setup_construct_system(system, param) allocate(collision_storage :: param%collision_history) associate (collision_history => param%collision_history) - allocate(fraggle_io_parameters :: collision_history%nc) + allocate(collision_io_parameters :: collision_history%nc) call collision_history%reset() select type(nc => collision_history%nc) - class is (fraggle_io_parameters) + class is (collision_io_parameters) nc%file_number = param%iloop / param%dump_cadence end select end associate @@ -106,32 +106,10 @@ module subroutine setup_construct_system(system, param) call util_exit(FAILURE) end select - - - - return end subroutine setup_construct_system - module subroutine setup_finalize_system(self, param) - !! author: David A. Minton - !! - !! Runs any finalization subroutines when ending the simulation. - !! - implicit none - ! Arguments - class(swiftest_nbody_system), intent(inout) :: self !! Swiftest system object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - - associate(system => self) - call param%system_history%nc%close() - end associate - - return - end subroutine setup_finalize_system - - module subroutine setup_initialize_particle_info_system(self, param) !! author: David A. Minton !! diff --git a/src/symba/symba_collision.f90 b/src/symba/symba_collision.f90 index e9c619d02..90d3847c4 100644 --- a/src/symba/symba_collision.f90 +++ b/src/symba/symba_collision.f90 @@ -30,7 +30,7 @@ module function symba_collision_casedisruption(system, param, t) result(status) character(len=STRMAX) :: message real(DP) :: dpe - associate(colliders => system%colliders, fragments => system%fragments) + associate(impactors => system%impactors, fragments => system%fragments) select case(fragments%regime) case(COLLRESOLVE_REGIME_DISRUPTION) @@ -38,14 +38,14 @@ module function symba_collision_casedisruption(system, param, t) result(status) case(COLLRESOLVE_REGIME_SUPERCATASTROPHIC) message = "Supercatastrophic disruption between" end select - call symba_collision_collider_message(system%pl, colliders%idx, message) + call symba_collision_collider_message(system%pl, impactors%idx, message) call io_log_one_message(FRAGGLE_LOG_OUT, message) ! Collisional fragments will be uniformly distributed around the pre-impact barycenter - call fragments%set_mass_dist(colliders, param) + call fragments%set_mass_dist(impactors, param) ! Generate the position and velocity distributions of the fragments - call fragments%generate_fragments(colliders, system, param, lfailure) + call fragments%generate_fragments(impactors, system, param, lfailure) dpe = fragments%pe_after - fragments%pe_before system%Ecollisions = system%Ecollisions - dpe @@ -57,9 +57,9 @@ module function symba_collision_casedisruption(system, param, t) result(status) nfrag = 0 select type(pl => system%pl) class is (symba_pl) - pl%status(colliders%idx(:)) = status - pl%ldiscard(colliders%idx(:)) = .false. - pl%lcollision(colliders%idx(:)) = .false. + pl%status(impactors%idx(:)) = status + pl%ldiscard(impactors%idx(:)) = .false. + pl%lcollision(impactors%idx(:)) = .false. end select else ! Populate the list of new bodies @@ -69,7 +69,7 @@ module function symba_collision_casedisruption(system, param, t) result(status) select case(fragments%regime) case(COLLRESOLVE_REGIME_DISRUPTION) status = DISRUPTION - ibiggest = colliders%idx(maxloc(system%pl%Gmass(colliders%idx(:)), dim=1)) + ibiggest = impactors%idx(maxloc(system%pl%Gmass(impactors%idx(:)), dim=1)) fragments%id(1) = system%pl%id(ibiggest) fragments%id(2:nfrag) = [(i, i = param%maxid + 1, param%maxid + nfrag - 1)] param%maxid = fragments%id(nfrag) @@ -105,12 +105,12 @@ module function symba_collision_casehitandrun(system, param, t) result(status) character(len=STRMAX) :: message real(DP) :: dpe - associate(colliders => system%colliders, fragments => system%fragments) + associate(impactors => system%impactors, fragments => system%fragments) message = "Hit and run between" - call symba_collision_collider_message(system%pl, colliders%idx, message) + call symba_collision_collider_message(system%pl, impactors%idx, message) call io_log_one_message(FRAGGLE_LOG_OUT, trim(adjustl(message))) - if (colliders%mass(1) > colliders%mass(2)) then + if (impactors%mass(1) > impactors%mass(2)) then jtarg = 1 jproj = 2 else @@ -118,16 +118,16 @@ module function symba_collision_casehitandrun(system, param, t) result(status) jproj = 1 end if - if (fragments%mass_dist(2) > 0.9_DP * colliders%mass(jproj)) then ! Pure hit and run, so we'll just keep the two bodies untouched + if (fragments%mass_dist(2) > 0.9_DP * impactors%mass(jproj)) then ! Pure hit and run, so we'll just keep the two bodies untouched call io_log_one_message(FRAGGLE_LOG_OUT, "Pure hit and run. No new fragments generated.") nfrag = 0 lpure = .true. else ! Imperfect hit and run, so we'll keep the largest body and destroy the other lpure = .false. - call fragments%set_mass_dist(colliders, param) + call fragments%set_mass_dist(impactors, param) ! Generate the position and velocity distributions of the fragments - call fragments%generate_fragments(colliders, system, param, lpure) + call fragments%generate_fragments(impactors, system, param, lpure) dpe = fragments%pe_after - fragments%pe_before system%Ecollisions = system%Ecollisions - dpe @@ -146,13 +146,13 @@ module function symba_collision_casehitandrun(system, param, t) result(status) status = HIT_AND_RUN_PURE select type(pl => system%pl) class is (symba_pl) - pl%status(colliders%idx(:)) = ACTIVE - pl%ldiscard(colliders%idx(:)) = .false. - pl%lcollision(colliders%idx(:)) = .false. + pl%status(impactors%idx(:)) = ACTIVE + pl%ldiscard(impactors%idx(:)) = .false. + pl%lcollision(impactors%idx(:)) = .false. end select - allocate(system%fragments%pl, source=system%colliders%pl) ! Be sure to save the pl so that snapshots still work + allocate(system%fragments%pl, source=system%impactors%pl) ! Be sure to save the pl so that snapshots still work else - ibiggest = colliders%idx(maxloc(system%pl%Gmass(colliders%idx(:)), dim=1)) + ibiggest = impactors%idx(maxloc(system%pl%Gmass(impactors%idx(:)), dim=1)) fragments%id(1) = system%pl%id(ibiggest) fragments%id(2:nfrag) = [(i, i = param%maxid + 1, param%maxid + nfrag - 1)] param%maxid = fragments%id(nfrag) @@ -187,37 +187,37 @@ module function symba_collision_casemerge(system, param, t) result(status) real(DP) :: dpe character(len=STRMAX) :: message - associate(colliders => system%colliders, fragments => system%fragments) + associate(impactors => system%impactors, fragments => system%fragments) message = "Merging" - call symba_collision_collider_message(system%pl, colliders%idx, message) + call symba_collision_collider_message(system%pl, impactors%idx, message) call io_log_one_message(FRAGGLE_LOG_OUT, message) select type(pl => system%pl) class is (symba_pl) - call fragments%set_mass_dist(colliders, param) + call fragments%set_mass_dist(impactors, param) ! Calculate the initial energy of the system without the collisional family - call fragments%get_energy_and_momentum(colliders, system, param, lbefore=.true.) + call fragments%get_energy_and_momentum(impactors, system, param, lbefore=.true.) - ibiggest = colliders%idx(maxloc(pl%Gmass(colliders%idx(:)), dim=1)) + ibiggest = impactors%idx(maxloc(pl%Gmass(impactors%idx(:)), dim=1)) fragments%id(1) = pl%id(ibiggest) fragments%rb(:,1) = fragments%rbcom(:) fragments%vb(:,1) = fragments%vbcom(:) if (param%lrotation) then ! Conserve angular momentum by putting pre-impact orbital momentum into spin of the new body - L_spin_new(:) = colliders%L_orbit(:,1) + colliders%L_orbit(:,2) + colliders%L_spin(:,1) + colliders%L_spin(:,2) + L_spin_new(:) = impactors%L_orbit(:,1) + impactors%L_orbit(:,2) + impactors%L_spin(:,1) + impactors%L_spin(:,2) ! Assume prinicpal axis rotation on 3rd Ip axis fragments%rot(:,1) = L_spin_new(:) / (fragments%Ip(3,1) * fragments%mass(1) * fragments%radius(1)**2) else ! If spin is not enabled, we will consider the lost pre-collision angular momentum as "escaped" and add it to our bookkeeping variable - system%Lescape(:) = system%Lescape(:) + colliders%L_orbit(:,1) + colliders%L_orbit(:,2) + system%Lescape(:) = system%Lescape(:) + impactors%L_orbit(:,1) + impactors%L_orbit(:,2) end if - ! Keep track of the component of potential energy due to the pre-impact colliders%idx for book-keeping + ! Keep track of the component of potential energy due to the pre-impact impactors%idx for book-keeping ! Get the energy of the system after the collision - call fragments%get_energy_and_momentum(colliders, system, param, lbefore=.false.) + call fragments%get_energy_and_momentum(impactors, system, param, lbefore=.false.) dpe = fragments%pe_after - fragments%pe_before system%Ecollisions = system%Ecollisions - dpe system%Euntracked = system%Euntracked + dpe @@ -225,8 +225,8 @@ module function symba_collision_casemerge(system, param, t) result(status) ! Update any encounter lists that have the removed bodies in them so that they instead point to the new do k = 1, system%plplenc_list%nenc - do j = 1, colliders%ncoll - i = colliders%idx(j) + do j = 1, impactors%ncoll + i = impactors%idx(j) if (i == ibiggest) cycle if (system%plplenc_list%id1(k) == pl%id(i)) then system%plplenc_list%id1(k) = pl%id(ibiggest) @@ -258,7 +258,7 @@ subroutine symba_collision_collider_message(pl, collidx, collider_message) implicit none ! Arguments class(swiftest_pl), intent(in) :: pl !! Swiftest massive body object - integer(I4B), dimension(:), intent(in) :: collidx !! Index of collisional colliders%idx members + integer(I4B), dimension(:), intent(in) :: collidx !! Index of collisional impactors%idx members character(*), intent(inout) :: collider_message !! The message to print to the screen. ! Internals integer(I4B) :: i, n @@ -375,7 +375,7 @@ module subroutine symba_collision_check_encounter(self, system, param, t, dt, ir self%v2(:,k) = pl%vb(:,j) if (lcollision(k)) then ! Check to see if either of these bodies has been involved with a collision before, and if so, make this a collider pair - if (pl%lcollision(i) .or. pl%lcollision(j)) call pl%make_colliders([i,j]) + if (pl%lcollision(i) .or. pl%lcollision(j)) call pl%make_impactors([i,j]) ! Set the collision flag for these to bodies to true in case they become involved in another collision later in the step pl%lcollision([i, j]) = .true. @@ -467,10 +467,10 @@ pure elemental subroutine symba_collision_check_one(xr, yr, zr, vxr, vyr, vzr, G end subroutine symba_collision_check_one - function symba_collision_consolidate_colliders(pl, cb, param, idx_parent, colliders) result(lflag) + function symba_collision_consolidate_impactors(pl, cb, param, idx_parent, impactors) result(lflag) !! author: David A. Minton !! - !! Loops through the pl-pl collision list and groups families together by index. Outputs the indices of all colliders%idx members, + !! Loops through the pl-pl collision list and groups families together by index. Outputs the indices of all impactors%idx members, !! and pairs of quantities (x and v vectors, mass, radius, L_spin, and Ip) that can be used to resolve the collisional outcome. implicit none ! Arguments @@ -478,9 +478,9 @@ function symba_collision_consolidate_colliders(pl, cb, param, idx_parent, collid class(symba_cb), intent(inout) :: cb !! SyMBA central body object class(symba_parameters), intent(in) :: param !! Current run configuration parameters with SyMBA additions integer(I4B), dimension(2), intent(inout) :: idx_parent !! Index of the two bodies considered the "parents" of the collision - class(fraggle_colliders), intent(out) :: colliders + class(collision_impactors), intent(out) :: impactors ! Result - logical :: lflag !! Logical flag indicating whether a colliders%idx was successfully created or not + logical :: lflag !! Logical flag indicating whether a impactors%idx was successfully created or not ! Internals type collidx_array integer(I4B), dimension(:), allocatable :: id @@ -488,7 +488,7 @@ function symba_collision_consolidate_colliders(pl, cb, param, idx_parent, collid end type collidx_array type(collidx_array), dimension(2) :: parent_child_index_array integer(I4B), dimension(2) :: nchild - integer(I4B) :: i, j, ncolliders, idx_child + integer(I4B) :: i, j, nimpactors, idx_child real(DP), dimension(2) :: volume, density real(DP) :: mchild, volchild real(DP), dimension(NDIM) :: xc, vc, xcom, vcom, xchild, vchild, xcrossv @@ -510,9 +510,9 @@ function symba_collision_consolidate_colliders(pl, cb, param, idx_parent, collid pl%kin(idx_parent(2))%parent = idx_parent(1) end if - colliders%mass(:) = pl%mass(idx_parent(:)) ! Note: This is meant to mass, not G*mass, as the collisional regime determination uses mass values that will be converted to Si - colliders%radius(:) = pl%radius(idx_parent(:)) - volume(:) = (4.0_DP / 3.0_DP) * PI * colliders%radius(:)**3 + impactors%mass(:) = pl%mass(idx_parent(:)) ! Note: This is meant to mass, not G*mass, as the collisional regime determination uses mass values that will be converted to Si + impactors%radius(:) = pl%radius(idx_parent(:)) + volume(:) = (4.0_DP / 3.0_DP) * PI * impactors%radius(:)**3 ! Group together the ids and indexes of each collisional parent and its children do j = 1, 2 @@ -528,24 +528,24 @@ function symba_collision_consolidate_colliders(pl, cb, param, idx_parent, collid end associate end do - ! Consolidate the groups of collsional parents with any children they may have into a single "colliders%idx" index array - ncolliders = 2 + sum(nchild(:)) - allocate(colliders%idx(ncolliders)) - colliders%idx = [parent_child_index_array(1)%idx(:),parent_child_index_array(2)%idx(:)] + ! Consolidate the groups of collsional parents with any children they may have into a single "impactors%idx" index array + nimpactors = 2 + sum(nchild(:)) + allocate(impactors%idx(nimpactors)) + impactors%idx = [parent_child_index_array(1)%idx(:),parent_child_index_array(2)%idx(:)] - colliders%ncoll = count(pl%lcollision(colliders%idx(:))) - colliders%idx = pack(colliders%idx(:), pl%lcollision(colliders%idx(:))) - colliders%L_spin(:,:) = 0.0_DP - colliders%Ip(:,:) = 0.0_DP + impactors%ncoll = count(pl%lcollision(impactors%idx(:))) + impactors%idx = pack(impactors%idx(:), pl%lcollision(impactors%idx(:))) + impactors%L_spin(:,:) = 0.0_DP + impactors%Ip(:,:) = 0.0_DP ! Find the barycenter of each body along with its children, if it has any do j = 1, 2 - colliders%rb(:, j) = pl%rh(:, idx_parent(j)) + cb%rb(:) - colliders%vb(:, j) = pl%vb(:, idx_parent(j)) + impactors%rb(:, j) = pl%rh(:, idx_parent(j)) + cb%rb(:) + impactors%vb(:, j) = pl%vb(:, idx_parent(j)) ! Assume principal axis rotation about axis corresponding to highest moment of inertia (3rd Ip) if (param%lrotation) then - colliders%Ip(:, j) = colliders%mass(j) * pl%Ip(:, idx_parent(j)) - colliders%L_spin(:, j) = colliders%Ip(3, j) * colliders%radius(j)**2 * pl%rot(:, idx_parent(j)) + impactors%Ip(:, j) = impactors%mass(j) * pl%Ip(:, idx_parent(j)) + impactors%L_spin(:, j) = impactors%Ip(3, j) * impactors%radius(j)**2 * pl%rot(:, idx_parent(j)) end if if (nchild(j) > 0) then @@ -560,49 +560,49 @@ function symba_collision_consolidate_colliders(pl, cb, param, idx_parent, collid ! Get angular momentum of the child-parent pair and add that to the spin ! Add the child's spin if (param%lrotation) then - xcom(:) = (colliders%mass(j) * colliders%rb(:,j) + mchild * xchild(:)) / (colliders%mass(j) + mchild) - vcom(:) = (colliders%mass(j) * colliders%vb(:,j) + mchild * vchild(:)) / (colliders%mass(j) + mchild) - xc(:) = colliders%rb(:, j) - xcom(:) - vc(:) = colliders%vb(:, j) - vcom(:) + xcom(:) = (impactors%mass(j) * impactors%rb(:,j) + mchild * xchild(:)) / (impactors%mass(j) + mchild) + vcom(:) = (impactors%mass(j) * impactors%vb(:,j) + mchild * vchild(:)) / (impactors%mass(j) + mchild) + xc(:) = impactors%rb(:, j) - xcom(:) + vc(:) = impactors%vb(:, j) - vcom(:) xcrossv(:) = xc(:) .cross. vc(:) - colliders%L_spin(:, j) = colliders%L_spin(:, j) + colliders%mass(j) * xcrossv(:) + impactors%L_spin(:, j) = impactors%L_spin(:, j) + impactors%mass(j) * xcrossv(:) xc(:) = xchild(:) - xcom(:) vc(:) = vchild(:) - vcom(:) xcrossv(:) = xc(:) .cross. vc(:) - colliders%L_spin(:, j) = colliders%L_spin(:, j) + mchild * xcrossv(:) + impactors%L_spin(:, j) = impactors%L_spin(:, j) + mchild * xcrossv(:) - colliders%L_spin(:, j) = colliders%L_spin(:, j) + mchild * pl%Ip(3, idx_child) & + impactors%L_spin(:, j) = impactors%L_spin(:, j) + mchild * pl%Ip(3, idx_child) & * pl%radius(idx_child)**2 & * pl%rot(:, idx_child) - colliders%Ip(:, j) = colliders%Ip(:, j) + mchild * pl%Ip(:, idx_child) + impactors%Ip(:, j) = impactors%Ip(:, j) + mchild * pl%Ip(:, idx_child) end if ! Merge the child and parent - colliders%mass(j) = colliders%mass(j) + mchild - colliders%rb(:, j) = xcom(:) - colliders%vb(:, j) = vcom(:) + impactors%mass(j) = impactors%mass(j) + mchild + impactors%rb(:, j) = xcom(:) + impactors%vb(:, j) = vcom(:) end do end if - density(j) = colliders%mass(j) / volume(j) - colliders%radius(j) = (3 * volume(j) / (4 * PI))**(1.0_DP / 3.0_DP) - if (param%lrotation) colliders%Ip(:, j) = colliders%Ip(:, j) / colliders%mass(j) + density(j) = impactors%mass(j) / volume(j) + impactors%radius(j) = (3 * volume(j) / (4 * PI))**(1.0_DP / 3.0_DP) + if (param%lrotation) impactors%Ip(:, j) = impactors%Ip(:, j) / impactors%mass(j) end do lflag = .true. - xcom(:) = (colliders%mass(1) * colliders%rb(:, 1) + colliders%mass(2) * colliders%rb(:, 2)) / sum(colliders%mass(:)) - vcom(:) = (colliders%mass(1) * colliders%vb(:, 1) + colliders%mass(2) * colliders%vb(:, 2)) / sum(colliders%mass(:)) - mxc(:, 1) = colliders%mass(1) * (colliders%rb(:, 1) - xcom(:)) - mxc(:, 2) = colliders%mass(2) * (colliders%rb(:, 2) - xcom(:)) - vcc(:, 1) = colliders%vb(:, 1) - vcom(:) - vcc(:, 2) = colliders%vb(:, 2) - vcom(:) - colliders%L_orbit(:,:) = mxc(:,:) .cross. vcc(:,:) + xcom(:) = (impactors%mass(1) * impactors%rb(:, 1) + impactors%mass(2) * impactors%rb(:, 2)) / sum(impactors%mass(:)) + vcom(:) = (impactors%mass(1) * impactors%vb(:, 1) + impactors%mass(2) * impactors%vb(:, 2)) / sum(impactors%mass(:)) + mxc(:, 1) = impactors%mass(1) * (impactors%rb(:, 1) - xcom(:)) + mxc(:, 2) = impactors%mass(2) * (impactors%rb(:, 2) - xcom(:)) + vcc(:, 1) = impactors%vb(:, 1) - vcom(:) + vcc(:, 2) = impactors%vb(:, 2) - vcom(:) + impactors%L_orbit(:,:) = mxc(:,:) .cross. vcc(:,:) - ! Destroy the kinship relationships for all members of this colliders%idx - call pl%reset_kinship(colliders%idx(:)) + ! Destroy the kinship relationships for all members of this impactors%idx + call pl%reset_kinship(impactors%idx(:)) return - end function symba_collision_consolidate_colliders + end function symba_collision_consolidate_impactors module subroutine symba_collision_extract_collisions_from_encounters(self, system, param) @@ -674,10 +674,10 @@ module subroutine symba_collision_extract_collisions_from_encounters(self, syste end subroutine symba_collision_extract_collisions_from_encounters - module subroutine symba_collision_make_colliders_pl(self, idx) + module subroutine symba_collision_make_impactors_pl(self, idx) !! author: Jennifer L.L. Pouplin, Carlisle A. wishard, and David A. Minton !! - !! When a single body is involved in more than one collision in a single step, it becomes part of a colliders%idx. + !! When a single body is involved in more than one collision in a single step, it becomes part of a impactors%idx. !! The largest body involved in a multi-body collision is the "parent" and all bodies that collide with it are its "children," !! including those that collide with the children. !! @@ -732,7 +732,7 @@ module subroutine symba_collision_make_colliders_pl(self, idx) end associate return - end subroutine symba_collision_make_colliders_pl + end subroutine symba_collision_make_impactors_pl subroutine symba_collision_mergeaddsub(system, param, t, status) @@ -747,7 +747,7 @@ subroutine symba_collision_mergeaddsub(system, param, t, status) real(DP), intent(in) :: t !! Time of collision integer(I4B), intent(in) :: status !! Status flag to assign to adds ! Internals - integer(I4B) :: i, ibiggest, ismallest, iother, nstart, nend, ncolliders, nfrag + integer(I4B) :: i, ibiggest, ismallest, iother, nstart, nend, nimpactors, nfrag logical, dimension(system%pl%nbody) :: lmask class(symba_pl), allocatable :: plnew, plsub character(*), parameter :: FRAGFMT = '("Newbody",I0.7)' @@ -757,9 +757,9 @@ subroutine symba_collision_mergeaddsub(system, param, t, status) class is (symba_pl) select type(pl_discards => system%pl_discards) class is (symba_merger) - associate(info => pl%info, pl_adds => system%pl_adds, cb => system%cb, npl => pl%nbody, colliders => system%colliders, fragments => system%fragments) - ! Add the colliders%idx bodies to the subtraction list - ncolliders = colliders%ncoll + associate(info => pl%info, pl_adds => system%pl_adds, cb => system%cb, npl => pl%nbody, impactors => system%impactors, fragments => system%fragments) + ! Add the impactors%idx bodies to the subtraction list + nimpactors = impactors%ncoll nfrag = fragments%nbody param%maxid_collision = max(param%maxid_collision, maxval(system%pl%info(:)%collision_id)) @@ -768,8 +768,8 @@ subroutine symba_collision_mergeaddsub(system, param, t, status) ! Setup new bodies allocate(plnew, mold=pl) call plnew%setup(nfrag, param) - ibiggest = colliders%idx(maxloc(pl%Gmass(colliders%idx(:)), dim=1)) - ismallest = colliders%idx(minloc(pl%Gmass(colliders%idx(:)), dim=1)) + ibiggest = impactors%idx(maxloc(pl%Gmass(impactors%idx(:)), dim=1)) + ismallest = impactors%idx(minloc(pl%Gmass(impactors%idx(:)), dim=1)) ! Copy over identification, information, and physical properties of the new bodies from the fragment list plnew%id(1:nfrag) = fragments%id(1:nfrag) @@ -796,13 +796,13 @@ subroutine symba_collision_mergeaddsub(system, param, t, status) 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) then + do i = 1, nimpactors + if (impactors%idx(i) == ibiggest) then iother = ismallest else iother = ibiggest end if - call pl%info(colliders%idx(i))%set_value(status="Supercatastrophic", discard_time=t, & + call pl%info(impactors%idx(i))%set_value(status="Supercatastrophic", discard_time=t, & discard_rh=pl%rh(:,i), discard_vh=pl%vh(:,i), & discard_body_id=iother) end do @@ -820,21 +820,21 @@ subroutine symba_collision_mergeaddsub(system, param, t, status) 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 + do i = 1, nimpactors + if (impactors%idx(i) == ibiggest) cycle iother = ibiggest - call pl%info(colliders%idx(i))%set_value(status=origin_type, discard_time=t, & + call pl%info(impactors%idx(i))%set_value(status=origin_type, discard_time=t, & discard_rh=pl%rh(:,i), discard_vh=pl%vh(:,i), & discard_body_id=iother) end do case(MERGED) call plnew%info(1)%copy(pl%info(ibiggest)) plnew%status(1) = OLD_PARTICLE - do i = 1, ncolliders - if (colliders%idx(i) == ibiggest) cycle + do i = 1, nimpactors + if (impactors%idx(i) == ibiggest) cycle iother = ibiggest - call pl%info(colliders%idx(i))%set_value(status="MERGED", discard_time=t, discard_rh=pl%rh(:,i), & + call pl%info(impactors%idx(i))%set_value(status="MERGED", discard_time=t, discard_rh=pl%rh(:,i), & discard_vh=pl%vh(:,i), discard_body_id=iother) end do end select @@ -874,11 +874,11 @@ subroutine symba_collision_mergeaddsub(system, param, t, status) pl_adds%ncomp(nstart:nend) = plnew%nbody ! Add the discarded bodies to the discard list - pl%status(colliders%idx(:)) = MERGED - pl%ldiscard(colliders%idx(:)) = .true. - pl%lcollision(colliders%idx(:)) = .true. + pl%status(impactors%idx(:)) = MERGED + pl%ldiscard(impactors%idx(:)) = .true. + pl%lcollision(impactors%idx(:)) = .true. lmask(:) = .false. - lmask(colliders%idx(:)) = .true. + lmask(impactors%idx(:)) = .true. call plnew%setup(0, param) deallocate(plnew) @@ -887,11 +887,11 @@ subroutine symba_collision_mergeaddsub(system, param, t, status) call pl%spill(plsub, lmask, ldestructive=.false.) nstart = pl_discards%nbody + 1 - nend = pl_discards%nbody + ncolliders - call pl_discards%append(plsub, lsource_mask=[(.true., i = 1, ncolliders)]) + nend = pl_discards%nbody + nimpactors + call pl_discards%append(plsub, lsource_mask=[(.true., i = 1, nimpactors)]) ! Record how many bodies were subtracted in this event - pl_discards%ncomp(nstart:nend) = ncolliders + pl_discards%ncomp(nstart:nend) = nimpactors call plsub%setup(0, param) deallocate(plsub) @@ -926,24 +926,24 @@ subroutine symba_resolve_collision(plplcollision_list , system, param, t) select type (cb => system%cb) class is (symba_cb) do i = 1, ncollisions - allocate(fraggle_colliders :: system%colliders) + allocate(collision_impactors :: system%impactors) allocate(fraggle_fragments :: system%fragments) idx_parent(1) = pl%kin(idx1(i))%parent idx_parent(2) = pl%kin(idx2(i))%parent - lgoodcollision = symba_collision_consolidate_colliders(pl, cb, param, idx_parent, system%colliders) + lgoodcollision = symba_collision_consolidate_impactors(pl, cb, param, idx_parent, system%impactors) if ((.not. lgoodcollision) .or. any(pl%status(idx_parent(:)) /= COLLISION)) cycle if (param%lfragmentation) then - call system%colliders%regime(system%fragments, system, param) + call system%impactors%regime(system%fragments, system, param) else - associate(fragments => system%fragments, colliders => system%colliders) + associate(fragments => system%fragments, impactors => system%impactors) fragments%regime = COLLRESOLVE_REGIME_MERGE - fragments%mtot = sum(colliders%mass(:)) + fragments%mtot = sum(impactors%mass(:)) fragments%mass_dist(1) = fragments%mtot fragments%mass_dist(2) = 0.0_DP fragments%mass_dist(3) = 0.0_DP - fragments%rbcom(:) = (colliders%mass(1) * colliders%rb(:,1) + colliders%mass(2) * colliders%rb(:,2)) / fragments%mtot - fragments%vbcom(:) = (colliders%mass(1) * colliders%vb(:,1) + colliders%mass(2) * colliders%vb(:,2)) / fragments%mtot + fragments%rbcom(:) = (impactors%mass(1) * impactors%rb(:,1) + impactors%mass(2) * impactors%rb(:,2)) / fragments%mtot + fragments%vbcom(:) = (impactors%mass(1) * impactors%vb(:,1) + impactors%mass(2) * impactors%vb(:,2)) / fragments%mtot end associate end if @@ -960,7 +960,7 @@ subroutine symba_resolve_collision(plplcollision_list , system, param, t) call util_exit(FAILURE) end select call collision_history%take_snapshot(param,system, t, "after") - deallocate(system%colliders,system%fragments) + deallocate(system%impactors,system%fragments) end do end select end select From 56d151266e173dd4fc03ad5ed14616c606bfb80e Mon Sep 17 00:00:00 2001 From: David A Minton Date: Fri, 16 Dec 2022 13:26:25 -0500 Subject: [PATCH 449/569] Fixed some typos --- src/CMakeLists.txt | 8 ++++---- src/modules/encounter_classes.f90 | 18 +++++++++++++++++- 2 files changed, 21 insertions(+), 5 deletions(-) diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index 5aa3c4f8f..5ada15b9b 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -26,10 +26,10 @@ SET(FAST_MATH_FILES ${SRC}/modules/symba_classes.f90 ${SRC}/modules/whm_classes.f90 ${SRC}/modules/swiftest.f90 - ${SRC}/fraggle/collision_io.f90 - ${SRC}/fraggle/collision_placeholder.f90 - ${SRC}/fraggle/collision_setup.f90 - ${SRC}/fraggle/collision_util.f90 + ${SRC}/collision/collision_io.f90 + ${SRC}/collision/collision_placeholder.f90 + ${SRC}/collision/collision_setup.f90 + ${SRC}/collision/collision_util.f90 ${SRC}/discard/discard.f90 ${SRC}/drift/drift.f90 ${SRC}/encounter/encounter_check.f90 diff --git a/src/modules/encounter_classes.f90 b/src/modules/encounter_classes.f90 index 0eb0dc3f7..84a7fdf4c 100644 --- a/src/modules/encounter_classes.f90 +++ b/src/modules/encounter_classes.f90 @@ -64,6 +64,17 @@ module encounter_classes final :: encounter_util_final_storage end type encounter_storage + !> NetCDF dimension and variable names for the enounter save object + type, extends(netcdf_parameters) :: encounter_io_parameters + character(NAMELEN) :: loop_varname = "loopnum" !! Loop number for encounter + integer(I4B) :: loop_varid !! ID for the recursion level variable + integer(I4B) :: time_dimsize = 0 !! Number of time values in snapshot + integer(I4B) :: name_dimsize = 0 !! Number of potential id values in snapshot + integer(I4B) :: file_number = 1 !! The number to append on the output file + contains + procedure :: initialize => encounter_io_initialize !! Initialize a set of parameters used to identify a NetCDF output object + end type encounter_io_parameters + 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) @@ -202,6 +213,12 @@ module subroutine encounter_io_dump(self, param) class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters end subroutine encounter_io_dump + module subroutine encounter_io_initialize(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 + module subroutine encounter_io_write_frame_snapshot(self, nc, param) implicit none class(encounter_snapshot), intent(in) :: self !! Swiftest encounter structure @@ -291,7 +308,6 @@ module subroutine encounter_util_snapshot(self, param, system, t, arg) character(*), intent(in), optional :: arg !! Optional argument (needed for extended storage type used in collision snapshots) end subroutine encounter_util_snapshot - module subroutine encounter_util_spill_list(self, discards, lspill_list, ldestructive) implicit none class(encounter_list), intent(inout) :: self !! Swiftest encounter list From e031a2e00a4bca04025d5c60d2bf90be5250a281 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Fri, 16 Dec 2022 15:07:02 -0500 Subject: [PATCH 450/569] Cleaning up after the restructuring --- src/CMakeLists.txt | 1 - src/collision/collision_io.f90 | 147 ++++++++++------- src/collision/collision_placeholder.f90 | 53 ------ src/collision/collision_setup.f90 | 35 +++- src/collision/collision_util.f90 | 207 ++++++++++++++---------- src/encounter/encounter_io.f90 | 98 ++++------- src/encounter/encounter_placeholder.f90 | 53 ------ src/fraggle/fraggle_generate.f90 | 25 ++- src/fraggle/fraggle_io.f90 | 4 +- src/fraggle/fraggle_regime.f90 | 4 +- src/fraggle/fraggle_set.f90 | 34 ++-- src/fraggle/fraggle_setup.f90 | 9 +- src/fraggle/fraggle_util.f90 | 54 +++++-- src/modules/collision_classes.f90 | 76 ++++----- src/modules/encounter_classes.f90 | 6 +- src/modules/fraggle_classes.f90 | 41 +++-- src/modules/swiftest_classes.f90 | 4 +- src/modules/symba_classes.f90 | 3 +- src/netcdf/netcdf.f90 | 12 +- src/symba/symba_collision.f90 | 30 ++-- 20 files changed, 436 insertions(+), 460 deletions(-) delete mode 100644 src/collision/collision_placeholder.f90 delete mode 100644 src/encounter/encounter_placeholder.f90 diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index 5ada15b9b..90ace7141 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -27,7 +27,6 @@ SET(FAST_MATH_FILES ${SRC}/modules/whm_classes.f90 ${SRC}/modules/swiftest.f90 ${SRC}/collision/collision_io.f90 - ${SRC}/collision/collision_placeholder.f90 ${SRC}/collision/collision_setup.f90 ${SRC}/collision/collision_util.f90 ${SRC}/discard/discard.f90 diff --git a/src/collision/collision_io.f90 b/src/collision/collision_io.f90 index 88c37cbbc..e22937577 100644 --- a/src/collision/collision_io.f90 +++ b/src/collision/collision_io.f90 @@ -12,7 +12,51 @@ contains - module subroutine collision_io_initialize(self, param) + + +module subroutine collision_io_dump(self, param) + !! author: David A. Minton + !! + !! Dumps the time history of an encounter to file. + implicit none + ! Arguments + class(collision_storage(*)), intent(inout) :: self !! Encounter storage object + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + ! Internals + integer(I4B) :: i + + select type(nc => self%nc) + class is (collision_io_parameters) + if (self%iframe > 0) then + nc%file_number = nc%file_number + 1 + call self%make_index_map() + nc%event_dimsize = self%nt + nc%name_dimsize = self%nid + + write(nc%file_name, '("collision_",I0.6,".nc")') nc%file_number + call nc%initialize(param) + + do i = 1, self%nframes + if (allocated(self%frame(i)%item)) then + select type(snapshot => self%frame(i)%item) + class is (collision_snapshot) + param%ioutput = i + call snapshot%write_frame(nc,param) + end select + else + exit + end if + end do + + call nc%close() + call self%reset() + end if + end select + + return +end subroutine collision_io_dump + + module subroutine collision_io_initialize_output(self, param) !! author: David A. Minton !! !! Initialize a NetCDF fragment history file system. This is a simplified version of the main simulation output NetCDF file, but with fewer variables. @@ -51,93 +95,93 @@ module subroutine collision_io_initialize(self, param) close(unit=LUN, status="delete") end if - call check( nf90_create(nc%file_name, NF90_NETCDF4, nc%id), "collision_io_initialize nf90_create" ) + call check( nf90_create(nc%file_name, NF90_NETCDF4, nc%id), "collision_io_initialize_output nf90_create" ) ! Dimensions - call check( nf90_def_dim(nc%id, nc%event_dimname, nc%event_dimsize, nc%event_dimid), "collision_io_initialize nf90_def_dim event_dimid" ) ! Dimension to store individual collision events - call check( nf90_def_dim(nc%id, nc%space_dimname, NDIM, nc%space_dimid), "collision_io_initialize nf90_def_dim space_dimid" ) ! 3D space dimension - call check( nf90_def_dim(nc%id, nc%name_dimname, nc%name_dimsize, nc%name_dimid), "collision_io_initialize nf90_def_dim name_dimid" ) ! Dimension to store particle id numbers - call check( nf90_def_dim(nc%id, nc%str_dimname, NAMELEN, nc%str_dimid), "collision_io_initialize nf90_def_dim str_dimid" ) ! Dimension for string variables (aka character arrays) - call check( nf90_def_dim(nc%id, nc%stage_dimname, 2, nc%stage_dimid), "collision_io_initialize nf90_def_dim stage_dimid" ) ! Dimension for stage variables (aka "before" vs. "after" + call check( nf90_def_dim(nc%id, nc%event_dimname, nc%event_dimsize, nc%event_dimid), "collision_io_initialize_output nf90_def_dim event_dimid" ) ! Dimension to store individual collision events + call check( nf90_def_dim(nc%id, nc%space_dimname, NDIM, nc%space_dimid), "collision_io_initialize_output nf90_def_dim space_dimid" ) ! 3D space dimension + call check( nf90_def_dim(nc%id, nc%name_dimname, nc%name_dimsize, nc%name_dimid), "collision_io_initialize_output nf90_def_dim name_dimid" ) ! Dimension to store particle id numbers + call check( nf90_def_dim(nc%id, nc%str_dimname, NAMELEN, nc%str_dimid), "collision_io_initialize_output nf90_def_dim str_dimid" ) ! Dimension for string variables (aka character arrays) + call check( nf90_def_dim(nc%id, nc%stage_dimname, 2, nc%stage_dimid), "collision_io_initialize_output nf90_def_dim stage_dimid" ) ! Dimension for stage variables (aka "before" vs. "after" ! Dimension coordinates - call check( nf90_def_var(nc%id, nc%space_dimname, NF90_CHAR, nc%space_dimid, nc%space_varid), "collision_io_initialize nf90_def_var space_varid" ) - call check( nf90_def_var(nc%id, nc%name_dimname, NF90_CHAR, [nc%str_dimid, nc%name_dimid], nc%name_varid), "collision_io_initialize nf90_def_var name_varid") - call check( nf90_def_var(nc%id, nc%stage_dimname, NF90_CHAR, [nc%str_dimid, nc%stage_dimid], nc%stage_varid), "collision_io_initialize nf90_def_var stage_varid" ) + call check( nf90_def_var(nc%id, nc%space_dimname, NF90_CHAR, nc%space_dimid, nc%space_varid), "collision_io_initialize_output nf90_def_var space_varid" ) + call check( nf90_def_var(nc%id, nc%name_dimname, NF90_CHAR, [nc%str_dimid, nc%name_dimid], nc%name_varid), "collision_io_initialize_output nf90_def_var name_varid") + call check( nf90_def_var(nc%id, nc%stage_dimname, NF90_CHAR, [nc%str_dimid, nc%stage_dimid], nc%stage_varid), "collision_io_initialize_output nf90_def_var stage_varid" ) ! Variables - call check( nf90_def_var(nc%id, nc%id_varname, NF90_INT, nc%name_dimid, nc%id_varid), "collision_io_initialize nf90_def_var id_varid" ) + call check( nf90_def_var(nc%id, nc%id_varname, NF90_INT, nc%name_dimid, nc%id_varid), "collision_io_initialize_output nf90_def_var id_varid" ) call check( nf90_def_var(nc%id, nc%time_dimname, nc%out_type, & - nc%event_dimid, nc%time_varid), "collision_io_initialize nf90_def_var time_varid" ) + nc%event_dimid, nc%time_varid), "collision_io_initialize_output nf90_def_var time_varid" ) call check( nf90_def_var(nc%id, nc%regime_varname, NF90_CHAR, & - [nc%str_dimid, nc%event_dimid], nc%regime_varid), "collision_io_initialize nf90_def_var regime_varid") + [nc%str_dimid, nc%event_dimid], nc%regime_varid), "collision_io_initialize_output nf90_def_var regime_varid") call check( nf90_def_var(nc%id, nc%Qloss_varname, nc%out_type, & - [ nc%event_dimid], nc%Qloss_varid), "collision_io_initialize nf90_def_var Qloss_varid") + [ nc%event_dimid], nc%Qloss_varid), "collision_io_initialize_output nf90_def_var Qloss_varid") call check( nf90_def_var(nc%id, nc%ptype_varname, NF90_CHAR, & - [nc%str_dimid, nc%name_dimid, nc%stage_dimid, nc%event_dimid], nc%ptype_varid), "collision_io_initialize nf90_def_var ptype_varid") + [nc%str_dimid, nc%name_dimid, nc%stage_dimid, nc%event_dimid], nc%ptype_varid), "collision_io_initialize_output nf90_def_var ptype_varid") call check( nf90_def_var(nc%id, nc%loop_varname, NF90_INT, & - [ nc%event_dimid], nc%loop_varid), "collision_io_initialize nf90_def_var loop_varid") + [ nc%event_dimid], nc%loop_varid), "collision_io_initialize_output nf90_def_var loop_varid") call check( nf90_def_var(nc%id, nc%rh_varname, nc%out_type,& - [ nc%space_dimid, nc%name_dimid, nc%stage_dimid, nc%event_dimid], nc%rh_varid), "collision_io_initialize nf90_def_var rh_varid") + [ nc%space_dimid, nc%name_dimid, nc%stage_dimid, nc%event_dimid], nc%rh_varid), "collision_io_initialize_output nf90_def_var rh_varid") call check( nf90_def_var(nc%id, nc%vh_varname, nc%out_type,& - [ nc%space_dimid, nc%name_dimid, nc%stage_dimid, nc%event_dimid], nc%vh_varid), "collision_io_initialize nf90_def_var vh_varid") + [ nc%space_dimid, nc%name_dimid, nc%stage_dimid, nc%event_dimid], nc%vh_varid), "collision_io_initialize_output nf90_def_var vh_varid") call check( nf90_def_var(nc%id, nc%Gmass_varname, nc%out_type,& - [ nc%name_dimid, nc%stage_dimid, nc%event_dimid], nc%Gmass_varid), "collision_io_initialize nf90_def_var Gmass_varid") + [ nc%name_dimid, nc%stage_dimid, nc%event_dimid], nc%Gmass_varid), "collision_io_initialize_output nf90_def_var Gmass_varid") call check( nf90_def_var(nc%id, nc%radius_varname, nc%out_type,& - [ nc%name_dimid, nc%stage_dimid, nc%event_dimid], nc%radius_varid), "collision_io_initialize nf90_def_var radius_varid") + [ nc%name_dimid, nc%stage_dimid, nc%event_dimid], nc%radius_varid), "collision_io_initialize_output nf90_def_var radius_varid") call check( nf90_def_var(nc%id, nc%Ip_varname, nc%out_type,& - [ nc%space_dimid, nc%name_dimid, nc%stage_dimid, nc%event_dimid], nc%Ip_varid), "collision_io_initialize nf90_def_var Ip_varid") + [ nc%space_dimid, nc%name_dimid, nc%stage_dimid, nc%event_dimid], nc%Ip_varid), "collision_io_initialize_output nf90_def_var Ip_varid") call check( nf90_def_var(nc%id, nc%rot_varname, nc%out_type,& - [ nc%space_dimid, nc%name_dimid, nc%stage_dimid, nc%event_dimid], nc%rot_varid), "collision_io_initialize nf90_def_var rot_varid") + [ nc%space_dimid, nc%name_dimid, nc%stage_dimid, nc%event_dimid], nc%rot_varid), "collision_io_initialize_output nf90_def_var rot_varid") if (param%lenergy) then call check( nf90_def_var(nc%id, nc%ke_orb_varname, nc%out_type,& - [ nc%stage_dimid, nc%event_dimid], nc%KE_orb_varid), "collision_io_initialize nf90_def_var KE_orb_varid") + [ nc%stage_dimid, nc%event_dimid], nc%KE_orb_varid), "collision_io_initialize_output nf90_def_var KE_orb_varid") call check( nf90_def_var(nc%id, nc%ke_spin_varname, nc%out_type,& - [ nc%stage_dimid, nc%event_dimid], nc%KE_spin_varid), "collision_io_initialize nf90_def_var KE_spin_varid" ) + [ nc%stage_dimid, nc%event_dimid], nc%KE_spin_varid), "collision_io_initialize_output nf90_def_var KE_spin_varid" ) call check( nf90_def_var(nc%id, nc%pe_varname, nc%out_type,& - [ nc%stage_dimid, nc%event_dimid], nc%PE_varid), "collision_io_initialize nf90_def_var PE_varid" ) + [ nc%stage_dimid, nc%event_dimid], nc%PE_varid), "collision_io_initialize_output nf90_def_var PE_varid" ) call check( nf90_def_var(nc%id, nc%L_orb_varname, nc%out_type, & - [ nc%space_dimid, nc%stage_dimid, nc%event_dimid], nc%L_orb_varid), "collision_io_initialize nf90_def_var L_orb_varid" ) + [ nc%space_dimid, nc%stage_dimid, nc%event_dimid], nc%L_orb_varid), "collision_io_initialize_output nf90_def_var L_orb_varid" ) - call check( nf90_def_var(nc%id, nc%L_spin_varname, nc%out_type,& - [ nc%space_dimid, nc%stage_dimid, nc%event_dimid], nc%L_spin_varid), "collision_io_initialize nf90_def_var L_spin_varid" ) + call check( nf90_def_var(nc%id, nc%Lspin_varname, nc%out_type,& + [ nc%space_dimid, nc%stage_dimid, nc%event_dimid], nc%Lspin_varid), "collision_io_initialize_output nf90_def_var Lspin_varid" ) end if - call check( nf90_inquire(nc%id, nVariables=nvar), "collision_io_initialize nf90_inquire nVariables" ) + call check( nf90_inquire(nc%id, nVariables=nvar), "collision_io_initialize_output nf90_inquire nVariables" ) do varid = 1, nvar - call check( nf90_inquire_variable(nc%id, varid, xtype=vartype, ndims=ndims), "collision_io_initialize nf90_inquire_variable" ) + call check( nf90_inquire_variable(nc%id, varid, xtype=vartype, ndims=ndims), "collision_io_initialize_output nf90_inquire_variable" ) select case(vartype) case(NF90_INT) - call check( nf90_def_var_fill(nc%id, varid, NO_FILL, NF90_FILL_INT), "collision_io_initialize nf90_def_var_fill NF90_INT" ) + call check( nf90_def_var_fill(nc%id, varid, NO_FILL, NF90_FILL_INT), "collision_io_initialize_output nf90_def_var_fill NF90_INT" ) case(NF90_FLOAT) - call check( nf90_def_var_fill(nc%id, varid, NO_FILL, sfill), "collision_io_initialize nf90_def_var_fill NF90_FLOAT" ) + call check( nf90_def_var_fill(nc%id, varid, NO_FILL, sfill), "collision_io_initialize_output nf90_def_var_fill NF90_FLOAT" ) case(NF90_DOUBLE) - call check( nf90_def_var_fill(nc%id, varid, NO_FILL, dfill), "collision_io_initialize nf90_def_var_fill NF90_DOUBLE" ) + call check( nf90_def_var_fill(nc%id, varid, NO_FILL, dfill), "collision_io_initialize_output nf90_def_var_fill NF90_DOUBLE" ) case(NF90_CHAR) - call check( nf90_def_var_fill(nc%id, varid, NO_FILL, 0), "collision_io_initialize nf90_def_var_fill NF90_CHAR" ) + call check( nf90_def_var_fill(nc%id, varid, NO_FILL, 0), "collision_io_initialize_output nf90_def_var_fill NF90_CHAR" ) end select end do ! Take the file out of define mode - call check( nf90_enddef(nc%id), "collision_io_initialize nf90_enddef" ) + call check( nf90_enddef(nc%id), "collision_io_initialize_output nf90_enddef" ) ! Add in the space and stage dimension coordinates - call check( nf90_put_var(nc%id, nc%space_varid, nc%space_coords, start=[1], count=[NDIM]), "collision_io_initialize nf90_put_var space" ) - call check( nf90_put_var(nc%id, nc%stage_varid, nc%stage_coords(1), start=[1,1], count=[len(nc%stage_coords(1)),1]), "collision_io_initialize nf90_put_var stage 1" ) - call check( nf90_put_var(nc%id, nc%stage_varid, nc%stage_coords(2), start=[1,2], count=[len(nc%stage_coords(2)),1]), "collision_io_initialize nf90_put_var stage 2" ) + call check( nf90_put_var(nc%id, nc%space_varid, nc%space_coords, start=[1], count=[NDIM]), "collision_io_initialize_output nf90_put_var space" ) + call check( nf90_put_var(nc%id, nc%stage_varid, nc%stage_coords(1), start=[1,1], count=[len(nc%stage_coords(1)),1]), "collision_io_initialize_output nf90_put_var stage 1" ) + call check( nf90_put_var(nc%id, nc%stage_varid, nc%stage_coords(2), start=[1,2], count=[len(nc%stage_coords(2)),1]), "collision_io_initialize_output nf90_put_var stage 2" ) end associate end select @@ -147,7 +191,7 @@ module subroutine collision_io_initialize(self, param) 667 continue write(*,*) "Error creating fragmentation output file. " // trim(adjustl(errmsg)) call util_exit(FAILURE) - end subroutine collision_io_initialize + end subroutine collision_io_initialize_output module subroutine collision_io_write_frame_snapshot(self, nc, param) @@ -169,23 +213,23 @@ module subroutine collision_io_write_frame_snapshot(self, nc, param) class is (collision_io_parameters) select type (param) class is (symba_parameters) - associate(impactors => self%impactors, fragments => self%fragments, collision_history => param%collision_history, eslot => param%ioutput) + associate(system => self%collision_system, impactors => self%collision_system%impactors, fragments => self%collision_system%fragments, collision_history => param%collision_history, eslot => param%ioutput) call check( nf90_set_fill(nc%id, nf90_nofill, old_mode), "collision_io_write_frame_snapshot nf90_set_fill" ) call check( nf90_put_var(nc%id, nc%time_varid, self%t, start=[eslot]), "collision_io_write_frame_snapshot nf90_put_var time_varid" ) call check( nf90_put_var(nc%id, nc%loop_varid, int(self%iloop,kind=I4B), start=[eslot]), "collision_io_write_frame_snapshot nf90_put_varloop_varid" ) - charstring = trim(adjustl(REGIME_NAMES(fragments%regime))) + charstring = trim(adjustl(REGIME_NAMES(impactors%regime))) call check( nf90_put_var(nc%id, nc%regime_varid, charstring, start=[1, eslot], count=[len(charstring), 1]), "collision_io_write_frame_snapshot nf90_put_var regime_varid" ) - call check( nf90_put_var(nc%id, nc%Qloss_varid, fragments%Qloss, start=[eslot] ), "collision_io_write_frame_snapshot nf90_put_var Qloss_varid" ) + call check( nf90_put_var(nc%id, nc%Qloss_varid, impactors%Qloss, start=[eslot] ), "collision_io_write_frame_snapshot nf90_put_var Qloss_varid" ) do stage = 1,2 if (allocated(pl)) deallocate(pl) select case(stage) case(1) - allocate(pl, source=impactors%pl) + allocate(pl, source=system%before%pl) case(2) - allocate(pl, source=fragments%pl) + allocate(pl, source=system%after%pl) end select npl = pl%nbody do i = 1, npl @@ -204,16 +248,11 @@ module subroutine collision_io_write_frame_snapshot(self, nc, param) end do end do if (param%lenergy) then - call check( nf90_put_var(nc%id, nc%ke_orb_varid, fragments%ke_orbit_before, start=[ 1, eslot]), "collision_io_write_frame_snapshot nf90_put_var ke_orb_varid before" ) - call check( nf90_put_var(nc%id, nc%ke_orb_varid, fragments%ke_orbit_after, start=[ 2, eslot]), "collision_io_write_frame_snapshot nf90_put_var ke_orb_varid after" ) - call check( nf90_put_var(nc%id, nc%ke_spin_varid, fragments%ke_spin_before, start=[ 1, eslot]), "collision_io_write_frame_snapshot nf90_put_var ke_spin_varid before" ) - call check( nf90_put_var(nc%id, nc%ke_spin_varid, fragments%ke_spin_after, start=[ 2, eslot]), "collision_io_write_frame_snapshot nf90_put_var ke_spin_varid after" ) - call check( nf90_put_var(nc%id, nc%pe_varid, fragments%pe_before, start=[ 1, eslot]), "collision_io_write_frame_snapshot nf90_put_var pe_varid before" ) - call check( nf90_put_var(nc%id, nc%pe_varid, fragments%pe_after, start=[ 2, eslot]), "collision_io_write_frame_snapshot nf90_put_var pe_varid after" ) - call check( nf90_put_var(nc%id, nc%L_orb_varid, fragments%Lorbit_before(:), start=[1, 1, eslot], count=[NDIM, 1, 1]), "collision_io_write_frame_snapshot nf90_put_var L_orb_varid before" ) - call check( nf90_put_var(nc%id, nc%L_orb_varid, fragments%Lorbit_after(:), start=[1, 2, eslot], count=[NDIM, 1, 1]), "collision_io_write_frame_snapshot nf90_put_var L_orb_varid after" ) - call check( nf90_put_var(nc%id, nc%L_spin_varid, fragments%Lspin_before(:), start=[1, 1, eslot], count=[NDIM, 1, 1]), "collision_io_write_frame_snapshot nf90_put_var L_spin_varid before" ) - call check( nf90_put_var(nc%id, nc%L_spin_varid, fragments%Lspin_after(:), start=[1, 2, eslot], count=[NDIM, 1, 1]), "collision_io_write_frame_snapshot nf90_put_var L_spin_varid after" ) + call check( nf90_put_var(nc%id, nc%ke_orb_varid, system%ke_orbit(:), start=[ 1, eslot], count=[ 2, 1]), "collision_io_write_frame_snapshot nf90_put_var ke_orb_varid before" ) + call check( nf90_put_var(nc%id, nc%ke_spin_varid, system%ke_spin(:), start=[ 1, eslot], count=[ 2, 1]), "collision_io_write_frame_snapshot nf90_put_var ke_spin_varid before" ) + call check( nf90_put_var(nc%id, nc%pe_varid, system%pe(:), start=[ 1, eslot], count=[ 2, 1]), "collision_io_write_frame_snapshot nf90_put_var pe_varid before" ) + call check( nf90_put_var(nc%id, nc%L_orb_varid, system%Lorbit(:,:), start=[1, 1, eslot], count=[NDIM, 2, 1]), "collision_io_write_frame_snapshot nf90_put_var L_orb_varid before" ) + call check( nf90_put_var(nc%id, nc%Lspin_varid, system%Lspin(:,:), start=[1, 1, eslot], count=[NDIM, 2, 1]), "collision_io_write_frame_snapshot nf90_put_var Lspin_varid before" ) end if call check( nf90_set_fill(nc%id, old_mode, old_mode) ) diff --git a/src/collision/collision_placeholder.f90 b/src/collision/collision_placeholder.f90 deleted file mode 100644 index 61ae6eebd..000000000 --- a/src/collision/collision_placeholder.f90 +++ /dev/null @@ -1,53 +0,0 @@ -!! Copyright 2022 - David Minton, Carlisle Wishard, Jennifer Pouplin, Jake Elliott, & Dana Singh -!! This file is part of Swiftest. -!! Swiftest is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License -!! as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. -!! Swiftest is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty -!! of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. -!! You should have received a copy of the GNU General Public License along with Swiftest. -!! If not, see: https://www.gnu.org/licenses. - -submodule(collision_classes) s_collision_placeholder - use swiftest - -contains - - !> The following interfaces are placeholders intended to satisfy the required abstract methods given by the parent class - module subroutine collision_placeholder_accel(self, system, param, t, lbeg) - implicit none - class(collision_fragments), intent(inout) :: self !! Fraggle fragment system object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - real(DP), intent(in) :: t !! Current simulation time - logical, intent(in) :: lbeg !! Optional argument that determines whether or not this is the beginning or end of the step - write(*,*) "The type-bound procedure 'accel' is not defined for the collision_fragments class" - return - end subroutine collision_placeholder_accel - - module subroutine collision_placeholder_kick(self, system, param, t, dt, lbeg) - implicit none - class(collision_fragments), intent(inout) :: self !! Fraggle fragment system object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system objec - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - real(DP), intent(in) :: t !! Current time - real(DP), intent(in) :: dt !! Stepsize - logical, intent(in) :: lbeg !! Logical flag indicating whether this is the beginning of the half step or not. - - write(*,*) "The type-bound procedure 'kick' is not defined for the collision_fragments class" - return - end subroutine collision_placeholder_kick - - module subroutine collision_placeholder_step(self, system, param, t, dt) - implicit none - class(collision_fragments), intent(inout) :: self !! Swiftest body object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest system object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - real(DP), intent(in) :: t !! Simulation time - real(DP), intent(in) :: dt !! Current stepsize - - write(*,*) "The type-bound procedure 'step' is not defined for the collision_fragments class" - return - end subroutine collision_placeholder_step - - -end submodule s_collision_placeholder \ No newline at end of file diff --git a/src/collision/collision_setup.f90 b/src/collision/collision_setup.f90 index 24d565472..287d74109 100644 --- a/src/collision/collision_setup.f90 +++ b/src/collision/collision_setup.f90 @@ -34,22 +34,41 @@ module subroutine collision_setup_fragments(self, n, param) ! Arguments class(collision_fragments), intent(inout) :: self integer(I4B), intent(in) :: n - class(swiftest_parameters), intent(in) :: param + class(swiftest_parameters), intent(in) :: param - call self%swiftest_pl%setup(n, param) if (n < 0) return call self%dealloc() if (n == 0) return - ! allocate(self%rotmag(n)) - ! allocate(self%v_r_mag(n)) - ! allocate(self%v_t_mag(n)) - ! allocate(self%v_n_mag(n)) - - call self%reset() + self%mtot = 0.0_DP + allocate(self%status(n)) + allocate(self%rb(NDIM,n)) + allocate(self%vb(NDIM,n)) + allocate(self%mass(n)) + allocate(self%rot(NDIM,n)) + allocate(self%Ip(NDIM,n)) + + allocate(self%rc(NDIM,n)) + allocate(self%vc(NDIM,n)) + allocate(self%vmag(n)) + allocate(self%rmag(n)) + allocate(self%rotmag(n)) + allocate(self%radius(n)) + allocate(self%density(n)) + + self%status(:) = INACTIVE + self%rb(:,:) = 0.0_DP + self%vb(:,:) = 0.0_DP + self%rc(:,:) = 0.0_DP + self%vc(:,:) = 0.0_DP + self%vmag(:) = 0.0_DP + self%rmag(:) = 0.0_DP + self%rotmag(:) = 0.0_DP + self%radius(:) = 0.0_DP + self%density(:) = 0.0_DP return end subroutine collision_setup_fragments diff --git a/src/collision/collision_util.f90 b/src/collision/collision_util.f90 index fc0926c91..55a8b23a1 100644 --- a/src/collision/collision_util.f90 +++ b/src/collision/collision_util.f90 @@ -7,36 +7,43 @@ !! You should have received a copy of the GNU General Public License along with Swiftest. !! If not, see: https://www.gnu.org/licenses. -submodule (encounter_classes) s_encounter_util +submodule (collision_classes) s_collision_util use swiftest contains - module subroutine collision_util_final_impactors(self) + module subroutine collision_util_dealloc_fragments(self) !! author: David A. Minton !! - !! Finalizer will deallocate all allocatables + !! Deallocates all allocatables implicit none ! Arguments - type(collision_impactors), intent(inout) :: self !! Collision impactors storage object + class(collision_fragments), intent(inout) :: self - call self%reset() + call util_dealloc_pl(self) - return - end subroutine collision_util_final_impactors + if (allocated(self%rc)) deallocate(self%rc) + if (allocated(self%vc)) deallocate(self%vc) + if (allocated(self%rmag)) deallocate(self%rmag) + if (allocated(self%rotmag)) deallocate(self%rotmag) + if (allocated(self%v_r_unit)) deallocate(self%v_r_unit) + if (allocated(self%v_t_unit)) deallocate(self%v_t_unit) + if (allocated(self%v_n_unit)) deallocate(self%v_n_unit) + return + end subroutine collision_util_dealloc_fragments - module subroutine collision_util_final_system(self) + module subroutine collision_util_final_impactors(self) !! author: David A. Minton !! !! Finalizer will deallocate all allocatables implicit none ! Arguments - type(collision_system), intent(inout) :: self !! Collision impactors storage object + type(collision_impactors), intent(inout) :: self !! Collision impactors storage object call self%reset() return - end subroutine collision_util_final_system + end subroutine collision_util_final_impactors module subroutine collision_util_final_snapshot(self) @@ -78,7 +85,7 @@ module subroutine collision_util_final_system(self) call self%reset() return - end subroutine collision_util_final_storage + end subroutine collision_util_final_system module subroutine collision_util_get_idvalues_snapshot(self, idvals) @@ -87,28 +94,41 @@ module subroutine collision_util_get_idvalues_snapshot(self, idvals) !! Returns an array of all id values saved in this snapshot implicit none ! Arguments - class(collision_snapshot), intent(in) :: self !! Fraggle snapshot object + class(collision_snapshot), intent(in) :: self !! Fraggle snapshot object integer(I4B), dimension(:), allocatable, intent(out) :: idvals !! Array of all id values saved in this snapshot ! Internals - integer(I4B) :: ncoll, nfrag + integer(I4B) :: npl_before, ntp_before, npl_after, ntp_after, ntot, nlo, nhi - if (allocated(self%impactors)) then - ncoll = self%impactors%pl%nbody - else - ncoll = 0 + npl_before = 0; ntp_before = 0; npl_after = 0; ntp_after = 0 + if (allocated(self%collision_system%before%pl)) then + npl_before = self%collision_system%before%pl%nbody + endif + + if (allocated(self%collision_system%before%tp)) then + ntp_before = self%collision_system%before%tp%nbody end if - if (allocated(self%fragments)) then - nfrag = self%fragments%pl%nbody - else - nfrag = 0 + if (allocated(self%collision_system%after%pl)) then + npl_after = self%collision_system%after%pl%nbody end if - if (ncoll + nfrag == 0) return - allocate(idvals(ncoll+nfrag)) + if (allocated(self%collision_system%after%tp)) then + ntp_after = self%collision_system%after%tp%nbody + end if + + ntot = npl_before + ntp_before + npl_after + ntp_after + if (ntot == 0) return + allocate(idvals(ntot)) - if (ncoll > 0) idvals(1:ncoll) = self%impactors%pl%id(:) - if (nfrag > 0) idvals(ncoll+1:ncoll+nfrag) = self%fragments%pl%id(:) + nlo = 1; nhi = npl_before + if (npl_before > 0) idvals(nlo:nhi) = self%collision_system%before%pl%id(1:npl_before) + nlo = nhi + 1; nhi = nhi + ntp_before + if (ntp_before > 0) idvals(nlo:nhi) = self%collision_system%before%tp%id(1:ntp_before) + + nlo = nhi + 1; nhi = nhi + npl_after + if (npl_after > 0) idvals(nlo:nhi) = self%collision_system%after%pl%id(1:npl_after) + nlo = nhi + 1; nhi = nhi + ntp_after + if (ntp_after > 0) idvals(nlo:nhi) = self%collision_system%after%tp%id(1:ntp_after) return @@ -124,14 +144,14 @@ module subroutine collision_util_get_energy_momentum(self, system, param, lbefo !! This will temporarily expand the massive body object in a temporary system object called tmpsys to feed it into symba_energy implicit none ! Arguments - class(collision_system), intent(inout) :: self !! Encounter collision system object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object - class(swiftest_parameters), intent(inout) :: param !! Current swiftest run configuration parameters - logical, intent(in) :: lbefore !! Flag indicating that this the "before" state of the system, with impactors included and fragments excluded or vice versa + class(collision_system), intent(inout) :: self !! Encounter collision system object + class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_parameters), intent(inout) :: param !! Current swiftest run configuration parameters + logical, intent(in) :: lbefore !! Flag indicating that this the "before" state of the system, with impactors included and fragments excluded or vice versa ! Internals class(swiftest_nbody_system), allocatable, save :: tmpsys class(swiftest_parameters), allocatable, save :: tmpparam - integer(I4B) :: npl_before, npl_after + integer(I4B) :: npl_before, npl_after, stage associate(fragments => self%fragments, impactors => self%impactors, nfrag => self%fragments%nbody, pl => system%pl, cb => system%cb) @@ -166,22 +186,18 @@ module subroutine collision_util_get_energy_momentum(self, system, param, lbefo ! Calculate the current fragment energy and momentum balances if (lbefore) then - fragments%Lorbit_before(:) = tmpsys%Lorbit(:) - fragments%Lspin_before(:) = tmpsys%Lspin(:) - fragments%Ltot_before(:) = tmpsys%Ltot(:) - fragments%ke_orbit_before = tmpsys%ke_orbit - fragments%ke_spin_before = tmpsys%ke_spin - fragments%pe_before = tmpsys%pe - fragments%Etot_before = tmpsys%te + stage = 1 else - fragments%Lorbit_after(:) = tmpsys%Lorbit(:) - fragments%Lspin_after(:) = tmpsys%Lspin(:) - fragments%Ltot_after(:) = tmpsys%Ltot(:) - fragments%ke_orbit_after = tmpsys%ke_orbit - fragments%ke_spin_after = tmpsys%ke_spin - fragments%pe_after = tmpsys%pe - fragments%Etot_after = tmpsys%te - (fragments%pe_after - fragments%pe_before) ! Gotta be careful with PE when number of bodies changes. + stage = 2 end if + self%Lorbit(:,stage) = tmpsys%Lorbit(:) + self%Lspin(:,stage) = tmpsys%Lspin(:) + self%Ltot(:,stage) = tmpsys%Ltot(:) + self%ke_orbit(stage) = tmpsys%ke_orbit + self%ke_spin(stage) = tmpsys%ke_spin + self%pe(stage) = tmpsys%pe + self%Etot(stage) = tmpsys%te + if (stage == 2) self%Etot(stage) = self%Etot(stage) - (self%pe(2) - self%pe(1)) ! Gotta be careful with PE when number of bodies changes. end associate return @@ -211,27 +227,42 @@ module subroutine collision_util_index_map(self) return end subroutine collision_util_index_map - - module subroutine collision_util_reset_fragments(self) - !! author: David A. Minton - !! - !! Deallocates all allocatables + !> The following interfaces are placeholders intended to satisfy the required abstract methods given by the parent class + module subroutine collision_util_placeholder_accel(self, system, param, t, lbeg) implicit none - ! Arguments - class(collision_fragments), intent(inout) :: self + class(collision_fragments), intent(inout) :: self !! Fraggle fragment system object + class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + real(DP), intent(in) :: t !! Current simulation time + logical, intent(in) :: lbeg !! Optional argument that determines whether or not this is the beginning or end of the step + write(*,*) "The type-bound procedure 'accel' is not defined for the collision_fragments class" + return + end subroutine collision_util_placeholder_accel - call self%swiftest_pl%dealloc() + module subroutine collision_util_placeholder_kick(self, system, param, t, dt, lbeg) + implicit none + class(collision_fragments), intent(inout) :: self !! Fraggle fragment system object + class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system objec + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + real(DP), intent(in) :: t !! Current time + real(DP), intent(in) :: dt !! Stepsize + logical, intent(in) :: lbeg !! Logical flag indicating whether this is the beginning of the half step or not. + + write(*,*) "The type-bound procedure 'kick' is not defined for the collision_fragments class" + return + end subroutine collision_util_placeholder_kick - if (allocated(self%rc)) deallocate(self%rc) - if (allocated(self%vc)) deallocate(self%vc) - if (allocated(self%rmag)) deallocate(self%rmag) - if (allocated(self%rotmag)) deallocate(self%rotmag) - if (allocated(self%v_r_unit)) deallocate(self%v_r_unit) - if (allocated(self%v_t_unit)) deallocate(self%v_t_unit) - if (allocated(self%v_n_unit)) deallocate(self%v_n_unit) + module subroutine collision_util_placeholder_step(self, system, param, t, dt) + implicit none + class(collision_fragments), intent(inout) :: self !! Swiftest body object + class(swiftest_nbody_system), intent(inout) :: system !! Swiftest system object + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + real(DP), intent(in) :: t !! Simulation time + real(DP), intent(in) :: dt !! Current stepsize + write(*,*) "The type-bound procedure 'step' is not defined for the collision_fragments class" return - end subroutine collision_util_reset_fragments + end subroutine collision_util_placeholder_step module subroutine collision_util_reset_impactors(self) @@ -244,25 +275,25 @@ module subroutine collision_util_reset_impactors(self) if (allocated(self%idx)) deallocate(self%idx) if (allocated(self%mass_dist)) deallocate(self%mass_dist) - ncoll = 0 - rb(:,:) = 0.0_DP - vb(:,:) = 0.0_DP - rot(:,:) = 0.0_DP - L_spin(:,:) = 0.0_DP - L_orbit(:,:) = 0.0_DP - Ip(:,:) = 0.0_DP - mass(:) = 0.0_DP - radius(:) = 0.0_DP - Qloss = 0.0_DP - regime = 0 - - x_unit(:) = 0.0_DP - y_unit(:) = 0.0_DP - z_unit(:) = 0.0_DP - v_unit(:) = 0.0_DP - rbcom(:) = 0.0_DP - vbcom(:) = 0.0_DP - rbimp(:) = 0.0_DP + self%ncoll = 0 + self%rb(:,:) = 0.0_DP + self%vb(:,:) = 0.0_DP + self%rot(:,:) = 0.0_DP + self%Lspin(:,:) = 0.0_DP + self%Lorbit(:,:) = 0.0_DP + self%Ip(:,:) = 0.0_DP + self%mass(:) = 0.0_DP + self%radius(:) = 0.0_DP + self%Qloss = 0.0_DP + self%regime = 0 + + self%x_unit(:) = 0.0_DP + self%y_unit(:) = 0.0_DP + self%z_unit(:) = 0.0_DP + self%v_unit(:) = 0.0_DP + self%rbcom(:) = 0.0_DP + self%vbcom(:) = 0.0_DP + self%rbimp(:) = 0.0_DP return end subroutine collision_util_reset_impactors @@ -281,16 +312,16 @@ module subroutine collision_util_reset_system(self) if (allocated(self%before)) deallocate(self%before) if (allocated(self%after)) deallocate(self%after) - Lorbit(:,:) = 0.0_DP - Lspin(:,:) = 0.0_DP - Ltot(:,:) = 0.0_DP - ke_orbit(:) = 0.0_DP - ke_spin(:) = 0.0_DP - pe(:) = 0.0_DP - Etot(:) = 0.0_DP + self%Lorbit(:,:) = 0.0_DP + self%Lspin(:,:) = 0.0_DP + self%Ltot(:,:) = 0.0_DP + self%ke_orbit(:) = 0.0_DP + self%ke_spin(:) = 0.0_DP + self%pe(:) = 0.0_DP + self%Etot(:) = 0.0_DP return - end subroutine collision_util_reset_impactors + end subroutine collision_util_reset_system subroutine collision_util_save_snapshot(collision_history, snapshot) @@ -338,4 +369,4 @@ subroutine collision_util_save_snapshot(collision_history, snapshot) end subroutine collision_util_save_snapshot -end submodule s_encounter_util \ No newline at end of file +end submodule s_collision_util \ No newline at end of file diff --git a/src/encounter/encounter_io.f90 b/src/encounter/encounter_io.f90 index fb84067ca..70b782948 100644 --- a/src/encounter/encounter_io.f90 +++ b/src/encounter/encounter_io.f90 @@ -11,50 +11,6 @@ use swiftest contains - - module subroutine collision_io_dump(self, param) - !! author: David A. Minton - !! - !! Dumps the time history of an encounter to file. - implicit none - ! Arguments - class(collision_storage(*)), intent(inout) :: self !! Encounter storage object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - ! Internals - integer(I4B) :: i - - select type(nc => self%nc) - class is (collision_io_parameters) - if (self%iframe > 0) then - nc%file_number = nc%file_number + 1 - call self%make_index_map() - nc%event_dimsize = self%nt - nc%name_dimsize = self%nid - - write(nc%file_name, '("collision_",I0.6,".nc")') nc%file_number - call nc%initialize(param) - - do i = 1, self%nframes - if (allocated(self%frame(i)%item)) then - select type(snapshot => self%frame(i)%item) - class is (collision_snapshot) - param%ioutput = i - call snapshot%write_frame(nc,param) - end select - else - exit - end if - end do - - call nc%close() - call self%reset() - end if - end select - - return - end subroutine collision_io_dump - - module subroutine encounter_io_dump(self, param) ! author: David A. Minton !! @@ -98,7 +54,7 @@ module subroutine encounter_io_dump(self, param) end subroutine encounter_io_dump - module subroutine encounter_io_initialize(self, param) + module subroutine encounter_io_initialize_output(self, param) !! author: David A. Minton !! !! Initialize a NetCDF encounter file system. This is a simplified version of the main simulation output NetCDF file, but with fewer variables. @@ -135,54 +91,54 @@ module subroutine encounter_io_initialize(self, param) close(unit=LUN, status="delete") end if - call check( nf90_create(nc%file_name, NF90_NETCDF4, nc%id), "encounter_io_initialize nf90_create" ) + call check( nf90_create(nc%file_name, NF90_NETCDF4, nc%id), "encounter_io_initialize_output nf90_create" ) ! Dimensions - call check( nf90_def_dim(nc%id, nc%time_dimname, nc%time_dimsize, nc%time_dimid), "encounter_io_initialize nf90_def_dim time_dimid" ) ! Simulation time dimension - call check( nf90_def_dim(nc%id, nc%space_dimname, NDIM, nc%space_dimid), "encounter_io_initialize nf90_def_dim space_dimid" ) ! 3D space dimension - call check( nf90_def_dim(nc%id, nc%name_dimname, nc%name_dimsize, nc%name_dimid), "encounter_io_initialize nf90_def_dim name_dimid" ) ! dimension to store particle id numbers - call check( nf90_def_dim(nc%id, nc%str_dimname, NAMELEN, nc%str_dimid), "encounter_io_initialize nf90_def_dim str_dimid" ) ! Dimension for string variables (aka character arrays) + call check( nf90_def_dim(nc%id, nc%time_dimname, nc%time_dimsize, nc%time_dimid), "encounter_io_initialize_output nf90_def_dim time_dimid" ) ! Simulation time dimension + call check( nf90_def_dim(nc%id, nc%space_dimname, NDIM, nc%space_dimid), "encounter_io_initialize_output nf90_def_dim space_dimid" ) ! 3D space dimension + call check( nf90_def_dim(nc%id, nc%name_dimname, nc%name_dimsize, nc%name_dimid), "encounter_io_initialize_output nf90_def_dim name_dimid" ) ! dimension to store particle id numbers + call check( nf90_def_dim(nc%id, nc%str_dimname, NAMELEN, nc%str_dimid), "encounter_io_initialize_output nf90_def_dim str_dimid" ) ! Dimension for string variables (aka character arrays) ! Dimension coordinates - call check( nf90_def_var(nc%id, nc%time_dimname, nc%out_type, nc%time_dimid, nc%time_varid), "encounter_io_initialize nf90_def_var time_varid" ) - call check( nf90_def_var(nc%id, nc%space_dimname, NF90_CHAR, nc%space_dimid, nc%space_varid), "encounter_io_initialize nf90_def_var space_varid" ) - call check( nf90_def_var(nc%id, nc%name_dimname, NF90_CHAR, [nc%str_dimid, nc%name_dimid], nc%name_varid), "encounter_io_initialize nf90_def_var id_varid" ) + call check( nf90_def_var(nc%id, nc%time_dimname, nc%out_type, nc%time_dimid, nc%time_varid), "encounter_io_initialize_output nf90_def_var time_varid" ) + call check( nf90_def_var(nc%id, nc%space_dimname, NF90_CHAR, nc%space_dimid, nc%space_varid), "encounter_io_initialize_output nf90_def_var space_varid" ) + call check( nf90_def_var(nc%id, nc%name_dimname, NF90_CHAR, [nc%str_dimid, nc%name_dimid], nc%name_varid), "encounter_io_initialize_output nf90_def_var id_varid" ) ! Variables - call check( nf90_def_var(nc%id, nc%id_varname, NF90_INT, nc%name_dimid, nc%id_varid), "encounter_io_initialize nf90_def_var id_varid" ) - call check( nf90_def_var(nc%id, nc%ptype_varname, NF90_CHAR, [nc%str_dimid, nc%name_dimid], nc%ptype_varid), "encounter_io_initialize nf90_def_var ptype_varid" ) - call check( nf90_def_var(nc%id, nc%rh_varname, nc%out_type, [nc%space_dimid, nc%name_dimid, nc%time_dimid], nc%rh_varid), "encounter_io_initialize nf90_def_var rh_varid" ) - call check( nf90_def_var(nc%id, nc%vh_varname, nc%out_type, [nc%space_dimid, nc%name_dimid, nc%time_dimid], nc%vh_varid), "encounter_io_initialize nf90_def_var vh_varid" ) - call check( nf90_def_var(nc%id, nc%Gmass_varname, nc%out_type, [nc%name_dimid, nc%time_dimid], nc%Gmass_varid), "encounter_io_initialize nf90_def_var Gmass_varid" ) - call check( nf90_def_var(nc%id, nc%loop_varname, NF90_INT, [nc%time_dimid], nc%loop_varid), "encounter_io_initialize nf90_def_var loop_varid" ) + call check( nf90_def_var(nc%id, nc%id_varname, NF90_INT, nc%name_dimid, nc%id_varid), "encounter_io_initialize_output nf90_def_var id_varid" ) + call check( nf90_def_var(nc%id, nc%ptype_varname, NF90_CHAR, [nc%str_dimid, nc%name_dimid], nc%ptype_varid), "encounter_io_initialize_output nf90_def_var ptype_varid" ) + call check( nf90_def_var(nc%id, nc%rh_varname, nc%out_type, [nc%space_dimid, nc%name_dimid, nc%time_dimid], nc%rh_varid), "encounter_io_initialize_output nf90_def_var rh_varid" ) + call check( nf90_def_var(nc%id, nc%vh_varname, nc%out_type, [nc%space_dimid, nc%name_dimid, nc%time_dimid], nc%vh_varid), "encounter_io_initialize_output nf90_def_var vh_varid" ) + call check( nf90_def_var(nc%id, nc%Gmass_varname, nc%out_type, [nc%name_dimid, nc%time_dimid], nc%Gmass_varid), "encounter_io_initialize_output nf90_def_var Gmass_varid" ) + call check( nf90_def_var(nc%id, nc%loop_varname, NF90_INT, [nc%time_dimid], nc%loop_varid), "encounter_io_initialize_output nf90_def_var loop_varid" ) if (param%lclose) then - call check( nf90_def_var(nc%id, nc%radius_varname, nc%out_type, [nc%name_dimid, nc%time_dimid], nc%radius_varid), "encounter_io_initialize nf90_def_var radius_varid" ) + call check( nf90_def_var(nc%id, nc%radius_varname, nc%out_type, [nc%name_dimid, nc%time_dimid], nc%radius_varid), "encounter_io_initialize_output nf90_def_var radius_varid" ) end if if (param%lrotation) then - call check( nf90_def_var(nc%id, nc%Ip_varname, nc%out_type, [nc%space_dimid, nc%name_dimid, nc%time_dimid], nc%Ip_varid), "encounter_io_initialize nf90_def_var Ip_varid" ) - call check( nf90_def_var(nc%id, nc%rot_varname, nc%out_type, [nc%space_dimid, nc%name_dimid, nc%time_dimid], nc%rot_varid), "encounter_io_initialize nf90_def_var rot_varid" ) + call check( nf90_def_var(nc%id, nc%Ip_varname, nc%out_type, [nc%space_dimid, nc%name_dimid, nc%time_dimid], nc%Ip_varid), "encounter_io_initialize_output nf90_def_var Ip_varid" ) + call check( nf90_def_var(nc%id, nc%rot_varname, nc%out_type, [nc%space_dimid, nc%name_dimid, nc%time_dimid], nc%rot_varid), "encounter_io_initialize_output nf90_def_var rot_varid" ) end if - call check( nf90_inquire(nc%id, nVariables=nvar), "encounter_io_initialize nf90_inquire nVariables" ) + call check( nf90_inquire(nc%id, nVariables=nvar), "encounter_io_initialize_output nf90_inquire nVariables" ) do varid = 1, nvar - call check( nf90_inquire_variable(nc%id, varid, xtype=vartype, ndims=ndims), "encounter_io_initialize nf90_inquire_variable" ) + call check( nf90_inquire_variable(nc%id, varid, xtype=vartype, ndims=ndims), "encounter_io_initialize_output nf90_inquire_variable" ) select case(vartype) case(NF90_INT) - call check( nf90_def_var_fill(nc%id, varid, NO_FILL, NF90_FILL_INT), "encounter_io_initialize nf90_def_var_fill NF90_INT" ) + call check( nf90_def_var_fill(nc%id, varid, NO_FILL, NF90_FILL_INT), "encounter_io_initialize_output nf90_def_var_fill NF90_INT" ) case(NF90_FLOAT) - call check( nf90_def_var_fill(nc%id, varid, NO_FILL, sfill), "encounter_io_initialize nf90_def_var_fill NF90_FLOAT" ) + call check( nf90_def_var_fill(nc%id, varid, NO_FILL, sfill), "encounter_io_initialize_output nf90_def_var_fill NF90_FLOAT" ) case(NF90_DOUBLE) - call check( nf90_def_var_fill(nc%id, varid, NO_FILL, dfill), "encounter_io_initialize nf90_def_var_fill NF90_DOUBLE" ) + call check( nf90_def_var_fill(nc%id, varid, NO_FILL, dfill), "encounter_io_initialize_output nf90_def_var_fill NF90_DOUBLE" ) case(NF90_CHAR) - call check( nf90_def_var_fill(nc%id, varid, NO_FILL, 0), "encounter_io_initialize nf90_def_var_fill NF90_CHAR" ) + call check( nf90_def_var_fill(nc%id, varid, NO_FILL, 0), "encounter_io_initialize_output nf90_def_var_fill NF90_CHAR" ) end select end do ! Take the file out of define mode - call check( nf90_enddef(nc%id), "encounter_io_initialize nf90_enddef" ) + call check( nf90_enddef(nc%id), "encounter_io_initialize_output nf90_enddef" ) ! Add in the space dimension coordinates - call check( nf90_put_var(nc%id, nc%space_varid, nc%space_coords, start=[1], count=[NDIM]), "encounter_io_initialize nf90_put_var space" ) + call check( nf90_put_var(nc%id, nc%space_varid, nc%space_coords, start=[1], count=[NDIM]), "encounter_io_initialize_output nf90_put_var space" ) end associate @@ -191,7 +147,7 @@ module subroutine encounter_io_initialize(self, param) 667 continue write(*,*) "Error creating encounter output file. " // trim(adjustl(errmsg)) call util_exit(FAILURE) - end subroutine encounter_io_initialize + end subroutine encounter_io_initialize_output module subroutine encounter_io_write_frame_snapshot(self, nc, param) diff --git a/src/encounter/encounter_placeholder.f90 b/src/encounter/encounter_placeholder.f90 deleted file mode 100644 index 61ae6eebd..000000000 --- a/src/encounter/encounter_placeholder.f90 +++ /dev/null @@ -1,53 +0,0 @@ -!! Copyright 2022 - David Minton, Carlisle Wishard, Jennifer Pouplin, Jake Elliott, & Dana Singh -!! This file is part of Swiftest. -!! Swiftest is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License -!! as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. -!! Swiftest is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty -!! of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. -!! You should have received a copy of the GNU General Public License along with Swiftest. -!! If not, see: https://www.gnu.org/licenses. - -submodule(collision_classes) s_collision_placeholder - use swiftest - -contains - - !> The following interfaces are placeholders intended to satisfy the required abstract methods given by the parent class - module subroutine collision_placeholder_accel(self, system, param, t, lbeg) - implicit none - class(collision_fragments), intent(inout) :: self !! Fraggle fragment system object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - real(DP), intent(in) :: t !! Current simulation time - logical, intent(in) :: lbeg !! Optional argument that determines whether or not this is the beginning or end of the step - write(*,*) "The type-bound procedure 'accel' is not defined for the collision_fragments class" - return - end subroutine collision_placeholder_accel - - module subroutine collision_placeholder_kick(self, system, param, t, dt, lbeg) - implicit none - class(collision_fragments), intent(inout) :: self !! Fraggle fragment system object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system objec - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - real(DP), intent(in) :: t !! Current time - real(DP), intent(in) :: dt !! Stepsize - logical, intent(in) :: lbeg !! Logical flag indicating whether this is the beginning of the half step or not. - - write(*,*) "The type-bound procedure 'kick' is not defined for the collision_fragments class" - return - end subroutine collision_placeholder_kick - - module subroutine collision_placeholder_step(self, system, param, t, dt) - implicit none - class(collision_fragments), intent(inout) :: self !! Swiftest body object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest system object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - real(DP), intent(in) :: t !! Simulation time - real(DP), intent(in) :: dt !! Current stepsize - - write(*,*) "The type-bound procedure 'step' is not defined for the collision_fragments class" - return - end subroutine collision_placeholder_step - - -end submodule s_collision_placeholder \ No newline at end of file diff --git a/src/fraggle/fraggle_generate.f90 b/src/fraggle/fraggle_generate.f90 index 4ad5c75d1..7c9cfa358 100644 --- a/src/fraggle/fraggle_generate.f90 +++ b/src/fraggle/fraggle_generate.f90 @@ -17,15 +17,14 @@ contains - module subroutine collision_generate_fragments(self, impactors, system, param, lfailure) + module subroutine fraggle_generate_fragments(self, system, param, lfailure) !! Author: Jennifer L.L. Pouplin, Carlisle A. Wishard, and David A. Minton !! !! Generates a system of fragments in barycentric coordinates that conserves energy and momentum. use, intrinsic :: ieee_exceptions implicit none ! Arguments - class(fraggle_fragments), intent(inout) :: self !! Fraggle system object the outputs will be the fragmentation - class(collision_impactors), intent(inout) :: impactors !! Fraggle impactors object containing the two-body equivalent values of the colliding bodies + class(fraggle_system), intent(inout) :: self !! Fraggle system object the outputs will be the fragmentation class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters logical, intent(out) :: lfailure !! Answers the question: Should this have been a merger instead? @@ -125,9 +124,9 @@ module subroutine collision_generate_fragments(self, impactors, system, param, l dLmag = .mag. (fragments%Ltot_after(:) - fragments%Ltot_before(:)) exit - lfailure = ((abs(dEtot + fragments%Qloss) > FRAGGLE_ETOL) .or. (dEtot > 0.0_DP)) + lfailure = ((abs(dEtot + impactors%Qloss) > FRAGGLE_ETOL) .or. (dEtot > 0.0_DP)) if (lfailure) then - write(message, *) dEtot, abs(dEtot + fragments%Qloss) / FRAGGLE_ETOL + write(message, *) dEtot, abs(dEtot + impactors%Qloss) / FRAGGLE_ETOL call io_log_one_message(FRAGGLE_LOG_OUT, "Fraggle failed due to high energy error: " // & trim(adjustl(message))) cycle @@ -166,7 +165,7 @@ module subroutine collision_generate_fragments(self, impactors, system, param, l call ieee_set_halting_mode(IEEE_ALL,fpe_halting_modes) ! Save the current halting modes so we can turn them off temporarily return - end subroutine collision_generate_fragments + end subroutine fraggle_generate_fragments subroutine fraggle_generate_pos_vec(fragments, impactors, r_max_start) @@ -190,8 +189,8 @@ subroutine fraggle_generate_pos_vec(fragments, impactors, r_max_start) associate(nfrag => fragments%nbody) allocate(loverlap(nfrag)) - lnoncat = (fragments%regime /= COLLRESOLVE_REGIME_SUPERCATASTROPHIC) ! For non-catastrophic impacts, make the fragments act like ejecta and point away from the impact point - lhitandrun = (fragments%regime == COLLRESOLVE_REGIME_HIT_AND_RUN) ! Disruptive hit and runs have their own fragment distribution + lnoncat = (impactors%regime /= COLLRESOLVE_REGIME_SUPERCATASTROPHIC) ! For non-catastrophic impacts, make the fragments act like ejecta and point away from the impact point + lhitandrun = (impactors%regime == COLLRESOLVE_REGIME_HIT_AND_RUN) ! Disruptive hit and runs have their own fragment distribution ! Place the fragments into a region that is big enough that we should usually not have overlapping bodies ! An overlapping bodies will collide in the next time step, so it's not a major problem if they do (it just slows the run down) @@ -279,12 +278,12 @@ subroutine fraggle_generate_spins(fragments, impactors, f_spin, lfailure) ke_remainder = fragments%ke_budget ! Add a fraction of the orbit angular momentum of the second body to the spin of the first body to kick things off - L(:) = impactors%L_spin(:,1) + f_spin * (impactors%L_orbit(:,2) + impactors%L_spin(:,2)) + L(:) = impactors%Lspin(:,1) + f_spin * (impactors%Lorbit(:,2) + impactors%Lspin(:,2)) fragments%rot(:,1) = L(:) / (fragments%mass(1) * fragments%radius(1)**2 * fragments%Ip(3,1)) L_remainder(:) = L_remainder(:) - L(:) ! Partition the spin momentum of the second body into the spin of the fragments, with some random variation - L(:) = impactors%L_spin(:,2) / (nfrag - 1) + L(:) = impactors%Lspin(:,2) / (nfrag - 1) call random_number(frot_rand(:,2:nfrag)) frot_rand(:,2:nfrag) = 2 * (frot_rand(:,2:nfrag) - 0.5_DP) * frot_rand_mag @@ -425,8 +424,8 @@ subroutine fraggle_generate_tan_vel(fragments, impactors, lfailure) if (lfailure) then call io_log_one_message(FRAGGLE_LOG_OUT, " ") call io_log_one_message(FRAGGLE_LOG_OUT, "Tangential velocity failure diagnostics") - call fragments%get_ang_mtm() - L_frag_tot = fragments%L_spin(:) + fragments%L_orbit(:) + call fragments%get_angular_momentum() + L_frag_tot = fragments%Lspin(:) + fragments%Lorbit(:) write(message, *) .mag.(fragments%L_budget(:) - L_frag_tot(:)) / (.mag.fragments%Ltot_before(:)) call io_log_one_message(FRAGGLE_LOG_OUT, "|L_remainder| : " // trim(adjustl(message))) write(message, *) fragments%ke_budget @@ -479,7 +478,7 @@ function solve_fragment_tan_vel(lfailure, v_t_mag_input) result(v_t_mag_output) end if end do b(1:3) = -L_lin_others(:) - b(4:6) = fragments%L_budget(:) - fragments%L_spin(:) - L_orb_others(:) + b(4:6) = fragments%L_budget(:) - fragments%Lspin(:) - L_orb_others(:) allocate(v_t_mag_output(nfrag)) v_t_mag_output(1:6) = util_solve_linear_system(A, b, 6, lfailure) if (present(v_t_mag_input)) v_t_mag_output(7:nfrag) = v_t_mag_input(:) diff --git a/src/fraggle/fraggle_io.f90 b/src/fraggle/fraggle_io.f90 index 1ddc4b4e9..c55db4173 100644 --- a/src/fraggle/fraggle_io.f90 +++ b/src/fraggle/fraggle_io.f90 @@ -30,7 +30,7 @@ module subroutine fraggle_io_log_regime(impactors, fragments) write(LUN, *) "--------------------------------------------------------------------" write(LUN, *) "True number of impactors : ",impactors%ncoll write(LUN, *) "Index list of true impactors : ",impactors%idx(1:impactors%ncoll) - select case(fragments%regime) + select case(impactors%regime) case(COLLRESOLVE_REGIME_MERGE) write(LUN, *) "Regime: Merge" case(COLLRESOLVE_REGIME_DISRUPTION) @@ -42,7 +42,7 @@ module subroutine fraggle_io_log_regime(impactors, fragments) case(COLLRESOLVE_REGIME_HIT_AND_RUN) write(LUN, *) "Regime: Hit and run" end select - write(LUN, *) "Energy loss : ", fragments%Qloss + write(LUN, *) "Energy loss : ", impactors%Qloss write(LUN, *) "--------------------------------------------------------------------" close(LUN) diff --git a/src/fraggle/fraggle_regime.f90 b/src/fraggle/fraggle_regime.f90 index 1563a4ccf..2873d236d 100644 --- a/src/fraggle/fraggle_regime.f90 +++ b/src/fraggle/fraggle_regime.f90 @@ -60,7 +60,7 @@ module subroutine encounter_regime_impactors(self, fragments, system, param) !! Use the positions and velocities of the parents from indside the step (at collision) to calculate the collisional regime call encounter_regime_collresolve(Mcb_si, mass_si(jtarg), mass_si(jproj), radius_si(jtarg), radius_si(jproj), & x1_si(:), x2_si(:), v1_si(:), v2_si(:), density_si(jtarg), density_si(jproj), & - min_mfrag_si, fragments%regime, mlr, mslr, fragments%Qloss) + min_mfrag_si, impactors%regime, mlr, mslr, impactors%Qloss) fragments%mass_dist(1) = min(max(mlr, 0.0_DP), mtot) fragments%mass_dist(2) = min(max(mslr, 0.0_DP), mtot) @@ -78,7 +78,7 @@ module subroutine encounter_regime_impactors(self, fragments, system, param) ! Convert quantities back to the system units and save them into the fragment system fragments%mass_dist(:) = (fragments%mass_dist(:) / param%MU2KG) - fragments%Qloss = fragments%Qloss * (param%TU2S / param%DU2M)**2 / param%MU2KG + impactors%Qloss = impactors%Qloss * (param%TU2S / param%DU2M)**2 / param%MU2KG call fraggle_io_log_regime(impactors, fragments) end associate diff --git a/src/fraggle/fraggle_set.f90 b/src/fraggle/fraggle_set.f90 index 122f593ab..fa0e28aeb 100644 --- a/src/fraggle/fraggle_set.f90 +++ b/src/fraggle/fraggle_set.f90 @@ -17,18 +17,18 @@ module subroutine fraggle_set_budgets_fragments(self) !! Sets the energy and momentum budgets of the fragments based on the collider values and the before/after values of energy and momentum implicit none ! Arguments - class(fraggle_fragments), intent(inout) :: self !! Fraggle fragment system object + class(collision_system), intent(inout) :: self !! Fraggle fragment system object ! Internals real(DP) :: dEtot real(DP), dimension(NDIM) :: dL - associate(fragments => self) + associate(impactors => self%impactors, fragments => self%fragments) - dEtot = fragments%Etot_after - fragments%Etot_before - dL(:) = fragments%Ltot_after(:) - fragments%Ltot_before(:) + dEtot = self%Etot(2) - self%Etot(1) + dL(:) = self%Ltot(:,2) - self%Ltot(:,1) fragments%L_budget(:) = -dL(:) - fragments%ke_budget = -(dEtot - 0.5_DP * fragments%mtot * dot_product(fragments%vbcom(:), fragments%vbcom(:))) - fragments%Qloss + fragments%ke_budget = -(dEtot - 0.5_DP * fragments%mtot * dot_product(fragments%vbcom(:), fragments%vbcom(:))) - impactors%Qloss end associate return @@ -71,7 +71,7 @@ module subroutine fraggle_set_mass_dist_fragments(self, impactors, param) jproj = 1 end if - select case(fragments%regime) + select case(impactors%regime) case(COLLRESOLVE_REGIME_DISRUPTION, COLLRESOLVE_REGIME_SUPERCATASTROPHIC, COLLRESOLVE_REGIME_HIT_AND_RUN) ! The first two bins of the mass_dist are the largest and second-largest fragments that came out of encounter_regime. ! The remainder from the third bin will be distributed among nfrag-2 bodies. The following code will determine nfrag based on @@ -110,7 +110,7 @@ module subroutine fraggle_set_mass_dist_fragments(self, impactors, param) if (param%lrotation) fragments%Ip(:, 1) = impactors%Ip(:,1) return case default - write(*,*) "fraggle_set_mass_dist_fragments error: Unrecognized regime code",fragments%regime + write(*,*) "fraggle_set_mass_dist_fragments error: Unrecognized regime code",impactors%regime end select ! Make the first two bins the same as the Mlr and Mslr values that came from encounter_regime @@ -139,7 +139,7 @@ module subroutine fraggle_set_mass_dist_fragments(self, impactors, param) fragments%mass(nfrag) = fragments%mass(nfrag) + mremaining ! Compute physical properties of the new fragments - select case(fragments%regime) + select case(impactors%regime) case(COLLRESOLVE_REGIME_HIT_AND_RUN) ! The hit and run case always preserves the largest body intact, so there is no need to recompute the physical properties of the first fragment fragments%radius(1) = impactors%radius(jtarg) fragments%density(1) = fragments%mass_dist(iMlr) / volume(jtarg) @@ -183,7 +183,7 @@ module subroutine encounter_set_coordinate_system(self, impactors) ! y-axis is the separation distance fragments%y_coll_unit(:) = .unit.delta_r(:) - Ltot = impactors%L_orbit(:,1) + impactors%L_orbit(:,2) + impactors%L_spin(:,1) + impactors%L_spin(:,2) + Ltot = impactors%Lorbit(:,1) + impactors%Lorbit(:,2) + impactors%Lspin(:,1) + impactors%Lspin(:,2) L_mag = .mag.Ltot(:) if (L_mag > sqrt(tiny(L_mag))) then @@ -249,24 +249,24 @@ module subroutine fraggle_set_natural_scale_factors(self, impactors) impactors%vb(:,:) = impactors%vb(:,:) / fragments%vscale impactors%mass(:) = impactors%mass(:) / fragments%mscale impactors%radius(:) = impactors%radius(:) / fragments%dscale - impactors%L_spin(:,:) = impactors%L_spin(:,:) / fragments%Lscale - impactors%L_orbit(:,:) = impactors%L_orbit(:,:) / fragments%Lscale + impactors%Lspin(:,:) = impactors%Lspin(:,:) / fragments%Lscale + impactors%Lorbit(:,:) = impactors%Lorbit(:,:) / fragments%Lscale do i = 1, 2 - impactors%rot(:,i) = impactors%L_spin(:,i) / (impactors%mass(i) * impactors%radius(i)**2 * impactors%Ip(3, i)) + impactors%rot(:,i) = impactors%Lspin(:,i) / (impactors%mass(i) * impactors%radius(i)**2 * impactors%Ip(3, i)) end do fragments%mtot = fragments%mtot / fragments%mscale fragments%mass = fragments%mass / fragments%mscale fragments%radius = fragments%radius / fragments%dscale - fragments%Qloss = fragments%Qloss / fragments%Escale + impactors%Qloss = impactors%Qloss / fragments%Escale end associate return end subroutine fraggle_set_natural_scale_factors - module subroutine fraggle_set_original_scale_factors(self, impactors) + module subroutine fraggle_set_original_scale_factors(self) !! author: David A. Minton !! !! Restores dimenional quantities back to the system units @@ -293,9 +293,9 @@ module subroutine fraggle_set_original_scale_factors(self, impactors) impactors%radius = impactors%radius * fragments%dscale impactors%rb = impactors%rb * fragments%dscale impactors%vb = impactors%vb * fragments%vscale - impactors%L_spin = impactors%L_spin * fragments%Lscale + impactors%Lspin = impactors%Lspin * fragments%Lscale do i = 1, 2 - impactors%rot(:,i) = impactors%L_spin(:,i) * (impactors%mass(i) * impactors%radius(i)**2 * impactors%Ip(3, i)) + impactors%rot(:,i) = impactors%Lspin(:,i) * (impactors%mass(i) * impactors%radius(i)**2 * impactors%Ip(3, i)) end do fragments%mtot = fragments%mtot * fragments%mscale @@ -310,7 +310,7 @@ module subroutine fraggle_set_original_scale_factors(self, impactors) fragments%vb(:, i) = fragments%v_coll(:, i) + fragments%vbcom(:) end do - fragments%Qloss = fragments%Qloss * fragments%Escale + impactors%Qloss = impactors%Qloss * fragments%Escale fragments%Lorbit_before(:) = fragments%Lorbit_before * fragments%Lscale fragments%Lspin_before(:) = fragments%Lspin_before * fragments%Lscale diff --git a/src/fraggle/fraggle_setup.f90 b/src/fraggle/fraggle_setup.f90 index 3d8916967..7b6551d88 100644 --- a/src/fraggle/fraggle_setup.f90 +++ b/src/fraggle/fraggle_setup.f90 @@ -22,8 +22,6 @@ module subroutine fraggle_setup_reset_fragments(self) self%rb(:,:) = 0.0_DP self%vb(:,:) = 0.0_DP self%rot(:,:) = 0.0_DP - self%r_coll(:,:) = 0.0_DP - self%v_coll(:,:) = 0.0_DP self%v_r_unit(:,:) = 0.0_DP self%v_t_unit(:,:) = 0.0_DP self%v_n_unit(:,:) = 0.0_DP @@ -33,11 +31,6 @@ module subroutine fraggle_setup_reset_fragments(self) self%v_r_mag(:) = 0.0_DP self%v_t_mag(:) = 0.0_DP - self%ke_orbit = 0.0_DP - self%ke_spin = 0.0_DP - self%L_orbit(:) = 0.0_DP - self%L_spin(:) = 0.0_DP - return end subroutine fraggle_setup_reset_fragments @@ -52,7 +45,7 @@ module subroutine fraggle_setup_fragments(self, n, param) integer(I4B), intent(in) :: n class(swiftest_parameters), intent(in) :: param - call self%collision_fragments%setup(n, param) + call collision_util_setup_fragments(n, param) if (n < 0) return if (allocated(self%v_r_mag)) deallocate(self%v_r_mag) diff --git a/src/fraggle/fraggle_util.f90 b/src/fraggle/fraggle_util.f90 index bb32167b1..4d1a203fb 100644 --- a/src/fraggle/fraggle_util.f90 +++ b/src/fraggle/fraggle_util.f90 @@ -59,7 +59,7 @@ module subroutine fraggle_util_add_fragments_to_system(fragments, impactors, sys end subroutine fraggle_util_add_fragments_to_system - module subroutine fraggle_util_ang_mtm(self) + module subroutine fraggle_util_get_angular_momentum(self) !! Author: David A. Minton !! !! Calcualtes the current angular momentum of the fragments @@ -70,17 +70,17 @@ module subroutine fraggle_util_ang_mtm(self) integer(I4B) :: i associate(fragments => self, nfrag => self%nbody) - fragments%L_orbit(:) = 0.0_DP - fragments%L_spin(:) = 0.0_DP + fragments%Lorbit(:) = 0.0_DP + fragments%Lspin(:) = 0.0_DP do i = 1, nfrag - fragments%L_orbit(:) = fragments%L_orbit(:) + fragments%mass(i) * (fragments%r_coll(:, i) .cross. fragments%v_coll(:, i)) - fragments%L_spin(:) = fragments%L_spin(:) + fragments%mass(i) * fragments%radius(i)**2 * fragments%Ip(:, i) * fragments%rot(:, i) + fragments%Lorbit(:) = fragments%Lorbit(:) + fragments%mass(i) * (fragments%rc(:, i) .cross. fragments%vc(:, i)) + fragments%Lspin(:) = fragments%Lspin(:) + fragments%mass(i) * fragments%radius(i)**2 * fragments%Ip(:, i) * fragments%rot(:, i) end do end associate return - end subroutine fraggle_util_ang_mtm + end subroutine fraggle_util_get_angular_momentum module subroutine fraggle_util_construct_temporary_system(fragments, system, param, tmpsys, tmpparam) @@ -131,6 +131,24 @@ module subroutine fraggle_util_construct_temporary_system(fragments, system, par end subroutine fraggle_util_construct_temporary_system + module subroutine fraggle_util_dealloc_fragments(self) + !! author: David A. Minton + !! + !! Deallocates all allocatables + implicit none + ! Arguments + class(fraggle_fragments), intent(inout) :: self + + call collision_util_deallocate_fragments(self) + + if (allocated(self%v_r_mag)) deallocate(self%v_r_mag) + if (allocated(self%v_t_mag)) deallocate(self%v_t_mag) + if (allocated(self%v_n_mag)) deallocate(self%v_n_mag) + + return + end subroutine fraggle_util_dealloc_fragments + + module subroutine fraggle_util_final_impactors(self) !! author: David A. Minton @@ -154,20 +172,26 @@ module subroutine fraggle_util_final_fragments(self) ! Arguments type(fraggle_fragments), intent(inout) :: self !! Fraggle encountar storage object - if (allocated(self%r_coll)) deallocate(self%r_coll) - if (allocated(self%v_coll)) deallocate(self%v_coll) - if (allocated(self%v_r_unit)) deallocate(self%v_r_unit) - if (allocated(self%v_t_unit)) deallocate(self%v_t_unit) - if (allocated(self%v_n_unit)) deallocate(self%v_n_unit) - if (allocated(self%rmag)) deallocate(self%rmag) - if (allocated(self%rotmag)) deallocate(self%rotmag) - if (allocated(self%v_r_mag)) deallocate(self%v_r_mag) - if (allocated(self%v_t_mag)) deallocate(self%v_t_mag) + call self%dealloc() return end subroutine fraggle_util_final_fragments + module subroutine fraggle_util_final_system(self) + !! author: David A. Minton + !! + !! Finalizer will deallocate all allocatables + implicit none + ! Arguments + type(fraggle_system), intent(inout) :: self !! Collision impactors storage object + + call self%reset() + + return + end subroutine fraggle_util_final_system + + module subroutine fraggle_util_restructure(self, impactors, try, f_spin, r_max_start) !! Author: David A. Minton !! diff --git a/src/modules/collision_classes.f90 b/src/modules/collision_classes.f90 index d3ede5fcb..d2d2bd9b1 100644 --- a/src/modules/collision_classes.f90 +++ b/src/modules/collision_classes.f90 @@ -36,8 +36,8 @@ module collision_classes real(DP), dimension(NDIM,2) :: rb !! Two-body equivalent position vectors of the collider bodies prior to collision real(DP), dimension(NDIM,2) :: vb !! Two-body equivalent velocity vectors of the collider bodies prior to collision real(DP), dimension(NDIM,2) :: rot !! Two-body equivalent principal axes moments of inertia the collider bodies prior to collision - real(DP), dimension(NDIM,2) :: L_spin !! Two-body equivalent spin angular momentum vectors of the collider bodies prior to collision - real(DP), dimension(NDIM,2) :: L_orbit !! Two-body equivalent orbital angular momentum vectors of the collider bodies prior to collision + real(DP), dimension(NDIM,2) :: Lspin !! Two-body equivalent spin angular momentum vectors of the collider bodies prior to collision + real(DP), dimension(NDIM,2) :: Lorbit !! Two-body equivalent orbital angular momentum vectors of the collider bodies prior to collision real(DP), dimension(NDIM,2) :: Ip !! Two-body equivalent principal axes moments of inertia the collider bodies prior to collision real(DP), dimension(2) :: mass !! Two-body equivalent mass of the collider bodies prior to the collision real(DP), dimension(2) :: radius !! Two-body equivalent radii of the collider bodies prior to the collision @@ -77,12 +77,12 @@ module collision_classes real(DP), dimension(:,:), allocatable :: v_n_unit !! Array of normal direction unit vectors of individual fragments in the collisional coordinate frame contains - procedure :: accel => collision_placeholder_accel !! Placeholder subroutine to fulfill requirement for an accel method - procedure :: kick => collision_placeholder_kick !! Placeholder subroutine to fulfill requirement for a kick method - procedure :: step => collision_placeholder_step !! Placeholder subroutine to fulfill requirement for a step method - procedure :: set_coordinate_system => collision_set_coordinate_fragments !! Defines the collisional coordinate system, including the unit vectors of both the system and individual fragments. - procedure :: setup => collision_setup_fragments !! Allocates arrays for n fragments in a Fraggle system. Passing n = 0 deallocates all arrays. - procedure :: reset => collision_util_reset_fragments !! Deallocates all allocatable arrays + procedure :: accel => collision_util_placeholder_accel !! Placeholder subroutine to fulfill requirement for an accel method + procedure :: kick => collision_util_placeholder_kick !! Placeholder subroutine to fulfill requirement for a kick method + procedure :: step => collision_util_placeholder_step !! Placeholder subroutine to fulfill requirement for a step method + procedure :: set_coordinate_system => collision_set_coordinate_fragments !! Defines the collisional coordinate system, including the unit vectors of both the system and individual fragments. + procedure :: setup => collision_setup_fragments !! Allocates arrays for n fragments in a Fraggle system. Passing n = 0 deallocates all arrays. + procedure :: dealloc => collision_util_dealloc_fragments !! Deallocates all allocatable arrays end type collision_fragments type :: collision_system @@ -97,12 +97,11 @@ module collision_classes real(DP), dimension(NDIM,2) :: Lorbit !! Before/after orbital angular momentum real(DP), dimension(NDIM,2) :: Lspin !! Before/after spin angular momentum real(DP), dimension(NDIM,2) :: Ltot !! Before/after total system angular momentum - real(DP), dimension(2) :: ke_orbit !! Before/after orbital kinetic energy - real(DP), dimension(2) :: ke_spin !! Before/after spin kinetic energy - real(DP), dimension(2) :: pe !! Before/after potential energy - real(DP), dimension(2) :: Etot !! Before/after total system energy + real(DP), dimension(2) :: ke_orbit !! Before/after orbital kinetic energy + real(DP), dimension(2) :: ke_spin !! Before/after spin kinetic energy + real(DP), dimension(2) :: pe !! Before/after potential energy + real(DP), dimension(2) :: Etot !! Before/after total system energy contains - procedure :: generate_fragments => collision_generate_fragment_system !! Generates a system of fragments in barycentric coordinates that conserves energy and momentum. procedure :: regime => collision_regime_system !! Determine which fragmentation regime the set of impactors will be procedure :: setup => collision_setup_system !! Initializer for the encounter collision system. Allocates the collider and fragments classes and the before/after snapshots procedure :: get_energy_and_momentum => collision_util_get_energy_momentum !! Calculates total system energy in either the pre-collision outcome state (lbefore = .true.) or the post-collision outcome state (lbefore = .false.) @@ -110,11 +109,25 @@ module collision_classes final :: collision_util_final_system !! Finalizer will deallocate all allocatables end type collision_system - - !> NetCDF dimension and variable names for the enounter save object + !! NetCDF dimension and variable names for the enounter save object type, extends(encounter_io_parameters) :: collision_io_parameters + integer(I4B) :: stage_dimid !! ID for the stage dimension + integer(I4B) :: stage_varid !! ID for the stage variable + character(NAMELEN) :: stage_dimname = "stage" !! name of the stage dimension (before/after) + character(len=6), dimension(2) :: stage_coords = ["before", "after"] !! The stage coordinate labels + + character(NAMELEN) :: event_dimname = "collision" !! Name of collision event dimension + integer(I4B) :: event_dimid !! ID for the collision event dimension + integer(I4B) :: event_varid !! ID for the collision event variable + integer(I4B) :: event_dimsize = 0 !! Number of events + + character(NAMELEN) :: Qloss_varname = "Qloss" !! name of the energy loss variable + integer(I4B) :: Qloss_varid !! ID for the energy loss variable + character(NAMELEN) :: regime_varname = "regime" !! name of the collision regime variable + integer(I4B) :: regime_varid !! ID for the collision regime variable + contains - procedure :: initialize => collision_io_initialize !! Initialize a set of parameters used to identify a NetCDF output object + procedure :: initialize => collision_io_initialize_output !! Initialize a set of parameters used to identify a NetCDF output object end type collision_io_parameters type, extends(encounter_snapshot) :: collision_snapshot @@ -136,26 +149,17 @@ module collision_classes end type collision_storage interface - module subroutine collision_generate_fragment_system(self, system, param, lfailure) - use swiftest_classes, only : swiftest_nbody_system, swiftest_parameters - implicit none - class(collision_system), intent(inout) :: self !! Fraggle fragment system object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - logical, intent(out) :: lfailure !! Answers the question: Should this have been a merger instead? - end subroutine collision_generate_fragment_system - module subroutine collision_io_dump(self, param) implicit none class(collision_storage(*)), intent(inout) :: self !! Collision storage object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters end subroutine collision_io_dump - module subroutine collision_io_initialize(self, param) + module subroutine collision_io_initialize_output(self, param) implicit none class(collision_io_parameters), intent(inout) :: self !! Parameters used to identify a particular NetCDF dataset class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters - end subroutine collision_io_initialize + end subroutine collision_io_initialize_output module subroutine collision_io_write_frame_snapshot(self, nc, param) implicit none @@ -165,7 +169,7 @@ module subroutine collision_io_write_frame_snapshot(self, nc, param) end subroutine collision_io_write_frame_snapshot !> The following interfaces are placeholders intended to satisfy the required abstract methods given by the parent class - module subroutine collision_placeholder_accel(self, system, param, t, lbeg) + module subroutine collision_util_placeholder_accel(self, system, param, t, lbeg) use swiftest_classes, only : swiftest_nbody_system, swiftest_parameters implicit none class(collision_fragments), intent(inout) :: self !! Fraggle fragment system object @@ -173,9 +177,9 @@ module subroutine collision_placeholder_accel(self, system, param, t, lbeg) class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! Current simulation time logical, intent(in) :: lbeg !! Optional argument that determines whether or not this is the beginning or end of the step - end subroutine collision_placeholder_accel + end subroutine collision_util_placeholder_accel - module subroutine collision_placeholder_kick(self, system, param, t, dt, lbeg) + module subroutine collision_util_placeholder_kick(self, system, param, t, dt, lbeg) use swiftest_classes, only : swiftest_nbody_system, swiftest_parameters implicit none class(collision_fragments), intent(inout) :: self !! Fraggle fragment system object @@ -184,9 +188,9 @@ module subroutine collision_placeholder_kick(self, system, param, t, dt, lbeg) real(DP), intent(in) :: t !! Current time real(DP), intent(in) :: dt !! Stepsize logical, intent(in) :: lbeg !! Logical flag indicating whether this is the beginning of the half step or not. - end subroutine collision_placeholder_kick + end subroutine collision_util_placeholder_kick - module subroutine collision_placeholder_step(self, system, param, t, dt) + module subroutine collision_util_placeholder_step(self, system, param, t, dt) use swiftest_classes, only : swiftest_nbody_system, swiftest_parameters implicit none class(collision_fragments), intent(inout) :: self !! Helio massive body particle object @@ -194,7 +198,7 @@ module subroutine collision_placeholder_step(self, system, param, t, dt) class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! Current simulation time real(DP), intent(in) :: dt !! Stepsiz - end subroutine collision_placeholder_step + end subroutine collision_util_placeholder_step module subroutine collision_regime_system(self, system, param) implicit none @@ -235,10 +239,10 @@ module subroutine collision_setup_system(self, system, param) class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters end subroutine collision_setup_system - module subroutine collision_util_reset_fragments(self) + module subroutine collision_util_dealloc_fragments(self) implicit none class(collision_fragments), intent(inout) :: self - end subroutine collision_util_reset_fragments + end subroutine collision_util_dealloc_fragments module subroutine collision_util_final_impactors(self) implicit none @@ -257,7 +261,7 @@ end subroutine collision_util_final_snapshot module subroutine collision_util_final_system(self) implicit none - type(collision_system), intent(inout) :: self !! Collision system object + type(collision_system), intent(inout) :: self !! Collision system object end subroutine collision_util_final_system module subroutine collision_util_get_idvalues_snapshot(self, idvals) diff --git a/src/modules/encounter_classes.f90 b/src/modules/encounter_classes.f90 index 84a7fdf4c..e3aa2f9fe 100644 --- a/src/modules/encounter_classes.f90 +++ b/src/modules/encounter_classes.f90 @@ -72,7 +72,7 @@ module encounter_classes integer(I4B) :: name_dimsize = 0 !! Number of potential id values in snapshot integer(I4B) :: file_number = 1 !! The number to append on the output file contains - procedure :: initialize => encounter_io_initialize !! Initialize a set of parameters used to identify a NetCDF output object + procedure :: initialize => encounter_io_initialize_output !! Initialize a set of parameters used to identify a NetCDF output object end type encounter_io_parameters type encounter_bounding_box_1D @@ -213,11 +213,11 @@ module subroutine encounter_io_dump(self, param) class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters end subroutine encounter_io_dump - module subroutine encounter_io_initialize(self, param) + 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 + end subroutine encounter_io_initialize_output module subroutine encounter_io_write_frame_snapshot(self, nc, param) implicit none diff --git a/src/modules/fraggle_classes.f90 b/src/modules/fraggle_classes.f90 index 6ef73ffb1..b8a558af8 100644 --- a/src/modules/fraggle_classes.f90 +++ b/src/modules/fraggle_classes.f90 @@ -27,10 +27,14 @@ module fraggle_classes !> Class definition for the variables that describe a collection of fragments by Fraggle barycentric coordinates type, extends(collision_fragments) :: fraggle_fragments - real(DP), dimension(:), allocatable :: v_r_mag !! Array of radial direction velocity magnitudes of individual fragments - real(DP), dimension(:), allocatable :: v_t_mag !! Array of tangential direction velocity magnitudes of individual fragments - real(DP), dimension(:), allocatable :: v_n_mag !! Array of normal direction velocity magnitudes of individual fragments - + real(DP), dimension(:), allocatable :: v_r_mag !! Array of radial direction velocity magnitudes of individual fragments + real(DP), dimension(:), allocatable :: v_t_mag !! Array of tangential direction velocity magnitudes of individual fragments + real(DP), dimension(:), allocatable :: v_n_mag !! Array of normal direction velocity magnitudes of individual fragments + real(DP), dimension(NDIM) :: Lorbit !! Orbital angular momentum vector of all fragments + real(DP), dimension(NDIM) :: Lspin !! Spin angular momentum vector of all fragments + real(DP) :: ke_orbit !! Orbital kinetic energy of all fragments + real(DP) :: ke_spin !! Spin kinetic energy of all fragments + real(DP) :: ke_budget !! Kinetic energy budget for computing quanities ! Scale factors used to scale dimensioned quantities to a more "natural" system where important quantities (like kinetic energy, momentum) are of order ~1 real(DP) :: dscale = 1.0_DP !! Distance dimension scale factor @@ -40,32 +44,36 @@ module fraggle_classes real(DP) :: Escale = 1.0_DP !! Energy scale factor (a convenience unit that is derived from dscale, tscale, and mscale) real(DP) :: Lscale = 1.0_DP !! Angular momentum scale factor (a convenience unit that is derived from dscale, tscale, and mscale) contains - procedure :: generate_fragments => fraggle_generate_fragments !! Generates a system of fragments in barycentric coordinates that conserves energy and momentum. procedure :: set_budgets => fraggle_set_budgets_fragments !! Sets the energy and momentum budgets of the fragments based on the collider value procedure :: set_mass_dist => fraggle_set_mass_dist_fragments !! Sets the distribution of mass among the fragments depending on the regime type procedure :: set_natural_scale => fraggle_set_natural_scale_factors !! Scales dimenional quantities to ~O(1) with respect to the collisional system. procedure :: set_original_scale => fraggle_set_original_scale_factors !! Restores dimenional quantities back to the original system units procedure :: setup => fraggle_setup_fragments !! Allocates arrays for n fragments in a Fraggle system. Passing n = 0 deallocates all arrays. procedure :: reset => fraggle_setup_reset_fragments !! Resets all position and velocity-dependent fragment quantities in order to do a fresh calculation (does not reset mass, radius, or other values that get set prior to the call to fraggle_generate) - procedure :: get_ang_mtm => fraggle_util_ang_mtm !! Calcualtes the current angular momentum of the fragments + procedure :: get_angular_momentum => fraggle_util_get_angular_momentum !! Calcualtes the current angular momentum of the fragments + procedure :: dealloc => fraggle_util_dealloc_fragments !! Deallocates all allocatables procedure :: restructure => fraggle_util_restructure !! Restructure the inputs after a failed attempt failed to find a set of positions and velocities that satisfy the energy and momentum constraints final :: fraggle_util_final_fragments !! Finalizer will deallocate all allocatables end type fraggle_fragments + type, extends(collision_system) :: fraggle_system + contains + procedure :: generate_fragments => fraggle_generate_fragments !! Generates a system of fragments in barycentric coordinates that conserves energy and momentum. + final :: fraggle_util_final_system !! Finalizer will deallocate all allocatables + end type fraggle_system + interface - module subroutine fraggle_generate_fragments(self, colliders, system, param, lfailure) + module subroutine fraggle_generate_fragments(self, system, param, lfailure) use swiftest_classes, only : swiftest_nbody_system, swiftest_parameters implicit none - class(fraggle_fragments), intent(inout) :: self !! Fraggle fragment system object - class(collision_impactors), intent(inout) :: colliders !! Fraggle colliders object containing the two-body equivalent values of the colliding bodies + class(fraggle_system), intent(inout) :: self !! Fraggle fragment system object class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters logical, intent(out) :: lfailure !! Answers the question: Should this have been a merger instead? end subroutine fraggle_generate_fragments - module subroutine fraggle_io_log_regime(impactors, fragments) implicit none class(collision_impactors), intent(in) :: impactors @@ -117,10 +125,10 @@ module subroutine fraggle_util_add_fragments_to_system(fragments, impactors, sys class(swiftest_parameters), intent(in) :: param !! Current swiftest run configuration parameters end subroutine fraggle_util_add_fragments_to_system - module subroutine fraggle_util_ang_mtm(self) + module subroutine fraggle_util_get_angular_momentum(self) implicit none class(fraggle_fragments), intent(inout) :: self !! Fraggle fragment system object - end subroutine fraggle_util_ang_mtm + end subroutine fraggle_util_get_angular_momentum module subroutine fraggle_util_construct_temporary_system(fragments, system, param, tmpsys, tmpparam) use swiftest_classes, only : swiftest_nbody_system, swiftest_parameters @@ -132,6 +140,11 @@ module subroutine fraggle_util_construct_temporary_system(fragments, system, par class(swiftest_parameters), allocatable, intent(out) :: tmpparam !! Output temporary configuration run parameters end subroutine fraggle_util_construct_temporary_system + module subroutine fraggle_util_dealloc_fragments(self) + implicit none + class(fraggle_fragments), intent(inout) :: self + end subroutine fraggle_util_dealloc_fragments + module subroutine fraggle_util_final_impactors(self) implicit none type(collision_impactors), intent(inout) :: self !! Fraggle impactors object @@ -142,6 +155,10 @@ module subroutine fraggle_util_final_fragments(self) type(fraggle_fragments), intent(inout) :: self !! Fraggle frgments object end subroutine fraggle_util_final_fragments + module subroutine fraggle_util_final_system(self) + implicit none + type(fraggle_system), intent(inout) :: self !! Collision system object + end subroutine fraggle_util_final_system module subroutine fraggle_util_restructure(self, impactors, try, f_spin, r_max_start) implicit none diff --git a/src/modules/swiftest_classes.f90 b/src/modules/swiftest_classes.f90 index 090446da8..cf2ae97f4 100644 --- a/src/modules/swiftest_classes.f90 +++ b/src/modules/swiftest_classes.f90 @@ -105,8 +105,8 @@ module swiftest_classes 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) :: Lspin_varname = "Lspin" !! name of the spin angular momentum vector variable + integer(I4B) :: Lspin_varid !! ID for the system spin angular momentum vector variable character(NAMELEN) :: L_escape_varname = "L_escape" !! name of the escaped angular momentum vector variable integer(I4B) :: L_escape_varid !! ID for the escaped angular momentum vector variable character(NAMELEN) :: Ecollisions_varname = "Ecollisions" !! name of the escaped angular momentum y variable diff --git a/src/modules/symba_classes.f90 b/src/modules/symba_classes.f90 index 9e710c8fe..98143ed08 100644 --- a/src/modules/symba_classes.f90 +++ b/src/modules/symba_classes.f90 @@ -16,7 +16,8 @@ module symba_classes use swiftest_classes, only : swiftest_parameters, swiftest_base, swiftest_particle_info, swiftest_storage, netcdf_parameters use helio_classes, only : helio_cb, helio_pl, helio_tp, helio_nbody_system use fraggle_classes, only : collision_impactors, fraggle_fragments - use encounter_classes, only : encounter_list, encounter_storage, collision_storage + use encounter_classes, only : encounter_list, encounter_storage + use collision_classes, only : collision_storage implicit none public diff --git a/src/netcdf/netcdf.f90 b/src/netcdf/netcdf.f90 index 4ce217124..eaf11ddd4 100644 --- a/src/netcdf/netcdf.f90 +++ b/src/netcdf/netcdf.f90 @@ -106,7 +106,7 @@ module function netcdf_get_old_t_final_system(self, param) result(old_t_final) self%Eorbit_orig = KE_orb_orig + KE_spin_orig + PE_orig + self%Ecollisions + self%Euntracked call check( nf90_get_var(nc%id, nc%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(nc%id, nc%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(nc%id, nc%Lspin_varid, self%Lspin_orig(:), start=[1,1], count=[NDIM,1]), "netcdf_get_old_t_final_system Lspin_varid" ) call check( nf90_get_var(nc%id, nc%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(:) @@ -265,7 +265,7 @@ module subroutine netcdf_initialize_output(self, param) call check( nf90_def_var(nc%id, nc%ke_spin_varname, nc%out_type, nc%time_dimid, nc%KE_spin_varid), "netcdf_initialize_output nf90_def_var KE_spin_varid" ) call check( nf90_def_var(nc%id, nc%pe_varname, nc%out_type, nc%time_dimid, nc%PE_varid), "netcdf_initialize_output nf90_def_var PE_varid" ) call check( nf90_def_var(nc%id, nc%L_orb_varname, nc%out_type, [nc%space_dimid, nc%time_dimid], nc%L_orb_varid), "netcdf_initialize_output nf90_def_var L_orb_varid" ) - call check( nf90_def_var(nc%id, nc%L_spin_varname, nc%out_type, [nc%space_dimid, nc%time_dimid], nc%L_spin_varid), "netcdf_initialize_output nf90_def_var L_spin_varid" ) + call check( nf90_def_var(nc%id, nc%Lspin_varname, nc%out_type, [nc%space_dimid, nc%time_dimid], nc%Lspin_varid), "netcdf_initialize_output nf90_def_var Lspin_varid" ) call check( nf90_def_var(nc%id, nc%L_escape_varname, nc%out_type, [nc%space_dimid, nc%time_dimid], nc%L_escape_varid), "netcdf_initialize_output nf90_def_var L_escape_varid" ) call check( nf90_def_var(nc%id, nc%Ecollisions_varname, nc%out_type, nc%time_dimid, nc%Ecollisions_varid), "netcdf_initialize_output nf90_def_var Ecollisions_varid" ) call check( nf90_def_var(nc%id, nc%Euntracked_varname, nc%out_type, nc%time_dimid, nc%Euntracked_varid), "netcdf_initialize_output nf90_def_var Euntracked_varid" ) @@ -429,7 +429,7 @@ module subroutine netcdf_open(self, param, readonly) status = nf90_inq_varid(nc%id, nc%ke_spin_varname, nc%KE_spin_varid) status = nf90_inq_varid(nc%id, nc%pe_varname, nc%PE_varid) status = nf90_inq_varid(nc%id, nc%L_orb_varname, nc%L_orb_varid) - status = nf90_inq_varid(nc%id, nc%L_spin_varname, nc%L_spin_varid) + status = nf90_inq_varid(nc%id, nc%Lspin_varname, nc%Lspin_varid) status = nf90_inq_varid(nc%id, nc%L_escape_varname, nc%L_escape_varid) status = nf90_inq_varid(nc%id, nc%Ecollisions_varname, nc%Ecollisions_varid) status = nf90_inq_varid(nc%id, nc%Euntracked_varname, nc%Euntracked_varid) @@ -768,8 +768,8 @@ module subroutine netcdf_read_hdr_system(self, nc, param) if (status == nf90_noerr) call check( nf90_get_var(nc%id, nc%PE_varid, self%pe, start=[tslot]), "netcdf_read_hdr_system nf90_getvar PE_varid" ) status = nf90_inq_varid(nc%id, nc%L_orb_varname, nc%L_orb_varid) if (status == nf90_noerr) call check( nf90_get_var(nc%id, nc%L_orb_varid, self%Lorbit(:), start=[1,tslot], count=[NDIM,1]), "netcdf_read_hdr_system nf90_getvar L_orb_varid" ) - status = nf90_inq_varid(nc%id, nc%L_spin_varname, nc%L_spin_varid) - if (status == nf90_noerr) call check( nf90_get_var(nc%id, nc%L_spin_varid, self%Lspin(:), start=[1,tslot], count=[NDIM,1]), "netcdf_read_hdr_system nf90_getvar L_spin_varid" ) + status = nf90_inq_varid(nc%id, nc%Lspin_varname, nc%Lspin_varid) + if (status == nf90_noerr) call check( nf90_get_var(nc%id, nc%Lspin_varid, self%Lspin(:), start=[1,tslot], count=[NDIM,1]), "netcdf_read_hdr_system nf90_getvar Lspin_varid" ) status = nf90_inq_varid(nc%id, nc%L_escape_varname, nc%L_escape_varid) if (status == nf90_noerr) call check( nf90_get_var(nc%id, nc%L_escape_varid, self%Lescape(:), start=[1, tslot], count=[NDIM,1]), "netcdf_read_hdr_system nf90_getvar L_escape_varid" ) status = nf90_inq_varid(nc%id, nc%Ecollisions_varname, nc%Ecollisions_varid) @@ -1277,7 +1277,7 @@ module subroutine netcdf_write_hdr_system(self, nc, param) call check( nf90_put_var(nc%id, nc%KE_spin_varid, self%ke_spin, start=[tslot]), "netcdf_write_hdr_system nf90_put_var KE_spin_varid" ) call check( nf90_put_var(nc%id, nc%PE_varid, self%pe, start=[tslot]), "netcdf_write_hdr_system nf90_put_var PE_varid" ) call check( nf90_put_var(nc%id, nc%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(nc%id, nc%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(nc%id, nc%Lspin_varid, self%Lspin(:), start=[1,tslot], count=[NDIM,1]), "netcdf_write_hdr_system nf90_put_var Lspin_varid" ) call check( nf90_put_var(nc%id, nc%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(nc%id, nc%Ecollisions_varid, self%Ecollisions, start=[tslot]), "netcdf_write_hdr_system nf90_put_var Ecollisions_varid" ) call check( nf90_put_var(nc%id, nc%Euntracked_varid, self%Euntracked, start=[tslot]), "netcdf_write_hdr_system nf90_put_var Euntracked_varid" ) diff --git a/src/symba/symba_collision.f90 b/src/symba/symba_collision.f90 index 90d3847c4..16fd0d7bd 100644 --- a/src/symba/symba_collision.f90 +++ b/src/symba/symba_collision.f90 @@ -32,7 +32,7 @@ module function symba_collision_casedisruption(system, param, t) result(status) associate(impactors => system%impactors, fragments => system%fragments) - select case(fragments%regime) + select case(impactors%regime) case(COLLRESOLVE_REGIME_DISRUPTION) message = "Disruption between" case(COLLRESOLVE_REGIME_SUPERCATASTROPHIC) @@ -66,7 +66,7 @@ module function symba_collision_casedisruption(system, param, t) result(status) nfrag = fragments%nbody write(message, *) nfrag call io_log_one_message(FRAGGLE_LOG_OUT, "Generating " // trim(adjustl(message)) // " fragments") - select case(fragments%regime) + select case(impactors%regime) case(COLLRESOLVE_REGIME_DISRUPTION) status = DISRUPTION ibiggest = impactors%idx(maxloc(system%pl%Gmass(impactors%idx(:)), dim=1)) @@ -183,7 +183,7 @@ module function symba_collision_casemerge(system, param, t) result(status) integer(I4B) :: status !! Status flag assigned to this outcome ! Internals integer(I4B) :: i, j, k, ibiggest - real(DP), dimension(NDIM) :: L_spin_new + real(DP), dimension(NDIM) :: Lspin_new real(DP) :: dpe character(len=STRMAX) :: message @@ -207,12 +207,12 @@ module function symba_collision_casemerge(system, param, t) result(status) if (param%lrotation) then ! Conserve angular momentum by putting pre-impact orbital momentum into spin of the new body - L_spin_new(:) = impactors%L_orbit(:,1) + impactors%L_orbit(:,2) + impactors%L_spin(:,1) + impactors%L_spin(:,2) + Lspin_new(:) = impactors%Lorbit(:,1) + impactors%Lorbit(:,2) + impactors%Lspin(:,1) + impactors%Lspin(:,2) ! Assume prinicpal axis rotation on 3rd Ip axis - fragments%rot(:,1) = L_spin_new(:) / (fragments%Ip(3,1) * fragments%mass(1) * fragments%radius(1)**2) + fragments%rot(:,1) = Lspin_new(:) / (fragments%Ip(3,1) * fragments%mass(1) * fragments%radius(1)**2) else ! If spin is not enabled, we will consider the lost pre-collision angular momentum as "escaped" and add it to our bookkeeping variable - system%Lescape(:) = system%Lescape(:) + impactors%L_orbit(:,1) + impactors%L_orbit(:,2) + system%Lescape(:) = system%Lescape(:) + impactors%Lorbit(:,1) + impactors%Lorbit(:,2) end if ! Keep track of the component of potential energy due to the pre-impact impactors%idx for book-keeping @@ -471,7 +471,7 @@ function symba_collision_consolidate_impactors(pl, cb, param, idx_parent, impact !! author: David A. Minton !! !! Loops through the pl-pl collision list and groups families together by index. Outputs the indices of all impactors%idx members, - !! and pairs of quantities (x and v vectors, mass, radius, L_spin, and Ip) that can be used to resolve the collisional outcome. + !! and pairs of quantities (x and v vectors, mass, radius, Lspin, and Ip) that can be used to resolve the collisional outcome. implicit none ! Arguments class(symba_pl), intent(inout) :: pl !! SyMBA massive body object @@ -535,7 +535,7 @@ function symba_collision_consolidate_impactors(pl, cb, param, idx_parent, impact impactors%ncoll = count(pl%lcollision(impactors%idx(:))) impactors%idx = pack(impactors%idx(:), pl%lcollision(impactors%idx(:))) - impactors%L_spin(:,:) = 0.0_DP + impactors%Lspin(:,:) = 0.0_DP impactors%Ip(:,:) = 0.0_DP ! Find the barycenter of each body along with its children, if it has any @@ -545,7 +545,7 @@ function symba_collision_consolidate_impactors(pl, cb, param, idx_parent, impact ! Assume principal axis rotation about axis corresponding to highest moment of inertia (3rd Ip) if (param%lrotation) then impactors%Ip(:, j) = impactors%mass(j) * pl%Ip(:, idx_parent(j)) - impactors%L_spin(:, j) = impactors%Ip(3, j) * impactors%radius(j)**2 * pl%rot(:, idx_parent(j)) + impactors%Lspin(:, j) = impactors%Ip(3, j) * impactors%radius(j)**2 * pl%rot(:, idx_parent(j)) end if if (nchild(j) > 0) then @@ -565,14 +565,14 @@ function symba_collision_consolidate_impactors(pl, cb, param, idx_parent, impact xc(:) = impactors%rb(:, j) - xcom(:) vc(:) = impactors%vb(:, j) - vcom(:) xcrossv(:) = xc(:) .cross. vc(:) - impactors%L_spin(:, j) = impactors%L_spin(:, j) + impactors%mass(j) * xcrossv(:) + impactors%Lspin(:, j) = impactors%Lspin(:, j) + impactors%mass(j) * xcrossv(:) xc(:) = xchild(:) - xcom(:) vc(:) = vchild(:) - vcom(:) xcrossv(:) = xc(:) .cross. vc(:) - impactors%L_spin(:, j) = impactors%L_spin(:, j) + mchild * xcrossv(:) + impactors%Lspin(:, j) = impactors%Lspin(:, j) + mchild * xcrossv(:) - impactors%L_spin(:, j) = impactors%L_spin(:, j) + mchild * pl%Ip(3, idx_child) & + impactors%Lspin(:, j) = impactors%Lspin(:, j) + mchild * pl%Ip(3, idx_child) & * pl%radius(idx_child)**2 & * pl%rot(:, idx_child) impactors%Ip(:, j) = impactors%Ip(:, j) + mchild * pl%Ip(:, idx_child) @@ -596,7 +596,7 @@ function symba_collision_consolidate_impactors(pl, cb, param, idx_parent, impact mxc(:, 2) = impactors%mass(2) * (impactors%rb(:, 2) - xcom(:)) vcc(:, 1) = impactors%vb(:, 1) - vcom(:) vcc(:, 2) = impactors%vb(:, 2) - vcom(:) - impactors%L_orbit(:,:) = mxc(:,:) .cross. vcc(:,:) + impactors%Lorbit(:,:) = mxc(:,:) .cross. vcc(:,:) ! Destroy the kinship relationships for all members of this impactors%idx call pl%reset_kinship(impactors%idx(:)) @@ -937,7 +937,7 @@ subroutine symba_resolve_collision(plplcollision_list , system, param, t) call system%impactors%regime(system%fragments, system, param) else associate(fragments => system%fragments, impactors => system%impactors) - fragments%regime = COLLRESOLVE_REGIME_MERGE + impactors%regime = COLLRESOLVE_REGIME_MERGE fragments%mtot = sum(impactors%mass(:)) fragments%mass_dist(1) = fragments%mtot fragments%mass_dist(2) = 0.0_DP @@ -948,7 +948,7 @@ subroutine symba_resolve_collision(plplcollision_list , system, param, t) end if call collision_history%take_snapshot(param,system, t, "before") - select case (system%fragments%regime) + select case (system%impactors%regime) case (COLLRESOLVE_REGIME_DISRUPTION, COLLRESOLVE_REGIME_SUPERCATASTROPHIC) plplcollision_list%status(i) = symba_collision_casedisruption(system, param, t) case (COLLRESOLVE_REGIME_HIT_AND_RUN) From 9e4dd9852f5ed1d0056f0ce5a171fd07394aeacc Mon Sep 17 00:00:00 2001 From: David A Minton Date: Fri, 16 Dec 2022 15:19:20 -0500 Subject: [PATCH 451/569] More restructuring and cleaning (not there yet) --- src/collision/collision_util.f90 | 60 +++++++++++++++++++++++++++++++ src/fraggle/fraggle_generate.f90 | 7 ++-- src/fraggle/fraggle_set.f90 | 58 ------------------------------ src/modules/collision_classes.f90 | 17 ++++++--- 4 files changed, 77 insertions(+), 65 deletions(-) diff --git a/src/collision/collision_util.f90 b/src/collision/collision_util.f90 index 55a8b23a1..2e63029ce 100644 --- a/src/collision/collision_util.f90 +++ b/src/collision/collision_util.f90 @@ -324,6 +324,66 @@ module subroutine collision_util_reset_system(self) end subroutine collision_util_reset_system + + + module subroutine collision_util_set_coordinate_system(self) + !! author: David A. Minton + !! + !! Defines the collisional coordinate system, including the unit vectors of both the system and individual fragments. + implicit none + ! Arguments + class(collision_system), intent(inout) :: self !! Collisional system + ! Internals + integer(I4B) :: i + real(DP), dimension(NDIM) :: delta_r, delta_v, Ltot + real(DP) :: L_mag + real(DP), dimension(NDIM, self%fragments%nbody) :: L_sigma + + associate(fragments => self%fragments, impactors => self%impactors, nfrag => self%fragments%nbody) + delta_v(:) = impactors%vb(:, 2) - impactors%vb(:, 1) + delta_r(:) = impactors%rb(:, 2) - impactors%rb(:, 1) + + ! We will initialize fragments on a plane defined by the pre-impact system, with the z-axis aligned with the angular momentum vector + ! and the y-axis aligned with the pre-impact distance vector. + + ! y-axis is the separation distance + fragments%y_coll_unit(:) = .unit.delta_r(:) + Ltot = impactors%Lorbit(:,1) + impactors%Lorbit(:,2) + impactors%Lspin(:,1) + impactors%Lspin(:,2) + + L_mag = .mag.Ltot(:) + if (L_mag > sqrt(tiny(L_mag))) then + fragments%z_coll_unit(:) = .unit.Ltot(:) + else ! Not enough angular momentum to determine a z-axis direction. We'll just pick a random direction + call random_number(fragments%z_coll_unit(:)) + fragments%z_coll_unit(:) = .unit.fragments%z_coll_unit(:) + end if + + ! The cross product of the y- by z-axis will give us the x-axis + fragments%x_coll_unit(:) = fragments%y_coll_unit(:) .cross. fragments%z_coll_unit(:) + + fragments%v_coll_unit(:) = .unit.delta_v(:) + + if (.not.any(fragments%r_coll(:,:) > 0.0_DP)) return + fragments%rmag(:) = .mag. fragments%r_coll(:,:) + + ! Randomize the tangential velocity direction. + ! This helps to ensure that the tangential velocity doesn't completely line up with the angular momentum vector, otherwise we can get an ill-conditioned system + call random_number(L_sigma(:,:)) + do concurrent(i = 1:nfrag, fragments%rmag(i) > 0.0_DP) + fragments%v_n_unit(:, i) = fragments%z_coll_unit(:) + 2e-1_DP * (L_sigma(:,i) - 0.5_DP) + end do + + ! Define the radial, normal, and tangential unit vectors for each individual fragment + fragments%v_r_unit(:,:) = .unit. fragments%r_coll(:,:) + fragments%v_n_unit(:,:) = .unit. fragments%v_n_unit(:,:) + fragments%v_t_unit(:,:) = .unit. (fragments%v_n_unit(:,:) .cross. fragments%v_r_unit(:,:)) + + end associate + + return + end subroutine collision_util_set_coordinate_system + + subroutine collision_util_save_snapshot(collision_history, snapshot) !! author: David A. Minton !! diff --git a/src/fraggle/fraggle_generate.f90 b/src/fraggle/fraggle_generate.f90 index 7c9cfa358..e603b5b9d 100644 --- a/src/fraggle/fraggle_generate.f90 +++ b/src/fraggle/fraggle_generate.f90 @@ -45,7 +45,9 @@ module subroutine fraggle_generate_fragments(self, system, param, lfailure) fpe_quiet_modes(:) = .false. call ieee_set_halting_mode(IEEE_ALL,fpe_quiet_modes) - associate(fragments => self, nfrag => self%nbody, pl => system%pl) + select type(fragments => self%fragments) + class is (fraggle_fragments) + associate(collision => self, impactors => self%impactors, nfrag => fragments%nbody, pl => system%pl) write(message,*) nfrag call io_log_one_message(FRAGGLE_LOG_OUT, "Fraggle generating " // trim(adjustl(message)) // " fragments.") @@ -72,7 +74,7 @@ module subroutine fraggle_generate_fragments(self, system, param, lfailure) call fragments%reset() ! Calculate the initial energy of the system without the collisional family - call fragments%get_energy_and_momentum(impactors, system, param, lbefore=.true.) + call collision%get_energy_and_momentum(system, param, lbefore=.true.) ! Start out the fragments close to the initial separation distance. This will be increased if there is any overlap or we fail to find a solution r_max_start = 1.2_DP * .mag.(impactors%rb(:,2) - impactors%rb(:,1)) @@ -162,6 +164,7 @@ module subroutine fraggle_generate_fragments(self, system, param, lfailure) ! Restore the big array if (lk_plpl) call pl%flatten(param) end associate + end select call ieee_set_halting_mode(IEEE_ALL,fpe_halting_modes) ! Save the current halting modes so we can turn them off temporarily return diff --git a/src/fraggle/fraggle_set.f90 b/src/fraggle/fraggle_set.f90 index fa0e28aeb..a69a69260 100644 --- a/src/fraggle/fraggle_set.f90 +++ b/src/fraggle/fraggle_set.f90 @@ -160,64 +160,6 @@ module subroutine fraggle_set_mass_dist_fragments(self, impactors, param) end subroutine fraggle_set_mass_dist_fragments - module subroutine encounter_set_coordinate_system(self, impactors) - !! author: David A. Minton - !! - !! Defines the collisional coordinate system, including the unit vectors of both the system and individual fragments. - implicit none - ! Arguments - class(fraggle_fragments), intent(inout) :: self !! Fraggle fragment system object - class(collision_impactors), intent(inout) :: impactors !! Fraggle collider system object - ! Internals - integer(I4B) :: i - real(DP), dimension(NDIM) :: delta_r, delta_v, Ltot - real(DP) :: L_mag - real(DP), dimension(NDIM, self%nbody) :: L_sigma - - associate(fragments => self, nfrag => self%nbody) - delta_v(:) = impactors%vb(:, 2) - impactors%vb(:, 1) - delta_r(:) = impactors%rb(:, 2) - impactors%rb(:, 1) - - ! We will initialize fragments on a plane defined by the pre-impact system, with the z-axis aligned with the angular momentum vector - ! and the y-axis aligned with the pre-impact distance vector. - - ! y-axis is the separation distance - fragments%y_coll_unit(:) = .unit.delta_r(:) - Ltot = impactors%Lorbit(:,1) + impactors%Lorbit(:,2) + impactors%Lspin(:,1) + impactors%Lspin(:,2) - - L_mag = .mag.Ltot(:) - if (L_mag > sqrt(tiny(L_mag))) then - fragments%z_coll_unit(:) = .unit.Ltot(:) - else ! Not enough angular momentum to determine a z-axis direction. We'll just pick a random direction - call random_number(fragments%z_coll_unit(:)) - fragments%z_coll_unit(:) = .unit.fragments%z_coll_unit(:) - end if - - ! The cross product of the y- by z-axis will give us the x-axis - fragments%x_coll_unit(:) = fragments%y_coll_unit(:) .cross. fragments%z_coll_unit(:) - - fragments%v_coll_unit(:) = .unit.delta_v(:) - - if (.not.any(fragments%r_coll(:,:) > 0.0_DP)) return - fragments%rmag(:) = .mag. fragments%r_coll(:,:) - - ! Randomize the tangential velocity direction. - ! This helps to ensure that the tangential velocity doesn't completely line up with the angular momentum vector, otherwise we can get an ill-conditioned system - call random_number(L_sigma(:,:)) - do concurrent(i = 1:nfrag, fragments%rmag(i) > 0.0_DP) - fragments%v_n_unit(:, i) = fragments%z_coll_unit(:) + 2e-1_DP * (L_sigma(:,i) - 0.5_DP) - end do - - ! Define the radial, normal, and tangential unit vectors for each individual fragment - fragments%v_r_unit(:,:) = .unit. fragments%r_coll(:,:) - fragments%v_n_unit(:,:) = .unit. fragments%v_n_unit(:,:) - fragments%v_t_unit(:,:) = .unit. (fragments%v_n_unit(:,:) .cross. fragments%v_r_unit(:,:)) - - end associate - - return - end subroutine encounter_set_coordinate_system - module subroutine fraggle_set_natural_scale_factors(self, impactors) !! author: David A. Minton diff --git a/src/modules/collision_classes.f90 b/src/modules/collision_classes.f90 index d2d2bd9b1..262920269 100644 --- a/src/modules/collision_classes.f90 +++ b/src/modules/collision_classes.f90 @@ -102,11 +102,12 @@ module collision_classes real(DP), dimension(2) :: pe !! Before/after potential energy real(DP), dimension(2) :: Etot !! Before/after total system energy contains - procedure :: regime => collision_regime_system !! Determine which fragmentation regime the set of impactors will be - procedure :: setup => collision_setup_system !! Initializer for the encounter collision system. Allocates the collider and fragments classes and the before/after snapshots - procedure :: get_energy_and_momentum => collision_util_get_energy_momentum !! Calculates total system energy in either the pre-collision outcome state (lbefore = .true.) or the post-collision outcome state (lbefore = .false.) - procedure :: reset => collision_util_reset_system !! Deallocates all allocatables - final :: collision_util_final_system !! Finalizer will deallocate all allocatables + procedure :: regime => collision_regime_system !! Determine which fragmentation regime the set of impactors will be + procedure :: setup => collision_setup_system !! Initializer for the encounter collision system. Allocates the collider and fragments classes and the before/after snapshots + procedure :: get_energy_and_momentum => collision_util_get_energy_momentum !! Calculates total system energy in either the pre-collision outcome state (lbefore = .true.) or the post-collision outcome state (lbefore = .false.) + procedure :: reset => collision_util_reset_system !! Deallocates all allocatables + procedure :: set_coordinate_system => collision_util_set_coordinate_system !! Sets the coordinate system of the collisional system + final :: collision_util_final_system !! Finalizer will deallocate all allocatables end type collision_system !! NetCDF dimension and variable names for the enounter save object @@ -217,6 +218,12 @@ module subroutine collision_set_coordinate_fragments(self) class(collision_fragments), intent(inout) :: self !! Fragment system object end subroutine collision_set_coordinate_fragments + module subroutine collision_util_set_coordinate_system(self) + implicit none + class(collision_system), intent(inout) :: self !! Collisional system + end subroutine collision_util_set_coordinate_system + + module subroutine collision_setup_fragments(self, n, param) implicit none class(collision_fragments), intent(inout) :: self !! Fragment system object From 265483b0b02b0c54c6e7cefcf50400c8f638da9c Mon Sep 17 00:00:00 2001 From: David A Minton Date: Fri, 16 Dec 2022 16:36:55 -0500 Subject: [PATCH 452/569] More cleanup --- src/collision/collision_util.f90 | 20 ++++++++++---------- src/fraggle/fraggle_generate.f90 | 32 ++++++++++++++++---------------- src/fraggle/fraggle_set.f90 | 8 ++++---- 3 files changed, 30 insertions(+), 30 deletions(-) diff --git a/src/collision/collision_util.f90 b/src/collision/collision_util.f90 index 2e63029ce..0c435cfc6 100644 --- a/src/collision/collision_util.f90 +++ b/src/collision/collision_util.f90 @@ -347,34 +347,34 @@ module subroutine collision_util_set_coordinate_system(self) ! and the y-axis aligned with the pre-impact distance vector. ! y-axis is the separation distance - fragments%y_coll_unit(:) = .unit.delta_r(:) + impactors%y_unit(:) = .unit.delta_r(:) Ltot = impactors%Lorbit(:,1) + impactors%Lorbit(:,2) + impactors%Lspin(:,1) + impactors%Lspin(:,2) L_mag = .mag.Ltot(:) if (L_mag > sqrt(tiny(L_mag))) then - fragments%z_coll_unit(:) = .unit.Ltot(:) + impactors%z_unit(:) = .unit.Ltot(:) else ! Not enough angular momentum to determine a z-axis direction. We'll just pick a random direction - call random_number(fragments%z_coll_unit(:)) - fragments%z_coll_unit(:) = .unit.fragments%z_coll_unit(:) + call random_number(impactors%z_unit(:)) + impactors%z_unit(:) = .unit.impactors%z_unit(:) end if ! The cross product of the y- by z-axis will give us the x-axis - fragments%x_coll_unit(:) = fragments%y_coll_unit(:) .cross. fragments%z_coll_unit(:) + impactors%x_unit(:) = impactors%y_unit(:) .cross. impactors%z_unit(:) - fragments%v_coll_unit(:) = .unit.delta_v(:) + impactors%v_unit(:) = .unit.delta_v(:) - if (.not.any(fragments%r_coll(:,:) > 0.0_DP)) return - fragments%rmag(:) = .mag. fragments%r_coll(:,:) + if (.not.any(fragments%rc(:,:) > 0.0_DP)) return + fragments%rmag(:) = .mag. fragments%rc(:,:) ! Randomize the tangential velocity direction. ! This helps to ensure that the tangential velocity doesn't completely line up with the angular momentum vector, otherwise we can get an ill-conditioned system call random_number(L_sigma(:,:)) do concurrent(i = 1:nfrag, fragments%rmag(i) > 0.0_DP) - fragments%v_n_unit(:, i) = fragments%z_coll_unit(:) + 2e-1_DP * (L_sigma(:,i) - 0.5_DP) + fragments%v_n_unit(:, i) = impactors%z_unit(:) + 2e-1_DP * (L_sigma(:,i) - 0.5_DP) end do ! Define the radial, normal, and tangential unit vectors for each individual fragment - fragments%v_r_unit(:,:) = .unit. fragments%r_coll(:,:) + fragments%v_r_unit(:,:) = .unit. fragments%rc(:,:) fragments%v_n_unit(:,:) = .unit. fragments%v_n_unit(:,:) fragments%v_t_unit(:,:) = .unit. (fragments%v_n_unit(:,:) .cross. fragments%v_r_unit(:,:)) diff --git a/src/fraggle/fraggle_generate.f90 b/src/fraggle/fraggle_generate.f90 index e603b5b9d..ffc7acf7a 100644 --- a/src/fraggle/fraggle_generate.f90 +++ b/src/fraggle/fraggle_generate.f90 @@ -213,35 +213,35 @@ subroutine fraggle_generate_pos_vec(fragments, impactors, r_max_start) ! We will treat the first two fragments of the list as special cases. They get initialized the maximum distances apart along the original impactor distance vector. ! This is done because in a regular disruption, the first body is the largest, the second the second largest, and the rest are smaller equal-mass fragments. - call random_number(fragments%r_coll(:,3:nfrag)) + call random_number(fragments%rc(:,3:nfrag)) loverlap(:) = .true. do while (any(loverlap(3:nfrag))) - fragments%r_coll(:, 1) = impactors%rb(:, 1) - fragments%rbcom(:) - fragments%r_coll(:, 2) = impactors%rb(:, 2) - fragments%rbcom(:) + fragments%rc(:, 1) = impactors%rb(:, 1) - fragments%rbcom(:) + fragments%rc(:, 2) = impactors%rb(:, 2) - fragments%rbcom(:) r_max = r_max + 0.1_DP * rad do i = 3, nfrag if (loverlap(i)) then - call random_number(fragments%r_coll(:,i)) - fragments%r_coll(:,i) = 2 * (fragments%r_coll(:, i) - 0.5_DP) - fragments%r_coll(:, i) = fragments%r_coll(:,i) + fdistort * vunit(:) - fragments%r_coll(:, i) = r_max * fragments%r_coll(:, i) - fragments%r_coll(:, i) = fragments%r_coll(:, i) + (fragments%rbimp(:) - fragments%rbcom(:)) ! Shift the center of the fragment cloud to the impact point rather than the CoM - !if (lnoncat .and. dot_product(fragments%r_coll(:,i), runit(:)) < 0.0_DP) fragments%r_coll(:, i) = -fragments%r_coll(:, i) ! Make sure the fragment cloud points away from the impact point + call random_number(fragments%rc(:,i)) + fragments%rc(:,i) = 2 * (fragments%rc(:, i) - 0.5_DP) + fragments%rc(:, i) = fragments%rc(:,i) + fdistort * vunit(:) + fragments%rc(:, i) = r_max * fragments%rc(:, i) + fragments%rc(:, i) = fragments%rc(:, i) + (fragments%rbimp(:) - fragments%rbcom(:)) ! Shift the center of the fragment cloud to the impact point rather than the CoM + !if (lnoncat .and. dot_product(fragments%rc(:,i), runit(:)) < 0.0_DP) fragments%rc(:, i) = -fragments%rc(:, i) ! Make sure the fragment cloud points away from the impact point end if end do loverlap(:) = .false. do j = 1, nfrag do i = j + 1, nfrag - dis = .mag.(fragments%r_coll(:,j) - fragments%r_coll(:,i)) + dis = .mag.(fragments%rc(:,j) - fragments%rc(:,i)) loverlap(i) = loverlap(i) .or. (dis <= (fragments%radius(i) + fragments%radius(j))) end do end do end do - call fraggle_util_shift_vector_to_origin(fragments%mass, fragments%r_coll) + call fraggle_util_shift_vector_to_origin(fragments%mass, fragments%rc) call fragments%set_coordinate_system(impactors) do concurrent(i = 1:nfrag) - fragments%rb(:,i) = fragments%r_coll(:,i) + fragments%rbcom(:) + fragments%rb(:,i) = fragments%rc(:,i) + fragments%rbcom(:) end do fragments%rbcom(:) = 0.0_DP @@ -408,7 +408,7 @@ subroutine fraggle_generate_tan_vel(fragments, impactors, lfailure) fragments%vb(:,1:nfrag) = fraggle_util_vmag_to_vb(fragments%v_r_mag(1:nfrag), fragments%v_r_unit(:,1:nfrag), fragments%v_t_mag(1:nfrag), & fragments%v_t_unit(:,1:nfrag), fragments%mass(1:nfrag), fragments%vbcom(:)) do concurrent (i = 1:nfrag) - fragments%v_coll(:,i) = fragments%vb(:,i) - fragments%vbcom(:) + fragments%vc(:,i) = fragments%vb(:,i) - fragments%vbcom(:) end do ! Now do a kinetic energy budget check to make sure we are still within the budget. @@ -422,7 +422,7 @@ subroutine fraggle_generate_tan_vel(fragments, impactors, lfailure) ke_diff = fragments%ke_budget - fragments%ke_spin - fragments%ke_orbit lfailure = ke_diff < 0.0_DP if (.not.lfailure) exit - fragments%r_coll(:,:) = fragments%r_coll(:,:) * 1.1_DP + fragments%rc(:,:) = fragments%rc(:,:) * 1.1_DP end do if (lfailure) then call io_log_one_message(FRAGGLE_LOG_OUT, " ") @@ -476,7 +476,7 @@ function solve_fragment_tan_vel(lfailure, v_t_mag_input) result(v_t_mag_output) else if (present(v_t_mag_input)) then vtmp(:) = v_t_mag_input(i - 6) * fragments%v_t_unit(:, i) L_lin_others(:) = L_lin_others(:) + fragments%mass(i) * vtmp(:) - L(:) = fragments%mass(i) * (fragments%r_coll(:, i) .cross. vtmp(:)) + L(:) = fragments%mass(i) * (fragments%rc(:, i) .cross. vtmp(:)) L_orb_others(:) = L_orb_others(:) + L(:) end if end do @@ -582,7 +582,7 @@ subroutine fraggle_generate_rad_vel(fragments, impactors, lfailure) fragments%vb(:,1:nfrag) = fraggle_util_vmag_to_vb(fragments%v_r_mag(1:nfrag), fragments%v_r_unit(:,1:nfrag), & fragments%v_t_mag(1:nfrag), fragments%v_t_unit(:,1:nfrag), fragments%mass(1:nfrag), fragments%vbcom(:)) do i = 1, nfrag - fragments%v_coll(:, i) = fragments%vb(:, i) - fragments%vbcom(:) + fragments%vc(:, i) = fragments%vb(:, i) - fragments%vbcom(:) fragments%ke_orbit = fragments%ke_orbit + fragments%mass(i) * norm2(fragments%vb(:, i)) fragments%ke_spin = fragments%ke_spin + fragments%mass(i) * fragments%radius(i)**2 * fragments%Ip(3,i) * norm2(fragments%rot(:,i)) end do diff --git a/src/fraggle/fraggle_set.f90 b/src/fraggle/fraggle_set.f90 index a69a69260..0da950206 100644 --- a/src/fraggle/fraggle_set.f90 +++ b/src/fraggle/fraggle_set.f90 @@ -244,12 +244,12 @@ module subroutine fraggle_set_original_scale_factors(self) fragments%mass = fragments%mass * fragments%mscale fragments%radius = fragments%radius * fragments%dscale fragments%rot = fragments%rot / fragments%tscale - fragments%r_coll = fragments%r_coll * fragments%dscale - fragments%v_coll = fragments%v_coll * fragments%vscale + fragments%rc = fragments%rc * fragments%dscale + fragments%vc = fragments%vc * fragments%vscale do i = 1, fragments%nbody - fragments%rb(:, i) = fragments%r_coll(:, i) + fragments%rbcom(:) - fragments%vb(:, i) = fragments%v_coll(:, i) + fragments%vbcom(:) + fragments%rb(:, i) = fragments%rc(:, i) + fragments%rbcom(:) + fragments%vb(:, i) = fragments%vc(:, i) + fragments%vbcom(:) end do impactors%Qloss = impactors%Qloss * fragments%Escale From f903e34c5cf3e24282093a188a794e167f265792 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Sat, 17 Dec 2022 07:41:40 -0500 Subject: [PATCH 453/569] More cleaning --- src/fraggle/fraggle_generate.f90 | 165 ++++++++++++++++-------------- src/fraggle/fraggle_io.f90 | 52 +++++----- src/fraggle/fraggle_regime.f90 | 14 +-- src/fraggle/fraggle_set.f90 | 167 +++++++++++++++---------------- src/fraggle/fraggle_util.f90 | 16 +-- src/modules/fraggle_classes.f90 | 71 +++++++------ src/symba/symba_collision.f90 | 16 +-- 7 files changed, 254 insertions(+), 247 deletions(-) diff --git a/src/fraggle/fraggle_generate.f90 b/src/fraggle/fraggle_generate.f90 index ffc7acf7a..67b375940 100644 --- a/src/fraggle/fraggle_generate.f90 +++ b/src/fraggle/fraggle_generate.f90 @@ -47,7 +47,7 @@ module subroutine fraggle_generate_fragments(self, system, param, lfailure) select type(fragments => self%fragments) class is (fraggle_fragments) - associate(collision => self, impactors => self%impactors, nfrag => fragments%nbody, pl => system%pl) + associate(collision_system => self, impactors => self%impactors, nfrag => fragments%nbody, pl => system%pl) write(message,*) nfrag call io_log_one_message(FRAGGLE_LOG_OUT, "Fraggle generating " // trim(adjustl(message)) // " fragments.") @@ -69,12 +69,12 @@ module subroutine fraggle_generate_fragments(self, system, param, lfailure) lk_plpl = .false. end if - call fragments%set_natural_scale(impactors) + call collision_system%set_natural_scale() call fragments%reset() ! Calculate the initial energy of the system without the collisional family - call collision%get_energy_and_momentum(system, param, lbefore=.true.) + call collision_system%get_energy_and_momentum(system, param, lbefore=.true.) ! Start out the fragments close to the initial separation distance. This will be increased if there is any overlap or we fail to find a solution r_max_start = 1.2_DP * .mag.(impactors%rb(:,2) - impactors%rb(:,1)) @@ -92,38 +92,38 @@ module subroutine fraggle_generate_fragments(self, system, param, lfailure) lfailure = .false. call ieee_set_flag(ieee_all, .false.) ! Set all fpe flags to quiet - call fraggle_generate_pos_vec(fragments, impactors, r_max_start) - call fragments%set_coordinate_system(impactors) + call fraggle_generate_pos_vec(collision_system, r_max_start) + call collision_system%set_coordinate_system() ! Initial velocity guess will be the barycentric velocity of the colliding system so that the budgets are based on the much smaller collisional-frame velocities do concurrent (i = 1:nfrag) - fragments%vb(:, i) = fragments%vbcom(:) + fragments%vb(:, i) = impactors%vbcom(:) end do - call fragments%get_energy_and_momentum(impactors, system, param, lbefore=.false.) - call fragments%set_budgets() + call collision_system%get_energy_and_momentum(system, param, lbefore=.false.) + call collision_system%set_budgets() - call fraggle_generate_spins(fragments, impactors, f_spin, lfailure) + call fraggle_generate_spins(collision_system, f_spin, lfailure) if (lfailure) then call io_log_one_message(FRAGGLE_LOG_OUT, "Fraggle failed to find spins") cycle end if - call fraggle_generate_tan_vel(fragments, impactors, lfailure) + call fraggle_generate_tan_vel(collision_system, lfailure) if (lfailure) then call io_log_one_message(FRAGGLE_LOG_OUT, "Fraggle failed to find tangential velocities") cycle end if - call fraggle_generate_rad_vel(fragments, impactors, lfailure) + call fraggle_generate_rad_vel(collision_system, lfailure) if (lfailure) then call io_log_one_message(FRAGGLE_LOG_OUT, "Fraggle failed to find radial velocities") cycle end if - call fragments%get_energy_and_momentum(impactors, system, param, lbefore=.false.) - dEtot = fragments%Etot_after - fragments%Etot_before - dLmag = .mag. (fragments%Ltot_after(:) - fragments%Ltot_before(:)) + call collision_system%get_energy_and_momentum(system, param, lbefore=.false.) + dEtot = collision_system%Etot(2) - collision_system%Etot(1) + dLmag = .mag. (collision_system%Ltot(:,2) - collision_system%Ltot(:,1)) exit lfailure = ((abs(dEtot + impactors%Qloss) > FRAGGLE_ETOL) .or. (dEtot > 0.0_DP)) @@ -134,9 +134,9 @@ module subroutine fraggle_generate_fragments(self, system, param, lfailure) cycle end if - lfailure = ((abs(dLmag) / (.mag.fragments%Ltot_before)) > FRAGGLE_LTOL) + lfailure = ((abs(dLmag) / (.mag.collision_system%Ltot(:,1))) > FRAGGLE_LTOL) if (lfailure) then - write(message,*) dLmag / (.mag.fragments%Ltot_before(:)) + write(message,*) dLmag / (.mag.collision_system%Ltot(:,1)) call io_log_one_message(FRAGGLE_LOG_OUT, "Fraggle failed due to high angular momentum error: " // & trim(adjustl(message))) cycle @@ -159,7 +159,7 @@ module subroutine fraggle_generate_fragments(self, system, param, lfailure) trim(adjustl(message)) // " tries") end if - call fragments%set_original_scale(impactors) + call collision_system%set_original_scale() ! Restore the big array if (lk_plpl) call pl%flatten(param) @@ -171,7 +171,7 @@ module subroutine fraggle_generate_fragments(self, system, param, lfailure) end subroutine fraggle_generate_fragments - subroutine fraggle_generate_pos_vec(fragments, impactors, r_max_start) + subroutine fraggle_generate_pos_vec(collision_system, r_max_start) !! Author: Jennifer L.L. Pouplin, Carlisle A. Wishard, and David A. Minton !! !! Initializes the orbits of the fragments around the center of mass. The fragments are initially placed on a plane defined by the @@ -179,9 +179,8 @@ subroutine fraggle_generate_pos_vec(fragments, impactors, r_max_start) !! The initial positions do not conserve energy or momentum, so these need to be adjusted later. implicit none ! Arguments - class(fraggle_fragments), intent(inout) :: fragments !! Fraggle fragment system object - class(collision_impactors), intent(inout) :: impactors !! Fraggle collider system object - real(DP), intent(in) :: r_max_start !! Initial guess for the starting maximum radial distance of fragments + class(fraggle_system), intent(inout) :: collision_system !! Fraggle collision system object + real(DP), intent(in) :: r_max_start !! Initial guess for the starting maximum radial distance of fragments ! Internals real(DP) :: dis, rad, r_max, fdistort real(DP), dimension(NDIM) :: runit, vunit @@ -189,7 +188,7 @@ subroutine fraggle_generate_pos_vec(fragments, impactors, r_max_start) integer(I4B) :: i, j logical :: lnoncat, lhitandrun - associate(nfrag => fragments%nbody) + associate(fragments => collision_system%fragments, impactors => collision_system%impactors, nfrag => collision_system%fragments%nbody) allocate(loverlap(nfrag)) lnoncat = (impactors%regime /= COLLRESOLVE_REGIME_SUPERCATASTROPHIC) ! For non-catastrophic impacts, make the fragments act like ejecta and point away from the impact point @@ -216,8 +215,8 @@ subroutine fraggle_generate_pos_vec(fragments, impactors, r_max_start) call random_number(fragments%rc(:,3:nfrag)) loverlap(:) = .true. do while (any(loverlap(3:nfrag))) - fragments%rc(:, 1) = impactors%rb(:, 1) - fragments%rbcom(:) - fragments%rc(:, 2) = impactors%rb(:, 2) - fragments%rbcom(:) + fragments%rc(:, 1) = impactors%rb(:, 1) - impactors%rbcom(:) + fragments%rc(:, 2) = impactors%rb(:, 2) - impactors%rbcom(:) r_max = r_max + 0.1_DP * rad do i = 3, nfrag if (loverlap(i)) then @@ -225,7 +224,7 @@ subroutine fraggle_generate_pos_vec(fragments, impactors, r_max_start) fragments%rc(:,i) = 2 * (fragments%rc(:, i) - 0.5_DP) fragments%rc(:, i) = fragments%rc(:,i) + fdistort * vunit(:) fragments%rc(:, i) = r_max * fragments%rc(:, i) - fragments%rc(:, i) = fragments%rc(:, i) + (fragments%rbimp(:) - fragments%rbcom(:)) ! Shift the center of the fragment cloud to the impact point rather than the CoM + fragments%rc(:, i) = fragments%rc(:, i) + (impactors%rbimp(:) - impactors%rbcom(:)) ! Shift the center of the fragment cloud to the impact point rather than the CoM !if (lnoncat .and. dot_product(fragments%rc(:,i), runit(:)) < 0.0_DP) fragments%rc(:, i) = -fragments%rc(:, i) ! Make sure the fragment cloud points away from the impact point end if end do @@ -238,24 +237,24 @@ subroutine fraggle_generate_pos_vec(fragments, impactors, r_max_start) end do end do call fraggle_util_shift_vector_to_origin(fragments%mass, fragments%rc) - call fragments%set_coordinate_system(impactors) + call collision_system%set_coordinate_system() do concurrent(i = 1:nfrag) - fragments%rb(:,i) = fragments%rc(:,i) + fragments%rbcom(:) + fragments%rb(:,i) = fragments%rc(:,i) + impactors%rbcom(:) end do - fragments%rbcom(:) = 0.0_DP + impactors%rbcom(:) = 0.0_DP do concurrent(i = 1:nfrag) - fragments%rbcom(:) = fragments%rbcom(:) + fragments%mass(i) * fragments%rb(:,i) + impactors%rbcom(:) = impactors%rbcom(:) + fragments%mass(i) * fragments%rb(:,i) end do - fragments%rbcom(:) = fragments%rbcom(:) / fragments%mtot + impactors%rbcom(:) = impactors%rbcom(:) / fragments%mtot end associate return end subroutine fraggle_generate_pos_vec - subroutine fraggle_generate_spins(fragments, impactors, f_spin, lfailure) + subroutine fraggle_generate_spins(collision_system, f_spin, lfailure) !! Author: Jennifer L.L. Pouplin, Carlisle A. Wishard, and David A. Minton !! !! Calculates the spins of a collection of fragments such that they conserve angular momentum without blowing the fragment kinetic energy budget. @@ -263,19 +262,20 @@ subroutine fraggle_generate_spins(fragments, impactors, f_spin, lfailure) !! A failure will trigger a restructuring of the fragments so we will try new values of the radial position distribution. implicit none ! Arguments - class(fraggle_fragments), intent(inout) :: fragments !! Fraggle fragment system object - class(collision_impactors), intent(inout) :: impactors !! Fraggle collider system object - real(DP), intent(in) :: f_spin !! Fraction of energy or momentum that goes into spin (whichever gives the lowest kinetic energy) - logical, intent(out) :: lfailure !! Logical flag indicating whether this step fails or succeeds! + class(fraggle_system), intent(inout) :: collision_system !! Fraggle collision system object + real(DP), intent(in) :: f_spin !! Fraction of energy or momentum that goes into spin (whichever gives the lowest kinetic energy) + logical, intent(out) :: lfailure !! Logical flag indicating whether this step fails or succeeds! ! Internals real(DP), dimension(NDIM) :: L_remainder, rot_L, rot_ke, L - real(DP), dimension(NDIM,fragments%nbody) :: frot_rand ! The random rotation factor applied to fragments + real(DP), dimension(NDIM,collision_system%fragments%nbody) :: frot_rand ! The random rotation factor applied to fragments real(DP), parameter :: frot_rand_mag = 1.50_DP ! The magnitude of the rotation variation to apply to the fragments integer(I4B) :: i character(len=STRMAX) :: message real(DP) :: ke_remainder, ke - associate(nfrag => fragments%nbody) + associate(impactors => collision_system%impactors, nfrag => collision_system%fragments%nbody) + select type(fragments => collision_system%fragments) + class is (fraggle_fragments) lfailure = .false. L_remainder(:) = fragments%L_budget(:) ke_remainder = fragments%ke_budget @@ -337,13 +337,14 @@ subroutine fraggle_generate_spins(fragments, impactors, f_spin, lfailure) call io_log_one_message(FRAGGLE_LOG_OUT, "ke_remainder : " // trim(adjustl(message))) end if + end select end associate return end subroutine fraggle_generate_spins - subroutine fraggle_generate_tan_vel(fragments, impactors, lfailure) + subroutine fraggle_generate_tan_vel(collision_system, lfailure) !! Author: Jennifer L.L. Pouplin, Carlisle A. Wishard, and David A. Minton !! !! Adjusts the tangential velocities and spins of a collection of fragments such that they conserve angular momentum without blowing the fragment kinetic energy budget. @@ -358,8 +359,7 @@ subroutine fraggle_generate_tan_vel(fragments, impactors, lfailure) !! A failure will trigger a restructuring of the fragments so we will try new values of the radial position distribution. implicit none ! Arguments - class(fraggle_fragments), intent(inout) :: fragments !! Fraggle fragment system object - class(collision_impactors), intent(inout) :: impactors !! Fraggle collider system object + class(fraggle_system), intent(inout) :: collision_system !! Fraggle collision system object logical, intent(out) :: lfailure !! Logical flag indicating whether this step fails or succeeds ! Internals integer(I4B) :: i, try @@ -370,13 +370,15 @@ subroutine fraggle_generate_tan_vel(fragments, impactors, lfailure) integer(I4B), parameter :: MAXTRY = 100 real(DP) :: tol real(DP), dimension(:), allocatable :: v_t_initial, v_t_output - real(DP), dimension(fragments%nbody) :: kefrag, vnoise + real(DP), dimension(collision_system%fragments%nbody) :: kefrag, vnoise type(lambda_obj_err) :: objective_function real(DP), dimension(NDIM) :: L_frag_tot character(len=STRMAX) :: message real(DP) :: ke_diff - associate(nfrag => fragments%nbody) + associate(impactors => collision_system%impactors, nfrag => collision_system%fragments%nbody) + select type(fragments => collision_system%fragments) + class is (fraggle_fragments) lfailure = .false. allocate(v_t_initial, mold=fragments%v_t_mag) @@ -406,9 +408,9 @@ subroutine fraggle_generate_tan_vel(fragments, impactors, lfailure) ! Perform one final shift of the radial velocity vectors to align with the center of mass of the collisional system (the origin) fragments%vb(:,1:nfrag) = fraggle_util_vmag_to_vb(fragments%v_r_mag(1:nfrag), fragments%v_r_unit(:,1:nfrag), fragments%v_t_mag(1:nfrag), & - fragments%v_t_unit(:,1:nfrag), fragments%mass(1:nfrag), fragments%vbcom(:)) + fragments%v_t_unit(:,1:nfrag), fragments%mass(1:nfrag), impactors%vbcom(:)) do concurrent (i = 1:nfrag) - fragments%vc(:,i) = fragments%vb(:,i) - fragments%vbcom(:) + fragments%vc(:,i) = fragments%vb(:,i) - impactors%vbcom(:) end do ! Now do a kinetic energy budget check to make sure we are still within the budget. @@ -429,7 +431,7 @@ subroutine fraggle_generate_tan_vel(fragments, impactors, lfailure) call io_log_one_message(FRAGGLE_LOG_OUT, "Tangential velocity failure diagnostics") call fragments%get_angular_momentum() L_frag_tot = fragments%Lspin(:) + fragments%Lorbit(:) - write(message, *) .mag.(fragments%L_budget(:) - L_frag_tot(:)) / (.mag.fragments%Ltot_before(:)) + write(message, *) .mag.(fragments%L_budget(:) - L_frag_tot(:)) / (.mag.collision_system%Ltot(:,1)) call io_log_one_message(FRAGGLE_LOG_OUT, "|L_remainder| : " // trim(adjustl(message))) write(message, *) fragments%ke_budget call io_log_one_message(FRAGGLE_LOG_OUT, "ke_budget : " // trim(adjustl(message))) @@ -440,6 +442,7 @@ subroutine fraggle_generate_tan_vel(fragments, impactors, lfailure) write(message, *) fragments%ke_budget - fragments%ke_spin - fragments%ke_orbit call io_log_one_message(FRAGGLE_LOG_OUT, "ke_radial : " // trim(adjustl(message))) end if + end select end associate return @@ -461,7 +464,9 @@ function solve_fragment_tan_vel(lfailure, v_t_mag_input) result(v_t_mag_output) real(DP), dimension(2 * NDIM, 2 * NDIM) :: A ! LHS of linear equation used to solve for momentum constraint in Gauss elimination code real(DP), dimension(2 * NDIM) :: b ! RHS of linear equation used to solve for momentum constraint in Gauss elimination code real(DP), dimension(NDIM) :: L_lin_others, L_orb_others, L, vtmp - + + select type(fragments => collision_system%fragments) + class is (fraggle_fragments) associate(nfrag => fragments%nbody) lfailure = .false. ! We have 6 constraint equations (2 vector constraints in 3 dimensions each) @@ -486,6 +491,7 @@ function solve_fragment_tan_vel(lfailure, v_t_mag_input) result(v_t_mag_output) v_t_mag_output(1:6) = util_solve_linear_system(A, b, 6, lfailure) if (present(v_t_mag_input)) v_t_mag_output(7:nfrag) = v_t_mag_input(:) end associate + end select return end function solve_fragment_tan_vel @@ -502,15 +508,17 @@ function tangential_objective_function(v_t_mag_input, lfailure) result(fval) real(DP) :: fval ! Internals integer(I4B) :: i - real(DP), dimension(NDIM,fragments%nbody) :: v_shift - real(DP), dimension(fragments%nbody) :: v_t_new, kearr + real(DP), dimension(NDIM,collision_system%fragments%nbody) :: v_shift + real(DP), dimension(collision_system%fragments%nbody) :: v_t_new, kearr real(DP) :: keo - - associate(nfrag => fragments%nbody) + + select type(fragments => collision_system%fragments) + class is (fraggle_fragments) + associate(impactors => collision_system%impactors, nfrag => fragments%nbody) lfailure = .false. v_t_new(:) = solve_fragment_tan_vel(v_t_mag_input=v_t_mag_input(:), lfailure=lfailure) - v_shift(:,:) = fraggle_util_vmag_to_vb(fragments%v_r_mag, fragments%v_r_unit, v_t_new, fragments%v_t_unit, fragments%mass, fragments%vbcom) + v_shift(:,:) = fraggle_util_vmag_to_vb(fragments%v_r_mag, fragments%v_r_unit, v_t_new, fragments%v_t_unit, fragments%mass, impactors%vbcom) kearr = 0.0_DP do concurrent(i = 1:nfrag) @@ -520,6 +528,7 @@ function tangential_objective_function(v_t_mag_input, lfailure) result(fval) fval = keo lfailure = .false. end associate + end select return end function tangential_objective_function @@ -527,15 +536,14 @@ end function tangential_objective_function end subroutine fraggle_generate_tan_vel - subroutine fraggle_generate_rad_vel(fragments, impactors, lfailure) + subroutine fraggle_generate_rad_vel(collision_system, lfailure) !! Author: Jennifer L.L. Pouplin, Carlisle A. Wishard, and David A. Minton !! !! !! Adjust the fragment velocities to set the fragment orbital kinetic energy. This will minimize the difference between the fragment kinetic energy and the energy budget implicit none ! Arguments - class(fraggle_fragments), intent(inout) :: fragments !! Fraggle fragment system object - class(collision_impactors), intent(inout) :: impactors !! Fraggle collider system object + class(fraggle_system), intent(inout) :: collision_system !! Fraggle collision system object logical, intent(out) :: lfailure !! Logical flag indicating whether this step fails or succeeds! ! Internals real(DP), parameter :: TOL_MIN = FRAGGLE_ETOL ! This needs to be more accurate than the tangential step, as we are trying to minimize the total residual energy @@ -545,11 +553,13 @@ subroutine fraggle_generate_rad_vel(fragments, impactors, lfailure) real(DP) :: ke_radial, tol integer(I4B) :: i real(DP), dimension(:), allocatable :: v_r_initial - real(DP), dimension(fragments%nbody) :: vnoise + real(DP), dimension(collision_system%fragments%nbody) :: vnoise type(lambda_obj) :: objective_function character(len=STRMAX) :: message - associate(nfrag => fragments%nbody) + associate(impactors => collision_system%impactors, nfrag => collision_system%fragments%nbody) + select type(fragments => collision_system%fragments) + class is (fraggle_fragments) ! Set the "target" ke for the radial component allocate(v_r_initial, source=fragments%v_r_mag) @@ -580,9 +590,9 @@ subroutine fraggle_generate_rad_vel(fragments, impactors, lfailure) fragments%ke_orbit = 0.0_DP fragments%ke_spin = 0.0_DP fragments%vb(:,1:nfrag) = fraggle_util_vmag_to_vb(fragments%v_r_mag(1:nfrag), fragments%v_r_unit(:,1:nfrag), & - fragments%v_t_mag(1:nfrag), fragments%v_t_unit(:,1:nfrag), fragments%mass(1:nfrag), fragments%vbcom(:)) + fragments%v_t_mag(1:nfrag), fragments%v_t_unit(:,1:nfrag), fragments%mass(1:nfrag), impactors%vbcom(:)) do i = 1, nfrag - fragments%vc(:, i) = fragments%vb(:, i) - fragments%vbcom(:) + fragments%vc(:, i) = fragments%vb(:, i) - impactors%vbcom(:) fragments%ke_orbit = fragments%ke_orbit + fragments%mass(i) * norm2(fragments%vb(:, i)) fragments%ke_spin = fragments%ke_spin + fragments%mass(i) * fragments%radius(i)**2 * fragments%Ip(3,i) * norm2(fragments%rot(:,i)) end do @@ -603,6 +613,7 @@ subroutine fraggle_generate_rad_vel(fragments, impactors, lfailure) call io_log_one_message(FRAGGLE_LOG_OUT, "ke_remainder : " // trim(adjustl(message))) end if + end select end associate return @@ -620,23 +631,29 @@ function radial_objective_function(v_r_mag_input) result(fval) ! Internals integer(I4B) :: i real(DP), dimension(:,:), allocatable :: v_shift - real(DP), dimension(fragments%nbody) :: kearr + real(DP), dimension(collision_system%fragments%nbody) :: kearr real(DP) :: keo, ke_radial, rotmag2, vmag2 - - allocate(v_shift, mold=fragments%vb) - v_shift(:,:) = fraggle_util_vmag_to_vb(v_r_mag_input, fragments%v_r_unit, fragments%v_t_mag, fragments%v_t_unit, fragments%mass, fragments%vbcom) - !$omp do simd firstprivate(fragments) - do i = 1,fragments%nbody - rotmag2 = fragments%rot(1,i)**2 + fragments%rot(2,i)**2 + fragments%rot(3,i)**2 - vmag2 = v_shift(1,i)**2 + v_shift(2,i)**2 + v_shift(3,i)**2 - kearr(i) = fragments%mass(i) * (fragments%Ip(3, i) * fragments%radius(i)**2 * rotmag2 + vmag2) - end do - !$omp end do simd - keo = 2 * fragments%ke_budget - sum(kearr(:)) - ke_radial = fragments%ke_budget - fragments%ke_orbit - fragments%ke_spin - ! The following ensures that fval = 0 is a local minimum, which is what the BFGS method is searching for - fval = (keo / (2 * ke_radial))**2 - + + associate(impactors => collision_system%impactors, nfrag => collision_system%fragments%nbody) + select type(fragments => collision_system%fragments) + class is (fraggle_fragments) + allocate(v_shift, mold=fragments%vb) + v_shift(:,:) = fraggle_util_vmag_to_vb(v_r_mag_input, fragments%v_r_unit, fragments%v_t_mag, fragments%v_t_unit, fragments%mass, impactors%vbcom) + !$omp do simd firstprivate(fragments) + do i = 1,fragments%nbody + rotmag2 = fragments%rot(1,i)**2 + fragments%rot(2,i)**2 + fragments%rot(3,i)**2 + vmag2 = v_shift(1,i)**2 + v_shift(2,i)**2 + v_shift(3,i)**2 + kearr(i) = fragments%mass(i) * (fragments%Ip(3, i) * fragments%radius(i)**2 * rotmag2 + vmag2) + end do + !$omp end do simd + keo = 2 * fragments%ke_budget - sum(kearr(:)) + ke_radial = fragments%ke_budget - fragments%ke_orbit - fragments%ke_spin + ! The following ensures that fval = 0 is a local minimum, which is what the BFGS method is searching for + fval = (keo / (2 * ke_radial))**2 + + end select + end associate + return end function radial_objective_function diff --git a/src/fraggle/fraggle_io.f90 b/src/fraggle/fraggle_io.f90 index c55db4173..e13c46472 100644 --- a/src/fraggle/fraggle_io.f90 +++ b/src/fraggle/fraggle_io.f90 @@ -12,40 +12,40 @@ contains - module subroutine fraggle_io_log_regime(impactors, fragments) + module subroutine fraggle_io_log_regime(collision_system) !! author: David A. Minton !! !! Writes a log of the results of the collisional regime determination implicit none ! Arguments - class(collision_impactors), intent(in) :: impactors !! Fraggle collider system object - class(fraggle_fragments), intent(in) :: fragments !! Fraggle fragment object + class(fraggle_system), intent(inout) :: collision_system !! Fraggle collision system object ! Internals character(STRMAX) :: errmsg - open(unit=LUN, file=FRAGGLE_LOG_OUT, status = 'OLD', position = 'APPEND', form = 'FORMATTED', err = 667, iomsg = errmsg) - write(LUN, *, err = 667, iomsg = errmsg) - write(LUN, *) "--------------------------------------------------------------------" - write(LUN, *) " Fraggle collisional regime determination results" - write(LUN, *) "--------------------------------------------------------------------" - write(LUN, *) "True number of impactors : ",impactors%ncoll - write(LUN, *) "Index list of true impactors : ",impactors%idx(1:impactors%ncoll) - select case(impactors%regime) - case(COLLRESOLVE_REGIME_MERGE) - write(LUN, *) "Regime: Merge" - case(COLLRESOLVE_REGIME_DISRUPTION) - write(LUN, *) "Regime: Disruption" - case(COLLRESOLVE_REGIME_SUPERCATASTROPHIC) - write(LUN, *) "Regime: Supercatastrophic disruption" - case(COLLRESOLVE_REGIME_GRAZE_AND_MERGE) - write(LUN, *) "Regime: Graze and merge" - case(COLLRESOLVE_REGIME_HIT_AND_RUN) - write(LUN, *) "Regime: Hit and run" - end select - write(LUN, *) "Energy loss : ", impactors%Qloss - write(LUN, *) "--------------------------------------------------------------------" - close(LUN) - + associate(fragments => collision_system%fragments, impactors => collision_system%impactors) + open(unit=LUN, file=FRAGGLE_LOG_OUT, status = 'OLD', position = 'APPEND', form = 'FORMATTED', err = 667, iomsg = errmsg) + write(LUN, *, err = 667, iomsg = errmsg) + write(LUN, *) "--------------------------------------------------------------------" + write(LUN, *) " Fraggle collisional regime determination results" + write(LUN, *) "--------------------------------------------------------------------" + write(LUN, *) "True number of impactors : ",impactors%ncoll + write(LUN, *) "Index list of true impactors : ",impactors%idx(1:impactors%ncoll) + select case(impactors%regime) + case(COLLRESOLVE_REGIME_MERGE) + write(LUN, *) "Regime: Merge" + case(COLLRESOLVE_REGIME_DISRUPTION) + write(LUN, *) "Regime: Disruption" + case(COLLRESOLVE_REGIME_SUPERCATASTROPHIC) + write(LUN, *) "Regime: Supercatastrophic disruption" + case(COLLRESOLVE_REGIME_GRAZE_AND_MERGE) + write(LUN, *) "Regime: Graze and merge" + case(COLLRESOLVE_REGIME_HIT_AND_RUN) + write(LUN, *) "Regime: Hit and run" + end select + write(LUN, *) "Energy loss : ", impactors%Qloss + write(LUN, *) "--------------------------------------------------------------------" + close(LUN) + end associate return 667 continue write(*,*) "Error writing Fraggle regime information to log file: " // trim(adjustl(errmsg)) diff --git a/src/fraggle/fraggle_regime.f90 b/src/fraggle/fraggle_regime.f90 index 2873d236d..09015c66c 100644 --- a/src/fraggle/fraggle_regime.f90 +++ b/src/fraggle/fraggle_regime.f90 @@ -62,22 +62,22 @@ module subroutine encounter_regime_impactors(self, fragments, system, param) x1_si(:), x2_si(:), v1_si(:), v2_si(:), density_si(jtarg), density_si(jproj), & min_mfrag_si, impactors%regime, mlr, mslr, impactors%Qloss) - fragments%mass_dist(1) = min(max(mlr, 0.0_DP), mtot) - fragments%mass_dist(2) = min(max(mslr, 0.0_DP), mtot) - fragments%mass_dist(3) = min(max(mtot - mlr - mslr, 0.0_DP), mtot) + impactors%mass_dist(1) = min(max(mlr, 0.0_DP), mtot) + impactors%mass_dist(2) = min(max(mslr, 0.0_DP), mtot) + impactors%mass_dist(3) = min(max(mtot - mlr - mslr, 0.0_DP), mtot) ! Find the center of mass of the collisional system fragments%mtot = sum(impactors%mass(:)) - fragments%rbcom(:) = (impactors%mass(1) * impactors%rb(:,1) + impactors%mass(2) * impactors%rb(:,2)) / fragments%mtot - fragments%vbcom(:) = (impactors%mass(1) * impactors%vb(:,1) + impactors%mass(2) * impactors%vb(:,2)) / fragments%mtot + impactors%rbcom(:) = (impactors%mass(1) * impactors%rb(:,1) + impactors%mass(2) * impactors%rb(:,2)) / fragments%mtot + impactors%vbcom(:) = (impactors%mass(1) * impactors%vb(:,1) + impactors%mass(2) * impactors%vb(:,2)) / fragments%mtot ! Find the point of impact between the two bodies runit(:) = impactors%rb(:,2) - impactors%rb(:,1) runit(:) = runit(:) / (.mag. runit(:)) - fragments%rbimp(:) = impactors%rb(:,1) + impactors%radius(1) * runit(:) + impactors%rbimp(:) = impactors%rb(:,1) + impactors%radius(1) * runit(:) ! Convert quantities back to the system units and save them into the fragment system - fragments%mass_dist(:) = (fragments%mass_dist(:) / param%MU2KG) + impactors%mass_dist(:) = (impactors%mass_dist(:) / param%MU2KG) impactors%Qloss = impactors%Qloss * (param%TU2S / param%DU2M)**2 / param%MU2KG call fraggle_io_log_regime(impactors, fragments) diff --git a/src/fraggle/fraggle_set.f90 b/src/fraggle/fraggle_set.f90 index 0da950206..20770a1d0 100644 --- a/src/fraggle/fraggle_set.f90 +++ b/src/fraggle/fraggle_set.f90 @@ -11,31 +11,34 @@ use swiftest contains - module subroutine fraggle_set_budgets_fragments(self) + module subroutine fraggle_set_budgets(self) !! author: David A. Minton !! !! Sets the energy and momentum budgets of the fragments based on the collider values and the before/after values of energy and momentum implicit none ! Arguments - class(collision_system), intent(inout) :: self !! Fraggle fragment system object + class(fraggle_system), intent(inout) :: self !! Fraggle collision system object ! Internals real(DP) :: dEtot real(DP), dimension(NDIM) :: dL - associate(impactors => self%impactors, fragments => self%fragments) + associate(impactors => self%impactors) + select type(fragments => self%fragments) + class is (fraggle_fragments) dEtot = self%Etot(2) - self%Etot(1) dL(:) = self%Ltot(:,2) - self%Ltot(:,1) fragments%L_budget(:) = -dL(:) - fragments%ke_budget = -(dEtot - 0.5_DP * fragments%mtot * dot_product(fragments%vbcom(:), fragments%vbcom(:))) - impactors%Qloss + fragments%ke_budget = -(dEtot - 0.5_DP * fragments%mtot * dot_product(impactors%vbcom(:), impactors%vbcom(:))) - impactors%Qloss + end select end associate return - end subroutine fraggle_set_budgets_fragments + end subroutine fraggle_set_budgets - module subroutine fraggle_set_mass_dist_fragments(self, impactors, param) + module subroutine fraggle_set_mass_dist(self, param) !! author: David A. Minton !! !! Sets the mass of fragments based on the mass distribution returned by the regime calculation. @@ -43,9 +46,8 @@ module subroutine fraggle_set_mass_dist_fragments(self, impactors, param) !! implicit none ! Arguments - class(fraggle_fragments), intent(inout) :: self !! Fraggle fragment system object - class(collision_impactors), intent(inout) :: impactors !! Fraggle collider system object - class(swiftest_parameters), intent(in) :: param !! Current Swiftest run configuration parameters + class(fraggle_system), intent(inout) :: self !! Fraggle collision system object + class(swiftest_parameters), intent(in) :: param !! Current Swiftest run configuration parameters ! Internals integer(I4B) :: i, jproj, jtarg, nfrag, istart real(DP), dimension(2) :: volume @@ -59,7 +61,9 @@ module subroutine fraggle_set_mass_dist_fragments(self, impactors, param) integer(I4B), parameter :: iMslr = 2 integer(I4B), parameter :: iMrem = 3 - associate(fragments => self) + associate(impactors => self%impactors) + select type(fragments => self%fragments) + class is (fraggle_fragments) ! Get mass weighted mean of Ip and density volume(1:2) = 4._DP / 3._DP * PI * impactors%radius(1:2)**3 Ip_avg(:) = (impactors%mass(1) * impactors%Ip(:,1) + impactors%mass(2) * impactors%Ip(:,2)) / fragments%mtot @@ -92,9 +96,9 @@ module subroutine fraggle_set_mass_dist_fragments(self, impactors, param) end select i = iMrem - mremaining = fragments%mass_dist(iMrem) + mremaining = impactors%mass_dist(iMrem) do while (i <= nfrag) - mfrag = (1 + i - iMslr)**(-3._DP / BETA) * fragments%mass_dist(iMslr) + mfrag = (1 + i - iMslr)**(-3._DP / BETA) * impactors%mass_dist(iMslr) if (mremaining - mfrag < 0.0_DP) exit mremaining = mremaining - mfrag i = i + 1 @@ -104,9 +108,9 @@ module subroutine fraggle_set_mass_dist_fragments(self, impactors, param) call fragments%setup(nfrag, param) case (COLLRESOLVE_REGIME_MERGE, COLLRESOLVE_REGIME_GRAZE_AND_MERGE) call fragments%setup(1, param) - fragments%mass(1) = fragments%mass_dist(1) + fragments%mass(1) = impactors%mass_dist(1) fragments%radius(1) = impactors%radius(jtarg) - fragments%density(1) = fragments%mass_dist(1) / volume(jtarg) + fragments%density(1) = impactors%mass_dist(1) / volume(jtarg) if (param%lrotation) fragments%Ip(:, 1) = impactors%Ip(:,1) return case default @@ -114,13 +118,13 @@ module subroutine fraggle_set_mass_dist_fragments(self, impactors, param) end select ! Make the first two bins the same as the Mlr and Mslr values that came from encounter_regime - fragments%mass(1) = fragments%mass_dist(iMlr) - fragments%mass(2) = fragments%mass_dist(iMslr) + fragments%mass(1) = impactors%mass_dist(iMlr) + fragments%mass(2) = impactors%mass_dist(iMslr) ! Distribute the remaining mass the 3:nfrag bodies following the model SFD given by slope BETA - mremaining = fragments%mass_dist(iMrem) + mremaining = impactors%mass_dist(iMrem) do i = iMrem, nfrag - mfrag = (1 + i - iMslr)**(-3._DP / BETA) * fragments%mass_dist(iMslr) + mfrag = (1 + i - iMslr)**(-3._DP / BETA) * impactors%mass_dist(iMslr) fragments%mass(i) = mfrag mremaining = mremaining - mfrag end do @@ -142,7 +146,7 @@ module subroutine fraggle_set_mass_dist_fragments(self, impactors, param) select case(impactors%regime) case(COLLRESOLVE_REGIME_HIT_AND_RUN) ! The hit and run case always preserves the largest body intact, so there is no need to recompute the physical properties of the first fragment fragments%radius(1) = impactors%radius(jtarg) - fragments%density(1) = fragments%mass_dist(iMlr) / volume(jtarg) + fragments%density(1) = impactors%mass_dist(iMlr) / volume(jtarg) fragments%Ip(:, 1) = impactors%Ip(:,1) istart = 2 case default @@ -153,55 +157,53 @@ module subroutine fraggle_set_mass_dist_fragments(self, impactors, param) do i = istart, nfrag fragments%Ip(:, i) = Ip_avg(:) end do - + end select end associate return - end subroutine fraggle_set_mass_dist_fragments - + end subroutine fraggle_set_mass_dist - module subroutine fraggle_set_natural_scale_factors(self, impactors) + module subroutine fraggle_set_natural_scale_factors(self) !! author: David A. Minton !! !! Scales dimenional quantities to ~O(1) with respect to the collisional system. !! This scaling makes it easier for the non-linear minimization to converge on a solution implicit none ! Arguments - class(fraggle_fragments), intent(inout) :: self !! Fraggle fragment system object - class(collision_impactors), intent(inout) :: impactors !! Fraggle collider system object + class(fraggle_system), intent(inout) :: self !! Fraggle collision system object ! Internals integer(I4B) :: i - associate(fragments => self) + associate(collision_system => self, fragments => self%fragments, impactors => self%impactors) ! Set scale factors - fragments%Escale = 0.5_DP * (impactors%mass(1) * dot_product(impactors%vb(:,1), impactors%vb(:,1)) & - + impactors%mass(2) * dot_product(impactors%vb(:,2), impactors%vb(:,2))) - fragments%dscale = sum(impactors%radius(:)) - fragments%mscale = fragments%mtot - fragments%vscale = sqrt(fragments%Escale / fragments%mscale) - fragments%tscale = fragments%dscale / fragments%vscale - fragments%Lscale = fragments%mscale * fragments%dscale * fragments%vscale + collision_system%Escale = 0.5_DP * ( impactors%mass(1) * dot_product(impactors%vb(:,1), impactors%vb(:,1)) & + + impactors%mass(2) * dot_product(impactors%vb(:,2), impactors%vb(:,2))) + collision_system%dscale = sum(impactors%radius(:)) + collision_system%mscale = fragments%mtot + collision_system%vscale = sqrt(collision_system%Escale / collision_system%mscale) + collision_system%tscale = collision_system%dscale / collision_system%vscale + collision_system%Lscale = collision_system%mscale * collision_system%dscale * collision_system%vscale ! Scale all dimensioned quantities of impactors and fragments - fragments%rbcom(:) = fragments%rbcom(:) / fragments%dscale - fragments%vbcom(:) = fragments%vbcom(:) / fragments%vscale - fragments%rbimp(:) = fragments%rbimp(:) / fragments%dscale - impactors%rb(:,:) = impactors%rb(:,:) / fragments%dscale - impactors%vb(:,:) = impactors%vb(:,:) / fragments%vscale - impactors%mass(:) = impactors%mass(:) / fragments%mscale - impactors%radius(:) = impactors%radius(:) / fragments%dscale - impactors%Lspin(:,:) = impactors%Lspin(:,:) / fragments%Lscale - impactors%Lorbit(:,:) = impactors%Lorbit(:,:) / fragments%Lscale + impactors%rbcom(:) = impactors%rbcom(:) / collision_system%dscale + impactors%vbcom(:) = impactors%vbcom(:) / collision_system%vscale + impactors%rbimp(:) = impactors%rbimp(:) / collision_system%dscale + impactors%rb(:,:) = impactors%rb(:,:) / collision_system%dscale + impactors%vb(:,:) = impactors%vb(:,:) / collision_system%vscale + impactors%mass(:) = impactors%mass(:) / collision_system%mscale + impactors%radius(:) = impactors%radius(:) / collision_system%dscale + impactors%Lspin(:,:) = impactors%Lspin(:,:) / collision_system%Lscale + impactors%Lorbit(:,:) = impactors%Lorbit(:,:) / collision_system%Lscale do i = 1, 2 impactors%rot(:,i) = impactors%Lspin(:,i) / (impactors%mass(i) * impactors%radius(i)**2 * impactors%Ip(3, i)) end do - fragments%mtot = fragments%mtot / fragments%mscale - fragments%mass = fragments%mass / fragments%mscale - fragments%radius = fragments%radius / fragments%dscale - impactors%Qloss = impactors%Qloss / fragments%Escale + fragments%mtot = fragments%mtot / collision_system%mscale + fragments%mass = fragments%mass / collision_system%mscale + fragments%radius = fragments%radius / collision_system%dscale + impactors%Qloss = impactors%Qloss / collision_system%Escale end associate return @@ -215,8 +217,7 @@ module subroutine fraggle_set_original_scale_factors(self) use, intrinsic :: ieee_exceptions implicit none ! Arguments - class(fraggle_fragments), intent(inout) :: self !! Fraggle fragment system object - class(collision_impactors), intent(inout) :: impactors !! Fraggle collider system object + class(fraggle_system), intent(inout) :: self !! Fraggle fragment system object ! Internals integer(I4B) :: i logical, dimension(size(IEEE_ALL)) :: fpe_halting_modes @@ -224,58 +225,50 @@ module subroutine fraggle_set_original_scale_factors(self) call ieee_get_halting_mode(IEEE_ALL,fpe_halting_modes) ! Save the current halting modes so we can turn them off temporarily call ieee_set_halting_mode(IEEE_ALL,.false.) - associate(fragments => self) + associate(collision_system => self, fragments => self%fragments, impactors => self%impactors) ! Restore scale factors - fragments%rbcom(:) = fragments%rbcom(:) * fragments%dscale - fragments%vbcom(:) = fragments%vbcom(:) * fragments%vscale - fragments%rbimp(:) = fragments%rbimp(:) * fragments%dscale + impactors%rbcom(:) = impactors%rbcom(:) * collision_system%dscale + impactors%vbcom(:) = impactors%vbcom(:) * collision_system%vscale + impactors%rbimp(:) = impactors%rbimp(:) * collision_system%dscale - impactors%mass = impactors%mass * fragments%mscale - impactors%radius = impactors%radius * fragments%dscale - impactors%rb = impactors%rb * fragments%dscale - impactors%vb = impactors%vb * fragments%vscale - impactors%Lspin = impactors%Lspin * fragments%Lscale + impactors%mass = impactors%mass * collision_system%mscale + impactors%radius = impactors%radius * collision_system%dscale + impactors%rb = impactors%rb * collision_system%dscale + impactors%vb = impactors%vb * collision_system%vscale + impactors%Lspin = impactors%Lspin * collision_system%Lscale do i = 1, 2 impactors%rot(:,i) = impactors%Lspin(:,i) * (impactors%mass(i) * impactors%radius(i)**2 * impactors%Ip(3, i)) end do - fragments%mtot = fragments%mtot * fragments%mscale - fragments%mass = fragments%mass * fragments%mscale - fragments%radius = fragments%radius * fragments%dscale - fragments%rot = fragments%rot / fragments%tscale - fragments%rc = fragments%rc * fragments%dscale - fragments%vc = fragments%vc * fragments%vscale + fragments%mtot = fragments%mtot * collision_system%mscale + fragments%mass = fragments%mass * collision_system%mscale + fragments%radius = fragments%radius * collision_system%dscale + fragments%rot = fragments%rot / collision_system%tscale + fragments%rc = fragments%rc * collision_system%dscale + fragments%vc = fragments%vc * collision_system%vscale do i = 1, fragments%nbody - fragments%rb(:, i) = fragments%rc(:, i) + fragments%rbcom(:) - fragments%vb(:, i) = fragments%vc(:, i) + fragments%vbcom(:) + fragments%rb(:, i) = fragments%rc(:, i) + impactors%rbcom(:) + fragments%vb(:, i) = fragments%vc(:, i) + impactors%vbcom(:) end do - impactors%Qloss = impactors%Qloss * fragments%Escale + impactors%Qloss = impactors%Qloss * collision_system%Escale - fragments%Lorbit_before(:) = fragments%Lorbit_before * fragments%Lscale - fragments%Lspin_before(:) = fragments%Lspin_before * fragments%Lscale - fragments%Ltot_before(:) = fragments%Ltot_before * fragments%Lscale - fragments%ke_orbit_before = fragments%ke_orbit_before * fragments%Escale - fragments%ke_spin_before = fragments%ke_spin_before * fragments%Escale - fragments%pe_before = fragments%pe_before * fragments%Escale - fragments%Etot_before = fragments%Etot_before * fragments%Escale - - fragments%Lorbit_after(:) = fragments%Lorbit_after * fragments%Lscale - fragments%Lspin_after(:) = fragments%Lspin_after * fragments%Lscale - fragments%Ltot_after(:) = fragments%Ltot_after * fragments%Lscale - fragments%ke_orbit_after = fragments%ke_orbit_after * fragments%Escale - fragments%ke_spin_after = fragments%ke_spin_after * fragments%Escale - fragments%pe_after = fragments%pe_after * fragments%Escale - fragments%Etot_after = fragments%Etot_after * fragments%Escale + collision_system%Lorbit(:,:) = collision_system%Lorbit(:,:) * collision_system%Lscale + collision_system%Lspin(:,:) = collision_system%Lspin(:,:) * collision_system%Lscale + collision_system%Ltot(:,:) = collision_system%Ltot(:,:) * collision_system%Lscale + collision_system%ke_orbit(:) = collision_system%ke_orbit(:) * collision_system%Escale + collision_system%ke_spin(:) = collision_system%ke_spin(:) * collision_system%Escale + collision_system%pe(:) = collision_system%pe(:) * collision_system%Escale + collision_system%Etot(:) = collision_system%Etot(:) * collision_system%Escale - fragments%mscale = 1.0_DP - fragments%dscale = 1.0_DP - fragments%vscale = 1.0_DP - fragments%tscale = 1.0_DP - fragments%Lscale = 1.0_DP - fragments%Escale = 1.0_DP + collision_system%mscale = 1.0_DP + collision_system%dscale = 1.0_DP + collision_system%vscale = 1.0_DP + collision_system%tscale = 1.0_DP + collision_system%Lscale = 1.0_DP + collision_system%Escale = 1.0_DP end associate call ieee_set_halting_mode(IEEE_ALL,fpe_halting_modes) diff --git a/src/fraggle/fraggle_util.f90 b/src/fraggle/fraggle_util.f90 index 4d1a203fb..d550b7166 100644 --- a/src/fraggle/fraggle_util.f90 +++ b/src/fraggle/fraggle_util.f90 @@ -83,22 +83,22 @@ module subroutine fraggle_util_get_angular_momentum(self) end subroutine fraggle_util_get_angular_momentum - module subroutine fraggle_util_construct_temporary_system(fragments, system, param, tmpsys, tmpparam) + module subroutine fraggle_util_construct_temporary_system(collision_system, nbody_system, param, tmpsys, tmpparam) !! Author: David A. Minton !! !! Constructs a temporary internal system consisting of active bodies and additional fragments. This internal temporary system is used to calculate system energy with and without fragments implicit none ! Arguments - class(fraggle_fragments), intent(in) :: fragments !! Fraggle fragment system object - class(swiftest_nbody_system), intent(in) :: system !! Original swiftest nbody system object - class(swiftest_parameters), intent(in) :: param !! Current swiftest run configuration parameters - class(swiftest_nbody_system), allocatable, intent(out) :: tmpsys !! Output temporary swiftest nbody system object - class(swiftest_parameters), allocatable, intent(out) :: tmpparam !! Output temporary configuration run parameters + class(fraggle_system), intent(inout) :: collision_system !! Fraggle collision system object + class(swiftest_nbody_system), intent(in) :: nbody_system !! Original swiftest nbody system object + class(swiftest_parameters), intent(in) :: param !! Current swiftest run configuration parameters + class(swiftest_nbody_system), allocatable, intent(out) :: tmpsys !! Output temporary swiftest nbody system object + class(swiftest_parameters), allocatable, intent(out) :: tmpparam !! Output temporary configuration run parameters ! Internals logical, dimension(:), allocatable :: linclude integer(I4B) :: npl_tot - associate(nfrag => fragments%nbody, pl => system%pl, npl => system%pl%nbody, cb => system%cb) + associate(fragments => collision_system%fragments, nfrag => collision_system%fragments%nbody, pl => nbody_system%pl, npl => nbody_system%pl%nbody, cb => nbody_system%cb) ! Set up a new system based on the original if (allocated(tmpparam)) deallocate(tmpparam) if (allocated(tmpsys)) deallocate(tmpsys) @@ -123,7 +123,7 @@ module subroutine fraggle_util_construct_temporary_system(fragments, system, par call tmpsys%pl%fill(pl, linclude) ! Scale the temporary system to the natural units of the current Fraggle calculation - call tmpsys%rescale(tmpparam, fragments%mscale, fragments%dscale, fragments%tscale) + call tmpsys%rescale(tmpparam, collision_system%mscale, collision_system%dscale, collision_system%tscale) end associate diff --git a/src/modules/fraggle_classes.f90 b/src/modules/fraggle_classes.f90 index b8a558af8..eff70b1f8 100644 --- a/src/modules/fraggle_classes.f90 +++ b/src/modules/fraggle_classes.f90 @@ -34,20 +34,10 @@ module fraggle_classes real(DP), dimension(NDIM) :: Lspin !! Spin angular momentum vector of all fragments real(DP) :: ke_orbit !! Orbital kinetic energy of all fragments real(DP) :: ke_spin !! Spin kinetic energy of all fragments - real(DP) :: ke_budget !! Kinetic energy budget for computing quanities + real(DP) :: ke_budget !! Kinetic energy budget for computing fragment trajectories + real(DP), dimension(NDIM) :: L_budget !! Angular momentum budget for computing fragment trajectories - ! Scale factors used to scale dimensioned quantities to a more "natural" system where important quantities (like kinetic energy, momentum) are of order ~1 - real(DP) :: dscale = 1.0_DP !! Distance dimension scale factor - real(DP) :: mscale = 1.0_DP !! Mass scale factor - real(DP) :: tscale = 1.0_DP !! Time scale factor - real(DP) :: vscale = 1.0_DP !! Velocity scale factor (a convenience unit that is derived from dscale and tscale) - real(DP) :: Escale = 1.0_DP !! Energy scale factor (a convenience unit that is derived from dscale, tscale, and mscale) - real(DP) :: Lscale = 1.0_DP !! Angular momentum scale factor (a convenience unit that is derived from dscale, tscale, and mscale) contains - procedure :: set_budgets => fraggle_set_budgets_fragments !! Sets the energy and momentum budgets of the fragments based on the collider value - procedure :: set_mass_dist => fraggle_set_mass_dist_fragments !! Sets the distribution of mass among the fragments depending on the regime type - procedure :: set_natural_scale => fraggle_set_natural_scale_factors !! Scales dimenional quantities to ~O(1) with respect to the collisional system. - procedure :: set_original_scale => fraggle_set_original_scale_factors !! Restores dimenional quantities back to the original system units procedure :: setup => fraggle_setup_fragments !! Allocates arrays for n fragments in a Fraggle system. Passing n = 0 deallocates all arrays. procedure :: reset => fraggle_setup_reset_fragments !! Resets all position and velocity-dependent fragment quantities in order to do a fresh calculation (does not reset mass, radius, or other values that get set prior to the call to fraggle_generate) procedure :: get_angular_momentum => fraggle_util_get_angular_momentum !! Calcualtes the current angular momentum of the fragments @@ -58,9 +48,20 @@ module fraggle_classes end type fraggle_fragments type, extends(collision_system) :: fraggle_system + ! Scale factors used to scale dimensioned quantities to a more "natural" system where important quantities (like kinetic energy, momentum) are of order ~1 + real(DP) :: dscale = 1.0_DP !! Distance dimension scale factor + real(DP) :: mscale = 1.0_DP !! Mass scale factor + real(DP) :: tscale = 1.0_DP !! Time scale factor + real(DP) :: vscale = 1.0_DP !! Velocity scale factor (a convenience unit that is derived from dscale and tscale) + real(DP) :: Escale = 1.0_DP !! Energy scale factor (a convenience unit that is derived from dscale, tscale, and mscale) + real(DP) :: Lscale = 1.0_DP !! Angular momentum scale factor (a convenience unit that is derived from dscale, tscale, and mscale) contains - procedure :: generate_fragments => fraggle_generate_fragments !! Generates a system of fragments in barycentric coordinates that conserves energy and momentum. - final :: fraggle_util_final_system !! Finalizer will deallocate all allocatables + procedure :: generate_fragments => fraggle_generate_fragments !! Generates a system of fragments in barycentric coordinates that conserves energy and momentum. + procedure :: set_budgets => fraggle_set_budgets !! Sets the energy and momentum budgets of the fragments based on the collider value + procedure :: set_mass_dist => fraggle_set_mass_dist !! Sets the distribution of mass among the fragments depending on the regime type + procedure :: set_natural_scale => fraggle_set_natural_scale_factors !! Scales dimenional quantities to ~O(1) with respect to the collisional system. + procedure :: set_original_scale => fraggle_set_original_scale_factors !! Restores dimenional quantities back to the original system units + final :: fraggle_util_final_system !! Finalizer will deallocate all allocatables end type fraggle_system @@ -74,34 +75,30 @@ module subroutine fraggle_generate_fragments(self, system, param, lfailure) logical, intent(out) :: lfailure !! Answers the question: Should this have been a merger instead? end subroutine fraggle_generate_fragments - module subroutine fraggle_io_log_regime(impactors, fragments) + module subroutine fraggle_io_log_regime(collision_system) implicit none - class(collision_impactors), intent(in) :: impactors - class(fraggle_fragments), intent(in) :: fragments + class(fraggle_system), intent(inout) :: collision_system !! Fraggle collision system object end subroutine fraggle_io_log_regime - module subroutine fraggle_set_budgets_fragments(self) + module subroutine fraggle_set_budgets(self) implicit none - class(fraggle_fragments), intent(inout) :: self !! Fraggle fragment system object - end subroutine fraggle_set_budgets_fragments + class(fraggle_system), intent(inout) :: self !! Fraggle collision system object + end subroutine fraggle_set_budgets - module subroutine fraggle_set_mass_dist_fragments(self, impactors, param) + module subroutine fraggle_set_mass_dist(self, param) implicit none - class(fraggle_fragments), intent(inout) :: self !! Fraggle fragment system object - class(collision_impactors), intent(inout) :: impactors !! Fraggle collider system object - class(swiftest_parameters), intent(in) :: param !! Current Swiftest run configuration parameters - end subroutine fraggle_set_mass_dist_fragments + class(fraggle_system), intent(inout) :: self !! Fraggle collision system object + class(swiftest_parameters), intent(in) :: param !! Current Swiftest run configuration parameters + end subroutine fraggle_set_mass_dist - module subroutine fraggle_set_natural_scale_factors(self, impactors) + module subroutine fraggle_set_natural_scale_factors(self) implicit none - class(fraggle_fragments), intent(inout) :: self !! Fraggle fragment system object - class(collision_impactors), intent(inout) :: impactors !! Fraggle collider system object + class(fraggle_system), intent(inout) :: self !! Fraggle collision system object end subroutine fraggle_set_natural_scale_factors - module subroutine fraggle_set_original_scale_factors(self, impactors) + module subroutine fraggle_set_original_scale_factors(self) implicit none - class(fraggle_fragments), intent(inout) :: self !! Fraggle fragment system object - class(collision_impactors), intent(inout) :: impactors !! Fraggle collider system object + class(fraggle_system), intent(inout) :: self !! Fraggle collision system object end subroutine fraggle_set_original_scale_factors module subroutine fraggle_setup_fragments(self, n, param) @@ -130,14 +127,14 @@ module subroutine fraggle_util_get_angular_momentum(self) class(fraggle_fragments), intent(inout) :: self !! Fraggle fragment system object end subroutine fraggle_util_get_angular_momentum - module subroutine fraggle_util_construct_temporary_system(fragments, system, param, tmpsys, tmpparam) + module subroutine fraggle_util_construct_temporary_system(collision_system, nbody_system, param, tmpsys, tmpparam) use swiftest_classes, only : swiftest_nbody_system, swiftest_parameters implicit none - class(fraggle_fragments), intent(in) :: fragments !! Fraggle fragment system object - class(swiftest_nbody_system), intent(in) :: system !! Original swiftest nbody system object - class(swiftest_parameters), intent(in) :: param !! Current swiftest run configuration parameters - class(swiftest_nbody_system), allocatable, intent(out) :: tmpsys !! Output temporary swiftest nbody system object - class(swiftest_parameters), allocatable, intent(out) :: tmpparam !! Output temporary configuration run parameters + class(fraggle_system), intent(inout) :: collision_system !! Fraggle collision system object + class(swiftest_nbody_system), intent(in) :: nbody_system !! Original swiftest nbody system object + class(swiftest_parameters), intent(in) :: param !! Current swiftest run configuration parameters + class(swiftest_nbody_system), allocatable, intent(out) :: tmpsys !! Output temporary swiftest nbody system object + class(swiftest_parameters), allocatable, intent(out) :: tmpparam !! Output temporary configuration run parameters end subroutine fraggle_util_construct_temporary_system module subroutine fraggle_util_dealloc_fragments(self) diff --git a/src/symba/symba_collision.f90 b/src/symba/symba_collision.f90 index 16fd0d7bd..663e40b55 100644 --- a/src/symba/symba_collision.f90 +++ b/src/symba/symba_collision.f90 @@ -118,7 +118,7 @@ module function symba_collision_casehitandrun(system, param, t) result(status) jproj = 1 end if - if (fragments%mass_dist(2) > 0.9_DP * impactors%mass(jproj)) then ! Pure hit and run, so we'll just keep the two bodies untouched + if (impactors%mass_dist(2) > 0.9_DP * impactors%mass(jproj)) then ! Pure hit and run, so we'll just keep the two bodies untouched call io_log_one_message(FRAGGLE_LOG_OUT, "Pure hit and run. No new fragments generated.") nfrag = 0 lpure = .true. @@ -202,8 +202,8 @@ module function symba_collision_casemerge(system, param, t) result(status) ibiggest = impactors%idx(maxloc(pl%Gmass(impactors%idx(:)), dim=1)) fragments%id(1) = pl%id(ibiggest) - fragments%rb(:,1) = fragments%rbcom(:) - fragments%vb(:,1) = fragments%vbcom(:) + fragments%rb(:,1) = impactors%rbcom(:) + fragments%vb(:,1) = impactors%vbcom(:) if (param%lrotation) then ! Conserve angular momentum by putting pre-impact orbital momentum into spin of the new body @@ -939,11 +939,11 @@ subroutine symba_resolve_collision(plplcollision_list , system, param, t) associate(fragments => system%fragments, impactors => system%impactors) impactors%regime = COLLRESOLVE_REGIME_MERGE fragments%mtot = sum(impactors%mass(:)) - fragments%mass_dist(1) = fragments%mtot - fragments%mass_dist(2) = 0.0_DP - fragments%mass_dist(3) = 0.0_DP - fragments%rbcom(:) = (impactors%mass(1) * impactors%rb(:,1) + impactors%mass(2) * impactors%rb(:,2)) / fragments%mtot - fragments%vbcom(:) = (impactors%mass(1) * impactors%vb(:,1) + impactors%mass(2) * impactors%vb(:,2)) / fragments%mtot + impactors%mass_dist(1) = fragments%mtot + impactors%mass_dist(2) = 0.0_DP + impactors%mass_dist(3) = 0.0_DP + impactors%rbcom(:) = (impactors%mass(1) * impactors%rb(:,1) + impactors%mass(2) * impactors%rb(:,2)) / fragments%mtot + impactors%vbcom(:) = (impactors%mass(1) * impactors%vb(:,1) + impactors%mass(2) * impactors%vb(:,2)) / fragments%mtot end associate end if From da12dc98adb755bb6baaacac8cadcfacf74a9ba4 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Sat, 17 Dec 2022 10:29:09 -0500 Subject: [PATCH 454/569] More cleanup. It compiles again! --- src/CMakeLists.txt | 2 +- .../collision_regime.f90} | 25 ++++---- src/collision/collision_setup.f90 | 12 ++-- src/collision/collision_util.f90 | 19 +++--- src/fraggle/fraggle_set.f90 | 4 +- src/fraggle/fraggle_util.f90 | 6 +- src/modules/collision_classes.f90 | 49 ++++++++++----- src/modules/symba_classes.f90 | 5 +- src/setup/setup.f90 | 11 ++++ src/symba/symba_collision.f90 | 63 +++++++++---------- 10 files changed, 116 insertions(+), 80 deletions(-) rename src/{fraggle/fraggle_regime.f90 => collision/collision_regime.f90} (95%) diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index 90ace7141..95ee7e9a0 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -27,6 +27,7 @@ SET(FAST_MATH_FILES ${SRC}/modules/whm_classes.f90 ${SRC}/modules/swiftest.f90 ${SRC}/collision/collision_io.f90 + ${SRC}/collision/collision_regime.f90 ${SRC}/collision/collision_setup.f90 ${SRC}/collision/collision_util.f90 ${SRC}/discard/discard.f90 @@ -37,7 +38,6 @@ SET(FAST_MATH_FILES ${SRC}/encounter/encounter_io.f90 ${SRC}/fraggle/fraggle_generate.f90 ${SRC}/fraggle/fraggle_io.f90 - ${SRC}/fraggle/fraggle_regime.f90 ${SRC}/fraggle/fraggle_set.f90 ${SRC}/fraggle/fraggle_setup.f90 ${SRC}/fraggle/fraggle_util.f90 diff --git a/src/fraggle/fraggle_regime.f90 b/src/collision/collision_regime.f90 similarity index 95% rename from src/fraggle/fraggle_regime.f90 rename to src/collision/collision_regime.f90 index 09015c66c..89fdeb269 100644 --- a/src/fraggle/fraggle_regime.f90 +++ b/src/collision/collision_regime.f90 @@ -7,20 +7,19 @@ !! You should have received a copy of the GNU General Public License along with Swiftest. !! If not, see: https://www.gnu.org/licenses. -submodule(fraggle_classes) s_encounter_regime +submodule(collision_classes) s_collision_regime use swiftest contains - module subroutine encounter_regime_impactors(self, fragments, system, param) + module subroutine collision_regime_impactors(self, system, param) !! Author: Jennifer L.L. Pouplin, Carlisle A. Wishard, and David A. Minton !! !! Determine which fragmentation regime the set of impactors will be. This subroutine is a wrapper for the non-polymorphic raggle_regime_collresolve subroutine. !! It converts to SI units prior to calling implicit none ! Arguments - class(collision_impactors), intent(inout) :: self !! Fraggle impactors object - class(fraggle_fragments), intent(inout) :: fragments !! Fraggle fragment system object + class(collision_impactors), intent(inout) :: self !! Collision system impactors object class(swiftest_nbody_system), intent(in) :: system !! Swiftest nbody system object class(swiftest_parameters), intent(in) :: param !! Current Swiftest run configuration parameters ! Internals @@ -58,7 +57,7 @@ module subroutine encounter_regime_impactors(self, fragments, system, param) dentot = sum(mass_si(:) * density_si(:)) / mtot !! Use the positions and velocities of the parents from indside the step (at collision) to calculate the collisional regime - call encounter_regime_collresolve(Mcb_si, mass_si(jtarg), mass_si(jproj), radius_si(jtarg), radius_si(jproj), & + call collision_regime_collresolve(Mcb_si, mass_si(jtarg), mass_si(jproj), radius_si(jtarg), radius_si(jproj), & x1_si(:), x2_si(:), v1_si(:), v2_si(:), density_si(jtarg), density_si(jproj), & min_mfrag_si, impactors%regime, mlr, mslr, impactors%Qloss) @@ -67,9 +66,9 @@ module subroutine encounter_regime_impactors(self, fragments, system, param) impactors%mass_dist(3) = min(max(mtot - mlr - mslr, 0.0_DP), mtot) ! Find the center of mass of the collisional system - fragments%mtot = sum(impactors%mass(:)) - impactors%rbcom(:) = (impactors%mass(1) * impactors%rb(:,1) + impactors%mass(2) * impactors%rb(:,2)) / fragments%mtot - impactors%vbcom(:) = (impactors%mass(1) * impactors%vb(:,1) + impactors%mass(2) * impactors%vb(:,2)) / fragments%mtot + mtot = sum(impactors%mass(:)) + impactors%rbcom(:) = (impactors%mass(1) * impactors%rb(:,1) + impactors%mass(2) * impactors%rb(:,2)) / mtot + impactors%vbcom(:) = (impactors%mass(1) * impactors%vb(:,1) + impactors%mass(2) * impactors%vb(:,2)) / mtot ! Find the point of impact between the two bodies runit(:) = impactors%rb(:,2) - impactors%rb(:,1) @@ -80,14 +79,14 @@ module subroutine encounter_regime_impactors(self, fragments, system, param) impactors%mass_dist(:) = (impactors%mass_dist(:) / param%MU2KG) impactors%Qloss = impactors%Qloss * (param%TU2S / param%DU2M)**2 / param%MU2KG - call fraggle_io_log_regime(impactors, fragments) + !call fraggle_io_log_regime(impactors, fragments) end associate return - end subroutine encounter_regime_impactors + end subroutine collision_regime_impactors - subroutine encounter_regime_collresolve(Mcb, m1, m2, rad1, rad2, rh1, rh2, vb1, vb2, den1, den2, min_mfrag, & + subroutine collision_regime_collresolve(Mcb, m1, m2, rad1, rad2, rh1, rh2, vb1, vb2, den1, den2, min_mfrag, & regime, Mlr, Mslr, Qloss) !! Author: Jennifer L.L. Pouplin, Carlisle A. Wishard, and David A. Minton !! @@ -379,6 +378,6 @@ function calc_c_star(Rc1) result(c_star) return end function calc_c_star - end subroutine encounter_regime_collresolve + end subroutine collision_regime_collresolve -end submodule s_encounter_regime \ No newline at end of file +end submodule s_collision_regime \ No newline at end of file diff --git a/src/collision/collision_setup.f90 b/src/collision/collision_setup.f90 index 287d74109..d98883ca4 100644 --- a/src/collision/collision_setup.f90 +++ b/src/collision/collision_setup.f90 @@ -11,21 +11,25 @@ use swiftest contains - module subroutine collision_setup_system(self, system, param) + module subroutine collision_setup_system(self, param) !! author: David A. Minton !! !! Initializer for the encounter collision system. Allocates the collider and fragments classes and the before/after snapshots implicit none ! Arguments - class(collision_system), intent(inout) :: self !! Encounter collision system object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + class(collision_system), intent(inout) :: self !! Encounter collision system object + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters ! Internals + ! TODO: Check parameter file for fragmentation model in SyMBA + allocate(collision_impactors :: self%impactors) + allocate(fraggle_fragments :: self%fragments) + return end subroutine collision_setup_system + module subroutine collision_setup_fragments(self, n, param) !! author: David A. Minton !! diff --git a/src/collision/collision_util.f90 b/src/collision/collision_util.f90 index 0c435cfc6..819f9df76 100644 --- a/src/collision/collision_util.f90 +++ b/src/collision/collision_util.f90 @@ -81,8 +81,12 @@ module subroutine collision_util_final_system(self) implicit none ! Arguments type(collision_system), intent(inout) :: self !! Collision system object + ! Internals + type(swiftest_parameters) :: tmp_param - call self%reset() + call self%reset(tmp_param) + if (allocated(self%impactors)) deallocate(self%impactors) + if (allocated(self%fragments)) deallocate(self%fragments) return end subroutine collision_util_final_system @@ -298,17 +302,15 @@ module subroutine collision_util_reset_impactors(self) return end subroutine collision_util_reset_impactors - - module subroutine collision_util_reset_system(self) + module subroutine collision_util_reset_system(self, param) !! author: David A. Minton !! !! Resets the collider system and deallocates all allocatables implicit none ! Arguments - class(collision_system), intent(inout) :: self + class(collision_system), intent(inout) :: self !! Collision system object + class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters - if (allocated(self%impactors)) deallocate(self%impactors) - if (allocated(self%fragments)) deallocate(self%fragments) if (allocated(self%before)) deallocate(self%before) if (allocated(self%after)) deallocate(self%after) @@ -320,12 +322,13 @@ module subroutine collision_util_reset_system(self) self%pe(:) = 0.0_DP self%Etot(:) = 0.0_DP + call self%impactors%reset() + call self%fragments%setup(0, param) + return end subroutine collision_util_reset_system - - module subroutine collision_util_set_coordinate_system(self) !! author: David A. Minton !! diff --git a/src/fraggle/fraggle_set.f90 b/src/fraggle/fraggle_set.f90 index 20770a1d0..7c405db90 100644 --- a/src/fraggle/fraggle_set.f90 +++ b/src/fraggle/fraggle_set.f90 @@ -77,7 +77,7 @@ module subroutine fraggle_set_mass_dist(self, param) select case(impactors%regime) case(COLLRESOLVE_REGIME_DISRUPTION, COLLRESOLVE_REGIME_SUPERCATASTROPHIC, COLLRESOLVE_REGIME_HIT_AND_RUN) - ! The first two bins of the mass_dist are the largest and second-largest fragments that came out of encounter_regime. + ! The first two bins of the mass_dist are the largest and second-largest fragments that came out of collision_regime. ! The remainder from the third bin will be distributed among nfrag-2 bodies. The following code will determine nfrag based on ! the limits bracketed above and the model size distribution of fragments. ! Check to see if our size distribution would give us a smaller number of fragments than the maximum number @@ -117,7 +117,7 @@ module subroutine fraggle_set_mass_dist(self, param) write(*,*) "fraggle_set_mass_dist_fragments error: Unrecognized regime code",impactors%regime end select - ! Make the first two bins the same as the Mlr and Mslr values that came from encounter_regime + ! Make the first two bins the same as the Mlr and Mslr values that came from collision_regime fragments%mass(1) = impactors%mass_dist(iMlr) fragments%mass(2) = impactors%mass_dist(iMslr) diff --git a/src/fraggle/fraggle_util.f90 b/src/fraggle/fraggle_util.f90 index d550b7166..c1e2fccb5 100644 --- a/src/fraggle/fraggle_util.f90 +++ b/src/fraggle/fraggle_util.f90 @@ -185,8 +185,12 @@ module subroutine fraggle_util_final_system(self) implicit none ! Arguments type(fraggle_system), intent(inout) :: self !! Collision impactors storage object + ! Internals + type(swiftest_parameters) :: tmp_param - call self%reset() + call self%reset(tmp_param) + if (allocated(self%impactors)) deallocate(self%impactors) + if (allocated(self%fragments)) deallocate(self%fragments) return end subroutine fraggle_util_final_system diff --git a/src/modules/collision_classes.f90 b/src/modules/collision_classes.f90 index 262920269..5c31ab592 100644 --- a/src/modules/collision_classes.f90 +++ b/src/modules/collision_classes.f90 @@ -55,6 +55,7 @@ module collision_classes real(DP), dimension(NDIM) :: rbimp !! Impact point position vector of the collider system in system barycentric coordinates contains + procedure :: get_regime => collision_regime_impactors !! Determine which fragmentation regime the set of impactors will be procedure :: set_coordinate_system => collision_set_coordinate_impactors !! Defines the collisional coordinate system, including the unit vectors of both the system and individual fragments. procedure :: setup => collision_setup_impactors !! Allocates arrays for n fragments in a fragment system. Passing n = 0 deallocates all arrays. procedure :: reset => collision_util_reset_impactors !! Resets the collider object variables to 0 and deallocates the index and mass distributions @@ -102,7 +103,8 @@ module collision_classes real(DP), dimension(2) :: pe !! Before/after potential energy real(DP), dimension(2) :: Etot !! Before/after total system energy contains - procedure :: regime => collision_regime_system !! Determine which fragmentation regime the set of impactors will be + procedure :: generate_fragments => abstract_generate_fragments !! Generates a system of fragments + procedure :: set_mass_dist => abstract_set_mass_dist !! Sets the distribution of mass among the fragments depending on the regime type procedure :: setup => collision_setup_system !! Initializer for the encounter collision system. Allocates the collider and fragments classes and the before/after snapshots procedure :: get_energy_and_momentum => collision_util_get_energy_momentum !! Calculates total system energy in either the pre-collision outcome state (lbefore = .true.) or the post-collision outcome state (lbefore = .false.) procedure :: reset => collision_util_reset_system !! Deallocates all allocatables @@ -110,6 +112,24 @@ module collision_classes final :: collision_util_final_system !! Finalizer will deallocate all allocatables end type collision_system + abstract interface + subroutine abstract_generate_fragments(self, system, param, lfailure) + import collision_system, swiftest_nbody_system, swiftest_parameters + implicit none + class(collision_system), intent(inout) :: self !! Fraggle fragment system object + class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + logical, intent(out) :: lfailure !! Answers the question: Should this have been a merger instead? + end subroutine abstract_generate_fragments + + subroutine abstract_set_mass_dist(self, param) + import collision_system, swiftest_parameters + implicit none + class(collision_system), intent(inout) :: self !! Collision system object + class(swiftest_parameters), intent(in) :: param !! Current Swiftest run configuration parameters + end subroutine abstract_set_mass_dist + end interface + !! NetCDF dimension and variable names for the enounter save object type, extends(encounter_io_parameters) :: collision_io_parameters integer(I4B) :: stage_dimid !! ID for the stage dimension @@ -201,12 +221,12 @@ module subroutine collision_util_placeholder_step(self, system, param, t, dt) real(DP), intent(in) :: dt !! Stepsiz end subroutine collision_util_placeholder_step - module subroutine collision_regime_system(self, system, param) + module subroutine collision_regime_impactors(self, system, param) implicit none - class(collision_system), intent(inout) :: self !! Collision system object - class(swiftest_nbody_system), intent(in) :: system !! Swiftest nbody system object - class(swiftest_parameters), intent(in) :: param !! Current Swiftest run configuration parameters - end subroutine collision_regime_system + class(collision_impactors), intent(inout) :: self !! Collision system impactors object + class(swiftest_nbody_system), intent(in) :: system !! Swiftest nbody system object + class(swiftest_parameters), intent(in) :: param !! Current Swiftest run configuration parameters + end subroutine collision_regime_impactors module subroutine collision_set_coordinate_impactors(self) implicit none @@ -223,7 +243,6 @@ module subroutine collision_util_set_coordinate_system(self) class(collision_system), intent(inout) :: self !! Collisional system end subroutine collision_util_set_coordinate_system - module subroutine collision_setup_fragments(self, n, param) implicit none class(collision_fragments), intent(inout) :: self !! Fragment system object @@ -238,12 +257,11 @@ module subroutine collision_setup_impactors(self, system, param) class(swiftest_parameters), intent(in) :: param !! Current swiftest run configuration parameters end subroutine collision_setup_impactors - module subroutine collision_setup_system(self, system, param) - use swiftest_classes, only : swiftest_nbody_system, swiftest_parameters + module subroutine collision_setup_system(self, param) + use swiftest_classes, only : swiftest_parameters implicit none - class(collision_system), intent(inout) :: self !! Encounter collision system object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + class(collision_system), intent(inout) :: self !! Collision system object + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters end subroutine collision_setup_system module subroutine collision_util_dealloc_fragments(self) @@ -293,12 +311,13 @@ end subroutine collision_util_index_map module subroutine collision_util_reset_impactors(self) implicit none - class(collision_impactors), intent(inout) :: self + class(collision_impactors), intent(inout) :: self !! Collision system object end subroutine collision_util_reset_impactors - module subroutine collision_util_reset_system(self) + module subroutine collision_util_reset_system(self, param) implicit none - class(collision_system), intent(inout) :: self + class(collision_system), intent(inout) :: self !! Collision system object + class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters end subroutine collision_util_reset_system module subroutine collision_util_snapshot(self, param, system, t, arg) diff --git a/src/modules/symba_classes.f90 b/src/modules/symba_classes.f90 index 98143ed08..86988fc9e 100644 --- a/src/modules/symba_classes.f90 +++ b/src/modules/symba_classes.f90 @@ -17,7 +17,7 @@ module symba_classes use helio_classes, only : helio_cb, helio_pl, helio_tp, helio_nbody_system use fraggle_classes, only : collision_impactors, fraggle_fragments use encounter_classes, only : encounter_list, encounter_storage - use collision_classes, only : collision_storage + use collision_classes, only : collision_storage, collision_system implicit none public @@ -190,8 +190,7 @@ module symba_classes 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(collision_impactors), allocatable :: impactors !! Fraggle impactors object - class(fraggle_fragments), allocatable :: fragments !! Fraggle fragmentation system object + class(collision_system), allocatable :: collision_system !! Collision system object 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 diff --git a/src/setup/setup.f90 b/src/setup/setup.f90 index 353f60fb2..9b27416ae 100644 --- a/src/setup/setup.f90 +++ b/src/setup/setup.f90 @@ -75,6 +75,15 @@ module subroutine setup_construct_system(system, param) select type(param) class is (symba_parameters) + + if (param%lfragmentation) then + allocate(fraggle_system :: system%collision_system) + call system%collision_system%setup(param) + + allocate(symba_nbody_system :: system%collision_system%before) + allocate(symba_nbody_system :: system%collision_system%after) + end if + if (param%lenc_save_trajectory .or. param%lenc_save_closest) then allocate(encounter_storage :: param%encounter_history) associate (encounter_history => param%encounter_history) @@ -98,6 +107,8 @@ module subroutine setup_construct_system(system, param) end associate end select + + end select case (RINGMOONS) write(*,*) 'RINGMOONS-SyMBA integrator not yet enabled' diff --git a/src/symba/symba_collision.f90 b/src/symba/symba_collision.f90 index 663e40b55..3af2c7e99 100644 --- a/src/symba/symba_collision.f90 +++ b/src/symba/symba_collision.f90 @@ -30,8 +30,7 @@ module function symba_collision_casedisruption(system, param, t) result(status) character(len=STRMAX) :: message real(DP) :: dpe - associate(impactors => system%impactors, fragments => system%fragments) - + associate(collision_system => system%collision_system, impactors => system%collision_system%impactors, fragments => system%collision_system%fragments) select case(impactors%regime) case(COLLRESOLVE_REGIME_DISRUPTION) message = "Disruption between" @@ -42,12 +41,12 @@ module function symba_collision_casedisruption(system, param, t) result(status) call io_log_one_message(FRAGGLE_LOG_OUT, message) ! Collisional fragments will be uniformly distributed around the pre-impact barycenter - call fragments%set_mass_dist(impactors, param) + call collision_system%set_mass_dist(param) ! Generate the position and velocity distributions of the fragments - call fragments%generate_fragments(impactors, system, param, lfailure) + call collision_system%generate_fragments(system, param, lfailure) - dpe = fragments%pe_after - fragments%pe_before + dpe = collision_system%pe(2) - collision_system%pe(1) system%Ecollisions = system%Ecollisions - dpe system%Euntracked = system%Euntracked + dpe @@ -105,7 +104,7 @@ module function symba_collision_casehitandrun(system, param, t) result(status) character(len=STRMAX) :: message real(DP) :: dpe - associate(impactors => system%impactors, fragments => system%fragments) + associate(collision_system => system%collision_system, impactors => system%collision_system%impactors, fragments => system%collision_system%fragments) message = "Hit and run between" call symba_collision_collider_message(system%pl, impactors%idx, message) call io_log_one_message(FRAGGLE_LOG_OUT, trim(adjustl(message))) @@ -124,12 +123,12 @@ module function symba_collision_casehitandrun(system, param, t) result(status) lpure = .true. else ! Imperfect hit and run, so we'll keep the largest body and destroy the other lpure = .false. - call fragments%set_mass_dist(impactors, param) + call collision_system%set_mass_dist(param) ! Generate the position and velocity distributions of the fragments - call fragments%generate_fragments(impactors, system, param, lpure) + call collision_system%generate_fragments(system, param, lpure) - dpe = fragments%pe_after - fragments%pe_before + dpe = collision_system%pe(2) - collision_system%pe(1) system%Ecollisions = system%Ecollisions - dpe system%Euntracked = system%Euntracked + dpe @@ -150,7 +149,7 @@ module function symba_collision_casehitandrun(system, param, t) result(status) pl%ldiscard(impactors%idx(:)) = .false. pl%lcollision(impactors%idx(:)) = .false. end select - allocate(system%fragments%pl, source=system%impactors%pl) ! Be sure to save the pl so that snapshots still work + allocate(collision_system%after%pl, source=collision_system%before%pl) ! Be sure to save the pl so that snapshots still work else ibiggest = impactors%idx(maxloc(system%pl%Gmass(impactors%idx(:)), dim=1)) fragments%id(1) = system%pl%id(ibiggest) @@ -187,7 +186,7 @@ module function symba_collision_casemerge(system, param, t) result(status) real(DP) :: dpe character(len=STRMAX) :: message - associate(impactors => system%impactors, fragments => system%fragments) + associate(collision_system => system%collision_system, impactors => system%collision_system%impactors, fragments => system%collision_system%fragments) message = "Merging" call symba_collision_collider_message(system%pl, impactors%idx, message) call io_log_one_message(FRAGGLE_LOG_OUT, message) @@ -195,10 +194,10 @@ module function symba_collision_casemerge(system, param, t) result(status) select type(pl => system%pl) class is (symba_pl) - call fragments%set_mass_dist(impactors, param) + call collision_system%set_mass_dist(param) ! Calculate the initial energy of the system without the collisional family - call fragments%get_energy_and_momentum(impactors, system, param, lbefore=.true.) + call collision_system%get_energy_and_momentum(system, param, lbefore=.true.) ibiggest = impactors%idx(maxloc(pl%Gmass(impactors%idx(:)), dim=1)) fragments%id(1) = pl%id(ibiggest) @@ -217,8 +216,8 @@ module function symba_collision_casemerge(system, param, t) result(status) ! Keep track of the component of potential energy due to the pre-impact impactors%idx for book-keeping ! Get the energy of the system after the collision - call fragments%get_energy_and_momentum(impactors, system, param, lbefore=.false.) - dpe = fragments%pe_after - fragments%pe_before + call collision_system%get_energy_and_momentum(system, param, lbefore=.false.) + dpe = collision_system%pe(2) - collision_system%pe(1) system%Ecollisions = system%Ecollisions - dpe system%Euntracked = system%Euntracked + dpe @@ -757,7 +756,8 @@ subroutine symba_collision_mergeaddsub(system, param, t, status) class is (symba_pl) select type(pl_discards => system%pl_discards) class is (symba_merger) - associate(info => pl%info, pl_adds => system%pl_adds, cb => system%cb, npl => pl%nbody, impactors => system%impactors, fragments => system%fragments) + associate(info => pl%info, pl_adds => system%pl_adds, cb => system%cb, npl => pl%nbody, & + collision_system => system%collision_system, impactors => system%collision_system%impactors, fragments => system%collision_system%fragments) ! Add the impactors%idx bodies to the subtraction list nimpactors = impactors%ncoll nfrag = fragments%nbody @@ -864,7 +864,7 @@ subroutine symba_collision_mergeaddsub(system, param, t, status) end where ! Log the properties of the new bodies - allocate(system%fragments%pl, source=plnew) + allocate(collision_system%after%pl, source=plnew) ! Append the new merged body to the list nstart = pl_adds%nbody + 1 @@ -920,35 +920,32 @@ subroutine symba_resolve_collision(plplcollision_list , system, param, t) logical :: lgoodcollision integer(I4B) :: i - associate(ncollisions => plplcollision_list%nenc, idx1 => plplcollision_list%index1, idx2 => plplcollision_list%index2, collision_history => param%collision_history) + associate(ncollisions => plplcollision_list%nenc, idx1 => plplcollision_list%index1, idx2 => plplcollision_list%index2, collision_history => param%collision_history, & + collision_system => system%collision_system, impactors => system%collision_system%impactors, fragments => system%collision_system%fragments) select type(pl => system%pl) class is (symba_pl) select type (cb => system%cb) class is (symba_cb) do i = 1, ncollisions - allocate(collision_impactors :: system%impactors) - allocate(fraggle_fragments :: system%fragments) idx_parent(1) = pl%kin(idx1(i))%parent idx_parent(2) = pl%kin(idx2(i))%parent - lgoodcollision = symba_collision_consolidate_impactors(pl, cb, param, idx_parent, system%impactors) + lgoodcollision = symba_collision_consolidate_impactors(pl, cb, param, idx_parent, impactors) if ((.not. lgoodcollision) .or. any(pl%status(idx_parent(:)) /= COLLISION)) cycle if (param%lfragmentation) then - call system%impactors%regime(system%fragments, system, param) + call impactors%get_regime(system, param) else - associate(fragments => system%fragments, impactors => system%impactors) - impactors%regime = COLLRESOLVE_REGIME_MERGE - fragments%mtot = sum(impactors%mass(:)) - impactors%mass_dist(1) = fragments%mtot - impactors%mass_dist(2) = 0.0_DP - impactors%mass_dist(3) = 0.0_DP - impactors%rbcom(:) = (impactors%mass(1) * impactors%rb(:,1) + impactors%mass(2) * impactors%rb(:,2)) / fragments%mtot - impactors%vbcom(:) = (impactors%mass(1) * impactors%vb(:,1) + impactors%mass(2) * impactors%vb(:,2)) / fragments%mtot - end associate + impactors%regime = COLLRESOLVE_REGIME_MERGE + fragments%mtot = sum(impactors%mass(:)) + impactors%mass_dist(1) = fragments%mtot + impactors%mass_dist(2) = 0.0_DP + impactors%mass_dist(3) = 0.0_DP + impactors%rbcom(:) = (impactors%mass(1) * impactors%rb(:,1) + impactors%mass(2) * impactors%rb(:,2)) / fragments%mtot + impactors%vbcom(:) = (impactors%mass(1) * impactors%vb(:,1) + impactors%mass(2) * impactors%vb(:,2)) / fragments%mtot end if call collision_history%take_snapshot(param,system, t, "before") - select case (system%impactors%regime) + select case (impactors%regime) case (COLLRESOLVE_REGIME_DISRUPTION, COLLRESOLVE_REGIME_SUPERCATASTROPHIC) plplcollision_list%status(i) = symba_collision_casedisruption(system, param, t) case (COLLRESOLVE_REGIME_HIT_AND_RUN) @@ -960,7 +957,7 @@ subroutine symba_resolve_collision(plplcollision_list , system, param, t) call util_exit(FAILURE) end select call collision_history%take_snapshot(param,system, t, "after") - deallocate(system%impactors,system%fragments) + call impactors%reset() end do end select end select From 8d406e11fe704477859d9fb0bf7923490b18da9b Mon Sep 17 00:00:00 2001 From: David A Minton Date: Sat, 17 Dec 2022 10:38:33 -0500 Subject: [PATCH 455/569] Too soon. Not quite compiled yet. More cleanup --- src/collision/collision_util.f90 | 61 +++++++++- src/encounter/encounter_util.f90 | 195 ++++++++++++++++++++++++++++++ src/fraggle/fraggle_setup.f90 | 2 +- src/fraggle/fraggle_util.f90 | 2 +- src/modules/collision_classes.f90 | 8 +- 5 files changed, 258 insertions(+), 10 deletions(-) diff --git a/src/collision/collision_util.f90 b/src/collision/collision_util.f90 index 819f9df76..3a1aea3fa 100644 --- a/src/collision/collision_util.f90 +++ b/src/collision/collision_util.f90 @@ -386,7 +386,6 @@ module subroutine collision_util_set_coordinate_system(self) return end subroutine collision_util_set_coordinate_system - subroutine collision_util_save_snapshot(collision_history, snapshot) !! author: David A. Minton !! @@ -432,4 +431,64 @@ subroutine collision_util_save_snapshot(collision_history, snapshot) end subroutine collision_util_save_snapshot + module subroutine collision_util_snapshot(self, param, system, t, arg) + !! author: David A. Minton + !! + !! Takes a minimal snapshot of the state of the system during an encounter so that the trajectories + !! can be played back through the encounter + implicit none + ! Internals + class(collision_storage(*)), intent(inout) :: self !! Swiftest storage object + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object to store + real(DP), intent(in), optional :: t !! Time of snapshot if different from system time + character(*), intent(in), optional :: arg !! "before": takes a snapshot just before the collision. "after" takes the snapshot just after the collision. + ! Arguments + class(collision_snapshot), allocatable :: snapshot + type(symba_pl) :: pl + character(len=:), allocatable :: stage + + if (present(arg)) then + stage = arg + else + stage = "" + end if + + select type (system) + class is (symba_nbody_system) + + select case(stage) + case("before") + ! Saves the states of the bodies involved in the collision before the collision is resolved + associate (idx => system%collision_system%impactors%idx, ncoll => system%collision_system%impactors%ncoll) + call pl%setup(ncoll, param) + pl%id(:) = system%pl%id(idx(:)) + pl%Gmass(:) = system%pl%Gmass(idx(:)) + pl%radius(:) = system%pl%radius(idx(:)) + pl%rot(:,:) = system%pl%rot(:,idx(:)) + pl%Ip(:,:) = system%pl%Ip(:,idx(:)) + pl%rh(:,:) = system%pl%rh(:,idx(:)) + pl%vh(:,:) = system%pl%vh(:,idx(:)) + pl%info(:) = system%pl%info(idx(:)) + !end select + allocate(system%collision_system%before%pl, source=pl) + end associate + case("after") + allocate(collision_snapshot :: snapshot) + allocate(snapshot%collision_system, source=system%collision_system) + snapshot%t = t + select type(param) + class is (symba_parameters) + call collision_util_save_snapshot(param%collision_history,snapshot) + end select + case default + write(*,*) "collision_util_snapshot requies either 'before' or 'after' passed to 'arg'" + end select + + end select + + return + end subroutine collision_util_snapshot + + end submodule s_collision_util \ No newline at end of file diff --git a/src/encounter/encounter_util.f90 b/src/encounter/encounter_util.f90 index c4acc1df9..0297c769c 100644 --- a/src/encounter/encounter_util.f90 +++ b/src/encounter/encounter_util.f90 @@ -410,4 +410,199 @@ subroutine encounter_util_save_snapshot(encounter_history, snapshot) end subroutine encounter_util_save_snapshot + module subroutine encounter_util_snapshot(self, param, system, t, arg) + !! author: David A. Minton + !! + !! Takes a minimal snapshot of the state of the system during an encounter so that the trajectories + !! can be played back through the encounter + implicit none + ! Internals + class(encounter_storage(*)), intent(inout) :: self !! Swiftest storage object + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object to store + real(DP), intent(in), optional :: t !! Time of snapshot if different from system time + character(*), intent(in), optional :: arg !! Optional argument (needed for extended storage type used in collision snapshots) + ! Arguments + class(encounter_snapshot), allocatable :: snapshot + integer(I4B) :: i, pi, pj, k, npl_snap, ntp_snap, iflag + real(DP), dimension(NDIM) :: rrel, vrel, rcom, vcom + real(DP) :: Gmtot, a, q, capm, tperi + real(DP), dimension(NDIM,2) :: rb,vb + + if (.not.present(t)) then + write(*,*) "encounter_util_snapshot_encounter requires `t` to be passed" + return + end if + + if (.not.present(arg)) then + write(*,*) "encounter_util_snapshot_encounter requires `arg` to be passed" + return + end if + + select type(param) + class is (symba_parameters) + select type (system) + class is (symba_nbody_system) + select type(pl => system%pl) + class is (symba_pl) + select type (tp => system%tp) + class is (symba_tp) + associate(npl => pl%nbody, ntp => tp%nbody) + if (npl + ntp == 0) return + allocate(encounter_snapshot :: snapshot) + allocate(snapshot%pl, mold=pl) + allocate(snapshot%tp, mold=tp) + snapshot%iloop = param%iloop + + select type(pl_snap => snapshot%pl) + class is (symba_pl) + select type(tp_snap => snapshot%tp) + class is (symba_tp) + + select case(arg) + case("trajectory") + snapshot%t = t + + npl_snap = npl + ntp_snap = ntp + + if (npl > 0) then + pl%lmask(1:npl) = pl%status(1:npl) /= INACTIVE .and. pl%levelg(1:npl) == system%irec + npl_snap = count(pl%lmask(1:npl)) + end if + if (ntp > 0) then + tp%lmask(1:ntp) = tp%status(1:ntp) /= INACTIVE .and. tp%levelg(1:ntp) == system%irec + ntp_snap = count(tp%lmask(1:ntp)) + end if + + if (npl_snap + ntp_snap == 0) return ! Nothing to snapshot + + pl_snap%nbody = npl_snap + + ! Take snapshot of the currently encountering massive bodies + if (npl_snap > 0) then + call pl_snap%setup(npl_snap, param) + pl_snap%levelg(:) = pack(pl%levelg(1:npl), pl%lmask(1:npl)) + pl_snap%id(:) = pack(pl%id(1:npl), pl%lmask(1:npl)) + pl_snap%info(:) = pack(pl%info(1:npl), pl%lmask(1:npl)) + pl_snap%Gmass(:) = pack(pl%Gmass(1:npl), pl%lmask(1:npl)) + do i = 1, NDIM + pl_snap%rh(i,:) = pack(pl%rh(i,1:npl), pl%lmask(1:npl)) + pl_snap%vh(i,:) = pack(pl%vb(i,1:npl), pl%lmask(1:npl)) + end do + if (param%lclose) then + pl_snap%radius(:) = pack(pl%radius(1:npl), pl%lmask(1:npl)) + end if + + if (param%lrotation) then + do i = 1, NDIM + pl_snap%Ip(i,:) = pack(pl%Ip(i,1:npl), pl%lmask(1:npl)) + pl_snap%rot(i,:) = pack(pl%rot(i,1:npl), pl%lmask(1:npl)) + end do + end if + call pl_snap%sort("id", ascending=.true.) + end if + + ! Take snapshot of the currently encountering test particles + tp_snap%nbody = ntp_snap + if (ntp_snap > 0) then + call tp_snap%setup(ntp_snap, param) + tp_snap%id(:) = pack(tp%id(1:ntp), tp%lmask(1:ntp)) + tp_snap%info(:) = pack(tp%info(1:ntp), tp%lmask(1:ntp)) + do i = 1, NDIM + tp_snap%rh(i,:) = pack(tp%rh(i,1:ntp), tp%lmask(1:ntp)) + tp_snap%vh(i,:) = pack(tp%vh(i,1:ntp), tp%lmask(1:ntp)) + end do + end if + + ! Save the snapshot + param%encounter_history%nid = param%encounter_history%nid + ntp_snap + npl_snap + call encounter_util_save_encounter(param%encounter_history,snapshot) + case("closest") + associate(plplenc_list => system%plplenc_list, pltpenc_list => system%pltpenc_list) + if (any(plplenc_list%lclosest(:))) then + call pl_snap%setup(2, param) + do k = 1, plplenc_list%nenc + if (plplenc_list%lclosest(k)) then + pi = plplenc_list%index1(k) + pj = plplenc_list%index2(k) + pl_snap%levelg(:) = pl%levelg([pi,pj]) + pl_snap%id(:) = pl%id([pi,pj]) + pl_snap%info(:) = pl%info([pi,pj]) + pl_snap%Gmass(:) = pl%Gmass([pi,pj]) + Gmtot = sum(pl_snap%Gmass(:)) + if (param%lclose) pl_snap%radius(:) = pl%radius([pi,pj]) + if (param%lrotation) then + do i = 1, NDIM + pl_snap%Ip(i,:) = pl%Ip(i,[pi,pj]) + pl_snap%rot(i,:) = pl%rot(i,[pi,pj]) + end do + end if + + ! Compute pericenter passage time to get the closest approach parameters + rrel(:) = plplenc_list%r2(:,k) - plplenc_list%r1(:,k) + vrel(:) = plplenc_list%v2(:,k) - plplenc_list%v1(:,k) + call orbel_xv2aqt(Gmtot, rrel(1), rrel(2), rrel(3), vrel(1), vrel(2), vrel(3), a, q, capm, tperi) + snapshot%t = t + tperi + if ((snapshot%t < maxval(pl_snap%info(:)%origin_time)) .or. & + (snapshot%t > minval(pl_snap%info(:)%discard_time))) cycle + + ! Computer the center mass of the pair + rcom(:) = (plplenc_list%r1(:,k) * pl_snap%Gmass(1) + plplenc_list%r2(:,k) * pl_snap%Gmass(2)) / Gmtot + vcom(:) = (plplenc_list%v1(:,k) * pl_snap%Gmass(1) + plplenc_list%v2(:,k) * pl_snap%Gmass(2)) / Gmtot + rb(:,1) = plplenc_list%r1(:,k) - rcom(:) + rb(:,2) = plplenc_list%r2(:,k) - rcom(:) + vb(:,1) = plplenc_list%v1(:,k) - vcom(:) + vb(:,2) = plplenc_list%v2(:,k) - vcom(:) + + ! Drift the relative orbit to get the new relative position and velocity + call drift_one(Gmtot, rrel(1), rrel(2), rrel(3), vrel(1), vrel(2), vrel(3), tperi, iflag) + if (iflag /= 0) write(*,*) "Danby error in encounter_util_snapshot_encounter. Closest approach positions and vectors may not be accurate." + + ! Get the new position and velocity vectors + rb(:,1) = -(pl_snap%Gmass(2) / Gmtot) * rrel(:) + rb(:,2) = (pl_snap%Gmass(1)) / Gmtot * rrel(:) + + vb(:,1) = -(pl_snap%Gmass(2) / Gmtot) * vrel(:) + vb(:,2) = (pl_snap%Gmass(1)) / Gmtot * vrel(:) + + ! Move the CoM assuming constant velocity over the time it takes to reach periapsis + rcom(:) = rcom(:) + vcom(:) * tperi + + ! Compute the heliocentric position and velocity vector at periapsis + pl_snap%rh(:,1) = rb(:,1) + rcom(:) + pl_snap%rh(:,2) = rb(:,2) + rcom(:) + pl_snap%vh(:,1) = vb(:,1) + vcom(:) + pl_snap%vh(:,2) = vb(:,2) + vcom(:) + + call pl_snap%sort("id", ascending=.true.) + call encounter_util_save_encounter(param%encounter_history,snapshot) + end if + end do + + plplenc_list%lclosest(:) = .false. + end if + + if (any(pltpenc_list%lclosest(:))) then + do k = 1, pltpenc_list%nenc + end do + pltpenc_list%lclosest(:) = .false. + end if + end associate + case default + write(*,*) "encounter_util_snapshot_encounter requires `arg` to be either `trajectory` or `closest`" + end select + end select + end select + end associate + end select + end select + end select + end select + + return + end subroutine encounter_util_snapshot + + + end submodule s_encounter_util \ No newline at end of file diff --git a/src/fraggle/fraggle_setup.f90 b/src/fraggle/fraggle_setup.f90 index 7b6551d88..5b9442ff6 100644 --- a/src/fraggle/fraggle_setup.f90 +++ b/src/fraggle/fraggle_setup.f90 @@ -45,7 +45,7 @@ module subroutine fraggle_setup_fragments(self, n, param) integer(I4B), intent(in) :: n class(swiftest_parameters), intent(in) :: param - call collision_util_setup_fragments(n, param) + call self%collision_fragments%setup(n, param) if (n < 0) return if (allocated(self%v_r_mag)) deallocate(self%v_r_mag) diff --git a/src/fraggle/fraggle_util.f90 b/src/fraggle/fraggle_util.f90 index c1e2fccb5..ae9cb8854 100644 --- a/src/fraggle/fraggle_util.f90 +++ b/src/fraggle/fraggle_util.f90 @@ -139,7 +139,7 @@ module subroutine fraggle_util_dealloc_fragments(self) ! Arguments class(fraggle_fragments), intent(inout) :: self - call collision_util_deallocate_fragments(self) + call collision_util_dealloc_fragments(self) if (allocated(self%v_r_mag)) deallocate(self%v_r_mag) if (allocated(self%v_t_mag)) deallocate(self%v_t_mag) diff --git a/src/modules/collision_classes.f90 b/src/modules/collision_classes.f90 index 5c31ab592..635a3fb33 100644 --- a/src/modules/collision_classes.f90 +++ b/src/modules/collision_classes.f90 @@ -81,7 +81,6 @@ module collision_classes procedure :: accel => collision_util_placeholder_accel !! Placeholder subroutine to fulfill requirement for an accel method procedure :: kick => collision_util_placeholder_kick !! Placeholder subroutine to fulfill requirement for a kick method procedure :: step => collision_util_placeholder_step !! Placeholder subroutine to fulfill requirement for a step method - procedure :: set_coordinate_system => collision_set_coordinate_fragments !! Defines the collisional coordinate system, including the unit vectors of both the system and individual fragments. procedure :: setup => collision_setup_fragments !! Allocates arrays for n fragments in a Fraggle system. Passing n = 0 deallocates all arrays. procedure :: dealloc => collision_util_dealloc_fragments !! Deallocates all allocatable arrays end type collision_fragments @@ -152,7 +151,7 @@ end subroutine abstract_set_mass_dist end type collision_io_parameters type, extends(encounter_snapshot) :: collision_snapshot - logical :: lcollision !! Indicates that this snapshot contains at least one collision + logical :: lcollision !! Indicates that this snapshot contains at least one collision class(collision_system), allocatable :: collision_system !! impactors object at this snapshot contains procedure :: write_frame => collision_io_write_frame_snapshot !! Writes a frame of encounter data to file @@ -233,11 +232,6 @@ module subroutine collision_set_coordinate_impactors(self) class(collision_impactors), intent(inout) :: self !! Collider system object end subroutine collision_set_coordinate_impactors - module subroutine collision_set_coordinate_fragments(self) - implicit none - class(collision_fragments), intent(inout) :: self !! Fragment system object - end subroutine collision_set_coordinate_fragments - module subroutine collision_util_set_coordinate_system(self) implicit none class(collision_system), intent(inout) :: self !! Collisional system From b29b1bf47d3a68306861d0374ae5437315f62758 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Sat, 17 Dec 2022 10:39:15 -0500 Subject: [PATCH 456/569] Cleanup --- src/fraggle/fraggle_setup.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/fraggle/fraggle_setup.f90 b/src/fraggle/fraggle_setup.f90 index 5b9442ff6..63e2a2f5b 100644 --- a/src/fraggle/fraggle_setup.f90 +++ b/src/fraggle/fraggle_setup.f90 @@ -45,7 +45,7 @@ module subroutine fraggle_setup_fragments(self, n, param) integer(I4B), intent(in) :: n class(swiftest_parameters), intent(in) :: param - call self%collision_fragments%setup(n, param) + call collision_setup_fragments(self, n, param) if (n < 0) return if (allocated(self%v_r_mag)) deallocate(self%v_r_mag) From 33282c6ba13e11405d12dd030384db4d4f16293a Mon Sep 17 00:00:00 2001 From: "Minton, David A" Date: Sat, 17 Dec 2022 15:56:47 -0500 Subject: [PATCH 457/569] Update encounter_util.f90 Fixed name of subroutine --- src/encounter/encounter_util.f90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/encounter/encounter_util.f90 b/src/encounter/encounter_util.f90 index 0297c769c..e6a786be2 100644 --- a/src/encounter/encounter_util.f90 +++ b/src/encounter/encounter_util.f90 @@ -517,7 +517,7 @@ module subroutine encounter_util_snapshot(self, param, system, t, arg) ! Save the snapshot param%encounter_history%nid = param%encounter_history%nid + ntp_snap + npl_snap - call encounter_util_save_encounter(param%encounter_history,snapshot) + call encounter_util_save_snapshot(param%encounter_history,snapshot) case("closest") associate(plplenc_list => system%plplenc_list, pltpenc_list => system%pltpenc_list) if (any(plplenc_list%lclosest(:))) then @@ -576,7 +576,7 @@ module subroutine encounter_util_snapshot(self, param, system, t, arg) pl_snap%vh(:,2) = vb(:,2) + vcom(:) call pl_snap%sort("id", ascending=.true.) - call encounter_util_save_encounter(param%encounter_history,snapshot) + call encounter_util_save_snapshot(param%encounter_history,snapshot) end if end do @@ -605,4 +605,4 @@ end subroutine encounter_util_snapshot -end submodule s_encounter_util \ No newline at end of file +end submodule s_encounter_util From ae189eb9497aebcb227c052e64417f103d21c5ea Mon Sep 17 00:00:00 2001 From: David A Minton Date: Sat, 17 Dec 2022 17:44:29 -0500 Subject: [PATCH 458/569] More cleanup --- src/collision/collision_util.f90 | 48 ++++++++++++++++++++++++++++++- src/fraggle/fraggle_util.f90 | 46 ----------------------------- src/modules/collision_classes.f90 | 28 +++++++++--------- src/modules/fraggle_classes.f90 | 9 ------ 4 files changed, 62 insertions(+), 69 deletions(-) diff --git a/src/collision/collision_util.f90 b/src/collision/collision_util.f90 index 3a1aea3fa..b6c776fbe 100644 --- a/src/collision/collision_util.f90 +++ b/src/collision/collision_util.f90 @@ -11,6 +11,52 @@ use swiftest contains + module subroutine collison_util_add_fragments_to_system(self, system, param) + !! Author: David A. Minton + !! + !! Adds fragments to the temporary system pl object + implicit none + ! Arguments + class(collision_system), intent(in) :: self !! Collision system system object + class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_parameters), intent(in) :: param !! Current swiftest run configuration parameters + ! Internals + integer(I4B) :: i, npl_before, npl_after + logical, dimension(:), allocatable :: lexclude + + associate(fragments => self%fragments, impactors => self%impactors, nfrag => self%fragments%nbody, pl => system%pl, cb => system%cb) + npl_after = pl%nbody + npl_before = npl_after - nfrag + allocate(lexclude(npl_after)) + + pl%status(npl_before+1:npl_after) = ACTIVE + pl%mass(npl_before+1:npl_after) = fragments%mass(1:nfrag) + pl%Gmass(npl_before+1:npl_after) = fragments%mass(1:nfrag) * param%GU + pl%radius(npl_before+1:npl_after) = fragments%radius(1:nfrag) + do concurrent (i = 1:nfrag) + pl%rb(:,npl_before+i) = fragments%rb(:,i) + pl%vb(:,npl_before+i) = fragments%vb(:,i) + pl%rh(:,npl_before+i) = fragments%rb(:,i) - cb%rb(:) + pl%vh(:,npl_before+i) = fragments%vb(:,i) - cb%vb(:) + end do + if (param%lrotation) then + pl%Ip(:,npl_before+1:npl_after) = fragments%Ip(:,1:nfrag) + pl%rot(:,npl_before+1:npl_after) = fragments%rot(:,1:nfrag) + end if + ! This will remove the impactors from the system since we've replaced them with fragments + lexclude(1:npl_after) = .false. + lexclude(impactors%idx(1:impactors%ncoll)) = .true. + where(lexclude(1:npl_after)) + pl%status(1:npl_after) = INACTIVE + elsewhere + pl%status(1:npl_after) = ACTIVE + endwhere + + end associate + + return + end subroutine collison_util_add_fragments_to_system + module subroutine collision_util_dealloc_fragments(self) !! author: David A. Minton !! @@ -179,7 +225,7 @@ module subroutine collision_util_get_energy_momentum(self, system, param, lbefo call util_exit(FAILURE) end if ! Build the exluded body logical mask for the *after* case: Only the new bodies are used to compute energy and momentum - call encounter_util_add_fragments_to_system(fragments, impactors, tmpsys, tmpparam) + call self%add_fragments(tmpsys, tmpparam) tmpsys%pl%status(impactors%idx(1:impactors%ncoll)) = INACTIVE tmpsys%pl%status(npl_before+1:npl_after) = ACTIVE end if diff --git a/src/fraggle/fraggle_util.f90 b/src/fraggle/fraggle_util.f90 index ae9cb8854..6da202ad6 100644 --- a/src/fraggle/fraggle_util.f90 +++ b/src/fraggle/fraggle_util.f90 @@ -11,52 +11,6 @@ use swiftest contains - module subroutine fraggle_util_add_fragments_to_system(fragments, impactors, system, param) - !! Author: David A. Minton - !! - !! Adds fragments to the temporary system pl object - implicit none - ! Arguments - class(fraggle_fragments), intent(in) :: fragments !! Fraggle fragment system object - class(collision_impactors), intent(in) :: impactors !! Fraggle collider system object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object - class(swiftest_parameters), intent(in) :: param !! Current swiftest run configuration parameters - ! Internals - integer(I4B) :: i, npl_before, npl_after - logical, dimension(:), allocatable :: lexclude - - associate(nfrag => fragments%nbody, pl => system%pl, cb => system%cb) - npl_after = pl%nbody - npl_before = npl_after - nfrag - allocate(lexclude(npl_after)) - - pl%status(npl_before+1:npl_after) = ACTIVE - pl%mass(npl_before+1:npl_after) = fragments%mass(1:nfrag) - pl%Gmass(npl_before+1:npl_after) = fragments%mass(1:nfrag) * param%GU - pl%radius(npl_before+1:npl_after) = fragments%radius(1:nfrag) - do concurrent (i = 1:nfrag) - pl%rb(:,npl_before+i) = fragments%rb(:,i) - pl%vb(:,npl_before+i) = fragments%vb(:,i) - pl%rh(:,npl_before+i) = fragments%rb(:,i) - cb%rb(:) - pl%vh(:,npl_before+i) = fragments%vb(:,i) - cb%vb(:) - end do - if (param%lrotation) then - pl%Ip(:,npl_before+1:npl_after) = fragments%Ip(:,1:nfrag) - pl%rot(:,npl_before+1:npl_after) = fragments%rot(:,1:nfrag) - end if - ! This will remove the impactors from the system since we've replaced them with fragments - lexclude(1:npl_after) = .false. - lexclude(impactors%idx(1:impactors%ncoll)) = .true. - where(lexclude(1:npl_after)) - pl%status(1:npl_after) = INACTIVE - elsewhere - pl%status(1:npl_after) = ACTIVE - endwhere - - end associate - - return - end subroutine fraggle_util_add_fragments_to_system module subroutine fraggle_util_get_angular_momentum(self) diff --git a/src/modules/collision_classes.f90 b/src/modules/collision_classes.f90 index 635a3fb33..ac80477f1 100644 --- a/src/modules/collision_classes.f90 +++ b/src/modules/collision_classes.f90 @@ -56,7 +56,6 @@ module collision_classes contains procedure :: get_regime => collision_regime_impactors !! Determine which fragmentation regime the set of impactors will be - procedure :: set_coordinate_system => collision_set_coordinate_impactors !! Defines the collisional coordinate system, including the unit vectors of both the system and individual fragments. procedure :: setup => collision_setup_impactors !! Allocates arrays for n fragments in a fragment system. Passing n = 0 deallocates all arrays. procedure :: reset => collision_util_reset_impactors !! Resets the collider object variables to 0 and deallocates the index and mass distributions final :: collision_util_final_impactors !! Finalizer will deallocate all allocatables @@ -102,13 +101,14 @@ module collision_classes real(DP), dimension(2) :: pe !! Before/after potential energy real(DP), dimension(2) :: Etot !! Before/after total system energy contains - procedure :: generate_fragments => abstract_generate_fragments !! Generates a system of fragments - procedure :: set_mass_dist => abstract_set_mass_dist !! Sets the distribution of mass among the fragments depending on the regime type - procedure :: setup => collision_setup_system !! Initializer for the encounter collision system. Allocates the collider and fragments classes and the before/after snapshots - procedure :: get_energy_and_momentum => collision_util_get_energy_momentum !! Calculates total system energy in either the pre-collision outcome state (lbefore = .true.) or the post-collision outcome state (lbefore = .false.) - procedure :: reset => collision_util_reset_system !! Deallocates all allocatables - procedure :: set_coordinate_system => collision_util_set_coordinate_system !! Sets the coordinate system of the collisional system - final :: collision_util_final_system !! Finalizer will deallocate all allocatables + procedure :: generate_fragments => abstract_generate_fragments !! Generates a system of fragments + procedure :: set_mass_dist => abstract_set_mass_dist !! Sets the distribution of mass among the fragments depending on the regime type + procedure :: setup => collision_setup_system !! Initializer for the encounter collision system. Allocates the collider and fragments classes and the before/after snapshots + procedure :: add_fragments => collison_util_add_fragments_to_system !! Add fragments to system + procedure :: get_energy_and_momentum => collision_util_get_energy_momentum !! Calculates total system energy in either the pre-collision outcome state (lbefore = .true.) or the post-collision outcome state (lbefore = .false.) + procedure :: reset => collision_util_reset_system !! Deallocates all allocatables + procedure :: set_coordinate_system => collision_util_set_coordinate_system !! Sets the coordinate system of the collisional system + final :: collision_util_final_system !! Finalizer will deallocate all allocatables end type collision_system abstract interface @@ -227,11 +227,6 @@ module subroutine collision_regime_impactors(self, system, param) class(swiftest_parameters), intent(in) :: param !! Current Swiftest run configuration parameters end subroutine collision_regime_impactors - module subroutine collision_set_coordinate_impactors(self) - implicit none - class(collision_impactors), intent(inout) :: self !! Collider system object - end subroutine collision_set_coordinate_impactors - module subroutine collision_util_set_coordinate_system(self) implicit none class(collision_system), intent(inout) :: self !! Collisional system @@ -258,6 +253,13 @@ module subroutine collision_setup_system(self, param) class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters end subroutine collision_setup_system + module subroutine collison_util_add_fragments_to_system(self, system, param) + implicit none + class(collision_system), intent(in) :: self !! Collision system system object + class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_parameters), intent(in) :: param !! Current swiftest run configuration parameters + end subroutine collison_util_add_fragments_to_system + module subroutine collision_util_dealloc_fragments(self) implicit none class(collision_fragments), intent(inout) :: self diff --git a/src/modules/fraggle_classes.f90 b/src/modules/fraggle_classes.f90 index eff70b1f8..cdecf1205 100644 --- a/src/modules/fraggle_classes.f90 +++ b/src/modules/fraggle_classes.f90 @@ -113,15 +113,6 @@ module subroutine fraggle_setup_reset_fragments(self) class(fraggle_fragments), intent(inout) :: self end subroutine fraggle_setup_reset_fragments - module subroutine fraggle_util_add_fragments_to_system(fragments, impactors, system, param) - use swiftest_classes, only : swiftest_nbody_system, swiftest_parameters - implicit none - class(fraggle_fragments), intent(in) :: fragments !! Fraggle fragment system object - class(collision_impactors), intent(in) :: impactors !! Fraggle collider system object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object - class(swiftest_parameters), intent(in) :: param !! Current swiftest run configuration parameters - end subroutine fraggle_util_add_fragments_to_system - module subroutine fraggle_util_get_angular_momentum(self) implicit none class(fraggle_fragments), intent(inout) :: self !! Fraggle fragment system object From ad14dde3392a8c741965d841ec26745882b5c17b Mon Sep 17 00:00:00 2001 From: David A Minton Date: Sat, 17 Dec 2022 19:44:09 -0500 Subject: [PATCH 459/569] more cleanup --- src/collision/collision_util.f90 | 51 +++++++++++++++++++++++++++++-- src/fraggle/fraggle_util.f90 | 47 ++++++---------------------- src/modules/collision_classes.f90 | 30 ++++++++++++------ src/modules/fraggle_classes.f90 | 27 ++++++++-------- 4 files changed, 91 insertions(+), 64 deletions(-) diff --git a/src/collision/collision_util.f90 b/src/collision/collision_util.f90 index b6c776fbe..5e81b7b00 100644 --- a/src/collision/collision_util.f90 +++ b/src/collision/collision_util.f90 @@ -11,7 +11,7 @@ use swiftest contains - module subroutine collison_util_add_fragments_to_system(self, system, param) + module subroutine collision_util_add_fragments_to_system(self, system, param) !! Author: David A. Minton !! !! Adds fragments to the temporary system pl object @@ -55,7 +55,52 @@ module subroutine collison_util_add_fragments_to_system(self, system, param) end associate return - end subroutine collison_util_add_fragments_to_system + end subroutine collision_util_add_fragments_to_system + + + module subroutine collision_util_construct_temporary_system(self, nbody_system, param, tmpsys, tmpparam) + !! Author: David A. Minton + !! + !! Constructs a temporary internal system consisting of active bodies and additional fragments. This internal temporary system is used to calculate system energy with and without fragments + implicit none + ! Arguments + class(collision_system), intent(inout) :: self !! Fraggle collision system object + class(swiftest_nbody_system), intent(in) :: nbody_system !! Original swiftest nbody system object + class(swiftest_parameters), intent(in) :: param !! Current swiftest run configuration parameters + class(swiftest_nbody_system), allocatable, intent(out) :: tmpsys !! Output temporary swiftest nbody system object + class(swiftest_parameters), allocatable, intent(out) :: tmpparam !! Output temporary configuration run parameters + ! Internals + logical, dimension(:), allocatable :: linclude + integer(I4B) :: npl_tot + + associate(fragments => self%fragments, nfrag => self%fragments%nbody, pl => nbody_system%pl, npl => nbody_system%pl%nbody, cb => nbody_system%cb) + ! Set up a new system based on the original + if (allocated(tmpparam)) deallocate(tmpparam) + if (allocated(tmpsys)) deallocate(tmpsys) + allocate(tmpparam, source=param) + call setup_construct_system(tmpsys, tmpparam) + + ! No test particles necessary for energy/momentum calcs + call tmpsys%tp%setup(0, param) + + ! Replace the empty central body object with a copy of the original + deallocate(tmpsys%cb) + allocate(tmpsys%cb, source=cb) + + ! Make space for the fragments + npl_tot = npl + nfrag + call tmpsys%pl%setup(npl_tot, tmpparam) + allocate(linclude(npl_tot)) + + ! Fill up the temporary system with all of the original bodies, leaving the spaces for fragments empty until we add them in later + linclude(1:npl) = .true. + linclude(npl+1:npl_tot) = .false. + call tmpsys%pl%fill(pl, linclude) + + end associate + + return + end subroutine collision_util_construct_temporary_system module subroutine collision_util_dealloc_fragments(self) !! author: David A. Minton @@ -214,7 +259,7 @@ module subroutine collision_util_get_energy_momentum(self, system, param, lbefo npl_after = npl_before + nfrag if (lbefore) then - call encounter_util_construct_temporary_system(fragments, system, param, tmpsys, tmpparam) + call self%construct_temporary_system(system, param, tmpsys, tmpparam) ! Build the exluded body logical mask for the *before* case: Only the original bodies are used to compute energy and momentum tmpsys%pl%status(impactors%idx(1:impactors%ncoll)) = ACTIVE tmpsys%pl%status(npl_before+1:npl_after) = INACTIVE diff --git a/src/fraggle/fraggle_util.f90 b/src/fraggle/fraggle_util.f90 index 6da202ad6..a46ec64a0 100644 --- a/src/fraggle/fraggle_util.f90 +++ b/src/fraggle/fraggle_util.f90 @@ -37,49 +37,20 @@ module subroutine fraggle_util_get_angular_momentum(self) end subroutine fraggle_util_get_angular_momentum - module subroutine fraggle_util_construct_temporary_system(collision_system, nbody_system, param, tmpsys, tmpparam) + module subroutine fraggle_util_construct_temporary_system(self, nbody_system, param, tmpsys, tmpparam) !! Author: David A. Minton !! !! Constructs a temporary internal system consisting of active bodies and additional fragments. This internal temporary system is used to calculate system energy with and without fragments implicit none ! Arguments - class(fraggle_system), intent(inout) :: collision_system !! Fraggle collision system object - class(swiftest_nbody_system), intent(in) :: nbody_system !! Original swiftest nbody system object - class(swiftest_parameters), intent(in) :: param !! Current swiftest run configuration parameters - class(swiftest_nbody_system), allocatable, intent(out) :: tmpsys !! Output temporary swiftest nbody system object - class(swiftest_parameters), allocatable, intent(out) :: tmpparam !! Output temporary configuration run parameters - ! Internals - logical, dimension(:), allocatable :: linclude - integer(I4B) :: npl_tot - - associate(fragments => collision_system%fragments, nfrag => collision_system%fragments%nbody, pl => nbody_system%pl, npl => nbody_system%pl%nbody, cb => nbody_system%cb) - ! Set up a new system based on the original - if (allocated(tmpparam)) deallocate(tmpparam) - if (allocated(tmpsys)) deallocate(tmpsys) - allocate(tmpparam, source=param) - call setup_construct_system(tmpsys, tmpparam) - - ! No test particles necessary for energy/momentum calcs - call tmpsys%tp%setup(0, param) - - ! Replace the empty central body object with a copy of the original - deallocate(tmpsys%cb) - allocate(tmpsys%cb, source=cb) - - ! Make space for the fragments - npl_tot = npl + nfrag - call tmpsys%pl%setup(npl_tot, tmpparam) - allocate(linclude(npl_tot)) - - ! Fill up the temporary system with all of the original bodies, leaving the spaces for fragments empty until we add them in later - linclude(1:npl) = .true. - linclude(npl+1:npl_tot) = .false. - call tmpsys%pl%fill(pl, linclude) - - ! Scale the temporary system to the natural units of the current Fraggle calculation - call tmpsys%rescale(tmpparam, collision_system%mscale, collision_system%dscale, collision_system%tscale) - - end associate + class(fraggle_system), intent(inout) :: self !! Fraggle collision system object + class(swiftest_nbody_system), intent(in) :: nbody_system !! Original swiftest nbody system object + class(swiftest_parameters), intent(in) :: param !! Current swiftest run configuration parameters + class(swiftest_nbody_system), allocatable, intent(out) :: tmpsys !! Output temporary swiftest nbody system object + class(swiftest_parameters), allocatable, intent(out) :: tmpparam !! Output temporary configuration run parameters + + call self%collision_system%construct_temporary_system(nbody_system, param, tmpsys, tmpparam) + call tmpsys%rescale(tmpparam, self%mscale, self%dscale, self%tscale) return end subroutine fraggle_util_construct_temporary_system diff --git a/src/modules/collision_classes.f90 b/src/modules/collision_classes.f90 index ac80477f1..dccda9c88 100644 --- a/src/modules/collision_classes.f90 +++ b/src/modules/collision_classes.f90 @@ -101,14 +101,15 @@ module collision_classes real(DP), dimension(2) :: pe !! Before/after potential energy real(DP), dimension(2) :: Etot !! Before/after total system energy contains - procedure :: generate_fragments => abstract_generate_fragments !! Generates a system of fragments - procedure :: set_mass_dist => abstract_set_mass_dist !! Sets the distribution of mass among the fragments depending on the regime type - procedure :: setup => collision_setup_system !! Initializer for the encounter collision system. Allocates the collider and fragments classes and the before/after snapshots - procedure :: add_fragments => collison_util_add_fragments_to_system !! Add fragments to system - procedure :: get_energy_and_momentum => collision_util_get_energy_momentum !! Calculates total system energy in either the pre-collision outcome state (lbefore = .true.) or the post-collision outcome state (lbefore = .false.) - procedure :: reset => collision_util_reset_system !! Deallocates all allocatables - procedure :: set_coordinate_system => collision_util_set_coordinate_system !! Sets the coordinate system of the collisional system - final :: collision_util_final_system !! Finalizer will deallocate all allocatables + procedure :: generate_fragments => abstract_generate_fragments !! Generates a system of fragments + procedure :: set_mass_dist => abstract_set_mass_dist !! Sets the distribution of mass among the fragments depending on the regime type + procedure :: setup => collision_setup_system !! Initializer for the encounter collision system. Allocates the collider and fragments classes and the before/after snapshots + procedure :: add_fragments => collision_util_add_fragments_to_system !! Add fragments to system + procedure :: construct_temporary_system => collision_util_construct_temporary_system !! Constructs temporary n-body system in order to compute pre- and post-impact energy and momentum + procedure :: get_energy_and_momentum => collision_util_get_energy_momentum !! Calculates total system energy in either the pre-collision outcome state (lbefore = .true.) or the post-collision outcome state (lbefore = .false.) + procedure :: reset => collision_util_reset_system !! Deallocates all allocatables + procedure :: set_coordinate_system => collision_util_set_coordinate_system !! Sets the coordinate system of the collisional system + final :: collision_util_final_system !! Finalizer will deallocate all allocatables end type collision_system abstract interface @@ -253,12 +254,21 @@ module subroutine collision_setup_system(self, param) class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters end subroutine collision_setup_system - module subroutine collison_util_add_fragments_to_system(self, system, param) + module subroutine collision_util_add_fragments_to_system(self, system, param) implicit none class(collision_system), intent(in) :: self !! Collision system system object class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object class(swiftest_parameters), intent(in) :: param !! Current swiftest run configuration parameters - end subroutine collison_util_add_fragments_to_system + end subroutine collision_util_add_fragments_to_system + + module subroutine collision_util_construct_temporary_system(self, nbody_system, param, tmpsys, tmpparam) + implicit none + class(collision_system), intent(inout) :: self !! Fraggle collision system object + class(swiftest_nbody_system), intent(in) :: nbody_system !! Original swiftest nbody system object + class(swiftest_parameters), intent(in) :: param !! Current swiftest run configuration parameters + class(swiftest_nbody_system), allocatable, intent(out) :: tmpsys !! Output temporary swiftest nbody system object + class(swiftest_parameters), allocatable, intent(out) :: tmpparam !! Output temporary configuration run parameters + end subroutine collision_util_construct_temporary_system module subroutine collision_util_dealloc_fragments(self) implicit none diff --git a/src/modules/fraggle_classes.f90 b/src/modules/fraggle_classes.f90 index cdecf1205..de8542f67 100644 --- a/src/modules/fraggle_classes.f90 +++ b/src/modules/fraggle_classes.f90 @@ -56,13 +56,14 @@ module fraggle_classes real(DP) :: Escale = 1.0_DP !! Energy scale factor (a convenience unit that is derived from dscale, tscale, and mscale) real(DP) :: Lscale = 1.0_DP !! Angular momentum scale factor (a convenience unit that is derived from dscale, tscale, and mscale) contains - procedure :: generate_fragments => fraggle_generate_fragments !! Generates a system of fragments in barycentric coordinates that conserves energy and momentum. - procedure :: set_budgets => fraggle_set_budgets !! Sets the energy and momentum budgets of the fragments based on the collider value - procedure :: set_mass_dist => fraggle_set_mass_dist !! Sets the distribution of mass among the fragments depending on the regime type - procedure :: set_natural_scale => fraggle_set_natural_scale_factors !! Scales dimenional quantities to ~O(1) with respect to the collisional system. - procedure :: set_original_scale => fraggle_set_original_scale_factors !! Restores dimenional quantities back to the original system units - final :: fraggle_util_final_system !! Finalizer will deallocate all allocatables - end type fraggle_system + procedure :: generate_fragments => fraggle_generate_fragments !! Generates a system of fragments in barycentric coordinates that conserves energy and momentum. + procedure :: set_budgets => fraggle_set_budgets !! Sets the energy and momentum budgets of the fragments based on the collider value + procedure :: set_mass_dist => fraggle_set_mass_dist !! Sets the distribution of mass among the fragments depending on the regime type + procedure :: set_natural_scale => fraggle_set_natural_scale_factors !! Scales dimenional quantities to ~O(1) with respect to the collisional system. + procedure :: set_original_scale => fraggle_set_original_scale_factors !! Restores dimenional quantities back to the original system units + procedure :: construct_temporary_system => fraggle_util_construct_temporary_system !! Constructs temporary n-body system in order to compute pre- and post-impact energy and momentum + final :: fraggle_util_final_system !! Finalizer will deallocate all allocatables + end type fraggle_system interface @@ -118,14 +119,14 @@ module subroutine fraggle_util_get_angular_momentum(self) class(fraggle_fragments), intent(inout) :: self !! Fraggle fragment system object end subroutine fraggle_util_get_angular_momentum - module subroutine fraggle_util_construct_temporary_system(collision_system, nbody_system, param, tmpsys, tmpparam) + module subroutine fraggle_util_construct_temporary_system(self, nbody_system, param, tmpsys, tmpparam) use swiftest_classes, only : swiftest_nbody_system, swiftest_parameters implicit none - class(fraggle_system), intent(inout) :: collision_system !! Fraggle collision system object - class(swiftest_nbody_system), intent(in) :: nbody_system !! Original swiftest nbody system object - class(swiftest_parameters), intent(in) :: param !! Current swiftest run configuration parameters - class(swiftest_nbody_system), allocatable, intent(out) :: tmpsys !! Output temporary swiftest nbody system object - class(swiftest_parameters), allocatable, intent(out) :: tmpparam !! Output temporary configuration run parameters + class(fraggle_system), intent(inout) :: self !! Fraggle collision system object + class(swiftest_nbody_system), intent(in) :: nbody_system !! Original swiftest nbody system object + class(swiftest_parameters), intent(in) :: param !! Current swiftest run configuration parameters + class(swiftest_nbody_system), allocatable, intent(out) :: tmpsys !! Output temporary swiftest nbody system object + class(swiftest_parameters), allocatable, intent(out) :: tmpparam !! Output temporary configuration run parameters end subroutine fraggle_util_construct_temporary_system module subroutine fraggle_util_dealloc_fragments(self) From a41f331fdc95722983bf283490a61493f6ad231a Mon Sep 17 00:00:00 2001 From: David A Minton Date: Sat, 17 Dec 2022 20:13:02 -0500 Subject: [PATCH 460/569] More cleanup --- src/collision/collision_util.f90 | 2 +- src/encounter/encounter_util.f90 | 20 ++++++++++---------- src/modules/collision_classes.f90 | 2 +- src/modules/encounter_classes.f90 | 15 +++++++++++---- src/modules/swiftest_classes.f90 | 23 +++++++++++++++-------- src/util/util_index.f90 | 20 ++++++++++---------- 6 files changed, 48 insertions(+), 34 deletions(-) diff --git a/src/collision/collision_util.f90 b/src/collision/collision_util.f90 index 5e81b7b00..844bb8cca 100644 --- a/src/collision/collision_util.f90 +++ b/src/collision/collision_util.f90 @@ -310,7 +310,7 @@ module subroutine collision_util_index_map(self) integer(I4B), dimension(:), allocatable :: idvals real(DP), dimension(:), allocatable :: tvals - call encounter_util_get_vals_storage(self, idvals, tvals) + call self%get_index_values(idvals, tvals) ! Consolidate ids to only unique values call util_unique(idvals,self%idvals,self%idmap) diff --git a/src/encounter/encounter_util.f90 b/src/encounter/encounter_util.f90 index e6a786be2..4c472c4b3 100644 --- a/src/encounter/encounter_util.f90 +++ b/src/encounter/encounter_util.f90 @@ -203,19 +203,19 @@ module subroutine encounter_util_get_idvalues_snapshot(self, idvals) end subroutine encounter_util_get_idvalues_snapshot - subroutine encounter_util_get_vals_storage(storage, idvals, tvals) + module subroutine encounter_util_get_vals_storage(self, idvals, tvals) !! author: David A. Minton !! - !! Gets the id values in a storage object, regardless of whether it is encounter of collision + !! Gets the id values in a self object, regardless of whether it is encounter of collision ! Argument - class(swiftest_storage(*)), intent(in) :: storage !! Swiftest storage object - integer(I4B), dimension(:), allocatable, intent(out) :: idvals !! Array of all id values in all snapshots - real(DP), dimension(:), allocatable, intent(out) :: tvals !! Array of all time values in all snapshots + class(encounter_storage(*)), intent(in) :: self !! Encounter storages object + integer(I4B), dimension(:), allocatable, intent(out) :: idvals !! Array of all id values in all snapshots + real(DP), dimension(:), allocatable, intent(out) :: tvals !! Array of all time values in all snapshots ! Internals integer(I4B) :: i, n, nlo, nhi, ntotal integer(I4B), dimension(:), allocatable :: itmp - associate(nsnaps => storage%iframe) + associate(nsnaps => self%iframe) allocate(tvals(nsnaps)) @@ -224,8 +224,8 @@ subroutine encounter_util_get_vals_storage(storage, idvals, tvals) ! First pass to get total number of ids ntotal = 0 do i = 1, nsnaps - if (allocated(storage%frame(i)%item)) then - select type(snapshot => storage%frame(i)%item) + if (allocated(self%frame(i)%item)) then + select type(snapshot => self%frame(i)%item) class is (encounter_snapshot) tvals(i) = snapshot%t call snapshot%get_idvals(itmp) @@ -241,8 +241,8 @@ subroutine encounter_util_get_vals_storage(storage, idvals, tvals) nlo = 1 ! Second pass to store all ids get all of the ids stored do i = 1, nsnaps - if (allocated(storage%frame(i)%item)) then - select type(snapshot => storage%frame(i)%item) + if (allocated(self%frame(i)%item)) then + select type(snapshot => self%frame(i)%item) class is (encounter_snapshot) tvals(i) = snapshot%t call snapshot%get_idvals(itmp) diff --git a/src/modules/collision_classes.f90 b/src/modules/collision_classes.f90 index dccda9c88..791542ffd 100644 --- a/src/modules/collision_classes.f90 +++ b/src/modules/collision_classes.f90 @@ -161,7 +161,7 @@ end subroutine abstract_set_mass_dist end type collision_snapshot !> A class that that is used to store simulation history data between file output - type, extends(swiftest_storage) :: collision_storage + type, extends(encounter_storage) :: collision_storage contains procedure :: dump => collision_io_dump !! Dumps contents of encounter history to file procedure :: take_snapshot => collision_util_snapshot !! Take a minimal snapshot of the system through an encounter diff --git a/src/modules/encounter_classes.f90 b/src/modules/encounter_classes.f90 index e3aa2f9fe..164d97450 100644 --- a/src/modules/encounter_classes.f90 +++ b/src/modules/encounter_classes.f90 @@ -58,10 +58,11 @@ module encounter_classes !> A class that that is used to store simulation history data between file output type, extends(swiftest_storage) :: encounter_storage contains - procedure :: dump => encounter_io_dump !! Dumps contents of encounter history to file - procedure :: make_index_map => encounter_util_index_map !! Maps body id values to storage index values so we don't have to use unlimited dimensions for id - procedure :: take_snapshot => encounter_util_snapshot !! Take a minimal snapshot of the system through an encounter - final :: encounter_util_final_storage + procedure :: dump => encounter_io_dump !! Dumps contents of encounter history to file + procedure :: get_index_values => encounter_util_get_vals_storage !! Gets the unique values of the indices of a storage object (i.e. body id or time value) + procedure :: make_index_map => encounter_util_index_map !! Maps body id values to storage index values so we don't have to use unlimited dimensions for id + procedure :: take_snapshot => encounter_util_snapshot !! Take a minimal snapshot of the system through an encounter + final :: encounter_util_final_storage end type encounter_storage !> NetCDF dimension and variable names for the enounter save object @@ -288,6 +289,12 @@ module subroutine encounter_util_get_idvalues_snapshot(self, idvals) integer(I4B), dimension(:), allocatable, intent(out) :: idvals !! Array of all id values saved in this snapshot end subroutine encounter_util_get_idvalues_snapshot + module subroutine encounter_util_get_vals_storage(self, idvals, tvals) + class(encounter_storage(*)), intent(in) :: self !! Encounter storages object + integer(I4B), dimension(:), allocatable, intent(out) :: idvals !! Array of all id values in all snapshots + real(DP), dimension(:), allocatable, intent(out) :: tvals !! Array of all time values in all snapshots + end subroutine encounter_util_get_vals_storage + module subroutine encounter_util_index_map(self) implicit none class(encounter_storage(*)), intent(inout) :: self !! Encounter storage object diff --git a/src/modules/swiftest_classes.f90 b/src/modules/swiftest_classes.f90 index cf2ae97f4..972e3751f 100644 --- a/src/modules/swiftest_classes.f90 +++ b/src/modules/swiftest_classes.f90 @@ -146,9 +146,9 @@ module swiftest_classes type swiftest_storage_frame class(*), allocatable :: item contains - 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 - final :: util_final_storage_frame + 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 + final :: util_final_storage_frame end type type :: swiftest_storage(nframes) @@ -164,11 +164,12 @@ module swiftest_classes integer(I4B), dimension(:), allocatable :: tmap !! The t value -> index map class(netcdf_parameters), allocatable :: nc !! NetCDF object attached to this storage object contains - procedure :: dump => io_dump_storage !! Dumps storage object contents to file - procedure :: make_index_map => util_index_map_storage !! Maps body id values to storage index values so we don't have to use unlimited dimensions for id - procedure :: reset => util_reset_storage !! Resets a storage object by deallocating all items and resetting the frame counter to 0 - procedure :: take_snapshot => util_snapshot_system !! Takes a snapshot of the system for later file storage - final :: util_final_storage + procedure :: dump => io_dump_storage !! Dumps storage object contents to file + procedure :: get_index_values => util_get_vals_storage !! Gets the unique values of the indices of a storage object (i.e. body id or time value) + procedure :: make_index_map => util_index_map_storage !! Maps body id values to storage index values so we don't have to use unlimited dimensions for id + procedure :: reset => util_reset_storage !! Resets a storage object by deallocating all items and resetting the frame counter to 0 + procedure :: take_snapshot => util_snapshot_system !! Takes a snapshot of the system for later file storage + final :: util_final_storage end type swiftest_storage !******************************************************************************************************************************** @@ -1507,6 +1508,12 @@ module subroutine util_flatten_eucl_pltp(self, pl, param) class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters end subroutine + module subroutine util_get_vals_storage(self, idvals, tvals) + class(swiftest_storage(*)), intent(in) :: self !! Swiftest storage object + integer(I4B), dimension(:), allocatable, intent(out) :: idvals !! Array of all id values in all snapshots + real(DP), dimension(:), allocatable, intent(out) :: tvals !! Array of all time values in all snapshots + end subroutine util_get_vals_storage + module subroutine util_index_array(ind_arr, n) implicit none integer(I4B), dimension(:), allocatable, intent(inout) :: ind_arr !! Index array. Input is a pre-existing index array where n /= size(ind_arr). Output is a new index array ind_arr = [1, 2, ... n] diff --git a/src/util/util_index.f90 b/src/util/util_index.f90 index 0fbd40319..e268b3789 100644 --- a/src/util/util_index.f90 +++ b/src/util/util_index.f90 @@ -78,19 +78,19 @@ module subroutine util_get_idvalues_system(self, idvals) end subroutine util_get_idvalues_system - subroutine util_get_vals_storage(storage, idvals, tvals) + module subroutine util_get_vals_storage(self, idvals, tvals) !! author: David A. Minton !! !! Gets the id values in a storage object, regardless of whether it is encounter of collision ! Argument - class(swiftest_storage(*)), intent(in) :: storage !! Swiftest storage object - integer(I4B), dimension(:), allocatable, intent(out) :: idvals !! Array of all id values in all snapshots - real(DP), dimension(:), allocatable, intent(out) :: tvals !! Array of all time values in all snapshots + class(swiftest_storage(*)), intent(in) :: self !! Swiftest storage object + integer(I4B), dimension(:), allocatable, intent(out) :: idvals !! Array of all id values in all snapshots + real(DP), dimension(:), allocatable, intent(out) :: tvals !! Array of all time values in all snapshots ! Internals integer(I4B) :: i, n, nlo, nhi, ntotal integer(I4B), dimension(:), allocatable :: itmp - associate(nsnaps => storage%iframe) + associate(nsnaps => self%iframe) allocate(tvals(nsnaps)) tvals(:) = 0.0_DP @@ -98,8 +98,8 @@ subroutine util_get_vals_storage(storage, idvals, tvals) ! First pass to get total number of ids ntotal = 0 do i = 1, nsnaps - if (allocated(storage%frame(i)%item)) then - select type(snapshot => storage%frame(i)%item) + if (allocated(self%frame(i)%item)) then + select type(snapshot => self%frame(i)%item) class is (swiftest_nbody_system) tvals(i) = snapshot%t call snapshot%get_idvals(itmp) @@ -115,8 +115,8 @@ subroutine util_get_vals_storage(storage, idvals, tvals) nlo = 1 ! Second pass to store all ids get all of the ids stored do i = 1, nsnaps - if (allocated(storage%frame(i)%item)) then - select type(snapshot => storage%frame(i)%item) + if (allocated(self%frame(i)%item)) then + select type(snapshot => self%frame(i)%item) class is (swiftest_nbody_system) tvals(i) = snapshot%t call snapshot%get_idvals(itmp) @@ -146,7 +146,7 @@ module subroutine util_index_map_storage(self) integer(I4B), dimension(:), allocatable :: idvals real(DP), dimension(:), allocatable :: tvals - call util_get_vals_storage(self, idvals, tvals) + call self%get_index_values(idvals, tvals) call util_unique(idvals,self%idvals,self%idmap) self%nid = size(self%idvals) From a009b559dff4de9a7abd5963a75dc8eeb96e6662 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Sat, 17 Dec 2022 20:29:39 -0500 Subject: [PATCH 461/569] It compiles --- src/modules/swiftest_classes.f90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/modules/swiftest_classes.f90 b/src/modules/swiftest_classes.f90 index 972e3751f..813426dc7 100644 --- a/src/modules/swiftest_classes.f90 +++ b/src/modules/swiftest_classes.f90 @@ -146,9 +146,9 @@ module swiftest_classes type swiftest_storage_frame class(*), allocatable :: item contains - 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 - final :: util_final_storage_frame + 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 + final :: util_final_storage_frame end type type :: swiftest_storage(nframes) From 199b28842b93476e6a896cf8f7433d12a400f354 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Sat, 17 Dec 2022 20:40:16 -0500 Subject: [PATCH 462/569] Cleanup and fixing segfaults --- src/collision/collision_regime.f90 | 2 ++ src/collision/collision_util.f90 | 4 ++-- src/fraggle/fraggle_set.f90 | 9 ++++++--- src/fraggle/fraggle_setup.f90 | 1 + 4 files changed, 11 insertions(+), 5 deletions(-) diff --git a/src/collision/collision_regime.f90 b/src/collision/collision_regime.f90 index 89fdeb269..94079e388 100644 --- a/src/collision/collision_regime.f90 +++ b/src/collision/collision_regime.f90 @@ -61,6 +61,8 @@ module subroutine collision_regime_impactors(self, system, param) x1_si(:), x2_si(:), v1_si(:), v2_si(:), density_si(jtarg), density_si(jproj), & min_mfrag_si, impactors%regime, mlr, mslr, impactors%Qloss) + if (allocated(impactors%mass_dist)) deallocate(impactors%mass_dist) + allocate(impactors%mass_dist(3)) impactors%mass_dist(1) = min(max(mlr, 0.0_DP), mtot) impactors%mass_dist(2) = min(max(mslr, 0.0_DP), mtot) impactors%mass_dist(3) = min(max(mtot - mlr - mslr, 0.0_DP), mtot) diff --git a/src/collision/collision_util.f90 b/src/collision/collision_util.f90 index 844bb8cca..68412cfc5 100644 --- a/src/collision/collision_util.f90 +++ b/src/collision/collision_util.f90 @@ -413,8 +413,8 @@ module subroutine collision_util_reset_system(self, param) self%pe(:) = 0.0_DP self%Etot(:) = 0.0_DP - call self%impactors%reset() - call self%fragments%setup(0, param) + if (allocated(self%impactors)) call self%impactors%reset() + if (allocated(self%fragments)) call self%fragments%setup(0, param) return end subroutine collision_util_reset_system diff --git a/src/fraggle/fraggle_set.f90 b/src/fraggle/fraggle_set.f90 index 7c405db90..b0cfdf951 100644 --- a/src/fraggle/fraggle_set.f90 +++ b/src/fraggle/fraggle_set.f90 @@ -52,7 +52,7 @@ module subroutine fraggle_set_mass_dist(self, param) integer(I4B) :: i, jproj, jtarg, nfrag, istart real(DP), dimension(2) :: volume real(DP), dimension(NDIM) :: Ip_avg - real(DP) :: mfrag, mremaining, min_mfrag + real(DP) :: mfrag, mremaining, min_mfrag, mtot real(DP), parameter :: BETA = 2.85_DP integer(I4B), parameter :: NFRAGMAX = 100 !! Maximum number of fragments that can be generated integer(I4B), parameter :: NFRAGMIN = 7 !! Minimum number of fragments that can be generated (set by the fraggle_generate algorithm for constraining momentum and energy) @@ -66,7 +66,9 @@ module subroutine fraggle_set_mass_dist(self, param) class is (fraggle_fragments) ! Get mass weighted mean of Ip and density volume(1:2) = 4._DP / 3._DP * PI * impactors%radius(1:2)**3 - Ip_avg(:) = (impactors%mass(1) * impactors%Ip(:,1) + impactors%mass(2) * impactors%Ip(:,2)) / fragments%mtot + mtot = sum(impactors%mass(:)) + Ip_avg(:) = (impactors%mass(1) * impactors%Ip(:,1) + impactors%mass(2) * impactors%Ip(:,2)) / mtot + if (impactors%mass(1) > impactors%mass(2)) then jtarg = 1 jproj = 2 @@ -88,7 +90,7 @@ module subroutine fraggle_set_mass_dist(self, param) ! The number of fragments we generate is bracked by the minimum required by fraggle_generate (7) and the ! maximum set by the NFRAG_SIZE_MULTIPLIER which limits the total number of fragments to prevent the nbody ! code from getting an overwhelmingly large number of fragments - nfrag = ceiling(NFRAG_SIZE_MULTIPLIER * log(fragments%mtot / min_mfrag)) + nfrag = ceiling(NFRAG_SIZE_MULTIPLIER * log(mtot / min_mfrag)) nfrag = max(min(nfrag, NFRAGMAX), NFRAGMIN) class default min_mfrag = 0.0_DP @@ -116,6 +118,7 @@ module subroutine fraggle_set_mass_dist(self, param) case default write(*,*) "fraggle_set_mass_dist_fragments error: Unrecognized regime code",impactors%regime end select + fragments%mtot = mtot ! Make the first two bins the same as the Mlr and Mslr values that came from collision_regime fragments%mass(1) = impactors%mass_dist(iMlr) diff --git a/src/fraggle/fraggle_setup.f90 b/src/fraggle/fraggle_setup.f90 index 63e2a2f5b..2e67f6c7d 100644 --- a/src/fraggle/fraggle_setup.f90 +++ b/src/fraggle/fraggle_setup.f90 @@ -48,6 +48,7 @@ module subroutine fraggle_setup_fragments(self, n, param) call collision_setup_fragments(self, n, param) if (n < 0) return + if (allocated(self%rotmag)) deallocate(self%rotmag) if (allocated(self%v_r_mag)) deallocate(self%v_r_mag) if (allocated(self%v_t_mag)) deallocate(self%v_t_mag) if (allocated(self%v_n_mag)) deallocate(self%v_t_mag) From 43361007eb0733b86c3335450c2fbc610e257766 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Sat, 17 Dec 2022 21:18:13 -0500 Subject: [PATCH 463/569] more cleanup --- src/setup/setup.f90 | 35 +++++++++++++++++------------------ 1 file changed, 17 insertions(+), 18 deletions(-) diff --git a/src/setup/setup.f90 b/src/setup/setup.f90 index 9b27416ae..df55a53e9 100644 --- a/src/setup/setup.f90 +++ b/src/setup/setup.f90 @@ -20,6 +20,9 @@ module subroutine setup_construct_system(system, param) ! Arguments class(swiftest_nbody_system), allocatable, intent(inout) :: system !! Swiftest system object class(swiftest_parameters), intent(inout) :: param !! Swiftest parameters + ! Internals + type(encounter_storage) :: encounter_history + type(collision_storage) :: collision_history allocate(swiftest_storage(param%dump_cadence) :: param%system_history) allocate(netcdf_parameters :: param%system_history%nc) @@ -85,26 +88,22 @@ module subroutine setup_construct_system(system, param) end if if (param%lenc_save_trajectory .or. param%lenc_save_closest) then - allocate(encounter_storage :: param%encounter_history) - associate (encounter_history => param%encounter_history) - allocate(encounter_io_parameters :: encounter_history%nc) - call encounter_history%reset() - select type(nc => encounter_history%nc) - class is (encounter_io_parameters) - nc%file_number = param%iloop / param%dump_cadence - end select - end associate - end if - - allocate(collision_storage :: param%collision_history) - associate (collision_history => param%collision_history) - allocate(collision_io_parameters :: collision_history%nc) - call collision_history%reset() - select type(nc => collision_history%nc) - class is (collision_io_parameters) + allocate(encounter_io_parameters :: encounter_history%nc) + call encounter_history%reset() + select type(nc => encounter_history%nc) + class is (encounter_io_parameters) nc%file_number = param%iloop / param%dump_cadence end select - end associate + allocate(param%encounter_history, source=encounter_history) + end if + + allocate(collision_io_parameters :: collision_history%nc) + call collision_history%reset() + select type(nc => collision_history%nc) + class is (collision_io_parameters) + nc%file_number = param%iloop / param%dump_cadence + end select + allocate(param%collision_history, source=collision_history) end select From 348b8de25356d0a4d90f5b63ed7a2b34e6e85a09 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Sat, 17 Dec 2022 21:24:17 -0500 Subject: [PATCH 464/569] Fixed issue where failed fragmentation didn't get the copy of the "after" system for recording --- src/collision/collision_io.f90 | 4 ++-- src/symba/symba_collision.f90 | 1 + 2 files changed, 3 insertions(+), 2 deletions(-) diff --git a/src/collision/collision_io.f90 b/src/collision/collision_io.f90 index e22937577..5afb3ab8e 100644 --- a/src/collision/collision_io.f90 +++ b/src/collision/collision_io.f90 @@ -227,9 +227,9 @@ module subroutine collision_io_write_frame_snapshot(self, nc, param) if (allocated(pl)) deallocate(pl) select case(stage) case(1) - allocate(pl, source=system%before%pl) + allocate(pl, source=self%collision_system%before%pl) case(2) - allocate(pl, source=system%after%pl) + allocate(pl, source=self%collision_system%after%pl) end select npl = pl%nbody do i = 1, npl diff --git a/src/symba/symba_collision.f90 b/src/symba/symba_collision.f90 index 3af2c7e99..0c0150997 100644 --- a/src/symba/symba_collision.f90 +++ b/src/symba/symba_collision.f90 @@ -60,6 +60,7 @@ module function symba_collision_casedisruption(system, param, t) result(status) pl%ldiscard(impactors%idx(:)) = .false. pl%lcollision(impactors%idx(:)) = .false. end select + allocate(collision_system%after%pl, source=collision_system%before%pl) ! Be sure to save the pl so that snapshots still work else ! Populate the list of new bodies nfrag = fragments%nbody From a1501e5d7e232a69166ac5ce0d43f7f2b5c0e56f Mon Sep 17 00:00:00 2001 From: David A Minton Date: Tue, 20 Dec 2022 18:06:53 -0500 Subject: [PATCH 465/569] Major restructuring to pull collision modeling out of SyMBA. Still doesn't compile, but getting close --- src/CMakeLists.txt | 80 +- src/collision/collision_check.f90 | 263 + src/collision/collision_io.f90 | 238 +- src/collision/collision_regime.f90 | 162 +- src/collision/collision_resolve.f90 | 768 +++ src/collision/collision_setup.f90 | 82 +- src/collision/collision_util.f90 | 451 +- src/encounter/encounter_check.f90 | 214 +- src/encounter/encounter_io.f90 | 165 +- src/encounter/encounter_setup.f90 | 4 +- src/encounter/encounter_util.f90 | 389 +- src/fraggle/fraggle_generate.f90 | 93 +- src/fraggle/fraggle_io.f90 | 4 +- src/fraggle/fraggle_resolve.f90 | 192 + src/fraggle/fraggle_set.f90 | 125 +- src/fraggle/fraggle_setup.f90 | 58 +- src/fraggle/fraggle_util.f90 | 101 +- src/helio/helio_drift.f90 | 4 +- src/helio/helio_gr.f90 | 10 +- src/helio/helio_kick.f90 | 6 +- src/helio/helio_setup.f90 | 2 +- src/helio/helio_step.f90 | 2 +- src/helio/helio_util.f90 | 2 +- src/main/swiftest_driver.f90 | 10 +- src/modules/base.f90 | 487 ++ src/modules/collision.f90 | 406 ++ src/modules/collision_classes.f90 | 341 -- .../{encounter_classes.f90 => encounter.f90} | 96 +- .../{fraggle_classes.f90 => fraggle.f90} | 118 +- .../{swiftest_globals.f90 => globals.f90} | 26 +- src/modules/{helio_classes.f90 => helio.f90} | 37 +- src/{io => modules}/io_progress_bar.f90 | 24 +- src/modules/lambda_function.f90 | 2 +- .../{swiftest_operators.f90 => operators.f90} | 6 +- src/modules/{rmvs_classes.f90 => rmvs.f90} | 39 +- src/modules/swiftest.f90 | 1887 ++++++- src/modules/swiftest_classes.f90 | 2007 ------- src/modules/{symba_classes.f90 => symba.f90} | 334 +- src/modules/walltime.f90 | 76 + src/modules/walltime_classes.f90 | 134 - src/modules/{whm_classes.f90 => whm.f90} | 42 +- src/netcdf/netcdf.f90 | 1290 ----- src/operators/operator_cross.f90 | 2 +- src/operators/operator_mag.f90 | 2 +- src/operators/operator_unit.f90 | 2 +- src/rmvs/rmvs_discard.f90 | 2 +- src/rmvs/rmvs_encounter_check.f90 | 2 +- src/rmvs/rmvs_kick.f90 | 2 +- src/rmvs/rmvs_setup.f90 | 2 +- src/rmvs/rmvs_step.f90 | 20 +- src/rmvs/rmvs_util.f90 | 2 +- .../swiftest_discard.f90} | 31 +- .../swiftest_drift.f90} | 99 +- .../swiftest_gr.f90} | 35 +- .../swiftest_io.f90} | 315 +- .../swiftest_io_netcdf.f90 | 1211 ++++ .../swiftest_kick.f90} | 34 +- .../swiftest_obl.f90} | 19 +- .../swiftest_orbel.f90} | 181 +- .../swiftest_setup.f90} | 187 +- src/swiftest_procedures/swiftest_util.f90 | 4923 +++++++++++++++++ src/symba/symba_collision.f90 | 1081 ---- src/symba/symba_discard.f90 | 44 +- src/symba/symba_drift.f90 | 2 +- src/symba/symba_encounter_check.f90 | 64 +- src/symba/symba_gr.f90 | 2 +- src/symba/symba_io.f90 | 198 +- src/symba/symba_kick.f90 | 28 +- src/symba/symba_setup.f90 | 48 +- src/symba/symba_step.f90 | 76 +- src/symba/symba_util.f90 | 527 +- src/tides/tides_getacch_pl.f90 | 6 +- src/tides/tides_spin_step.f90 | 30 +- src/user/user_getacch.f90 | 12 +- src/util/util_append.f90 | 304 - src/util/util_coord.f90 | 309 -- src/util/util_copy.f90 | 95 - src/util/util_dealloc.f90 | 93 - src/util/util_exit.f90 | 49 - src/util/util_fill.f90 | 256 - src/util/util_final.f90 | 62 - src/util/util_flatten.f90 | 148 - src/util/util_get_energy_momentum.f90 | 219 - src/util/util_index.f90 | 160 - src/util/util_minimize_bfgs.f90 | 593 -- src/util/util_peri.f90 | 75 - src/util/util_rescale.f90 | 63 - src/util/util_reset.f90 | 37 - src/util/util_resize.f90 | 372 -- src/util/util_set.f90 | 251 - src/util/util_snapshot.f90 | 36 - src/util/util_solve.f90 | 237 - src/util/util_sort.f90 | 1007 ---- src/util/util_spill.f90 | 440 -- src/util/util_unique.f90 | 80 - src/util/util_valid.f90 | 52 - src/util/util_version.f90 | 62 - src/walltime/walltime.f90 | 352 -- src/walltime/walltime_implementations.f90 | 143 + src/whm/whm_coord.f90 | 2 +- src/whm/whm_drift.f90 | 4 +- src/whm/whm_gr.f90 | 10 +- src/whm/whm_kick.f90 | 8 +- src/whm/whm_setup.f90 | 2 +- src/whm/whm_step.f90 | 2 +- src/whm/whm_util.f90 | 2 +- 106 files changed, 12296 insertions(+), 13195 deletions(-) create mode 100644 src/collision/collision_check.f90 create mode 100644 src/collision/collision_resolve.f90 create mode 100644 src/fraggle/fraggle_resolve.f90 create mode 100644 src/modules/base.f90 create mode 100644 src/modules/collision.f90 delete mode 100644 src/modules/collision_classes.f90 rename src/modules/{encounter_classes.f90 => encounter.f90} (84%) rename src/modules/{fraggle_classes.f90 => fraggle.f90} (61%) rename src/modules/{swiftest_globals.f90 => globals.f90} (90%) rename src/modules/{helio_classes.f90 => helio.f90} (83%) rename src/{io => modules}/io_progress_bar.f90 (84%) rename src/modules/{swiftest_operators.f90 => operators.f90} (99%) rename src/modules/{rmvs_classes.f90 => rmvs.f90} (89%) delete mode 100644 src/modules/swiftest_classes.f90 rename src/modules/{symba_classes.f90 => symba.f90} (55%) create mode 100644 src/modules/walltime.f90 delete mode 100644 src/modules/walltime_classes.f90 rename src/modules/{whm_classes.f90 => whm.f90} (86%) delete mode 100644 src/netcdf/netcdf.f90 rename src/{discard/discard.f90 => swiftest_procedures/swiftest_discard.f90} (95%) rename src/{drift/drift.f90 => swiftest_procedures/swiftest_drift.f90} (88%) rename src/{gr/gr.f90 => swiftest_procedures/swiftest_gr.f90} (91%) rename src/{io/io.f90 => swiftest_procedures/swiftest_io.f90} (86%) create mode 100644 src/swiftest_procedures/swiftest_io_netcdf.f90 rename src/{kick/kick.f90 => swiftest_procedures/swiftest_kick.f90} (92%) rename src/{obl/obl.f90 => swiftest_procedures/swiftest_obl.f90} (94%) rename src/{orbel/orbel.f90 => swiftest_procedures/swiftest_orbel.f90} (87%) rename src/{setup/setup.f90 => swiftest_procedures/swiftest_setup.f90} (67%) create mode 100644 src/swiftest_procedures/swiftest_util.f90 delete mode 100644 src/symba/symba_collision.f90 delete mode 100644 src/util/util_append.f90 delete mode 100644 src/util/util_coord.f90 delete mode 100644 src/util/util_copy.f90 delete mode 100644 src/util/util_dealloc.f90 delete mode 100644 src/util/util_exit.f90 delete mode 100644 src/util/util_fill.f90 delete mode 100644 src/util/util_final.f90 delete mode 100644 src/util/util_flatten.f90 delete mode 100644 src/util/util_get_energy_momentum.f90 delete mode 100644 src/util/util_index.f90 delete mode 100644 src/util/util_minimize_bfgs.f90 delete mode 100644 src/util/util_peri.f90 delete mode 100644 src/util/util_rescale.f90 delete mode 100644 src/util/util_reset.f90 delete mode 100644 src/util/util_resize.f90 delete mode 100644 src/util/util_set.f90 delete mode 100644 src/util/util_snapshot.f90 delete mode 100644 src/util/util_solve.f90 delete mode 100644 src/util/util_sort.f90 delete mode 100644 src/util/util_spill.f90 delete mode 100644 src/util/util_unique.f90 delete mode 100644 src/util/util_valid.f90 delete mode 100644 src/util/util_version.f90 delete mode 100644 src/walltime/walltime.f90 create mode 100644 src/walltime/walltime_implementations.f90 diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index 95ee7e9a0..92784193d 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -13,55 +13,59 @@ # Add the source files SET(FAST_MATH_FILES - ${SRC}/modules/swiftest_globals.f90 + ${SRC}/modules/globals.f90 + ${SRC}/modules/base.f90 + ${SRC}/modules/encounter.f90 + ${SRC}/modules/collision.f90 + ${SRC}/modules/fraggle.f90 ${SRC}/modules/lambda_function.f90 - ${SRC}/modules/swiftest_operators.f90 - ${SRC}/modules/walltime_classes.f90 - ${SRC}/modules/swiftest_classes.f90 - ${SRC}/modules/encounter_classes.f90 - ${SRC}/modules/collision_classes.f90 - ${SRC}/modules/fraggle_classes.f90 - ${SRC}/modules/helio_classes.f90 - ${SRC}/modules/rmvs_classes.f90 - ${SRC}/modules/symba_classes.f90 - ${SRC}/modules/whm_classes.f90 + ${SRC}/modules/operators.f90 + ${SRC}/modules/walltime.f90 + ${SRC}/modules/io_progress_bar.f90 ${SRC}/modules/swiftest.f90 - ${SRC}/collision/collision_io.f90 - ${SRC}/collision/collision_regime.f90 + ${SRC}/modules/whm.f90 + ${SRC}/modules/rmvs.f90 + ${SRC}/modules/helio.f90 + ${SRC}/modules/symba.f90 + ${SRC}/swiftest_procedures/swiftest_discard.f90 + ${SRC}/swiftest_procedures/swiftest_io.f90 + ${SRC}/swiftest_procedures/swiftest_obl.f90 + ${SRC}/swiftest_procedures/swiftest_util.f90 + ${SRC}/swiftest_procedures/swiftest_drift.f90 + ${SRC}/swiftest_procedures/swiftest_io_netcdf.f90 + ${SRC}/swiftest_procedures/swiftest_orbel.f90 + ${SRC}/swiftest_procedures/swiftest_gr.f90 + ${SRC}/swiftest_procedures/swiftest_kick.f90 + ${SRC}/swiftest_procedures/swiftest_setup.f90 + ${SRC}/collision/collision_check.f90 + ${SRC}/collision/collision_regime.f90 ${SRC}/collision/collision_setup.f90 + ${SRC}/collision/collision_io.f90 + ${SRC}/collision/collision_resolve.f90 ${SRC}/collision/collision_util.f90 - ${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}/encounter/encounter_io.f90 ${SRC}/fraggle/fraggle_generate.f90 ${SRC}/fraggle/fraggle_io.f90 + ${SRC}/fraggle/fraggle_resolve.f90 ${SRC}/fraggle/fraggle_set.f90 ${SRC}/fraggle/fraggle_setup.f90 ${SRC}/fraggle/fraggle_util.f90 - ${SRC}/gr/gr.f90 ${SRC}/helio/helio_drift.f90 ${SRC}/helio/helio_gr.f90 ${SRC}/helio/helio_setup.f90 ${SRC}/helio/helio_step.f90 ${SRC}/helio/helio_util.f90 - ${SRC}/io/io.f90 - ${SRC}/io/io_progress_bar.f90 - ${SRC}/netcdf/netcdf.f90 - ${SRC}/obl/obl.f90 ${SRC}/operators/operator_cross.f90 ${SRC}/operators/operator_mag.f90 ${SRC}/operators/operator_unit.f90 - ${SRC}/orbel/orbel.f90 ${SRC}/rmvs/rmvs_discard.f90 ${SRC}/rmvs/rmvs_encounter_check.f90 ${SRC}/rmvs/rmvs_setup.f90 ${SRC}/rmvs/rmvs_step.f90 ${SRC}/rmvs/rmvs_util.f90 - ${SRC}/setup/setup.f90 - ${SRC}/symba/symba_collision.f90 ${SRC}/symba/symba_discard.f90 ${SRC}/symba/symba_drift.f90 ${SRC}/symba/symba_encounter_check.f90 @@ -73,30 +77,7 @@ SET(FAST_MATH_FILES ${SRC}/tides/tides_getacch_pl.f90 ${SRC}/tides/tides_spin_step.f90 ${SRC}/user/user_getacch.f90 - ${SRC}/util/util_append.f90 - ${SRC}/util/util_coord.f90 - ${SRC}/util/util_copy.f90 - ${SRC}/util/util_dealloc.f90 - ${SRC}/util/util_exit.f90 - ${SRC}/util/util_fill.f90 - ${SRC}/util/util_final.f90 - ${SRC}/util/util_flatten.f90 - ${SRC}/util/util_get_energy_momentum.f90 - ${SRC}/util/util_index.f90 - ${SRC}/util/util_minimize_bfgs.f90 - ${SRC}/util/util_peri.f90 - ${SRC}/util/util_rescale.f90 - ${SRC}/util/util_reset.f90 - ${SRC}/util/util_resize.f90 - ${SRC}/util/util_set.f90 - ${SRC}/util/util_snapshot.f90 - ${SRC}/util/util_solve.f90 - ${SRC}/util/util_sort.f90 - ${SRC}/util/util_spill.f90 - ${SRC}/util/util_unique.f90 - ${SRC}/util/util_valid.f90 - ${SRC}/util/util_version.f90 - ${SRC}/walltime/walltime.f90 + ${SRC}/walltime/walltime_implementations.f90 ${SRC}/whm/whm_coord.f90 ${SRC}/whm/whm_drift.f90 ${SRC}/whm/whm_gr.f90 @@ -105,8 +86,9 @@ SET(FAST_MATH_FILES ${SRC}/whm/whm_util.f90 ${SRC}/main/swiftest_driver.f90 ) + SET(STRICT_MATH_FILES - ${SRC}/kick/kick.f90 + ${SRC}/swiftest_procedures/swiftest_kick.f90 ${SRC}/helio/helio_kick.f90 ${SRC}/rmvs/rmvs_kick.f90 ${SRC}/symba/symba_kick.f90 diff --git a/src/collision/collision_check.f90 b/src/collision/collision_check.f90 new file mode 100644 index 000000000..290773032 --- /dev/null +++ b/src/collision/collision_check.f90 @@ -0,0 +1,263 @@ + +!! Copyright 2022 - David Minton, Carlisle Wishard, Jennifer Pouplin, Jake Elliott, & Dana Singh +!! This file is part of Swiftest. +!! Swiftest is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License +!! as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. +!! Swiftest is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty +!! of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. +!! You should have received a copy of the GNU General Public License along with Swiftest. +!! If not, see: https://www.gnu.org/licenses. + +submodule (collision) s_collision_check + use swiftest +contains + + pure elemental subroutine collision_check_one(xr, yr, zr, vxr, vyr, vzr, Gmtot, rlim, dt, lvdotr, lcollision, lclosest) + !! author: David A. Minton + !! + !! Check for a merger between a single pair of particles + !! + !! Adapted from David E. Kaufmann's Swifter routines symba_merge_tp.f90 and symba_merge_pl.f90 + !! + !! Adapted from Hal Levison's Swift routine symba5_merge.f + implicit none + ! Arguments + real(DP), intent(in) :: xr, yr, zr !! Relative position vector components + real(DP), intent(in) :: vxr, vyr, vzr !! Relative velocity vector components + real(DP), intent(in) :: Gmtot !! Sum of G*mass of colliding bodies + real(DP), intent(in) :: rlim !! Collision limit - Typically the sum of the radii of colliding bodies + real(DP), intent(in) :: dt !! Step size + logical, intent(in) :: lvdotr !! Logical flag indicating that these two bodies are approaching in the current substep + logical, intent(out) :: lcollision !! Logical flag indicating whether these two bodies will collide or not + logical, intent(out) :: lclosest !! Logical flag indicating that, while not a collision, this is the closest approach for this pair of bodies + ! Internals + real(DP) :: r2, rlim2, a, e, q, vdotr, tcr2, dt2 + + r2 = xr**2 + yr**2 + zr**2 + rlim2 = rlim**2 + lclosest = .false. + if (r2 <= rlim2) then ! checks if bodies are actively colliding in this time step + lcollision = .true. + else ! if they are not actively colliding in this time step, checks if they are going to collide next time step based on velocities and q + lcollision = .false. + vdotr = xr * vxr + yr * vyr + zr * vzr + if (lvdotr .and. (vdotr > 0.0_DP)) then + tcr2 = r2 / (vxr**2 + vyr**2 + vzr**2) + dt2 = dt**2 + if (tcr2 <= dt2) then + call swiftest_orbel_xv2aeq(Gmtot, xr, yr, zr, vxr, vyr, vzr, a, e, q) + lcollision = (q < rlim) + end if + lclosest = .not. lcollision + end if + end if + + return + end subroutine collision_check_one + + + module subroutine collision_check_plpl(self, system, param, t, dt, irec, lany_collision) + !! author: David A. Minton + !! + !! Check for merger between massive bodies and test particles in SyMBA + !! + !! Adapted from David E. Kaufmann's Swifter routine symba_merge.f90 and symba_merge_tp.f90 + !! + !! Adapted from Hal Levison's Swift routine symba5_merge.f + implicit none + ! Arguments + class(collision_list_plpl), intent(inout) :: self !! SyMBA pl-tp encounter list object + class(base_nbody_system), intent(inout) :: system !! SyMBA nbody system object + class(base_parameters), intent(inout) :: param !! Current run configuration parameters + real(DP), intent(in) :: t !! current time + real(DP), intent(in) :: dt !! step size + integer(I4B), intent(in) :: irec !! Current recursion level + logical, intent(out) :: lany_collision !! Returns true if cany pair of encounters resulted in a collision + ! Internals + logical, dimension(:), allocatable :: lcollision, lmask + real(DP), dimension(NDIM) :: xr, vr + integer(I4B) :: i, j, k, nenc + real(DP) :: rlim, Gmtot + logical :: isplpl, lany_closest + character(len=STRMAX) :: timestr, idstri, idstrj, message + class(collision_list_plpl), allocatable :: tmp + + lany_collision = .false. + if (self%nenc == 0) return + + select type(system) + class is (swiftest_nbody_system) + associate(pl => system%pl) + + nenc = self%nenc + allocate(lmask(nenc)) + ! TODO: Move this to a SyMBA-specific method + ! lmask(:) = ((self%status(1:nenc) == ACTIVE) .and. (pl%levelg(self%index1(1:nenc)) >= irec)) + ! if (isplpl) then + ! lmask(:) = lmask(:) .and. (pl%levelg(self%index2(1:nenc)) >= irec) + ! else + ! lmask(:) = lmask(:) .and. (tp%levelg(self%index2(1:nenc)) >= irec) + ! end if + ! if (.not.any(lmask(:))) return + + allocate(lcollision(nenc)) + lcollision(:) = .false. + self%lclosest(:) = .false. + + do concurrent(k = 1:nenc, lmask(k)) + i = self%index1(k) + j = self%index2(k) + xr(:) = pl%rh(:, i) - pl%rh(:, j) + vr(:) = pl%vb(:, i) - pl%vb(:, j) + rlim = pl%radius(i) + pl%radius(j) + Gmtot = pl%Gmass(i) + pl%Gmass(j) + call collision_check_one(xr(1), xr(2), xr(3), vr(1), vr(2), vr(3), Gmtot, rlim, dt, self%lvdotr(k), lcollision(k), self%lclosest(k)) + end do + + lany_collision = any(lcollision(:)) + !lany_closest = (param%lenc_save_closest .and. any(self%lclosest(:))) + + + if (lany_collision .or. lany_closest) then + call pl%rh2rb(system%cb) ! Update the central body barycenteric position vector to get us out of DH and into bary + do k = 1, nenc + if (.not.lcollision(k) .and. .not. self%lclosest(k)) cycle + i = self%index1(k) + j = self%index2(k) + self%r1(:,k) = pl%rh(:,i) + system%cb%rb(:) + self%v1(:,k) = pl%vb(:,i) + if (lcollision(k)) then + self%status(k) = COLLIDED + self%tcollision(k) = t + end if + self%r2(:,k) = pl%rh(:,j) + system%cb%rb(:) + self%v2(:,k) = pl%vb(:,j) + if (lcollision(k)) then + ! Check to see if either of these bodies has been involved with a collision before, and if so, make this a collider pair + if (pl%lcollision(i) .or. pl%lcollision(j)) call pl%make_impactors([i,j]) + + ! Set the collision flag for these to bodies to true in case they become involved in another collision later in the step + pl%lcollision([i, j]) = .true. + pl%status([i, j]) = COLLIDED + call pl%info(i)%set_value(status="COLLIDED") + call pl%info(j)%set_value(status="COLLIDED") + end if + + end do + + ! Extract the pl-pl encounter list and return the pl-pl collision_list + call self%extract_collisions(system, param) + end if + + ! Take snapshots of pairs of bodies at close approach (but not collision) if requested + if (lany_closest) call system%encounter_history%take_snapshot(param, system, t, "closest") + + end associate + end select + return + end subroutine collision_check_plpl + + + module subroutine collision_check_pltp(self, system, param, t, dt, irec, lany_collision) + !! author: David A. Minton + !! + !! Check for merger between massive bodies and test particles in SyMBA + !! + !! Adapted from David E. Kaufmann's Swifter routine symba_merge.f90 and symba_merge_tp.f90 + !! + !! Adapted from Hal Levison's Swift routine symba5_merge.f + implicit none + ! Arguments + class(collision_list_pltp), intent(inout) :: self !! SyMBA pl-tp encounter list object + class(base_nbody_system), intent(inout) :: system !! SyMBA nbody system object + class(base_parameters), intent(inout) :: param !! Current run configuration parameters + real(DP), intent(in) :: t !! current time + real(DP), intent(in) :: dt !! step size + integer(I4B), intent(in) :: irec !! Current recursion level + logical, intent(out) :: lany_collision !! Returns true if cany pair of encounters resulted in a collision + ! Internals + logical, dimension(:), allocatable :: lcollision, lmask + real(DP), dimension(NDIM) :: xr, vr + integer(I4B) :: i, j, k, nenc + real(DP) :: rlim + logical :: lany_closest + character(len=STRMAX) :: timestr, idstri, idstrj, message + class(collision_list_pltp), allocatable :: tmp + + lany_collision = .false. + if (self%nenc == 0) return + select type(system) + class is (swiftest_nbody_system) + select type(param) + class is (swiftest_parameters) + + associate(pl => system%pl, tp => system%tp) + + nenc = self%nenc + allocate(lmask(nenc)) + ! TODO: Move this to a SyMBA-specific method + ! lmask(:) = ((self%status(1:nenc) == ACTIVE) .and. (pl%levelg(self%index1(1:nenc)) >= irec)) + ! lmask(:) = lmask(:) .and. (tp%levelg(self%index2(1:nenc)) >= irec) + ! if (.not.any(lmask(:))) return + + allocate(lcollision(nenc)) + lcollision(:) = .false. + self%lclosest(:) = .false. + + + do concurrent(k = 1:nenc, lmask(k)) + i = self%index1(k) + j = self%index2(k) + xr(:) = pl%rh(:, i) - tp%rh(:, j) + vr(:) = pl%vb(:, i) - tp%vb(:, j) + call collision_check_one(xr(1), xr(2), xr(3), vr(1), vr(2), vr(3), pl%Gmass(i), pl%radius(i), dt, self%lvdotr(k), lcollision(k), self%lclosest(k)) + end do + + lany_collision = any(lcollision(:)) + lany_closest = (param%lenc_save_closest .and. any(self%lclosest(:))) + + + if (lany_collision .or. lany_closest) then + call pl%rh2rb(system%cb) ! Update the central body barycenteric position vector to get us out of DH and into bary + do k = 1, nenc + if (.not.lcollision(k) .and. .not. self%lclosest(k)) cycle + i = self%index1(k) + j = self%index2(k) + self%r1(:,k) = pl%rh(:,i) + system%cb%rb(:) + self%v1(:,k) = pl%vb(:,i) + if (lcollision(k)) then + self%status(k) = COLLIDED + self%tcollision(k) = t + end if + + self%r2(:,k) = tp%rh(:,j) + system%cb%rb(:) + self%v2(:,k) = tp%vb(:,j) + if (lcollision(k)) then + tp%status(j) = DISCARDED_PLR + tp%ldiscard(j) = .true. + write(idstri, *) pl%id(i) + write(idstrj, *) tp%id(j) + write(timestr, *) t + call tp%info(j)%set_value(status="DISCARDED_PLR", discard_time=t, discard_rh=tp%rh(:,j), discard_vh=tp%vh(:,j)) + write(message, *) "Particle " // trim(adjustl(tp%info(j)%name)) // " (" // trim(adjustl(idstrj)) // ")" & + // " collided with massive body " // trim(adjustl(pl%info(i)%name)) // " (" // trim(adjustl(idstri)) // ")" & + // " at t = " // trim(adjustl(timestr)) + call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, message) + end if + end do + + ! Extract the pl-tp encounter list and return the pl-tp collision_list + allocate(tmp, mold=self) + call self%spill(tmp, lcollision, ldestructive=.true.) ! Remove this encounter pair from the encounter list + end if + + ! Take snapshots of pairs of bodies at close approach (but not collision) if requested + if (lany_closest) call system%encounter_history%take_snapshot(param, system, t, "closest") + end associate + end select + end select + + return + end subroutine collision_check_pltp + +end submodule s_collision_check \ No newline at end of file diff --git a/src/collision/collision_io.f90 b/src/collision/collision_io.f90 index 5afb3ab8e..2c5abd7b9 100644 --- a/src/collision/collision_io.f90 +++ b/src/collision/collision_io.f90 @@ -7,54 +7,55 @@ !! You should have received a copy of the GNU General Public License along with Swiftest. !! If not, see: https://www.gnu.org/licenses. -submodule(collision_classes) s_collision_io +submodule(collision) s_collision_io use swiftest contains + module subroutine collision_io_dump(self, param) + !! author: David A. Minton + !! + !! Dumps the time history of an encounter to file. + implicit none + ! Arguments + class(collision_storage(*)), intent(inout) :: self !! Encounter storage object + class(base_parameters), intent(inout) :: param !! Current run configuration parameters + ! Internals + integer(I4B) :: i + select type(nc => self%nc) + class is (collision_io_parameters) + select type(param) + class is (swiftest_parameters) + if (self%iframe > 0) then + nc%file_number = nc%file_number + 1 + call self%make_index_map() + nc%event_dimsize = self%nt + nc%name_dimsize = self%nid + + write(nc%file_name, '("collision_",I0.6,".nc")') nc%file_number + call nc%initialize(param) + + do i = 1, self%nframes + if (allocated(self%frame(i)%item)) then + select type(snapshot => self%frame(i)%item) + class is (collision_snapshot) + param%ioutput = i + call snapshot%write_frame(self,param) + end select + else + exit + end if + end do -module subroutine collision_io_dump(self, param) - !! author: David A. Minton - !! - !! Dumps the time history of an encounter to file. - implicit none - ! Arguments - class(collision_storage(*)), intent(inout) :: self !! Encounter storage object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - ! Internals - integer(I4B) :: i - - select type(nc => self%nc) - class is (collision_io_parameters) - if (self%iframe > 0) then - nc%file_number = nc%file_number + 1 - call self%make_index_map() - nc%event_dimsize = self%nt - nc%name_dimsize = self%nid - - write(nc%file_name, '("collision_",I0.6,".nc")') nc%file_number - call nc%initialize(param) - - do i = 1, self%nframes - if (allocated(self%frame(i)%item)) then - select type(snapshot => self%frame(i)%item) - class is (collision_snapshot) - param%ioutput = i - call snapshot%write_frame(nc,param) - end select - else - exit - end if - end do - - call nc%close() - call self%reset() - end if - end select + call nc%close() + call self%reset() + end if + end select + end select - return -end subroutine collision_io_dump + return + end subroutine collision_io_dump module subroutine collision_io_initialize_output(self, param) !! author: David A. Minton @@ -65,7 +66,7 @@ module subroutine collision_io_initialize_output(self, param) implicit none ! Arguments class(collision_io_parameters), intent(inout) :: self !! Parameters used to identify a particular NetCDF dataset - class(swiftest_parameters), intent(in) :: param + class(base_parameters), intent(in) :: param ! Internals integer(I4B) :: nvar, varid, vartype real(DP) :: dfill @@ -76,8 +77,8 @@ module subroutine collision_io_initialize_output(self, param) integer(I4B) :: ndims select type(param) - class is (symba_parameters) - associate(nc => self, collision_history => param%collision_history) + class is (base_parameters) + associate(nc => self) dfill = ieee_value(dfill, IEEE_QUIET_NAN) sfill = ieee_value(sfill, IEEE_QUIET_NAN) @@ -95,93 +96,93 @@ module subroutine collision_io_initialize_output(self, param) close(unit=LUN, status="delete") end if - call check( nf90_create(nc%file_name, NF90_NETCDF4, nc%id), "collision_io_initialize_output nf90_create" ) + call netcdf_check( nf90_create(nc%file_name, NF90_NETCDF4, nc%id), "collision_io_initialize_output nf90_create" ) ! Dimensions - call check( nf90_def_dim(nc%id, nc%event_dimname, nc%event_dimsize, nc%event_dimid), "collision_io_initialize_output nf90_def_dim event_dimid" ) ! Dimension to store individual collision events - call check( nf90_def_dim(nc%id, nc%space_dimname, NDIM, nc%space_dimid), "collision_io_initialize_output nf90_def_dim space_dimid" ) ! 3D space dimension - call check( nf90_def_dim(nc%id, nc%name_dimname, nc%name_dimsize, nc%name_dimid), "collision_io_initialize_output nf90_def_dim name_dimid" ) ! Dimension to store particle id numbers - call check( nf90_def_dim(nc%id, nc%str_dimname, NAMELEN, nc%str_dimid), "collision_io_initialize_output nf90_def_dim str_dimid" ) ! Dimension for string variables (aka character arrays) - call check( nf90_def_dim(nc%id, nc%stage_dimname, 2, nc%stage_dimid), "collision_io_initialize_output nf90_def_dim stage_dimid" ) ! Dimension for stage variables (aka "before" vs. "after" + call netcdf_check( nf90_def_dim(nc%id, nc%event_dimname, nc%event_dimsize, nc%event_dimid), "collision_io_initialize_output nf90_def_dim event_dimid" ) ! Dimension to store individual collision events + call netcdf_check( nf90_def_dim(nc%id, nc%space_dimname, NDIM, nc%space_dimid), "collision_io_initialize_output nf90_def_dim space_dimid" ) ! 3D space dimension + call netcdf_check( nf90_def_dim(nc%id, nc%name_dimname, nc%name_dimsize, nc%name_dimid), "collision_io_initialize_output nf90_def_dim name_dimid" ) ! Dimension to store particle id numbers + call netcdf_check( nf90_def_dim(nc%id, nc%str_dimname, NAMELEN, nc%str_dimid), "collision_io_initialize_output nf90_def_dim str_dimid" ) ! Dimension for string variables (aka character arrays) + call netcdf_check( nf90_def_dim(nc%id, nc%stage_dimname, 2, nc%stage_dimid), "collision_io_initialize_output nf90_def_dim stage_dimid" ) ! Dimension for stage variables (aka "before" vs. "after" ! Dimension coordinates - call check( nf90_def_var(nc%id, nc%space_dimname, NF90_CHAR, nc%space_dimid, nc%space_varid), "collision_io_initialize_output nf90_def_var space_varid" ) - call check( nf90_def_var(nc%id, nc%name_dimname, NF90_CHAR, [nc%str_dimid, nc%name_dimid], nc%name_varid), "collision_io_initialize_output nf90_def_var name_varid") - call check( nf90_def_var(nc%id, nc%stage_dimname, NF90_CHAR, [nc%str_dimid, nc%stage_dimid], nc%stage_varid), "collision_io_initialize_output nf90_def_var stage_varid" ) + call netcdf_check( nf90_def_var(nc%id, nc%space_dimname, NF90_CHAR, nc%space_dimid, nc%space_varid), "collision_io_initialize_output nf90_def_var space_varid" ) + call netcdf_check( nf90_def_var(nc%id, nc%name_dimname, NF90_CHAR, [nc%str_dimid, nc%name_dimid], nc%name_varid), "collision_io_initialize_output nf90_def_var name_varid") + call netcdf_check( nf90_def_var(nc%id, nc%stage_dimname, NF90_CHAR, [nc%str_dimid, nc%stage_dimid], nc%stage_varid), "collision_io_initialize_output nf90_def_var stage_varid" ) ! Variables - call check( nf90_def_var(nc%id, nc%id_varname, NF90_INT, nc%name_dimid, nc%id_varid), "collision_io_initialize_output nf90_def_var id_varid" ) - call check( nf90_def_var(nc%id, nc%time_dimname, nc%out_type, & + call netcdf_check( nf90_def_var(nc%id, nc%id_varname, NF90_INT, nc%name_dimid, nc%id_varid), "collision_io_initialize_output nf90_def_var id_varid" ) + call netcdf_check( nf90_def_var(nc%id, nc%time_dimname, nc%out_type, & nc%event_dimid, nc%time_varid), "collision_io_initialize_output nf90_def_var time_varid" ) - call check( nf90_def_var(nc%id, nc%regime_varname, NF90_CHAR, & + call netcdf_check( nf90_def_var(nc%id, nc%regime_varname, NF90_CHAR, & [nc%str_dimid, nc%event_dimid], nc%regime_varid), "collision_io_initialize_output nf90_def_var regime_varid") - call check( nf90_def_var(nc%id, nc%Qloss_varname, nc%out_type, & + call netcdf_check( nf90_def_var(nc%id, nc%Qloss_varname, nc%out_type, & [ nc%event_dimid], nc%Qloss_varid), "collision_io_initialize_output nf90_def_var Qloss_varid") - call check( nf90_def_var(nc%id, nc%ptype_varname, NF90_CHAR, & + call netcdf_check( nf90_def_var(nc%id, nc%ptype_varname, NF90_CHAR, & [nc%str_dimid, nc%name_dimid, nc%stage_dimid, nc%event_dimid], nc%ptype_varid), "collision_io_initialize_output nf90_def_var ptype_varid") - call check( nf90_def_var(nc%id, nc%loop_varname, NF90_INT, & + call netcdf_check( nf90_def_var(nc%id, nc%loop_varname, NF90_INT, & [ nc%event_dimid], nc%loop_varid), "collision_io_initialize_output nf90_def_var loop_varid") - call check( nf90_def_var(nc%id, nc%rh_varname, nc%out_type,& + call netcdf_check( nf90_def_var(nc%id, nc%rh_varname, nc%out_type,& [ nc%space_dimid, nc%name_dimid, nc%stage_dimid, nc%event_dimid], nc%rh_varid), "collision_io_initialize_output nf90_def_var rh_varid") - call check( nf90_def_var(nc%id, nc%vh_varname, nc%out_type,& + call netcdf_check( nf90_def_var(nc%id, nc%vh_varname, nc%out_type,& [ nc%space_dimid, nc%name_dimid, nc%stage_dimid, nc%event_dimid], nc%vh_varid), "collision_io_initialize_output nf90_def_var vh_varid") - call check( nf90_def_var(nc%id, nc%Gmass_varname, nc%out_type,& + call netcdf_check( nf90_def_var(nc%id, nc%Gmass_varname, nc%out_type,& [ nc%name_dimid, nc%stage_dimid, nc%event_dimid], nc%Gmass_varid), "collision_io_initialize_output nf90_def_var Gmass_varid") - call check( nf90_def_var(nc%id, nc%radius_varname, nc%out_type,& + call netcdf_check( nf90_def_var(nc%id, nc%radius_varname, nc%out_type,& [ nc%name_dimid, nc%stage_dimid, nc%event_dimid], nc%radius_varid), "collision_io_initialize_output nf90_def_var radius_varid") - call check( nf90_def_var(nc%id, nc%Ip_varname, nc%out_type,& + call netcdf_check( nf90_def_var(nc%id, nc%Ip_varname, nc%out_type,& [ nc%space_dimid, nc%name_dimid, nc%stage_dimid, nc%event_dimid], nc%Ip_varid), "collision_io_initialize_output nf90_def_var Ip_varid") - call check( nf90_def_var(nc%id, nc%rot_varname, nc%out_type,& + call netcdf_check( nf90_def_var(nc%id, nc%rot_varname, nc%out_type,& [ nc%space_dimid, nc%name_dimid, nc%stage_dimid, nc%event_dimid], nc%rot_varid), "collision_io_initialize_output nf90_def_var rot_varid") if (param%lenergy) then - call check( nf90_def_var(nc%id, nc%ke_orb_varname, nc%out_type,& + call netcdf_check( nf90_def_var(nc%id, nc%ke_orb_varname, nc%out_type,& [ nc%stage_dimid, nc%event_dimid], nc%KE_orb_varid), "collision_io_initialize_output nf90_def_var KE_orb_varid") - call check( nf90_def_var(nc%id, nc%ke_spin_varname, nc%out_type,& + call netcdf_check( nf90_def_var(nc%id, nc%ke_spin_varname, nc%out_type,& [ nc%stage_dimid, nc%event_dimid], nc%KE_spin_varid), "collision_io_initialize_output nf90_def_var KE_spin_varid" ) - call check( nf90_def_var(nc%id, nc%pe_varname, nc%out_type,& + call netcdf_check( nf90_def_var(nc%id, nc%pe_varname, nc%out_type,& [ nc%stage_dimid, nc%event_dimid], nc%PE_varid), "collision_io_initialize_output nf90_def_var PE_varid" ) - call check( nf90_def_var(nc%id, nc%L_orb_varname, nc%out_type, & + call netcdf_check( nf90_def_var(nc%id, nc%L_orb_varname, nc%out_type, & [ nc%space_dimid, nc%stage_dimid, nc%event_dimid], nc%L_orb_varid), "collision_io_initialize_output nf90_def_var L_orb_varid" ) - call check( nf90_def_var(nc%id, nc%Lspin_varname, nc%out_type,& + call netcdf_check( nf90_def_var(nc%id, nc%Lspin_varname, nc%out_type,& [ nc%space_dimid, nc%stage_dimid, nc%event_dimid], nc%Lspin_varid), "collision_io_initialize_output nf90_def_var Lspin_varid" ) end if - call check( nf90_inquire(nc%id, nVariables=nvar), "collision_io_initialize_output nf90_inquire nVariables" ) + call netcdf_check( nf90_inquire(nc%id, nVariables=nvar), "collision_io_initialize_output nf90_inquire nVariables" ) do varid = 1, nvar - call check( nf90_inquire_variable(nc%id, varid, xtype=vartype, ndims=ndims), "collision_io_initialize_output nf90_inquire_variable" ) + call netcdf_check( nf90_inquire_variable(nc%id, varid, xtype=vartype, ndims=ndims), "collision_io_initialize_output nf90_inquire_variable" ) select case(vartype) case(NF90_INT) - call check( nf90_def_var_fill(nc%id, varid, NO_FILL, NF90_FILL_INT), "collision_io_initialize_output nf90_def_var_fill NF90_INT" ) + call netcdf_check( nf90_def_var_fill(nc%id, varid, NO_FILL, NF90_FILL_INT), "collision_io_initialize_output nf90_def_var_fill NF90_INT" ) case(NF90_FLOAT) - call check( nf90_def_var_fill(nc%id, varid, NO_FILL, sfill), "collision_io_initialize_output nf90_def_var_fill NF90_FLOAT" ) + call netcdf_check( nf90_def_var_fill(nc%id, varid, NO_FILL, sfill), "collision_io_initialize_output nf90_def_var_fill NF90_FLOAT" ) case(NF90_DOUBLE) - call check( nf90_def_var_fill(nc%id, varid, NO_FILL, dfill), "collision_io_initialize_output nf90_def_var_fill NF90_DOUBLE" ) + call netcdf_check( nf90_def_var_fill(nc%id, varid, NO_FILL, dfill), "collision_io_initialize_output nf90_def_var_fill NF90_DOUBLE" ) case(NF90_CHAR) - call check( nf90_def_var_fill(nc%id, varid, NO_FILL, 0), "collision_io_initialize_output nf90_def_var_fill NF90_CHAR" ) + call netcdf_check( nf90_def_var_fill(nc%id, varid, NO_FILL, 0), "collision_io_initialize_output nf90_def_var_fill NF90_CHAR" ) end select end do ! Take the file out of define mode - call check( nf90_enddef(nc%id), "collision_io_initialize_output nf90_enddef" ) + call netcdf_check( nf90_enddef(nc%id), "collision_io_initialize_output nf90_enddef" ) ! Add in the space and stage dimension coordinates - call check( nf90_put_var(nc%id, nc%space_varid, nc%space_coords, start=[1], count=[NDIM]), "collision_io_initialize_output nf90_put_var space" ) - call check( nf90_put_var(nc%id, nc%stage_varid, nc%stage_coords(1), start=[1,1], count=[len(nc%stage_coords(1)),1]), "collision_io_initialize_output nf90_put_var stage 1" ) - call check( nf90_put_var(nc%id, nc%stage_varid, nc%stage_coords(2), start=[1,2], count=[len(nc%stage_coords(2)),1]), "collision_io_initialize_output nf90_put_var stage 2" ) + call netcdf_check( nf90_put_var(nc%id, nc%space_varid, nc%space_coords, start=[1], count=[NDIM]), "collision_io_initialize_output nf90_put_var space" ) + call netcdf_check( nf90_put_var(nc%id, nc%stage_varid, nc%stage_coords(1), start=[1,1], count=[len(nc%stage_coords(1)),1]), "collision_io_initialize_output nf90_put_var stage 1" ) + call netcdf_check( nf90_put_var(nc%id, nc%stage_varid, nc%stage_coords(2), start=[1,2], count=[len(nc%stage_coords(2)),1]), "collision_io_initialize_output nf90_put_var stage 2" ) end associate end select @@ -194,70 +195,73 @@ module subroutine collision_io_initialize_output(self, param) end subroutine collision_io_initialize_output - module subroutine collision_io_write_frame_snapshot(self, nc, param) + module subroutine collision_io_write_frame_snapshot(self, history, param) !! author: David A. Minton !! !! Write a frame of output of a collision result use netcdf implicit none ! Arguments - class(collision_snapshot), intent(in) :: self !! Swiftest encounter structure - class(netcdf_parameters), intent(inout) :: nc !! Parameters used to identify a particular encounter io NetCDF dataset - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + class(collision_snapshot), intent(in) :: self !! Swiftest encounter structure + class(encounter_storage(*)), intent(inout) :: history !! Collision history object + class(base_parameters), intent(inout) :: param !! Current run configuration parameters ! Internals integer(I4B) :: i, idslot, old_mode, npl, stage character(len=:), allocatable :: charstring class(swiftest_pl), allocatable :: pl - select type(nc) + select type(nc => history%nc) class is (collision_io_parameters) - select type (param) - class is (symba_parameters) - associate(system => self%collision_system, impactors => self%collision_system%impactors, fragments => self%collision_system%fragments, collision_history => param%collision_history, eslot => param%ioutput) - call check( nf90_set_fill(nc%id, nf90_nofill, old_mode), "collision_io_write_frame_snapshot nf90_set_fill" ) + associate(system => self%collision_system, impactors => self%collision_system%impactors, fragments => self%collision_system%fragments, eslot => param%ioutput) + call netcdf_check( nf90_set_fill(nc%id, nf90_nofill, old_mode), "collision_io_write_frame_snapshot nf90_set_fill" ) - call check( nf90_put_var(nc%id, nc%time_varid, self%t, start=[eslot]), "collision_io_write_frame_snapshot nf90_put_var time_varid" ) - call check( nf90_put_var(nc%id, nc%loop_varid, int(self%iloop,kind=I4B), start=[eslot]), "collision_io_write_frame_snapshot nf90_put_varloop_varid" ) + call netcdf_check( nf90_put_var(nc%id, nc%time_varid, self%t, start=[eslot]), "collision_io_write_frame_snapshot nf90_put_var time_varid" ) + call netcdf_check( nf90_put_var(nc%id, nc%loop_varid, int(self%iloop,kind=I4B), start=[eslot]), "collision_io_write_frame_snapshot nf90_put_varloop_varid" ) - charstring = trim(adjustl(REGIME_NAMES(impactors%regime))) - call check( nf90_put_var(nc%id, nc%regime_varid, charstring, start=[1, eslot], count=[len(charstring), 1]), "collision_io_write_frame_snapshot nf90_put_var regime_varid" ) - call check( nf90_put_var(nc%id, nc%Qloss_varid, impactors%Qloss, start=[eslot] ), "collision_io_write_frame_snapshot nf90_put_var Qloss_varid" ) + charstring = trim(adjustl(REGIME_NAMES(impactors%regime))) + call netcdf_check( nf90_put_var(nc%id, nc%regime_varid, charstring, start=[1, eslot], count=[len(charstring), 1]), "collision_io_write_frame_snapshot nf90_put_var regime_varid" ) + call netcdf_check( nf90_put_var(nc%id, nc%Qloss_varid, impactors%Qloss, start=[eslot] ), "collision_io_write_frame_snapshot nf90_put_var Qloss_varid" ) + select type(before =>self%collision_system%before) + class is (swiftest_nbody_system) + select type(after =>self%collision_system%before) + class is (swiftest_nbody_system) do stage = 1,2 if (allocated(pl)) deallocate(pl) select case(stage) case(1) - allocate(pl, source=self%collision_system%before%pl) + allocate(pl, source=before%pl) case(2) - allocate(pl, source=self%collision_system%after%pl) + allocate(pl, source=after%pl) end select npl = pl%nbody do i = 1, npl - idslot = findloc(collision_history%idvals,pl%id(i),dim=1) - call check( nf90_put_var(nc%id, nc%id_varid, pl%id(i), start=[ idslot ]), "collision_io_write_frame_snapshot nf90_put_var id_varid" ) + idslot = findloc(history%idvals,pl%id(i),dim=1) + call netcdf_check( nf90_put_var(nc%id, nc%id_varid, pl%id(i), start=[ idslot ]), "collision_io_write_frame_snapshot nf90_put_var id_varid" ) charstring = trim(adjustl(pl%info(i)%name)) - call check( nf90_put_var(nc%id, nc%name_varid, charstring, start=[1, idslot ], count=[len(charstring), 1]), "collision_io_write_frame_snapshot nf90_put_var name_varid" ) + call netcdf_check( nf90_put_var(nc%id, nc%name_varid, charstring, start=[1, idslot ], count=[len(charstring), 1]), "collision_io_write_frame_snapshot nf90_put_var name_varid" ) charstring = trim(adjustl(pl%info(i)%particle_type)) - call check( nf90_put_var(nc%id, nc%ptype_varid, charstring, start=[1, idslot, stage, eslot], count=[len(charstring), 1, 1]), "collision_io_write_frame_snapshot nf90_put_var particle_type_varid" ) - call check( nf90_put_var(nc%id, nc%rh_varid, pl%rh(:,i), start=[1, idslot, stage, eslot], count=[NDIM,1,1,1]), "collision_io_write_frame_snapshot nf90_put_var rh_varid" ) - call check( nf90_put_var(nc%id, nc%vh_varid, pl%vh(:,i), start=[1, idslot, stage, eslot], count=[NDIM,1,1,1]), "collision_io_write_frame_snapshot nf90_put_var vh_varid" ) - call check( nf90_put_var(nc%id, nc%Gmass_varid, pl%Gmass(i), start=[ idslot, stage, eslot]), "collision_io_write_frame_snapshot nf90_put_var Gmass_varid" ) - call check( nf90_put_var(nc%id, nc%radius_varid, pl%radius(i), start=[ idslot, stage, eslot]), "collision_io_write_frame_snapshot nf90_put_var radius_varid" ) - call check( nf90_put_var(nc%id, nc%Ip_varid, pl%Ip(:,i), start=[1, idslot, stage, eslot], count=[NDIM,1,1,1]), "collision_io_write_frame_snapshot nf90_put_var Ip_varid" ) - call check( nf90_put_var(nc%id, nc%rot_varid, pl%rot(:,i), start=[1, idslot, stage, eslot], count=[NDIM,1,1,1]), "collision_io_write_frame_snapshot nf90_put_var rotx_varid" ) + call netcdf_check( nf90_put_var(nc%id, nc%ptype_varid, charstring, start=[1, idslot, stage, eslot], count=[len(charstring), 1, 1]), "collision_io_write_frame_snapshot nf90_put_var particle_type_varid" ) + call netcdf_check( nf90_put_var(nc%id, nc%rh_varid, pl%rh(:,i), start=[1, idslot, stage, eslot], count=[NDIM,1,1,1]), "collision_io_write_frame_snapshot nf90_put_var rh_varid" ) + call netcdf_check( nf90_put_var(nc%id, nc%vh_varid, pl%vh(:,i), start=[1, idslot, stage, eslot], count=[NDIM,1,1,1]), "collision_io_write_frame_snapshot nf90_put_var vh_varid" ) + call netcdf_check( nf90_put_var(nc%id, nc%Gmass_varid, pl%Gmass(i), start=[ idslot, stage, eslot]), "collision_io_write_frame_snapshot nf90_put_var Gmass_varid" ) + call netcdf_check( nf90_put_var(nc%id, nc%radius_varid, pl%radius(i), start=[ idslot, stage, eslot]), "collision_io_write_frame_snapshot nf90_put_var radius_varid" ) + call netcdf_check( nf90_put_var(nc%id, nc%Ip_varid, pl%Ip(:,i), start=[1, idslot, stage, eslot], count=[NDIM,1,1,1]), "collision_io_write_frame_snapshot nf90_put_var Ip_varid" ) + call netcdf_check( nf90_put_var(nc%id, nc%rot_varid, pl%rot(:,i), start=[1, idslot, stage, eslot], count=[NDIM,1,1,1]), "collision_io_write_frame_snapshot nf90_put_var rotx_varid" ) end do end do - if (param%lenergy) then - call check( nf90_put_var(nc%id, nc%ke_orb_varid, system%ke_orbit(:), start=[ 1, eslot], count=[ 2, 1]), "collision_io_write_frame_snapshot nf90_put_var ke_orb_varid before" ) - call check( nf90_put_var(nc%id, nc%ke_spin_varid, system%ke_spin(:), start=[ 1, eslot], count=[ 2, 1]), "collision_io_write_frame_snapshot nf90_put_var ke_spin_varid before" ) - call check( nf90_put_var(nc%id, nc%pe_varid, system%pe(:), start=[ 1, eslot], count=[ 2, 1]), "collision_io_write_frame_snapshot nf90_put_var pe_varid before" ) - call check( nf90_put_var(nc%id, nc%L_orb_varid, system%Lorbit(:,:), start=[1, 1, eslot], count=[NDIM, 2, 1]), "collision_io_write_frame_snapshot nf90_put_var L_orb_varid before" ) - call check( nf90_put_var(nc%id, nc%Lspin_varid, system%Lspin(:,:), start=[1, 1, eslot], count=[NDIM, 2, 1]), "collision_io_write_frame_snapshot nf90_put_var Lspin_varid before" ) - end if - - call check( nf90_set_fill(nc%id, old_mode, old_mode) ) - end associate - end select + end select + end select + if (param%lenergy) then + call netcdf_check( nf90_put_var(nc%id, nc%ke_orb_varid, system%ke_orbit(:), start=[ 1, eslot], count=[ 2, 1]), "collision_io_write_frame_snapshot nf90_put_var ke_orb_varid before" ) + call netcdf_check( nf90_put_var(nc%id, nc%ke_spin_varid, system%ke_spin(:), start=[ 1, eslot], count=[ 2, 1]), "collision_io_write_frame_snapshot nf90_put_var ke_spin_varid before" ) + call netcdf_check( nf90_put_var(nc%id, nc%pe_varid, system%pe(:), start=[ 1, eslot], count=[ 2, 1]), "collision_io_write_frame_snapshot nf90_put_var pe_varid before" ) + call netcdf_check( nf90_put_var(nc%id, nc%L_orb_varid, system%Lorbit(:,:), start=[1, 1, eslot], count=[NDIM, 2, 1]), "collision_io_write_frame_snapshot nf90_put_var L_orb_varid before" ) + call netcdf_check( nf90_put_var(nc%id, nc%Lspin_varid, system%Lspin(:,:), start=[1, 1, eslot], count=[NDIM, 2, 1]), "collision_io_write_frame_snapshot nf90_put_var Lspin_varid before" ) + end if + + call netcdf_check( nf90_set_fill(nc%id, old_mode, old_mode) ) + end associate end select return end subroutine collision_io_write_frame_snapshot diff --git a/src/collision/collision_regime.f90 b/src/collision/collision_regime.f90 index 94079e388..b74d76d5f 100644 --- a/src/collision/collision_regime.f90 +++ b/src/collision/collision_regime.f90 @@ -7,86 +7,11 @@ !! You should have received a copy of the GNU General Public License along with Swiftest. !! If not, see: https://www.gnu.org/licenses. -submodule(collision_classes) s_collision_regime +submodule(collision) s_collision_regime use swiftest contains - module subroutine collision_regime_impactors(self, system, param) - !! Author: Jennifer L.L. Pouplin, Carlisle A. Wishard, and David A. Minton - !! - !! Determine which fragmentation regime the set of impactors will be. This subroutine is a wrapper for the non-polymorphic raggle_regime_collresolve subroutine. - !! It converts to SI units prior to calling - implicit none - ! Arguments - class(collision_impactors), intent(inout) :: self !! Collision system impactors object - class(swiftest_nbody_system), intent(in) :: system !! Swiftest nbody system object - class(swiftest_parameters), intent(in) :: param !! Current Swiftest run configuration parameters - ! Internals - integer(I4B) :: jtarg, jproj - real(DP), dimension(2) :: radius_si, mass_si, density_si - real(DP) :: min_mfrag_si, Mcb_si - real(DP), dimension(NDIM) :: x1_si, v1_si, x2_si, v2_si, runit - real(DP) :: mlr, mslr, mtot, dentot - - associate(impactors => self) - ! Convert all quantities to SI units and determine which of the pair is the projectile vs. target before sending them to the regime determination subroutine - if (impactors%mass(1) > impactors%mass(2)) then - jtarg = 1 - jproj = 2 - else - jtarg = 2 - jproj = 1 - end if - mass_si(:) = impactors%mass([jtarg, jproj]) * param%MU2KG !! The two-body equivalent masses of the collider system - radius_si(:) = impactors%radius([jtarg, jproj]) * param%DU2M !! The two-body equivalent radii of the collider system - density_si(:) = mass_si(:) / (4.0_DP / 3._DP * PI * radius_si(:)**3) !! The two-body equivalent density of the collider system - x1_si(:) = impactors%rb(:,jtarg) * param%DU2M !! The first body of the two-body equivalent position vector the collider system - v1_si(:) = impactors%vb(:,jtarg) * param%DU2M / param%TU2S !! The first body of the two-body equivalent velocity vector the collider system - x2_si(:) = impactors%rb(:,jproj) * param%DU2M !! The second body of the two-body equivalent position vector the collider system - v2_si(:) = impactors%vb(:,jproj) * param%DU2M / param%TU2S !! The second body of the two-body equivalent velocity vector the collider system - Mcb_si = system%cb%mass * param%MU2KG !! The central body mass of the system - select type(param) - class is (symba_parameters) - min_mfrag_si = (param%min_GMfrag / param%GU) * param%MU2KG !! The minimum fragment mass to generate. Collider systems that would otherwise generate less massive fragments than this value will be forced to merge instead - class default - min_mfrag_si = 0.0_DP - end select - - mtot = sum(mass_si(:)) - dentot = sum(mass_si(:) * density_si(:)) / mtot - - !! Use the positions and velocities of the parents from indside the step (at collision) to calculate the collisional regime - call collision_regime_collresolve(Mcb_si, mass_si(jtarg), mass_si(jproj), radius_si(jtarg), radius_si(jproj), & - x1_si(:), x2_si(:), v1_si(:), v2_si(:), density_si(jtarg), density_si(jproj), & - min_mfrag_si, impactors%regime, mlr, mslr, impactors%Qloss) - - if (allocated(impactors%mass_dist)) deallocate(impactors%mass_dist) - allocate(impactors%mass_dist(3)) - impactors%mass_dist(1) = min(max(mlr, 0.0_DP), mtot) - impactors%mass_dist(2) = min(max(mslr, 0.0_DP), mtot) - impactors%mass_dist(3) = min(max(mtot - mlr - mslr, 0.0_DP), mtot) - - ! Find the center of mass of the collisional system - mtot = sum(impactors%mass(:)) - impactors%rbcom(:) = (impactors%mass(1) * impactors%rb(:,1) + impactors%mass(2) * impactors%rb(:,2)) / mtot - impactors%vbcom(:) = (impactors%mass(1) * impactors%vb(:,1) + impactors%mass(2) * impactors%vb(:,2)) / mtot - - ! Find the point of impact between the two bodies - runit(:) = impactors%rb(:,2) - impactors%rb(:,1) - runit(:) = runit(:) / (.mag. runit(:)) - impactors%rbimp(:) = impactors%rb(:,1) + impactors%radius(1) * runit(:) - - ! Convert quantities back to the system units and save them into the fragment system - impactors%mass_dist(:) = (impactors%mass_dist(:) / param%MU2KG) - impactors%Qloss = impactors%Qloss * (param%TU2S / param%DU2M)**2 / param%MU2KG - - !call fraggle_io_log_regime(impactors, fragments) - end associate - - return - end subroutine collision_regime_impactors - subroutine collision_regime_collresolve(Mcb, m1, m2, rad1, rad2, rh1, rh2, vb1, vb2, den1, den2, min_mfrag, & regime, Mlr, Mslr, Qloss) @@ -198,7 +123,7 @@ subroutine collision_regime_collresolve(Mcb, m1, m2, rad1, rad2, rh1, rh2, vb1, Mlr = Mtot Mslr = 0.0_DP Qloss = 0.0_DP - call io_log_one_message(FRAGGLE_LOG_OUT, & + call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, & "Fragments would have mass below the minimum. Converting this collision into a merger.") else if( Vimp < Vescp) then @@ -382,4 +307,87 @@ end function calc_c_star end subroutine collision_regime_collresolve + + module subroutine collision_regime_impactors(self, system, param) + !! Author: Jennifer L.L. Pouplin, Carlisle A. Wishard, and David A. Minton + !! + !! Determine which fragmentation regime the set of impactors will be. This subroutine is a wrapper for the non-polymorphic raggle_regime_collresolve subroutine. + !! It converts to SI units prior to calling + implicit none + ! Arguments + class(collision_impactors), intent(inout) :: self !! Collision system impactors object + class(base_nbody_system), intent(in) :: system !! Swiftest nbody system object + class(base_parameters), intent(in) :: param !! Current Swiftest run configuration parameters + ! Internals + integer(I4B) :: jtarg, jproj + real(DP), dimension(2) :: radius_si, mass_si, density_si + real(DP) :: min_mfrag_si, Mcb_si + real(DP), dimension(NDIM) :: x1_si, v1_si, x2_si, v2_si, runit + real(DP) :: mlr, mslr, mtot, dentot + + associate(impactors => self) + select type (system) + class is (swiftest_nbody_system) + ! Convert all quantities to SI units and determine which of the pair is the projectile vs. target before sending them to the regime determination subroutine + if (impactors%mass(1) > impactors%mass(2)) then + jtarg = 1 + jproj = 2 + else + jtarg = 2 + jproj = 1 + end if + mass_si(:) = impactors%mass([jtarg, jproj]) * param%MU2KG !! The two-body equivalent masses of the collider system + radius_si(:) = impactors%radius([jtarg, jproj]) * param%DU2M !! The two-body equivalent radii of the collider system + density_si(:) = mass_si(:) / (4.0_DP / 3._DP * PI * radius_si(:)**3) !! The two-body equivalent density of the collider system + x1_si(:) = impactors%rb(:,jtarg) * param%DU2M !! The first body of the two-body equivalent position vector the collider system + v1_si(:) = impactors%vb(:,jtarg) * param%DU2M / param%TU2S !! The first body of the two-body equivalent velocity vector the collider system + x2_si(:) = impactors%rb(:,jproj) * param%DU2M !! The second body of the two-body equivalent position vector the collider system + v2_si(:) = impactors%vb(:,jproj) * param%DU2M / param%TU2S !! The second body of the two-body equivalent velocity vector the collider system + Mcb_si = system%cb%mass * param%MU2KG !! The central body mass of the system + select type(param) + class is (base_parameters) + min_mfrag_si = (param%min_GMfrag / param%GU) * param%MU2KG !! The minimum fragment mass to generate. Collider systems that would otherwise generate less massive fragments than this value will be forced to merge instead + class default + min_mfrag_si = 0.0_DP + end select + + mtot = sum(mass_si(:)) + dentot = sum(mass_si(:) * density_si(:)) / mtot + + !! Use the positions and velocities of the parents from indside the step (at collision) to calculate the collisional regime + call collision_regime_collresolve(Mcb_si, mass_si(jtarg), mass_si(jproj), radius_si(jtarg), radius_si(jproj), & + x1_si(:), x2_si(:), v1_si(:), v2_si(:), density_si(jtarg), density_si(jproj), & + min_mfrag_si, impactors%regime, mlr, mslr, impactors%Qloss) + + if (allocated(impactors%mass_dist)) deallocate(impactors%mass_dist) + allocate(impactors%mass_dist(3)) + impactors%mass_dist(1) = min(max(mlr, 0.0_DP), mtot) + impactors%mass_dist(2) = min(max(mslr, 0.0_DP), mtot) + impactors%mass_dist(3) = min(max(mtot - mlr - mslr, 0.0_DP), mtot) + + ! Find the center of mass of the collisional system + mtot = sum(impactors%mass(:)) + impactors%rbcom(:) = (impactors%mass(1) * impactors%rb(:,1) + impactors%mass(2) * impactors%rb(:,2)) / mtot + impactors%vbcom(:) = (impactors%mass(1) * impactors%vb(:,1) + impactors%mass(2) * impactors%vb(:,2)) / mtot + + ! Find the point of impact between the two bodies + runit(:) = impactors%rb(:,2) - impactors%rb(:,1) + runit(:) = runit(:) / (.mag. runit(:)) + impactors%rbimp(:) = impactors%rb(:,1) + impactors%radius(1) * runit(:) + + ! Convert quantities back to the system units and save them into the fragment system + impactors%mass_dist(:) = (impactors%mass_dist(:) / param%MU2KG) + impactors%Qloss = impactors%Qloss * (param%TU2S / param%DU2M)**2 / param%MU2KG + + !call fraggle_io_log_regime(impactors, fragments) + end select + end associate + + return + end subroutine collision_regime_impactors + + ! module subroutine collision_regime_resolve(self) + ! end subroutine collision_regime_resolve + + end submodule s_collision_regime \ No newline at end of file diff --git a/src/collision/collision_resolve.f90 b/src/collision/collision_resolve.f90 new file mode 100644 index 000000000..4ac8bdf16 --- /dev/null +++ b/src/collision/collision_resolve.f90 @@ -0,0 +1,768 @@ +!! Copyright 2022 - David Minton, Carlisle Wishard, Jennifer Pouplin, Jake Elliott, & Dana Singh +!! This file is part of Swiftest. +!! Swiftest is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License +!! as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. +!! Swiftest is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty +!! of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. +!! You should have received a copy of the GNU General Public License along with Swiftest. +!! If not, see: https://www.gnu.org/licenses. + +submodule (collision) s_collision_resolve + use swiftest +contains + + module function collision_resolve_merge(system, param, t) result(status) + !! author: Jennifer L.L. Pouplin, Carlisle A. Wishard, and David A. Minton + !! + !! Merge massive bodies. + !! + !! Adapted from David E. Kaufmann's Swifter routines swiftest_merge_pl.f90 and swiftest_discard_merge_pl.f90 + !! + !! Adapted from Hal Levison's Swift routines symba5_merge.f and discard_mass_merge.f + implicit none + ! Arguments + class(base_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(base_parameters), intent(inout) :: param !! Current run configuration parameters with Swiftest additions + real(DP), intent(in) :: t !! Time of collision + ! Result + integer(I4B) :: status !! Status flag assigned to this outcome + ! Internals + integer(I4B) :: i, j, k, ibiggest + real(DP), dimension(NDIM) :: Lspin_new + real(DP) :: dpe + character(len=STRMAX) :: message + + select type(system) + class is (swiftest_nbody_system) + associate(collision_system => system%collision_system, impactors => system%collision_system%impactors, fragments => system%collision_system%fragments) + message = "Merging" + call collision_resolve_collider_message(system%pl, impactors%id, message) + ! call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, message) + + select type(pl => system%pl) + class is (swiftest_pl) + + call collision_system%set_mass_dist(param) + + ! Calculate the initial energy of the system without the collisional family + call collision_system%get_energy_and_momentum(system, param, lbefore=.true.) + + ibiggest = impactors%id(maxloc(pl%Gmass(impactors%id(:)), dim=1)) + fragments%id(1) = pl%id(ibiggest) + fragments%rb(:,1) = impactors%rbcom(:) + fragments%vb(:,1) = impactors%vbcom(:) + + if (param%lrotation) then + ! Conserve angular momentum by putting pre-impact orbital momentum into spin of the new body + Lspin_new(:) = impactors%Lorbit(:,1) + impactors%Lorbit(:,2) + impactors%Lspin(:,1) + impactors%Lspin(:,2) + + ! Assume prinicpal axis rotation on 3rd Ip axis + fragments%rot(:,1) = Lspin_new(:) / (fragments%Ip(3,1) * fragments%mass(1) * fragments%radius(1)**2) + else ! If spin is not enabled, we will consider the lost pre-collision angular momentum as "escaped" and add it to our bookkeeping variable + system%Lescape(:) = system%Lescape(:) + impactors%Lorbit(:,1) + impactors%Lorbit(:,2) + end if + + ! Keep track of the component of potential energy due to the pre-impact impactors%id for book-keeping + ! Get the energy of the system after the collision + call collision_system%get_energy_and_momentum(system, param, lbefore=.false.) + dpe = collision_system%pe(2) - collision_system%pe(1) + system%Ecollisions = system%Ecollisions - dpe + system%Euntracked = system%Euntracked + dpe + + + ! Update any encounter lists that have the removed bodies in them so that they instead point to the new + do k = 1, system%plpl_encounter%nenc + do j = 1, impactors%ncoll + i = impactors%id(j) + if (i == ibiggest) cycle + if (system%plpl_encounter%id1(k) == pl%id(i)) then + system%plpl_encounter%id1(k) = pl%id(ibiggest) + system%plpl_encounter%index1(k) = i + end if + if (system%plpl_encounter%id2(k) == pl%id(i)) then + system%plpl_encounter%id2(k) = pl%id(ibiggest) + system%plpl_encounter%index2(k) = i + end if + if (system%plpl_encounter%id1(k) == system%plpl_encounter%id2(k)) system%plpl_encounter%status(k) = INACTIVE + end do + end do + + status = MERGED + + call collision_resolve_mergeaddsub(system, param, t, status) + + end select + end associate + end select + return + end function collision_resolve_merge + + + subroutine collision_resolve_collider_message(pl, collidx, collider_message) + !! author: David A. Minton + !! + !! Prints a nicely formatted message about which bodies collided, including their names and ids. + !! This subroutine appends the body names and ids to an input message. + implicit none + ! Arguments + class(swiftest_pl), intent(in) :: pl !! Swiftest massive body object + integer(I4B), dimension(:), intent(in) :: collidx !! Index of collisional impactors%id members + character(*), intent(inout) :: collider_message !! The message to print to the screen. + ! Internals + integer(I4B) :: i, n + character(len=STRMAX) :: idstr + + n = size(collidx) + if (n == 0) return + + do i = 1, n + if (i > 1) collider_message = trim(adjustl(collider_message)) // " and " + collider_message = " " // trim(adjustl(collider_message)) // " " // trim(adjustl(pl%info(collidx(i))%name)) + write(idstr, '(I10)') pl%id(collidx(i)) + collider_message = trim(adjustl(collider_message)) // " (" // trim(adjustl(idstr)) // ") " + end do + + return + end subroutine collision_resolve_collider_message + + + function collision_resolve_consolidate_impactors(pl, cb, param, idx_parent, impactors) result(lflag) + !! author: David A. Minton + !! + !! Loops through the pl-pl collision list and groups families together by index. Outputs the indices of all impactors%id members, + !! and pairs of quantities (x and v vectors, mass, radius, Lspin, and Ip) that can be used to resolve the collisional outcome. + implicit none + ! Arguments + class(swiftest_pl), intent(inout) :: pl !! Swiftest massive body object + class(swiftest_cb), intent(inout) :: cb !! Swiftest central body object + class(base_parameters), intent(in) :: param !! Current run configuration parameters with Swiftest additions + integer(I4B), dimension(2), intent(inout) :: idx_parent !! Index of the two bodies considered the "parents" of the collision + class(collision_impactors), intent(out) :: impactors + ! Result + logical :: lflag !! Logical flag indicating whether a impactors%id was successfully created or not + ! Internals + type collidx_array + integer(I4B), dimension(:), allocatable :: id + integer(I4B), dimension(:), allocatable :: idx + end type collidx_array + type(collidx_array), dimension(2) :: parent_child_index_array + integer(I4B), dimension(2) :: nchild + integer(I4B) :: i, j, nimpactors, idx_child + real(DP), dimension(2) :: volume, density + real(DP) :: mchild, volchild + real(DP), dimension(NDIM) :: xc, vc, xcom, vcom, xchild, vchild, xcrossv + real(DP), dimension(NDIM,2) :: mxc, vcc + + nchild(:) = pl%kin(idx_parent(:))%nchild + ! If all of these bodies share a parent, but this is still a unique collision, move the last child + ! out of the parent's position and make it the secondary body + if (idx_parent(1) == idx_parent(2)) then + if (nchild(1) == 0) then ! There is only one valid body recorded in this pair (this could happen due to restructuring of the kinship relationships, though it should be rare) + lflag = .false. + call pl%reset_kinship([idx_parent(1)]) + return + end if + idx_parent(2) = pl%kin(idx_parent(1))%child(nchild(1)) + nchild(1) = nchild(1) - 1 + nchild(2) = 0 + pl%kin(idx_parent(:))%nchild = nchild(:) + pl%kin(idx_parent(2))%parent = idx_parent(1) + end if + + impactors%mass(:) = pl%mass(idx_parent(:)) ! Note: This is meant to mass, not G*mass, as the collisional regime determination uses mass values that will be converted to Si + impactors%radius(:) = pl%radius(idx_parent(:)) + volume(:) = (4.0_DP / 3.0_DP) * PI * impactors%radius(:)**3 + + ! Group together the ids and indexes of each collisional parent and its children + do j = 1, 2 + allocate(parent_child_index_array(j)%idx(nchild(j)+ 1)) + allocate(parent_child_index_array(j)%id(nchild(j)+ 1)) + associate(idx_arr => parent_child_index_array(j)%idx, & + id_arr => parent_child_index_array(j)%id, & + ncj => nchild(j), & + plkinj => pl%kin(idx_parent(j))) + idx_arr(1) = idx_parent(j) + if (ncj > 0) idx_arr(2:ncj + 1) = plkinj%child(1:ncj) + id_arr(:) = pl%id(idx_arr(:)) + end associate + end do + + ! Consolidate the groups of collsional parents with any children they may have into a single "impactors%id" index array + nimpactors = 2 + sum(nchild(:)) + allocate(impactors%id(nimpactors)) + impactors%id = [parent_child_index_array(1)%idx(:),parent_child_index_array(2)%idx(:)] + + impactors%ncoll = count(pl%lcollision(impactors%id(:))) + impactors%id = pack(impactors%id(:), pl%lcollision(impactors%id(:))) + impactors%Lspin(:,:) = 0.0_DP + impactors%Ip(:,:) = 0.0_DP + + ! Find the barycenter of each body along with its children, if it has any + do j = 1, 2 + impactors%rb(:, j) = pl%rh(:, idx_parent(j)) + cb%rb(:) + impactors%vb(:, j) = pl%vb(:, idx_parent(j)) + ! Assume principal axis rotation about axis corresponding to highest moment of inertia (3rd Ip) + if (param%lrotation) then + impactors%Ip(:, j) = impactors%mass(j) * pl%Ip(:, idx_parent(j)) + impactors%Lspin(:, j) = impactors%Ip(3, j) * impactors%radius(j)**2 * pl%rot(:, idx_parent(j)) + end if + + if (nchild(j) > 0) then + do i = 1, nchild(j) ! Loop over all children and take the mass weighted mean of the properties + idx_child = parent_child_index_array(j)%idx(i + 1) + if (.not. pl%lcollision(idx_child)) cycle + mchild = pl%mass(idx_child) + xchild(:) = pl%rh(:, idx_child) + cb%rb(:) + vchild(:) = pl%vb(:, idx_child) + volchild = (4.0_DP / 3.0_DP) * PI * pl%radius(idx_child)**3 + volume(j) = volume(j) + volchild + ! Get angular momentum of the child-parent pair and add that to the spin + ! Add the child's spin + if (param%lrotation) then + xcom(:) = (impactors%mass(j) * impactors%rb(:,j) + mchild * xchild(:)) / (impactors%mass(j) + mchild) + vcom(:) = (impactors%mass(j) * impactors%vb(:,j) + mchild * vchild(:)) / (impactors%mass(j) + mchild) + xc(:) = impactors%rb(:, j) - xcom(:) + vc(:) = impactors%vb(:, j) - vcom(:) + xcrossv(:) = xc(:) .cross. vc(:) + impactors%Lspin(:, j) = impactors%Lspin(:, j) + impactors%mass(j) * xcrossv(:) + + xc(:) = xchild(:) - xcom(:) + vc(:) = vchild(:) - vcom(:) + xcrossv(:) = xc(:) .cross. vc(:) + impactors%Lspin(:, j) = impactors%Lspin(:, j) + mchild * xcrossv(:) + + impactors%Lspin(:, j) = impactors%Lspin(:, j) + mchild * pl%Ip(3, idx_child) & + * pl%radius(idx_child)**2 & + * pl%rot(:, idx_child) + impactors%Ip(:, j) = impactors%Ip(:, j) + mchild * pl%Ip(:, idx_child) + end if + + ! Merge the child and parent + impactors%mass(j) = impactors%mass(j) + mchild + impactors%rb(:, j) = xcom(:) + impactors%vb(:, j) = vcom(:) + end do + end if + density(j) = impactors%mass(j) / volume(j) + impactors%radius(j) = (3 * volume(j) / (4 * PI))**(1.0_DP / 3.0_DP) + if (param%lrotation) impactors%Ip(:, j) = impactors%Ip(:, j) / impactors%mass(j) + end do + lflag = .true. + + xcom(:) = (impactors%mass(1) * impactors%rb(:, 1) + impactors%mass(2) * impactors%rb(:, 2)) / sum(impactors%mass(:)) + vcom(:) = (impactors%mass(1) * impactors%vb(:, 1) + impactors%mass(2) * impactors%vb(:, 2)) / sum(impactors%mass(:)) + mxc(:, 1) = impactors%mass(1) * (impactors%rb(:, 1) - xcom(:)) + mxc(:, 2) = impactors%mass(2) * (impactors%rb(:, 2) - xcom(:)) + vcc(:, 1) = impactors%vb(:, 1) - vcom(:) + vcc(:, 2) = impactors%vb(:, 2) - vcom(:) + impactors%Lorbit(:,:) = mxc(:,:) .cross. vcc(:,:) + + ! Destroy the kinship relationships for all members of this impactors%id + call pl%reset_kinship(impactors%id(:)) + + return + end function collision_resolve_consolidate_impactors + + + module subroutine collision_resolve_extract_plpl(self, system, param) + !! author: David A. Minton + !! + !! Processes the pl-pl encounter list remove only those encounters that led to a collision + !! + implicit none + ! Arguments + class(collision_list_plpl), intent(inout) :: self !! pl-pl encounter list + class(base_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(base_parameters), intent(in) :: param !! Current run configuration parameters + ! Internals + logical, dimension(:), allocatable :: lplpl_collision + logical, dimension(:), allocatable :: lplpl_unique_parent + integer(I4B), dimension(:), pointer :: plparent + integer(I4B), dimension(:), allocatable :: collision_idx, unique_parent_idx + integer(I4B) :: i, index_coll, ncollisions, nunique_parent, nplplenc + + select type(system) + class is (swiftest_nbody_system) + select type (pl => system%pl) + class is (swiftest_pl) + associate(plpl_encounter => self, idx1 => self%index1, idx2 => self%index2, plparent => pl%kin%parent) + nplplenc = plpl_encounter%nenc + allocate(lplpl_collision(nplplenc)) + lplpl_collision(:) = plpl_encounter%status(1:nplplenc) == COLLIDED + if (.not.any(lplpl_collision)) return + ! Collisions have been detected in this step. So we need to determine which of them are between unique bodies. + + ! Get the subset of pl-pl encounters that lead to a collision + ncollisions = count(lplpl_collision(:)) + allocate(collision_idx(ncollisions)) + collision_idx = pack([(i, i=1, nplplenc)], lplpl_collision) + + ! Get the subset of collisions that involve a unique pair of parents + allocate(lplpl_unique_parent(ncollisions)) + + lplpl_unique_parent(:) = plparent(idx1(collision_idx(:))) /= plparent(idx2(collision_idx(:))) + nunique_parent = count(lplpl_unique_parent(:)) + allocate(unique_parent_idx(nunique_parent)) + unique_parent_idx = pack(collision_idx(:), lplpl_unique_parent(:)) + + ! Scrub all pl-pl collisions involving unique pairs of parents, which will remove all duplicates and leave behind + ! all pairs that have themselves as parents but are not part of the unique parent list. This can hapepn in rare cases + ! due to restructuring of parent/child relationships when there are large numbers of multi-body collisions in a single + ! step + lplpl_unique_parent(:) = .true. + do index_coll = 1, ncollisions + associate(ip1 => plparent(idx1(collision_idx(index_coll))), ip2 => plparent(idx2(collision_idx(index_coll)))) + lplpl_unique_parent(:) = .not. ( any(plparent(idx1(unique_parent_idx(:))) == ip1) .or. & + any(plparent(idx2(unique_parent_idx(:))) == ip1) .or. & + any(plparent(idx1(unique_parent_idx(:))) == ip2) .or. & + any(plparent(idx2(unique_parent_idx(:))) == ip2) ) + end associate + end do + + ! Reassemble collision index list to include only those containing the unique pairs of parents, plus all the non-unique pairs that don't + ! contain a parent body on the unique parent list. + ncollisions = nunique_parent + count(lplpl_unique_parent) + collision_idx = [unique_parent_idx(:), pack(collision_idx(:), lplpl_unique_parent(:))] + + ! Create a mask that contains only the pl-pl encounters that did not result in a collision, and then discard them + lplpl_collision(:) = .false. + lplpl_collision(collision_idx(:)) = .true. + call plpl_encounter%spill(system%plpl_collision, lplpl_collision, ldestructive=.true.) ! Extract any encounters that are not collisions from the list. + end associate + end select + end select + + return + end subroutine collision_resolve_extract_plpl + + module subroutine collision_resolve_extract_pltp(self, system, param) + implicit none + class(collision_list_pltp), intent(inout) :: self !! pl-tp encounter list + class(base_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(base_parameters), intent(in) :: param !! Current run configuration parameters + + return + end subroutine collision_resolve_extract_pltp + + + module subroutine collision_resolve_make_impactors_pl(pl, idx) + !! author: Jennifer L.L. Pouplin, Carlisle A. wishard, and David A. Minton + !! + !! When a single body is involved in more than one collision in a single step, it becomes part of a impactors%id. + !! The largest body involved in a multi-body collision is the "parent" and all bodies that collide with it are its "children," + !! including those that collide with the children. + !! + !! Adapted from David E. Kaufmann's Swifter routine swiftest_merge_pl.f90 + !! + !! Adapted from Hal Levison's Swift routine symba5_merge.f + implicit none + ! Arguments + class(base_object), intent(inout) :: pl !! Swiftest massive body object + integer(I4B), dimension(:), intent(in) :: idx !! Array holding the indices of the two bodies involved in the collision + ! Internals + integer(I4B) :: i, j, index_parent, index_child, p1, p2 + integer(I4B) :: nchild_inherit, nchild_orig, nchild_new + integer(I4B), dimension(:), allocatable :: temp + + select type(pl) + class is (swiftest_pl) + + p1 = pl%kin(idx(1))%parent + p2 = pl%kin(idx(2))%parent + if (p1 == p2) return ! This is a collision between to children of a shared parent. We will ignore it. + + if (pl%mass(p1) > pl%mass(p2)) then + index_parent = p1 + index_child = p2 + else + index_parent = p2 + index_child = p1 + end if + + ! Expand the child array (or create it if necessary) and copy over the previous lists of children + nchild_orig = pl%kin(index_parent)%nchild + nchild_inherit = pl%kin(index_child)%nchild + nchild_new = nchild_orig + nchild_inherit + 1 + allocate(temp(nchild_new)) + + if (nchild_orig > 0) temp(1:nchild_orig) = pl%kin(index_parent)%child(1:nchild_orig) + ! Find out if the child body has any children of its own. The new parent wil inherit these children + if (nchild_inherit > 0) then + temp(nchild_orig+1:nchild_orig+nchild_inherit) = pl%kin(index_child)%child(1:nchild_inherit) + do i = 1, nchild_inherit + j = pl%kin(index_child)%child(i) + ! Set the childrens' parent to the new parent + pl%kin(j)%parent = index_parent + end do + end if + call pl%reset_kinship([index_child]) + ! Add the new child to its parent + pl%kin(index_child)%parent = index_parent + temp(nchild_new) = index_child + ! Save the new child array to the parent + pl%kin(index_parent)%nchild = nchild_new + call move_alloc(from=temp, to=pl%kin(index_parent)%child) + end select + + return + end subroutine collision_resolve_make_impactors_pl + + + subroutine collision_resolve_mergeaddsub(system, param, t, status) + !! author: David A. Minton + !! + !! Fills the pl_discards and pl_adds with removed and added bodies + !! + use symba, only : symba_pl + implicit none + ! Arguments + class(base_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(base_parameters), intent(inout) :: param !! Current run configuration parameters with Swiftest additions + real(DP), intent(in) :: t !! Time of collision + integer(I4B), intent(in) :: status !! Status flag to assign to adds + ! Internals + integer(I4B) :: i, ibiggest, ismallest, iother, nstart, nend, nimpactors, nfrag + logical, dimension(:), allocatable :: lmask + class(swiftest_pl), allocatable :: plnew, plsub + character(*), parameter :: FRAGFMT = '("Newbody",I0.7)' + character(len=NAMELEN) :: newname, origin_type + + select type(system) + class is (swiftest_nbody_system) + select type(param) + class is (swiftest_parameters) + associate(pl => system%pl, pl_discards => system%pl_discards, info => system%pl%info, pl_adds => system%pl_adds, cb => system%cb, npl => pl%nbody, & + collision_system => system%collision_system, impactors => system%collision_system%impactors,fragments => system%collision_system%fragments) + + ! Add the impactors%id bodies to the subtraction list + nimpactors = impactors%ncoll + nfrag = fragments%nbody + + param%maxid_collision = max(param%maxid_collision, maxval(system%pl%info(:)%collision_id)) + param%maxid_collision = param%maxid_collision + 1 + + ! Setup new bodies + allocate(plnew, mold=pl) + call plnew%setup(nfrag, param) + ibiggest = impactors%id(maxloc(pl%Gmass(impactors%id(:)), dim=1)) + ismallest = impactors%id(minloc(pl%Gmass(impactors%id(:)), dim=1)) + + ! Copy over identification, information, and physical properties of the new bodies from the fragment list + plnew%id(1:nfrag) = fragments%id(1:nfrag) + plnew%rb(:, 1:nfrag) = fragments%rb(:, 1:nfrag) + plnew%vb(:, 1:nfrag) = fragments%vb(:, 1:nfrag) + call pl%vb2vh(cb) + call pl%rh2rb(cb) + do i = 1, nfrag + plnew%rh(:,i) = fragments%rb(:, i) - cb%rb(:) + plnew%vh(:,i) = fragments%vb(:, i) - cb%vb(:) + end do + plnew%mass(1:nfrag) = fragments%mass(1:nfrag) + plnew%Gmass(1:nfrag) = param%GU * fragments%mass(1:nfrag) + plnew%radius(1:nfrag) = fragments%radius(1:nfrag) + plnew%density(1:nfrag) = fragments%mass(1:nfrag) / fragments%radius(1:nfrag) + call plnew%set_rhill(cb) + + select case(status) + case(SUPERCATASTROPHIC) + plnew%status(1:nfrag) = NEW_PARTICLE + do i = 1, nfrag + write(newname, FRAGFMT) fragments%id(i) + call plnew%info(i)%set_value(origin_type="Supercatastrophic", origin_time=t, name=newname, & + origin_rh=plnew%rh(:,i), origin_vh=plnew%vh(:,i), & + collision_id=param%maxid_collision) + end do + do i = 1, nimpactors + if (impactors%id(i) == ibiggest) then + iother = ismallest + else + iother = ibiggest + end if + call pl%info(impactors%id(i))%set_value(status="Supercatastrophic", discard_time=t, & + discard_rh=pl%rh(:,i), discard_vh=pl%vh(:,i), & + discard_body_id=iother) + end do + case(DISRUPTED,HIT_AND_RUN_DISRUPT) + if (status == DISRUPTED) then + write(origin_type,*) "Disruption" + else if (status == HIT_AND_RUN_DISRUPT) then + write(origin_type,*) "Hit and run fragmention" + end if + call plnew%info(1)%copy(pl%info(ibiggest)) + plnew%status(1) = OLD_PARTICLE + do i = 2, nfrag + write(newname, FRAGFMT) fragments%id(i) + call plnew%info(i)%set_value(origin_type=origin_type, origin_time=t, name=newname, & + origin_rh=plnew%rh(:,i), origin_vh=plnew%vh(:,i), & + collision_id=param%maxid_collision) + end do + do i = 1, nimpactors + if (impactors%id(i) == ibiggest) cycle + iother = ibiggest + call pl%info(impactors%id(i))%set_value(status=origin_type, discard_time=t, & + discard_rh=pl%rh(:,i), discard_vh=pl%vh(:,i), & + discard_body_id=iother) + end do + case(MERGED) + call plnew%info(1)%copy(pl%info(ibiggest)) + plnew%status(1) = OLD_PARTICLE + do i = 1, nimpactors + if (impactors%id(i) == ibiggest) cycle + + iother = ibiggest + call pl%info(impactors%id(i))%set_value(status="MERGED", discard_time=t, discard_rh=pl%rh(:,i), & + discard_vh=pl%vh(:,i), discard_body_id=iother) + end do + end select + + if (param%lrotation) then + plnew%Ip(:, 1:nfrag) = fragments%Ip(:, 1:nfrag) + plnew%rot(:, 1:nfrag) = fragments%rot(:, 1:nfrag) + end if + + ! if (param%ltides) then + ! plnew%Q = pl%Q(ibiggest) + ! plnew%k2 = pl%k2(ibiggest) + ! plnew%tlag = pl%tlag(ibiggest) + ! end if + + !Copy over or set integration parameters for new bodies + plnew%lcollision(1:nfrag) = .false. + plnew%ldiscard(1:nfrag) = .false. + select type(pl) + class is (symba_pl) + select type(plnew) + class is (symba_pl) + plnew%levelg(1:nfrag) = pl%levelg(ibiggest) + plnew%levelm(1:nfrag) = pl%levelm(ibiggest) + end select + end select + + plnew%lmtiny(1:nfrag) = plnew%Gmass(1:nfrag) < param%GMTINY + where(plnew%lmtiny(1:nfrag)) + plnew%info(1:nfrag)%particle_type = PL_TINY_TYPE_NAME + elsewhere + plnew%info(1:nfrag)%particle_type = PL_TYPE_NAME + end where + + ! Log the properties of the new bodies + select type(after => collision_system%after) + class is (swiftest_nbody_system) + allocate(after%pl, source=plnew) + end select + + ! Append the new merged body to the list + nstart = pl_adds%nbody + 1 + nend = pl_adds%nbody + nfrag + call pl_adds%append(plnew, lsource_mask=[(.true., i=1, nfrag)]) + + ! Add the discarded bodies to the discard list + pl%status(impactors%id(:)) = MERGED + pl%ldiscard(impactors%id(:)) = .true. + pl%lcollision(impactors%id(:)) = .true. + allocate(lmask, mold=pl%lmask) + lmask(:) = .false. + lmask(impactors%id(:)) = .true. + + call plnew%setup(0, param) + deallocate(plnew) + + allocate(plsub, mold=pl) + call pl%spill(plsub, lmask, ldestructive=.false.) + + nstart = pl_discards%nbody + 1 + nend = pl_discards%nbody + nimpactors + call pl_discards%append(plsub, lsource_mask=[(.true., i = 1, nimpactors)]) + + call plsub%setup(0, param) + deallocate(plsub) + end associate + + end select + end select + + return + end subroutine collision_resolve_mergeaddsub + + + subroutine collision_resolve_list(plpl_collision , system, param, t) + !! author: David A. Minton + !! + !! Process list of collisions, determine the collisional regime, and then create fragments. + !! + implicit none + ! Arguments + class(collision_list_plpl), intent(inout) :: plpl_collision !! Swiftest pl-pl encounter list + class(base_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(base_parameters), intent(inout) :: param !! Current run configuration parameters with Swiftest additions + real(DP), intent(in) :: t !! Time of collision + ! Internals + ! Internals + integer(I4B), dimension(2) :: idx_parent !! Index of the two bodies considered the "parents" of the collision + logical :: lgoodcollision + integer(I4B) :: i + + select type(system) + class is (swiftest_nbody_system) + associate(ncollisions => plpl_collision%nenc, idx1 => plpl_collision%index1, idx2 => plpl_collision%index2, collision_history => system%collision_history, & + collision_system => system%collision_system, impactors => system%collision_system%impactors, fragments => system%collision_system%fragments, & + pl => system%pl, cb => system%cb) + do i = 1, ncollisions + idx_parent(1) = pl%kin(idx1(i))%parent + idx_parent(2) = pl%kin(idx2(i))%parent + lgoodcollision = collision_resolve_consolidate_impactors(pl, cb, param, idx_parent, impactors) + if ((.not. lgoodcollision) .or. any(pl%status(idx_parent(:)) /= COLLIDED)) cycle + + if (param%lfragmentation) then + call impactors%get_regime(system, param) + else + impactors%regime = COLLRESOLVE_REGIME_MERGE + fragments%mtot = sum(impactors%mass(:)) + impactors%mass_dist(1) = fragments%mtot + impactors%mass_dist(2) = 0.0_DP + impactors%mass_dist(3) = 0.0_DP + impactors%rbcom(:) = (impactors%mass(1) * impactors%rb(:,1) + impactors%mass(2) * impactors%rb(:,2)) / fragments%mtot + impactors%vbcom(:) = (impactors%mass(1) * impactors%vb(:,1) + impactors%mass(2) * impactors%vb(:,2)) / fragments%mtot + end if + + call collision_history%take_snapshot(param,system, t, "before") + select case (impactors%regime) + case (COLLRESOLVE_REGIME_DISRUPTION, COLLRESOLVE_REGIME_SUPERCATASTROPHIC) + plpl_collision%status(i) = fraggle_resolve_disruption(system, param, t) + case (COLLRESOLVE_REGIME_HIT_AND_RUN) + plpl_collision%status(i) = fraggle_resolve_hitandrun(system, param, t) + case (COLLRESOLVE_REGIME_MERGE, COLLRESOLVE_REGIME_GRAZE_AND_MERGE) + plpl_collision%status(i) = collision_resolve_merge(system, param, t) + case default + write(*,*) "Error in swiftest_collision, unrecognized collision regime" + call util_exit(FAILURE) + end select + call collision_history%take_snapshot(param,system, t, "after") + call impactors%reset() + end do + end associate + end select + return + end subroutine collision_resolve_list + + + module subroutine collision_resolve_plpl(self, system, param, t, dt, irec) + !! author: David A. Minton + !! + !! Process the pl-pl collision list, then modifiy the massive bodies based on the outcome of the collision + !! + implicit none + ! Arguments + class(collision_list_plpl), intent(inout) :: self !! Swiftest pl-pl encounter list + class(base_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(base_parameters), intent(inout) :: param !! Current run configuration parameters with Swiftest additions + real(DP), intent(in) :: t !! Current simulation time + real(DP), intent(in) :: dt !! Current simulation step size + integer(I4B), intent(in) :: irec !! Current recursion level + ! Internals + real(DP) :: Eorbit_before, Eorbit_after + logical :: lplpl_collision + character(len=STRMAX) :: timestr + class(swiftest_parameters), allocatable :: tmp_param + + select type (system) + class is (swiftest_nbody_system) + select type(pl => system%pl) + class is (swiftest_pl) + select type(param) + class is (swiftest_parameters) + associate(plpl_encounter => self, plpl_collision => system%plpl_collision) + if (plpl_collision%nenc == 0) return ! No collisions to resolve + ! Make sure that the heliocentric and barycentric coordinates are consistent with each other + call pl%vb2vh(system%cb) + call pl%rh2rb(system%cb) + + ! Get the energy before the collision is resolved + if (param%lenergy) then + call system%get_energy_and_momentum(param) + Eorbit_before = system%te + end if + + do + write(timestr,*) t + call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, "") + call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, "***********************************************************" // & + "***********************************************************") + call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, "Collision between massive bodies detected at time t = " // & + trim(adjustl(timestr))) + call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, "***********************************************************" // & + "***********************************************************") + allocate(tmp_param, source=param) + + call collision_resolve_list(plpl_collision, system, param, t) + + ! Destroy the collision list now that the collisions are resolved + call plpl_collision%setup(0_I8B) + + if ((system%pl_adds%nbody == 0) .and. (system%pl_discards%nbody == 0)) exit + + ! Save the add/discard information to file + call system%write_discard(tmp_param) + + ! Rearrange the arrays: Remove discarded bodies, add any new bodies, resort, and recompute all indices and encounter lists + call pl%rearray(system, tmp_param) + + ! Destroy the add/discard list so that we don't append the same body multiple times if another collision is detected + call system%pl_discards%setup(0, param) + call system%pl_adds%setup(0, param) + deallocate(tmp_param) + + ! Check whether or not any of the particles that were just added are themselves in a collision state. This will generate a new plpl_collision + call plpl_encounter%collision_check(system, param, t, dt, irec, lplpl_collision) + + if (.not.lplpl_collision) exit + end do + + if (param%lenergy) then + call system%get_energy_and_momentum(param) + Eorbit_after = system%te + system%Ecollisions = system%Ecollisions + (Eorbit_after - Eorbit_before) + end if + + end associate + end select + end select + end select + + return + end subroutine collision_resolve_plpl + + + module subroutine collision_resolve_pltp(self, system, param, t, dt, irec) + !! author: David A. Minton + !! + !! Process the pl-tp collision list, then modifiy the massive bodies based on the outcome of the collision + !! + implicit none + ! Arguments + class(collision_list_pltp), intent(inout) :: self !! Swiftest pl-pl encounter list + class(base_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(base_parameters), intent(inout) :: param !! Current run configuration parameters with Swiftest additions + real(DP), intent(in) :: t !! Current simulation tim + real(DP), intent(in) :: dt !! Current simulation step size + integer(I4B), intent(in) :: irec !! Current recursion level + + ! Make sure coordinate systems are all synced up due to being inside the recursion at this point + select type(system) + class is (swiftest_nbody_system) + select type(param) + class is (swiftest_parameters) + call system%pl%vb2vh(system%cb) + call system%tp%vb2vh(system%cb%vb) + call system%pl%b2h(system%cb) + call system%tp%b2h(system%cb) + + ! Discard the collider + call system%tp%discard(system, param) + end select + end select + + return + end subroutine collision_resolve_pltp + +end submodule s_collision_resolve \ No newline at end of file diff --git a/src/collision/collision_setup.f90 b/src/collision/collision_setup.f90 index d98883ca4..d3be371d3 100644 --- a/src/collision/collision_setup.f90 +++ b/src/collision/collision_setup.f90 @@ -7,89 +7,61 @@ !! You should have received a copy of the GNU General Public License along with Swiftest. !! If not, see: https://www.gnu.org/licenses. -submodule (collision_classes) s_collision_setup +submodule (collision) s_collision_setup use swiftest contains - module subroutine collision_setup_system(self, param) + module subroutine collision_setup_system(self, nbody_system) !! author: David A. Minton !! - !! Initializer for the encounter collision system. Allocates the collider and fragments classes and the before/after snapshots + !! Initializer for the encounter collision system. Sets up impactors and the before/after snapshots, + !! but not fragments. Those are setup later when the number of fragments is known. implicit none ! Arguments - class(collision_system), intent(inout) :: self !! Encounter collision system object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - ! Internals + class(collision_system), intent(inout) :: self !! Encounter collision system object + class(base_nbody_system), intent(in) :: nbody_system !! Current nbody system. Used as a mold for the before/after snapshots - ! TODO: Check parameter file for fragmentation model in SyMBA - allocate(collision_impactors :: self%impactors) - allocate(fraggle_fragments :: self%fragments) + call self%setup_impactors() + if (allocated(self%before)) deallocate(self%before) + if (allocated(self%after)) deallocate(self%after) + allocate(self%before, mold=nbody_system) + allocate(self%after, mold=nbody_system) return end subroutine collision_setup_system - module subroutine collision_setup_fragments(self, n, param) + module subroutine collision_setup_impactors_system(self) !! author: David A. Minton !! - !! Allocates arrays for n fragments in a collision system. Passing n = 0 deallocates all arrays. + !! Initializer for the impactors for the encounter collision system. Deallocates old impactors before creating new ones implicit none ! Arguments - class(collision_fragments), intent(inout) :: self - integer(I4B), intent(in) :: n - class(swiftest_parameters), intent(in) :: param - - - if (n < 0) return - - call self%dealloc() - - if (n == 0) return - - self%mtot = 0.0_DP - allocate(self%status(n)) - allocate(self%rb(NDIM,n)) - allocate(self%vb(NDIM,n)) - allocate(self%mass(n)) - allocate(self%rot(NDIM,n)) - allocate(self%Ip(NDIM,n)) - - allocate(self%rc(NDIM,n)) - allocate(self%vc(NDIM,n)) - allocate(self%vmag(n)) - allocate(self%rmag(n)) - allocate(self%rotmag(n)) - allocate(self%radius(n)) - allocate(self%density(n)) - - self%status(:) = INACTIVE - self%rb(:,:) = 0.0_DP - self%vb(:,:) = 0.0_DP - self%rc(:,:) = 0.0_DP - self%vc(:,:) = 0.0_DP - self%vmag(:) = 0.0_DP - self%rmag(:) = 0.0_DP - self%rotmag(:) = 0.0_DP - self%radius(:) = 0.0_DP - self%density(:) = 0.0_DP + class(collision_system), intent(inout) :: self !! Encounter collision system object + + if (allocated(self%impactors)) deallocate(self%impactors) + allocate(collision_impactors :: self%impactors) return - end subroutine collision_setup_fragments + end subroutine collision_setup_impactors_system - module subroutine collision_setup_impactors(self, system, param) + module subroutine collision_setup_fragments_system(self, nfrag) !! author: David A. Minton !! - !! Initializes a collider object + !! Initializer for the fragments of the collision system. implicit none ! Arguments - class(collision_impactors), intent(inout) :: self !! Fragment system object - class(swiftest_nbody_system), intent(in) :: system - class(swiftest_parameters), intent(in) :: param !! Current swiftest run configuration parameters + class(collision_system), intent(inout) :: self !! Encounter collision system object + integer(I4B), intent(in) :: nfrag !! Number of fragments to create + + if (allocated(self%fragments)) deallocate(self%fragments) + allocate(collision_fragments(nfrag) :: self%fragments) return - end subroutine collision_setup_impactors + end subroutine collision_setup_fragments_system + end submodule s_collision_setup diff --git a/src/collision/collision_util.f90 b/src/collision/collision_util.f90 index 68412cfc5..0690adf60 100644 --- a/src/collision/collision_util.f90 +++ b/src/collision/collision_util.f90 @@ -7,7 +7,7 @@ !! You should have received a copy of the GNU General Public License along with Swiftest. !! If not, see: https://www.gnu.org/licenses. -submodule (collision_classes) s_collision_util +submodule (collision) s_collision_util use swiftest contains @@ -18,41 +18,44 @@ module subroutine collision_util_add_fragments_to_system(self, system, param) implicit none ! Arguments class(collision_system), intent(in) :: self !! Collision system system object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object - class(swiftest_parameters), intent(in) :: param !! Current swiftest run configuration parameters + class(base_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(base_parameters), intent(in) :: param !! Current swiftest run configuration parameters ! Internals integer(I4B) :: i, npl_before, npl_after logical, dimension(:), allocatable :: lexclude - associate(fragments => self%fragments, impactors => self%impactors, nfrag => self%fragments%nbody, pl => system%pl, cb => system%cb) - npl_after = pl%nbody - npl_before = npl_after - nfrag - allocate(lexclude(npl_after)) - - pl%status(npl_before+1:npl_after) = ACTIVE - pl%mass(npl_before+1:npl_after) = fragments%mass(1:nfrag) - pl%Gmass(npl_before+1:npl_after) = fragments%mass(1:nfrag) * param%GU - pl%radius(npl_before+1:npl_after) = fragments%radius(1:nfrag) - do concurrent (i = 1:nfrag) - pl%rb(:,npl_before+i) = fragments%rb(:,i) - pl%vb(:,npl_before+i) = fragments%vb(:,i) - pl%rh(:,npl_before+i) = fragments%rb(:,i) - cb%rb(:) - pl%vh(:,npl_before+i) = fragments%vb(:,i) - cb%vb(:) - end do - if (param%lrotation) then - pl%Ip(:,npl_before+1:npl_after) = fragments%Ip(:,1:nfrag) - pl%rot(:,npl_before+1:npl_after) = fragments%rot(:,1:nfrag) - end if - ! This will remove the impactors from the system since we've replaced them with fragments - lexclude(1:npl_after) = .false. - lexclude(impactors%idx(1:impactors%ncoll)) = .true. - where(lexclude(1:npl_after)) - pl%status(1:npl_after) = INACTIVE - elsewhere - pl%status(1:npl_after) = ACTIVE - endwhere - - end associate + select type(system) + class is (swiftest_nbody_system) + associate(fragments => self%fragments, impactors => self%impactors, nfrag => self%fragments%nbody, pl => system%pl, cb => system%cb) + npl_after = pl%nbody + npl_before = npl_after - nfrag + allocate(lexclude(npl_after)) + + pl%status(npl_before+1:npl_after) = ACTIVE + pl%mass(npl_before+1:npl_after) = fragments%mass(1:nfrag) + pl%Gmass(npl_before+1:npl_after) = fragments%mass(1:nfrag) * param%GU + pl%radius(npl_before+1:npl_after) = fragments%radius(1:nfrag) + do concurrent (i = 1:nfrag) + pl%rb(:,npl_before+i) = fragments%rb(:,i) + pl%vb(:,npl_before+i) = fragments%vb(:,i) + pl%rh(:,npl_before+i) = fragments%rb(:,i) - cb%rb(:) + pl%vh(:,npl_before+i) = fragments%vb(:,i) - cb%vb(:) + end do + if (param%lrotation) then + pl%Ip(:,npl_before+1:npl_after) = fragments%Ip(:,1:nfrag) + pl%rot(:,npl_before+1:npl_after) = fragments%rot(:,1:nfrag) + end if + ! This will remove the impactors from the system since we've replaced them with fragments + lexclude(1:npl_after) = .false. + lexclude(impactors%id(1:impactors%ncoll)) = .true. + where(lexclude(1:npl_after)) + pl%status(1:npl_after) = INACTIVE + elsewhere + pl%status(1:npl_after) = ACTIVE + endwhere + + end associate + end select return end subroutine collision_util_add_fragments_to_system @@ -64,64 +67,70 @@ module subroutine collision_util_construct_temporary_system(self, nbody_system, !! Constructs a temporary internal system consisting of active bodies and additional fragments. This internal temporary system is used to calculate system energy with and without fragments implicit none ! Arguments - class(collision_system), intent(inout) :: self !! Fraggle collision system object - class(swiftest_nbody_system), intent(in) :: nbody_system !! Original swiftest nbody system object - class(swiftest_parameters), intent(in) :: param !! Current swiftest run configuration parameters - class(swiftest_nbody_system), allocatable, intent(out) :: tmpsys !! Output temporary swiftest nbody system object - class(swiftest_parameters), allocatable, intent(out) :: tmpparam !! Output temporary configuration run parameters + class(collision_system), intent(inout) :: self !! Fraggle collision system object + class(base_nbody_system), intent(in) :: nbody_system !! Original swiftest nbody system object + class(base_parameters), intent(in) :: param !! Current swiftest run configuration parameters + class(base_nbody_system), allocatable, intent(out) :: tmpsys !! Output temporary swiftest nbody system object + class(base_parameters), allocatable, intent(out) :: tmpparam !! Output temporary configuration run parameters ! Internals logical, dimension(:), allocatable :: linclude integer(I4B) :: npl_tot - associate(fragments => self%fragments, nfrag => self%fragments%nbody, pl => nbody_system%pl, npl => nbody_system%pl%nbody, cb => nbody_system%cb) - ! Set up a new system based on the original - if (allocated(tmpparam)) deallocate(tmpparam) - if (allocated(tmpsys)) deallocate(tmpsys) - allocate(tmpparam, source=param) - call setup_construct_system(tmpsys, tmpparam) - - ! No test particles necessary for energy/momentum calcs - call tmpsys%tp%setup(0, param) - - ! Replace the empty central body object with a copy of the original - deallocate(tmpsys%cb) - allocate(tmpsys%cb, source=cb) - - ! Make space for the fragments - npl_tot = npl + nfrag - call tmpsys%pl%setup(npl_tot, tmpparam) - allocate(linclude(npl_tot)) - - ! Fill up the temporary system with all of the original bodies, leaving the spaces for fragments empty until we add them in later - linclude(1:npl) = .true. - linclude(npl+1:npl_tot) = .false. - call tmpsys%pl%fill(pl, linclude) + select type(nbody_system) + class is (swiftest_nbody_system) + select type(param) + class is (swiftest_parameters) + associate(fragments => self%fragments, nfrag => self%fragments%nbody, pl => nbody_system%pl, npl => nbody_system%pl%nbody, cb => nbody_system%cb) + ! Set up a new system based on the original + if (allocated(tmpparam)) deallocate(tmpparam) + if (allocated(tmpsys)) deallocate(tmpsys) + allocate(tmpparam, source=param) + call swiftest_setup_construct_system(tmpsys, tmpparam) + select type(tmpsys) + class is (swiftest_nbody_system) + select type(tmpparam) + class is (swiftest_parameters) + + ! No test particles necessary for energy/momentum calcs + call tmpsys%tp%setup(0, param) + + ! Replace the empty central body object with a copy of the original + deallocate(tmpsys%cb) + allocate(tmpsys%cb, source=cb) + + ! Make space for the fragments + npl_tot = npl + nfrag + call tmpsys%pl%setup(npl_tot, tmpparam) + allocate(linclude(npl_tot)) + + ! Fill up the temporary system with all of the original bodies, leaving the spaces for fragments empty until we add them in later + linclude(1:npl) = .true. + linclude(npl+1:npl_tot) = .false. + call tmpsys%pl%fill(pl, linclude) + end select + end select - end associate + end associate + end select + end select return end subroutine collision_util_construct_temporary_system - module subroutine collision_util_dealloc_fragments(self) + + module subroutine collision_util_final_fragments(self) !! author: David A. Minton !! - !! Deallocates all allocatables + !! Finalizer will deallocate all allocatables implicit none ! Arguments - class(collision_fragments), intent(inout) :: self - - call util_dealloc_pl(self) + type(collision_fragments(*)), intent(inout) :: self - if (allocated(self%rc)) deallocate(self%rc) - if (allocated(self%vc)) deallocate(self%vc) - if (allocated(self%rmag)) deallocate(self%rmag) - if (allocated(self%rotmag)) deallocate(self%rotmag) - if (allocated(self%v_r_unit)) deallocate(self%v_r_unit) - if (allocated(self%v_t_unit)) deallocate(self%v_t_unit) - if (allocated(self%v_n_unit)) deallocate(self%v_n_unit) + call self%reset() return - end subroutine collision_util_dealloc_fragments + end subroutine collision_util_final_fragments + module subroutine collision_util_final_impactors(self) !! author: David A. Minton @@ -158,8 +167,12 @@ module subroutine collision_util_final_storage(self) implicit none ! Arguments type(collision_storage(*)), intent(inout) :: self !! Collision storage object + ! Internals + integer(I4B) :: i - call util_final_storage(self%swiftest_storage) + do i = 1, self%nframes + if (allocated(self%frame(i)%item)) deallocate(self%frame(i)%item) + end do return end subroutine collision_util_final_storage @@ -172,10 +185,8 @@ module subroutine collision_util_final_system(self) implicit none ! Arguments type(collision_system), intent(inout) :: self !! Collision system object - ! Internals - type(swiftest_parameters) :: tmp_param - call self%reset(tmp_param) + call self%reset() if (allocated(self%impactors)) deallocate(self%impactors) if (allocated(self%fragments)) deallocate(self%fragments) @@ -194,36 +205,42 @@ module subroutine collision_util_get_idvalues_snapshot(self, idvals) ! Internals integer(I4B) :: npl_before, ntp_before, npl_after, ntp_after, ntot, nlo, nhi - npl_before = 0; ntp_before = 0; npl_after = 0; ntp_after = 0 - if (allocated(self%collision_system%before%pl)) then - npl_before = self%collision_system%before%pl%nbody - endif - - if (allocated(self%collision_system%before%tp)) then - ntp_before = self%collision_system%before%tp%nbody - end if + select type(before => self%collision_system%before) + class is (swiftest_nbody_system) + select type(after => self%collision_system%after) + class is (swiftest_nbody_system) + npl_before = 0; ntp_before = 0; npl_after = 0; ntp_after = 0 + if (allocated(before%pl)) then + npl_before = before%pl%nbody + endif + + if (allocated(before%tp)) then + ntp_before = before%tp%nbody + end if - if (allocated(self%collision_system%after%pl)) then - npl_after = self%collision_system%after%pl%nbody - end if + if (allocated(after%pl)) then + npl_after = after%pl%nbody + end if - if (allocated(self%collision_system%after%tp)) then - ntp_after = self%collision_system%after%tp%nbody - end if + if (allocated(after%tp)) then + ntp_after = after%tp%nbody + end if - ntot = npl_before + ntp_before + npl_after + ntp_after - if (ntot == 0) return - allocate(idvals(ntot)) + ntot = npl_before + ntp_before + npl_after + ntp_after + if (ntot == 0) return + allocate(idvals(ntot)) - nlo = 1; nhi = npl_before - if (npl_before > 0) idvals(nlo:nhi) = self%collision_system%before%pl%id(1:npl_before) - nlo = nhi + 1; nhi = nhi + ntp_before - if (ntp_before > 0) idvals(nlo:nhi) = self%collision_system%before%tp%id(1:ntp_before) + nlo = 1; nhi = npl_before + if (npl_before > 0) idvals(nlo:nhi) = before%pl%id(1:npl_before) + nlo = nhi + 1; nhi = nhi + ntp_before + if (ntp_before > 0) idvals(nlo:nhi) = before%tp%id(1:ntp_before) - nlo = nhi + 1; nhi = nhi + npl_after - if (npl_after > 0) idvals(nlo:nhi) = self%collision_system%after%pl%id(1:npl_after) - nlo = nhi + 1; nhi = nhi + ntp_after - if (ntp_after > 0) idvals(nlo:nhi) = self%collision_system%after%tp%id(1:ntp_after) + nlo = nhi + 1; nhi = nhi + npl_after + if (npl_after > 0) idvals(nlo:nhi) = after%pl%id(1:npl_after) + nlo = nhi + 1; nhi = nhi + ntp_after + if (ntp_after > 0) idvals(nlo:nhi) = after%tp%id(1:ntp_after) + end select + end select return @@ -239,61 +256,76 @@ module subroutine collision_util_get_energy_momentum(self, system, param, lbefo !! This will temporarily expand the massive body object in a temporary system object called tmpsys to feed it into symba_energy implicit none ! Arguments - class(collision_system), intent(inout) :: self !! Encounter collision system object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object - class(swiftest_parameters), intent(inout) :: param !! Current swiftest run configuration parameters - logical, intent(in) :: lbefore !! Flag indicating that this the "before" state of the system, with impactors included and fragments excluded or vice versa + class(collision_system), intent(inout) :: self !! Encounter collision system object + class(base_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(base_parameters), intent(inout) :: param !! Current swiftest run configuration parameters + logical, intent(in) :: lbefore !! Flag indicating that this the "before" state of the system, with impactors included and fragments excluded or vice versa ! Internals - class(swiftest_nbody_system), allocatable, save :: tmpsys - class(swiftest_parameters), allocatable, save :: tmpparam + class(base_nbody_system), allocatable, save :: tmpsys + class(base_parameters), allocatable, save :: tmpparam integer(I4B) :: npl_before, npl_after, stage - associate(fragments => self%fragments, impactors => self%impactors, nfrag => self%fragments%nbody, pl => system%pl, cb => system%cb) - - ! Because we're making a copy of the massive body object with the excludes/fragments appended, we need to deallocate the - ! big k_plpl array and recreate it when we're done, otherwise we run the risk of blowing up the memory by - ! allocating two of these ginormous arrays simulteouously. This is not particularly efficient, but as this - ! subroutine should be called relatively infrequently, it shouldn't matter too much. - - npl_before = pl%nbody - npl_after = npl_before + nfrag - - if (lbefore) then - call self%construct_temporary_system(system, param, tmpsys, tmpparam) - ! Build the exluded body logical mask for the *before* case: Only the original bodies are used to compute energy and momentum - tmpsys%pl%status(impactors%idx(1:impactors%ncoll)) = ACTIVE - tmpsys%pl%status(npl_before+1:npl_after) = INACTIVE - else - if (.not.allocated(tmpsys)) then - write(*,*) "Error in collision_util_get_energy_momentum. " // & - " This must be called with lbefore=.true. at least once before calling it with lbefore=.false." - call util_exit(FAILURE) - end if - ! Build the exluded body logical mask for the *after* case: Only the new bodies are used to compute energy and momentum - call self%add_fragments(tmpsys, tmpparam) - tmpsys%pl%status(impactors%idx(1:impactors%ncoll)) = INACTIVE - tmpsys%pl%status(npl_before+1:npl_after) = ACTIVE - end if - - if (param%lflatten_interactions) call tmpsys%pl%flatten(param) - - call tmpsys%get_energy_and_momentum(param) - - ! Calculate the current fragment energy and momentum balances - if (lbefore) then - stage = 1 - else - stage = 2 - end if - self%Lorbit(:,stage) = tmpsys%Lorbit(:) - self%Lspin(:,stage) = tmpsys%Lspin(:) - self%Ltot(:,stage) = tmpsys%Ltot(:) - self%ke_orbit(stage) = tmpsys%ke_orbit - self%ke_spin(stage) = tmpsys%ke_spin - self%pe(stage) = tmpsys%pe - self%Etot(stage) = tmpsys%te - if (stage == 2) self%Etot(stage) = self%Etot(stage) - (self%pe(2) - self%pe(1)) ! Gotta be careful with PE when number of bodies changes. - end associate + select type(system) + class is (swiftest_nbody_system) + select type(param) + class is (swiftest_parameters) + associate(fragments => self%fragments, impactors => self%impactors, nfrag => self%fragments%nbody, pl => system%pl, cb => system%cb) + + ! Because we're making a copy of the massive body object with the excludes/fragments appended, we need to deallocate the + ! big k_plpl array and recreate it when we're done, otherwise we run the risk of blowing up the memory by + ! allocating two of these ginormous arrays simulteouously. This is not particularly efficient, but as this + ! subroutine should be called relatively infrequently, it shouldn't matter too much. + + npl_before = pl%nbody + npl_after = npl_before + nfrag + + if (lbefore) then + call self%construct_temporary_system(system, param, tmpsys, tmpparam) + select type(tmpsys) + class is (swiftest_nbody_system) + ! Build the exluded body logical mask for the *before* case: Only the original bodies are used to compute energy and momentum + tmpsys%pl%status(impactors%id(1:impactors%ncoll)) = ACTIVE + tmpsys%pl%status(npl_before+1:npl_after) = INACTIVE + end select + else + if (.not.allocated(tmpsys)) then + write(*,*) "Error in collision_util_get_energy_momentum. " // & + " This must be called with lbefore=.true. at least once before calling it with lbefore=.false." + call util_exit(FAILURE) + end if + select type(tmpsys) + class is (swiftest_nbody_system) + ! Build the exluded body logical mask for the *after* case: Only the new bodies are used to compute energy and momentum + call self%add_fragments(tmpsys, tmpparam) + tmpsys%pl%status(impactors%id(1:impactors%ncoll)) = INACTIVE + tmpsys%pl%status(npl_before+1:npl_after) = ACTIVE + end select + end if + select type(tmpsys) + class is (swiftest_nbody_system) + + if (param%lflatten_interactions) call tmpsys%pl%flatten(param) + + call tmpsys%get_energy_and_momentum(param) + + ! Calculate the current fragment energy and momentum balances + if (lbefore) then + stage = 1 + else + stage = 2 + end if + self%Lorbit(:,stage) = tmpsys%Lorbit(:) + self%Lspin(:,stage) = tmpsys%Lspin(:) + self%Ltot(:,stage) = tmpsys%Ltot(:) + self%ke_orbit(stage) = tmpsys%ke_orbit + self%ke_spin(stage) = tmpsys%ke_spin + self%pe(stage) = tmpsys%pe + self%Etot(stage) = tmpsys%te + if (stage == 2) self%Etot(stage) = self%Etot(stage) - (self%pe(2) - self%pe(1)) ! Gotta be careful with PE when number of bodies changes. + end select + end associate + end select + end select return end subroutine collision_util_get_energy_momentum @@ -322,43 +354,6 @@ module subroutine collision_util_index_map(self) return end subroutine collision_util_index_map - !> The following interfaces are placeholders intended to satisfy the required abstract methods given by the parent class - module subroutine collision_util_placeholder_accel(self, system, param, t, lbeg) - implicit none - class(collision_fragments), intent(inout) :: self !! Fraggle fragment system object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - real(DP), intent(in) :: t !! Current simulation time - logical, intent(in) :: lbeg !! Optional argument that determines whether or not this is the beginning or end of the step - write(*,*) "The type-bound procedure 'accel' is not defined for the collision_fragments class" - return - end subroutine collision_util_placeholder_accel - - module subroutine collision_util_placeholder_kick(self, system, param, t, dt, lbeg) - implicit none - class(collision_fragments), intent(inout) :: self !! Fraggle fragment system object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system objec - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - real(DP), intent(in) :: t !! Current time - real(DP), intent(in) :: dt !! Stepsize - logical, intent(in) :: lbeg !! Logical flag indicating whether this is the beginning of the half step or not. - - write(*,*) "The type-bound procedure 'kick' is not defined for the collision_fragments class" - return - end subroutine collision_util_placeholder_kick - - module subroutine collision_util_placeholder_step(self, system, param, t, dt) - implicit none - class(collision_fragments), intent(inout) :: self !! Swiftest body object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest system object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - real(DP), intent(in) :: t !! Simulation time - real(DP), intent(in) :: dt !! Current stepsize - - write(*,*) "The type-bound procedure 'step' is not defined for the collision_fragments class" - return - end subroutine collision_util_placeholder_step - module subroutine collision_util_reset_impactors(self) !! author: David A. Minton @@ -368,7 +363,7 @@ module subroutine collision_util_reset_impactors(self) ! Arguments class(collision_impactors), intent(inout) :: self - if (allocated(self%idx)) deallocate(self%idx) + if (allocated(self%id)) deallocate(self%id) if (allocated(self%mass_dist)) deallocate(self%mass_dist) self%ncoll = 0 self%rb(:,:) = 0.0_DP @@ -393,14 +388,44 @@ module subroutine collision_util_reset_impactors(self) return end subroutine collision_util_reset_impactors - module subroutine collision_util_reset_system(self, param) + + module subroutine collision_util_reset_fragments(self) + !! author: David A. Minton + !! + !! Deallocates all allocatables + implicit none + ! Arguments + class(collision_fragments(*)), intent(inout) :: self + + if (allocated(self%info)) deallocate(self%info) + self%mtot = 0.0_DP + self%status = 0 + self%rh(:,:) = 0.0_DP + self%vh(:,:) = 0.0_DP + self%rb(:,:) = 0.0_DP + self%vb(:,:) = 0.0_DP + self%rot(:,:) = 0.0_DP + self%Ip(:,:) = 0.0_DP + self%mass(:) = 0.0_DP + self%radius(:) = 0.0_DP + self%density(:) = 0.0_DP + self%rc(:,:) = 0.0_DP + self%vc(:,:) = 0.0_DP + self%v_r_unit(:,:) = 0.0_DP + self%v_t_unit(:,:) = 0.0_DP + self%v_n_unit(:,:) = 0.0_DP + + return + end subroutine collision_util_reset_fragments + + + module subroutine collision_util_reset_system(self) !! author: David A. Minton !! !! Resets the collider system and deallocates all allocatables implicit none ! Arguments class(collision_system), intent(inout) :: self !! Collision system object - class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters if (allocated(self%before)) deallocate(self%before) if (allocated(self%after)) deallocate(self%after) @@ -414,7 +439,7 @@ module subroutine collision_util_reset_system(self, param) self%Etot(:) = 0.0_DP if (allocated(self%impactors)) call self%impactors%reset() - if (allocated(self%fragments)) call self%fragments%setup(0, param) + if (allocated(self%fragments)) deallocate(self%fragments) return end subroutine collision_util_reset_system @@ -486,7 +511,7 @@ subroutine collision_util_save_snapshot(collision_history, snapshot) !! Memory usage grows by a factor of 2 each time it fills up, but no more. implicit none ! Arguments - type(collision_storage(*)), allocatable, intent(inout) :: collision_history !! Collision history object + class(collision_storage(*)), allocatable, intent(inout) :: collision_history !! Collision history object class(encounter_snapshot), intent(in) :: snapshot !! Encounter snapshot object ! Internals type(collision_storage(nframes=:)), allocatable :: tmp @@ -529,14 +554,14 @@ module subroutine collision_util_snapshot(self, param, system, t, arg) !! can be played back through the encounter implicit none ! Internals - class(collision_storage(*)), intent(inout) :: self !! Swiftest storage object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object to store - real(DP), intent(in), optional :: t !! Time of snapshot if different from system time - character(*), intent(in), optional :: arg !! "before": takes a snapshot just before the collision. "after" takes the snapshot just after the collision. + class(collision_storage(*)), intent(inout) :: self !! Swiftest storage object + class(base_parameters), intent(inout) :: param !! Current run configuration parameters + class(base_nbody_system), intent(inout) :: system !! Swiftest nbody system object to store + real(DP), intent(in), optional :: t !! Time of snapshot if different from system time + character(*), intent(in), optional :: arg !! "before": takes a snapshot just before the collision. "after" takes the snapshot just after the collision. ! Arguments class(collision_snapshot), allocatable :: snapshot - type(symba_pl) :: pl + class(swiftest_pl), allocatable :: pl character(len=:), allocatable :: stage if (present(arg)) then @@ -546,12 +571,13 @@ module subroutine collision_util_snapshot(self, param, system, t, arg) end if select type (system) - class is (symba_nbody_system) - + class is (swiftest_nbody_system) + select type(param) + class is (swiftest_parameters) select case(stage) case("before") ! Saves the states of the bodies involved in the collision before the collision is resolved - associate (idx => system%collision_system%impactors%idx, ncoll => system%collision_system%impactors%ncoll) + associate (idx => system%collision_system%impactors%id, ncoll => system%collision_system%impactors%ncoll) call pl%setup(ncoll, param) pl%id(:) = system%pl%id(idx(:)) pl%Gmass(:) = system%pl%Gmass(idx(:)) @@ -561,21 +587,20 @@ module subroutine collision_util_snapshot(self, param, system, t, arg) pl%rh(:,:) = system%pl%rh(:,idx(:)) pl%vh(:,:) = system%pl%vh(:,idx(:)) pl%info(:) = system%pl%info(idx(:)) - !end select - allocate(system%collision_system%before%pl, source=pl) + select type (before => system%collision_system%before) + class is (swiftest_nbody_system) + allocate(before%pl, source=pl) + end select end associate case("after") allocate(collision_snapshot :: snapshot) allocate(snapshot%collision_system, source=system%collision_system) snapshot%t = t - select type(param) - class is (symba_parameters) - call collision_util_save_snapshot(param%collision_history,snapshot) - end select + call collision_util_save_snapshot(system%collision_history,snapshot) case default write(*,*) "collision_util_snapshot requies either 'before' or 'after' passed to 'arg'" end select - + end select end select return diff --git a/src/encounter/encounter_check.f90 b/src/encounter/encounter_check.f90 index 4e60ecf4f..f3a5a3f8d 100644 --- a/src/encounter/encounter_check.f90 +++ b/src/encounter/encounter_check.f90 @@ -7,7 +7,7 @@ !! You should have received a copy of the GNU General Public License along with Swiftest. !! If not, see: https://www.gnu.org/licenses. -submodule (encounter_classes) s_encounter_check +submodule (encounter) s_encounter_check use swiftest contains @@ -19,7 +19,7 @@ module subroutine encounter_check_all_plpl(param, npl, x, v, renc, dt, & !! implicit none ! Arguments - class(swiftest_parameters), intent(inout) :: param !! Current Swiftest run configuration parameter5s + class(base_parameters), intent(inout) :: param !! Current Swiftest run configuration parameter5s integer(I4B), intent(in) :: npl !! Total number of massive bodies real(DP), dimension(:,:), intent(in) :: x !! Position vectors of massive bodies real(DP), dimension(:,:), intent(in) :: v !! Velocity vectors of massive bodies @@ -30,43 +30,43 @@ module subroutine encounter_check_all_plpl(param, npl, x, v, renc, dt, & integer(I4B), dimension(:), allocatable, intent(out) :: index2 !! List of indices for body 2 in each encounter logical, dimension(:), allocatable, intent(out) :: lvdotr !! Logical flag indicating the sign of v .dot. x ! Internals - type(interaction_timer), save :: itimer + !type(interaction_timer), save :: itimer logical, save :: lfirst = .true. logical, save :: skipit = .false. ! This will be used to ensure that the sort & sweep subroutine gets called at least once before timing it so that the extent array is nearly sorted when it is timed integer(I8B) :: nplpl = 0_I8B - if (param%ladaptive_encounters_plpl .and. (.not. skipit)) then - nplpl = (npl * (npl - 1) / 2) - if (nplpl > 0) then - if (lfirst) then - write(itimer%loopname, *) "encounter_check_all_plpl" - write(itimer%looptype, *) "ENCOUNTER_PLPL" - lfirst = .false. - itimer%step_counter = INTERACTION_TIMER_CADENCE - else - if (itimer%check(param, nplpl)) call itimer%time_this_loop(param, nplpl) - end if - else - param%lencounter_sas_plpl = .false. - end if - end if + ! if (param%ladaptive_encounters_plpl .and. (.not. skipit)) then + ! nplpl = (npl * (npl - 1) / 2) + ! if (nplpl > 0) then + ! if (lfirst) then + ! write(itimer%loopname, *) "encounter_check_all_plpl" + ! write(itimer%looptype, *) "ENCOUNTER_PLPL" + ! lfirst = .false. + ! itimer%step_counter = INTERACTION_TIMER_CADENCE + ! else + ! if (itimer%io_netcdf_check(param, nplpl)) call itimer%time_this_loop(param, nplpl) + ! end if + ! else + ! param%lencounter_sas_plpl = .false. + ! end if + ! end if - if (param%lencounter_sas_plpl) then - call encounter_check_all_sort_and_sweep_plpl(npl, x, v, renc, dt, nenc, index1, index2, lvdotr) - else + ! if (param%lencounter_sas_plpl) then + ! call encounter_check_all_sort_and_sweep_plpl(npl, x, v, renc, dt, nenc, index1, index2, lvdotr) + ! else call encounter_check_all_triangular_plpl(npl, x, v, renc, dt, nenc, index1, index2, lvdotr) - end if - - if (skipit) then - skipit = .false. - else - if (param%ladaptive_encounters_plpl .and. nplpl > 0) then - if (itimer%is_on) then - call itimer%adapt(param, nplpl) - skipit = .true. - end if - end if - end if + ! end if + + ! if (skipit) then + ! skipit = .false. + ! else + ! if (param%ladaptive_encounters_plpl .and. nplpl > 0) then + ! if (itimer%is_on) then + ! call itimer%adapt(param, nplpl) + ! skipit = .true. + ! end if + ! end if + ! end if return end subroutine encounter_check_all_plpl @@ -80,7 +80,7 @@ module subroutine encounter_check_all_plplm(param, nplm, nplt, xplm, vplm, xplt, !! implicit none ! Arguments - class(swiftest_parameters), intent(inout) :: param !! Current Swiftest run configuration parameter5s + class(base_parameters), intent(inout) :: param !! Current Swiftest run configuration parameter5s integer(I4B), intent(in) :: nplm !! Total number of fully interacting massive bodies integer(I4B), intent(in) :: nplt !! Total number of partially interacting masive bodies (GM < GMTINY) real(DP), dimension(:,:), intent(in) :: xplm !! Position vectors of fully interacting massive bodies @@ -95,7 +95,7 @@ module subroutine encounter_check_all_plplm(param, nplm, nplt, xplm, vplm, xplt, integer(I4B), dimension(:), allocatable, intent(out) :: index2 !! List of indices for body 2 in each encounter logical, dimension(:), allocatable, intent(out) :: lvdotr !! Logical flag indicating the sign of v .dot. x ! Internals - type(interaction_timer), save :: itimer + ! type(interaction_timer), save :: itimer logical, save :: lfirst = .true. logical, save :: skipit = .false. integer(I8B) :: nplplm = 0_I8B @@ -104,27 +104,27 @@ module subroutine encounter_check_all_plplm(param, nplm, nplt, xplm, vplm, xplt, integer(I4B), dimension(:), allocatable :: plmplt_index1 !! List of indices for body 1 in each encounter in the plm-plt group integer(I4B), dimension(:), allocatable :: plmplt_index2 !! List of indices for body 2 in each encounter in the plm-lt group integer(I8B) :: plmplt_nenc !! Number of encounters of the plm-plt group - class(swiftest_parameters), allocatable :: tmp_param !! Temporary parameter structure to turn off adaptive timer for the pl-pl phase if necessary + class(base_parameters), allocatable :: tmp_param !! Temporary parameter structure to turn off adaptive timer for the pl-pl phase if necessary integer(I8B), dimension(:), allocatable :: ind integer(I4B), dimension(:), allocatable :: itmp logical, dimension(:), allocatable :: ltmp - if (param%ladaptive_encounters_plpl .and. (.not. skipit)) then - npl = nplm + nplt - nplplm = nplm * npl - nplm * (nplm + 1) / 2 - if (nplplm > 0) then - if (lfirst) then - write(itimer%loopname, *) "encounter_check_all_plpl" - write(itimer%looptype, *) "ENCOUNTER_PLPL" - lfirst = .false. - itimer%step_counter = INTERACTION_TIMER_CADENCE - else - if (itimer%check(param, nplplm)) call itimer%time_this_loop(param, nplplm) - end if - else - param%lencounter_sas_plpl = .false. - end if - end if + ! if (param%ladaptive_encounters_plpl .and. (.not. skipit)) then + ! npl = nplm + nplt + ! nplplm = nplm * npl - nplm * (nplm + 1) / 2 + ! if (nplplm > 0) then + ! if (lfirst) then + ! write(itimer%loopname, *) "encounter_check_all_plpl" + ! write(itimer%looptype, *) "ENCOUNTER_PLPL" + ! lfirst = .false. + ! itimer%step_counter = INTERACTION_TIMER_CADENCE + ! else + ! if (itimer%io_netcdf_check(param, nplplm)) call itimer%time_this_loop(param, nplplm) + ! end if + ! else + ! param%lencounter_sas_plpl = .false. + ! end if + ! end if allocate(tmp_param, source=param) @@ -134,24 +134,24 @@ module subroutine encounter_check_all_plplm(param, nplm, nplt, xplm, vplm, xplt, ! Start with the pl-pl group call encounter_check_all_plpl(tmp_param, nplm, xplm, vplm, rencm, dt, nenc, index1, index2, lvdotr) - if (param%lencounter_sas_plpl) then - call encounter_check_all_sort_and_sweep_plplm(nplm, nplt, xplm, vplm, xplt, vplt, rencm, renct, dt, & - plmplt_nenc, plmplt_index1, plmplt_index2, plmplt_lvdotr) - else + ! if (param%lencounter_sas_plpl) then + ! call encounter_check_all_sort_and_sweep_plplm(nplm, nplt, xplm, vplm, xplt, vplt, rencm, renct, dt, & + ! plmplt_nenc, plmplt_index1, plmplt_index2, plmplt_lvdotr) + ! else call encounter_check_all_triangular_plplm(nplm, nplt, xplm, vplm, xplt, vplt, rencm, renct, dt, & plmplt_nenc, plmplt_index1, plmplt_index2, plmplt_lvdotr) - end if - - if (skipit) then - skipit = .false. - else - if (param%ladaptive_encounters_plpl .and. nplplm > 0) then - if (itimer%is_on) then - call itimer%adapt(param, nplplm) - skipit = .true. - end if - end if - end if + ! end if + + ! if (skipit) then + ! skipit = .false. + ! else + ! if (param%ladaptive_encounters_plpl .and. nplplm > 0) then + ! if (itimer%is_on) then + ! call itimer%adapt(param, nplplm) + ! skipit = .true. + ! end if + ! end if + ! end if if (plmplt_nenc > 0) then ! Consolidate the two lists allocate(itmp(nenc+plmplt_nenc)) @@ -187,7 +187,7 @@ module subroutine encounter_check_all_pltp(param, npl, ntp, xpl, vpl, xtp, vtp, !! implicit none ! Arguments - class(swiftest_parameters), intent(inout) :: param !! Current Swiftest run configuration parameter5s + class(base_parameters), intent(inout) :: param !! Current Swiftest run configuration parameter5s integer(I4B), intent(in) :: npl !! Total number of massive bodies integer(I4B), intent(in) :: ntp !! Total number of test particles real(DP), dimension(:,:), intent(in) :: xpl !! Position vectors of massive bodies @@ -201,42 +201,42 @@ module subroutine encounter_check_all_pltp(param, npl, ntp, xpl, vpl, xtp, vtp, integer(I4B), dimension(:), allocatable, intent(out) :: index2 !! List of indices for body 2 in each encounter logical, dimension(:), allocatable, intent(out) :: lvdotr !! Logical flag indicating the sign of v .dot. x ! Internals - type(interaction_timer), save :: itimer + ! type(interaction_timer), save :: itimer logical, save :: lfirst = .true. logical, save :: lsecond = .false. integer(I8B) :: npltp = 0_I8B - if (param%ladaptive_encounters_pltp) then - npltp = npl * ntp - if (npltp > 0) then - if (lfirst) then - write(itimer%loopname, *) "encounter_check_all_pltp" - write(itimer%looptype, *) "ENCOUNTER_PLTP" - lfirst = .false. - lsecond = .true. - else - if (lsecond) then ! This ensures that the encounter check methods are run at least once prior to timing. Sort and sweep improves on the second pass due to the bounding box extents needing to be nearly sorted - call itimer%time_this_loop(param, npltp) - lsecond = .false. - else if (itimer%check(param, npltp)) then - lsecond = .true. - itimer%is_on = .false. - end if - end if - else - param%lencounter_sas_pltp = .false. - end if - end if - - if (param%lencounter_sas_pltp) then - call encounter_check_all_sort_and_sweep_pltp(npl, ntp, xpl, vpl, xtp, vtp, renc, dt, nenc, index1, index2, lvdotr) - else + ! if (param%ladaptive_encounters_pltp) then + ! npltp = npl * ntp + ! if (npltp > 0) then + ! if (lfirst) then + ! write(itimer%loopname, *) "encounter_check_all_pltp" + ! write(itimer%looptype, *) "ENCOUNTER_PLTP" + ! lfirst = .false. + ! lsecond = .true. + ! else + ! if (lsecond) then ! This ensures that the encounter check methods are run at least once prior to timing. Sort and sweep improves on the second pass due to the bounding box extents needing to be nearly sorted + ! call itimer%time_this_loop(param, npltp) + ! lsecond = .false. + ! else if (itimer%io_netcdf_check(param, npltp)) then + ! lsecond = .true. + ! itimer%is_on = .false. + ! end if + ! end if + ! else + ! param%lencounter_sas_pltp = .false. + ! end if + ! end if + + ! if (param%lencounter_sas_pltp) then + ! call encounter_check_all_sort_and_sweep_pltp(npl, ntp, xpl, vpl, xtp, vtp, renc, dt, nenc, index1, index2, lvdotr) + ! else call encounter_check_all_triangular_pltp(npl, ntp, xpl, vpl, xtp, vtp, renc, dt, nenc, index1, index2, lvdotr) - end if + ! end if - if (.not.lfirst .and. param%ladaptive_encounters_pltp .and. npltp > 0) then - if (itimer%is_on) call itimer%adapt(param, npltp) - end if + ! if (.not.lfirst .and. param%ladaptive_encounters_pltp .and. npltp > 0) then + ! if (itimer%is_on) call itimer%adapt(param, npltp) + ! end if return end subroutine encounter_check_all_pltp @@ -514,7 +514,7 @@ pure subroutine encounter_check_all_triangular_one(i, n, xi, yi, zi, vxi, vyi, v real(DP), dimension(:), intent(in) :: renc !! Array of encounter radii of all bodies real(DP), intent(in) :: dt !! Step size integer(I4B), dimension(:), intent(in) :: ind_arr !! Index array [1, 2, ..., n] - type(encounter_list), intent(out) :: lenci !! Output encounter lists containing number of encounters, the v.dot.r direction array, and the index list of encountering bodies + class(encounter_list), intent(out) :: lenci !! Output encounter lists containing number of encounters, the v.dot.r direction array, and the index list of encountering bodies ! Internals integer(I4B) :: j integer(I8B) :: nenci @@ -563,7 +563,7 @@ subroutine encounter_check_all_triangular_plpl(npl, x, v, renc, dt, nenc, index1 ! Internals integer(I4B) :: i integer(I4B), dimension(:), allocatable, save :: ind_arr - type(encounter_list), dimension(npl) :: lenc + type(collision_list_plpl), dimension(npl) :: lenc call util_index_array(ind_arr, npl) @@ -610,7 +610,7 @@ subroutine encounter_check_all_triangular_plplm(nplm, nplt, xplm, vplm, xplt, vp ! Internals integer(I4B) :: i integer(I4B), dimension(:), allocatable, save :: ind_arr - type(encounter_list), dimension(nplm) :: lenc + type(collision_list_plpl), dimension(nplm) :: lenc call util_index_array(ind_arr, nplt) @@ -656,7 +656,7 @@ subroutine encounter_check_all_triangular_pltp(npl, ntp, xpl, vpl, xtp, vtp, ren ! Internals integer(I4B) :: i integer(I4B), dimension(:), allocatable, save :: ind_arr - type(encounter_list), dimension(npl) :: lenc + type(collision_list_pltp), dimension(npl) :: lenc real(DP), dimension(ntp) :: renct call util_index_array(ind_arr, ntp) @@ -734,7 +734,7 @@ module subroutine encounter_check_collapse_ragged_list(ragged_list, n1, nenc, in !! Collapses a ragged index list (one encounter list per body) into a pair of index arrays and a vdotr logical array (optional) implicit none ! Arguments - type(encounter_list), dimension(:), intent(in) :: ragged_list !! The ragged encounter list + class(encounter_list), dimension(:), intent(in) :: ragged_list !! The ragged encounter list integer(I4B), intent(in) :: n1 !! Number of bodies 1 integer(I8B), intent(out) :: nenc !! Total number of encountersj integer(I4B), dimension(:), allocatable, intent(out) :: index1 !! Array of indices for body 1 @@ -917,7 +917,7 @@ module subroutine encounter_check_sweep_aabb_double_list(self, n1, n2, r1, v1, r logical, dimension(SWEEPDIM,n1+n2) :: loverlap_by_dimension logical, dimension(SWEEPDIM,2*(n1+n2)) :: llist1 integer(I4B), dimension(SWEEPDIM,2*(n1+n2)) :: ext_ind - type(encounter_list), dimension(n1+n2) :: lenc !! Array of encounter lists (one encounter list per body) + type(collision_list_pltp), dimension(n1+n2) :: lenc !! Array of encounter lists (one encounter list per body) integer(I4B), dimension(:), allocatable, save :: ind_arr integer(I8B) :: ibeg, iend real(DP), dimension(2*(n1+n2)) :: xind, yind, zind, vxind, vyind, vzind, rencind @@ -1012,7 +1012,7 @@ module subroutine encounter_check_sweep_aabb_single_list(self, n, x, v, renc, dt !! author: David A. Minton !! !! Sweeps the sorted bounding box extents and returns the true encounters (combines broad and narrow phases) - !! Double list version (e.g. pl-tp or plm-plt) + !! Single list version (e.g. pl-pl) implicit none ! Arguments class(encounter_bounding_box), intent(inout) :: self !! Multi-dimensional bounding box structure @@ -1031,7 +1031,7 @@ module subroutine encounter_check_sweep_aabb_single_list(self, n, x, v, renc, dt logical, dimension(2*n) :: lencounteri real(DP), dimension(2*n) :: xind, yind, zind, vxind, vyind, vzind, rencind integer(I4B), dimension(SWEEPDIM,2*n) :: ext_ind - type(encounter_list), dimension(n) :: lenc !! Array of encounter lists (one encounter list per body) + type(collision_list_plpl), dimension(n) :: lenc !! Array of encounter lists (one encounter list per body) integer(I4B), dimension(:), allocatable, save :: ind_arr integer(I8B) :: ibeg, iend diff --git a/src/encounter/encounter_io.f90 b/src/encounter/encounter_io.f90 index 70b782948..b92b9a2fd 100644 --- a/src/encounter/encounter_io.f90 +++ b/src/encounter/encounter_io.f90 @@ -7,7 +7,7 @@ !! You should have received a copy of the GNU General Public License along with Swiftest. !! If not, see: https://www.gnu.org/licenses. -submodule (encounter_classes) s_encounter_io +submodule (encounter) s_encounter_io use swiftest contains @@ -18,7 +18,7 @@ module subroutine encounter_io_dump(self, param) implicit none ! Arguments class(encounter_storage(*)), intent(inout) :: self !! Encounter storage object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + class(base_parameters), intent(inout) :: param !! Current run configuration parameters ! Internals integer(I4B) :: i @@ -38,7 +38,7 @@ module subroutine encounter_io_dump(self, param) select type(snapshot => self%frame(i)%item) class is (encounter_snapshot) param%ioutput = self%tmap(i) - call snapshot%write_frame(nc,param) + call snapshot%write_frame(self,param) end select else exit @@ -63,7 +63,7 @@ module subroutine encounter_io_initialize_output(self, param) 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 + class(base_parameters), intent(in) :: param !! Current run configuration parameters ! Internals integer(I4B) :: nvar, varid, vartype real(DP) :: dfill @@ -91,54 +91,54 @@ module subroutine encounter_io_initialize_output(self, param) close(unit=LUN, status="delete") end if - call check( nf90_create(nc%file_name, NF90_NETCDF4, nc%id), "encounter_io_initialize_output nf90_create" ) + call netcdf_check( nf90_create(nc%file_name, NF90_NETCDF4, nc%id), "encounter_io_initialize_output nf90_create" ) ! Dimensions - call check( nf90_def_dim(nc%id, nc%time_dimname, nc%time_dimsize, nc%time_dimid), "encounter_io_initialize_output nf90_def_dim time_dimid" ) ! Simulation time dimension - call check( nf90_def_dim(nc%id, nc%space_dimname, NDIM, nc%space_dimid), "encounter_io_initialize_output nf90_def_dim space_dimid" ) ! 3D space dimension - call check( nf90_def_dim(nc%id, nc%name_dimname, nc%name_dimsize, nc%name_dimid), "encounter_io_initialize_output nf90_def_dim name_dimid" ) ! dimension to store particle id numbers - call check( nf90_def_dim(nc%id, nc%str_dimname, NAMELEN, nc%str_dimid), "encounter_io_initialize_output nf90_def_dim str_dimid" ) ! Dimension for string variables (aka character arrays) + call netcdf_check( nf90_def_dim(nc%id, nc%time_dimname, nc%time_dimsize, nc%time_dimid), "encounter_io_initialize_output nf90_def_dim time_dimid" ) ! Simulation time dimension + call netcdf_check( nf90_def_dim(nc%id, nc%space_dimname, NDIM, nc%space_dimid), "encounter_io_initialize_output nf90_def_dim space_dimid" ) ! 3D space dimension + call netcdf_check( nf90_def_dim(nc%id, nc%name_dimname, nc%name_dimsize, nc%name_dimid), "encounter_io_initialize_output nf90_def_dim name_dimid" ) ! dimension to store particle id numbers + call netcdf_check( nf90_def_dim(nc%id, nc%str_dimname, NAMELEN, nc%str_dimid), "encounter_io_initialize_output nf90_def_dim str_dimid" ) ! Dimension for string variables (aka character arrays) ! Dimension coordinates - call check( nf90_def_var(nc%id, nc%time_dimname, nc%out_type, nc%time_dimid, nc%time_varid), "encounter_io_initialize_output nf90_def_var time_varid" ) - call check( nf90_def_var(nc%id, nc%space_dimname, NF90_CHAR, nc%space_dimid, nc%space_varid), "encounter_io_initialize_output nf90_def_var space_varid" ) - call check( nf90_def_var(nc%id, nc%name_dimname, NF90_CHAR, [nc%str_dimid, nc%name_dimid], nc%name_varid), "encounter_io_initialize_output nf90_def_var id_varid" ) + call netcdf_check( nf90_def_var(nc%id, nc%time_dimname, nc%out_type, nc%time_dimid, nc%time_varid), "encounter_io_initialize_output nf90_def_var time_varid" ) + call netcdf_check( nf90_def_var(nc%id, nc%space_dimname, NF90_CHAR, nc%space_dimid, nc%space_varid), "encounter_io_initialize_output nf90_def_var space_varid" ) + call netcdf_check( nf90_def_var(nc%id, nc%name_dimname, NF90_CHAR, [nc%str_dimid, nc%name_dimid], nc%name_varid), "encounter_io_initialize_output nf90_def_var id_varid" ) ! Variables - call check( nf90_def_var(nc%id, nc%id_varname, NF90_INT, nc%name_dimid, nc%id_varid), "encounter_io_initialize_output nf90_def_var id_varid" ) - call check( nf90_def_var(nc%id, nc%ptype_varname, NF90_CHAR, [nc%str_dimid, nc%name_dimid], nc%ptype_varid), "encounter_io_initialize_output nf90_def_var ptype_varid" ) - call check( nf90_def_var(nc%id, nc%rh_varname, nc%out_type, [nc%space_dimid, nc%name_dimid, nc%time_dimid], nc%rh_varid), "encounter_io_initialize_output nf90_def_var rh_varid" ) - call check( nf90_def_var(nc%id, nc%vh_varname, nc%out_type, [nc%space_dimid, nc%name_dimid, nc%time_dimid], nc%vh_varid), "encounter_io_initialize_output nf90_def_var vh_varid" ) - call check( nf90_def_var(nc%id, nc%Gmass_varname, nc%out_type, [nc%name_dimid, nc%time_dimid], nc%Gmass_varid), "encounter_io_initialize_output nf90_def_var Gmass_varid" ) - call check( nf90_def_var(nc%id, nc%loop_varname, NF90_INT, [nc%time_dimid], nc%loop_varid), "encounter_io_initialize_output nf90_def_var loop_varid" ) + call netcdf_check( nf90_def_var(nc%id, nc%id_varname, NF90_INT, nc%name_dimid, nc%id_varid), "encounter_io_initialize_output nf90_def_var id_varid" ) + call netcdf_check( nf90_def_var(nc%id, nc%ptype_varname, NF90_CHAR, [nc%str_dimid, nc%name_dimid], nc%ptype_varid), "encounter_io_initialize_output nf90_def_var ptype_varid" ) + call netcdf_check( nf90_def_var(nc%id, nc%rh_varname, nc%out_type, [nc%space_dimid, nc%name_dimid, nc%time_dimid], nc%rh_varid), "encounter_io_initialize_output nf90_def_var rh_varid" ) + call netcdf_check( nf90_def_var(nc%id, nc%vh_varname, nc%out_type, [nc%space_dimid, nc%name_dimid, nc%time_dimid], nc%vh_varid), "encounter_io_initialize_output nf90_def_var vh_varid" ) + call netcdf_check( nf90_def_var(nc%id, nc%Gmass_varname, nc%out_type, [nc%name_dimid, nc%time_dimid], nc%Gmass_varid), "encounter_io_initialize_output nf90_def_var Gmass_varid" ) + call netcdf_check( nf90_def_var(nc%id, nc%loop_varname, NF90_INT, [nc%time_dimid], nc%loop_varid), "encounter_io_initialize_output nf90_def_var loop_varid" ) if (param%lclose) then - call check( nf90_def_var(nc%id, nc%radius_varname, nc%out_type, [nc%name_dimid, nc%time_dimid], nc%radius_varid), "encounter_io_initialize_output nf90_def_var radius_varid" ) + call netcdf_check( nf90_def_var(nc%id, nc%radius_varname, nc%out_type, [nc%name_dimid, nc%time_dimid], nc%radius_varid), "encounter_io_initialize_output nf90_def_var radius_varid" ) end if if (param%lrotation) then - call check( nf90_def_var(nc%id, nc%Ip_varname, nc%out_type, [nc%space_dimid, nc%name_dimid, nc%time_dimid], nc%Ip_varid), "encounter_io_initialize_output nf90_def_var Ip_varid" ) - call check( nf90_def_var(nc%id, nc%rot_varname, nc%out_type, [nc%space_dimid, nc%name_dimid, nc%time_dimid], nc%rot_varid), "encounter_io_initialize_output nf90_def_var rot_varid" ) + call netcdf_check( nf90_def_var(nc%id, nc%Ip_varname, nc%out_type, [nc%space_dimid, nc%name_dimid, nc%time_dimid], nc%Ip_varid), "encounter_io_initialize_output nf90_def_var Ip_varid" ) + call netcdf_check( nf90_def_var(nc%id, nc%rot_varname, nc%out_type, [nc%space_dimid, nc%name_dimid, nc%time_dimid], nc%rot_varid), "encounter_io_initialize_output nf90_def_var rot_varid" ) end if - call check( nf90_inquire(nc%id, nVariables=nvar), "encounter_io_initialize_output nf90_inquire nVariables" ) + call netcdf_check( nf90_inquire(nc%id, nVariables=nvar), "encounter_io_initialize_output nf90_inquire nVariables" ) do varid = 1, nvar - call check( nf90_inquire_variable(nc%id, varid, xtype=vartype, ndims=ndims), "encounter_io_initialize_output nf90_inquire_variable" ) + call netcdf_check( nf90_inquire_variable(nc%id, varid, xtype=vartype, ndims=ndims), "encounter_io_initialize_output nf90_inquire_variable" ) select case(vartype) case(NF90_INT) - call check( nf90_def_var_fill(nc%id, varid, NO_FILL, NF90_FILL_INT), "encounter_io_initialize_output nf90_def_var_fill NF90_INT" ) + call netcdf_check( nf90_def_var_fill(nc%id, varid, NO_FILL, NF90_FILL_INT), "encounter_io_initialize_output nf90_def_var_fill NF90_INT" ) case(NF90_FLOAT) - call check( nf90_def_var_fill(nc%id, varid, NO_FILL, sfill), "encounter_io_initialize_output nf90_def_var_fill NF90_FLOAT" ) + call netcdf_check( nf90_def_var_fill(nc%id, varid, NO_FILL, sfill), "encounter_io_initialize_output nf90_def_var_fill NF90_FLOAT" ) case(NF90_DOUBLE) - call check( nf90_def_var_fill(nc%id, varid, NO_FILL, dfill), "encounter_io_initialize_output nf90_def_var_fill NF90_DOUBLE" ) + call netcdf_check( nf90_def_var_fill(nc%id, varid, NO_FILL, dfill), "encounter_io_initialize_output nf90_def_var_fill NF90_DOUBLE" ) case(NF90_CHAR) - call check( nf90_def_var_fill(nc%id, varid, NO_FILL, 0), "encounter_io_initialize_output nf90_def_var_fill NF90_CHAR" ) + call netcdf_check( nf90_def_var_fill(nc%id, varid, NO_FILL, 0), "encounter_io_initialize_output nf90_def_var_fill NF90_CHAR" ) end select end do ! Take the file out of define mode - call check( nf90_enddef(nc%id), "encounter_io_initialize_output nf90_enddef" ) + call netcdf_check( nf90_enddef(nc%id), "encounter_io_initialize_output nf90_enddef" ) ! Add in the space dimension coordinates - call check( nf90_put_var(nc%id, nc%space_varid, nc%space_coords, start=[1], count=[NDIM]), "encounter_io_initialize_output nf90_put_var space" ) + call netcdf_check( nf90_put_var(nc%id, nc%space_varid, nc%space_coords, start=[1], count=[NDIM]), "encounter_io_initialize_output nf90_put_var space" ) end associate @@ -150,67 +150,74 @@ module subroutine encounter_io_initialize_output(self, param) end subroutine encounter_io_initialize_output - module subroutine encounter_io_write_frame_snapshot(self, nc, param) + module subroutine encounter_io_write_frame_snapshot(self, history, param) !! author: David A. Minton !! !! Write a frame of output of an encounter trajectory. use netcdf implicit none ! Arguments - class(encounter_snapshot), intent(in) :: self !! Swiftest encounter structure - class(netcdf_parameters), intent(inout) :: nc !! Parameters used to identify a particular encounter io NetCDF dataset - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + class(encounter_snapshot), intent(in) :: self !! Swiftest encounter structure + class(encounter_storage(*)), intent(inout) :: history !! Encounter storage object + class(base_parameters), intent(inout) :: param !! Current run configuration parameters + ! Internals integer(I4B) :: i, idslot, old_mode, npl, ntp character(len=:), allocatable :: charstring - select type (nc) + select type(param) + class is (swiftest_parameters) + select type(pl => self%pl) + class is (swiftest_pl) + select type(tp => self%tp) + class is (swiftest_pl) + select type (nc => history%nc) class is (encounter_io_parameters) - select type (param) - class is (symba_parameters) - associate(pl => self%pl, tp => self%tp, encounter_history => param%encounter_history, tslot => param%ioutput) - call check( nf90_set_fill(nc%id, nf90_nofill, old_mode), "encounter_io_write_frame_snapshot nf90_set_fill" ) - - call check( nf90_put_var(nc%id, nc%time_varid, self%t, start=[tslot]), "encounter_io_write_frame_snapshot nf90_put_var time_varid" ) - call check( nf90_put_var(nc%id, nc%loop_varid, int(self%iloop,kind=I4B), start=[tslot]), "encounter_io_write_frame_snapshot nf90_put_var pl loop_varid" ) - - npl = pl%nbody - do i = 1, npl - idslot = findloc(encounter_history%idvals,pl%id(i),dim=1) - call check( nf90_put_var(nc%id, nc%id_varid, pl%id(i), start=[idslot]), "encounter_io_write_frame_snapshot nf90_put_var pl id_varid" ) - call check( nf90_put_var(nc%id, nc%rh_varid, pl%rh(:,i), start=[1,idslot,tslot], count=[NDIM,1,1]), "encounter_io_write_frame_snapshot nf90_put_var pl rh_varid" ) - call check( nf90_put_var(nc%id, nc%vh_varid, pl%vh(:,i), start=[1,idslot,tslot], count=[NDIM,1,1]), "encounter_io_write_frame_snapshot nf90_put_var pl vh_varid" ) - call check( nf90_put_var(nc%id, nc%Gmass_varid, pl%Gmass(i), start=[idslot, tslot]), "encounter_io_write_frame_snapshot nf90_put_var pl Gmass_varid" ) - - if (param%lclose) call check( nf90_put_var(nc%id, nc%radius_varid, pl%radius(i), start=[idslot, tslot]), "encounter_io_write_frame_snapshot nf90_put_var pl radius_varid" ) - - if (param%lrotation) then - call check( nf90_put_var(nc%id, nc%Ip_varid, pl%Ip(:,i), start=[1, idslot, tslot], count=[NDIM,1,1]), "encounter_io_write_frame_snapshot nf90_put_var pl Ip_varid" ) - call check( nf90_put_var(nc%id, nc%rot_varid, pl%rot(:,i), start=[1,idslot, tslot], count=[NDIM,1,1]), "encounter_io_write_frame_snapshot nf90_put_var pl rotx_varid" ) - end if - - charstring = trim(adjustl(pl%info(i)%name)) - call check( nf90_put_var(nc%id, nc%name_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "encounter_io_write_frame_snapshot nf90_put_var pl name_varid" ) - charstring = trim(adjustl(pl%info(i)%particle_type)) - call check( nf90_put_var(nc%id, nc%ptype_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "encounter_io_write_frame_snapshot nf90_put_var pl particle_type_varid" ) - end do - - ntp = tp%nbody - do i = 1, ntp - idslot = findloc(param%encounter_history%idvals,tp%id(i),dim=1) - call check( nf90_put_var(nc%id, nc%id_varid, tp%id(i), start=[idslot]), "encounter_io_write_frame_snapshot nf90_put_var tp id_varid" ) - call check( nf90_put_var(nc%id, nc%rh_varid, tp%rh(:,i), start=[1,idslot,tslot], count=[NDIM,1,1]), "encounter_io_write_frame_snapshot nf90_put_var tp rh_varid" ) - call check( nf90_put_var(nc%id, nc%vh_varid, tp%vh(:,i), start=[1,idslot,tslot], count=[NDIM,1,1]), "encounter_io_write_frame_snapshot nf90_put_var tp vh_varid" ) - - charstring = trim(adjustl(tp%info(i)%name)) - call check( nf90_put_var(nc%id, nc%name_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "encounter_io_write_frame_snapshot nf90_put_var tp name_varid" ) - charstring = trim(adjustl(tp%info(i)%particle_type)) - call check( nf90_put_var(nc%id, nc%ptype_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "encounter_io_write_frame_snapshot nf90_put_var tp particle_type_varid" ) - end do - - call check( nf90_set_fill(nc%id, old_mode, old_mode) ) - end associate - end select + associate(tslot => param%ioutput) + call netcdf_check( nf90_set_fill(nc%id, nf90_nofill, old_mode), "encounter_io_write_frame_snapshot nf90_set_fill" ) + + call netcdf_check( nf90_put_var(nc%id, nc%time_varid, self%t, start=[tslot]), "encounter_io_write_frame_snapshot nf90_put_var time_varid" ) + call netcdf_check( nf90_put_var(nc%id, nc%loop_varid, int(self%iloop,kind=I4B), start=[tslot]), "encounter_io_write_frame_snapshot nf90_put_var pl loop_varid" ) + + npl = pl%nbody + do i = 1, npl + idslot = findloc(history%idvals,pl%id(i),dim=1) + call netcdf_check( nf90_put_var(nc%id, nc%id_varid, pl%id(i), start=[idslot]), "encounter_io_write_frame_snapshot nf90_put_var pl id_varid" ) + call netcdf_check( nf90_put_var(nc%id, nc%rh_varid, pl%rh(:,i), start=[1,idslot,tslot], count=[NDIM,1,1]), "encounter_io_write_frame_snapshot nf90_put_var pl rh_varid" ) + call netcdf_check( nf90_put_var(nc%id, nc%vh_varid, pl%vh(:,i), start=[1,idslot,tslot], count=[NDIM,1,1]), "encounter_io_write_frame_snapshot nf90_put_var pl vh_varid" ) + call netcdf_check( nf90_put_var(nc%id, nc%Gmass_varid, pl%Gmass(i), start=[idslot, tslot]), "encounter_io_write_frame_snapshot nf90_put_var pl Gmass_varid" ) + + if (param%lclose) call netcdf_check( nf90_put_var(nc%id, nc%radius_varid, pl%radius(i), start=[idslot, tslot]), "encounter_io_write_frame_snapshot nf90_put_var pl radius_varid" ) + + if (param%lrotation) then + call netcdf_check( nf90_put_var(nc%id, nc%Ip_varid, pl%Ip(:,i), start=[1, idslot, tslot], count=[NDIM,1,1]), "encounter_io_write_frame_snapshot nf90_put_var pl Ip_varid" ) + call netcdf_check( nf90_put_var(nc%id, nc%rot_varid, pl%rot(:,i), start=[1,idslot, tslot], count=[NDIM,1,1]), "encounter_io_write_frame_snapshot nf90_put_var pl rotx_varid" ) + end if + + charstring = trim(adjustl(pl%info(i)%name)) + call netcdf_check( nf90_put_var(nc%id, nc%name_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "encounter_io_write_frame_snapshot nf90_put_var pl name_varid" ) + charstring = trim(adjustl(pl%info(i)%particle_type)) + call netcdf_check( nf90_put_var(nc%id, nc%ptype_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "encounter_io_write_frame_snapshot nf90_put_var pl particle_type_varid" ) + end do + + ntp = tp%nbody + do i = 1, ntp + idslot = findloc(history%idvals,tp%id(i),dim=1) + call netcdf_check( nf90_put_var(nc%id, nc%id_varid, tp%id(i), start=[idslot]), "encounter_io_write_frame_snapshot nf90_put_var tp id_varid" ) + call netcdf_check( nf90_put_var(nc%id, nc%rh_varid, tp%rh(:,i), start=[1,idslot,tslot], count=[NDIM,1,1]), "encounter_io_write_frame_snapshot nf90_put_var tp rh_varid" ) + call netcdf_check( nf90_put_var(nc%id, nc%vh_varid, tp%vh(:,i), start=[1,idslot,tslot], count=[NDIM,1,1]), "encounter_io_write_frame_snapshot nf90_put_var tp vh_varid" ) + + charstring = trim(adjustl(tp%info(i)%name)) + call netcdf_check( nf90_put_var(nc%id, nc%name_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "encounter_io_write_frame_snapshot nf90_put_var tp name_varid" ) + charstring = trim(adjustl(tp%info(i)%particle_type)) + call netcdf_check( nf90_put_var(nc%id, nc%ptype_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "encounter_io_write_frame_snapshot nf90_put_var tp particle_type_varid" ) + end do + + call netcdf_check( nf90_set_fill(nc%id, old_mode, old_mode) ) + end associate + end select + end select + end select end select return diff --git a/src/encounter/encounter_setup.f90 b/src/encounter/encounter_setup.f90 index 18b60d229..aff1bd626 100644 --- a/src/encounter/encounter_setup.f90 +++ b/src/encounter/encounter_setup.f90 @@ -7,7 +7,7 @@ !! You should have received a copy of the GNU General Public License along with Swiftest. !! If not, see: https://www.gnu.org/licenses. -submodule (encounter_classes) s_encounter_setup +submodule (encounter) s_encounter_setup use swiftest contains @@ -72,6 +72,7 @@ module subroutine encounter_setup_list(self, n) if (n == 0_I8B) return self%t = 0.0_DP + allocate(self%tcollision(n)) allocate(self%lvdotr(n)) allocate(self%lclosest(n)) allocate(self%status(n)) @@ -84,6 +85,7 @@ module subroutine encounter_setup_list(self, n) allocate(self%v1(NDIM,n)) allocate(self%v2(NDIM,n)) + self%tcollision(:) = 0.0_DP self%lvdotr(:) = .false. self%lclosest(:) = .false. self%status(:) = INACTIVE diff --git a/src/encounter/encounter_util.f90 b/src/encounter/encounter_util.f90 index 4c472c4b3..8dc63201e 100644 --- a/src/encounter/encounter_util.f90 +++ b/src/encounter/encounter_util.f90 @@ -7,7 +7,7 @@ !! You should have received a copy of the GNU General Public License along with Swiftest. !! If not, see: https://www.gnu.org/licenses. -submodule (encounter_classes) s_encounter_util +submodule (encounter) s_encounter_util use swiftest contains @@ -96,6 +96,7 @@ module subroutine encounter_util_dealloc_list(self) ! Arguments class(encounter_list), intent(inout) :: self + if (allocated(self%tcollision)) deallocate(self%tcollision) if (allocated(self%lvdotr)) deallocate(self%lvdotr) if (allocated(self%lclosest)) deallocate(self%lclosest) if (allocated(self%status)) deallocate(self%status) @@ -126,20 +127,6 @@ module subroutine encounter_util_final_aabb(self) end subroutine encounter_util_final_aabb - module subroutine encounter_util_final_list(self) - !! author: David A. Minton - !! - !! Finalize the encounter list - deallocates all allocatables - implicit none - ! Arguments - type(encounter_list), intent(inout) :: self - - call self%dealloc() - - return - end subroutine encounter_util_final_list - - module subroutine encounter_util_final_snapshot(self) !! author: David A. Minton !! @@ -163,8 +150,14 @@ module subroutine encounter_util_final_storage(self) implicit none ! Arguments type(encounter_storage(*)), intent(inout) :: self !! Encounter storage object + ! Internals + integer(I4B) :: i + + do i = 1, self%nframes + if (allocated(self%frame(i)%item)) deallocate(self%frame(i)%item) + end do - call util_final_storage(self%swiftest_storage) + return return end subroutine encounter_util_final_storage @@ -181,22 +174,29 @@ module subroutine encounter_util_get_idvalues_snapshot(self, idvals) ! Internals integer(I4B) :: npl, ntp - if (allocated(self%pl)) then - npl = self%pl%nbody - else - npl = 0 - end if - if (allocated(self%tp)) then - ntp = self%tp%nbody - else - ntp = 0 - end if + select type(pl => self%pl) + class is (swiftest_pl) + select type(tp => self%tp) + class is (swiftest_tp) + if (allocated(self%pl)) then + npl = pl%nbody + else + npl = 0 + end if + + if (allocated(self%tp)) then + ntp = tp%nbody + else + ntp = 0 + end if - if (npl + ntp == 0) return - allocate(idvals(npl+ntp)) + if (npl + ntp == 0) return + allocate(idvals(npl+ntp)) - if (npl > 0) idvals(1:npl) = self%pl%id(:) - if (ntp >0) idvals(npl+1:npl+ntp) = self%tp%id(:) + if (npl > 0) idvals(1:npl) = pl%id(:) + if (ntp >0) idvals(npl+1:npl+ntp) = tp%id(:) + end select + end select return @@ -372,7 +372,7 @@ subroutine encounter_util_save_snapshot(encounter_history, snapshot) !! Memory usage grows by a factor of 2 each time it fills up, but no more. implicit none ! Arguments - type(encounter_storage(*)), allocatable, intent(inout) :: encounter_history !! SyMBA encounter storage object + class(encounter_storage(*)), allocatable, intent(inout) :: encounter_history !! SyMBA encounter storage object class(encounter_snapshot), intent(in) :: snapshot !! Encounter snapshot object ! Internals type(encounter_storage(nframes=:)), allocatable :: tmp @@ -415,11 +415,12 @@ module subroutine encounter_util_snapshot(self, param, system, t, arg) !! !! Takes a minimal snapshot of the state of the system during an encounter so that the trajectories !! can be played back through the encounter + use symba implicit none ! Internals class(encounter_storage(*)), intent(inout) :: self !! Swiftest storage object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object to store + class(base_parameters), intent(inout) :: param !! Current run configuration parameters + class(base_nbody_system), intent(inout) :: system !! Swiftest nbody system object to store real(DP), intent(in), optional :: t !! Time of snapshot if different from system time character(*), intent(in), optional :: arg !! Optional argument (needed for extended storage type used in collision snapshots) ! Arguments @@ -440,164 +441,194 @@ module subroutine encounter_util_snapshot(self, param, system, t, arg) end if select type(param) - class is (symba_parameters) - select type (system) - class is (symba_nbody_system) - select type(pl => system%pl) - class is (symba_pl) - select type (tp => system%tp) - class is (symba_tp) - associate(npl => pl%nbody, ntp => tp%nbody) - if (npl + ntp == 0) return - allocate(encounter_snapshot :: snapshot) - allocate(snapshot%pl, mold=pl) - allocate(snapshot%tp, mold=tp) - snapshot%iloop = param%iloop - - select type(pl_snap => snapshot%pl) - class is (symba_pl) - select type(tp_snap => snapshot%tp) + class is (swiftest_parameters) + select type (system) + class is (swiftest_nbody_system) + select type (pl => system%pl) + class is (swiftest_pl) + select type (tp => system%tp) + class is (swiftest_tp) + associate(npl => pl%nbody, ntp => tp%nbody) + if (npl + ntp == 0) return + allocate(encounter_snapshot :: snapshot) + allocate(snapshot%pl, mold=pl) + allocate(snapshot%tp, mold=tp) + snapshot%iloop = param%iloop + + select type(pl_snap => snapshot%pl) + class is (swiftest_pl) + select type(tp_snap => snapshot%tp) + class is (swiftest_tp) + + select case(arg) + case("trajectory") + snapshot%t = t + + npl_snap = npl + ntp_snap = ntp + + if (npl > 0) then + pl%lmask(1:npl) = pl%status(1:npl) /= INACTIVE + select type(pl) + class is (symba_pl) + select type(system) + class is (symba_nbody_system) + pl%lmask(1:npl) = pl%lmask(1:npl) .and. pl%levelg(1:npl) == system%irec + end select + end select + npl_snap = count(pl%lmask(1:npl)) + end if + if (ntp > 0) then + tp%lmask(1:ntp) = tp%status(1:ntp) /= INACTIVE + select type(tp) class is (symba_tp) + select type(system) + class is (symba_nbody_system) + tp%lmask(1:ntp) = tp%lmask(1:ntp) .and. tp%levelg(1:ntp) == system%irec + end select + end select + ntp_snap = count(tp%lmask(1:ntp)) + end if - select case(arg) - case("trajectory") - snapshot%t = t - - npl_snap = npl - ntp_snap = ntp - - if (npl > 0) then - pl%lmask(1:npl) = pl%status(1:npl) /= INACTIVE .and. pl%levelg(1:npl) == system%irec - npl_snap = count(pl%lmask(1:npl)) - end if - if (ntp > 0) then - tp%lmask(1:ntp) = tp%status(1:ntp) /= INACTIVE .and. tp%levelg(1:ntp) == system%irec - ntp_snap = count(tp%lmask(1:ntp)) - end if + if (npl_snap + ntp_snap == 0) return ! Nothing to snapshot - if (npl_snap + ntp_snap == 0) return ! Nothing to snapshot - - pl_snap%nbody = npl_snap - - ! Take snapshot of the currently encountering massive bodies - if (npl_snap > 0) then - call pl_snap%setup(npl_snap, param) - pl_snap%levelg(:) = pack(pl%levelg(1:npl), pl%lmask(1:npl)) - pl_snap%id(:) = pack(pl%id(1:npl), pl%lmask(1:npl)) - pl_snap%info(:) = pack(pl%info(1:npl), pl%lmask(1:npl)) - pl_snap%Gmass(:) = pack(pl%Gmass(1:npl), pl%lmask(1:npl)) - do i = 1, NDIM - pl_snap%rh(i,:) = pack(pl%rh(i,1:npl), pl%lmask(1:npl)) - pl_snap%vh(i,:) = pack(pl%vb(i,1:npl), pl%lmask(1:npl)) - end do - if (param%lclose) then - pl_snap%radius(:) = pack(pl%radius(1:npl), pl%lmask(1:npl)) - end if + pl_snap%nbody = npl_snap + + ! Take snapshot of the currently encountering massive bodies + if (npl_snap > 0) then + call pl_snap%setup(npl_snap, param) + select type (pl) + class is (symba_pl) + select type(pl_snap) + class is (symba_pl) + pl_snap%levelg(:) = pack(pl%levelg(1:npl), pl%lmask(1:npl)) + end select + end select + pl_snap%id(:) = pack(pl%id(1:npl), pl%lmask(1:npl)) + pl_snap%info(:) = pack(pl%info(1:npl), pl%lmask(1:npl)) + pl_snap%Gmass(:) = pack(pl%Gmass(1:npl), pl%lmask(1:npl)) + do i = 1, NDIM + pl_snap%rh(i,:) = pack(pl%rh(i,1:npl), pl%lmask(1:npl)) + pl_snap%vh(i,:) = pack(pl%vb(i,1:npl), pl%lmask(1:npl)) + end do + if (param%lclose) then + pl_snap%radius(:) = pack(pl%radius(1:npl), pl%lmask(1:npl)) + end if + + if (param%lrotation) then + do i = 1, NDIM + pl_snap%Ip(i,:) = pack(pl%Ip(i,1:npl), pl%lmask(1:npl)) + pl_snap%rot(i,:) = pack(pl%rot(i,1:npl), pl%lmask(1:npl)) + end do + end if + call pl_snap%sort("id", ascending=.true.) + end if + + ! Take snapshot of the currently encountering test particles + tp_snap%nbody = ntp_snap + if (ntp_snap > 0) then + call tp_snap%setup(ntp_snap, param) + tp_snap%id(:) = pack(tp%id(1:ntp), tp%lmask(1:ntp)) + tp_snap%info(:) = pack(tp%info(1:ntp), tp%lmask(1:ntp)) + do i = 1, NDIM + tp_snap%rh(i,:) = pack(tp%rh(i,1:ntp), tp%lmask(1:ntp)) + tp_snap%vh(i,:) = pack(tp%vh(i,1:ntp), tp%lmask(1:ntp)) + end do + end if + + ! Save the snapshot + select type (encounter_history => system%encounter_history) + class is (encounter_storage(*)) + encounter_history%nid = encounter_history%nid + ntp_snap + npl_snap + call encounter_util_save_snapshot(system%encounter_history,snapshot) + end select + case("closest") + associate(plpl_encounter => system%plpl_encounter, pltp_encounter => system%pltp_encounter) + if (any(plpl_encounter%lclosest(:))) then + call pl_snap%setup(2, param) + do k = 1, plpl_encounter%nenc + if (plpl_encounter%lclosest(k)) then + pi = plpl_encounter%index1(k) + pj = plpl_encounter%index2(k) + select type(pl_snap) + class is (symba_pl) + select type(pl) + class is (symba_pl) + pl_snap%levelg(:) = pl%levelg([pi,pj]) + end select + end select + pl_snap%id(:) = pl%id([pi,pj]) + pl_snap%info(:) = pl%info([pi,pj]) + pl_snap%Gmass(:) = pl%Gmass([pi,pj]) + Gmtot = sum(pl_snap%Gmass(:)) + if (param%lclose) pl_snap%radius(:) = pl%radius([pi,pj]) if (param%lrotation) then do i = 1, NDIM - pl_snap%Ip(i,:) = pack(pl%Ip(i,1:npl), pl%lmask(1:npl)) - pl_snap%rot(i,:) = pack(pl%rot(i,1:npl), pl%lmask(1:npl)) + pl_snap%Ip(i,:) = pl%Ip(i,[pi,pj]) + pl_snap%rot(i,:) = pl%rot(i,[pi,pj]) end do end if - call pl_snap%sort("id", ascending=.true.) - end if - - ! Take snapshot of the currently encountering test particles - tp_snap%nbody = ntp_snap - if (ntp_snap > 0) then - call tp_snap%setup(ntp_snap, param) - tp_snap%id(:) = pack(tp%id(1:ntp), tp%lmask(1:ntp)) - tp_snap%info(:) = pack(tp%info(1:ntp), tp%lmask(1:ntp)) - do i = 1, NDIM - tp_snap%rh(i,:) = pack(tp%rh(i,1:ntp), tp%lmask(1:ntp)) - tp_snap%vh(i,:) = pack(tp%vh(i,1:ntp), tp%lmask(1:ntp)) - end do - end if - - ! Save the snapshot - param%encounter_history%nid = param%encounter_history%nid + ntp_snap + npl_snap - call encounter_util_save_snapshot(param%encounter_history,snapshot) - case("closest") - associate(plplenc_list => system%plplenc_list, pltpenc_list => system%pltpenc_list) - if (any(plplenc_list%lclosest(:))) then - call pl_snap%setup(2, param) - do k = 1, plplenc_list%nenc - if (plplenc_list%lclosest(k)) then - pi = plplenc_list%index1(k) - pj = plplenc_list%index2(k) - pl_snap%levelg(:) = pl%levelg([pi,pj]) - pl_snap%id(:) = pl%id([pi,pj]) - pl_snap%info(:) = pl%info([pi,pj]) - pl_snap%Gmass(:) = pl%Gmass([pi,pj]) - Gmtot = sum(pl_snap%Gmass(:)) - if (param%lclose) pl_snap%radius(:) = pl%radius([pi,pj]) - if (param%lrotation) then - do i = 1, NDIM - pl_snap%Ip(i,:) = pl%Ip(i,[pi,pj]) - pl_snap%rot(i,:) = pl%rot(i,[pi,pj]) - end do - end if - - ! Compute pericenter passage time to get the closest approach parameters - rrel(:) = plplenc_list%r2(:,k) - plplenc_list%r1(:,k) - vrel(:) = plplenc_list%v2(:,k) - plplenc_list%v1(:,k) - call orbel_xv2aqt(Gmtot, rrel(1), rrel(2), rrel(3), vrel(1), vrel(2), vrel(3), a, q, capm, tperi) - snapshot%t = t + tperi - if ((snapshot%t < maxval(pl_snap%info(:)%origin_time)) .or. & - (snapshot%t > minval(pl_snap%info(:)%discard_time))) cycle - - ! Computer the center mass of the pair - rcom(:) = (plplenc_list%r1(:,k) * pl_snap%Gmass(1) + plplenc_list%r2(:,k) * pl_snap%Gmass(2)) / Gmtot - vcom(:) = (plplenc_list%v1(:,k) * pl_snap%Gmass(1) + plplenc_list%v2(:,k) * pl_snap%Gmass(2)) / Gmtot - rb(:,1) = plplenc_list%r1(:,k) - rcom(:) - rb(:,2) = plplenc_list%r2(:,k) - rcom(:) - vb(:,1) = plplenc_list%v1(:,k) - vcom(:) - vb(:,2) = plplenc_list%v2(:,k) - vcom(:) - - ! Drift the relative orbit to get the new relative position and velocity - call drift_one(Gmtot, rrel(1), rrel(2), rrel(3), vrel(1), vrel(2), vrel(3), tperi, iflag) - if (iflag /= 0) write(*,*) "Danby error in encounter_util_snapshot_encounter. Closest approach positions and vectors may not be accurate." - - ! Get the new position and velocity vectors - rb(:,1) = -(pl_snap%Gmass(2) / Gmtot) * rrel(:) - rb(:,2) = (pl_snap%Gmass(1)) / Gmtot * rrel(:) - - vb(:,1) = -(pl_snap%Gmass(2) / Gmtot) * vrel(:) - vb(:,2) = (pl_snap%Gmass(1)) / Gmtot * vrel(:) - - ! Move the CoM assuming constant velocity over the time it takes to reach periapsis - rcom(:) = rcom(:) + vcom(:) * tperi - - ! Compute the heliocentric position and velocity vector at periapsis - pl_snap%rh(:,1) = rb(:,1) + rcom(:) - pl_snap%rh(:,2) = rb(:,2) + rcom(:) - pl_snap%vh(:,1) = vb(:,1) + vcom(:) - pl_snap%vh(:,2) = vb(:,2) + vcom(:) - - call pl_snap%sort("id", ascending=.true.) - call encounter_util_save_snapshot(param%encounter_history,snapshot) - end if - end do - plplenc_list%lclosest(:) = .false. - end if + ! Compute pericenter passage time to get the closest approach parameters + rrel(:) = plpl_encounter%r2(:,k) - plpl_encounter%r1(:,k) + vrel(:) = plpl_encounter%v2(:,k) - plpl_encounter%v1(:,k) + call swiftest_orbel_xv2aqt(Gmtot, rrel(1), rrel(2), rrel(3), vrel(1), vrel(2), vrel(3), a, q, capm, tperi) + snapshot%t = t + tperi + if ((snapshot%t < maxval(pl_snap%info(:)%origin_time)) .or. & + (snapshot%t > minval(pl_snap%info(:)%discard_time))) cycle + + ! Computer the center mass of the pair + rcom(:) = (plpl_encounter%r1(:,k) * pl_snap%Gmass(1) + plpl_encounter%r2(:,k) * pl_snap%Gmass(2)) / Gmtot + vcom(:) = (plpl_encounter%v1(:,k) * pl_snap%Gmass(1) + plpl_encounter%v2(:,k) * pl_snap%Gmass(2)) / Gmtot + rb(:,1) = plpl_encounter%r1(:,k) - rcom(:) + rb(:,2) = plpl_encounter%r2(:,k) - rcom(:) + vb(:,1) = plpl_encounter%v1(:,k) - vcom(:) + vb(:,2) = plpl_encounter%v2(:,k) - vcom(:) + + ! Drift the relative orbit to get the new relative position and velocity + call swiftest_drift_one(Gmtot, rrel(1), rrel(2), rrel(3), vrel(1), vrel(2), vrel(3), tperi, iflag) + if (iflag /= 0) write(*,*) "Danby error in encounter_util_snapshot_encounter. Closest approach positions and vectors may not be accurate." + + ! Get the new position and velocity vectors + rb(:,1) = -(pl_snap%Gmass(2) / Gmtot) * rrel(:) + rb(:,2) = (pl_snap%Gmass(1)) / Gmtot * rrel(:) + + vb(:,1) = -(pl_snap%Gmass(2) / Gmtot) * vrel(:) + vb(:,2) = (pl_snap%Gmass(1)) / Gmtot * vrel(:) + + ! Move the CoM assuming constant velocity over the time it takes to reach periapsis + rcom(:) = rcom(:) + vcom(:) * tperi + + ! Compute the heliocentric position and velocity vector at periapsis + pl_snap%rh(:,1) = rb(:,1) + rcom(:) + pl_snap%rh(:,2) = rb(:,2) + rcom(:) + pl_snap%vh(:,1) = vb(:,1) + vcom(:) + pl_snap%vh(:,2) = vb(:,2) + vcom(:) - if (any(pltpenc_list%lclosest(:))) then - do k = 1, pltpenc_list%nenc - end do - pltpenc_list%lclosest(:) = .false. - end if - end associate - case default - write(*,*) "encounter_util_snapshot_encounter requires `arg` to be either `trajectory` or `closest`" - end select - end select - end select - end associate + call pl_snap%sort("id", ascending=.true.) + call encounter_util_save_snapshot(system%encounter_history,snapshot) + end if + end do + + plpl_encounter%lclosest(:) = .false. + end if + + if (any(pltp_encounter%lclosest(:))) then + do k = 1, pltp_encounter%nenc + end do + pltp_encounter%lclosest(:) = .false. + end if + end associate + case default + write(*,*) "encounter_util_snapshot_encounter requires `arg` to be either `trajectory` or `closest`" + end select end select end select - end select + end associate + end select + end select + end select end select return diff --git a/src/fraggle/fraggle_generate.f90 b/src/fraggle/fraggle_generate.f90 index 67b375940..5f9eccee8 100644 --- a/src/fraggle/fraggle_generate.f90 +++ b/src/fraggle/fraggle_generate.f90 @@ -7,8 +7,9 @@ !! You should have received a copy of the GNU General Public License along with Swiftest. !! If not, see: https://www.gnu.org/licenses. -submodule(fraggle_classes) s_fraggle_generate +submodule(fraggle) s_fraggle_generate use swiftest + use symba integer(I4B), parameter :: NFRAG_MIN = 7 !! The minimum allowable number of fragments (set to 6 because that's how many unknowns are needed in the tangential velocity calculation) real(DP), parameter :: F_SPIN_FIRST = 0.05_DP !! The initial try value of the fraction of energy or momenum in spin (whichever has the lowest kinetic energy) @@ -24,10 +25,10 @@ module subroutine fraggle_generate_fragments(self, system, param, lfailure) use, intrinsic :: ieee_exceptions implicit none ! Arguments - class(fraggle_system), intent(inout) :: self !! Fraggle system object the outputs will be the fragmentation - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - logical, intent(out) :: lfailure !! Answers the question: Should this have been a merger instead? + class(fraggle_system), intent(inout) :: self !! Fraggle system object the outputs will be the fragmentation + class(base_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(base_parameters), intent(inout) :: param !! Current run configuration parameters + logical, intent(out) :: lfailure !! Answers the question: Should this have been a merger instead? ! Internals integer(I4B) :: i integer(I4B) :: try @@ -45,15 +46,19 @@ module subroutine fraggle_generate_fragments(self, system, param, lfailure) fpe_quiet_modes(:) = .false. call ieee_set_halting_mode(IEEE_ALL,fpe_quiet_modes) + select type(system) + class is (swiftest_nbody_system) + select type(param) + class is (swiftest_parameters) select type(fragments => self%fragments) - class is (fraggle_fragments) + class is (fraggle_fragments(*)) associate(collision_system => self, impactors => self%impactors, nfrag => fragments%nbody, pl => system%pl) write(message,*) nfrag - call io_log_one_message(FRAGGLE_LOG_OUT, "Fraggle generating " // trim(adjustl(message)) // " fragments.") + call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, "Fraggle generating " // trim(adjustl(message)) // " fragments.") if (nfrag < NFRAG_MIN) then write(message,*) "Fraggle needs at least ",NFRAG_MIN," fragments, but only ",nfrag," were given." - call io_log_one_message(FRAGGLE_LOG_OUT, message) + call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, message) lfailure = .true. return end if @@ -82,7 +87,7 @@ module subroutine fraggle_generate_fragments(self, system, param, lfailure) try = 1 do while (try < MAXTRY) write(message,*) try - call io_log_one_message(FRAGGLE_LOG_OUT, "Fraggle try " // trim(adjustl(message))) + call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, "Fraggle try " // trim(adjustl(message))) if (lfailure) then call fragments%restructure(impactors, try, f_spin, r_max_start) call fragments%reset() @@ -105,19 +110,19 @@ module subroutine fraggle_generate_fragments(self, system, param, lfailure) call fraggle_generate_spins(collision_system, f_spin, lfailure) if (lfailure) then - call io_log_one_message(FRAGGLE_LOG_OUT, "Fraggle failed to find spins") + call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, "Fraggle failed to find spins") cycle end if call fraggle_generate_tan_vel(collision_system, lfailure) if (lfailure) then - call io_log_one_message(FRAGGLE_LOG_OUT, "Fraggle failed to find tangential velocities") + call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, "Fraggle failed to find tangential velocities") cycle end if call fraggle_generate_rad_vel(collision_system, lfailure) if (lfailure) then - call io_log_one_message(FRAGGLE_LOG_OUT, "Fraggle failed to find radial velocities") + call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, "Fraggle failed to find radial velocities") cycle end if @@ -129,7 +134,7 @@ module subroutine fraggle_generate_fragments(self, system, param, lfailure) lfailure = ((abs(dEtot + impactors%Qloss) > FRAGGLE_ETOL) .or. (dEtot > 0.0_DP)) if (lfailure) then write(message, *) dEtot, abs(dEtot + impactors%Qloss) / FRAGGLE_ETOL - call io_log_one_message(FRAGGLE_LOG_OUT, "Fraggle failed due to high energy error: " // & + call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, "Fraggle failed due to high energy error: " // & trim(adjustl(message))) cycle end if @@ -137,7 +142,7 @@ module subroutine fraggle_generate_fragments(self, system, param, lfailure) lfailure = ((abs(dLmag) / (.mag.collision_system%Ltot(:,1))) > FRAGGLE_LTOL) if (lfailure) then write(message,*) dLmag / (.mag.collision_system%Ltot(:,1)) - call io_log_one_message(FRAGGLE_LOG_OUT, "Fraggle failed due to high angular momentum error: " // & + call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, "Fraggle failed due to high angular momentum error: " // & trim(adjustl(message))) cycle end if @@ -147,15 +152,15 @@ module subroutine fraggle_generate_fragments(self, system, param, lfailure) lfailure = any(fpe_flag) if (.not.lfailure) exit write(message,*) "Fraggle failed due to a floating point exception: ", fpe_flag - call io_log_one_message(FRAGGLE_LOG_OUT, message) + call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, message) end do write(message,*) try if (lfailure) then - call io_log_one_message(FRAGGLE_LOG_OUT, "Fraggle fragment generation failed after " // & + call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, "Fraggle fragment generation failed after " // & trim(adjustl(message)) // " tries") else - call io_log_one_message(FRAGGLE_LOG_OUT, "Fraggle fragment generation succeeded after " // & + call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, "Fraggle fragment generation succeeded after " // & trim(adjustl(message)) // " tries") end if @@ -165,6 +170,8 @@ module subroutine fraggle_generate_fragments(self, system, param, lfailure) if (lk_plpl) call pl%flatten(param) end associate end select + end select + end select call ieee_set_halting_mode(IEEE_ALL,fpe_halting_modes) ! Save the current halting modes so we can turn them off temporarily return @@ -275,7 +282,7 @@ subroutine fraggle_generate_spins(collision_system, f_spin, lfailure) associate(impactors => collision_system%impactors, nfrag => collision_system%fragments%nbody) select type(fragments => collision_system%fragments) - class is (fraggle_fragments) + class is (fraggle_fragments(*)) lfailure = .false. L_remainder(:) = fragments%L_budget(:) ke_remainder = fragments%ke_budget @@ -325,16 +332,16 @@ subroutine fraggle_generate_spins(collision_system, f_spin, lfailure) lfailure = ((fragments%ke_budget - fragments%ke_spin - fragments%ke_orbit) < 0.0_DP) if (lfailure) then - call io_log_one_message(FRAGGLE_LOG_OUT, " ") - call io_log_one_message(FRAGGLE_LOG_OUT, "Spin failure diagnostics") + call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, " ") + call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, "Spin failure diagnostics") write(message, *) fragments%ke_budget - call io_log_one_message(FRAGGLE_LOG_OUT, "ke_budget : " // trim(adjustl(message))) + call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, "ke_budget : " // trim(adjustl(message))) write(message, *) fragments%ke_spin - call io_log_one_message(FRAGGLE_LOG_OUT, "ke_spin : " // trim(adjustl(message))) + call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, "ke_spin : " // trim(adjustl(message))) write(message, *) fragments%ke_orbit - call io_log_one_message(FRAGGLE_LOG_OUT, "ke_orbit : " // trim(adjustl(message))) + call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, "ke_orbit : " // trim(adjustl(message))) write(message, *) fragments%ke_budget - fragments%ke_spin - fragments%ke_orbit - call io_log_one_message(FRAGGLE_LOG_OUT, "ke_remainder : " // trim(adjustl(message))) + call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, "ke_remainder : " // trim(adjustl(message))) end if end select @@ -378,7 +385,7 @@ subroutine fraggle_generate_tan_vel(collision_system, lfailure) associate(impactors => collision_system%impactors, nfrag => collision_system%fragments%nbody) select type(fragments => collision_system%fragments) - class is (fraggle_fragments) + class is (fraggle_fragments(*)) lfailure = .false. allocate(v_t_initial, mold=fragments%v_t_mag) @@ -427,20 +434,20 @@ subroutine fraggle_generate_tan_vel(collision_system, lfailure) fragments%rc(:,:) = fragments%rc(:,:) * 1.1_DP end do if (lfailure) then - call io_log_one_message(FRAGGLE_LOG_OUT, " ") - call io_log_one_message(FRAGGLE_LOG_OUT, "Tangential velocity failure diagnostics") + call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, " ") + call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, "Tangential velocity failure diagnostics") call fragments%get_angular_momentum() L_frag_tot = fragments%Lspin(:) + fragments%Lorbit(:) write(message, *) .mag.(fragments%L_budget(:) - L_frag_tot(:)) / (.mag.collision_system%Ltot(:,1)) - call io_log_one_message(FRAGGLE_LOG_OUT, "|L_remainder| : " // trim(adjustl(message))) + call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, "|L_remainder| : " // trim(adjustl(message))) write(message, *) fragments%ke_budget - call io_log_one_message(FRAGGLE_LOG_OUT, "ke_budget : " // trim(adjustl(message))) + call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, "ke_budget : " // trim(adjustl(message))) write(message, *) fragments%ke_spin - call io_log_one_message(FRAGGLE_LOG_OUT, "ke_spin : " // trim(adjustl(message))) + call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, "ke_spin : " // trim(adjustl(message))) write(message, *) fragments%ke_orbit - call io_log_one_message(FRAGGLE_LOG_OUT, "ke_tangential : " // trim(adjustl(message))) + call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, "ke_tangential : " // trim(adjustl(message))) write(message, *) fragments%ke_budget - fragments%ke_spin - fragments%ke_orbit - call io_log_one_message(FRAGGLE_LOG_OUT, "ke_radial : " // trim(adjustl(message))) + call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, "ke_radial : " // trim(adjustl(message))) end if end select end associate @@ -466,7 +473,7 @@ function solve_fragment_tan_vel(lfailure, v_t_mag_input) result(v_t_mag_output) real(DP), dimension(NDIM) :: L_lin_others, L_orb_others, L, vtmp select type(fragments => collision_system%fragments) - class is (fraggle_fragments) + class is (fraggle_fragments(*)) associate(nfrag => fragments%nbody) lfailure = .false. ! We have 6 constraint equations (2 vector constraints in 3 dimensions each) @@ -513,7 +520,7 @@ function tangential_objective_function(v_t_mag_input, lfailure) result(fval) real(DP) :: keo select type(fragments => collision_system%fragments) - class is (fraggle_fragments) + class is (fraggle_fragments(*)) associate(impactors => collision_system%impactors, nfrag => fragments%nbody) lfailure = .false. @@ -559,7 +566,7 @@ subroutine fraggle_generate_rad_vel(collision_system, lfailure) associate(impactors => collision_system%impactors, nfrag => collision_system%fragments%nbody) select type(fragments => collision_system%fragments) - class is (fraggle_fragments) + class is (fraggle_fragments(*)) ! Set the "target" ke for the radial component allocate(v_r_initial, source=fragments%v_r_mag) @@ -601,16 +608,16 @@ subroutine fraggle_generate_rad_vel(collision_system, lfailure) lfailure = abs((fragments%ke_budget - (fragments%ke_orbit + fragments%ke_spin)) / fragments%ke_budget) > FRAGGLE_ETOL if (lfailure) then - call io_log_one_message(FRAGGLE_LOG_OUT, " ") - call io_log_one_message(FRAGGLE_LOG_OUT, "Radial velocity failure diagnostics") + call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, " ") + call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, "Radial velocity failure diagnostics") write(message, *) fragments%ke_budget - call io_log_one_message(FRAGGLE_LOG_OUT, "ke_budget : " // trim(adjustl(message))) + call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, "ke_budget : " // trim(adjustl(message))) write(message, *) fragments%ke_spin - call io_log_one_message(FRAGGLE_LOG_OUT, "ke_spin : " // trim(adjustl(message))) + call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, "ke_spin : " // trim(adjustl(message))) write(message, *) fragments%ke_orbit - call io_log_one_message(FRAGGLE_LOG_OUT, "ke_orbit : " // trim(adjustl(message))) + call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, "ke_orbit : " // trim(adjustl(message))) write(message, *) fragments%ke_budget - (fragments%ke_orbit + fragments%ke_spin) - call io_log_one_message(FRAGGLE_LOG_OUT, "ke_remainder : " // trim(adjustl(message))) + call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, "ke_remainder : " // trim(adjustl(message))) end if end select @@ -636,16 +643,14 @@ function radial_objective_function(v_r_mag_input) result(fval) associate(impactors => collision_system%impactors, nfrag => collision_system%fragments%nbody) select type(fragments => collision_system%fragments) - class is (fraggle_fragments) + class is (fraggle_fragments(*)) allocate(v_shift, mold=fragments%vb) v_shift(:,:) = fraggle_util_vmag_to_vb(v_r_mag_input, fragments%v_r_unit, fragments%v_t_mag, fragments%v_t_unit, fragments%mass, impactors%vbcom) - !$omp do simd firstprivate(fragments) do i = 1,fragments%nbody rotmag2 = fragments%rot(1,i)**2 + fragments%rot(2,i)**2 + fragments%rot(3,i)**2 vmag2 = v_shift(1,i)**2 + v_shift(2,i)**2 + v_shift(3,i)**2 kearr(i) = fragments%mass(i) * (fragments%Ip(3, i) * fragments%radius(i)**2 * rotmag2 + vmag2) end do - !$omp end do simd keo = 2 * fragments%ke_budget - sum(kearr(:)) ke_radial = fragments%ke_budget - fragments%ke_orbit - fragments%ke_spin ! The following ensures that fval = 0 is a local minimum, which is what the BFGS method is searching for diff --git a/src/fraggle/fraggle_io.f90 b/src/fraggle/fraggle_io.f90 index e13c46472..7c943b5d6 100644 --- a/src/fraggle/fraggle_io.f90 +++ b/src/fraggle/fraggle_io.f90 @@ -7,7 +7,7 @@ !! You should have received a copy of the GNU General Public License along with Swiftest. !! If not, see: https://www.gnu.org/licenses. -submodule(fraggle_classes) s_fraggle_io +submodule(fraggle) s_fraggle_io use swiftest contains @@ -29,7 +29,7 @@ module subroutine fraggle_io_log_regime(collision_system) write(LUN, *) " Fraggle collisional regime determination results" write(LUN, *) "--------------------------------------------------------------------" write(LUN, *) "True number of impactors : ",impactors%ncoll - write(LUN, *) "Index list of true impactors : ",impactors%idx(1:impactors%ncoll) + write(LUN, *) "Index list of true impactors : ",impactors%id(1:impactors%ncoll) select case(impactors%regime) case(COLLRESOLVE_REGIME_MERGE) write(LUN, *) "Regime: Merge" diff --git a/src/fraggle/fraggle_resolve.f90 b/src/fraggle/fraggle_resolve.f90 new file mode 100644 index 000000000..e2cb6677b --- /dev/null +++ b/src/fraggle/fraggle_resolve.f90 @@ -0,0 +1,192 @@ +!! Copyright 2022 - David Minton, Carlisle Wishard, Jennifer Pouplin, Jake Elliott, & Dana Singh +!! This file is part of Swiftest. +!! Swiftest is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License +!! as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. +!! Swiftest is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty +!! of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. +!! You should have received a copy of the GNU General Public License along with Swiftest. +!! If not, see: https://www.gnu.org/licenses. + +submodule(fraggle) s_fraggle_resolve + use swiftest + use symba +contains + + module function fraggle_resolve_disruption(system, param, t) result(status) + !! author: Jennifer L.L. Pouplin, Carlisle A. Wishard, and David A. Minton + !! + !! Create the fragments resulting from a non-catastrophic disruption collision + !! + implicit none + ! Arguments + class(base_nbody_system), intent(inout) :: system !! SyMBA nbody system object + class(base_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions + real(DP), intent(in) :: t !! Time of collision + ! Result + integer(I4B) :: status !! Status flag assigned to this outcome + ! Internals + integer(I4B) :: i, ibiggest, nfrag + logical :: lfailure + character(len=STRMAX) :: message + real(DP) :: dpe + + select type(system) + class is (swiftest_nbody_system) + select type(param) + class is (swiftest_parameters) + select type(before => system%collision_system%before) + class is (swiftest_nbody_system) + select type(after => system%collision_system%after) + class is (swiftest_nbody_system) + associate(collision_system => system%collision_system, impactors => system%collision_system%impactors, fragments => system%collision_system%fragments) + select case(impactors%regime) + case(COLLRESOLVE_REGIME_DISRUPTION) + message = "Disruption between" + case(COLLRESOLVE_REGIME_SUPERCATASTROPHIC) + message = "Supercatastrophic disruption between" + end select + call collision_resolve_collider_message(system%pl, impactors%id, message) + call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, message) + + ! Collisional fragments will be uniformly distributed around the pre-impact barycenter + call collision_system%set_mass_dist(param) + + ! Generate the position and velocity distributions of the fragments + call collision_system%generate_fragments(system, param, lfailure) + + dpe = collision_system%pe(2) - collision_system%pe(1) + system%Ecollisions = system%Ecollisions - dpe + system%Euntracked = system%Euntracked + dpe + + if (lfailure) then + call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, "No fragment solution found, so treat as a pure hit-and-run") + status = ACTIVE + nfrag = 0 + select type(pl => system%pl) + class is (swiftest_pl) + pl%status(impactors%id(:)) = status + pl%ldiscard(impactors%id(:)) = .false. + pl%lcollision(impactors%id(:)) = .false. + end select + allocate(after%pl, source=before%pl) ! Be sure to save the pl so that snapshots still work + else + ! Populate the list of new bodies + nfrag = fragments%nbody + write(message, *) nfrag + call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, "Generating " // trim(adjustl(message)) // " fragments") + select case(impactors%regime) + case(COLLRESOLVE_REGIME_DISRUPTION) + status = DISRUPTED + ibiggest = impactors%id(maxloc(system%pl%Gmass(impactors%id(:)), dim=1)) + fragments%id(1) = system%pl%id(ibiggest) + fragments%id(2:nfrag) = [(i, i = param%maxid + 1, param%maxid + nfrag - 1)] + param%maxid = fragments%id(nfrag) + case(COLLRESOLVE_REGIME_SUPERCATASTROPHIC) + status = SUPERCATASTROPHIC + fragments%id(1:nfrag) = [(i, i = param%maxid + 1, param%maxid + nfrag)] + param%maxid = fragments%id(nfrag) + end select + + call collision_resolve_mergeaddsub(system, param, t, status) + end if + end associate + end select + end select + end select + end select + + return + end function fraggle_resolve_disruption + + + module function fraggle_resolve_hitandrun(system, param, t) result(status) + !! author: Jennifer L.L. Pouplin, Carlisle A. Wishard, and David A. Minton + !! + !! Create the fragments resulting from a non-catastrophic hit-and-run collision + !! + implicit none + ! Arguments + class(base_nbody_system), intent(inout) :: system !! SyMBA nbody system object + class(base_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions + real(DP), intent(in) :: t !! Time of collision + ! Result + integer(I4B) :: status !! Status flag assigned to this outcom + ! Internals + integer(I4B) :: i, ibiggest, nfrag, jtarg, jproj + logical :: lpure + character(len=STRMAX) :: message + real(DP) :: dpe + + select type(system) + class is (swiftest_nbody_system) + select type(param) + class is (swiftest_parameters) + select type(before => system%collision_system%before) + class is (swiftest_nbody_system) + select type(after => system%collision_system%after) + class is (swiftest_nbody_system) + associate(collision_system => system%collision_system, impactors => system%collision_system%impactors, fragments => system%collision_system%fragments) + message = "Hit and run between" + call collision_resolve_collider_message(system%pl, impactors%id, message) + call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, trim(adjustl(message))) + + if (impactors%mass(1) > impactors%mass(2)) then + jtarg = 1 + jproj = 2 + else + jtarg = 2 + jproj = 1 + end if + + if (impactors%mass_dist(2) > 0.9_DP * impactors%mass(jproj)) then ! Pure hit and run, so we'll just keep the two bodies untouched + call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, "Pure hit and run. No new fragments generated.") + nfrag = 0 + lpure = .true. + else ! Imperfect hit and run, so we'll keep the largest body and destroy the other + lpure = .false. + call collision_system%set_mass_dist(param) + + ! Generate the position and velocity distributions of the fragments + call collision_system%generate_fragments(system, param, lpure) + + dpe = collision_system%pe(2) - collision_system%pe(1) + system%Ecollisions = system%Ecollisions - dpe + system%Euntracked = system%Euntracked + dpe + + if (lpure) then + call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, "Should have been a pure hit and run instead") + nfrag = 0 + else + nfrag = fragments%nbody + write(message, *) nfrag + call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, "Generating " // trim(adjustl(message)) // " fragments") + end if + end if + if (lpure) then ! Reset these bodies back to being active so that nothing further is done to them + status = HIT_AND_RUN_PURE + select type(pl => system%pl) + class is (symba_pl) + pl%status(impactors%id(:)) = ACTIVE + pl%ldiscard(impactors%id(:)) = .false. + pl%lcollision(impactors%id(:)) = .false. + end select + allocate(after%pl, source=before%pl) ! Be sure to save the pl so that snapshots still work + else + ibiggest = impactors%id(maxloc(system%pl%Gmass(impactors%id(:)), dim=1)) + fragments%id(1) = system%pl%id(ibiggest) + fragments%id(2:nfrag) = [(i, i = param%maxid + 1, param%maxid + nfrag - 1)] + param%maxid = fragments%id(nfrag) + status = HIT_AND_RUN_DISRUPT + call collision_resolve_mergeaddsub(system, param, t, status) + end if + end associate + end select + end select + end select + end select + + + return + end function fraggle_resolve_hitandrun + +end submodule s_fraggle_resolve \ No newline at end of file diff --git a/src/fraggle/fraggle_set.f90 b/src/fraggle/fraggle_set.f90 index b0cfdf951..42c7e4500 100644 --- a/src/fraggle/fraggle_set.f90 +++ b/src/fraggle/fraggle_set.f90 @@ -7,8 +7,9 @@ !! You should have received a copy of the GNU General Public License along with Swiftest. !! If not, see: https://www.gnu.org/licenses. -submodule(fraggle_classes) s_fraggle_set +submodule(fraggle) s_fraggle_set use swiftest + use symba contains module subroutine fraggle_set_budgets(self) @@ -23,17 +24,18 @@ module subroutine fraggle_set_budgets(self) real(DP), dimension(NDIM) :: dL associate(impactors => self%impactors) - select type(fragments => self%fragments) - class is (fraggle_fragments) + select type(fragments => self%fragments) + class is (fraggle_fragments(*)) - dEtot = self%Etot(2) - self%Etot(1) - dL(:) = self%Ltot(:,2) - self%Ltot(:,1) + dEtot = self%Etot(2) - self%Etot(1) + dL(:) = self%Ltot(:,2) - self%Ltot(:,1) - fragments%L_budget(:) = -dL(:) - fragments%ke_budget = -(dEtot - 0.5_DP * fragments%mtot * dot_product(impactors%vbcom(:), impactors%vbcom(:))) - impactors%Qloss + fragments%L_budget(:) = -dL(:) + fragments%ke_budget = -(dEtot - 0.5_DP * fragments%mtot * dot_product(impactors%vbcom(:), impactors%vbcom(:))) - impactors%Qloss - end select + end select end associate + return end subroutine fraggle_set_budgets @@ -47,7 +49,7 @@ module subroutine fraggle_set_mass_dist(self, param) implicit none ! Arguments class(fraggle_system), intent(inout) :: self !! Fraggle collision system object - class(swiftest_parameters), intent(in) :: param !! Current Swiftest run configuration parameters + class(base_parameters), intent(in) :: param !! Current Swiftest run configuration parameters ! Internals integer(I4B) :: i, jproj, jtarg, nfrag, istart real(DP), dimension(2) :: volume @@ -62,8 +64,6 @@ module subroutine fraggle_set_mass_dist(self, param) integer(I4B), parameter :: iMrem = 3 associate(impactors => self%impactors) - select type(fragments => self%fragments) - class is (fraggle_fragments) ! Get mass weighted mean of Ip and density volume(1:2) = 4._DP / 3._DP * PI * impactors%radius(1:2)**3 mtot = sum(impactors%mass(:)) @@ -85,7 +85,7 @@ module subroutine fraggle_set_mass_dist(self, param) ! Check to see if our size distribution would give us a smaller number of fragments than the maximum number select type(param) - class is (symba_parameters) + class is (base_parameters) min_mfrag = (param%min_GMfrag / param%GU) ! The number of fragments we generate is bracked by the minimum required by fraggle_generate (7) and the ! maximum set by the NFRAG_SIZE_MULTIPLIER which limits the total number of fragments to prevent the nbody @@ -106,61 +106,70 @@ module subroutine fraggle_set_mass_dist(self, param) i = i + 1 end do if (i < nfrag) nfrag = max(i, NFRAGMIN) ! The sfd would actually give us fewer fragments than our maximum - - call fragments%setup(nfrag, param) + call self%setup_fragments(nfrag) + case (COLLRESOLVE_REGIME_MERGE, COLLRESOLVE_REGIME_GRAZE_AND_MERGE) - call fragments%setup(1, param) - fragments%mass(1) = impactors%mass_dist(1) - fragments%radius(1) = impactors%radius(jtarg) - fragments%density(1) = impactors%mass_dist(1) / volume(jtarg) - if (param%lrotation) fragments%Ip(:, 1) = impactors%Ip(:,1) + + call self%setup_fragments(1) + select type(fragments => self%fragments) + class is (fraggle_fragments(*)) + fragments%mass(1) = impactors%mass_dist(1) + fragments%radius(1) = impactors%radius(jtarg) + fragments%density(1) = impactors%mass_dist(1) / volume(jtarg) + if (param%lrotation) fragments%Ip(:, 1) = impactors%Ip(:,1) + end select return case default write(*,*) "fraggle_set_mass_dist_fragments error: Unrecognized regime code",impactors%regime end select - fragments%mtot = mtot - - ! Make the first two bins the same as the Mlr and Mslr values that came from collision_regime - fragments%mass(1) = impactors%mass_dist(iMlr) - fragments%mass(2) = impactors%mass_dist(iMslr) - - ! Distribute the remaining mass the 3:nfrag bodies following the model SFD given by slope BETA - mremaining = impactors%mass_dist(iMrem) - do i = iMrem, nfrag - mfrag = (1 + i - iMslr)**(-3._DP / BETA) * impactors%mass_dist(iMslr) - fragments%mass(i) = mfrag - mremaining = mremaining - mfrag - end do - ! If there is any residual mass (either positive or negative) we will distribute remaining mass proportionally among the the fragments - if (mremaining < 0.0_DP) then ! If the remainder is negative, this means that that the number of fragments required by the SFD is smaller than our lower limit set by fraggle_generate. - istart = iMrem ! We will reduce the mass of the 3:nfrag bodies to prevent the second-largest fragment from going smaller - else ! If the remainder is postiive, this means that the number of fragments required by the SFD is larger than our upper limit set by computational expediency. - istart = iMslr ! We will increase the mass of the 2:nfrag bodies to compensate, which ensures that the second largest fragment remains the second largest - end if - mfrag = 1._DP + mremaining / sum(fragments%mass(istart:nfrag)) - fragments%mass(istart:nfrag) = fragments%mass(istart:nfrag) * mfrag + select type(fragments => self%fragments) + class is (fraggle_fragments(*)) + fragments%mtot = mtot - ! There may still be some small residual due to round-off error. If so, simply add it to the last bin of the mass distribution. - mremaining = fragments%mtot - sum(fragments%mass(1:nfrag)) - fragments%mass(nfrag) = fragments%mass(nfrag) + mremaining + ! Make the first two bins the same as the Mlr and Mslr values that came from collision_regime + fragments%mass(1) = impactors%mass_dist(iMlr) + fragments%mass(2) = impactors%mass_dist(iMslr) + + ! Distribute the remaining mass the 3:nfrag bodies following the model SFD given by slope BETA + mremaining = impactors%mass_dist(iMrem) + do i = iMrem, nfrag + mfrag = (1 + i - iMslr)**(-3._DP / BETA) * impactors%mass_dist(iMslr) + fragments%mass(i) = mfrag + mremaining = mremaining - mfrag + end do + + ! If there is any residual mass (either positive or negative) we will distribute remaining mass proportionally among the the fragments + if (mremaining < 0.0_DP) then ! If the remainder is negative, this means that that the number of fragments required by the SFD is smaller than our lower limit set by fraggle_generate. + istart = iMrem ! We will reduce the mass of the 3:nfrag bodies to prevent the second-largest fragment from going smaller + else ! If the remainder is postiive, this means that the number of fragments required by the SFD is larger than our upper limit set by computational expediency. + istart = iMslr ! We will increase the mass of the 2:nfrag bodies to compensate, which ensures that the second largest fragment remains the second largest + end if + mfrag = 1._DP + mremaining / sum(fragments%mass(istart:nfrag)) + fragments%mass(istart:nfrag) = fragments%mass(istart:nfrag) * mfrag + + ! There may still be some small residual due to round-off error. If so, simply add it to the last bin of the mass distribution. + mremaining = fragments%mtot - sum(fragments%mass(1:nfrag)) + fragments%mass(nfrag) = fragments%mass(nfrag) + mremaining + + ! Compute physical properties of the new fragments + select case(impactors%regime) + case(COLLRESOLVE_REGIME_HIT_AND_RUN) ! The hit and run case always preserves the largest body intact, so there is no need to recompute the physical properties of the first fragment + fragments%radius(1) = impactors%radius(jtarg) + fragments%density(1) = impactors%mass_dist(iMlr) / volume(jtarg) + fragments%Ip(:, 1) = impactors%Ip(:,1) + istart = 2 + case default + istart = 1 + end select + + fragments%density(istart:nfrag) = fragments%mtot / sum(volume(:)) + fragments%radius(istart:nfrag) = (3 * fragments%mass(istart:nfrag) / (4 * PI * fragments%density(istart:nfrag)))**(1.0_DP / 3.0_DP) + do i = istart, nfrag + fragments%Ip(:, i) = Ip_avg(:) + end do - ! Compute physical properties of the new fragments - select case(impactors%regime) - case(COLLRESOLVE_REGIME_HIT_AND_RUN) ! The hit and run case always preserves the largest body intact, so there is no need to recompute the physical properties of the first fragment - fragments%radius(1) = impactors%radius(jtarg) - fragments%density(1) = impactors%mass_dist(iMlr) / volume(jtarg) - fragments%Ip(:, 1) = impactors%Ip(:,1) - istart = 2 - case default - istart = 1 end select - fragments%density(istart:nfrag) = fragments%mtot / sum(volume(:)) - fragments%radius(istart:nfrag) = (3 * fragments%mass(istart:nfrag) / (4 * PI * fragments%density(istart:nfrag)))**(1.0_DP / 3.0_DP) - do i = istart, nfrag - fragments%Ip(:, i) = Ip_avg(:) - end do - end select end associate return diff --git a/src/fraggle/fraggle_setup.f90 b/src/fraggle/fraggle_setup.f90 index 2e67f6c7d..b612f05b2 100644 --- a/src/fraggle/fraggle_setup.f90 +++ b/src/fraggle/fraggle_setup.f90 @@ -7,64 +7,24 @@ !! You should have received a copy of the GNU General Public License along with Swiftest. !! If not, see: https://www.gnu.org/licenses. -submodule (fraggle_classes) s_fraggle_setup +submodule (fraggle) s_fraggle_setup use swiftest + use symba contains - module subroutine fraggle_setup_reset_fragments(self) + module subroutine fraggle_setup_fragments_system(self, nfrag) !! author: David A. Minton !! - !! Resets all position and velocity-dependent fragment quantities in order to do a fresh calculation (does not reset mass, radius, or other values that get set prior to the call to fraggle_generate) + !! Initializer for the fragments of the collision system. implicit none ! Arguments - class(fraggle_fragments), intent(inout) :: self + class(fraggle_system), intent(inout) :: self !! Encounter collision system object + integer(I4B), intent(in) :: nfrag !! Number of fragments to create - self%rb(:,:) = 0.0_DP - self%vb(:,:) = 0.0_DP - self%rot(:,:) = 0.0_DP - self%v_r_unit(:,:) = 0.0_DP - self%v_t_unit(:,:) = 0.0_DP - self%v_n_unit(:,:) = 0.0_DP - - self%rmag(:) = 0.0_DP - self%rotmag(:) = 0.0_DP - self%v_r_mag(:) = 0.0_DP - self%v_t_mag(:) = 0.0_DP + if (allocated(self%fragments)) deallocate(self%fragments) + allocate(fraggle_fragments(nfrag) :: self%fragments) return - end subroutine fraggle_setup_reset_fragments - - - module subroutine fraggle_setup_fragments(self, n, param) - !! author: David A. Minton - !! - !! Allocates arrays for n fragments in a Fraggle system. Passing n = 0 deallocates all arrays. - implicit none - ! Arguments - class(fraggle_fragments), intent(inout) :: self - integer(I4B), intent(in) :: n - class(swiftest_parameters), intent(in) :: param - - call collision_setup_fragments(self, n, param) - if (n < 0) return - - if (allocated(self%rotmag)) deallocate(self%rotmag) - if (allocated(self%v_r_mag)) deallocate(self%v_r_mag) - if (allocated(self%v_t_mag)) deallocate(self%v_t_mag) - if (allocated(self%v_n_mag)) deallocate(self%v_t_mag) - - if (n == 0) return - - allocate(self%rotmag(n)) - allocate(self%v_r_mag(n)) - allocate(self%v_t_mag(n)) - allocate(self%v_n_mag(n)) - - call self%reset() - - return - end subroutine fraggle_setup_fragments - - + end subroutine fraggle_setup_fragments_system end submodule s_fraggle_setup \ No newline at end of file diff --git a/src/fraggle/fraggle_util.f90 b/src/fraggle/fraggle_util.f90 index a46ec64a0..62581c0db 100644 --- a/src/fraggle/fraggle_util.f90 +++ b/src/fraggle/fraggle_util.f90 @@ -7,19 +7,18 @@ !! You should have received a copy of the GNU General Public License along with Swiftest. !! If not, see: https://www.gnu.org/licenses. -submodule(fraggle_classes) s_fraggle_util +submodule(fraggle) s_fraggle_util use swiftest + use symba contains - - module subroutine fraggle_util_get_angular_momentum(self) !! Author: David A. Minton !! !! Calcualtes the current angular momentum of the fragments implicit none ! Arguments - class(fraggle_fragments), intent(inout) :: self !! Fraggle fragment system object + class(fraggle_fragments(*)), intent(inout) :: self !! Fraggle fragment system object ! Internals integer(I4B) :: i @@ -43,82 +42,104 @@ module subroutine fraggle_util_construct_temporary_system(self, nbody_system, pa !! Constructs a temporary internal system consisting of active bodies and additional fragments. This internal temporary system is used to calculate system energy with and without fragments implicit none ! Arguments - class(fraggle_system), intent(inout) :: self !! Fraggle collision system object - class(swiftest_nbody_system), intent(in) :: nbody_system !! Original swiftest nbody system object - class(swiftest_parameters), intent(in) :: param !! Current swiftest run configuration parameters - class(swiftest_nbody_system), allocatable, intent(out) :: tmpsys !! Output temporary swiftest nbody system object - class(swiftest_parameters), allocatable, intent(out) :: tmpparam !! Output temporary configuration run parameters + class(fraggle_system), intent(inout) :: self !! Fraggle collision system object + class(base_nbody_system), intent(in) :: nbody_system !! Original swiftest nbody system object + class(base_parameters), intent(in) :: param !! Current swiftest run configuration parameters + class(base_nbody_system), allocatable, intent(out) :: tmpsys !! Output temporary swiftest nbody system object + class(base_parameters), allocatable, intent(out) :: tmpparam !! Output temporary configuration run parameters call self%collision_system%construct_temporary_system(nbody_system, param, tmpsys, tmpparam) - call tmpsys%rescale(tmpparam, self%mscale, self%dscale, self%tscale) + + select type(tmpsys) + class is (swiftest_nbody_system) + select type(tmpparam) + class is (swiftest_parameters) + call tmpsys%rescale(tmpparam, self%mscale, self%dscale, self%tscale) + end select + end select return end subroutine fraggle_util_construct_temporary_system - module subroutine fraggle_util_dealloc_fragments(self) + module subroutine fraggle_util_final_fragments(self) !! author: David A. Minton !! - !! Deallocates all allocatables + !! Finalizer will deallocate all allocatables implicit none ! Arguments - class(fraggle_fragments), intent(inout) :: self - - call collision_util_dealloc_fragments(self) + type(fraggle_fragments(*)), intent(inout) :: self !! Fraggle encountar storage object - if (allocated(self%v_r_mag)) deallocate(self%v_r_mag) - if (allocated(self%v_t_mag)) deallocate(self%v_t_mag) - if (allocated(self%v_n_mag)) deallocate(self%v_n_mag) + call self%collision_fragments%reset() return - end subroutine fraggle_util_dealloc_fragments - + end subroutine fraggle_util_final_fragments - module subroutine fraggle_util_final_impactors(self) + module subroutine fraggle_util_final_system(self) !! author: David A. Minton !! !! Finalizer will deallocate all allocatables implicit none ! Arguments - type(collision_impactors), intent(inout) :: self !! Fraggle encountar storage object + type(fraggle_system), intent(inout) :: self !! Collision impactors storage object - if (allocated(self%idx)) deallocate(self%idx) + call self%reset() + if (allocated(self%impactors)) deallocate(self%impactors) + if (allocated(self%fragments)) deallocate(self%fragments) return - end subroutine fraggle_util_final_impactors + end subroutine fraggle_util_final_system - module subroutine fraggle_util_final_fragments(self) + module subroutine fraggle_util_reset_fragments(self) !! author: David A. Minton !! - !! Finalizer will deallocate all allocatables + !! Resets all position and velocity-dependent fragment quantities in order to do a fresh calculation (does not reset mass, radius, or other values that get set prior to the call to fraggle_generate) implicit none ! Arguments - type(fraggle_fragments), intent(inout) :: self !! Fraggle encountar storage object - - call self%dealloc() + class(fraggle_fragments(*)), intent(inout) :: self + + self%rc(:,:) = 0.0_DP + self%vc(:,:) = 0.0_DP + self%rh(:,:) = 0.0_DP + self%vh(:,:) = 0.0_DP + self%rb(:,:) = 0.0_DP + self%vb(:,:) = 0.0_DP + self%rot(:,:) = 0.0_DP + self%v_r_unit(:,:) = 0.0_DP + self%v_t_unit(:,:) = 0.0_DP + self%v_n_unit(:,:) = 0.0_DP + + self%rmag(:) = 0.0_DP + self%rotmag(:) = 0.0_DP + self%v_r_mag(:) = 0.0_DP + self%v_t_mag(:) = 0.0_DP + self%v_n_mag(:) = 0.0_DP return - end subroutine fraggle_util_final_fragments + end subroutine fraggle_util_reset_fragments - module subroutine fraggle_util_final_system(self) + module subroutine fraggle_util_reset_system(self) !! author: David A. Minton !! - !! Finalizer will deallocate all allocatables + !! Resets the collider system and deallocates all allocatables implicit none ! Arguments - type(fraggle_system), intent(inout) :: self !! Collision impactors storage object - ! Internals - type(swiftest_parameters) :: tmp_param + class(fraggle_system), intent(inout) :: self !! Collision system object - call self%reset(tmp_param) - if (allocated(self%impactors)) deallocate(self%impactors) - if (allocated(self%fragments)) deallocate(self%fragments) + self%dscale = 1.0_DP + self%mscale = 1.0_DP + self%tscale = 1.0_DP + self%vscale = 1.0_DP + self%Escale = 1.0_DP + self%Lscale = 1.0_DP + + call self%collision_system%reset() return - end subroutine fraggle_util_final_system + end subroutine fraggle_util_reset_system module subroutine fraggle_util_restructure(self, impactors, try, f_spin, r_max_start) @@ -127,7 +148,7 @@ module subroutine fraggle_util_restructure(self, impactors, try, f_spin, r_max_s !! Restructure the inputs after a failed attempt failed to find a set of positions and velocities that satisfy the energy and momentum constraints implicit none ! Arguments - class(fraggle_fragments), intent(inout) :: self !! Fraggle fragment system object + class(fraggle_fragments(*)), intent(inout) :: self !! Fraggle fragment system object class(collision_impactors), intent(in) :: impactors !! Fraggle collider system object integer(I4B), intent(in) :: try !! The current number of times Fraggle has tried to find a solution real(DP), intent(inout) :: f_spin !! Fraction of energy/momentum that goes into spin. This decreases ater a failed attempt diff --git a/src/helio/helio_drift.f90 b/src/helio/helio_drift.f90 index 06e98e0fa..d61eb6450 100644 --- a/src/helio/helio_drift.f90 +++ b/src/helio/helio_drift.f90 @@ -7,7 +7,7 @@ !! You should have received a copy of the GNU General Public License along with Swiftest. !! If not, see: https://www.gnu.org/licenses. -submodule (helio_classes) s_helio_drift +submodule (helio) s_helio_drift use swiftest contains @@ -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%rh, self%vb, self%nbody, param, dt, self%lmask, iflag) + call swiftest_drift_all(mu, self%rh, self%vb, self%nbody, param, dt, self%lmask, iflag) if (any(iflag(1:n) /= 0)) then where(iflag(1:n) /= 0) self%status(1:n) = DISCARDED_DRIFTERR do i = 1, n diff --git a/src/helio/helio_gr.f90 b/src/helio/helio_gr.f90 index 13209ce1a..7a5ac9525 100644 --- a/src/helio/helio_gr.f90 +++ b/src/helio/helio_gr.f90 @@ -7,7 +7,7 @@ !! You should have received a copy of the GNU General Public License along with Swiftest. !! If not, see: https://www.gnu.org/licenses. -submodule(helio_classes) s_helio_gr +submodule(helio) s_helio_gr use swiftest contains @@ -26,7 +26,7 @@ pure module subroutine helio_gr_kick_getacch_pl(self, param) if (self%nbody == 0) return associate(pl => self, npl => self%nbody) - call gr_kick_getacch(pl%mu, pl%rh, pl%lmask, npl, param%inv_c2, pl%agr) + call swiftest_gr_kick_getacch(pl%mu, pl%rh, pl%lmask, npl, param%inv_c2, pl%agr) pl%ah(:,1:npl) = pl%ah(:,1:npl) + pl%agr(:,1:npl) end associate @@ -49,7 +49,7 @@ pure module subroutine helio_gr_kick_getacch_tp(self, param) if (self%nbody == 0) return associate(tp => self, ntp => self%nbody) - call gr_kick_getacch(tp%mu, tp%rh, tp%lmask, ntp, param%inv_c2, tp%agr) + call swiftest_gr_kick_getacch(tp%mu, tp%rh, tp%lmask, ntp, param%inv_c2, tp%agr) tp%ah(:,1:ntp) = tp%ah(:,1:ntp) + tp%agr(:,1:ntp) end associate @@ -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%rh(:, i), pl%vb(:, i), dt) + call swiftest_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%rh(:, i), tp%vb(:, i), dt) + call swiftest_gr_p4_pos_kick(param, tp%rh(:, i), tp%vb(:, i), dt) end do end associate diff --git a/src/helio/helio_kick.f90 b/src/helio/helio_kick.f90 index 03bc688b5..525990d12 100644 --- a/src/helio/helio_kick.f90 +++ b/src/helio/helio_kick.f90 @@ -7,7 +7,7 @@ !! You should have received a copy of the GNU General Public License along with Swiftest. !! If not, see: https://www.gnu.org/licenses. -submodule(helio_classes) s_helio_kick +submodule(helio) s_helio_kick use swiftest contains @@ -77,7 +77,7 @@ module subroutine helio_kick_getacch_tp(self, system, param, t, lbeg) if (system%lbeg) then call tp%accel_int(param, pl%Gmass(1:npl), pl%rbeg(:,1:npl), npl) else - call tp%accel_int(param, pl%Gmass(1:npl), pl%xend(:,1:npl), npl) + call tp%accel_int(param, pl%Gmass(1:npl), pl%rend(:,1:npl), npl) end if if (param%loblatecb) call tp%accel_obl(system) if (param%lextra_force) call tp%accel_user(system, param, t, lbeg) @@ -114,7 +114,7 @@ module subroutine helio_kick_vb_pl(self, system, param, t, dt, lbeg) if (lbeg) then call pl%set_beg_end(rbeg = pl%rh) else - call pl%set_beg_end(xend = pl%rh) + call pl%set_beg_end(rend = pl%rh) end if do concurrent(i = 1:npl, pl%lmask(i)) pl%vb(1, i) = pl%vb(1, i) + pl%ah(1, i) * dt diff --git a/src/helio/helio_setup.f90 b/src/helio/helio_setup.f90 index 22187f526..80effc1a9 100644 --- a/src/helio/helio_setup.f90 +++ b/src/helio/helio_setup.f90 @@ -7,7 +7,7 @@ !! You should have received a copy of the GNU General Public License along with Swiftest. !! If not, see: https://www.gnu.org/licenses. -submodule(helio_classes) s_helio_setup +submodule(helio) s_helio_setup use swiftest contains diff --git a/src/helio/helio_step.f90 b/src/helio/helio_step.f90 index 318a1bba2..ddcfe0bd5 100644 --- a/src/helio/helio_step.f90 +++ b/src/helio/helio_step.f90 @@ -7,7 +7,7 @@ !! You should have received a copy of the GNU General Public License along with Swiftest. !! If not, see: https://www.gnu.org/licenses. -submodule(helio_classes) s_helio_step +submodule(helio) s_helio_step use swiftest contains diff --git a/src/helio/helio_util.f90 b/src/helio/helio_util.f90 index 73a88d58c..3568fa557 100644 --- a/src/helio/helio_util.f90 +++ b/src/helio/helio_util.f90 @@ -7,7 +7,7 @@ !! You should have received a copy of the GNU General Public License along with Swiftest. !! If not, see: https://www.gnu.org/licenses. -submodule(helio_classes) s_helio_util +submodule(helio) s_helio_util use swiftest contains diff --git a/src/main/swiftest_driver.f90 b/src/main/swiftest_driver.f90 index ebd207e54..b7a0b330b 100644 --- a/src/main/swiftest_driver.f90 +++ b/src/main/swiftest_driver.f90 @@ -20,7 +20,7 @@ program swiftest_driver class(swiftest_nbody_system), allocatable :: 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 :: integrator !! Integrator type code (see globals for symbolic names) character(len=:), allocatable :: param_file_name !! Name of the file containing user-defined parameters character(len=:), allocatable :: display_style !! Style of the output display {"STANDARD", "COMPACT", "PROGRESS"}). Default is "STANDARD" integer(I8B) :: istart !! Starting index for loop counter @@ -29,7 +29,7 @@ program swiftest_driver integer(I4B) :: idump !! Dump cadence counter type(walltimer) :: integration_timer !! Object used for computing elapsed wall time real(DP) :: tfrac !! Fraction of total simulation time completed - type(progress_bar) :: pbar !! Object used to print out a progress bar + type(pbar) :: pbar !! Object used to print out a progress bar character(*), parameter :: statusfmt = '("Time = ", ES12.5, "; fraction done = ", F6.3, ' // & '"; Number of active pl, tp = ", I6, ", ", I6)' character(*), parameter :: symbastatfmt = '("Time = ", ES12.5, "; fraction done = ", F6.3, ' // & @@ -38,16 +38,16 @@ program swiftest_driver character(len=64) :: pbarmessage character(*), parameter :: symbacompactfmt = '(";NPLM",ES22.15,$)' - !type(swiftest_storage(nframes=:)), allocatable :: system_history + !type(base_storage(nframes=:)), allocatable :: system_history call io_get_args(integrator, param_file_name, display_style) !> Read in the user-defined parameters file and the initial conditions of the system select case(integrator) case(symba) - allocate(symba_parameters :: param) + allocate(base_parameters :: param) case default - allocate(swiftest_parameters :: param) + allocate(base_parameters :: param) end select param%integrator = trim(adjustl(integrator)) call param%set_display(display_style) diff --git a/src/modules/base.f90 b/src/modules/base.f90 new file mode 100644 index 000000000..83e26eef6 --- /dev/null +++ b/src/modules/base.f90 @@ -0,0 +1,487 @@ +!! Copyright 2022 - David Minton, Carlisle Wishard, Jennifer Pouplin, Jake Elliott, & Dana Singh +!! This file is part of Swiftest. +!! Swiftest is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License +!! as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. +!! Swiftest is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty +!! of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. +!! You should have received a copy of the GNU General Public License along with Swiftest. +!! If not, see: https://www.gnu.org/licenses. + +module base + !! author: The Purdue Swiftest Team - David A. Minton, Carlisle A. Wishard, Jennifer L.L. Pouplin, and Jacob R. Elliott + !! + !! Base type definitions. This allows the collision and encounter modules to be defined before the swiftest module. + !! + use globals + implicit none + public + + + !> User defined parameters that are read in from the parameters input file. + !> Each paramter is initialized to a default values. + type, abstract :: base_parameters + character(len=:), allocatable :: integrator !! Symbolic name of the nbody integrator used + character(len=:), allocatable :: param_file_name !! The name of the parameter file + integer(I4B) :: maxid = -1 !! The current maximum particle id number + integer(I4B) :: maxid_collision = 0 !! The current maximum collision id number + real(DP) :: t0 = 0.0_DP !! Integration reference time + real(DP) :: tstart = -1.0_DP !! Integration start time + real(DP) :: tstop = -1.0_DP !! Integration stop time + real(DP) :: dt = -1.0_DP !! Time step + integer(I8B) :: iloop = 0_I8B !! Main loop counter + integer(I4B) :: ioutput = 1 !! Output counter + character(STRMAX) :: incbfile = CB_INFILE !! Name of input file for the central body + character(STRMAX) :: inplfile = PL_INFILE !! Name of input file for massive bodies + character(STRMAX) :: intpfile = TP_INFILE !! Name of input file for test particles + character(STRMAX) :: in_netcdf = NC_INFILE !! Name of system input file for NetCDF input + character(STRMAX) :: in_type = "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 = BIN_OUTFILE !! Name of output binary file + character(STRMAX) :: out_type = "NETCDF_DOUBLE" !! Binary format of output file + character(STRMAX) :: out_form = "XVEL" !! Data to write to output file + character(STRMAX) :: out_stat = 'NEW' !! Open status for output binary file + integer(I4B) :: dump_cadence = 10 !! Number of output steps between dumping simulation data to file + real(DP) :: rmin = -1.0_DP !! Minimum heliocentric radius for test particle + real(DP) :: rmax = -1.0_DP !! Maximum heliocentric radius for test particle + real(DP) :: rmaxu = -1.0_DP !! Maximum unbound heliocentric radius for test particle + real(DP) :: qmin = -1.0_DP !! Minimum pericenter distance for test particle + character(STRMAX) :: qmin_coord = 'HELIO' !! Coordinate frame to use for qmin + real(DP) :: qmin_alo = -1.0_DP !! Minimum semimajor axis for qmin + real(DP) :: qmin_ahi = -1.0_DP !! Maximum semimajor axis for qmin + real(QP) :: MU2KG = -1.0_QP !! Converts mass units to grams + real(QP) :: TU2S = -1.0_QP !! Converts time units to seconds + real(QP) :: DU2M = -1.0_QP !! Converts distance unit to centimeters + real(DP) :: GU = -1.0_DP !! Universal gravitational constant in the system units + real(DP) :: inv_c2 = -1.0_DP !! Inverse speed of light squared in the system units + real(DP) :: GMTINY = -1.0_DP !! Smallest G*mass that is fully gravitating + real(DP) :: min_GMfrag = -1.0_DP !! Smallest G*mass that can be produced in a fragmentation event + integer(I4B), dimension(:), allocatable :: seed !! Random seeds for fragmentation modeling + logical :: lfragmentation = .false. !! Do fragmentation modeling instead of simple merger. + character(STRMAX) :: encounter_save = "NONE" !! Indicate if and how encounter data should be saved + logical :: lenc_save_trajectory = .false. !! Indicates that when encounters are saved, the full trajectory through recursion steps are saved + logical :: lenc_save_closest = .false. !! Indicates that when encounters are saved, the closest approach distance between pairs of bodies is saved + character(NAMELEN) :: interaction_loops = "ADAPTIVE" !! Method used to compute interaction loops. Options are "TRIANGULAR", "FLAT", or "ADAPTIVE" + character(NAMELEN) :: encounter_check_plpl = "ADAPTIVE" !! Method used to compute pl-pl encounter checks. Options are "TRIANGULAR", "SORTSWEEP", or "ADAPTIVE" + character(NAMELEN) :: encounter_check_pltp = "ADAPTIVE" !! Method used to compute pl-tp encounter checks. Options are "TRIANGULAR", "SORTSWEEP", or "ADAPTIVE" + + ! The following are used internally, and are not set by the user, but instead are determined by the input value of INTERACTION_LOOPS + logical :: lflatten_interactions = .false. !! Use the flattened upper triangular matrix for pl-pl interaction loops + logical :: ladaptive_interactions = .false. !! Adaptive interaction loop is turned on (choose between TRIANGULAR and FLAT based on periodic timing tests) + logical :: lencounter_sas_plpl = .false. !! Use the Sort and Sweep algorithm to prune the encounter list before checking for close encounters + logical :: lencounter_sas_pltp = .false. !! Use the Sort and Sweep algorithm to prune the encounter list before checking for close encounters + logical :: ladaptive_encounters_plpl = .false. !! Adaptive encounter checking is turned on (choose between TRIANGULAR or SORTSWEEP based on periodic timing tests) + logical :: ladaptive_encounters_pltp = .false. !! Adaptive encounter checking is turned on (choose between TRIANGULAR or SORTSWEEP based on periodic timing tests) + + ! Logical flags to turn on or off various features of the code + logical :: lrhill_present = .false. !! Hill radii are given as an input rather than calculated by the code (can be used to inflate close encounter regions manually) + logical :: lextra_force = .false. !! User defined force function turned on + logical :: lbig_discard = .false. !! Save big bodies on every discard + logical :: lclose = .false. !! Turn on close encounters + logical :: lenergy = .false. !! Track the total energy of the system + logical :: loblatecb = .false. !! Calculate acceleration from oblate central body (automatically turns true if nonzero J2 is input) + logical :: lrotation = .false. !! Include rotation states of big bodies + logical :: ltides = .false. !! Include tidal dissipation + + ! Initial values to pass to the energy report subroutine (usually only used in the case of a restart, otherwise these will be updated with initial conditions values) + real(DP) :: Eorbit_orig = 0.0_DP !! Initial orbital energy + real(DP) :: GMtot_orig = 0.0_DP !! Initial system mass + real(DP), dimension(NDIM) :: Ltot_orig = 0.0_DP !! Initial total angular momentum vector + real(DP), dimension(NDIM) :: Lorbit_orig = 0.0_DP !! Initial orbital angular momentum + real(DP), dimension(NDIM) :: Lspin_orig = 0.0_DP !! Initial spin angular momentum vector + real(DP), dimension(NDIM) :: Lescape = 0.0_DP !! Angular momentum of bodies that escaped the system (used for bookeeping) + real(DP) :: GMescape = 0.0_DP !! Mass of bodies that escaped the system (used for bookeeping) + real(DP) :: Ecollisions = 0.0_DP !! Energy lost from system due to collisions + real(DP) :: Euntracked = 0.0_DP !! Energy gained from system due to escaped bodies + logical :: lfirstenergy = .true. !! This is the first time computing energe + logical :: lfirstkick = .true. !! Initiate the first kick in a symplectic step + logical :: lrestart = .false. !! Indicates whether or not this is a restarted run + + character(len=:), allocatable :: display_style !! Style of the output display {"STANDARD", "COMPACT"}). Default is "STANDARD" + integer(I4B) :: display_unit !! File unit number for display (either to stdout or to a log file) + logical :: log_output = .false. !! Logs the output to file instead of displaying it on the terminal + + ! Future features not implemented or in development + logical :: lgr = .false. !! Turn on GR + logical :: lyarkovsky = .false. !! Turn on Yarkovsky effect + logical :: lyorp = .false. !! Turn on YORP effect + contains + procedure(abstract_io_dump_param), deferred :: dump + procedure(abstract_io_param_reader), deferred :: reader + procedure(abstract_io_param_writer), deferred :: writer + procedure(abstract_io_read_in_param), deferred :: read_in + end type base_parameters + + abstract interface + subroutine abstract_io_dump_param(self, param_file_name) + import base_parameters + implicit none + class(base_parameters),intent(in) :: self !! Output collection of parameters + character(len=*), intent(in) :: param_file_name !! Parameter input file name (i.e. param.in) + end subroutine abstract_io_dump_param + + subroutine abstract_io_param_reader(self, unit, iotype, v_list, iostat, iomsg) + import base_parameters, I4B + implicit none + class(base_parameters), intent(inout) :: self !! Collection of parameters + integer(I4B), intent(in) :: unit !! File unit number + character(len=*), intent(in) :: iotype !! Dummy argument passed to the input/output procedure contains the text from the char-literal-constant, prefixed with DT. + !! If you do not include a char-literal-constant, the iotype argument contains only DT. + character(len=*), intent(in) :: v_list(:) !! The first element passes the integrator code to the reader + integer(I4B), intent(out) :: iostat !! IO status code + character(len=*), intent(inout) :: iomsg !! Message to pass if iostat /= 0 + end subroutine abstract_io_param_reader + + subroutine abstract_io_param_writer(self, unit, iotype, v_list, iostat, iomsg) + import base_parameters, I4B + implicit none + class(base_parameters), intent(in) :: self !! Collection of parameters + integer(I4B), intent(in) :: unit !! File unit number + character(len=*), intent(in) :: iotype !! Dummy argument passed to the input/output procedure contains the text from the char-literal-constant, prefixed with DT. + !! If you do not include a char-literal-constant, the iotype argument contains only DT. + integer(I4B), intent(in) :: v_list(:) !! Not used in this procedure + integer(I4B), intent(out) :: iostat !! IO status code + character(len=*), intent(inout) :: iomsg !! Message to pass if iostat /= 0 + end subroutine abstract_io_param_writer + + subroutine abstract_io_read_in_param(self, param_file_name) + import base_parameters + implicit none + class(base_parameters), intent(inout) :: self !! Current run configuration parameters + character(len=*), intent(in) :: param_file_name !! Parameter input file name (i.e. param.in) + end subroutine abstract_io_read_in_param + end interface + + !! This derived datatype stores the NetCDF ID values for each of the variables included in the NetCDF data file. This is used as the base class defined in base + type, abstract :: base_io_netcdf_parameters + character(STRMAX) :: file_name !! Name of the output file + 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) :: name_dimname = "name" !! name of the particle name dimension + integer(I4B) :: name_dimid !! ID for the particle name dimension + integer(I4B) :: name_varid !! ID for the particle name variable + character(NAMELEN) :: space_dimname = "space" !! name of the space dimension + integer(I4B) :: space_dimid !! ID for the space dimension + integer(I4B) :: space_varid !! ID for the space variable + character(len=1), dimension(3) :: space_coords = ["x","y","z"] !! The space dimension coordinate labels + + ! Non-dimension ids and variable names + character(NAMELEN) :: ptype_varname = "particle_type" !! name of the particle type variable + integer(I4B) :: ptype_varid !! ID for the particle type variable + character(NAMELEN) :: id_varname = "id" !! name of the particle id variable + integer(I4B) :: id_varid !! ID for the id variable + character(NAMELEN) :: npl_varname = "npl" !! name of the number of active massive bodies variable + integer(I4B) :: npl_varid !! ID for the number of active massive bodies variable + character(NAMELEN) :: ntp_varname = "ntp" !! name of the number of active test particles variable + integer(I4B) :: ntp_varid !! ID for the number of active test particles variable + character(NAMELEN) :: nplm_varname = "nplm" !! name of the number of active fully interacting massive bodies variable (SyMBA) + integer(I4B) :: nplm_varid !! ID for the number of active fully interacting massive bodies variable (SyMBA) + character(NAMELEN) :: a_varname = "a" !! name of the semimajor axis variable + integer(I4B) :: a_varid !! ID for the semimajor axis variable + character(NAMELEN) :: e_varname = "e" !! name of the eccentricity variable + integer(I4B) :: e_varid !! ID for the eccentricity variable + character(NAMELEN) :: inc_varname = "inc" !! name of the inclination variable + integer(I4B) :: inc_varid !! ID for the inclination variable + character(NAMELEN) :: capom_varname = "capom" !! name of the long. asc. node variable + integer(I4B) :: capom_varid !! ID for the long. asc. node variable + character(NAMELEN) :: omega_varname = "omega" !! name of the arg. of periapsis variable + integer(I4B) :: omega_varid !! ID for the arg. of periapsis variable + character(NAMELEN) :: capm_varname = "capm" !! name of the mean anomaly variable + integer(I4B) :: capm_varid !! ID for the mean anomaly variable + character(NAMELEN) :: varpi_varname = "varpi" !! name of the long. of periapsis variable + integer(I4B) :: varpi_varid !! ID for the long. of periapsis variable + character(NAMELEN) :: lam_varname = "lam" !! name of the mean longitude variable + integer(I4B) :: lam_varid !! ID for the mean longitude variable + character(NAMELEN) :: f_varname = "f" !! name of the true anomaly variable + integer(I4B) :: f_varid !! ID for the true anomaly variable + character(NAMELEN) :: cape_varname = "cape" !! name of the eccentric anomaly variable + integer(I4B) :: cape_varid !! ID for the eccentric anomaly variable + character(NAMELEN) :: rh_varname = "rh" !! name of the heliocentric position vector variable + integer(I4B) :: rh_varid !! ID for the heliocentric position vector variable + character(NAMELEN) :: vh_varname = "vh" !! name of the heliocentric velocity vector variable + integer(I4B) :: vh_varid !! ID for the heliocentric velocity vector variable + character(NAMELEN) :: gr_pseudo_vh_varname = "gr_pseudo_vh" !! name of the heliocentric pseudovelocity vector variable (used in GR only) + integer(I4B) :: gr_pseudo_vh_varid !! ID for the heliocentric pseudovelocity vector variable (used in GR) + character(NAMELEN) :: gmass_varname = "Gmass" !! name of the mass variable + integer(I4B) :: Gmass_varid !! ID for the mass variable + character(NAMELEN) :: rhill_varname = "rhill" !! name of the hill radius variable + integer(I4B) :: rhill_varid !! ID for the hill radius variable + character(NAMELEN) :: radius_varname = "radius" !! name of the radius variable + integer(I4B) :: radius_varid !! ID for the radius variable + character(NAMELEN) :: Ip_varname = "Ip" !! name of the principal moment of inertial variable + integer(I4B) :: Ip_varid !! ID for the axis principal moment of inertia variable + character(NAMELEN) :: rot_varname = "rot" !! name of the rotation vector variable + integer(I4B) :: rot_varid !! ID for the rotation vector variable + character(NAMELEN) :: j2rp2_varname = "j2rp2" !! name of the j2rp2 variable + integer(I4B) :: j2rp2_varid !! ID for the j2 variable + character(NAMELEN) :: j4rp4_varname = "j4rp4" !! name of the j4pr4 variable + integer(I4B) :: j4rp4_varid !! ID for the j4 variable + character(NAMELEN) :: k2_varname = "k2" !! name of the Love number variable + integer(I4B) :: k2_varid !! ID for the Love number variable + character(NAMELEN) :: q_varname = "Q" !! name of the energy dissipation variable + integer(I4B) :: Q_varid !! ID for the energy dissipation variable + character(NAMELEN) :: ke_orb_varname = "KE_orb" !! name of the system orbital kinetic energy variable + integer(I4B) :: KE_orb_varid !! ID for the system orbital kinetic energy variable + character(NAMELEN) :: ke_spin_varname = "KE_spin" !! name of the system spin kinetic energy variable + integer(I4B) :: KE_spin_varid !! ID for the system spin kinetic energy variable + character(NAMELEN) :: pe_varname = "PE" !! name of the system potential energy variable + integer(I4B) :: PE_varid !! ID for the system potential energy variable + character(NAMELEN) :: L_orb_varname = "L_orb" !! name of the orbital angular momentum vector variable + integer(I4B) :: L_orb_varid !! ID for the system orbital angular momentum vector variable + character(NAMELEN) :: Lspin_varname = "Lspin" !! name of the spin angular momentum vector variable + integer(I4B) :: Lspin_varid !! ID for the system spin angular momentum vector variable + character(NAMELEN) :: L_escape_varname = "L_escape" !! name of the escaped angular momentum vector variable + integer(I4B) :: L_escape_varid !! ID for the escaped angular momentum vector variable + character(NAMELEN) :: Ecollisions_varname = "Ecollisions" !! name of the escaped angular momentum y variable + integer(I4B) :: Ecollisions_varid !! ID for the energy lost in collisions variable + character(NAMELEN) :: Euntracked_varname = "Euntracked" !! name of the energy that is untracked due to loss (untracked potential energy due to mergers and body energy for escaped bodies) + integer(I4B) :: Euntracked_varid !! ID for the energy that is untracked due to loss (untracked potential energy due to mergers and body energy for escaped bodies) + character(NAMELEN) :: GMescape_varname = "GMescape" !! name of the G*Mass of bodies that escape the system + integer(I4B) :: GMescape_varid !! ID for the G*Mass of bodies that escape the system + character(NAMELEN) :: origin_type_varname = "origin_type" !! name of the origin type variable (Initial Conditions, Disruption, etc.) + integer(I4B) :: origin_type_varid !! ID for the origin type + character(NAMELEN) :: origin_time_varname = "origin_time" !! name of the time of origin variable + integer(I4B) :: origin_time_varid !! ID for the origin time + character(NAMELEN) :: collision_id_varname = "collision_id" !! name of the collision id variable + integer(I4B) :: collision_id_varid !! Netcdf ID for the origin collision ID + character(NAMELEN) :: origin_rh_varname = "origin_rh" !! name of the heliocentric position vector of the body at the time of origin variable + integer(I4B) :: origin_rh_varid !! ID for the origin position vector variable + character(NAMELEN) :: origin_vh_varname = "origin_vh" !! name of the heliocentric velocity vector of the body at the time of origin variable + integer(I4B) :: origin_vh_varid !! ID for the origin velocity vector component + character(NAMELEN) :: discard_time_varname = "discard_time" !! name of the time of discard variable + integer(I4B) :: discard_time_varid !! ID for the time of discard variable + character(NAMELEN) :: discard_rh_varname = "discard_rh" !! name of the heliocentric position vector of the body at the time of discard variable + integer(I4B) :: discard_rh_varid !! ID for the heliocentric position vector of the body at the time of discard variable + character(NAMELEN) :: discard_vh_varname = "discard_vh" !! name of the heliocentric velocity vector of the body at the time of discard variable + integer(I4B) :: discard_vh_varid !! ID for the heliocentric velocity vector of the body at the time of discard variable + character(NAMELEN) :: discard_body_id_varname = "discard_body_id" !! name of the id of the other body involved in the discard + contains + procedure(abstract_io_netcdf_initialize_output), deferred :: initialize + procedure(abstract_io_netcdf_open), deferred :: open + procedure :: close => base_io_netcdf_close !! Closes an open NetCDF file + procedure :: flush => base_io_netcdf_flush !! Flushes the current buffer to disk by closing and re-opening the file. + procedure :: sync => base_io_netcdf_sync !! Syncrhonize the disk and memory buffer of the NetCDF file (e.g. commit the frame files stored in memory to disk) + end type base_io_netcdf_parameters + + abstract interface + subroutine abstract_io_netcdf_initialize_output(self, param) + import base_io_netcdf_parameters, base_parameters + implicit none + class(base_io_netcdf_parameters), intent(inout) :: self !! Parameters used to for writing a NetCDF dataset to file + class(base_parameters), intent(in) :: param !! Current run configuration parameters + end subroutine abstract_io_netcdf_initialize_output + end interface + + + type :: base_storage_frame + class(*), allocatable :: item + contains + procedure :: store => copy_store !! Stores a snapshot of the nbody system so that later it can be retrieved for saving to file. + generic :: assignment(=) => store + final :: final_storage_frame + end type + + type, abstract :: base_storage(nframes) + !! An class that establishes the pattern for various storage objects + integer(I4B), len :: nframes = 4096 !! Total number of frames that can be stored + + !! An class that establishes the pattern for various storage objects + type(base_storage_frame), dimension(nframes) :: frame !! Array of stored frames + integer(I4B) :: iframe = 0 !! Index of the last frame stored in the system + integer(I4B) :: nid !! Number of unique id values in all saved snapshots + integer(I4B), dimension(:), allocatable :: idvals !! The set of unique id values contained in the snapshots + integer(I4B), dimension(:), allocatable :: idmap !! The id value -> index map + integer(I4B) :: nt !! Number of unique time values in all saved snapshots + real(DP), dimension(:), allocatable :: tvals !! The set of unique time values contained in the snapshots + integer(I4B), dimension(:), allocatable :: tmap !! The t value -> index map + class(base_io_netcdf_parameters), allocatable :: nc !! NetCDF object attached to this storage object + contains + procedure :: reset => reset_storage !! Resets a storage object by deallocating all items and resetting the frame counter to 0 + end type base_storage + + + !> Class definition for the particle origin information object. This object is used to track time, location, and collisional regime + !> of fragments produced in collisional events. + type, abstract :: base_particle_info + end type base_particle_info + + + !> An abstract class for a generic collection of Swiftest bodies + type, abstract :: base_object + end type base_object + + type, abstract :: base_multibody(nbody) + integer(I4B), len :: nbody + integer(I4B), dimension(nbody) :: id + end type base_multibody + + !> Class definition for the kinship relationships used in bookkeeping multiple collisions bodies in a single time step. + type, abstract :: base_kinship + end type base_kinship + + + !> An abstract class for a basic Swiftest nbody system + type, abstract :: base_nbody_system + end type base_nbody_system + + abstract interface + subroutine abstract_io_netcdf_open(self, param, readonly) + import base_io_netcdf_parameters, base_parameters + implicit none + class(base_io_netcdf_parameters), intent(inout) :: self !! Parameters used to identify a particular NetCDF dataset + class(base_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 abstract_io_netcdf_open + end interface + + contains + + subroutine copy_store(self, source) + !! author: David A. Minton + !! + !! Stores a snapshot of the nbody system so that later it can be retrieved for saving to file. + implicit none + class(base_storage_frame), intent(inout) :: self !! Swiftest storage frame object + class(*), intent(in) :: source !! Swiftest n-body system object + + if (allocated(self%item)) deallocate(self%item) + allocate(self%item, source=source) + + return + end subroutine copy_store + + + subroutine final_storage_frame(self) + !! author: David A. Minton + !! + !! Finalizer for the storage frame data type + implicit none + type(base_storage_frame) :: self + + if (allocated(self%item)) deallocate(self%item) + + return + end subroutine final_storage_frame + + subroutine netcdf_check(status, call_identifier) + !! author: Carlisle A. Wishard, Dana Singh, and David A. Minton + !! + !! Checks the status of all NetCDF operations to catch errors + use netcdf + implicit none + ! Arguments + integer, intent (in) :: status !! The status code returned by a NetCDF function + character(len=*), intent(in), optional :: call_identifier !! String that indicates which calling function caused the error for diagnostic purposes + + if(status /= nf90_noerr) then + if (present(call_identifier)) write(*,*) "NetCDF error in ",trim(call_identifier) + write(*,*) trim(nf90_strerror(status)) + call util_exit(FAILURE) + end if + + return + end subroutine netcdf_check + + + subroutine base_io_netcdf_close(self) + !! author: Carlisle A. Wishard, Dana Singh, and David A. Minton + !! + !! Closes a NetCDF file + use netcdf + implicit none + ! Arguments + class(base_io_netcdf_parameters), intent(inout) :: self !! Parameters used to identify a particular NetCDF dataset + + call netcdf_check( nf90_close(self%id), "base_io_netcdf_close" ) + + return + end subroutine base_io_netcdf_close + + + subroutine base_io_netcdf_flush(self, param) + !! author: David A. Minton + !! + !! Flushes the current buffer to disk by closing and re-opening the file. + !! + implicit none + ! Arguments + class(base_io_netcdf_parameters), intent(inout) :: self !! Parameters used to identify a particular NetCDF dataset + class(base_parameters), intent(inout) :: param !! Current run configuration parameters + + call self%close() + call self%open(param) + + return + end subroutine base_io_netcdf_flush + + + + subroutine base_io_netcdf_sync(self) + !! author: David A. Minton + !! + !! Syncrhonize the disk and memory buffer of the NetCDF file (e.g. commit the frame files stored in memory to disk) + !! + use netcdf + implicit none + ! Arguments + class(base_io_netcdf_parameters), intent(inout) :: self !! Parameters used to identify a particular NetCDF dataset + + call netcdf_check( nf90_sync(self%id), "base_io_netcdf_sync nf90_sync" ) + + return + end subroutine base_io_netcdf_sync + + + + subroutine base_util_final_storage(self) + !! author: David A. Minton + !! + !! Finalizer for the storage object + implicit none + ! Arguments + class(base_storage(*)), intent(inout) :: self + ! Internals + integer(I4B) :: i + + do i = 1, self%nframes + call final_storage_frame(self%frame(i)) + end do + return + end subroutine base_util_final_storage + + + subroutine reset_storage(self) + !! author: David A. Minton + !! + !! Resets a storage object by deallocating all items and resetting the frame counter to 0 + implicit none + ! Arguments + class(base_storage(*)), intent(inout) :: self !! Swiftest storage object + ! Internals + integer(I4B) :: i + + do i = 1, self%nframes + if (allocated(self%frame(i)%item)) deallocate(self%frame(i)%item) + end do + + if (allocated(self%idmap)) deallocate(self%idmap) + if (allocated(self%tmap)) deallocate(self%tmap) + self%nid = 0 + self%nt = 0 + self%iframe = 0 + + return + end subroutine reset_storage + +end module base diff --git a/src/modules/collision.f90 b/src/modules/collision.f90 new file mode 100644 index 000000000..bee281fd3 --- /dev/null +++ b/src/modules/collision.f90 @@ -0,0 +1,406 @@ +!! Copyright 2022 - David Minton, Carlisle Wishard, Jennifer Pouplin, Jake Elliott, & Dana Singh +!! This file is part of Swiftest. +!! Swiftest is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License +!! as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. +!! Swiftest is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty +!! of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. +!! You should have received a copy of the GNU General Public License along with Swiftest. +!! If not, see: https://www.gnu.org/licenses. + +module collision + !! author: The Purdue Swiftest Team - David A. Minton, Carlisle A. Wishard, Jennifer L.L. Pouplin, and Jacob R. Elliott + !! + !! Definition of classes and methods used to determine close encounters + use globals + use base + use encounter + implicit none + public + + !>Symbolic names for collisional outcomes from collresolve_resolve: + integer(I4B), parameter :: COLLRESOLVE_REGIME_MERGE = 1 + integer(I4B), parameter :: COLLRESOLVE_REGIME_DISRUPTION = 2 + integer(I4B), parameter :: COLLRESOLVE_REGIME_SUPERCATASTROPHIC = 3 + integer(I4B), parameter :: COLLRESOLVE_REGIME_GRAZE_AND_MERGE = 4 + integer(I4B), parameter :: COLLRESOLVE_REGIME_HIT_AND_RUN = 5 + character(len=*),dimension(5), parameter :: REGIME_NAMES = ["Merge", "Disruption", "Supercatastrophic", "Graze and Merge", "Hit and Run"] + + !> Swiftest class for tracking pl-pl close encounters in a step when collisions are possible + type, extends(encounter_list) :: collision_list_plpl + contains + procedure :: extract_collisions => collision_resolve_extract_plpl !! Processes the pl-pl encounter list remove only those encounters that led to a collision + procedure :: collision_check => collision_check_plpl !! Checks if a test particle is going to collide with a massive body + procedure :: resolve_collision => collision_resolve_plpl !! Process the pl-pl collision list, then modifiy the massive bodies based on the outcome of the collision + end type collision_list_plpl + + + !> Class for tracking pl-tp close encounters in a step when collisions are possible + type, extends(encounter_list) :: collision_list_pltp + contains + procedure :: extract_collisions => collision_resolve_extract_pltp !! Processes the pl-tp encounter list remove only those encounters that led to a collision + procedure :: collision_check => collision_check_pltp !! Checks if a test particle is going to collide with a massive body + procedure :: resolve_collision => collision_resolve_pltp !! Process the pl-tp collision list + end type collision_list_pltp + + + !> Class definition for the variables that describe the bodies involved in the collision + type, extends(base_object) :: collision_impactors + integer(I4B) :: ncoll !! Number of bodies involved in the collision + integer(I4B), dimension(:), allocatable :: id !! Index of bodies involved in the collision + real(DP), dimension(NDIM,2) :: rb !! Two-body equivalent position vectors of the collider bodies prior to collision + real(DP), dimension(NDIM,2) :: vb !! Two-body equivalent velocity vectors of the collider bodies prior to collision + real(DP), dimension(NDIM,2) :: rot !! Two-body equivalent principal axes moments of inertia the collider bodies prior to collision + real(DP), dimension(NDIM,2) :: Lspin !! Two-body equivalent spin angular momentum vectors of the collider bodies prior to collision + real(DP), dimension(NDIM,2) :: Lorbit !! Two-body equivalent orbital angular momentum vectors of the collider bodies prior to collision + real(DP), dimension(NDIM,2) :: Ip !! Two-body equivalent principal axes moments of inertia the collider bodies prior to collision + real(DP), dimension(2) :: mass !! Two-body equivalent mass of the collider bodies prior to the collision + real(DP), dimension(2) :: radius !! Two-body equivalent radii of the collider bodies prior to the collision + real(DP) :: Qloss !! Energy lost during the collision + integer(I4B) :: regime !! Collresolve regime code for this collision + real(DP), dimension(:), allocatable :: mass_dist !! Distribution of fragment mass determined by the regime calculation (largest fragment, second largest, and remainder) + real(DP) :: Mcb !! Mass of central body (used to compute potential energy in regime determination) + + ! Values in a coordinate frame centered on the collider barycenter and collisional system unit vectors + real(DP), dimension(NDIM) :: x_unit !! x-direction unit vector of collisional system + real(DP), dimension(NDIM) :: y_unit !! y-direction unit vector of collisional system + real(DP), dimension(NDIM) :: z_unit !! z-direction unit vector of collisional system + real(DP), dimension(NDIM) :: v_unit !! z-direction unit vector of collisional system + real(DP), dimension(NDIM) :: rbcom !! Center of mass position vector of the collider system in system barycentric coordinates + real(DP), dimension(NDIM) :: vbcom !! Velocity vector of the center of mass of the collider system in system barycentric coordinates + real(DP), dimension(NDIM) :: rbimp !! Impact point position vector of the collider system in system barycentric coordinates + + contains + procedure :: get_regime => collision_regime_impactors !! Determine which fragmentation regime the set of impactors will be + procedure :: reset => collision_util_reset_impactors !! Resets the collider object variables to 0 and deallocates the index and mass distributions + final :: collision_util_final_impactors !! Finalizer will deallocate all allocatables + end type collision_impactors + + + !> Class definition for the variables that describe a collection of fragments in barycentric coordinates + type, extends(base_multibody) :: collision_fragments + real(DP) :: mtot !! Total mass of fragments + class(base_particle_info), dimension(:), allocatable :: info !! Particle metadata information + integer(I4B), dimension(nbody) :: status !! An integrator-specific status indicator + real(DP), dimension(NDIM,nbody) :: rh !! Heliocentric position + real(DP), dimension(NDIM,nbody) :: vh !! Heliocentric velocity + real(DP), dimension(NDIM,nbody) :: rb !! Barycentric position + real(DP), dimension(NDIM,nbody) :: vb !! Barycentric velocity + real(DP), dimension(NDIM,nbody) :: rot !! rotation vectors of fragments + real(DP), dimension(NDIM,nbody) :: Ip !! Principal axes moment of inertia for fragments + real(DP), dimension(nbody) :: mass !! masses of fragments + real(DP), dimension(nbody) :: radius !! Radii of fragments + real(DP), dimension(nbody) :: density !! Radii of fragments + real(DP), dimension(NDIM,nbody) :: rc !! Position vectors in the collision coordinate frame + real(DP), dimension(NDIM,nbody) :: vc !! Velocity vectors in the collision coordinate frame + real(DP), dimension(nbody) :: rmag !! Array of radial distance magnitudes of individual fragments in the collisional coordinate frame + real(DP), dimension(nbody) :: vmag !! Array of radial distance magnitudes of individual fragments in the collisional coordinate frame + real(DP), dimension(nbody) :: rotmag !! Array of rotation magnitudes of individual fragments + real(DP), dimension(NDIM,nbody) :: v_r_unit !! Array of radial direction unit vectors of individual fragments in the collisional coordinate frame + real(DP), dimension(NDIM,nbody) :: v_t_unit !! Array of tangential direction unit vectors of individual fragments in the collisional coordinate frame + real(DP), dimension(NDIM,nbody) :: v_n_unit !! Array of normal direction unit vectors of individual fragments in the collisional coordinate frame + contains + procedure :: reset => collision_util_reset_fragments !! Deallocates all allocatable arrays and sets everything else to 0 + final :: collision_util_final_fragments !! Finalizer deallocates all allocatables + end type collision_fragments + + + type :: collision_system + !! This class defines a collisional system that stores impactors and fragments. This is written so that various collision models (i.e. Fraggle) could potentially be used + !! to resolve collision by defining extended types of encounters_impactors and/or encounetr_fragments + class(collision_fragments(:)), allocatable :: fragments !! Object containing information on the pre-collision system + class(collision_impactors), allocatable :: impactors !! Object containing information on the post-collision system + class(base_nbody_system), allocatable :: before !! A snapshot of the subset of the system involved in the collision + class(base_nbody_system), allocatable :: after !! A snapshot of the subset of the system containing products of the collision + + ! For the following variables, index 1 refers to the *entire* n-body system in its pre-collisional state and index 2 refers to the system in its post-collisional state + real(DP), dimension(NDIM,2) :: Lorbit !! Before/after orbital angular momentum + real(DP), dimension(NDIM,2) :: Lspin !! Before/after spin angular momentum + real(DP), dimension(NDIM,2) :: Ltot !! Before/after total system angular momentum + real(DP), dimension(2) :: ke_orbit !! Before/after orbital kinetic energy + real(DP), dimension(2) :: ke_spin !! Before/after spin kinetic energy + real(DP), dimension(2) :: pe !! Before/after potential energy + real(DP), dimension(2) :: Etot !! Before/after total system energy + contains + procedure :: generate_fragments => abstract_generate_fragments !! Generates a system of fragments + procedure :: set_mass_dist => abstract_set_mass_dist !! Sets the distribution of mass among the fragments depending on the regime type + procedure :: setup => collision_setup_system !! Initializer for the encounter collision system and the before/after snapshots + procedure :: setup_impactors => collision_setup_impactors_system !! Initializer for the impactors for the encounter collision system. Deallocates old impactors before creating new ones + procedure :: setup_fragments => collision_setup_fragments_system !! Initializer for the fragments of the collision system. + procedure :: add_fragments => collision_util_add_fragments_to_system !! Add fragments to system + procedure :: construct_temporary_system => collision_util_construct_temporary_system !! Constructs temporary n-body system in order to compute pre- and post-impact energy and momentum + procedure :: get_energy_and_momentum => collision_util_get_energy_momentum !! Calculates total system energy in either the pre-collision outcome state (lbefore = .true.) or the post-collision outcome state (lbefore = .false.) + procedure :: reset => collision_util_reset_system !! Deallocates all allocatables + procedure :: set_coordinate_system => collision_util_set_coordinate_system !! Sets the coordinate system of the collisional system + final :: collision_util_final_system !! Finalizer will deallocate all allocatables + end type collision_system + + + !! NetCDF dimension and variable names for the enounter save object + type, extends(encounter_io_parameters) :: collision_io_parameters + integer(I4B) :: stage_dimid !! ID for the stage dimension + integer(I4B) :: stage_varid !! ID for the stage variable + character(NAMELEN) :: stage_dimname = "stage" !! name of the stage dimension (before/after) + character(len=6), dimension(2) :: stage_coords = ["before", "after"] !! The stage coordinate labels + + character(NAMELEN) :: event_dimname = "collision" !! Name of collision event dimension + integer(I4B) :: event_dimid !! ID for the collision event dimension + integer(I4B) :: event_varid !! ID for the collision event variable + integer(I4B) :: event_dimsize = 0 !! Number of events + + character(NAMELEN) :: Qloss_varname = "Qloss" !! name of the energy loss variable + integer(I4B) :: Qloss_varid !! ID for the energy loss variable + character(NAMELEN) :: regime_varname = "regime" !! name of the collision regime variable + integer(I4B) :: regime_varid !! ID for the collision regime variable + contains + procedure :: initialize => collision_io_initialize_output !! Initialize a set of parameters used to identify a NetCDF output object + end type collision_io_parameters + + + type, extends(encounter_snapshot) :: collision_snapshot + logical :: lcollision !! Indicates that this snapshot contains at least one collision + class(collision_system), allocatable :: collision_system !! impactors object at this snapshot + contains + procedure :: write_frame => collision_io_write_frame_snapshot !! Writes a frame of encounter data to file + procedure :: get_idvals => collision_util_get_idvalues_snapshot !! Gets an array of all id values saved in this snapshot + final :: collision_util_final_snapshot !! Finalizer deallocates all allocatables + end type collision_snapshot + + + !> A class that that is used to store simulation history data between file output + type, extends(encounter_storage) :: collision_storage + contains + procedure :: dump => collision_io_dump !! Dumps contents of encounter history to file + procedure :: take_snapshot => collision_util_snapshot !! Take a minimal snapshot of the system through an encounter + procedure :: make_index_map => collision_util_index_map !! Maps body id values to storage index values so we don't have to use unlimited dimensions for id + final :: collision_util_final_storage !! Finalizer deallocates all allocatables + end type collision_storage + + + abstract interface + subroutine abstract_generate_fragments(self, system, param, lfailure) + import collision_system, base_nbody_system, base_parameters + implicit none + class(collision_system), intent(inout) :: self !! Collision system object + class(base_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(base_parameters), intent(inout) :: param !! Current run configuration parameters + logical, intent(out) :: lfailure !! Answers the question: Should this have been a merger instead? + end subroutine abstract_generate_fragments + + subroutine abstract_set_mass_dist(self, param) + import collision_system, base_parameters + implicit none + class(collision_system), intent(inout) :: self !! Collision system object + class(base_parameters), intent(in) :: param !! Current Swiftest run configuration parameters + end subroutine abstract_set_mass_dist + end interface + + + interface + module subroutine collision_io_dump(self, param) + implicit none + class(collision_storage(*)), intent(inout) :: self !! Collision storage object + class(base_parameters), intent(inout) :: param !! Current run configuration parameters + end subroutine collision_io_dump + + module subroutine collision_io_initialize_output(self, param) + implicit none + class(collision_io_parameters), intent(inout) :: self !! Parameters used to identify a particular NetCDF dataset + class(base_parameters), intent(in) :: param !! Current run configuration parameters + end subroutine collision_io_initialize_output + + module subroutine collision_io_write_frame_snapshot(self, history, param) + implicit none + class(collision_snapshot), intent(in) :: self !! Swiftest encounter structure + class(encounter_storage(*)), intent(inout) :: history !! Collision history object + class(base_parameters), intent(inout) :: param !! Current run configuration parameters + end subroutine collision_io_write_frame_snapshot + + module subroutine collision_regime_impactors(self, system, param) + implicit none + class(collision_impactors), intent(inout) :: self !! Collision system impactors object + class(base_nbody_system), intent(in) :: system !! Swiftest nbody system object + class(base_parameters), intent(in) :: param !! Current Swiftest run configuration parameters + end subroutine collision_regime_impactors + + module subroutine collision_check_plpl(self, system, param, t, dt, irec, lany_collision) + implicit none + class(collision_list_plpl), intent(inout) :: self !! encounter list object + class(base_nbody_system), intent(inout) :: system !! SyMBA nbody system object + class(base_parameters), intent(inout) :: param !! Current run configuration parameters + real(DP), intent(in) :: t !! current time + real(DP), intent(in) :: dt !! step size + integer(I4B), intent(in) :: irec !! Current recursion level + logical, intent(out) :: lany_collision !! Returns true if any pair of encounters resulted in a collision + end subroutine collision_check_plpl + + module subroutine collision_check_pltp(self, system, param, t, dt, irec, lany_collision) + implicit none + class(collision_list_pltp), intent(inout) :: self !! encounter list object + class(base_nbody_system), intent(inout) :: system !! SyMBA nbody system object + class(base_parameters), intent(inout) :: param !! Current run configuration parameters + real(DP), intent(in) :: t !! current time + real(DP), intent(in) :: dt !! step size + integer(I4B), intent(in) :: irec !! Current recursion level + logical, intent(out) :: lany_collision !! Returns true if any pair of encounters resulted in a collision + end subroutine collision_check_pltp + + module subroutine collision_resolve_extract_plpl(self, system, param) + implicit none + class(collision_list_plpl), intent(inout) :: self !! pl-pl encounter list + class(base_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(base_parameters), intent(in) :: param !! Current run configuration parameters + end subroutine collision_resolve_extract_plpl + + module subroutine collision_resolve_extract_pltp(self, system, param) + implicit none + class(collision_list_pltp), intent(inout) :: self !! pl-tp encounter list + class(base_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(base_parameters), intent(in) :: param !! Current run configuration parameters + end subroutine collision_resolve_extract_pltp + + module subroutine collision_resolve_make_impactors_pl(pl, idx) + implicit none + class(base_object), intent(inout) :: pl !! Massive body object + integer(I4B), dimension(:), intent(in) :: idx !! Array holding the indices of the two bodies involved in the collision + end subroutine collision_resolve_make_impactors_pl + + module function collision_resolve_merge(system, param, t) result(status) + implicit none + class(base_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(base_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions + real(DP), intent(in) :: t !! Time of collision + integer(I4B) :: status !! Status flag assigned to this outcome + end function collision_resolve_merge + + + module subroutine collision_resolve_plpl(self, system, param, t, dt, irec) + implicit none + class(collision_list_plpl), intent(inout) :: self !! pl-pl encounter list + class(base_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(base_parameters), intent(inout) :: param !! Current run configuration parameters with Swiftest additions + real(DP), intent(in) :: t !! Current simulation time + real(DP), intent(in) :: dt !! Current simulation step size + integer(I4B), intent(in) :: irec !! Current recursion level + end subroutine collision_resolve_plpl + + module subroutine collision_resolve_pltp(self, system, param, t, dt, irec) + implicit none + class(collision_list_pltp), intent(inout) :: self !! pl-tp encounter list + class(base_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(base_parameters), intent(inout) :: param !! Current run configuration parameters with Swiftest additions + real(DP), intent(in) :: t !! Current simulation time + real(DP), intent(in) :: dt !! Current simulation step size + integer(I4B), intent(in) :: irec !! Current recursion level + end subroutine collision_resolve_pltp + + module subroutine collision_util_set_coordinate_system(self) + implicit none + class(collision_system), intent(inout) :: self !! Collisional system + end subroutine collision_util_set_coordinate_system + + module subroutine collision_setup_system(self, nbody_system) + implicit none + class(collision_system), intent(inout) :: self !! Encounter collision system object + class(base_nbody_system), intent(in) :: nbody_system !! Current nbody system. Used as a mold for the before/after snapshots + end subroutine collision_setup_system + + module subroutine collision_setup_impactors_system(self) + implicit none + class(collision_system), intent(inout) :: self !! Encounter collision system object + end subroutine collision_setup_impactors_system + + module subroutine collision_setup_fragments_system(self, nfrag) + implicit none + class(collision_system), intent(inout) :: self !! Encounter collision system object + integer(I4B), intent(in) :: nfrag !! Number of fragments to create + end subroutine collision_setup_fragments_system + + module subroutine collision_util_add_fragments_to_system(self, system, param) + implicit none + class(collision_system), intent(in) :: self !! Collision system system object + class(base_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(base_parameters), intent(in) :: param !! Current swiftest run configuration parameters + end subroutine collision_util_add_fragments_to_system + + module subroutine collision_util_construct_temporary_system(self, nbody_system, param, tmpsys, tmpparam) + implicit none + class(collision_system), intent(inout) :: self !! Collision system object + class(base_nbody_system), intent(in) :: nbody_system !! Original swiftest nbody system object + class(base_parameters), intent(in) :: param !! Current swiftest run configuration parameters + class(base_nbody_system), allocatable, intent(out) :: tmpsys !! Output temporary swiftest nbody system object + class(base_parameters), allocatable, intent(out) :: tmpparam !! Output temporary configuration run parameters + end subroutine collision_util_construct_temporary_system + + module subroutine collision_util_reset_fragments(self) + implicit none + class(collision_fragments(*)), intent(inout) :: self + end subroutine collision_util_reset_fragments + + module subroutine collision_util_final_fragments(self) + implicit none + type(collision_fragments(*)), intent(inout) :: self + end subroutine collision_util_final_fragments + + module subroutine collision_util_final_impactors(self) + implicit none + type(collision_impactors), intent(inout) :: self !! Collision impactors storage object + end subroutine collision_util_final_impactors + + module subroutine collision_util_final_storage(self) + implicit none + type(collision_storage(*)), intent(inout) :: self !! Swiftest nbody system object + end subroutine collision_util_final_storage + + module subroutine collision_util_final_snapshot(self) + implicit none + type(collision_snapshot), intent(inout) :: self !! Fraggle storage snapshot object + end subroutine collision_util_final_snapshot + + module subroutine collision_util_final_system(self) + implicit none + type(collision_system), intent(inout) :: self !! Collision system object + end subroutine collision_util_final_system + + module subroutine collision_util_get_idvalues_snapshot(self, idvals) + implicit none + class(collision_snapshot), intent(in) :: self !! Fraggle snapshot object + integer(I4B), dimension(:), allocatable, intent(out) :: idvals !! Array of all id values saved in this snapshot + end subroutine collision_util_get_idvalues_snapshot + + module subroutine collision_util_get_energy_momentum(self, system, param, lbefore) + use base, only : base_nbody_system, base_parameters + implicit none + class(collision_system), intent(inout) :: self !! Encounter collision system object + class(base_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(base_parameters), intent(inout) :: param !! Current swiftest run configuration parameters + logical, intent(in) :: lbefore !! Flag indicating that this the "before" state of the system, with impactors included and fragments excluded or vice versa + end subroutine collision_util_get_energy_momentum + + module subroutine collision_util_index_map(self) + implicit none + class(collision_storage(*)), intent(inout) :: self !! Collision storage object + end subroutine collision_util_index_map + + module subroutine collision_util_reset_impactors(self) + implicit none + class(collision_impactors), intent(inout) :: self !! Collision system object + end subroutine collision_util_reset_impactors + + module subroutine collision_util_reset_system(self) + implicit none + class(collision_system), intent(inout) :: self !! Collision system object + end subroutine collision_util_reset_system + + module subroutine collision_util_snapshot(self, param, system, t, arg) + implicit none + class(collision_storage(*)), intent(inout) :: self !! Swiftest storage object + class(base_parameters), intent(inout) :: param !! Current run configuration parameters + class(base_nbody_system), intent(inout) :: system !! Swiftest nbody system object to store + real(DP), intent(in), optional :: t !! Time of snapshot if different from system time + character(*), intent(in), optional :: arg !! "before": takes a snapshot just before the collision. "after" takes the snapshot just after the collision. + end subroutine collision_util_snapshot + end interface + + +end module collision + diff --git a/src/modules/collision_classes.f90 b/src/modules/collision_classes.f90 deleted file mode 100644 index 791542ffd..000000000 --- a/src/modules/collision_classes.f90 +++ /dev/null @@ -1,341 +0,0 @@ -!! Copyright 2022 - David Minton, Carlisle Wishard, Jennifer Pouplin, Jake Elliott, & Dana Singh -!! This file is part of Swiftest. -!! Swiftest is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License -!! as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. -!! Swiftest is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty -!! of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. -!! You should have received a copy of the GNU General Public License along with Swiftest. -!! If not, see: https://www.gnu.org/licenses. - -module collision_classes - !! author: The Purdue Swiftest Team - David A. Minton, Carlisle A. Wishard, Jennifer L.L. Pouplin, and Jacob R. Elliott - !! - !! Definition of classes and methods used to determine close encounters - use swiftest_globals - use swiftest_classes, only : swiftest_parameters, swiftest_nbody_system, swiftest_pl, swiftest_storage, netcdf_parameters - use encounter_classes, only : encounter_snapshot, encounter_io_parameters, encounter_storage, encounter_io_parameters - implicit none - public - - - !>Symbolic names for collisional outcomes from collresolve_resolve: - integer(I4B), parameter :: COLLRESOLVE_REGIME_MERGE = 1 - integer(I4B), parameter :: COLLRESOLVE_REGIME_DISRUPTION = 2 - integer(I4B), parameter :: COLLRESOLVE_REGIME_SUPERCATASTROPHIC = 3 - integer(I4B), parameter :: COLLRESOLVE_REGIME_GRAZE_AND_MERGE = 4 - integer(I4B), parameter :: COLLRESOLVE_REGIME_HIT_AND_RUN = 5 - character(len=*),dimension(5), parameter :: REGIME_NAMES = ["Merge", "Disruption", "Supercatastrophic", "Graze and Merge", "Hit and Run"] - - !******************************************************************************************************************************** - ! collision_impactors class definitions and method interfaces - !******************************************************************************************************************************* - !> Class definition for the variables that describe the bodies involved in the collision - type :: collision_impactors - integer(I4B) :: ncoll !! Number of bodies involved in the collision - integer(I4B), dimension(:), allocatable :: idx !! Index of bodies involved in the collision - real(DP), dimension(NDIM,2) :: rb !! Two-body equivalent position vectors of the collider bodies prior to collision - real(DP), dimension(NDIM,2) :: vb !! Two-body equivalent velocity vectors of the collider bodies prior to collision - real(DP), dimension(NDIM,2) :: rot !! Two-body equivalent principal axes moments of inertia the collider bodies prior to collision - real(DP), dimension(NDIM,2) :: Lspin !! Two-body equivalent spin angular momentum vectors of the collider bodies prior to collision - real(DP), dimension(NDIM,2) :: Lorbit !! Two-body equivalent orbital angular momentum vectors of the collider bodies prior to collision - real(DP), dimension(NDIM,2) :: Ip !! Two-body equivalent principal axes moments of inertia the collider bodies prior to collision - real(DP), dimension(2) :: mass !! Two-body equivalent mass of the collider bodies prior to the collision - real(DP), dimension(2) :: radius !! Two-body equivalent radii of the collider bodies prior to the collision - real(DP) :: Qloss !! Energy lost during the collision - integer(I4B) :: regime !! Collresolve regime code for this collision - real(DP), dimension(:), allocatable :: mass_dist !! Distribution of fragment mass determined by the regime calculation (largest fragment, second largest, and remainder) - - ! Values in a coordinate frame centered on the collider barycenter and collisional system unit vectors - real(DP), dimension(NDIM) :: x_unit !! x-direction unit vector of collisional system - real(DP), dimension(NDIM) :: y_unit !! y-direction unit vector of collisional system - real(DP), dimension(NDIM) :: z_unit !! z-direction unit vector of collisional system - real(DP), dimension(NDIM) :: v_unit !! z-direction unit vector of collisional system - real(DP), dimension(NDIM) :: rbcom !! Center of mass position vector of the collider system in system barycentric coordinates - real(DP), dimension(NDIM) :: vbcom !! Velocity vector of the center of mass of the collider system in system barycentric coordinates - real(DP), dimension(NDIM) :: rbimp !! Impact point position vector of the collider system in system barycentric coordinates - - contains - procedure :: get_regime => collision_regime_impactors !! Determine which fragmentation regime the set of impactors will be - procedure :: setup => collision_setup_impactors !! Allocates arrays for n fragments in a fragment system. Passing n = 0 deallocates all arrays. - procedure :: reset => collision_util_reset_impactors !! Resets the collider object variables to 0 and deallocates the index and mass distributions - final :: collision_util_final_impactors !! Finalizer will deallocate all allocatables - end type collision_impactors - - !******************************************************************************************************************************** - ! collision_fragments class definitions and method interfaces - !******************************************************************************************************************************* - !> Class definition for the variables that describe a collection of fragments by Fraggle barycentric coordinates - type, abstract, extends(swiftest_pl) :: collision_fragments - real(DP) :: mtot !! Total mass of fragments - real(DP), dimension(:,:), allocatable :: rc !! Position vectors in the collision coordinate frame - real(DP), dimension(:,:), allocatable :: vc !! Velocity vectors in the collision coordinate frame - real(DP), dimension(:), allocatable :: rmag !! Array of radial distance magnitudes of individual fragments in the collisional coordinate frame - real(DP), dimension(:), allocatable :: vmag !! Array of radial distance magnitudes of individual fragments in the collisional coordinate frame - real(DP), dimension(:), allocatable :: rotmag !! Array of rotation magnitudes of individual fragments - real(DP), dimension(:,:), allocatable :: v_r_unit !! Array of radial direction unit vectors of individual fragments in the collisional coordinate frame - real(DP), dimension(:,:), allocatable :: v_t_unit !! Array of tangential direction unit vectors of individual fragments in the collisional coordinate frame - real(DP), dimension(:,:), allocatable :: v_n_unit !! Array of normal direction unit vectors of individual fragments in the collisional coordinate frame - - contains - procedure :: accel => collision_util_placeholder_accel !! Placeholder subroutine to fulfill requirement for an accel method - procedure :: kick => collision_util_placeholder_kick !! Placeholder subroutine to fulfill requirement for a kick method - procedure :: step => collision_util_placeholder_step !! Placeholder subroutine to fulfill requirement for a step method - procedure :: setup => collision_setup_fragments !! Allocates arrays for n fragments in a Fraggle system. Passing n = 0 deallocates all arrays. - procedure :: dealloc => collision_util_dealloc_fragments !! Deallocates all allocatable arrays - end type collision_fragments - - type :: collision_system - !! This class defines a collisional system that stores impactors and fragments. This is written so that various collision models (i.e. Fraggle) could potentially be used - !! to resolve collision by defining extended types of encounters_impactors and/or encounetr_fragments - class(collision_impactors), allocatable :: impactors !! Object containing information on the pre-collision system - class(collision_fragments), allocatable :: fragments !! Object containing information on the post-collision system - class(swiftest_nbody_system), allocatable :: before !! A snapshot of the subset of the system involved in the collision - class(swiftest_nbody_system), allocatable :: after !! A snapshot of the subset of the system containing products of the collision - - ! For the following variables, index 1 refers to the *entire* n-body system in its pre-collisional state and index 2 refers to the system in its post-collisional state - real(DP), dimension(NDIM,2) :: Lorbit !! Before/after orbital angular momentum - real(DP), dimension(NDIM,2) :: Lspin !! Before/after spin angular momentum - real(DP), dimension(NDIM,2) :: Ltot !! Before/after total system angular momentum - real(DP), dimension(2) :: ke_orbit !! Before/after orbital kinetic energy - real(DP), dimension(2) :: ke_spin !! Before/after spin kinetic energy - real(DP), dimension(2) :: pe !! Before/after potential energy - real(DP), dimension(2) :: Etot !! Before/after total system energy - contains - procedure :: generate_fragments => abstract_generate_fragments !! Generates a system of fragments - procedure :: set_mass_dist => abstract_set_mass_dist !! Sets the distribution of mass among the fragments depending on the regime type - procedure :: setup => collision_setup_system !! Initializer for the encounter collision system. Allocates the collider and fragments classes and the before/after snapshots - procedure :: add_fragments => collision_util_add_fragments_to_system !! Add fragments to system - procedure :: construct_temporary_system => collision_util_construct_temporary_system !! Constructs temporary n-body system in order to compute pre- and post-impact energy and momentum - procedure :: get_energy_and_momentum => collision_util_get_energy_momentum !! Calculates total system energy in either the pre-collision outcome state (lbefore = .true.) or the post-collision outcome state (lbefore = .false.) - procedure :: reset => collision_util_reset_system !! Deallocates all allocatables - procedure :: set_coordinate_system => collision_util_set_coordinate_system !! Sets the coordinate system of the collisional system - final :: collision_util_final_system !! Finalizer will deallocate all allocatables - end type collision_system - - abstract interface - subroutine abstract_generate_fragments(self, system, param, lfailure) - import collision_system, swiftest_nbody_system, swiftest_parameters - implicit none - class(collision_system), intent(inout) :: self !! Fraggle fragment system object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - logical, intent(out) :: lfailure !! Answers the question: Should this have been a merger instead? - end subroutine abstract_generate_fragments - - subroutine abstract_set_mass_dist(self, param) - import collision_system, swiftest_parameters - implicit none - class(collision_system), intent(inout) :: self !! Collision system object - class(swiftest_parameters), intent(in) :: param !! Current Swiftest run configuration parameters - end subroutine abstract_set_mass_dist - end interface - - !! NetCDF dimension and variable names for the enounter save object - type, extends(encounter_io_parameters) :: collision_io_parameters - integer(I4B) :: stage_dimid !! ID for the stage dimension - integer(I4B) :: stage_varid !! ID for the stage variable - character(NAMELEN) :: stage_dimname = "stage" !! name of the stage dimension (before/after) - character(len=6), dimension(2) :: stage_coords = ["before", "after"] !! The stage coordinate labels - - character(NAMELEN) :: event_dimname = "collision" !! Name of collision event dimension - integer(I4B) :: event_dimid !! ID for the collision event dimension - integer(I4B) :: event_varid !! ID for the collision event variable - integer(I4B) :: event_dimsize = 0 !! Number of events - - character(NAMELEN) :: Qloss_varname = "Qloss" !! name of the energy loss variable - integer(I4B) :: Qloss_varid !! ID for the energy loss variable - character(NAMELEN) :: regime_varname = "regime" !! name of the collision regime variable - integer(I4B) :: regime_varid !! ID for the collision regime variable - - contains - procedure :: initialize => collision_io_initialize_output !! Initialize a set of parameters used to identify a NetCDF output object - end type collision_io_parameters - - type, extends(encounter_snapshot) :: collision_snapshot - logical :: lcollision !! Indicates that this snapshot contains at least one collision - class(collision_system), allocatable :: collision_system !! impactors object at this snapshot - contains - procedure :: write_frame => collision_io_write_frame_snapshot !! Writes a frame of encounter data to file - procedure :: get_idvals => collision_util_get_idvalues_snapshot !! Gets an array of all id values saved in this snapshot - final :: collision_util_final_snapshot !! Finalizer deallocates all allocatables - end type collision_snapshot - - !> A class that that is used to store simulation history data between file output - type, extends(encounter_storage) :: collision_storage - contains - procedure :: dump => collision_io_dump !! Dumps contents of encounter history to file - procedure :: take_snapshot => collision_util_snapshot !! Take a minimal snapshot of the system through an encounter - procedure :: make_index_map => collision_util_index_map !! Maps body id values to storage index values so we don't have to use unlimited dimensions for id - final :: collision_util_final_storage !! Finalizer deallocates all allocatables - end type collision_storage - - interface - module subroutine collision_io_dump(self, param) - implicit none - class(collision_storage(*)), intent(inout) :: self !! Collision storage object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - end subroutine collision_io_dump - - module subroutine collision_io_initialize_output(self, param) - implicit none - class(collision_io_parameters), intent(inout) :: self !! Parameters used to identify a particular NetCDF dataset - class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters - end subroutine collision_io_initialize_output - - module subroutine collision_io_write_frame_snapshot(self, nc, param) - implicit none - class(collision_snapshot), intent(in) :: self !! Swiftest encounter structure - class(netcdf_parameters), intent(inout) :: nc !! Parameters used to identify a particular encounter io NetCDF dataset - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - end subroutine collision_io_write_frame_snapshot - - !> The following interfaces are placeholders intended to satisfy the required abstract methods given by the parent class - module subroutine collision_util_placeholder_accel(self, system, param, t, lbeg) - use swiftest_classes, only : swiftest_nbody_system, swiftest_parameters - implicit none - class(collision_fragments), intent(inout) :: self !! Fraggle fragment system object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - real(DP), intent(in) :: t !! Current simulation time - logical, intent(in) :: lbeg !! Optional argument that determines whether or not this is the beginning or end of the step - end subroutine collision_util_placeholder_accel - - module subroutine collision_util_placeholder_kick(self, system, param, t, dt, lbeg) - use swiftest_classes, only : swiftest_nbody_system, swiftest_parameters - implicit none - class(collision_fragments), intent(inout) :: self !! Fraggle fragment system object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system objec - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - real(DP), intent(in) :: t !! Current time - real(DP), intent(in) :: dt !! Stepsize - logical, intent(in) :: lbeg !! Logical flag indicating whether this is the beginning of the half step or not. - end subroutine collision_util_placeholder_kick - - module subroutine collision_util_placeholder_step(self, system, param, t, dt) - use swiftest_classes, only : swiftest_nbody_system, swiftest_parameters - implicit none - class(collision_fragments), intent(inout) :: self !! Helio massive body particle object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - real(DP), intent(in) :: t !! Current simulation time - real(DP), intent(in) :: dt !! Stepsiz - end subroutine collision_util_placeholder_step - - module subroutine collision_regime_impactors(self, system, param) - implicit none - class(collision_impactors), intent(inout) :: self !! Collision system impactors object - class(swiftest_nbody_system), intent(in) :: system !! Swiftest nbody system object - class(swiftest_parameters), intent(in) :: param !! Current Swiftest run configuration parameters - end subroutine collision_regime_impactors - - module subroutine collision_util_set_coordinate_system(self) - implicit none - class(collision_system), intent(inout) :: self !! Collisional system - end subroutine collision_util_set_coordinate_system - - module subroutine collision_setup_fragments(self, n, param) - implicit none - class(collision_fragments), intent(inout) :: self !! Fragment system object - integer(I4B), intent(in) :: n !! Number of fragments - class(swiftest_parameters), intent(in) :: param !! Current swiftest run configuration parameters - end subroutine collision_setup_fragments - - module subroutine collision_setup_impactors(self, system, param) - implicit none - class(collision_impactors), intent(inout) :: self !! Fragment system object - class(swiftest_nbody_system), intent(in) :: system - class(swiftest_parameters), intent(in) :: param !! Current swiftest run configuration parameters - end subroutine collision_setup_impactors - - module subroutine collision_setup_system(self, param) - use swiftest_classes, only : swiftest_parameters - implicit none - class(collision_system), intent(inout) :: self !! Collision system object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - end subroutine collision_setup_system - - module subroutine collision_util_add_fragments_to_system(self, system, param) - implicit none - class(collision_system), intent(in) :: self !! Collision system system object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object - class(swiftest_parameters), intent(in) :: param !! Current swiftest run configuration parameters - end subroutine collision_util_add_fragments_to_system - - module subroutine collision_util_construct_temporary_system(self, nbody_system, param, tmpsys, tmpparam) - implicit none - class(collision_system), intent(inout) :: self !! Fraggle collision system object - class(swiftest_nbody_system), intent(in) :: nbody_system !! Original swiftest nbody system object - class(swiftest_parameters), intent(in) :: param !! Current swiftest run configuration parameters - class(swiftest_nbody_system), allocatable, intent(out) :: tmpsys !! Output temporary swiftest nbody system object - class(swiftest_parameters), allocatable, intent(out) :: tmpparam !! Output temporary configuration run parameters - end subroutine collision_util_construct_temporary_system - - module subroutine collision_util_dealloc_fragments(self) - implicit none - class(collision_fragments), intent(inout) :: self - end subroutine collision_util_dealloc_fragments - - module subroutine collision_util_final_impactors(self) - implicit none - type(collision_impactors), intent(inout) :: self !! Collision impactors storage object - end subroutine collision_util_final_impactors - - module subroutine collision_util_final_storage(self) - implicit none - type(collision_storage(*)), intent(inout) :: self !! SyMBA nbody system object - end subroutine collision_util_final_storage - - module subroutine collision_util_final_snapshot(self) - implicit none - type(collision_snapshot), intent(inout) :: self !! Fraggle storage snapshot object - end subroutine collision_util_final_snapshot - - module subroutine collision_util_final_system(self) - implicit none - type(collision_system), intent(inout) :: self !! Collision system object - end subroutine collision_util_final_system - - module subroutine collision_util_get_idvalues_snapshot(self, idvals) - implicit none - class(collision_snapshot), intent(in) :: self !! Fraggle snapshot object - integer(I4B), dimension(:), allocatable, intent(out) :: idvals !! Array of all id values saved in this snapshot - end subroutine collision_util_get_idvalues_snapshot - - module subroutine collision_util_get_energy_momentum(self, system, param, lbefore) - use swiftest_classes, only : swiftest_nbody_system, swiftest_parameters - implicit none - class(collision_system), intent(inout) :: self !! Encounter collision system object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object - class(swiftest_parameters), intent(inout) :: param !! Current swiftest run configuration parameters - logical, intent(in) :: lbefore !! Flag indicating that this the "before" state of the system, with impactors included and fragments excluded or vice versa - end subroutine collision_util_get_energy_momentum - - module subroutine collision_util_index_map(self) - implicit none - class(collision_storage(*)), intent(inout) :: self !! Collision storage object - end subroutine collision_util_index_map - - module subroutine collision_util_reset_impactors(self) - implicit none - class(collision_impactors), intent(inout) :: self !! Collision system object - end subroutine collision_util_reset_impactors - - module subroutine collision_util_reset_system(self, param) - implicit none - class(collision_system), intent(inout) :: self !! Collision system object - class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters - end subroutine collision_util_reset_system - - module subroutine collision_util_snapshot(self, param, system, t, arg) - implicit none - class(collision_storage(*)), intent(inout) :: self !! Swiftest storage object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object to store - real(DP), intent(in), optional :: t !! Time of snapshot if different from system time - character(*), intent(in), optional :: arg !! "before": takes a snapshot just before the collision. "after" takes the snapshot just after the collision. - end subroutine collision_util_snapshot - - end interface - -end module collision_classes - diff --git a/src/modules/encounter_classes.f90 b/src/modules/encounter.f90 similarity index 84% rename from src/modules/encounter_classes.f90 rename to src/modules/encounter.f90 index 164d97450..d47fca9ee 100644 --- a/src/modules/encounter_classes.f90 +++ b/src/modules/encounter.f90 @@ -7,32 +7,33 @@ !! You should have received a copy of the GNU General Public License along with Swiftest. !! If not, see: https://www.gnu.org/licenses. -module encounter_classes +module encounter !! author: The Purdue Swiftest Team - David A. Minton, Carlisle A. Wishard, Jennifer L.L. Pouplin, and Jacob R. Elliott !! !! Definition of classes and methods used to determine close encounters - use swiftest_globals - use swiftest_classes, only : swiftest_parameters, swiftest_nbody_system, swiftest_cb, swiftest_tp, swiftest_pl, swiftest_storage, netcdf_parameters + use globals + use base implicit none public integer(I4B), parameter :: SWEEPDIM = 3 - type :: encounter_list - integer(I8B) :: nenc = 0 !! Total number of encounters - logical :: lcollision !! Indicates if the encounter resulted in at least one collision - real(DP) :: t !! Time of encounter - logical, dimension(:), allocatable :: lclosest !! indicates that thie pair of bodies is in currently at its closest approach point - logical, dimension(:), allocatable :: lvdotr !! relative vdotr flag - integer(I4B), dimension(:), allocatable :: status !! status of the interaction - integer(I4B), dimension(:), allocatable :: index1 !! position of the first body in the encounter - integer(I4B), dimension(:), allocatable :: index2 !! position of the second body in the encounter - integer(I4B), dimension(:), allocatable :: id1 !! id of the first body in the encounter - integer(I4B), dimension(:), allocatable :: id2 !! id of the second body in the encounter - real(DP), dimension(:,:), allocatable :: r1 !! the position of body 1 in the encounter - real(DP), dimension(:,:), allocatable :: r2 !! the position of body 2 in the encounter - real(DP), dimension(:,:), allocatable :: v1 !! the velocity of body 1 in the encounter - real(DP), dimension(:,:), allocatable :: v2 !! the velocity of body 2 in the encounter + type, abstract :: encounter_list + integer(I8B) :: nenc = 0 !! Total number of encounters + real(DP) :: t !! Time of encounter + logical :: lcollision !! Indicates if the encounter resulted in at least one collision + real(DP), dimension(:), allocatable :: tcollision!! Time of collision + logical, dimension(:), allocatable :: lclosest !! indicates that thie pair of bodies is in currently at its closest approach point + logical, dimension(:), allocatable :: lvdotr !! relative vdotr flag + integer(I4B), dimension(:), allocatable :: status !! status of the interaction + integer(I4B), dimension(:), allocatable :: index1 !! position of the first body in the encounter + integer(I4B), dimension(:), allocatable :: index2 !! position of the second body in the encounter + integer(I4B), dimension(:), allocatable :: id1 !! id of the first body in the encounter + integer(I4B), dimension(:), allocatable :: id2 !! id of the second body in the encounter + real(DP), dimension(:,:), allocatable :: r1 !! the position of body 1 in the encounter + real(DP), dimension(:,:), allocatable :: r2 !! the position of body 2 in the encounter + real(DP), dimension(:,:), allocatable :: v1 !! the velocity of body 1 in the encounter + real(DP), dimension(:,:), allocatable :: v2 !! the velocity of body 2 in the encounter 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 @@ -40,23 +41,23 @@ module encounter_classes 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 end type encounter_list + type :: encounter_snapshot !! A simplified version of a SyMBA nbody system object for storing minimal snapshots of the system state during encounters - class(swiftest_pl), allocatable :: pl !! Massive body data structure - class(swiftest_tp), allocatable :: tp !! Test particle data structure + class(base_object), allocatable :: pl !! Massive body data structure + class(base_object), allocatable :: tp !! Test particle data structure real(DP) :: t !! Simulation time when snapshot was taken integer(I8B) :: iloop !! Loop number at time of snapshot contains - procedure :: write_frame => encounter_io_write_frame_snapshot !! Writes a frame of encounter data to file - procedure :: get_idvals => encounter_util_get_idvalues_snapshot !! Gets an array of all id values saved in this snapshot + procedure :: write_frame => encounter_io_write_frame_snapshot !! Writes a frame of encounter data to file + procedure :: get_idvals => encounter_util_get_idvalues_snapshot !! Gets an array of all id values saved in this snapshot final :: encounter_util_final_snapshot end type encounter_snapshot !> A class that that is used to store simulation history data between file output - type, extends(swiftest_storage) :: encounter_storage + type, extends(base_storage) :: encounter_storage contains procedure :: dump => encounter_io_dump !! Dumps contents of encounter history to file procedure :: get_index_values => encounter_util_get_vals_storage !! Gets the unique values of the indices of a storage object (i.e. body id or time value) @@ -66,7 +67,7 @@ module encounter_classes end type encounter_storage !> NetCDF dimension and variable names for the enounter save object - type, extends(netcdf_parameters) :: encounter_io_parameters + type, extends(base_io_netcdf_parameters) :: encounter_io_parameters character(NAMELEN) :: loop_varname = "loopnum" !! Loop number for encounter integer(I4B) :: loop_varid !! ID for the recursion level variable integer(I4B) :: time_dimsize = 0 !! Number of time values in snapshot @@ -74,6 +75,7 @@ module encounter_classes integer(I4B) :: file_number = 1 !! The number to append on the output file contains procedure :: initialize => encounter_io_initialize_output !! Initialize a set of parameters used to identify a NetCDF output object + procedure :: open => encounter_io_netcdf_open end type encounter_io_parameters type encounter_bounding_box_1D @@ -98,9 +100,9 @@ module encounter_classes interface module subroutine encounter_check_all_plpl(param, npl, x, v, renc, dt, nenc, index1, index2, lvdotr) - use swiftest_classes, only: swiftest_parameters + use base, only: base_parameters implicit none - class(swiftest_parameters), intent(inout) :: param !! Current Swiftest run configuration parameter5s + class(base_parameters), intent(inout) :: param !! Current Swiftest run configuration parameter5s integer(I4B), intent(in) :: npl !! Total number of massive bodies real(DP), dimension(:,:), intent(in) :: x !! Position vectors of massive bodies real(DP), dimension(:,:), intent(in) :: v !! Velocity vectors of massive bodies @@ -114,9 +116,9 @@ end subroutine encounter_check_all_plpl module subroutine encounter_check_all_plplm(param, nplm, nplt, xplm, vplm, xplt, vplt, rencm, renct, dt, & nenc, index1, index2, lvdotr) - use swiftest_classes, only: swiftest_parameters + use base, only: base_parameters implicit none - class(swiftest_parameters), intent(inout) :: param !! Current Swiftest run configuration parameter5s + class(base_parameters), intent(inout) :: param !! Current Swiftest run configuration parameter5s integer(I4B), intent(in) :: nplm !! Total number of fully interacting massive bodies integer(I4B), intent(in) :: nplt !! Total number of partially interacting masive bodies (GM < GMTINY) real(DP), dimension(:,:), intent(in) :: xplm !! Position vectors of fully interacting massive bodies @@ -133,9 +135,9 @@ module subroutine encounter_check_all_plplm(param, nplm, nplt, xplm, vplm, xplt, end subroutine encounter_check_all_plplm module subroutine encounter_check_all_pltp(param, npl, ntp, xpl, vpl, xtp, vtp, renc, dt, nenc, index1, index2, lvdotr) - use swiftest_classes, only: swiftest_parameters + use base, only: base_parameters implicit none - class(swiftest_parameters), intent(inout) :: param !! Current Swiftest run configuration parameter5s + class(base_parameters), intent(inout) :: param !! Current Swiftest run configuration parameter5s integer(I4B), intent(in) :: npl !! Total number of massive bodies integer(I4B), intent(in) :: ntp !! Total number of test particles real(DP), dimension(:,:), intent(in) :: xpl !! Position vectors of massive bodies @@ -163,7 +165,7 @@ end subroutine encounter_check_one module subroutine encounter_check_collapse_ragged_list(ragged_list, n1, nenc, index1, index2, lvdotr) implicit none - type(encounter_list), dimension(:), intent(in) :: ragged_list !! The ragged encounter list + class(encounter_list), dimension(:), intent(in) :: ragged_list !! The ragged encounter list integer(I4B), intent(in) :: n1 !! Number of bodies 1 integer(I8B), intent(out) :: nenc !! Total number of encountersj integer(I4B), dimension(:), allocatable, intent(out) :: index1 !! Array of indices for body 1 @@ -211,20 +213,27 @@ end subroutine encounter_check_sweep_aabb_single_list module subroutine encounter_io_dump(self, param) implicit none class(encounter_storage(*)), intent(inout) :: self !! Encounter storage object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + class(base_parameters), intent(inout) :: param !! Current run configuration parameters end subroutine encounter_io_dump 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 + class(base_parameters), intent(in) :: param end subroutine encounter_io_initialize_output - module subroutine encounter_io_write_frame_snapshot(self, nc, param) + module subroutine encounter_io_netcdf_open(self, param, readonly) implicit none - class(encounter_snapshot), intent(in) :: self !! Swiftest encounter structure - class(netcdf_parameters), intent(inout) :: nc !! Parameters used to identify a particular encounter io NetCDF dataset - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + class(encounter_io_parameters), intent(inout) :: self !! Parameters used to identify a particular NetCDF dataset + class(base_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_netcdf_open + + module subroutine encounter_io_write_frame_snapshot(self, history, param) + implicit none + class(encounter_snapshot), intent(in) :: self !! Swiftest encounter structure + class(encounter_storage(*)), intent(inout) :: history !! Encounter storage object + class(base_parameters), intent(inout) :: param !! Current run configuration parameters end subroutine encounter_io_write_frame_snapshot module subroutine encounter_setup_aabb(self, n, n_last) @@ -268,11 +277,6 @@ module subroutine encounter_util_final_aabb(self) type(encounter_bounding_box_1D), intent(inout) :: self !!Bounding box structure along a single dimension end subroutine encounter_util_final_aabb - module subroutine encounter_util_final_list(self) - implicit none - type(encounter_list), intent(inout) :: self !! Swiftest encounter list object - end subroutine encounter_util_final_list - module subroutine encounter_util_final_snapshot(self) implicit none type(encounter_snapshot), intent(inout) :: self !! Encounter snapshot object @@ -309,8 +313,8 @@ end subroutine encounter_util_resize_list module subroutine encounter_util_snapshot(self, param, system, t, arg) implicit none class(encounter_storage(*)), intent(inout) :: self !! Swiftest storage object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object to store + class(base_parameters), intent(inout) :: param !! Current run configuration parameters + class(base_nbody_system), intent(inout) :: system !! Swiftest nbody system object to store real(DP), intent(in), optional :: t !! Time of snapshot if different from system time character(*), intent(in), optional :: arg !! Optional argument (needed for extended storage type used in collision snapshots) end subroutine encounter_util_snapshot @@ -325,5 +329,5 @@ end subroutine encounter_util_spill_list end interface -end module encounter_classes +end module encounter diff --git a/src/modules/fraggle_classes.f90 b/src/modules/fraggle.f90 similarity index 61% rename from src/modules/fraggle_classes.f90 rename to src/modules/fraggle.f90 index de8542f67..6b336fff4 100644 --- a/src/modules/fraggle_classes.f90 +++ b/src/modules/fraggle.f90 @@ -7,46 +7,42 @@ !! You should have received a copy of the GNU General Public License along with Swiftest. !! If not, see: https://www.gnu.org/licenses. -module fraggle_classes +module fraggle !! author: The Purdue Swiftest Team - David A. Minton, Carlisle A. Wishard, Jennifer L.L. Pouplin, and Jacob R. Elliott !! !! Definition of classes and methods specific to Fraggle: *Fragment* *g*eneration that conserves angular momentum (*L*) and energy (*E*) - use swiftest_globals - use swiftest_classes, only : swiftest_parameters, swiftest_nbody_system, swiftest_cb, swiftest_pl, swiftest_storage, netcdf_parameters - use encounter_classes, only : encounter_snapshot, encounter_io_parameters, encounter_storage - use collision_classes, only : collision_impactors, collision_fragments, collision_system + use globals + use base + use encounter + use collision implicit none public integer(I4B), parameter :: FRAGGLE_NMASS_DIST = 3 !! Number of mass bins returned by the regime calculation (largest fragment, second largest, and remainder) character(len=*), parameter :: FRAGGLE_LOG_OUT = "fraggle.log" !! Name of log file for Fraggle diagnostic information - !******************************************************************************************************************************** - ! fraggle_fragments class definitions and method interfaces - !******************************************************************************************************************************* + !> Class definition for the variables that describe a collection of fragments by Fraggle barycentric coordinates type, extends(collision_fragments) :: fraggle_fragments - real(DP), dimension(:), allocatable :: v_r_mag !! Array of radial direction velocity magnitudes of individual fragments - real(DP), dimension(:), allocatable :: v_t_mag !! Array of tangential direction velocity magnitudes of individual fragments - real(DP), dimension(:), allocatable :: v_n_mag !! Array of normal direction velocity magnitudes of individual fragments - real(DP), dimension(NDIM) :: Lorbit !! Orbital angular momentum vector of all fragments - real(DP), dimension(NDIM) :: Lspin !! Spin angular momentum vector of all fragments - real(DP) :: ke_orbit !! Orbital kinetic energy of all fragments - real(DP) :: ke_spin !! Spin kinetic energy of all fragments - real(DP) :: ke_budget !! Kinetic energy budget for computing fragment trajectories - real(DP), dimension(NDIM) :: L_budget !! Angular momentum budget for computing fragment trajectories + real(DP), dimension(nbody) :: v_r_mag !! Array of radial direction velocity magnitudes of individual fragments + real(DP), dimension(nbody) :: v_t_mag !! Array of tangential direction velocity magnitudes of individual fragments + real(DP), dimension(nbody) :: v_n_mag !! Array of normal direction velocity magnitudes of individual fragments + real(DP), dimension(NDIM) :: Lorbit !! Orbital angular momentum vector of all fragments + real(DP), dimension(NDIM) :: Lspin !! Spin angular momentum vector of all fragments + real(DP) :: ke_orbit !! Orbital kinetic energy of all fragments + real(DP) :: ke_spin !! Spin kinetic energy of all fragments + real(DP) :: ke_budget !! Kinetic energy budget for computing fragment trajectories + real(DP), dimension(NDIM) :: L_budget !! Angular momentum budget for computing fragment trajectories contains - procedure :: setup => fraggle_setup_fragments !! Allocates arrays for n fragments in a Fraggle system. Passing n = 0 deallocates all arrays. - procedure :: reset => fraggle_setup_reset_fragments !! Resets all position and velocity-dependent fragment quantities in order to do a fresh calculation (does not reset mass, radius, or other values that get set prior to the call to fraggle_generate) - procedure :: get_angular_momentum => fraggle_util_get_angular_momentum !! Calcualtes the current angular momentum of the fragments - procedure :: dealloc => fraggle_util_dealloc_fragments !! Deallocates all allocatables - procedure :: restructure => fraggle_util_restructure !! Restructure the inputs after a failed attempt failed to find a set of positions and velocities that satisfy the energy and momentum constraints - final :: fraggle_util_final_fragments !! Finalizer will deallocate all allocatables - + procedure :: get_angular_momentum => fraggle_util_get_angular_momentum !! Calcualtes the current angular momentum of the fragments + procedure :: reset => fraggle_util_reset_fragments !! Resets all position and velocity-dependent fragment quantities in order to do a fresh calculation (does not reset mass, radius, or other values that get set prior to the call to fraggle_generate) + procedure :: restructure => fraggle_util_restructure !! Restructure the inputs after a failed attempt failed to find a set of positions and velocities that satisfy the energy and momentum constraints + final :: fraggle_util_final_fragments !! Finalizer will deallocate all allocatables end type fraggle_fragments + type, extends(collision_system) :: fraggle_system ! Scale factors used to scale dimensioned quantities to a more "natural" system where important quantities (like kinetic energy, momentum) are of order ~1 real(DP) :: dscale = 1.0_DP !! Distance dimension scale factor @@ -61,18 +57,21 @@ module fraggle_classes procedure :: set_mass_dist => fraggle_set_mass_dist !! Sets the distribution of mass among the fragments depending on the regime type procedure :: set_natural_scale => fraggle_set_natural_scale_factors !! Scales dimenional quantities to ~O(1) with respect to the collisional system. procedure :: set_original_scale => fraggle_set_original_scale_factors !! Restores dimenional quantities back to the original system units + procedure :: setup_fragments => fraggle_setup_fragments_system !! Initializer for the fragments of the collision system. procedure :: construct_temporary_system => fraggle_util_construct_temporary_system !! Constructs temporary n-body system in order to compute pre- and post-impact energy and momentum + procedure :: reset => fraggle_util_reset_system !! Deallocates all allocatables final :: fraggle_util_final_system !! Finalizer will deallocate all allocatables end type fraggle_system interface + module subroutine fraggle_generate_fragments(self, system, param, lfailure) - use swiftest_classes, only : swiftest_nbody_system, swiftest_parameters + use base, only : base_nbody_system, base_parameters implicit none class(fraggle_system), intent(inout) :: self !! Fraggle fragment system object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + class(base_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(base_parameters), intent(inout) :: param !! Current run configuration parameters logical, intent(out) :: lfailure !! Answers the question: Should this have been a merger instead? end subroutine fraggle_generate_fragments @@ -89,7 +88,7 @@ end subroutine fraggle_set_budgets module subroutine fraggle_set_mass_dist(self, param) implicit none class(fraggle_system), intent(inout) :: self !! Fraggle collision system object - class(swiftest_parameters), intent(in) :: param !! Current Swiftest run configuration parameters + class(base_parameters), intent(in) :: param !! Current Swiftest run configuration parameters end subroutine fraggle_set_mass_dist module subroutine fraggle_set_natural_scale_factors(self) @@ -97,43 +96,48 @@ module subroutine fraggle_set_natural_scale_factors(self) class(fraggle_system), intent(inout) :: self !! Fraggle collision system object end subroutine fraggle_set_natural_scale_factors + module function fraggle_resolve_disruption(system, param, t) result(status) + implicit none + class(base_nbody_system), intent(inout) :: system !! SyMBA nbody system object + class(base_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions + real(DP), intent(in) :: t !! Time of collision + integer(I4B) :: status !! Status flag assigned to this outcome + end function fraggle_resolve_disruption + + module function fraggle_resolve_hitandrun(system, param, t) result(status) + implicit none + class(base_nbody_system), intent(inout) :: system !! SyMBA nbody system object + class(base_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions + real(DP), intent(in) :: t !! Time of collision + integer(I4B) :: status !! Status flag assigned to this outcome + end function fraggle_resolve_hitandrun + module subroutine fraggle_set_original_scale_factors(self) implicit none class(fraggle_system), intent(inout) :: self !! Fraggle collision system object end subroutine fraggle_set_original_scale_factors - module subroutine fraggle_setup_fragments(self, n, param) + module subroutine fraggle_setup_fragments_system(self, nfrag) implicit none - class(fraggle_fragments), intent(inout) :: self - integer(I4B), intent(in) :: n - class(swiftest_parameters), intent(in) :: param - end subroutine fraggle_setup_fragments - - module subroutine fraggle_setup_reset_fragments(self) - implicit none - class(fraggle_fragments), intent(inout) :: self - end subroutine fraggle_setup_reset_fragments + class(fraggle_system), intent(inout) :: self !! Encounter collision system object + integer(I4B), intent(in) :: nfrag !! Number of fragments to create + end subroutine fraggle_setup_fragments_system module subroutine fraggle_util_get_angular_momentum(self) implicit none - class(fraggle_fragments), intent(inout) :: self !! Fraggle fragment system object + class(fraggle_fragments(*)), intent(inout) :: self !! Fraggle fragment system object end subroutine fraggle_util_get_angular_momentum module subroutine fraggle_util_construct_temporary_system(self, nbody_system, param, tmpsys, tmpparam) - use swiftest_classes, only : swiftest_nbody_system, swiftest_parameters + use base, only : base_nbody_system, base_parameters implicit none class(fraggle_system), intent(inout) :: self !! Fraggle collision system object - class(swiftest_nbody_system), intent(in) :: nbody_system !! Original swiftest nbody system object - class(swiftest_parameters), intent(in) :: param !! Current swiftest run configuration parameters - class(swiftest_nbody_system), allocatable, intent(out) :: tmpsys !! Output temporary swiftest nbody system object - class(swiftest_parameters), allocatable, intent(out) :: tmpparam !! Output temporary configuration run parameters + class(base_nbody_system), intent(in) :: nbody_system !! Original swiftest nbody system object + class(base_parameters), intent(in) :: param !! Current swiftest run configuration parameters + class(base_nbody_system), allocatable, intent(out) :: tmpsys !! Output temporary swiftest nbody system object + class(base_parameters), allocatable, intent(out) :: tmpparam !! Output temporary configuration run parameters end subroutine fraggle_util_construct_temporary_system - module subroutine fraggle_util_dealloc_fragments(self) - implicit none - class(fraggle_fragments), intent(inout) :: self - end subroutine fraggle_util_dealloc_fragments - module subroutine fraggle_util_final_impactors(self) implicit none type(collision_impactors), intent(inout) :: self !! Fraggle impactors object @@ -141,7 +145,7 @@ end subroutine fraggle_util_final_impactors module subroutine fraggle_util_final_fragments(self) implicit none - type(fraggle_fragments), intent(inout) :: self !! Fraggle frgments object + type(fraggle_fragments(*)), intent(inout) :: self !! Fraggle frgments object end subroutine fraggle_util_final_fragments module subroutine fraggle_util_final_system(self) @@ -149,9 +153,19 @@ module subroutine fraggle_util_final_system(self) type(fraggle_system), intent(inout) :: self !! Collision system object end subroutine fraggle_util_final_system + module subroutine fraggle_util_reset_fragments(self) + implicit none + class(fraggle_fragments(*)), intent(inout) :: self + end subroutine fraggle_util_reset_fragments + + module subroutine fraggle_util_reset_system(self) + implicit none + class(fraggle_system), intent(inout) :: self !! Collision system object + end subroutine fraggle_util_reset_system + module subroutine fraggle_util_restructure(self, impactors, try, f_spin, r_max_start) implicit none - class(fraggle_fragments), intent(inout) :: self !! Fraggle fragment system object + class(fraggle_fragments(*)), intent(inout) :: self !! Fraggle fragment system object class(collision_impactors), intent(in) :: impactors !! Fraggle collider system object integer(I4B), intent(in) :: try !! The current number of times Fraggle has tried to find a solution real(DP), intent(inout) :: f_spin !! Fraction of energy/momentum that goes into spin. This decreases ater a failed attempt @@ -175,4 +189,4 @@ module function fraggle_util_vmag_to_vb(v_r_mag, v_r_unit, v_t_mag, v_t_unit, m_ end function fraggle_util_vmag_to_vb end interface -end module fraggle_classes \ No newline at end of file +end module fraggle \ No newline at end of file diff --git a/src/modules/swiftest_globals.f90 b/src/modules/globals.f90 similarity index 90% rename from src/modules/swiftest_globals.f90 rename to src/modules/globals.f90 index fb669b559..23162a872 100644 --- a/src/modules/swiftest_globals.f90 +++ b/src/modules/globals.f90 @@ -7,12 +7,12 @@ !! You should have received a copy of the GNU General Public License along with Swiftest. !! If not, see: https://www.gnu.org/licenses. -module swiftest_globals +module globals !! author: David A. Minton !! graph: false !! !! Basic parameters, definitions, and global type definitions used throughout the Swiftest project - !! Adapted from David E. Kaufmann's Swifter routine: swiftest_globals.f90 and module_swifter.f90 + !! Adapted from David E. Kaufmann's Swifter routine: globals.f90 and module_swifter.f90 use, intrinsic :: iso_fortran_env ! Use the intrinsic kind definitions implicit none public @@ -45,14 +45,14 @@ module swiftest_globals !> Symbolic name for integrator types character(*), parameter :: UNKNOWN_INTEGRATOR = "UKNOWN INTEGRATOR" - character(*), parameter :: BS = "Bulirsch-Stoer" - character(*), parameter :: HELIO = "Democratic Heliocentric" - character(*), parameter :: RA15 = "Radau 15th order" - character(*), parameter :: TU4 = "T+U 4th order" - character(*), parameter :: WHM = "Wisdom-Holman Method" - character(*), parameter :: RMVS = "Regularized Mixed Variable Symplectic" - character(*), parameter :: SYMBA = "SyMBA" - character(*), parameter :: RINGMOONS = "SyMBA-RINGMOONS" + character(*), parameter :: INT_BS = "Bulirsch-Stoer" + character(*), parameter :: INT_HELIO = "Democratic Heliocentric" + character(*), parameter :: INT_RA15 = "Radau 15th order" + character(*), parameter :: INT_TU4 = "T+U 4th order" + character(*), parameter :: INT_WHM = "Wisdom-Holman Method" + character(*), parameter :: INT_RMVS = "Regularized Mixed Variable Symplectic" + character(*), parameter :: INT_SYMBA = "SyMBA" + character(*), parameter :: INT_RINGMOONS = "SyMBA-RINGMOONS" integer(I4B), parameter :: STRMAX = 512 !! Maximum size of character strings integer(I4B), parameter :: NAMELEN = 32 !! Maximum size of name strings @@ -86,12 +86,12 @@ module swiftest_globals integer(I4B), parameter :: DISCARDED_PLQ = -6 integer(I4B), parameter :: DISCARDED_DRIFTERR = -7 integer(I4B), parameter :: MERGED = -8 - integer(I4B), parameter :: DISRUPTION = -9 + integer(I4B), parameter :: DISRUPTED = -9 integer(I4B), parameter :: SUPERCATASTROPHIC = -10 integer(I4B), parameter :: GRAZE_AND_MERGE = -11 integer(I4B), parameter :: HIT_AND_RUN_DISRUPT = -12 integer(I4B), parameter :: HIT_AND_RUN_PURE = -13 - integer(I4B), parameter :: COLLISION = -14 + integer(I4B), parameter :: COLLIDED = -14 integer(I4B), parameter :: NEW_PARTICLE = -15 integer(I4B), parameter :: OLD_PARTICLE = -16 @@ -124,4 +124,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 -end module swiftest_globals +end module globals diff --git a/src/modules/helio_classes.f90 b/src/modules/helio.f90 similarity index 83% rename from src/modules/helio_classes.f90 rename to src/modules/helio.f90 index bad042664..8a93badae 100644 --- a/src/modules/helio_classes.f90 +++ b/src/modules/helio.f90 @@ -7,21 +7,17 @@ !! You should have received a copy of the GNU General Public License along with Swiftest. !! If not, see: https://www.gnu.org/licenses. -module helio_classes +module helio !! author: The Purdue Swiftest Team - David A. Minton, Carlisle A. Wishard, Jennifer L.L. Pouplin, and Jacob R. Elliott !! !! Definition of classes and methods specific to the Democratic Heliocentric Method !! Adapted from David E. Kaufmann's Swifter routine: module_helio.f90 - use swiftest_globals - use swiftest_classes, only : swiftest_cb, swiftest_pl, swiftest_tp, swiftest_nbody_system - use whm_classes, only : whm_nbody_system + use swiftest + use whm implicit none public - !******************************************************************************************************************************** - ! helio_nbody_system class definitions and method interfaces - !******************************************************************************************************************************** type, extends(whm_nbody_system) :: helio_nbody_system contains procedure :: step => helio_step_system !! Advance the Helio nbody system forward in time by one step @@ -29,9 +25,7 @@ module helio_classes final :: helio_util_final_system !! Finalizes the Helio system object - deallocates all allocatables end type helio_nbody_system - !******************************************************************************************************************************** - ! helio_cb class definitions and method interfaces - !******************************************************************************************************************************* + !> Helio central body particle class type, extends(swiftest_cb) :: helio_cb real(DP), dimension(NDIM) :: ptbeg !! negative barycentric velocity of the central body at the beginning of time step @@ -39,9 +33,6 @@ module helio_classes contains end type helio_cb - !******************************************************************************************************************************** - ! helio_pl class definitions and method interfaces - !******************************************************************************************************************************* !! Helio massive body particle class type, extends(swiftest_pl) :: helio_pl @@ -56,9 +47,6 @@ module helio_classes final :: helio_util_final_pl !! Finalizes the Helio massive body object - deallocates all allocatables end type helio_pl - !******************************************************************************************************************************** - ! helio_tp class definitions and method interfaces - !******************************************************************************************************************************* !! Helio test particle class type, extends(swiftest_tp) :: helio_tp @@ -75,7 +63,6 @@ module helio_classes interface module subroutine helio_drift_body(self, system, param, dt) - use swiftest_classes, only : swiftest_body, swiftest_nbody_system, swiftest_parameters implicit none class(swiftest_body), intent(inout) :: self !! Swiftest massive body object class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object @@ -84,7 +71,6 @@ module subroutine helio_drift_body(self, system, param, dt) end subroutine helio_drift_body module subroutine helio_drift_pl(self, system, param, dt) - use swiftest_classes, only : swiftest_nbody_system, swiftest_parameters implicit none class(helio_pl), intent(inout) :: self !! Helio massive body object class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object @@ -93,7 +79,6 @@ module subroutine helio_drift_pl(self, system, param, dt) end subroutine helio_drift_pl module subroutine helio_drift_tp(self, system, param, dt) - use swiftest_classes, only : swiftest_nbody_system, swiftest_parameters implicit none class(helio_tp), intent(inout) :: self !! Helio massive body object class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object @@ -118,21 +103,18 @@ module subroutine helio_drift_linear_tp(self, cb, dt, lbeg) end subroutine helio_drift_linear_tp pure module subroutine helio_gr_kick_getacch_pl(self, param) - use swiftest_classes, only : swiftest_parameters implicit none class(helio_pl), intent(inout) :: self !! Helio massive body particle data structure class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters end subroutine helio_gr_kick_getacch_pl pure module subroutine helio_gr_kick_getacch_tp(self, param) - use swiftest_classes, only : swiftest_parameters implicit none class(helio_tp), intent(inout) :: self !! Helio massive body particle data structure class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters end subroutine helio_gr_kick_getacch_tp pure module subroutine helio_gr_p4_pl(self, system, param, dt) - use swiftest_classes, only : swiftest_parameters, swiftest_nbody_system implicit none class(helio_pl), intent(inout) :: self !! Swiftest particle object class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object @@ -141,7 +123,6 @@ pure module subroutine helio_gr_p4_pl(self, system, param, dt) end subroutine helio_gr_p4_pl pure module subroutine helio_gr_p4_tp(self, system, param, dt) - use swiftest_classes, only : swiftest_parameters, swiftest_nbody_system implicit none class(helio_tp), intent(inout) :: self !! Swiftest particle object class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object @@ -150,7 +131,6 @@ pure module subroutine helio_gr_p4_tp(self, system, param, dt) end subroutine helio_gr_p4_tp module subroutine helio_kick_getacch_pl(self, system, param, t, lbeg) - use swiftest_classes, only : swiftest_parameters, swiftest_nbody_system implicit none class(helio_pl), intent(inout) :: self !! Helio massive body object class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object @@ -160,7 +140,6 @@ module subroutine helio_kick_getacch_pl(self, system, param, t, lbeg) end subroutine helio_kick_getacch_pl module subroutine helio_kick_getacch_tp(self, system, param, t, lbeg) - use swiftest_classes, only : swiftest_nbody_system, swiftest_parameters implicit none class(helio_tp), intent(inout) :: self !! Helio test particle object class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object @@ -170,7 +149,6 @@ module subroutine helio_kick_getacch_tp(self, system, param, t, lbeg) end subroutine helio_kick_getacch_tp module subroutine helio_kick_vb_pl(self, system, param, t, dt, lbeg) - use swiftest_classes, only : swiftest_nbody_system, swiftest_parameters implicit none class(helio_pl), intent(inout) :: self !! Helio massive body object class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object @@ -181,7 +159,6 @@ module subroutine helio_kick_vb_pl(self, system, param, t, dt, lbeg) end subroutine helio_kick_vb_pl module subroutine helio_kick_vb_tp(self, system, param, t, dt, lbeg) - use swiftest_classes, only : swiftest_nbody_system, swiftest_parameters implicit none class(helio_tp), intent(inout) :: self !! Helio test particle object class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object @@ -192,14 +169,12 @@ module subroutine helio_kick_vb_tp(self, system, param, t, dt, lbeg) end subroutine helio_kick_vb_tp module subroutine helio_setup_initialize_system(self, param) - use swiftest_classes, only : swiftest_parameters implicit none class(helio_nbody_system), intent(inout) :: self !! Helio nbody system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters end subroutine helio_setup_initialize_system module subroutine helio_step_pl(self, system, param, t, dt) - use swiftest_classes, only : swiftest_nbody_system, swiftest_parameters implicit none class(helio_pl), intent(inout) :: self !! Helio massive body particle object class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system @@ -209,7 +184,6 @@ module subroutine helio_step_pl(self, system, param, t, dt) end subroutine helio_step_pl module subroutine helio_step_system(self, param, t, dt) - use swiftest_classes, only : swiftest_parameters implicit none class(helio_nbody_system), intent(inout) :: self !! Helio nbody system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters @@ -218,7 +192,6 @@ module subroutine helio_step_system(self, param, t, dt) end subroutine helio_step_system module subroutine helio_step_tp(self, system, param, t, dt) - use swiftest_classes, only : swiftest_cb, swiftest_parameters, swiftest_nbody_system implicit none class(helio_tp), intent(inout) :: self !! Helio test particle object class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object @@ -244,4 +217,4 @@ end subroutine helio_util_final_tp end interface -end module helio_classes +end module helio diff --git a/src/io/io_progress_bar.f90 b/src/modules/io_progress_bar.f90 similarity index 84% rename from src/io/io_progress_bar.f90 rename to src/modules/io_progress_bar.f90 index 9a49ff935..1e1067da7 100644 --- a/src/io/io_progress_bar.f90 +++ b/src/modules/io_progress_bar.f90 @@ -2,14 +2,14 @@ module io_progress_bar !! author: The Purdue Swiftest Team - David A. Minton, Carlisle A. Wishard, Jennifer L.L. Pouplin, and Jacob R. Elliott !! !! Definition of classes and methods used to determine close encounters - use swiftest_globals - use swiftest_classes + use globals + use base implicit none public character(len=1),parameter, private :: barchar = "#" !! The progress bar character - type :: progress_bar + type :: pbar !! author: David A. Minton !! !! Implements a class for a simple progress bar that can print on the screen. @@ -20,19 +20,19 @@ module io_progress_bar character(len=32) :: fmt !! The format string that is used to define the progress bar itself character(len=64) :: message !! The current message displayed at the end of the progress bar contains - procedure :: reset => io_pbar_reset !! Resets the progress bar to the beginning - procedure :: update => io_pbar_update !! Updates the progress bar with new values - end type progress_bar + procedure :: reset => io_progress_bar_reset !! Resets the progress bar to the beginning + procedure :: update => io_progress_bar_update !! Updates the progress bar with new values + end type pbar contains - subroutine io_pbar_reset(self, loop_length) + subroutine io_progress_bar_reset(self, loop_length) !! author: David A. Minton !! !! Resets the progress bar to the beginning implicit none ! Arguments - class(progress_bar),intent(inout) :: self !! The progress bar object + class(pbar),intent(inout) :: self !! The progress bar object integer(I8B), intent(in) :: loop_length !! The length of the loop that the progress bar is attached to ! Internals character(len=2) :: numchar @@ -53,16 +53,16 @@ subroutine io_pbar_reset(self, loop_length) write(*,fmt=self%fmt) char(13),self%barstr,trim(adjustl(self%message)) return - end subroutine io_pbar_reset + end subroutine io_progress_bar_reset - subroutine io_pbar_update(self,i,message) + subroutine io_progress_bar_update(self,i,message) !! author: David A. Minton !! !! Updates the progress bar with new values implicit none ! Arguments - class(progress_bar), intent(inout) :: self !! Progres bar object + class(pbar), intent(inout) :: self !! Progres bar object integer(I8B), intent(in) :: i !! The current loop index of the progress loop character(len=*), intent(in), optional :: message !! An optional message to display to the right of the progress bar ! Internals @@ -92,7 +92,7 @@ subroutine io_pbar_update(self,i,message) return - end subroutine io_pbar_update + end subroutine io_progress_bar_update end module io_progress_bar diff --git a/src/modules/lambda_function.f90 b/src/modules/lambda_function.f90 index 44b97dfcc..9f7a0ef70 100644 --- a/src/modules/lambda_function.f90 +++ b/src/modules/lambda_function.f90 @@ -130,7 +130,7 @@ module lambda_function !! end program usage !! ******************************************************************************************************************************************************************************************** - use swiftest_globals + use globals implicit none public diff --git a/src/modules/swiftest_operators.f90 b/src/modules/operators.f90 similarity index 99% rename from src/modules/swiftest_operators.f90 rename to src/modules/operators.f90 index 165c7b283..8c351236b 100644 --- a/src/modules/swiftest_operators.f90 +++ b/src/modules/operators.f90 @@ -7,14 +7,14 @@ !! You should have received a copy of the GNU General Public License along with Swiftest. !! If not, see: https://www.gnu.org/licenses. -module swiftest_operators +module operators !! author: David A. Minton !! !! Custom operators, including !! A .cross. B = Cross product of A(1:NDIM) and B(1:NDIM) !! !! Each operator can also do element-wise computation on arrays of the form .mag. A(1:NDIM, 1:n) - use swiftest_globals + use globals implicit none public @@ -207,4 +207,4 @@ end function operator_unit_el_qp end interface -end module swiftest_operators +end module operators diff --git a/src/modules/rmvs_classes.f90 b/src/modules/rmvs.f90 similarity index 89% rename from src/modules/rmvs_classes.f90 rename to src/modules/rmvs.f90 index f8add18eb..b42e0a937 100644 --- a/src/modules/rmvs_classes.f90 +++ b/src/modules/rmvs.f90 @@ -7,13 +7,13 @@ !! You should have received a copy of the GNU General Public License along with Swiftest. !! If not, see: https://www.gnu.org/licenses. -module rmvs_classes +module rmvs !! author: David A. Minton !! - !! Definition of classes and methods specific to the Regularized Mixed Variable Symplectic (RMVS) integrator + !! Definition of classes and methods specific to the Regularized Mixed Variable Symplectic (INT_RMVS) integrator !! Partially adapted from David E. Kaufmann's Swifter module: module_rmvs.f90 - use swiftest_globals - use whm_classes, only : whm_cb, whm_pl, whm_tp, whm_nbody_system + use swiftest + use whm implicit none public @@ -24,11 +24,9 @@ module rmvs_classes real(DP), private, parameter :: RHPSCALE = 1.0_DP real(DP), private, parameter :: FACQDT = 2.0_DP - !******************************************************************************************************************************** - ! rmvs_nbody_system class definitions and method interfaces - !******************************************************************************************************************************** + + !> In the RMVS integrator, pl-tp encounters are handeled, but not pl-pl type, extends(whm_nbody_system) :: rmvs_nbody_system - !> In the RMVS integrator, only test particles are discarded logical :: lplanetocentric = .false. !! Flag that indicates that the object is a planetocentric set of masive bodies used for close encounter calculations real(DP) :: rts !! fraction of Hill's sphere radius to use as radius of encounter region real(DP), dimension(:,:), allocatable :: vbeg !! Planet velocities at beginning ot step @@ -49,9 +47,7 @@ module rmvs_classes final :: rmvs_util_final_interp !! Finalizes the RMVS interpolated system variables object - deallocates all allocatables end type rmvs_interp - !******************************************************************************************************************************** - ! rmvs_cb class definitions and method interfaces - !******************************************************************************************************************************* + !> RMVS central body particle class type, extends(whm_cb) :: rmvs_cb type(rmvs_interp), dimension(:), allocatable :: outer !! interpolated heliocentric central body position for outer encounters @@ -62,9 +58,6 @@ module rmvs_classes final :: rmvs_util_final_cb !! Finalizes the RMVS central body object - deallocates all allocatables end type rmvs_cb - !******************************************************************************************************************************** - ! rmvs_tp class definitions and method interfaces - !******************************************************************************************************************************* !! RMVS test particle class type, extends(whm_tp) :: rmvs_tp @@ -97,9 +90,6 @@ module rmvs_classes final :: rmvs_util_final_tp !! Finalizes the RMVS test particle object - deallocates all allocatables end type rmvs_tp - !******************************************************************************************************************************** - ! rmvs_pl class definitions and method interfaces - !******************************************************************************************************************************* !> RMVS massive body particle class type, extends(whm_pl) :: rmvs_pl @@ -124,7 +114,6 @@ module rmvs_classes interface module subroutine rmvs_discard_tp(self, system, param) - use swiftest_classes, only : swiftest_nbody_system, swiftest_parameters implicit none class(rmvs_tp), intent(inout) :: self !! RMVS test particle object class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object @@ -132,7 +121,6 @@ module subroutine rmvs_discard_tp(self, system, param) end subroutine rmvs_discard_tp module function rmvs_encounter_check_tp(self, param, system, dt) result(lencounter) - use swiftest_classes, only : swiftest_parameters implicit none class(rmvs_tp), intent(inout) :: self !! RMVS test particle object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters @@ -142,7 +130,6 @@ module function rmvs_encounter_check_tp(self, param, system, dt) result(lencount end function rmvs_encounter_check_tp module subroutine rmvs_kick_getacch_tp(self, system, param, t, lbeg) - use swiftest_classes, only : swiftest_nbody_system, swiftest_parameters implicit none class(rmvs_tp), intent(inout) :: self !! RMVS test particle data structure class(swiftest_nbody_system), intent(inout) :: system !! Swiftest central body particle data structuree @@ -152,7 +139,6 @@ module subroutine rmvs_kick_getacch_tp(self, system, param, t, lbeg) end subroutine rmvs_kick_getacch_tp module subroutine rmvs_setup_pl(self, n, param) - use swiftest_classes, only : swiftest_parameters implicit none class(rmvs_pl), intent(inout) :: self !! RMVS massive body object integer(I4B), intent(in) :: n !! Number of particles to allocate space for @@ -160,14 +146,12 @@ module subroutine rmvs_setup_pl(self, n, param) end subroutine rmvs_setup_pl module subroutine rmvs_setup_initialize_system(self, param) - use swiftest_classes, only : swiftest_parameters implicit none class(rmvs_nbody_system), intent(inout) :: self !! RMVS system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters end subroutine rmvs_setup_initialize_system module subroutine rmvs_setup_tp(self, n, param) - use swiftest_classes, only : swiftest_parameters implicit none class(rmvs_tp), intent(inout) :: self !! RMVS test particle object integer(I4B), intent(in) :: n !! Number of particles to allocate space for @@ -175,7 +159,6 @@ module subroutine rmvs_setup_tp(self, n, param) end subroutine rmvs_setup_tp module subroutine rmvs_util_append_pl(self, source, lsource_mask) - use swiftest_classes, only : swiftest_body implicit none class(rmvs_pl), intent(inout) :: self !! RMVS massive body object class(swiftest_body), intent(in) :: source !! Source object to append @@ -183,7 +166,6 @@ module subroutine rmvs_util_append_pl(self, source, lsource_mask) end subroutine rmvs_util_append_pl module subroutine rmvs_util_append_tp(self, source, lsource_mask) - use swiftest_classes, only : swiftest_body implicit none class(rmvs_tp), intent(inout) :: self !! RMVS test particle object class(swiftest_body), intent(in) :: source !! Source object to append @@ -211,7 +193,6 @@ module subroutine rmvs_util_dealloc_tp(self) end subroutine rmvs_util_dealloc_tp module subroutine rmvs_util_fill_pl(self, inserts, lfill_list) - use swiftest_classes, only : swiftest_body implicit none class(rmvs_pl), intent(inout) :: self !! RMVS massive body object class(swiftest_body), intent(in) :: inserts !! Inserted object @@ -219,7 +200,6 @@ module subroutine rmvs_util_fill_pl(self, inserts, lfill_list) end subroutine rmvs_util_fill_pl module subroutine rmvs_util_fill_tp(self, inserts, lfill_list) - use swiftest_classes, only : swiftest_body implicit none class(rmvs_tp), intent(inout) :: self !! RMVS massive body object class(swiftest_body), intent(in) :: inserts !! Inserted object @@ -290,7 +270,6 @@ module subroutine rmvs_util_sort_rearrange_tp(self, ind) end subroutine rmvs_util_sort_rearrange_tp module subroutine rmvs_util_spill_pl(self, discards, lspill_list, ldestructive) - use swiftest_classes, only : swiftest_body implicit none class(rmvs_pl), intent(inout) :: self !! RMVS massive body object class(swiftest_body), intent(inout) :: discards !! Discarded object @@ -299,7 +278,6 @@ module subroutine rmvs_util_spill_pl(self, discards, lspill_list, ldestructive) end subroutine rmvs_util_spill_pl module subroutine rmvs_util_spill_tp(self, discards, lspill_list, ldestructive) - use swiftest_classes, only : swiftest_body implicit none class(rmvs_tp), intent(inout) :: self !! RMVS test particle object class(swiftest_body), intent(inout) :: discards !! Discarded object @@ -308,7 +286,6 @@ module subroutine rmvs_util_spill_tp(self, discards, lspill_list, ldestructive) end subroutine rmvs_util_spill_tp module subroutine rmvs_step_system(self, param, t, dt) - use swiftest_classes, only : swiftest_parameters implicit none class(rmvs_nbody_system), intent(inout) :: self !! RMVS nbody system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters @@ -318,4 +295,4 @@ end subroutine rmvs_step_system end interface -end module rmvs_classes +end module rmvs diff --git a/src/modules/swiftest.f90 b/src/modules/swiftest.f90 index 8ca51ffdb..3cd04545e 100644 --- a/src/modules/swiftest.f90 +++ b/src/modules/swiftest.f90 @@ -9,25 +9,1886 @@ module swiftest !! author: David A. Minton - !! graph: false !! - !! This module serves to combine all of the Swiftest project modules under a single umbrella so that they can be accessed from individual submodule implementations with a simple "use swiftest" line. - use swiftest_globals - use swiftest_operators + !! This module serves to combine all of the Swiftest project modules under a single umbrella so that they can be accessed from individual submodule implementations + !! with a simple "use swiftest" line. + !! + !! The project structure is divided into a heirarchy of modules. The lowest level of the heirarchy are the modules called in the "use" statements below. Next the + !! "swiftest" !! modules (this one), and finally each individual integrator (and potential future integrators) sit at the top. This structure is a consequence of two + !! competing constraints: + !! 1) The desire that much of the basic functionality of the code is modular, such that new functionality can be easily added without altering too much of the basic code. + !! 2) Adhering to Modern Fortran's typing rules. + !! + !! A set of "base" types is defined in the base module. These define classes of objects, (i.e. central body, massive body, and test particles) and other major types + !! used throughout the project. However, none of the derived data types are defined with concrete type-bound procedures attached (only abstract procedures). + !! However, the *interfaces* of type-bound procedures are defined using the base types as arguments. Because of the typing rules of Modern Fortran's type-bound procedure overrides, any non-pass arguments + !! (i.e. arguments not named self) must be identical in all extended types. Because some of the basic functionality in the project is split across multiple modules, + !! we cannot define type-bound procedures in base class objects until the all interfaces are defined. In order to avoid these dependency issues and not end up with a + !! massive base class with every possibly type-bound procedure interface in the project (thus reducing the modularity of the project), the type-bound procedures are added + !! to the base types here. + !! + !! Structuring this code this way adds somewhat to the verbosity of the code. The main thing that has to happen is that for any procedures where one wishes to make use of an + !! type-bound procedures defined for arguments at the swiftest-type level or higher, but that are passsed to base-level procedures, must have their arguments wrapped in + !! a select type(...); class is(...) construct in order to "reveal" the procedures. This is done throughout the project at the beginning of many procedures (along with + !! copious amounts of associate(...) statements, in order to help with code readibility) + !! + !! Adapted from David E. Kaufmann's Swifter routine: module_swifter.f90 + use globals + use operators use lambda_function - use swiftest_classes - use whm_classes - use rmvs_classes - use helio_classes - use symba_classes - use encounter_classes - use collision_classes - use fraggle_classes - use walltime_classes + use base + use encounter + use collision + use fraggle + use walltime use io_progress_bar !use advisor_annotate !$ use omp_lib implicit none public + type, extends(base_io_netcdf_parameters) :: swiftest_io_netcdf_parameters + contains + procedure :: initialize => swiftest_io_netcdf_initialize_output !! Initialize a set of parameters used to identify a NetCDF output object + procedure :: open => swiftest_io_netcdf_open !! Opens a NetCDF file and does the variable inquiries to activate variable ids + end type swiftest_io_netcdf_parameters + + + type, extends(base_storage) :: swiftest_storage + contains + procedure :: dump => swiftest_io_dump_storage !! Dumps storage object contents to file + procedure :: get_index_values => swiftest_util_get_vals_storage !! Gets the unique values of the indices of a storage object (i.e. body id or time value) + procedure :: make_index_map => swiftest_util_index_map_storage !! Maps body id values to storage index values so we don't have to use unlimited dimensions for id + procedure :: take_snapshot => swiftest_util_snapshot_system !! Takes a snapshot of the system for later file storage + final :: swiftest_util_final_storage + end type swiftest_storage + + + ! The following extended types or their children should be used, where possible, as the base of any types defined in additional modules, such as new integrators. + type, extends(base_parameters) :: swiftest_parameters + type(swiftest_storage(nframes=:)), allocatable :: system_history + contains + procedure :: dump => swiftest_io_dump_param + procedure :: reader => swiftest_io_param_reader + procedure :: writer => swiftest_io_param_writer + procedure :: read_in => swiftest_io_read_in_param + procedure :: set_display => swiftest_io_set_display_param + end type swiftest_parameters + + + !> Class definition for the kinship relationships used in bookkeeping multiple collisions bodies in a single time step. + type, extends(base_kinship) :: swiftest_kinship + integer(I4B) :: parent !! Index of parent particle + integer(I4B) :: nchild !! number of children in merger list + integer(I4B), dimension(:), allocatable :: child !! Index of children particles + contains + procedure :: dealloc => swiftest_util_dealloc_kin !! Deallocates all allocatable arrays + final :: swiftest_util_final_kin !! Finalizes the Swiftest kinship object - deallocates all allocatables + end type swiftest_kinship + + + !> An abstract class for a generic collection of Swiftest bodies + type, abstract, extends(base_object) :: swiftest_body + !! Superclass that defines the generic elements of a Swiftest particle + integer(I4B) :: nbody = 0 !! Number of bodies + logical :: lfirst = .true. !! Run the current step as a first + integer(I4B), dimension(:), allocatable :: id !! External identifier (unique) + type(swiftest_particle_info), dimension(:), allocatable :: info !! Particle metadata information + logical, dimension(:), allocatable :: lmask !! Logical mask used to select a subset of bodies when performing certain operations (drift, kick, accel, etc.) + integer(I4B), dimension(:), allocatable :: status !! An integrator-specific status indicator + logical, dimension(:), allocatable :: ldiscard !! Body should be discarded + logical, dimension(:), allocatable :: lcollision !! flag indicating whether body has merged with another this time step + logical, dimension(:), allocatable :: lencounter !! flag indicating whether body is part of an encounter this time step + real(DP), dimension(:), allocatable :: mu !! G * (Mcb + [m]) + real(DP), dimension(:,:), allocatable :: rh !! Heliocentric position + real(DP), dimension(:,:), allocatable :: vh !! Heliocentric velocity + real(DP), dimension(:,:), allocatable :: rb !! Barycentric position + real(DP), dimension(:,:), allocatable :: vb !! Barycentric velocity + real(DP), dimension(:,:), allocatable :: ah !! Total heliocentric acceleration + real(DP), dimension(:,:), allocatable :: aobl !! Barycentric accelerations of bodies due to central body oblatenes + real(DP), dimension(:,:), allocatable :: agr !! Acceleration due to post-Newtonian correction + real(DP), dimension(:,:), allocatable :: atide !! Tanngential component of acceleration of bodies due to tides + real(DP), dimension(:), allocatable :: ir3h !! Inverse heliocentric radius term (1/rh**3) + integer(I4B), dimension(:), allocatable :: isperi !! perihelion passage flag + real(DP), dimension(:), allocatable :: peri !! perihelion distance + real(DP), dimension(:), allocatable :: atp !! semimajor axis following perihelion passage + real(DP), dimension(:), allocatable :: a !! Semimajor axis (pericentric distance for a parabolic orbit) + real(DP), dimension(:), allocatable :: e !! Eccentricity + real(DP), dimension(:), allocatable :: inc !! Inclination + real(DP), dimension(:), allocatable :: capom !! Longitude of ascending node + real(DP), dimension(:), allocatable :: omega !! Argument of pericenter + real(DP), dimension(:), allocatable :: capm !! Mean anomaly + + !! Note to developers: If you add components to this class, be sure to update methods and subroutines that traverse the + !! component list, such as setup_body and util_spill + contains + procedure(abstract_discard_body), deferred :: discard + procedure(abstract_kick_body), deferred :: kick + procedure(abstract_set_mu), deferred :: set_mu + procedure(abstract_step_body), deferred :: step + procedure(abstract_accel), deferred :: accel + + ! These are concrete because the implementation is the same for all types of particles + procedure :: drift => swiftest_drift_body !! Loop through bodies and call Danby drift routine on heliocentric variables + procedure :: v2pv => swiftest_gr_vh2pv_body !! Converts from velocity to psudeovelocity for GR calculations using symplectic integrators + procedure :: pv2v => swiftest_gr_pv2vh_body !! Converts from psudeovelocity to velocity for GR calculations using symplectic integrators + procedure :: read_frame_bin => swiftest_io_read_frame_body !! I/O routine for writing out a single frame of time-series data for the central body + procedure :: read_in => swiftest_io_read_in_body !! Read in body initial conditions from an ascii file + procedure :: write_frame => swiftest_io_netcdf_write_frame_body !! I/O routine for writing out a single frame of time-series data for all bodies in the system in NetCDF format + procedure :: write_info => swiftest_io_netcdf_write_info_body !! Dump contents of particle information metadata to file + procedure :: accel_obl => swiftest_obl_acc_body !! Compute the barycentric accelerations of bodies due to the oblateness of the central body + procedure :: el2xv => swiftest_orbel_el2xv_vec !! Convert orbital elements to position and velocity vectors + procedure :: xv2el => swiftest_orbel_xv2el_vec !! Convert position and velocity vectors to orbital elements + procedure :: setup => swiftest_setup_body !! A constructor that sets the number of bodies and allocates all allocatable arrays + procedure :: accel_user => swiftest_user_kick_getacch_body !! Add user-supplied heliocentric accelerations to planets + procedure :: append => swiftest_util_append_body !! Appends elements from one structure to another + procedure :: dealloc => swiftest_util_dealloc_body !! Deallocates all allocatable arrays + procedure :: fill => swiftest_util_fill_body !! "Fills" bodies from one object into another depending on the results of a mask (uses the UNPACK intrinsic) + procedure :: get_peri => swiftest_util_peri_body !! Determine system pericenter passages for test particles + procedure :: resize => swiftest_util_resize_body !! Checks the current size of a Swiftest body against the requested size and resizes it if it is too small. + + procedure :: set_ir3 => swiftest_util_set_ir3h !! Sets the inverse heliocentric radius term (1/rh**3) + procedure :: sort => swiftest_util_sort_body !! Sorts body arrays by a sortable componen + procedure :: rearrange => swiftest_util_sort_rearrange_body !! Rearranges the order of array elements of body based on an input index array. Used in sorting methods + procedure :: spill => swiftest_util_spill_body !! "Spills" bodies from one object to another depending on the results of a mask (uses the PACK intrinsic) + generic :: read_frame => read_frame_bin !! Add the generic read frame for Fortran binary files + end type swiftest_body + + + type, extends(base_particle_info) :: swiftest_particle_info + character(len=NAMELEN) :: name !! Non-unique name + character(len=NAMELEN) :: particle_type !! String containing a description of the particle type (e.g. Central Body, Massive Body, Test Particle) + character(len=NAMELEN) :: origin_type !! String containing a description of the origin of the particle (e.g. Initial Conditions, Supercatastrophic, Disruption, etc.) + real(DP) :: origin_time !! The time of the particle's formation + integer(I4B) :: collision_id !! The ID of the collision that formed the particle + real(DP), dimension(NDIM) :: origin_rh !! The heliocentric distance vector at the time of the particle's formation + real(DP), dimension(NDIM) :: origin_vh !! The heliocentric velocity vector at the time of the particle's formation + real(DP) :: discard_time !! The time of the particle's discard + character(len=NAMELEN) :: status !! Particle status description: Active, Merged, Fragmented, etc. + real(DP), dimension(NDIM) :: discard_rh !! The heliocentric distance vector at the time of the particle's discard + real(DP), dimension(NDIM) :: discard_vh !! The heliocentric velocity vector at the time of the particle's discard + integer(I4B) :: discard_body_id !! The id of the other body involved in the discard (0 if no other body involved) + contains + procedure :: copy => swiftest_util_copy_particle_info !! Copies one set of information object components into another, component-by-component + procedure :: set_value => swiftest_util_set_particle_info !! Sets one or more values of the particle information metadata object + end type swiftest_particle_info + + + type, abstract, extends(base_object) :: swiftest_cb + !> An abstract class for a generic central body in a Swiftest simulation + class(swiftest_particle_info), allocatable :: info !! Particle metadata information + integer(I4B) :: id = 0 !! External identifier (unique) + real(DP) :: mass = 0.0_DP !! Central body mass (units MU) + real(DP) :: Gmass = 0.0_DP !! Central mass gravitational term G * mass (units GU * MU) + real(DP) :: radius = 0.0_DP !! Central body radius (units DU) + real(DP) :: density = 1.0_DP !! Central body mass density - calculated internally (units MU / DU**3) + real(DP) :: j2rp2 = 0.0_DP !! J2*R^2 term for central body + real(DP) :: j4rp4 = 0.0_DP !! J4*R^2 term for central body + real(DP), dimension(NDIM) :: aobl = 0.0_DP !! Barycentric acceleration due to central body oblatenes + real(DP), dimension(NDIM) :: atide = 0.0_DP !! Barycentric acceleration due to central body oblatenes + real(DP), dimension(NDIM) :: aoblbeg = 0.0_DP !! Barycentric acceleration due to central body oblatenes at beginning of step + real(DP), dimension(NDIM) :: aoblend = 0.0_DP !! Barycentric acceleration due to central body oblatenes at end of step + real(DP), dimension(NDIM) :: atidebeg = 0.0_DP !! Barycentric acceleration due to central body oblatenes at beginning of step + real(DP), dimension(NDIM) :: atideend = 0.0_DP !! Barycentric acceleration due to central body oblatenes at end of step + real(DP), dimension(NDIM) :: rb = 0.0_DP !! Barycentric position (units DU) + real(DP), dimension(NDIM) :: vb = 0.0_DP !! Barycentric velocity (units DU / TU) + real(DP), dimension(NDIM) :: agr = 0.0_DP !! Acceleration due to post-Newtonian correction + real(DP), dimension(NDIM) :: Ip = 0.0_DP !! Unitless principal moments of inertia (I1, I2, I3) / (MR**2). Principal axis rotation assumed. + real(DP), dimension(NDIM) :: rot = 0.0_DP !! Body rotation vector in inertial coordinate frame (units rad / TU) + real(DP) :: k2 = 0.0_DP !! Tidal Love number + real(DP) :: Q = 0.0_DP !! Tidal quality factor + real(DP) :: tlag = 0.0_DP !! Tidal phase lag angle + real(DP), dimension(NDIM) :: L0 = 0.0_DP !! Initial angular momentum of the central body + real(DP), dimension(NDIM) :: dL = 0.0_DP !! Change in angular momentum of the central body + real(DP) :: GM0 = 0.0_DP !! Initial G*mass of the central body + real(DP) :: dGM = 0.0_DP !! Change in G*mass of the central body + real(DP) :: R0 = 0.0_DP !! Initial radius of the central body + real(DP) :: dR = 0.0_DP !! Change in the radius of the central body + contains + procedure :: read_in => swiftest_io_read_in_cb !! Read in central body initial conditions from an ASCII file + end type swiftest_cb + + + type, abstract, extends(swiftest_body) :: swiftest_pl + !! Superclass that defines the generic elements of a Swiftest particle + real(DP), dimension(:), allocatable :: mass !! Body mass (units MU) + real(DP), dimension(:), allocatable :: Gmass !! Mass gravitational term G * mass (units GU * MU) + real(DP), dimension(:), allocatable :: rhill !! Body mass (units MU) + real(DP), dimension(:), allocatable :: renc !! Critical radius for close encounters + real(DP), dimension(:), allocatable :: radius !! Body radius (units DU) + real(DP), dimension(:), allocatable :: density !! Body mass density - calculated internally (units MU / DU**3) + real(DP), dimension(:,:), allocatable :: rbeg !! Position at beginning of step + real(DP), dimension(:,:), allocatable :: rend !! Position at end of step + real(DP), dimension(:,:), allocatable :: vbeg !! Velocity at beginning of step + real(DP), dimension(:,:), allocatable :: Ip !! Unitless principal moments of inertia (I1, I2, I3) / (MR**2). Principal axis rotation assumed. + real(DP), dimension(:,:), allocatable :: rot !! Body rotation vector in inertial coordinate frame (units rad / TU) + real(DP), dimension(:), allocatable :: k2 !! Tidal Love number + real(DP), dimension(:), allocatable :: Q !! Tidal quality factor + real(DP), dimension(:), allocatable :: tlag !! Tidal phase lag + integer(I4B), dimension(:,:), allocatable :: k_plpl !! Index array used to convert flattened the body-body comparison upper triangular matrix + integer(I8B) :: nplpl !! Number of body-body comparisons in the flattened upper triangular matrix + type(swiftest_kinship), dimension(:), allocatable :: kin !! Array of merger relationship structures that can account for multiple pairwise mergers in a single step + logical, dimension(:), allocatable :: lmtiny !! flag indicating whether this body is below the GMTINY cutoff value + integer(I4B) :: nplm !! number of bodies above the GMTINY limit + integer(I8B) :: nplplm !! Number of body (all massive)-body (only those above GMTINY) comparisons in the flattened upper triangular matrix + integer(I4B), dimension(:), allocatable :: nplenc !! number of encounters with other planets this time step + integer(I4B), dimension(:), allocatable :: ntpenc !! number of encounters with test particles this time step + !! Note to developers: If you add components to this class, be sure to update methods and subroutines that traverse the + !! component list, such as setup_pl and util_spill_pl + contains + ! Massive body-specific concrete methods + ! These are concrete because they are the same implemenation for all integrators + procedure :: make_impactors => make_impactors_pl !! Make impactors out of the current kinship relationships + procedure :: discard => swiftest_discard_pl !! Placeholder method for discarding massive bodies + procedure :: accel_int => swiftest_kick_getacch_int_pl !! Compute direct cross (third) term heliocentric accelerations of massive bodies + procedure :: accel_obl => swiftest_obl_acc_pl !! Compute the barycentric accelerations of bodies due to the oblateness of the central body + procedure :: setup => swiftest_setup_pl !! A base constructor that sets the number of bodies and allocates and initializes all arrays + ! procedure :: accel_tides => tides_kick_getacch_pl !! Compute the accelerations of bodies due to tidal interactions with the central body + procedure :: append => swiftest_util_append_pl !! Appends elements from one structure to another + procedure :: h2b => swiftest_util_coord_h2b_pl !! Convert massive bodies from heliocentric to barycentric coordinates (position and velocity) + procedure :: b2h => swiftest_util_coord_b2h_pl !! Convert massive bodies from barycentric to heliocentric coordinates (position and velocity) + procedure :: vh2vb => swiftest_util_coord_vh2vb_pl !! Convert massive bodies from heliocentric to barycentric coordinates (velocity only) + procedure :: vb2vh => swiftest_util_coord_vb2vh_pl !! Convert massive bodies from barycentric to heliocentric coordinates (velocity only) + procedure :: rh2rb => swiftest_util_coord_rh2rb_pl !! Convert massive bodies from heliocentric to barycentric coordinates (position only) + procedure :: dealloc => swiftest_util_dealloc_pl !! Deallocates all allocatable arrays + procedure :: fill => swiftest_util_fill_pl !! "Fills" bodies from one object into another depending on the results of a mask (uses the UNPACK intrinsic) + procedure :: flatten => swiftest_util_flatten_eucl_plpl !! Sets up the (i, j) -> k indexing used for the single-loop blocking Euclidean distance matrix + procedure :: rearray => swiftest_util_rearray_pl !! Clean up the massive body structures to remove discarded bodies and add new bodies + procedure :: resize => swiftest_util_resize_pl !! Checks the current size of a Swiftest body against the requested size and resizes it if it is too small. + procedure :: reset_kinship => swiftest_util_reset_kinship_pl !! Resets the kinship status of bodies + procedure :: set_beg_end => swiftest_util_set_beg_end_pl !! Sets the beginning and ending positions and velocities of planets. + procedure :: set_mu => swiftest_util_set_mu_pl !! Method used to construct the vectorized form of the central body mass + procedure :: set_rhill => swiftest_util_set_rhill !! Calculates the Hill's radii for each body + procedure :: set_renc_I4B => swiftest_util_set_renc_I4B !! Sets the critical radius for encounter given an inpput integer scale factor + procedure :: set_renc_DP => swiftest_util_set_renc_DP !! Sets the critical radius for encounter given an input real scale factor + procedure :: sort => swiftest_util_sort_pl !! Sorts body arrays by a sortable component + procedure :: rearrange => swiftest_util_sort_rearrange_pl !! Rearranges the order of array elements of body based on an input index array. Used in sorting methods + procedure :: spill => swiftest_util_spill_pl !! "Spills" bodies from one object to another depending on the results of a mask (uses the PACK intrinsic) + generic :: set_renc => set_renc_I4B, set_renc_DP + end type swiftest_pl + + + type, abstract, extends(swiftest_body) :: swiftest_tp + !! Superclass that defines the generic elements of a Swiftest test particle + integer(I4B), dimension(:,:), allocatable :: k_pltp !! Index array used to convert flattened the body-body comparison upper triangular matrix + integer(I8B) :: npltp !! Number of pl-tp comparisons in the flattened upper triangular matrix + integer(I4B), dimension(:), allocatable :: nplenc !! number of encounters with planets this time step + !! Note to developers: If you add components to this class, be sure to update methods and subroutines that traverse the + !! component list, such as setup_tp and util_spill_tp + contains + ! Test particle-specific concrete methods + ! These are concrete because they are the same implemenation for all integrators + procedure :: discard => swiftest_discard_tp !! Check to see if test particles should be discarded based on their positions relative to the massive bodies + procedure :: accel_int => swiftest_kick_getacch_int_tp !! Compute direct cross (third) term heliocentric accelerations of test particles by massive bodies + procedure :: accel_obl => swiftest_obl_acc_tp !! Compute the barycentric accelerations of bodies due to the oblateness of the central body + procedure :: setup => swiftest_setup_tp !! A base constructor that sets the number of bodies and + procedure :: append => swiftest_util_append_tp !! Appends elements from one structure to another + procedure :: h2b => swiftest_util_coord_h2b_tp !! Convert test particles from heliocentric to barycentric coordinates (position and velocity) + procedure :: b2h => swiftest_util_coord_b2h_tp !! Convert test particles from barycentric to heliocentric coordinates (position and velocity) + procedure :: vb2vh => swiftest_util_coord_vb2vh_tp !! Convert test particles from barycentric to heliocentric coordinates (velocity only) + procedure :: vh2vb => swiftest_util_coord_vh2vb_tp !! Convert test particles from heliocentric to barycentric coordinates (velocity only) + procedure :: rh2rb => swiftest_util_coord_rh2rb_tp !! Convert test particles from heliocentric to barycentric coordinates (position only) + procedure :: dealloc => swiftest_util_dealloc_tp !! Deallocates all allocatable arrays + procedure :: fill => swiftest_util_fill_tp !! "Fills" bodies from one object into another depending on the results of a mask (uses the UNPACK intrinsic) + procedure :: resize => swiftest_util_resize_tp !! Checks the current size of a Swiftest body against the requested size and resizes it if it is too small. + procedure :: set_mu => swiftest_util_set_mu_tp !! Method used to construct the vectorized form of the central body mass + procedure :: sort => swiftest_util_sort_tp !! Sorts body arrays by a sortable component + procedure :: rearrange => swiftest_util_sort_rearrange_tp !! Rearranges the order of array elements of body based on an input index array. Used in sorting methods + procedure :: spill => swiftest_util_spill_tp !! "Spills" bodies from one object to another depending on the results of a mask (uses the PACK intrinsic) + end type swiftest_tp + + + !> An abstract class for a basic Swiftest nbody system + type, abstract, extends(base_nbody_system) :: swiftest_nbody_system + !! This superclass contains a minimial system of a set of test particles (tp), massive bodies (pl), and a central body (cb) + !! The full swiftest_nbody_system type that is used as the parent class of all integrators is defined in collision + + class(swiftest_cb), allocatable :: cb !! Central body data structure + class(swiftest_pl), allocatable :: pl !! Massive body data structure + class(swiftest_tp), allocatable :: tp !! Test particle data structure + + class(swiftest_tp), allocatable :: tp_discards !! Discarded test particle data structure + class(swiftest_pl), allocatable :: pl_discards !! Discarded massive body particle data structure + class(swiftest_pl), allocatable :: pl_adds !! List of added bodies in mergers or collisions + class(swiftest_tp), allocatable :: tp_adds !! List of added bodies in mergers or collisions + class(collision_list_pltp), allocatable :: pltp_encounter !! List of massive body-test particle encounters in a single step + class(collision_list_plpl), allocatable :: plpl_encounter !! List of massive body-massive body encounters in a single step + class(collision_list_plpl), allocatable :: plpl_collision !! List of massive body-massive body collisions in a single step + class(collision_list_plpl), allocatable :: pltp_collision !! List of massive body-massive body collisions in a single step + class(collision_system), allocatable :: collision_system !! Collision system object + class(encounter_storage(nframes=:)), allocatable :: encounter_history !! Stores encounter history for later retrieval and saving to file + class(collision_storage(nframes=:)), allocatable :: collision_history !! Stores encounter history for later retrieval and saving to file + + real(DP) :: t = -1.0_DP !! Integration current time + real(DP) :: GMtot = 0.0_DP !! Total system mass - used for barycentric coordinate conversion + real(DP) :: ke_orbit = 0.0_DP !! System orbital kinetic energy + real(DP) :: ke_spin = 0.0_DP !! System spin kinetic energy + real(DP) :: pe = 0.0_DP !! System potential energy + real(DP) :: te = 0.0_DP !! System total energy + real(DP) :: oblpot = 0.0_DP !! System potential energy due to oblateness of the central body + real(DP), dimension(NDIM) :: Lorbit = 0.0_DP !! System orbital angular momentum vector + real(DP), dimension(NDIM) :: Lspin = 0.0_DP !! System spin angular momentum vector + real(DP), dimension(NDIM) :: Ltot = 0.0_DP !! System angular momentum vector + real(DP) :: ke_orbit_orig = 0.0_DP !! Initial orbital kinetic energy + real(DP) :: ke_spin_orig = 0.0_DP !! Initial spin kinetic energy + real(DP) :: pe_orig = 0.0_DP !! Initial potential energy + real(DP) :: Eorbit_orig = 0.0_DP !! Initial orbital energy + real(DP) :: GMtot_orig = 0.0_DP !! Initial system mass + real(DP), dimension(NDIM) :: Ltot_orig = 0.0_DP !! Initial total angular momentum vector + real(DP), dimension(NDIM) :: Lorbit_orig = 0.0_DP !! Initial orbital angular momentum + real(DP), dimension(NDIM) :: Lspin_orig = 0.0_DP !! Initial spin angular momentum vector + real(DP), dimension(NDIM) :: Lescape = 0.0_DP !! Angular momentum of bodies that escaped the system (used for bookeeping) + real(DP) :: GMescape = 0.0_DP !! Mass of bodies that escaped the system (used for bookeeping) + real(DP) :: Ecollisions = 0.0_DP !! Energy lost from system due to collisions + real(DP) :: Euntracked = 0.0_DP !! Energy gained from system due to escaped bodies + + ! Energy, momentum, and mass errors (used in error reporting) + real(DP) :: ke_orbit_error = 0.0_DP + real(DP) :: ke_spin_error = 0.0_DP + real(DP) :: pe_error = 0.0_DP + real(DP) :: Eorbit_error = 0.0_DP + real(DP) :: Ecoll_error = 0.0_DP + real(DP) :: Euntracked_error = 0.0_DP + real(DP) :: Etot_error = 0.0_DP + real(DP) :: Lorbit_error = 0.0_DP + real(DP) :: Lspin_error = 0.0_DP + real(DP) :: Lescape_error = 0.0_DP + real(DP) :: Ltot_error = 0.0_DP + real(DP) :: Mtot_error = 0.0_DP + real(DP) :: Mescape_error = 0.0_DP + + logical :: lbeg !! True if this is the beginning of a step. This is used so that test particle steps can be calculated + !! separately from massive bodies. Massive body variables are saved at half steps, and passed to + !! the test particles + contains + !> Each integrator will have its own version of the step + procedure(abstract_step_system), deferred :: step + + ! Concrete classes that are common to the basic integrator (only test particles considered for discard) + procedure :: discard => swiftest_discard_system !! Perform a discard step on the system + procedure :: compact_output => swiftest_io_compact_output !! Prints out out terminal output when display_style is set to COMPACT + procedure :: conservation_report => swiftest_io_conservation_report !! Compute energy and momentum and print out the change with time + procedure :: dump => swiftest_io_dump_system !! Dump the state of the system to a file + procedure :: get_old_t_final => swiftest_io_netcdf_get_old_t_final_system !! Validates the dump file to check whether the dump file initial conditions duplicate the last frame of the netcdf output. + procedure :: read_frame => swiftest_io_netcdf_read_frame_system !! Read in a frame of input data from file + procedure :: write_frame_netcdf => swiftest_io_netcdf_write_frame_system !! Write a frame of input data from file + procedure :: write_frame_system => swiftest_io_write_frame_system !! Write a frame of input data from file + procedure :: read_hdr => swiftest_io_netcdf_read_hdr_system !! Read a header for an output frame in NetCDF format + procedure :: write_hdr => swiftest_io_netcdf_write_hdr_system !! Write a header for an output frame in NetCDF format + procedure :: read_in => swiftest_io_read_in_system !! Reads the initial conditions for an nbody system + procedure :: read_particle_info => swiftest_io_netcdf_read_particle_info_system !! Read in particle metadata from file + procedure :: obl_pot => swiftest_obl_pot_system !! Compute the contribution to the total gravitational potential due solely to the oblateness of the central body + procedure :: initialize => swiftest_setup_initialize_system !! Initialize the system from input files + procedure :: init_particle_info => swiftest_setup_initialize_particle_info_system !! Initialize the system from input files + ! procedure :: step_spin => tides_step_spin_system !! Steps the spins of the massive & central bodies due to tides. + procedure :: set_msys => swiftest_util_set_msys !! Sets the value of msys from the masses of system bodies. + procedure :: get_energy_and_momentum => swiftest_util_get_energy_momentum_system !! Calculates the total system energy and momentum + procedure :: get_idvals => swiftest_util_get_idvalues_system !! Returns an array of all id values in use in the system + procedure :: rescale => swiftest_util_rescale_system !! Rescales the system into a new set of units + procedure :: validate_ids => swiftest_util_valid_id_system !! Validate the numerical ids passed to the system and save the maximum value + procedure :: write_discard => swiftest_io_write_discard !! Write out information about discarded and merged planets and test particles in SyMBA + generic :: write_frame => write_frame_system, write_frame_netcdf !! Generic method call for reading a frame of output data + end type swiftest_nbody_system + + + abstract interface + + subroutine abstract_accel(self, system, param, t, lbeg) + import swiftest_body, swiftest_nbody_system, swiftest_parameters, DP + class(swiftest_body), intent(inout) :: self !! Swiftest body data structure + class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + real(DP), intent(in) :: t !! Current simulation time + logical, intent(in) :: lbeg !! Optional argument that determines whether or not this is the beginning or end of the step + end subroutine abstract_accel + + subroutine abstract_discard_body(self, system, param) + import swiftest_body, swiftest_nbody_system, swiftest_parameters + class(swiftest_body), intent(inout) :: self !! Swiftest body object + class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + end subroutine abstract_discard_body + + subroutine abstract_kick_body(self, system, param, t, dt, lbeg) + import swiftest_body, swiftest_nbody_system, swiftest_parameters, DP + implicit none + class(swiftest_body), intent(inout) :: self !! Swiftest generic body object + class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system objec + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + real(DP), intent(in) :: t !! Current time + real(DP), intent(in) :: dt !! Stepsize + logical, intent(in) :: lbeg !! Logical flag indicating whether this is the beginning of the half step or not. + end subroutine abstract_kick_body + + subroutine abstract_set_mu(self, cb) + import swiftest_body, swiftest_cb + class(swiftest_body), intent(inout) :: self !! Swiftest body object + class(swiftest_cb), intent(inout) :: cb !! Swiftest central body object + end subroutine abstract_set_mu + + subroutine abstract_step_body(self, system, param, t, dt) + import DP, swiftest_body, swiftest_nbody_system, swiftest_parameters + implicit none + class(swiftest_body), intent(inout) :: self !! Swiftest body object + class(swiftest_nbody_system), intent(inout) :: system !! Swiftest system object + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + real(DP), intent(in) :: t !! Simulation time + real(DP), intent(in) :: dt !! Current stepsize + end subroutine abstract_step_body + + subroutine abstract_step_system(self, param, t, dt) + import DP, swiftest_nbody_system, swiftest_parameters + implicit none + class(swiftest_nbody_system), intent(inout) :: self !! Swiftest system object + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + real(DP), intent(in) :: t !! Simulation time + real(DP), intent(in) :: dt !! Current stepsize + end subroutine abstract_step_system + end interface + + + interface + module subroutine swiftest_discard_pl(self, system, param) + implicit none + class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object + class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameter + end subroutine swiftest_discard_pl + + module subroutine swiftest_discard_system(self, param) + implicit none + class(swiftest_nbody_system), intent(inout) :: self !! Swiftest system object + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + end subroutine swiftest_discard_system + + module subroutine swiftest_discard_tp(self, system, param) + implicit none + class(swiftest_tp), intent(inout) :: self !! Swiftest test particle object + class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + end subroutine swiftest_discard_tp + + module subroutine swiftest_drift_all(mu, x, v, n, param, dt, lmask, iflag) + implicit none + real(DP), dimension(:), intent(in) :: mu !! Vector of gravitational constants + real(DP), dimension(:,:), intent(inout) :: x, v !! Position and velocity vectors + integer(I4B), intent(in) :: n !! number of bodies + class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters + real(DP), intent(in) :: dt !! Stepsize + logical, dimension(:), intent(in) :: lmask !! Logical mask of size self%nbody that determines which bodies to drift. + integer(I4B), dimension(:), intent(out) :: iflag !! Vector of error flags. 0 means no problem + end subroutine swiftest_drift_all + + module subroutine swiftest_drift_body(self, system, param, dt) + implicit none + class(swiftest_body), intent(inout) :: self !! Swiftest particle data structure + class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters + real(DP), intent(in) :: dt !! Stepsize + end subroutine swiftest_drift_body + + pure elemental module subroutine swiftest_drift_one(mu, px, py, pz, vx, vy, vz, dt, iflag) + !$omp declare simd(swiftest_drift_one) + implicit none + real(DP), intent(in) :: mu !! G * (Mcb + m), G = gravitational constant, Mcb = mass of central body, m = mass of body to drift + real(DP), intent(inout) :: px, py, pz, vx, vy, vz !! Position and velocity of body to drift + real(DP), intent(in) :: dt !! Step size + integer(I4B), intent(out) :: iflag !! iflag : error status flag for Danby drift (0 = OK, nonzero = ERROR) + end subroutine swiftest_drift_one + + pure module subroutine swiftest_gr_kick_getaccb_ns_body(self, system, param) + implicit none + class(swiftest_body), intent(inout) :: self !! Swiftest generic body object + class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters + end subroutine swiftest_gr_kick_getaccb_ns_body + + pure module subroutine swiftest_gr_kick_getacch(mu, x, lmask, n, inv_c2, agr) + implicit none + real(DP), dimension(:), intent(in) :: mu !! Gravitational constant + real(DP), dimension(:,:), intent(in) :: x !! Position vectors + logical, dimension(:), intent(in) :: lmask !! Logical mask indicating which bodies to compute + integer(I4B), intent(in) :: n !! Total number of bodies + real(DP), intent(in) :: inv_c2 !! Inverse speed of light squared: 1 / c**2 + real(DP), dimension(:,:), intent(out) :: agr !! Accelerations + end subroutine swiftest_gr_kick_getacch + + pure module subroutine swiftest_gr_p4_pos_kick(param, x, v, dt) + implicit none + class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters + real(DP), dimension(:), intent(inout) :: x !! Position vector + real(DP), dimension(:), intent(in) :: v !! Velocity vector + real(DP), intent(in) :: dt !! Step size + end subroutine swiftest_gr_p4_pos_kick + + pure module subroutine swiftest_gr_pseudovel2vel(param, mu, rh, pv, vh) + implicit none + class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters + real(DP), intent(in) :: mu !! G * (Mcb + m), G = gravitational constant, Mcb = mass of central body, m = mass of body + real(DP), dimension(:), intent(in) :: rh !! Swiftestcentric position vector + real(DP), dimension(:), intent(in) :: pv !! Pseudovelocity velocity vector - see Saha & Tremain (1994), eq. (32) + real(DP), dimension(:), intent(out) :: vh !! Swiftestcentric velocity vector + end subroutine swiftest_gr_pseudovel2vel + + pure module subroutine swiftest_gr_pv2vh_body(self, param) + implicit none + class(swiftest_body), intent(inout) :: self !! Swiftest particle object + class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters + end subroutine swiftest_gr_pv2vh_body + + pure module subroutine swiftest_gr_vel2pseudovel(param, mu, rh, vh, pv) + implicit none + class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters + real(DP), intent(in) :: mu !! G * (Mcb + m), G = gravitational constant, Mcb = mass of central body, m = mass of body + real(DP), dimension(:), intent(in) :: rh !! Swiftestcentric position vector + real(DP), dimension(:), intent(in) :: vh !! Swiftestcentric velocity vector + real(DP), dimension(:), intent(out) :: pv !! Pseudovelocity vector - see Saha & Tremain (1994), eq. (32) + end subroutine swiftest_gr_vel2pseudovel + + pure module subroutine swiftest_gr_vh2pv_body(self, param) + implicit none + class(swiftest_body), intent(inout) :: self !! Swiftest particle object + class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters + end subroutine swiftest_gr_vh2pv_body + + module subroutine swiftest_io_compact_output(self, param, timer) + implicit none + class(swiftest_nbody_system), intent(in) :: self !! Swiftest nbody system object + class(swiftest_parameters), intent(in) :: param !! Input colleciton of user-defined parameters + class(*), intent(in) :: timer !! Object used for computing elapsed wall time + end subroutine swiftest_io_compact_output + + module subroutine swiftest_io_conservation_report(self, param, lterminal) + implicit none + class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nbody system object + class(swiftest_parameters), intent(inout) :: param !! Input colleciton of user-defined parameters + logical, intent(in) :: lterminal !! Indicates whether to output information to the terminal screen + end subroutine swiftest_io_conservation_report + + module subroutine swiftest_io_dump_param(self, param_file_name) + implicit none + class(swiftest_parameters),intent(in) :: self !! Output collection of parameters + character(len=*), intent(in) :: param_file_name !! Parameter input file name (i.e. param.in) + end subroutine swiftest_io_dump_param + + module subroutine swiftest_io_dump_system(self, param) + implicit none + class(swiftest_nbody_system), intent(inout) :: self !! Swiftest system object + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + end subroutine swiftest_io_dump_system + + module subroutine swiftest_io_dump_storage(self, param) + implicit none + class(swiftest_storage(*)), intent(inout) :: self !! Swiftest simulation history storage object + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + end subroutine swiftest_io_dump_storage + + module subroutine swiftest_io_get_args(integrator, param_file_name, display_style) + implicit none + character(len=:), allocatable, intent(inout) :: integrator !! Symbolic code of the requested integrator + character(len=:), allocatable, intent(inout) :: param_file_name !! Name of the input parameters file + character(len=:), allocatable, intent(inout) :: display_style !! Style of the output display {"STANDARD", "COMPACT"}). Default is "STANDARD" + end subroutine swiftest_io_get_args + + module function swiftest_io_get_token(buffer, ifirst, ilast, ierr) result(token) + implicit none + character(len=*), intent(in) :: buffer !! Input string buffer + integer(I4B), intent(inout) :: ifirst !! Index of the buffer at which to start the search for a token + integer(I4B), intent(out) :: ilast !! Index of the buffer at the end of the returned token + integer(I4B), intent(out) :: ierr !! Error code + character(len=:), allocatable :: token !! Returned token string + end function swiftest_io_get_token + + module subroutine swiftest_io_log_one_message(file, message) + implicit none + character(len=*), intent(in) :: file !! Name of file to log + character(len=*), intent(in) :: message + end subroutine swiftest_io_log_one_message + + module subroutine swiftest_io_log_start(param, file, header) + implicit none + class(swiftest_parameters), intent(in) :: param !! Current Swiftest run configuration parameters + character(len=*), intent(in) :: file !! Name of file to log + character(len=*), intent(in) :: header !! Header to print at top of log file + end subroutine swiftest_io_log_start + + module subroutine swiftest_io_param_reader(self, unit, iotype, v_list, iostat, iomsg) + implicit none + class(swiftest_parameters), intent(inout) :: self !! Collection of parameters + integer(I4B), intent(in) :: unit !! File unit number + character(len=*), intent(in) :: iotype !! Dummy argument passed to the input/output procedure contains the text from the char-literal-constant, prefixed with DT. + !! If you do not include a char-literal-constant, the iotype argument contains only DT. + character(len=*), intent(in) :: v_list(:) !! The first element passes the integrator code to the reader + integer(I4B), intent(out) :: iostat !! IO status code + character(len=*), intent(inout) :: iomsg !! Message to pass if iostat /= 0 + end subroutine swiftest_io_param_reader + + module subroutine swiftest_io_param_writer(self, unit, iotype, v_list, iostat, iomsg) + implicit none + class(swiftest_parameters), intent(in) :: self !! Collection of parameters + integer(I4B), intent(in) :: unit !! File unit number + character(len=*), intent(in) :: iotype !! Dummy argument passed to the input/output procedure contains the text from the char-literal-constant, prefixed with DT. + !! If you do not include a char-literal-constant, the iotype argument contains only DT. + integer(I4B), intent(in) :: v_list(:) !! Not used in this procedure + integer(I4B), intent(out) :: iostat !! IO status code + character(len=*), intent(inout) :: iomsg !! Message to pass if iostat /= 0 + end subroutine swiftest_io_param_writer + end interface + + interface io_param_writer_one + module subroutine swiftest_io_param_writer_one_char(param_name, param_value, unit) + implicit none + character(len=*), intent(in) :: param_name !! Name of parameter to print + character(len=*), intent(in) :: param_value !! Value of parameter to print + integer(I4B), intent(in) :: unit !! Open file unit number to print parameter to + end subroutine swiftest_io_param_writer_one_char + + module subroutine swiftest_io_param_writer_one_DP(param_name, param_value, unit) + implicit none + character(len=*), intent(in) :: param_name !! Name of parameter to print + real(DP), intent(in) :: param_value !! Value of parameter to print + integer(I4B), intent(in) :: unit !! Open file unit number to print parameter to + end subroutine swiftest_io_param_writer_one_DP + + module subroutine swiftest_io_param_writer_one_DParr(param_name, param_value, unit) + implicit none + character(len=*), intent(in) :: param_name !! Name of parameter to print + real(DP), dimension(:), intent(in) :: param_value !! Value of parameter to print + integer(I4B), intent(in) :: unit !! Open file unit number to print parameter to + end subroutine swiftest_io_param_writer_one_DParr + + module subroutine swiftest_io_param_writer_one_I4B(param_name, param_value, unit) + implicit none + character(len=*), intent(in) :: param_name !! Name of parameter to print + integer(I4B), intent(in) :: param_value !! Value of parameter to print + integer(I4B), intent(in) :: unit !! Open file unit number to print parameter to + end subroutine swiftest_io_param_writer_one_I4B + + module subroutine swiftest_io_param_writer_one_I4Barr(param_name, param_value, unit) + implicit none + character(len=*), intent(in) :: param_name !! Name of parameter to print + integer(I4B), dimension(:), intent(in) :: param_value !! Value of parameter to print + integer(I4B), intent(in) :: unit !! Open file unit number to print parameter to + end subroutine swiftest_io_param_writer_one_I4Barr + + module subroutine swiftest_io_param_writer_one_I8B(param_name, param_value, unit) + implicit none + character(len=*), intent(in) :: param_name !! Name of parameter to print + integer(I8B), intent(in) :: param_value !! Value of parameter to print + integer(I4B), intent(in) :: unit !! Open file unit number to print parameter to + end subroutine swiftest_io_param_writer_one_I8B + + module subroutine swiftest_io_param_writer_one_logical(param_name, param_value, unit) + implicit none + character(len=*), intent(in) :: param_name !! Name of parameter to print + logical, intent(in) :: param_value !! Value of parameter to print + integer(I4B), intent(in) :: unit !! Open file unit number to print parameter to + end subroutine swiftest_io_param_writer_one_logical + + module subroutine swiftest_io_param_writer_one_QP(param_name, param_value, unit) + implicit none + character(len=*), intent(in) :: param_name !! Name of parameter to print + real(QP), intent(in) :: param_value !! Value of parameter to print + integer(I4B), intent(in) :: unit !! Open file unit number to print parameter to + end subroutine swiftest_io_param_writer_one_QP + end interface io_param_writer_one + + interface + + module subroutine swiftest_io_read_in_body(self,param) + implicit none + class(swiftest_body), intent(inout) :: self !! Swiftest base object + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + end subroutine swiftest_io_read_in_body + + module subroutine swiftest_io_read_in_cb(self,param) + implicit none + class(swiftest_cb), intent(inout) :: self !! Swiftest base object + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + end subroutine swiftest_io_read_in_cb + + module subroutine swiftest_io_read_in_param(self, param_file_name) + implicit none + class(swiftest_parameters), intent(inout) :: self !! Current run configuration parameters + character(len=*), intent(in) :: param_file_name !! Parameter input file name (i.e. param.in) + end subroutine swiftest_io_read_in_param + + module subroutine swiftest_io_read_in_system(self, param) + implicit none + class(swiftest_nbody_system), intent(inout) :: self + class(swiftest_parameters), intent(inout) :: param + end subroutine swiftest_io_read_in_system + + module function swiftest_io_read_frame_body(self, iu, param) result(ierr) + implicit none + class(swiftest_body), intent(inout) :: self !! Swiftest body object + integer(I4B), intent(inout) :: iu !! Unit number for the output file to write frame to + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + integer(I4B) :: ierr !! Error code: returns 0 if the read is successful + end function swiftest_io_read_frame_body + + module function swiftest_io_read_frame_system(self, iu, param) result(ierr) + implicit none + class(swiftest_nbody_system),intent(inout) :: self !! Swiftest system object + integer(I4B), intent(inout) :: iu !! Unit number for the output file to read frame from + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + integer(I4B) :: ierr !! Error code: returns 0 if the read is successful + end function swiftest_io_read_frame_system + + module subroutine swiftest_io_set_display_param(self, display_style) + implicit none + class(swiftest_parameters), intent(inout) :: self !! Current run configuration parameters + character(*), intent(in) :: display_style !! Style of the output display + end subroutine swiftest_io_set_display_param + + module subroutine swiftest_io_toupper(string) + implicit none + character(*), intent(inout) :: string !! String to make upper case + end subroutine swiftest_io_toupper + + module subroutine swiftest_io_write_frame_system(self, param) + implicit none + class(swiftest_nbody_system), intent(inout) :: self !! Swiftest system object + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + end subroutine swiftest_io_write_frame_system + + module subroutine swiftest_kick_getacch_int_pl(self, param) + implicit none + class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object + class(swiftest_parameters), intent(inout) :: param !! Current swiftest run configuration parameters + end subroutine swiftest_kick_getacch_int_pl + + module subroutine swiftest_kick_getacch_int_tp(self, param, GMpl, rhp, npl) + implicit none + class(swiftest_tp), intent(inout) :: self !! Swiftest test particle object + class(swiftest_parameters), intent(inout) :: param !! Current swiftest run configuration parameters + real(DP), dimension(:), intent(in) :: GMpl !! Massive body masses + real(DP), dimension(:,:), intent(in) :: rhp !! Massive body position vectors + integer(I4B), intent(in) :: npl !! Number of active massive bodies + end subroutine swiftest_kick_getacch_int_tp + + module subroutine swiftest_kick_getacch_int_all_flat_pl(npl, nplpl, k_plpl, x, Gmass, radius, acc) + implicit none + integer(I4B), intent(in) :: npl !! Number of massive bodies + integer(I8B), intent(in) :: nplpl !! Number of massive body interactions to compute + integer(I4B), dimension(:,:), intent(in) :: k_plpl !! Array of interaction pair indices (flattened upper triangular matrix) + real(DP), dimension(:,:), intent(in) :: x !! Position vector array + real(DP), dimension(:), intent(in) :: Gmass !! Array of massive body G*mass + real(DP), dimension(:), intent(in), optional :: radius !! Array of massive body radii + real(DP), dimension(:,:), intent(inout) :: acc !! Acceleration vector array + end subroutine swiftest_kick_getacch_int_all_flat_pl + + module subroutine swiftest_kick_getacch_int_all_triangular_pl(npl, nplm, x, Gmass, radius, acc) + implicit none + integer(I4B), intent(in) :: npl !! Total number of massive bodies + integer(I4B), intent(in) :: nplm !! Number of fully interacting massive bodies + real(DP), dimension(:,:), intent(in) :: x !! Position vector array + real(DP), dimension(:), intent(in) :: Gmass !! Array of massive body G*mass + real(DP), dimension(:), intent(in), optional :: radius !! Array of massive body radii + real(DP), dimension(:,:), intent(inout) :: acc !! Acceleration vector array + end subroutine swiftest_kick_getacch_int_all_triangular_pl + + module subroutine swiftest_kick_getacch_int_all_tp(ntp, npl, xtp, xpl, GMpl, lmask, acc) + implicit none + integer(I4B), intent(in) :: ntp !! Number of test particles + integer(I4B), intent(in) :: npl !! Number of massive bodies + real(DP), dimension(:,:), intent(in) :: xtp !! Test particle position vector array + real(DP), dimension(:,:), intent(in) :: xpl !! Massive body particle position vector array + real(DP), dimension(:), intent(in) :: GMpl !! Array of massive body G*mass + logical, dimension(:), intent(in) :: lmask !! Logical mask indicating which test particles should be computed + real(DP), dimension(:,:), intent(inout) :: acc !! Acceleration vector array + end subroutine swiftest_kick_getacch_int_all_tp + + pure module subroutine swiftest_kick_getacch_int_one_pl(rji2, xr, yr, zr, Gmi, Gmj, axi, ayi, azi, axj, ayj, azj) + !$omp declare simd(swiftest_kick_getacch_int_one_pl) + implicit none + real(DP), intent(in) :: rji2 !! Square of distance between the two bodies + real(DP), intent(in) :: xr, yr, zr !! Distances between the two bodies in x, y, and z directions + real(DP), intent(in) :: Gmi !! G*mass of body i + real(DP), intent(in) :: Gmj !! G*mass of body j + real(DP), intent(inout) :: axi, ayi, azi !! Acceleration vector components of body i + real(DP), intent(inout) :: axj, ayj, azj !! Acceleration vector components of body j + end subroutine swiftest_kick_getacch_int_one_pl + + pure module subroutine swiftest_kick_getacch_int_one_tp(rji2, xr, yr, zr, Gmpl, ax, ay, az) + !$omp declare simd(swiftest_kick_getacch_int_one_tp) + implicit none + real(DP), intent(in) :: rji2 !! Square of distance between the test particle and massive body + real(DP), intent(in) :: xr, yr, zr !! Distances between the two bodies in x, y, and z directions + real(DP), intent(in) :: Gmpl !! G*mass of massive body + real(DP), intent(inout) :: ax, ay, az !! Acceleration vector components of test particle + end subroutine swiftest_kick_getacch_int_one_tp + + module function swiftest_io_netcdf_get_old_t_final_system(self, param) result(old_t_final) + implicit none + class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nbody system object + class(base_parameters), intent(inout) :: param !! Current run configuration parameters + real(DP) :: old_t_final !! Final time from last run + end function swiftest_io_netcdf_get_old_t_final_system + + module subroutine swiftest_io_netcdf_initialize_output(self, param) + implicit none + class(swiftest_io_netcdf_parameters), intent(inout) :: self !! Parameters used to for writing a NetCDF dataset to file + class(base_parameters), intent(in) :: param !! Current run configuration parameters + end subroutine swiftest_io_netcdf_initialize_output + + module subroutine swiftest_io_netcdf_open(self, param, readonly) + implicit none + class(swiftest_io_netcdf_parameters), intent(inout) :: self !! Parameters used to identify a particular NetCDF dataset + class(base_parameters), intent(in) :: param !! Current run configuration parameters + logical, optional, intent(in) :: readonly !! Logical flag indicating that this should be open read only + end subroutine swiftest_io_netcdf_open + + module function swiftest_io_netcdf_read_frame_system(self, nc, param) result(ierr) + implicit none + class(swiftest_nbody_system), intent(inout) :: self !! Swiftest system object + class(base_io_netcdf_parameters), intent(inout) :: nc !! Parameters used to for reading a NetCDF dataset to file + class(base_parameters), intent(inout) :: param !! Current run configuration parameters + integer(I4B) :: ierr !! Error code: returns 0 if the read is successful + end function swiftest_io_netcdf_read_frame_system + + module subroutine swiftest_io_netcdf_read_hdr_system(self, nc, param) + implicit none + class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nbody system object + class(base_io_netcdf_parameters), intent(inout) :: nc !! Parameters used to for reading a NetCDF dataset to file + class(base_parameters), intent(inout) :: param !! Current run configuration parameters + end subroutine swiftest_io_netcdf_read_hdr_system + + module subroutine swiftest_io_netcdf_read_particle_info_system(self, nc, param, plmask, tpmask) + implicit none + class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nbody system object + class(base_io_netcdf_parameters), intent(inout) :: nc !! Parameters used to identify a particular NetCDF dataset + class(base_parameters), intent(inout) :: param !! Current run configuration parameters + logical, dimension(:), intent(in) :: plmask !! Logical array indicating which index values belong to massive bodies + logical, dimension(:), intent(in) :: tpmask !! Logical array indicating which index values belong to test particles + end subroutine swiftest_io_netcdf_read_particle_info_system + + module subroutine swiftest_io_netcdf_write_frame_body(self, nc, param) + implicit none + class(swiftest_body), intent(in) :: self !! Swiftest base object + class(base_io_netcdf_parameters), intent(inout) :: nc !! Parameters used to for writing a NetCDF dataset to file + class(base_parameters), intent(inout) :: param !! Current run configuration parameters + end subroutine swiftest_io_netcdf_write_frame_body + + module subroutine swiftest_io_netcdf_write_frame_system(self, nc, param) + implicit none + class(swiftest_nbody_system), intent(inout) :: self !! Swiftest system object + class(base_io_netcdf_parameters), intent(inout) :: nc !! Parameters used to for writing a NetCDF dataset to file + class(base_parameters), intent(inout) :: param !! Current run configuration parameters + end subroutine swiftest_io_netcdf_write_frame_system + + module subroutine swiftest_io_netcdf_write_hdr_system(self, nc, param) + implicit none + class(swiftest_nbody_system), intent(in) :: self !! Swiftest nbody system object + class(base_io_netcdf_parameters), intent(inout) :: nc !! Parameters used to for writing a NetCDF dataset to file + class(base_parameters), intent(inout) :: param !! Current run configuration parameters + end subroutine swiftest_io_netcdf_write_hdr_system + + module subroutine swiftest_io_netcdf_write_info_body(self, nc, param) + implicit none + class(swiftest_body), intent(in) :: self !! Swiftest particle object + class(base_io_netcdf_parameters), intent(inout) :: nc !! Parameters used to identify a particular NetCDF dataset + class(base_parameters), intent(inout) :: param !! Current run configuration parameters + end subroutine swiftest_io_netcdf_write_info_body + + module subroutine swiftest_io_write_discard(self, param) + implicit none + class(swiftest_nbody_system), intent(inout) :: self !! SyMBA nbody system object + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + end subroutine swiftest_io_write_discard + + module subroutine swiftest_obl_acc_body(self, system) + implicit none + class(swiftest_body), intent(inout) :: self !! Swiftest body object + class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + end subroutine swiftest_obl_acc_body + + module subroutine swiftest_obl_acc_pl(self, system) + implicit none + class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object + class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + end subroutine swiftest_obl_acc_pl + + module subroutine swiftest_obl_acc_tp(self, system) + implicit none + class(swiftest_tp), intent(inout) :: self !! Swiftest test particle object + class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + end subroutine swiftest_obl_acc_tp + + module subroutine swiftest_obl_pot_system(self) + implicit none + class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nbody system object + end subroutine swiftest_obl_pot_system + + module subroutine swiftest_orbel_el2xv_vec(self, cb) + implicit none + class(swiftest_body), intent(inout) :: self !! Swiftest body object + class(swiftest_cb), intent(inout) :: cb !! Swiftest central body object + end subroutine swiftest_orbel_el2xv_vec + + pure module subroutine swiftest_orbel_scget(angle, sx, cx) + !$omp declare simd(swiftest_orbel_scget) + implicit none + real(DP), intent(in) :: angle + real(DP), intent(out) :: sx, cx + end subroutine swiftest_orbel_scget + + pure elemental module subroutine swiftest_orbel_xv2aeq(mu, px, py, pz, vx, vy, vz, a, e, q) + !$omp declare simd(swiftest_orbel_xv2aeq) + implicit none + real(DP), intent(in) :: mu !! Gravitational constant + real(DP), intent(in) :: px,py,pz !! Position vector + real(DP), intent(in) :: vx,vy,vz !! Velocity vector + real(DP), intent(out) :: a !! semimajor axis + real(DP), intent(out) :: e !! eccentricity + real(DP), intent(out) :: q !! periapsis + end subroutine swiftest_orbel_xv2aeq + + pure module subroutine swiftest_orbel_xv2aqt(mu, px, py, pz, vx, vy, vz, a, q, capm, tperi) + !$omp declare simd(swiftest_orbel_xv2aqt) + implicit none + real(DP), intent(in) :: mu !! Gravitational constant + real(DP), intent(in) :: px,py,pz !! Position vector + real(DP), intent(in) :: vx,vy,vz !! Velocity vector + real(DP), intent(out) :: a !! semimajor axis + real(DP), intent(out) :: q !! periapsis + real(DP), intent(out) :: capm !! mean anomaly + real(DP), intent(out) :: tperi !! time of pericenter passage + end subroutine swiftest_orbel_xv2aqt + + pure module subroutine swiftest_orbel_xv2el(mu, px, py, pz, vx, vy, vz, a, e, inc, capom, omega, capm, varpi, lam, f, cape, capf) + implicit none + real(DP), intent(in) :: mu !! Gravitational constant + real(DP), intent(in) :: px,py,pz !! Position vector + real(DP), intent(in) :: vx,vy,vz !! Velocity vector + real(DP), intent(out) :: a !! semimajor axis + real(DP), intent(out) :: e !! eccentricity + real(DP), intent(out) :: inc !! inclination + real(DP), intent(out) :: capom !! longitude of ascending node + real(DP), intent(out) :: omega !! argument of periapsis + real(DP), intent(out) :: capm !! mean anomaly + real(DP), intent(out) :: varpi !! longitude of periapsis + real(DP), intent(out) :: lam !! mean longitude + real(DP), intent(out) :: f !! true anomaly + real(DP), intent(out) :: cape !! eccentric anomaly (eccentric orbits) + real(DP), intent(out) :: capf !! hyperbolic anomaly (hyperbolic orbits) + end subroutine swiftest_orbel_xv2el + + module subroutine swiftest_orbel_xv2el_vec(self, cb) + implicit none + class(swiftest_body), intent(inout) :: self !! Swiftest body object + class(swiftest_cb), intent(inout) :: cb !! Swiftest central body object + end subroutine swiftest_orbel_xv2el_vec + + module subroutine swiftest_setup_body(self, n, param) + implicit none + class(swiftest_body), intent(inout) :: self !! Swiftest body object + integer(I4B), intent(in) :: n !! Number of particles to allocate space for + class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters + end subroutine swiftest_setup_body + + module subroutine swiftest_setup_construct_system(system, param) + implicit none + class(base_nbody_system), allocatable, intent(inout) :: system !! Swiftest system object + class(base_parameters), intent(inout) :: param !! Current run configuration parameters + end subroutine swiftest_setup_construct_system + + module subroutine swiftest_setup_initialize_particle_info_system(self, param) + implicit none + class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nbody system object + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + end subroutine swiftest_setup_initialize_particle_info_system + + module subroutine swiftest_setup_initialize_system(self, param) + implicit none + class(swiftest_nbody_system), intent(inout) :: self !! Swiftest system object + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + end subroutine swiftest_setup_initialize_system + + module subroutine swiftest_setup_pl(self, n, param) + implicit none + class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object + integer(I4B), intent(in) :: n !! Number of particles to allocate space for + class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters + end subroutine swiftest_setup_pl + + module subroutine swiftest_setup_tp(self, n, param) + implicit none + class(swiftest_tp), intent(inout) :: self !! Swiftest test particle object + integer(I4B), intent(in) :: n !! Number of particles to allocate space for + class(swiftest_parameters), intent(in) :: param !! Current run configuration parametersr + end subroutine swiftest_setup_tp + + ! TODO: Implement the tides model + module subroutine swiftest_tides_kick_getacch_pl(self, system) + implicit none + class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object + class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + end subroutine swiftest_tides_kick_getacch_pl + + ! module subroutine swiftest_tides_step_spin_system(self, param, t, dt) + ! implicit none + ! class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nbody system object + ! class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters + ! real(DP), intent(in) :: t !! Simulation time + ! real(DP), intent(in) :: dt !! Current stepsize + ! end subroutine swiftest_tides_step_spin_system + + module subroutine swiftest_user_kick_getacch_body(self, system, param, t, lbeg) + implicit none + class(swiftest_body), intent(inout) :: self !! Swiftest massive body particle data structure + class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody_system_object + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + real(DP), intent(in) :: t !! Current time + logical, intent(in) :: lbeg !! Optional argument that determines whether or not this is the beginning or end of the step + end subroutine swiftest_user_kick_getacch_body + end interface + + interface util_append + module subroutine swiftest_util_append_arr_char_string(arr, source, nold, nsrc, lsource_mask) + implicit none + character(len=STRMAX), dimension(:), allocatable, intent(inout) :: arr !! Destination array + character(len=STRMAX), dimension(:), allocatable, intent(in) :: source !! Array to append + integer(I4B), intent(in) :: nold, nsrc !! Extend of the old array and the source array, respectively + logical, dimension(:), intent(in) :: lsource_mask !! Logical mask indicating which elements to append to + end subroutine swiftest_util_append_arr_char_string + + module subroutine swiftest_util_append_arr_DP(arr, source, nold, nsrc, lsource_mask) + implicit none + real(DP), dimension(:), allocatable, intent(inout) :: arr !! Destination array + real(DP), dimension(:), allocatable, intent(in) :: source !! Array to append + integer(I4B), intent(in) :: nold, nsrc !! Extend of the old array and the source array, respectively + logical, dimension(:), intent(in) :: lsource_mask !! Logical mask indicating which elements to append to + end subroutine swiftest_util_append_arr_DP + + module subroutine swiftest_util_append_arr_DPvec(arr, source, nold, nsrc, lsource_mask) + implicit none + real(DP), dimension(:,:), allocatable, intent(inout) :: arr !! Destination array + real(DP), dimension(:,:), allocatable, intent(in) :: source !! Array to append + integer(I4B), intent(in) :: nold, nsrc !! Extend of the old array and the source array, respectively + logical, dimension(:), intent(in) :: lsource_mask !! Logical mask indicating which elements to append to + end subroutine swiftest_util_append_arr_DPvec + + module subroutine swiftest_util_append_arr_I4B(arr, source, nold, nsrc, lsource_mask) + implicit none + integer(I4B), dimension(:), allocatable, intent(inout) :: arr !! Destination array + integer(I4B), dimension(:), allocatable, intent(in) :: source !! Array to append + integer(I4B), intent(in) :: nold, nsrc !! Extend of the old array and the source array, respectively + logical, dimension(:), intent(in) :: lsource_mask !! Logical mask indicating which elements to append to + end subroutine swiftest_util_append_arr_I4B + + module subroutine swiftest_util_append_arr_info(arr, source, nold, nsrc, lsource_mask) + implicit none + type(swiftest_particle_info), dimension(:), allocatable, intent(inout) :: arr !! Destination array + type(swiftest_particle_info), dimension(:), allocatable, intent(in) :: source !! Array to append + integer(I4B), intent(in) :: nold, nsrc !! Extend of the old array and the source array, respectively + logical, dimension(:), intent(in) :: lsource_mask !! Logical mask indicating which elements to append to + end subroutine swiftest_util_append_arr_info + + module subroutine swiftest_util_append_arr_kin(arr, source, nold, nsrc, lsource_mask) + implicit none + type(swiftest_kinship), dimension(:), allocatable, intent(inout) :: arr !! Destination array + type(swiftest_kinship), dimension(:), allocatable, intent(in) :: source !! Array to append + integer(I4B), intent(in) :: nold, nsrc !! Extend of the old array and the source array, respectively + logical, dimension(:), intent(in) :: lsource_mask !! Logical mask indicating which elements to append to + end subroutine swiftest_util_append_arr_kin + + module subroutine swiftest_util_append_arr_logical(arr, source, nold, nsrc, lsource_mask) + implicit none + logical, dimension(:), allocatable, intent(inout) :: arr !! Destination array + logical, dimension(:), allocatable, intent(in) :: source !! Array to append + integer(I4B), intent(in) :: nold, nsrc !! Extend of the old array and the source array, respectively + logical, dimension(:), intent(in) :: lsource_mask !! Logical mask indicating which elements to append to + end subroutine swiftest_util_append_arr_logical + end interface + + interface + module subroutine swiftest_util_append_body(self, source, lsource_mask) + implicit none + class(swiftest_body), intent(inout) :: self !! Swiftest body object + class(swiftest_body), intent(in) :: source !! Source object to append + logical, dimension(:), intent(in) :: lsource_mask !! Logical mask indicating which elements to append to + end subroutine swiftest_util_append_body + + + module subroutine swiftest_util_append_pl(self, source, lsource_mask) + implicit none + class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object + class(swiftest_body), intent(in) :: source !! Source object to append + logical, dimension(:), intent(in) :: lsource_mask !! Logical mask indicating which elements to append to + end subroutine swiftest_util_append_pl + + module subroutine swiftest_util_append_tp(self, source, lsource_mask) + implicit none + class(swiftest_tp), intent(inout) :: self !! Swiftest test particle object + class(swiftest_body), intent(in) :: source !! Source object to append + logical, dimension(:), intent(in) :: lsource_mask !! Logical mask indicating which elements to append to + end subroutine swiftest_util_append_tp + + module subroutine swiftest_util_coord_b2h_pl(self, cb) + implicit none + class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object + class(swiftest_cb), intent(inout) :: cb !! Swiftest central body object + end subroutine swiftest_util_coord_b2h_pl + + module subroutine swiftest_util_coord_b2h_tp(self, cb) + implicit none + class(swiftest_tp), intent(inout) :: self !! Swiftest test particle object + class(swiftest_cb), intent(in) :: cb !! Swiftest central body object + end subroutine swiftest_util_coord_b2h_tp + + module subroutine swiftest_util_coord_h2b_pl(self, cb) + implicit none + class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object + class(swiftest_cb), intent(inout) :: cb !! Swiftest central body object + end subroutine swiftest_util_coord_h2b_pl + + module subroutine swiftest_util_coord_h2b_tp(self, cb) + implicit none + class(swiftest_tp), intent(inout) :: self !! Swiftest test particle object + class(swiftest_cb), intent(in) :: cb !! Swiftest central body object + end subroutine swiftest_util_coord_h2b_tp + + module subroutine swiftest_util_coord_vb2vh_pl(self, cb) + implicit none + class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object + class(swiftest_cb), intent(inout) :: cb !! Swiftest central body object + end subroutine swiftest_util_coord_vb2vh_pl + + module subroutine swiftest_util_coord_vb2vh_tp(self, vbcb) + implicit none + class(swiftest_tp), intent(inout) :: self !! Swiftest test particle object + real(DP), dimension(:), intent(in) :: vbcb !! Barycentric velocity of the central body + end subroutine swiftest_util_coord_vb2vh_tp + + module subroutine swiftest_util_coord_vh2vb_pl(self, cb) + implicit none + class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object + class(swiftest_cb), intent(inout) :: cb !! Swiftest central body object + end subroutine swiftest_util_coord_vh2vb_pl + + module subroutine swiftest_util_coord_vh2vb_tp(self, vbcb) + implicit none + class(swiftest_tp), intent(inout) :: self !! Swiftest test particle object + real(DP), dimension(:), intent(in) :: vbcb !! Barycentric velocity of the central body + end subroutine swiftest_util_coord_vh2vb_tp + + module subroutine swiftest_util_coord_rh2rb_pl(self, cb) + implicit none + class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object + class(swiftest_cb), intent(inout) :: cb !! Swiftest central body object + end subroutine swiftest_util_coord_rh2rb_pl + + module subroutine swiftest_util_coord_rh2rb_tp(self, cb) + implicit none + class(swiftest_tp), intent(inout) :: self !! Swiftest test particle object + class(swiftest_cb), intent(in) :: cb !! Swiftest central body object + end subroutine swiftest_util_coord_rh2rb_tp + + module subroutine swiftest_util_copy_particle_info(self, source) + implicit none + class(swiftest_particle_info), intent(inout) :: self + class(swiftest_particle_info), intent(in) :: source + end subroutine swiftest_util_copy_particle_info + + module subroutine swiftest_util_copy_particle_info_arr(source, dest, idx) + implicit none + class(swiftest_particle_info), dimension(:), intent(in) :: source !! Source object to copy into + class(swiftest_particle_info), dimension(:), intent(inout) :: dest !! Swiftest body object with particle metadata information object + integer(I4B), dimension(:), intent(in), optional :: idx !! Optional array of indices to draw the source object + end subroutine swiftest_util_copy_particle_info_arr + + module subroutine swiftest_util_dealloc_body(self) + implicit none + class(swiftest_body), intent(inout) :: self + end subroutine swiftest_util_dealloc_body + + module subroutine swiftest_util_dealloc_kin(self) + implicit none + class(swiftest_kinship), intent(inout) :: self !! Swiftest kinship object + end subroutine swiftest_util_dealloc_kin + + module subroutine swiftest_util_dealloc_pl(self) + implicit none + class(swiftest_pl), intent(inout) :: self + end subroutine swiftest_util_dealloc_pl + + module subroutine swiftest_util_final_kin(self) + implicit none + type(swiftest_kinship), intent(inout) :: self !! Swiftest kinship object + end subroutine swiftest_util_final_kin + + module subroutine swiftest_util_final_system(self) + implicit none + class(swiftest_nbody_system), intent(inout) :: self + end subroutine swiftest_util_final_system + + module subroutine swiftest_util_dealloc_tp(self) + implicit none + class(swiftest_tp), intent(inout) :: self + end subroutine swiftest_util_dealloc_tp + + module subroutine swiftest_util_exit(code) + implicit none + integer(I4B), intent(in) :: code !! Failure exit code + end subroutine swiftest_util_exit + + module subroutine swiftest_util_fill_body(self, inserts, lfill_list) + implicit none + class(swiftest_body), intent(inout) :: self !! Swiftest body object + class(swiftest_body), intent(in) :: inserts !! Swiftest body object to be inserted + logical, dimension(:), intent(in) :: lfill_list !! Logical array of bodies to merge into the keeps + end subroutine swiftest_util_fill_body + + + module subroutine swiftest_util_fill_pl(self, inserts, lfill_list) + implicit none + class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object + class(swiftest_body), intent(in) :: inserts !! Swiftest body object to be inserted + logical, dimension(:), intent(in) :: lfill_list !! Logical array of bodies to merge into the keeps + end subroutine swiftest_util_fill_pl + + module subroutine swiftest_util_fill_tp(self, inserts, lfill_list) + implicit none + class(swiftest_tp), intent(inout) :: self !! Swiftest test particle object + class(swiftest_body), intent(in) :: inserts !! Swiftest body object to be inserted + logical, dimension(:), intent(in) :: lfill_list !! Logical array of bodies to merge into the keeps + end subroutine swiftest_util_fill_tp + end interface + + interface util_fill + module subroutine swiftest_util_fill_arr_char_string(keeps, inserts, lfill_list) + implicit none + character(len=STRMAX), dimension(:), allocatable, intent(inout) :: keeps !! Array of values to keep + character(len=STRMAX), dimension(:), allocatable, intent(in) :: inserts !! Array of values to insert into keep + logical, dimension(:), intent(in) :: lfill_list !! Logical array of bodies to merge into the keeps + end subroutine swiftest_util_fill_arr_char_string + + module subroutine swiftest_util_fill_arr_DP(keeps, inserts, lfill_list) + implicit none + real(DP), dimension(:), allocatable, intent(inout) :: keeps !! Array of values to keep + real(DP), dimension(:), allocatable, intent(in) :: inserts !! Array of values to insert into keep + logical, dimension(:), intent(in) :: lfill_list !! Logical array of bodies to merge into the keeps + end subroutine swiftest_util_fill_arr_DP + + module subroutine swiftest_util_fill_arr_DPvec(keeps, inserts, lfill_list) + implicit none + real(DP), dimension(:,:), allocatable, intent(inout) :: keeps !! Array of values to keep + real(DP), dimension(:,:), allocatable, intent(in) :: inserts !! Array of values to insert into keep + logical, dimension(:), intent(in) :: lfill_list !! Logical array of bodies to merge into the keeps + end subroutine swiftest_util_fill_arr_DPvec + + module subroutine swiftest_util_fill_arr_I4B(keeps, inserts, lfill_list) + implicit none + integer(I4B), dimension(:), allocatable, intent(inout) :: keeps !! Array of values to keep + integer(I4B), dimension(:), allocatable, intent(in) :: inserts !! Array of values to insert into keep + logical, dimension(:), intent(in) :: lfill_list !! Logical array of bodies to merge into the keeps + end subroutine swiftest_util_fill_arr_I4B + + module subroutine swiftest_util_fill_arr_info(keeps, inserts, lfill_list) + implicit none + type(swiftest_particle_info), dimension(:), allocatable, intent(inout) :: keeps !! Array of values to keep + type(swiftest_particle_info), dimension(:), allocatable, intent(in) :: inserts !! Array of values to insert into keep + logical, dimension(:), intent(in) :: lfill_list !! Logical array of bodies to merge into the keeps + end subroutine swiftest_util_fill_arr_info + + module subroutine swiftest_util_fill_arr_kin(keeps, inserts, lfill_list) + implicit none + type(swiftest_kinship), dimension(:), allocatable, intent(inout) :: keeps !! Array of values to keep + type(swiftest_kinship), dimension(:), allocatable, intent(in) :: inserts !! Array of values to insert into keep + logical, dimension(:), intent(in) :: lfill_list !! Logical array of bodies to merge into the keeps + end subroutine swiftest_util_fill_arr_kin + + module subroutine swiftest_util_fill_arr_logical(keeps, inserts, lfill_list) + implicit none + logical, dimension(:), allocatable, intent(inout) :: keeps !! Array of values to keep + logical, dimension(:), allocatable, intent(in) :: inserts !! Array of values to insert into keep + logical, dimension(:), intent(in) :: lfill_list !! Logical array of bodies to merge into the keeps + end subroutine swiftest_util_fill_arr_logical + end interface + + interface + + module subroutine swiftest_util_final_storage(self) + implicit none + type(swiftest_storage(*)) :: self + end subroutine swiftest_util_final_storage + + pure module subroutine swiftest_util_flatten_eucl_ij_to_k(n, i, j, k) + !$omp declare simd(swiftest_util_flatten_eucl_ij_to_k) + implicit none + integer(I4B), intent(in) :: n !! Number of bodies + integer(I4B), intent(in) :: i !! Index of the ith body + integer(I4B), intent(in) :: j !! Index of the jth body + integer(I8B), intent(out) :: k !! Index of the flattened matrix + end subroutine swiftest_util_flatten_eucl_ij_to_k + + pure module subroutine swiftest_util_flatten_eucl_k_to_ij(n, k, i, j) + implicit none + integer(I4B), intent(in) :: n !! Number of bodies + integer(I8B), intent(in) :: k !! Index of the flattened matrix + integer(I4B), intent(out) :: i !! Index of the ith body + integer(I4B), intent(out) :: j !! Index of the jth body + end subroutine swiftest_util_flatten_eucl_k_to_ij + + module subroutine swiftest_util_flatten_eucl_plpl(self, param) + implicit none + class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + end subroutine + + module subroutine swiftest_util_flatten_eucl_pltp(self, pl, param) + implicit none + class(swiftest_tp), intent(inout) :: self !! Swiftest test particle object + class(swiftest_pl), intent(in) :: pl !! Swiftest massive body object + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + end subroutine + + module subroutine swiftest_util_get_vals_storage(self, idvals, tvals) + class(swiftest_storage(*)), intent(in) :: self !! Swiftest storage object + integer(I4B), dimension(:), allocatable, intent(out) :: idvals !! Array of all id values in all snapshots + real(DP), dimension(:), allocatable, intent(out) :: tvals !! Array of all time values in all snapshots + end subroutine swiftest_util_get_vals_storage + + module subroutine swiftest_util_index_array(ind_arr, n) + implicit none + integer(I4B), dimension(:), allocatable, intent(inout) :: ind_arr !! Index array. Input is a pre-existing index array where n /= size(ind_arr). Output is a new index array ind_arr = [1, 2, ... n] + integer(I4B), intent(in) :: n !! The new size of the index array + end subroutine swiftest_util_index_array + + module subroutine swiftest_util_index_map_storage(self) + implicit none + class(swiftest_storage(*)), intent(inout) :: self !! Swiftest storage object + end subroutine swiftest_util_index_map_storage + + module subroutine swiftest_util_minimize_bfgs(f, N, x0, eps, maxloop, lerr, x1) + use lambda_function + implicit none + integer(I4B), intent(in) :: N + class(lambda_obj), intent(inout) :: f + real(DP), dimension(:), intent(in) :: x0 + real(DP), intent(in) :: eps + logical, intent(out) :: lerr + integer(I4B), intent(in) :: maxloop + real(DP), dimension(:), allocatable, intent(out) :: x1 + end subroutine swiftest_util_minimize_bfgs + + module subroutine swiftest_util_peri_body(self, system, param) + implicit none + class(swiftest_body), intent(inout) :: self !! SyMBA massive body object + class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters + end subroutine swiftest_util_peri_body + + module subroutine swiftest_util_peri_tp(self, system, param) + implicit none + class(swiftest_tp), intent(inout) :: self !! Swiftest test particle object + class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters + end subroutine swiftest_util_peri_tp + + module subroutine swiftest_util_rearray_pl(self, system, param) + implicit none + class(swiftest_pl), intent(inout) :: self !! SyMBA massive body object + class(swiftest_nbody_system), intent(inout) :: system !! SyMBA nbody system object + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions + end subroutine swiftest_util_rearray_pl + + module subroutine swiftest_util_rescale_system(self, param, mscale, dscale, tscale) + implicit none + class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nbody system object + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters. Returns with new values of the scale vactors and GU + real(DP), intent(in) :: mscale, dscale, tscale !! Scale factors for mass, distance, and time units, respectively. + end subroutine swiftest_util_rescale_system + + module subroutine swiftest_util_reset_kinship_pl(self, idx) + implicit none + class(swiftest_pl), intent(inout) :: self !! SyMBA massive body object + integer(I4B), dimension(:), intent(in) :: idx !! Index array of bodies to reset + end subroutine swiftest_util_reset_kinship_pl + + module subroutine swiftest_util_reset_storage(self) + implicit none + class(swiftest_storage(*)), intent(inout) :: self !! Swiftest storage object + end subroutine swiftest_util_reset_storage + end interface + + + interface util_resize + module subroutine swiftest_util_resize_arr_char_string(arr, nnew) + implicit none + character(len=STRMAX), dimension(:), allocatable, intent(inout) :: arr !! Array to resize + integer(I4B), intent(in) :: nnew !! New size + end subroutine swiftest_util_resize_arr_char_string + + module subroutine swiftest_util_resize_arr_DP(arr, nnew) + implicit none + real(DP), dimension(:), allocatable, intent(inout) :: arr !! Array to resize + integer(I4B), intent(in) :: nnew !! New size + end subroutine swiftest_util_resize_arr_DP + + module subroutine swiftest_util_resize_arr_DPvec(arr, nnew) + implicit none + real(DP), dimension(:,:), allocatable, intent(inout) :: arr !! Array to resize + integer(I4B), intent(in) :: nnew !! New size + end subroutine swiftest_util_resize_arr_DPvec + + module subroutine swiftest_util_resize_arr_I4B(arr, nnew) + implicit none + integer(I4B), dimension(:), allocatable, intent(inout) :: arr !! Array to resize + integer(I4B), intent(in) :: nnew !! New size + end subroutine swiftest_util_resize_arr_I4B + + module subroutine swiftest_util_resize_arr_info(arr, nnew) + implicit none + type(swiftest_particle_info), dimension(:), allocatable, intent(inout) :: arr !! Array to resize + integer(I4B), intent(in) :: nnew !! New size + end subroutine swiftest_util_resize_arr_info + + module subroutine swiftest_util_resize_arr_kin(arr, nnew) + implicit none + type(swiftest_kinship), dimension(:), allocatable, intent(inout) :: arr !! Array to resize + integer(I4B), intent(in) :: nnew !! New size + end subroutine swiftest_util_resize_arr_kin + + module subroutine swiftest_util_resize_arr_logical(arr, nnew) + implicit none + logical, dimension(:), allocatable, intent(inout) :: arr !! Array to resize + integer(I4B), intent(in) :: nnew !! New size + end subroutine swiftest_util_resize_arr_logical + end interface + + interface + module subroutine swiftest_util_resize_body(self, nnew) + implicit none + class(swiftest_body), intent(inout) :: self !! Swiftest body object + integer(I4B), intent(in) :: nnew !! New size neded + end subroutine swiftest_util_resize_body + + module subroutine swiftest_util_resize_pl(self, nnew) + implicit none + class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object + integer(I4B), intent(in) :: nnew !! New size neded + end subroutine swiftest_util_resize_pl + + module subroutine swiftest_util_resize_tp(self, nnew) + implicit none + class(swiftest_tp), intent(inout) :: self !! Swiftest test particle object + integer(I4B), intent(in) :: nnew !! New size neded + end subroutine swiftest_util_resize_tp + + module subroutine swiftest_util_get_energy_momentum_system(self, param) + implicit none + class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nbody system object + class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters + end subroutine swiftest_util_get_energy_momentum_system + + module subroutine swiftest_util_get_idvalues_system(self, idvals) + implicit none + class(swiftest_nbody_system), intent(in) :: self !! Encounter snapshot object + integer(I4B), dimension(:), allocatable, intent(out) :: idvals !! Array of all id values saved in this snapshot + end subroutine swiftest_util_get_idvalues_system + + module subroutine swiftest_util_set_beg_end_pl(self, rbeg, rend, vbeg) + implicit none + class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object + real(DP), dimension(:,:), intent(in), optional :: rbeg !! Position vectors at beginning of step + real(DP), dimension(:,:), intent(in), optional :: rend !! Positions vectors at end of step + real(DP), dimension(:,:), intent(in), optional :: vbeg !! vbeg is an unused variable to keep this method forward compatible with RMVS + end subroutine swiftest_util_set_beg_end_pl + + module subroutine swiftest_util_set_ir3h(self) + implicit none + class(swiftest_body), intent(inout) :: self !! Swiftest body object + end subroutine swiftest_util_set_ir3h + + module subroutine swiftest_util_set_msys(self) + implicit none + class(swiftest_nbody_system), intent(inout) :: self !! Swiftest system object + end subroutine swiftest_util_set_msys + + module subroutine swiftest_util_set_mu_pl(self, cb) + implicit none + class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object + class(swiftest_cb), intent(inout) :: cb !! Swiftest central body object + end subroutine swiftest_util_set_mu_pl + + module subroutine swiftest_util_set_mu_tp(self, cb) + implicit none + class(swiftest_tp), intent(inout) :: self !! Swiftest test particle object + class(swiftest_cb), intent(inout) :: cb !! Swiftest central body object + end subroutine swiftest_util_set_mu_tp + + module subroutine swiftest_util_set_particle_info(self, name, particle_type, status, origin_type, origin_time, collision_id, & + origin_rh, origin_vh, discard_time, discard_rh, discard_vh, discard_body_id) + implicit none + class(swiftest_particle_info), intent(inout) :: self + character(len=*), intent(in), optional :: name !! Non-unique name + character(len=*), intent(in), optional :: particle_type !! String containing a description of the particle type (e.g. Central Body, Massive Body, Test Particle) + character(len=*), intent(in), optional :: status !! Particle status description: Active, Merged, Fragmented, etc. + character(len=*), intent(in), optional :: origin_type !! String containing a description of the origin of the particle (e.g. Initial Conditions, Supercatastrophic, Disruption, etc.) + real(DP), intent(in), optional :: origin_time !! The time of the particle's formation + integer(I4B), intent(in), optional :: collision_id !! The ID fo the collision that formed the particle + real(DP), dimension(:), intent(in), optional :: origin_rh !! The heliocentric distance vector at the time of the particle's formation + real(DP), dimension(:), intent(in), optional :: origin_vh !! The heliocentric velocity vector at the time of the particle's formation + real(DP), intent(in), optional :: discard_time !! The time of the particle's discard + real(DP), dimension(:), intent(in), optional :: discard_rh !! The heliocentric distance vector at the time of the particle's discard + real(DP), dimension(:), intent(in), optional :: discard_vh !! The heliocentric velocity vector at the time of the particle's discard + integer(I4B), intent(in), optional :: discard_body_id !! The id of the other body involved in the discard (0 if no other body involved) + end subroutine swiftest_util_set_particle_info + + module subroutine swiftest_util_set_rhill(self,cb) + implicit none + class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object + class(swiftest_cb), intent(inout) :: cb !! Swiftest central body object + end subroutine swiftest_util_set_rhill + + module subroutine swiftest_util_set_renc_I4B(self, scale) + implicit none + class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object + integer(I4B), intent(in) :: scale !! Input scale factor (multiplier of Hill's sphere size) + end subroutine swiftest_util_set_renc_I4B + + module subroutine swiftest_util_set_renc_DP(self, scale) + implicit none + class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object + real(DP), intent(in) :: scale !! Input scale factor (multiplier of Hill's sphere size) + end subroutine swiftest_util_set_renc_DP + + module subroutine swiftest_util_set_rhill_approximate(self,cb) + implicit none + class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object + class(swiftest_cb), intent(inout) :: cb !! Swiftest central body object + end subroutine swiftest_util_set_rhill_approximate + + module subroutine swiftest_util_snapshot_system(self, param, system, t, arg) + implicit none + class(swiftest_storage(*)), intent(inout) :: self !! Swiftest storage object + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object to store + real(DP), intent(in), optional :: t !! Time of snapshot if different from system time + character(*), intent(in), optional :: arg !! Optional argument (needed for extended storage type used in encounter snapshots) + end subroutine swiftest_util_snapshot_system + end interface + + + interface util_solve_linear_system + module function util_solve_linear_system_d(A,b,n,lerr) result(x) + implicit none + integer(I4B), intent(in) :: n + real(DP), dimension(:,:), intent(in) :: A + real(DP), dimension(:), intent(in) :: b + logical, intent(out) :: lerr + real(DP), dimension(n) :: x + end function util_solve_linear_system_d + + module function util_solve_linear_system_q(A,b,n,lerr) result(x) + implicit none + integer(I4B), intent(in) :: n + real(QP), dimension(:,:), intent(in) :: A + real(QP), dimension(:), intent(in) :: b + logical, intent(out) :: lerr + real(QP), dimension(n) :: x + end function util_solve_linear_system_q + end interface + + interface + module function util_solve_rkf45(f, y0in, t1, dt0, tol) result(y1) + use lambda_function + implicit none + class(lambda_obj), intent(inout) :: f !! lambda function object that has been initialized to be a function of derivatives. The object will return with components lastarg and lasteval set + real(DP), dimension(:), intent(in) :: y0in !! Initial value at t=0 + real(DP), intent(in) :: t1 !! Final time + real(DP), intent(in) :: dt0 !! Initial step size guess + real(DP), intent(in) :: tol !! Tolerance on solution + real(DP), dimension(:), allocatable :: y1 !! Final result + end function util_solve_rkf45 + end interface + + interface util_sort + pure module subroutine swiftest_util_sort_i4b(arr) + implicit none + integer(I4B), dimension(:), intent(inout) :: arr + end subroutine swiftest_util_sort_i4b + + pure module subroutine swiftest_util_sort_index_i4b(arr,ind) + implicit none + integer(I4B), dimension(:), intent(in) :: arr + integer(I4B), dimension(:), allocatable, intent(inout) :: ind + end subroutine swiftest_util_sort_index_i4b + + pure module subroutine swiftest_util_sort_index_I4B_I8Bind(arr,ind) + implicit none + integer(I4B), dimension(:), intent(in) :: arr + integer(I8B), dimension(:), allocatable, intent(inout) :: ind + end subroutine swiftest_util_sort_index_I4b_I8Bind + + pure module subroutine swiftest_util_sort_index_I8B_I8Bind(arr,ind) + implicit none + integer(I8B), dimension(:), intent(in) :: arr + integer(I8B), dimension(:), allocatable, intent(inout) :: ind + end subroutine swiftest_util_sort_index_I8B_I8Bind + + pure module subroutine swiftest_util_sort_sp(arr) + implicit none + real(SP), dimension(:), intent(inout) :: arr + end subroutine swiftest_util_sort_sp + + pure module subroutine swiftest_util_sort_index_sp(arr,ind) + implicit none + real(SP), dimension(:), intent(in) :: arr + integer(I4B), dimension(:), allocatable, intent(inout) :: ind + end subroutine swiftest_util_sort_index_sp + + pure module subroutine swiftest_util_sort_dp(arr) + implicit none + real(DP), dimension(:), intent(inout) :: arr + end subroutine swiftest_util_sort_dp + + pure module subroutine swiftest_util_sort_index_dp(arr,ind) + implicit none + real(DP), dimension(:), intent(in) :: arr + integer(I4B), dimension(:), allocatable, intent(inout) :: ind + end subroutine swiftest_util_sort_index_dp + end interface util_sort + + interface util_sort_rearrange + pure module subroutine swiftest_util_sort_rearrange_arr_char_string(arr, ind, n) + implicit none + character(len=STRMAX), dimension(:), allocatable, intent(inout) :: arr !! Destination array + integer(I4B), dimension(:), intent(in) :: ind !! Index to rearrange against + integer(I4B), intent(in) :: n !! Number of elements in arr and ind to rearrange + end subroutine swiftest_util_sort_rearrange_arr_char_string + + pure module subroutine swiftest_util_sort_rearrange_arr_DP(arr, ind, n) + implicit none + real(DP), dimension(:), allocatable, intent(inout) :: arr !! Destination array + integer(I4B), dimension(:), intent(in) :: ind !! Index to rearrange against + integer(I4B), intent(in) :: n !! Number of elements in arr and ind to rearrange + end subroutine swiftest_util_sort_rearrange_arr_DP + + pure module subroutine swiftest_util_sort_rearrange_arr_DPvec(arr, ind, n) + implicit none + real(DP), dimension(:,:), allocatable, intent(inout) :: arr !! Destination array + integer(I4B), dimension(:), intent(in) :: ind !! Index to rearrange against + integer(I4B), intent(in) :: n !! Number of elements in arr and ind to rearrange + end subroutine swiftest_util_sort_rearrange_arr_DPvec + + pure module subroutine swiftest_util_sort_rearrange_arr_I4B(arr, ind, n) + implicit none + integer(I4B), dimension(:), allocatable, intent(inout) :: arr !! Destination array + integer(I4B), dimension(:), intent(in) :: ind !! Index to rearrange against + integer(I4B), intent(in) :: n !! Number of elements in arr and ind to rearrange + end subroutine swiftest_util_sort_rearrange_arr_I4B + + pure module subroutine swiftest_util_sort_rearrange_arr_I4B_I8Bind(arr, ind, n) + implicit none + integer(I4B), dimension(:), allocatable, intent(inout) :: arr !! Destination array + integer(I8B), dimension(:), intent(in) :: ind !! Index to rearrange against + integer(I8B), intent(in) :: n !! Number of elements in arr and ind to rearrange + end subroutine swiftest_util_sort_rearrange_arr_I4B_I8Bind + + module subroutine swiftest_util_sort_rearrange_arr_info(arr, ind, n) + implicit none + type(swiftest_particle_info), dimension(:), allocatable, intent(inout) :: arr !! Destination array + integer(I4B), dimension(:), intent(in) :: ind !! Index to rearrange against + integer(I4B), intent(in) :: n !! Number of elements in arr and ind to rearrange + end subroutine swiftest_util_sort_rearrange_arr_info + + pure module subroutine swiftest_util_sort_rearrange_arr_kin(arr, ind, n) + implicit none + type(swiftest_kinship), dimension(:), allocatable, intent(inout) :: arr !! Destination array + integer(I4B), dimension(:), intent(in) :: ind !! Index to rearrange against + integer(I4B), intent(in) :: n !! Number of elements in arr and ind to rearrange + end subroutine swiftest_util_sort_rearrange_arr_kin + + pure module subroutine swiftest_util_sort_rearrange_arr_logical(arr, ind, n) + implicit none + logical, dimension(:), allocatable, intent(inout) :: arr !! Destination array + integer(I4B), dimension(:), intent(in) :: ind !! Index to rearrange against + integer(I4B), intent(in) :: n !! Number of elements in arr and ind to rearrange + end subroutine swiftest_util_sort_rearrange_arr_logical + + pure module subroutine swiftest_util_sort_rearrange_arr_logical_I8Bind(arr, ind, n) + implicit none + logical, dimension(:), allocatable, intent(inout) :: arr !! Destination array + integer(I8B), dimension(:), intent(in) :: ind !! Index to rearrange against + integer(I8B), intent(in) :: n !! Number of elements in arr and ind to rearrange + end subroutine swiftest_util_sort_rearrange_arr_logical_I8Bind + end interface util_sort_rearrange + + interface + module subroutine swiftest_util_sort_rearrange_body(self, ind) + implicit none + class(swiftest_body), intent(inout) :: self !! Swiftest body object + integer(I4B), dimension(:), intent(in) :: ind !! Index array used to restructure the body (should contain all 1:n index values in the desired order) + end subroutine swiftest_util_sort_rearrange_body + + module subroutine swiftest_util_sort_rearrange_pl(self, ind) + implicit none + class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object + integer(I4B), dimension(:), intent(in) :: ind !! Index array used to restructure the body (should contain all 1:n index values in the desired order) + end subroutine swiftest_util_sort_rearrange_pl + + module subroutine swiftest_util_sort_rearrange_tp(self, ind) + implicit none + class(swiftest_tp), intent(inout) :: self !! Swiftest test particle object + integer(I4B), dimension(:), intent(in) :: ind !! Index array used to restructure the body (should contain all 1:n index values in the desired order) + end subroutine swiftest_util_sort_rearrange_tp + + module subroutine swiftest_util_sort_body(self, sortby, ascending) + implicit none + class(swiftest_body), intent(inout) :: self !! Swiftest body object + character(*), intent(in) :: sortby !! Sorting attribute + logical, intent(in) :: ascending !! Logical flag indicating whether or not the sorting should be in ascending or descending order + end subroutine swiftest_util_sort_body + + module subroutine swiftest_util_sort_pl(self, sortby, ascending) + implicit none + class(swiftest_pl), intent(inout) :: self !! Swiftest body object + character(*), intent(in) :: sortby !! Sorting attribute + logical, intent(in) :: ascending !! Logical flag indicating whether or not the sorting should be in ascending or descending order + end subroutine swiftest_util_sort_pl + + module subroutine swiftest_util_sort_tp(self, sortby, ascending) + implicit none + class(swiftest_tp), intent(inout) :: self !! Swiftest body object + character(*), intent(in) :: sortby !! Sorting attribute + logical, intent(in) :: ascending !! Logical flag indicating whether or not the sorting should be in ascending or descending order + end subroutine swiftest_util_sort_tp + + end interface + + interface util_spill + module subroutine swiftest_util_spill_arr_char_string(keeps, discards, lspill_list, ldestructive) + implicit none + character(len=STRMAX), dimension(:), allocatable, intent(inout) :: keeps !! Array of values to keep + character(len=STRMAX), dimension(:), allocatable, intent(inout) :: discards !! Array of discards + logical, dimension(:), intent(in) :: lspill_list !! Logical array of bodies to spill into the discardss + logical, intent(in) :: ldestructive !! Logical flag indicating whether or not this operation should alter the keeps array or not + end subroutine swiftest_util_spill_arr_char_string + + module subroutine swiftest_util_spill_arr_DP(keeps, discards, lspill_list, ldestructive) + implicit none + real(DP), dimension(:), allocatable, intent(inout) :: keeps !! Array of values to keep + real(DP), dimension(:), allocatable, intent(inout) :: discards !! Array of discards + logical, dimension(:), intent(in) :: lspill_list !! Logical array of bodies to spill into the discards + logical, intent(in) :: ldestructive !! Logical flag indicating whether or not this operation should alter the keeps array or not + end subroutine swiftest_util_spill_arr_DP + + module subroutine swiftest_util_spill_arr_DPvec(keeps, discards, lspill_list, ldestructive) + implicit none + real(DP), dimension(:,:), allocatable, intent(inout) :: keeps !! Array of values to keep + real(DP), dimension(:,:), allocatable, intent(inout) :: discards !! Array discards + logical, dimension(:), intent(in) :: lspill_list !! Logical array of bodies to spill into the discards + logical, intent(in) :: ldestructive !! Logical flag indicating whether or not this operation should alter the keeps array or not + end subroutine swiftest_util_spill_arr_DPvec + + module subroutine swiftest_util_spill_arr_I4B(keeps, discards, lspill_list, ldestructive) + implicit none + integer(I4B), dimension(:), allocatable, intent(inout) :: keeps !! Array of values to keep + integer(I4B), dimension(:), allocatable, intent(inout) :: discards !! Array of discards + logical, dimension(:), intent(in) :: lspill_list !! Logical array of bodies to spill into the discardss + logical, intent(in) :: ldestructive !! Logical flag indicating whether or not this operation should alter the keeps array or not + end subroutine swiftest_util_spill_arr_I4B + + module subroutine swiftest_util_spill_arr_I8B(keeps, discards, lspill_list, ldestructive) + implicit none + integer(I8B), dimension(:), allocatable, intent(inout) :: keeps !! Array of values to keep + integer(I8B), dimension(:), allocatable, intent(inout) :: discards !! Array of discards + logical, dimension(:), intent(in) :: lspill_list !! Logical array of bodies to spill into the discardss + logical, intent(in) :: ldestructive !! Logical flag indicating whether or not this operation should alter the keeps array or not + end subroutine swiftest_util_spill_arr_I8B + + module subroutine swiftest_util_spill_arr_info(keeps, discards, lspill_list, ldestructive) + implicit none + type(swiftest_particle_info), dimension(:), allocatable, intent(inout) :: keeps !! Array of values to keep + type(swiftest_particle_info), dimension(:), allocatable, intent(inout) :: discards !! Array of discards + logical, dimension(:), intent(in) :: lspill_list !! Logical array of bodies to spill into the discardss + logical, intent(in) :: ldestructive !! Logical flag indicating whether or not this operation should alter the keeps array or not + end subroutine swiftest_util_spill_arr_info + + module subroutine swiftest_util_spill_arr_kin(keeps, discards, lspill_list, ldestructive) + implicit none + type(swiftest_kinship), dimension(:), allocatable, intent(inout) :: keeps !! Array of values to keep + type(swiftest_kinship), dimension(:), allocatable, intent(inout) :: discards !! Array of discards + logical, dimension(:), intent(in) :: lspill_list !! Logical array of bodies to spill into the discardss + logical, intent(in) :: ldestructive !! Logical flag indicating whether or not this operation should alter the keeps array or not + end subroutine swiftest_util_spill_arr_kin + + module subroutine swiftest_util_spill_arr_logical(keeps, discards, lspill_list, ldestructive) + implicit none + logical, dimension(:), allocatable, intent(inout) :: keeps !! Array of values to keep + logical, dimension(:), allocatable, intent(inout) :: discards !! Array of discards + logical, dimension(:), intent(in) :: lspill_list !! Logical array of bodies to spill into the discardss + logical, intent(in) :: ldestructive !! Logical flag indicating whether or not this operation should alter the keeps array or not + end subroutine swiftest_util_spill_arr_logical + end interface + + interface + module subroutine swiftest_util_spill_body(self, discards, lspill_list, ldestructive) + implicit none + class(swiftest_body), intent(inout) :: self !! Swiftest body object + class(swiftest_body), intent(inout) :: discards !! Discarded object + logical, dimension(:), intent(in) :: lspill_list !! Logical array of bodies to spill into the discards + logical, intent(in) :: ldestructive !! Logical flag indicating whether or not this operation should alter the keeps array or not + end subroutine swiftest_util_spill_body + + module subroutine swiftest_util_spill_pl(self, discards, lspill_list, ldestructive) + implicit none + class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object + class(swiftest_body), intent(inout) :: discards !! Discarded object + logical, dimension(:), intent(in) :: lspill_list !! Logical array of bodies to spill into the discards + logical, intent(in) :: ldestructive !! Logical flag indicating whether or not this operation should alter the keeps array or not + end subroutine swiftest_util_spill_pl + + module subroutine swiftest_util_spill_tp(self, discards, lspill_list, ldestructive) + implicit none + class(swiftest_tp), intent(inout) :: self !! Swiftest test particle object + class(swiftest_body), intent(inout) :: discards !! Discarded object + logical, dimension(:), intent(in) :: lspill_list !! Logical array of bodies to spill into the discards + logical, intent(in) :: ldestructive !! Logical flag indicating whether or not this operation should alter the keeps array or not + end subroutine swiftest_util_spill_tp + + end interface + + interface util_unique + module subroutine swiftest_util_unique_DP(input_array, output_array, index_map) + implicit none + real(DP), dimension(:), intent(in) :: input_array !! Unsorted input array + real(DP), dimension(:), allocatable, intent(out) :: output_array !! Sorted array of unique values + integer(I4B), dimension(:), allocatable, intent(out) :: index_map !! An array of the same size as input_array that such that any for any index i, output_array(index_map(i)) = input_array(i) + end subroutine swiftest_util_unique_DP + + module subroutine swiftest_util_unique_I4B(input_array, output_array, index_map) + implicit none + integer(I4B), dimension(:), intent(in) :: input_array !! Unsorted input array + integer(I4B), dimension(:), allocatable, intent(out) :: output_array !! Sorted array of unique values + integer(I4B), dimension(:), allocatable, intent(out) :: index_map !! An array of the same size as input_array that such that any for any index i, output_array(index_map(i)) = input_array(i) + end subroutine swiftest_util_unique_I4B + end interface util_unique + + interface + module subroutine swiftest_util_valid_id_system(self, param) + implicit none + class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nbody system object + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + end subroutine swiftest_util_valid_id_system + + module subroutine swiftest_util_version() + implicit none + end subroutine swiftest_util_version + end interface + + contains + subroutine make_impactors_pl(self, idx) + implicit none + class(swiftest_pl), intent(inout) :: self !! Massive body object + integer(I4B), dimension(:), intent(in) :: idx !! Array holding the indices of the two bodies involved in the collision) + + call collision_resolve_make_impactors_pl(self, idx) + + return + end subroutine make_impactors_pl + end module swiftest diff --git a/src/modules/swiftest_classes.f90 b/src/modules/swiftest_classes.f90 deleted file mode 100644 index 813426dc7..000000000 --- a/src/modules/swiftest_classes.f90 +++ /dev/null @@ -1,2007 +0,0 @@ -!! Copyright 2022 - David Minton, Carlisle Wishard, Jennifer Pouplin, Jake Elliott, & Dana Singh -!! This file is part of Swiftest. -!! Swiftest is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License -!! as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. -!! Swiftest is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty -!! of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. -!! You should have received a copy of the GNU General Public License along with Swiftest. -!! If not, see: https://www.gnu.org/licenses. - -module swiftest_classes - !! author: The Purdue Swiftest Team - David A. Minton, Carlisle A. Wishard, Jennifer L.L. Pouplin, and Jacob R. Elliott - !! - !! Definition of data and structures generic to all integrators. - !! Adapted from David E. Kaufmann's Swifter routine: module_swifter.f90 - use swiftest_globals - implicit none - public - - !> 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 - character(STRMAX) :: file_name !! Name of the output file - 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) :: name_dimname = "name" !! name of the particle name dimension - integer(I4B) :: name_dimid !! ID for the particle name dimension - integer(I4B) :: name_varid !! ID for the particle name variable - character(NAMELEN) :: space_dimname = "space" !! name of the space dimension - integer(I4B) :: space_dimid !! ID for the space dimension - integer(I4B) :: space_varid !! ID for the space variable - character(len=1), dimension(3) :: space_coords = ["x","y","z"] !! The space dimension coordinate labels - - ! Non-dimension ids and variable names - character(NAMELEN) :: ptype_varname = "particle_type" !! name of the particle type variable - integer(I4B) :: ptype_varid !! ID for the particle type variable - character(NAMELEN) :: id_varname = "id" !! name of the particle id variable - integer(I4B) :: id_varid !! ID for the id variable - character(NAMELEN) :: npl_varname = "npl" !! name of the number of active massive bodies variable - integer(I4B) :: npl_varid !! ID for the number of active massive bodies variable - character(NAMELEN) :: ntp_varname = "ntp" !! name of the number of active test particles variable - integer(I4B) :: ntp_varid !! ID for the number of active test particles variable - character(NAMELEN) :: nplm_varname = "nplm" !! name of the number of active fully interacting massive bodies variable (SyMBA) - integer(I4B) :: nplm_varid !! ID for the number of active fully interacting massive bodies variable (SyMBA) - character(NAMELEN) :: a_varname = "a" !! name of the semimajor axis variable - integer(I4B) :: a_varid !! ID for the semimajor axis variable - character(NAMELEN) :: e_varname = "e" !! name of the eccentricity variable - integer(I4B) :: e_varid !! ID for the eccentricity variable - character(NAMELEN) :: inc_varname = "inc" !! name of the inclination variable - integer(I4B) :: inc_varid !! ID for the inclination variable - character(NAMELEN) :: capom_varname = "capom" !! name of the long. asc. node variable - integer(I4B) :: capom_varid !! ID for the long. asc. node variable - character(NAMELEN) :: omega_varname = "omega" !! name of the arg. of periapsis variable - integer(I4B) :: omega_varid !! ID for the arg. of periapsis variable - character(NAMELEN) :: capm_varname = "capm" !! name of the mean anomaly variable - integer(I4B) :: capm_varid !! ID for the mean anomaly variable - character(NAMELEN) :: varpi_varname = "varpi" !! name of the long. of periapsis variable - integer(I4B) :: varpi_varid !! ID for the long. of periapsis variable - character(NAMELEN) :: lam_varname = "lam" !! name of the mean longitude variable - integer(I4B) :: lam_varid !! ID for the mean longitude variable - character(NAMELEN) :: f_varname = "f" !! name of the true anomaly variable - integer(I4B) :: f_varid !! ID for the true anomaly variable - character(NAMELEN) :: cape_varname = "cape" !! name of the eccentric anomaly variable - integer(I4B) :: cape_varid !! ID for the eccentric anomaly variable - character(NAMELEN) :: rh_varname = "rh" !! name of the heliocentric position vector variable - integer(I4B) :: rh_varid !! ID for the heliocentric position vector variable - character(NAMELEN) :: vh_varname = "vh" !! name of the heliocentric velocity vector variable - integer(I4B) :: vh_varid !! ID for the heliocentric velocity vector variable - character(NAMELEN) :: gr_pseudo_vh_varname = "gr_pseudo_vh" !! name of the heliocentric pseudovelocity vector variable (used in GR only) - integer(I4B) :: gr_pseudo_vh_varid !! ID for the heliocentric pseudovelocity vector variable (used in GR) - character(NAMELEN) :: gmass_varname = "Gmass" !! name of the mass variable - integer(I4B) :: Gmass_varid !! ID for the mass variable - character(NAMELEN) :: rhill_varname = "rhill" !! name of the hill radius variable - integer(I4B) :: rhill_varid !! ID for the hill radius variable - character(NAMELEN) :: radius_varname = "radius" !! name of the radius variable - integer(I4B) :: radius_varid !! ID for the radius variable - character(NAMELEN) :: Ip_varname = "Ip" !! name of the principal moment of inertial variable - integer(I4B) :: Ip_varid !! ID for the axis principal moment of inertia variable - character(NAMELEN) :: rot_varname = "rot" !! name of the rotation vector variable - integer(I4B) :: rot_varid !! ID for the rotation vector variable - character(NAMELEN) :: j2rp2_varname = "j2rp2" !! name of the j2rp2 variable - integer(I4B) :: j2rp2_varid !! ID for the j2 variable - character(NAMELEN) :: j4rp4_varname = "j4rp4" !! name of the j4pr4 variable - integer(I4B) :: j4rp4_varid !! ID for the j4 variable - character(NAMELEN) :: k2_varname = "k2" !! name of the Love number variable - integer(I4B) :: k2_varid !! ID for the Love number variable - character(NAMELEN) :: q_varname = "Q" !! name of the energy dissipation variable - integer(I4B) :: Q_varid !! ID for the energy dissipation variable - character(NAMELEN) :: ke_orb_varname = "KE_orb" !! name of the system orbital kinetic energy variable - integer(I4B) :: KE_orb_varid !! ID for the system orbital kinetic energy variable - character(NAMELEN) :: ke_spin_varname = "KE_spin" !! name of the system spin kinetic energy variable - integer(I4B) :: KE_spin_varid !! ID for the system spin kinetic energy variable - character(NAMELEN) :: pe_varname = "PE" !! name of the system potential energy variable - integer(I4B) :: PE_varid !! ID for the system potential energy variable - character(NAMELEN) :: L_orb_varname = "L_orb" !! name of the orbital angular momentum vector variable - integer(I4B) :: L_orb_varid !! ID for the system orbital angular momentum vector variable - character(NAMELEN) :: Lspin_varname = "Lspin" !! name of the spin angular momentum vector variable - integer(I4B) :: Lspin_varid !! ID for the system spin angular momentum vector variable - character(NAMELEN) :: L_escape_varname = "L_escape" !! name of the escaped angular momentum vector variable - integer(I4B) :: L_escape_varid !! ID for the escaped angular momentum vector variable - character(NAMELEN) :: Ecollisions_varname = "Ecollisions" !! name of the escaped angular momentum y variable - integer(I4B) :: Ecollisions_varid !! ID for the energy lost in collisions variable - character(NAMELEN) :: Euntracked_varname = "Euntracked" !! name of the energy that is untracked due to loss (untracked potential energy due to mergers and body energy for escaped bodies) - integer(I4B) :: Euntracked_varid !! ID for the energy that is untracked due to loss (untracked potential energy due to mergers and body energy for escaped bodies) - character(NAMELEN) :: GMescape_varname = "GMescape" !! name of the G*Mass of bodies that escape the system - integer(I4B) :: GMescape_varid !! ID for the G*Mass of bodies that escape the system - character(NAMELEN) :: origin_type_varname = "origin_type" !! name of the origin type variable (Initial Conditions, Disruption, etc.) - integer(I4B) :: origin_type_varid !! ID for the origin type - character(NAMELEN) :: origin_time_varname = "origin_time" !! name of the time of origin variable - integer(I4B) :: origin_time_varid !! ID for the origin time - character(NAMELEN) :: collision_id_varname = "collision_id" !! name of the collision id variable - integer(I4B) :: collision_id_varid !! Netcdf ID for the origin collision ID - character(NAMELEN) :: origin_rh_varname = "origin_rh" !! name of the heliocentric position vector of the body at the time of origin variable - integer(I4B) :: origin_rh_varid !! ID for the origin position vector variable - character(NAMELEN) :: origin_vh_varname = "origin_vh" !! name of the heliocentric velocity vector of the body at the time of origin variable - integer(I4B) :: origin_vh_varid !! ID for the origin velocity vector component - character(NAMELEN) :: discard_time_varname = "discard_time" !! name of the time of discard variable - integer(I4B) :: discard_time_varid !! ID for the time of discard variable - character(NAMELEN) :: discard_rh_varname = "discard_rh" !! name of the heliocentric position vector of the body at the time of discard variable - integer(I4B) :: discard_rh_varid !! ID for the heliocentric position vector of the body at the time of discard variable - character(NAMELEN) :: discard_vh_varname = "discard_vh" !! name of the heliocentric velocity vector of the body at the time of discard variable - integer(I4B) :: discard_vh_varid !! ID for the heliocentric velocity vector of the body at the time of discard variable - character(NAMELEN) :: discard_body_id_varname = "discard_body_id" !! name of the id of the other body involved in the discard - end type netcdf_variables - - type, extends(netcdf_variables) :: netcdf_parameters - contains - procedure :: close => netcdf_close !! Closes an open NetCDF file - procedure :: flush => netcdf_flush !! Flushes the current buffer to disk by closing and re-opening the file. - procedure :: initialize => netcdf_initialize_output !! Initialize a set of parameters used to identify a NetCDF output object - procedure :: open => netcdf_open !! Opens a NetCDF file - procedure :: sync => netcdf_sync !! Syncrhonize the disk and memory buffer of the NetCDF file (e.g. commit the frame files stored in memory to disk) - end type netcdf_parameters - - type swiftest_storage_frame - class(*), allocatable :: item - contains - 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 - final :: util_final_storage_frame - end type - - type :: swiftest_storage(nframes) - !! An class that establishes the pattern for various storage objects - integer(I4B), len :: nframes = 4096 !! Total number of frames that can be stored - type(swiftest_storage_frame), dimension(nframes) :: frame !! Array of stored frames - integer(I4B) :: iframe = 0 !! Index of the last frame stored in the system - integer(I4B) :: nid !! Number of unique id values in all saved snapshots - integer(I4B), dimension(:), allocatable :: idvals !! The set of unique id values contained in the snapshots - integer(I4B), dimension(:), allocatable :: idmap !! The id value -> index map - integer(I4B) :: nt !! Number of unique time values in all saved snapshots - real(DP), dimension(:), allocatable :: tvals !! The set of unique time values contained in the snapshots - integer(I4B), dimension(:), allocatable :: tmap !! The t value -> index map - class(netcdf_parameters), allocatable :: nc !! NetCDF object attached to this storage object - contains - procedure :: dump => io_dump_storage !! Dumps storage object contents to file - procedure :: get_index_values => util_get_vals_storage !! Gets the unique values of the indices of a storage object (i.e. body id or time value) - procedure :: make_index_map => util_index_map_storage !! Maps body id values to storage index values so we don't have to use unlimited dimensions for id - procedure :: reset => util_reset_storage !! Resets a storage object by deallocating all items and resetting the frame counter to 0 - procedure :: take_snapshot => util_snapshot_system !! Takes a snapshot of the system for later file storage - final :: util_final_storage - end type swiftest_storage - - !******************************************************************************************************************************** - ! swiftest_parameters class definitions - !******************************************************************************************************************************** - - !> User defined parameters that are read in from the parameters input file. - !> Each paramter is initialized to a default values. - type :: swiftest_parameters - character(len=:), allocatable :: integrator !! Symbolic name of the nbody integrator used - character(len=:), allocatable :: param_file_name !! The name of the parameter file - integer(I4B) :: maxid = -1 !! The current maximum particle id number - integer(I4B) :: maxid_collision = 0 !! The current maximum collision id number - real(DP) :: t0 = 0.0_DP !! Integration reference time - real(DP) :: tstart = -1.0_DP !! Integration start time - real(DP) :: tstop = -1.0_DP !! Integration stop time - real(DP) :: dt = -1.0_DP !! Time step - integer(I8B) :: iloop = 0_I8B !! Main loop counter - integer(I4B) :: ioutput = 1 !! Output counter - character(STRMAX) :: incbfile = CB_INFILE !! Name of input file for the central body - character(STRMAX) :: inplfile = PL_INFILE !! Name of input file for massive bodies - character(STRMAX) :: intpfile = TP_INFILE !! Name of input file for test particles - character(STRMAX) :: in_netcdf = NC_INFILE !! Name of system input file for NetCDF input - character(STRMAX) :: in_type = "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 = BIN_OUTFILE !! Name of output binary file - character(STRMAX) :: out_type = "NETCDF_DOUBLE" !! Binary format of output file - character(STRMAX) :: out_form = "XVEL" !! Data to write to output file - character(STRMAX) :: out_stat = 'NEW' !! Open status for output binary file - integer(I4B) :: dump_cadence = 10 !! Number of output steps between dumping simulation data to file - real(DP) :: rmin = -1.0_DP !! Minimum heliocentric radius for test particle - real(DP) :: rmax = -1.0_DP !! Maximum heliocentric radius for test particle - real(DP) :: rmaxu = -1.0_DP !! Maximum unbound heliocentric radius for test particle - real(DP) :: qmin = -1.0_DP !! Minimum pericenter distance for test particle - character(STRMAX) :: qmin_coord = 'HELIO' !! Coordinate frame to use for qmin - real(DP) :: qmin_alo = -1.0_DP !! Minimum semimajor axis for qmin - real(DP) :: qmin_ahi = -1.0_DP !! Maximum semimajor axis for qmin - real(QP) :: MU2KG = -1.0_QP !! Converts mass units to grams - real(QP) :: TU2S = -1.0_QP !! Converts time units to seconds - real(QP) :: DU2M = -1.0_QP !! Converts distance unit to centimeters - real(DP) :: GU = -1.0_DP !! Universal gravitational constant in the system units - real(DP) :: inv_c2 = -1.0_DP !! Inverse speed of light squared in the system units - character(NAMELEN) :: interaction_loops = "ADAPTIVE" !! Method used to compute interaction loops. Options are "TRIANGULAR", "FLAT", or "ADAPTIVE" - character(NAMELEN) :: encounter_check_plpl = "ADAPTIVE" !! Method used to compute pl-pl encounter checks. Options are "TRIANGULAR", "SORTSWEEP", or "ADAPTIVE" - character(NAMELEN) :: encounter_check_pltp = "ADAPTIVE" !! Method used to compute pl-tp encounter checks. Options are "TRIANGULAR", "SORTSWEEP", or "ADAPTIVE" - - ! The following are used internally, and are not set by the user, but instead are determined by the input value of INTERACTION_LOOPS - logical :: lflatten_interactions = .false. !! Use the flattened upper triangular matrix for pl-pl interaction loops - logical :: ladaptive_interactions = .false. !! Adaptive interaction loop is turned on (choose between TRIANGULAR and FLAT based on periodic timing tests) - logical :: lencounter_sas_plpl = .false. !! Use the Sort and Sweep algorithm to prune the encounter list before checking for close encounters - logical :: lencounter_sas_pltp = .false. !! Use the Sort and Sweep algorithm to prune the encounter list before checking for close encounters - logical :: ladaptive_encounters_plpl = .false. !! Adaptive encounter checking is turned on (choose between TRIANGULAR or SORTSWEEP based on periodic timing tests) - logical :: ladaptive_encounters_pltp = .false. !! Adaptive encounter checking is turned on (choose between TRIANGULAR or SORTSWEEP based on periodic timing tests) - - ! Logical flags to turn on or off various features of the code - logical :: lrhill_present = .false. !! Hill radii are given as an input rather than calculated by the code (can be used to inflate close encounter regions manually) - logical :: lextra_force = .false. !! User defined force function turned on - logical :: lbig_discard = .false. !! Save big bodies on every discard - logical :: lclose = .false. !! Turn on close encounters - logical :: lenergy = .false. !! Track the total energy of the system - logical :: loblatecb = .false. !! Calculate acceleration from oblate central body (automatically turns true if nonzero J2 is input) - logical :: lrotation = .false. !! Include rotation states of big bodies - logical :: ltides = .false. !! Include tidal dissipation - - ! Initial values to pass to the energy report subroutine (usually only used in the case of a restart, otherwise these will be updated with initial conditions values) - real(DP) :: Eorbit_orig = 0.0_DP !! Initial orbital energy - real(DP) :: GMtot_orig = 0.0_DP !! Initial system mass - real(DP), dimension(NDIM) :: Ltot_orig = 0.0_DP !! Initial total angular momentum vector - real(DP), dimension(NDIM) :: Lorbit_orig = 0.0_DP !! Initial orbital angular momentum - real(DP), dimension(NDIM) :: Lspin_orig = 0.0_DP !! Initial spin angular momentum vector - real(DP), dimension(NDIM) :: Lescape = 0.0_DP !! Angular momentum of bodies that escaped the system (used for bookeeping) - real(DP) :: GMescape = 0.0_DP !! Mass of bodies that escaped the system (used for bookeeping) - real(DP) :: Ecollisions = 0.0_DP !! Energy lost from system due to collisions - real(DP) :: Euntracked = 0.0_DP !! Energy gained from system due to escaped bodies - logical :: lfirstenergy = .true. !! This is the first time computing energe - logical :: lfirstkick = .true. !! Initiate the first kick in a symplectic step - logical :: lrestart = .false. !! Indicates whether or not this is a restarted run - - character(len=:), allocatable :: display_style !! Style of the output display {"STANDARD", "COMPACT"}). Default is "STANDARD" - integer(I4B) :: display_unit !! File unit number for display (either to stdout or to a log file) - logical :: log_output = .false. !! Logs the output to file instead of displaying it on the terminal - - ! Future features not implemented or in development - logical :: lgr = .false. !! Turn on GR - logical :: lyarkovsky = .false. !! Turn on Yarkovsky effect - logical :: lyorp = .false. !! Turn on YORP effect - type(swiftest_storage(nframes=:)), allocatable :: system_history - contains - procedure :: reader => io_param_reader - procedure :: writer => io_param_writer - procedure :: dump => io_dump_param - procedure :: read_in => io_read_in_param - procedure :: set_display => io_set_display_param - end type swiftest_parameters - - - !******************************************************************************************************************************** - ! swiftest_swiftest_particle_info class definitions and method interfaces - !******************************************************************************************************************************* - !> Class definition for the particle origin information object. This object is used to track time, location, and collisional regime - !> of fragments produced in collisional events. - type :: swiftest_particle_info - character(len=NAMELEN) :: name !! Non-unique name - character(len=NAMELEN) :: particle_type !! String containing a description of the particle type (e.g. Central Body, Massive Body, Test Particle) - character(len=NAMELEN) :: origin_type !! String containing a description of the origin of the particle (e.g. Initial Conditions, Supercatastrophic, Disruption, etc.) - real(DP) :: origin_time !! The time of the particle's formation - integer(I4B) :: collision_id !! The ID of the collision that formed the particle - real(DP), dimension(NDIM) :: origin_rh !! The heliocentric distance vector at the time of the particle's formation - real(DP), dimension(NDIM) :: origin_vh !! The heliocentric velocity vector at the time of the particle's formation - real(DP) :: discard_time !! The time of the particle's discard - character(len=NAMELEN) :: status !! Particle status description: Active, Merged, Fragmented, etc. - real(DP), dimension(NDIM) :: discard_rh !! The heliocentric distance vector at the time of the particle's discard - real(DP), dimension(NDIM) :: discard_vh !! The heliocentric velocity vector at the time of the particle's discard - integer(I4B) :: discard_body_id !! The id of the other body involved in the discard (0 if no other body involved) - contains - procedure :: copy => util_copy_particle_info !! Copies one set of information object components into another, component-by-component - procedure :: set_value => util_set_particle_info !! Sets one or more values of the particle information metadata object - end type swiftest_particle_info - - !******************************************************************************************************************************** - ! swiftest_base class definitions and methods - !******************************************************************************************************************************** - type, abstract :: swiftest_base - !! An abstract superclass for a generic Swiftest object - contains - !! The minimal methods that all systems must have - procedure :: 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 - - !******************************************************************************************************************************** - ! swiftest_cb class definitions and methods - !******************************************************************************************************************************** - !> An abstract class for a generic central body in a Swiftest simulation - type, abstract, extends(swiftest_base) :: swiftest_cb - type(swiftest_particle_info) :: info !! Particle metadata information - integer(I4B) :: id = 0 !! External identifier (unique) - real(DP) :: mass = 0.0_DP !! Central body mass (units MU) - real(DP) :: Gmass = 0.0_DP !! Central mass gravitational term G * mass (units GU * MU) - real(DP) :: radius = 0.0_DP !! Central body radius (units DU) - real(DP) :: density = 1.0_DP !! Central body mass density - calculated internally (units MU / DU**3) - real(DP) :: j2rp2 = 0.0_DP !! J2*R^2 term for central body - real(DP) :: j4rp4 = 0.0_DP !! J4*R^2 term for central body - real(DP), dimension(NDIM) :: aobl = 0.0_DP !! Barycentric acceleration due to central body oblatenes - real(DP), dimension(NDIM) :: atide = 0.0_DP !! Barycentric acceleration due to central body oblatenes - real(DP), dimension(NDIM) :: aoblbeg = 0.0_DP !! Barycentric acceleration due to central body oblatenes at beginning of step - real(DP), dimension(NDIM) :: aoblend = 0.0_DP !! Barycentric acceleration due to central body oblatenes at end of step - real(DP), dimension(NDIM) :: atidebeg = 0.0_DP !! Barycentric acceleration due to central body oblatenes at beginning of step - real(DP), dimension(NDIM) :: atideend = 0.0_DP !! Barycentric acceleration due to central body oblatenes at end of step - real(DP), dimension(NDIM) :: rb = 0.0_DP !! Barycentric position (units DU) - real(DP), dimension(NDIM) :: vb = 0.0_DP !! Barycentric velocity (units DU / TU) - real(DP), dimension(NDIM) :: agr = 0.0_DP !! Acceleration due to post-Newtonian correction - real(DP), dimension(NDIM) :: Ip = 0.0_DP !! Unitless principal moments of inertia (I1, I2, I3) / (MR**2). Principal axis rotation assumed. - real(DP), dimension(NDIM) :: rot = 0.0_DP !! Body rotation vector in inertial coordinate frame (units rad / TU) - real(DP) :: k2 = 0.0_DP !! Tidal Love number - real(DP) :: Q = 0.0_DP !! Tidal quality factor - real(DP) :: tlag = 0.0_DP !! Tidal phase lag angle - real(DP), dimension(NDIM) :: L0 = 0.0_DP !! Initial angular momentum of the central body - real(DP), dimension(NDIM) :: dL = 0.0_DP !! Change in angular momentum of the central body - contains - end type swiftest_cb - - !******************************************************************************************************************************** - ! swiftest_body definitions and methods - !******************************************************************************************************************************** - !> An abstract class for a generic collection of Swiftest bodies - type, abstract, extends(swiftest_base) :: swiftest_body - !! Superclass that defines the generic elements of a Swiftest particle - logical :: lfirst = .true. !! Run the current step as a first - integer(I4B) :: nbody = 0 !! Number of bodies - type(swiftest_particle_info), dimension(:), allocatable :: info !! Particle metadata information - integer(I4B), dimension(:), allocatable :: id !! External identifier (unique) - integer(I4B), dimension(:), allocatable :: status !! An integrator-specific status indicator - logical, dimension(:), allocatable :: ldiscard !! Body should be discarded - logical, dimension(:), allocatable :: lmask !! Logical mask used to select a subset of bodies when performing certain operations (drift, kick, accel, etc.) - real(DP), dimension(:), allocatable :: mu !! G * (Mcb + [m]) - real(DP), dimension(:,:), allocatable :: rh !! Heliocentric position - real(DP), dimension(:,:), allocatable :: vh !! Heliocentric velocity - real(DP), dimension(:,:), allocatable :: rb !! Barycentric position - real(DP), dimension(:,:), allocatable :: vb !! Barycentric velocity - real(DP), dimension(:,:), allocatable :: ah !! Total heliocentric acceleration - real(DP), dimension(:,:), allocatable :: aobl !! Barycentric accelerations of bodies due to central body oblatenes - real(DP), dimension(:,:), allocatable :: atide !! Tanngential component of acceleration of bodies due to tides - real(DP), dimension(:,:), allocatable :: agr !! Acceleration due to post-Newtonian correction - real(DP), dimension(:), allocatable :: ir3h !! Inverse heliocentric radius term (1/rh**3) - real(DP), dimension(:), allocatable :: a !! Semimajor axis (pericentric distance for a parabolic orbit) - real(DP), dimension(:), allocatable :: e !! Eccentricity - real(DP), dimension(:), allocatable :: inc !! Inclination - real(DP), dimension(:), allocatable :: capom !! Longitude of ascending node - real(DP), dimension(:), allocatable :: omega !! Argument of pericenter - real(DP), dimension(:), allocatable :: capm !! Mean anomaly - !! Note to developers: If you add components to this class, be sure to update methods and subroutines that traverse the - !! component list, such as setup_body and util_spill - contains - procedure(abstract_discard_body), deferred :: discard - procedure(abstract_kick_body), deferred :: kick - procedure(abstract_set_mu), deferred :: set_mu - procedure(abstract_step_body), deferred :: step - procedure(abstract_accel), deferred :: accel - ! These are concrete because the implementation is the same for all types of particles - procedure :: drift => drift_body !! Loop through bodies and call Danby drift routine on heliocentric variables - procedure :: v2pv => gr_vh2pv_body !! Converts from velocity to psudeovelocity for GR calculations using symplectic integrators - procedure :: pv2v => gr_pv2vh_body !! Converts from psudeovelocity to velocity for GR calculations using symplectic integrators - procedure :: read_frame_bin => io_read_frame_body !! I/O routine for writing out a single frame of time-series data for the central body - procedure :: accel_obl => obl_acc_body !! Compute the barycentric accelerations of bodies due to the oblateness of the central body - procedure :: el2xv => orbel_el2xv_vec !! Convert orbital elements to position and velocity vectors - procedure :: xv2el => orbel_xv2el_vec !! Convert position and velocity vectors to orbital elements - procedure :: setup => setup_body !! A constructor that sets the number of bodies and allocates all allocatable arrays - procedure :: accel_user => user_kick_getacch_body !! Add user-supplied heliocentric accelerations to planets - procedure :: append => util_append_body !! Appends elements from one structure to another - procedure :: dealloc => util_dealloc_body !! Deallocates all allocatable arrays - procedure :: fill => util_fill_body !! "Fills" bodies from one object into another depending on the results of a mask (uses the UNPACK intrinsic) - procedure :: resize => util_resize_body !! Checks the current size of a Swiftest body against the requested size and resizes it if it is too small. - procedure :: set_ir3 => util_set_ir3h !! Sets the inverse heliocentric radius term (1/rh**3) - procedure :: sort => util_sort_body !! Sorts body arrays by a sortable componen - procedure :: rearrange => util_sort_rearrange_body !! Rearranges the order of array elements of body based on an input index array. Used in sorting methods - procedure :: spill => util_spill_body !! "Spills" bodies from one object to another depending on the results of a mask (uses the PACK intrinsic) - generic :: read_frame => read_frame_bin !! Add the generic read frame for Fortran binary files - end type swiftest_body - - !******************************************************************************************************************************** - ! swiftest_pl definitions and methods - !******************************************************************************************************************************** - !> An abstract class for a generic collection of Swiftest massive bodies - type, abstract, extends(swiftest_body) :: swiftest_pl - !! Superclass that defines the generic elements of a Swiftest particle - real(DP), dimension(:), allocatable :: mass !! Body mass (units MU) - real(DP), dimension(:), allocatable :: Gmass !! Mass gravitational term G * mass (units GU * MU) - real(DP), dimension(:), allocatable :: rhill !! Body mass (units MU) - real(DP), dimension(:), allocatable :: renc !! Critical radius for close encounters - real(DP), dimension(:), allocatable :: radius !! Body radius (units DU) - real(DP), dimension(:,:), allocatable :: rbeg !! Position at beginning of step - real(DP), dimension(:,:), allocatable :: xend !! Position at end of step - real(DP), dimension(:,:), allocatable :: vbeg !! Velocity at beginning of step - real(DP), dimension(:), allocatable :: density !! Body mass density - calculated internally (units MU / DU**3) - real(DP), dimension(:,:), allocatable :: Ip !! Unitless principal moments of inertia (I1, I2, I3) / (MR**2). Principal axis rotation assumed. - real(DP), dimension(:,:), allocatable :: rot !! Body rotation vector in inertial coordinate frame (units rad / TU) - real(DP), dimension(:), allocatable :: k2 !! Tidal Love number - real(DP), dimension(:), allocatable :: Q !! Tidal quality factor - real(DP), dimension(:), allocatable :: tlag !! Tidal phase lag - integer(I4B), dimension(:,:), allocatable :: k_plpl !! Index array used to convert flattened the body-body comparison upper triangular matrix - integer(I8B) :: nplpl !! Number of body-body comparisons in the flattened upper triangular matrix - !! Note to developers: If you add components to this class, be sure to update methods and subroutines that traverse the - !! component list, such as setup_pl and util_spill_pl - contains - ! Massive body-specific concrete methods - ! These are concrete because they are the same implemenation for all integrators - procedure :: discard => discard_pl !! Placeholder method for discarding massive bodies - procedure :: flatten => util_flatten_eucl_plpl !! Sets up the (i, j) -> k indexing used for the single-loop blocking Euclidean distance matrix - procedure :: accel_int => kick_getacch_int_pl !! Compute direct cross (third) term heliocentric accelerations of massive bodies - procedure :: accel_obl => obl_acc_pl !! Compute the barycentric accelerations of bodies due to the oblateness of the central body - procedure :: setup => setup_pl !! A base constructor that sets the number of bodies and allocates and initializes all arrays - ! procedure :: accel_tides => tides_kick_getacch_pl !! Compute the accelerations of bodies due to tidal interactions with the central body - procedure :: append => util_append_pl !! Appends elements from one structure to another - procedure :: h2b => util_coord_h2b_pl !! Convert massive bodies from heliocentric to barycentric coordinates (position and velocity) - procedure :: b2h => util_coord_b2h_pl !! Convert massive bodies from barycentric to heliocentric coordinates (position and velocity) - procedure :: vh2vb => util_coord_vh2vb_pl !! Convert massive bodies from heliocentric to barycentric coordinates (velocity only) - procedure :: vb2vh => util_coord_vb2vh_pl !! Convert massive bodies from barycentric to heliocentric coordinates (velocity only) - procedure :: rh2rb => util_coord_rh2rb_pl !! Convert massive bodies from heliocentric to barycentric coordinates (position only) - procedure :: dealloc => util_dealloc_pl !! Deallocates all allocatable arrays - procedure :: fill => util_fill_pl !! "Fills" bodies from one object into another depending on the results of a mask (uses the UNPACK intrinsic) - procedure :: resize => util_resize_pl !! Checks the current size of a Swiftest body against the requested size and resizes it if it is too small. - procedure :: set_beg_end => util_set_beg_end_pl !! Sets the beginning and ending positions and velocities of planets. - procedure :: set_mu => util_set_mu_pl !! Method used to construct the vectorized form of the central body mass - procedure :: set_rhill => util_set_rhill !! Calculates the Hill's radii for each body - procedure :: set_renc_I4B => util_set_renc_I4B !! Sets the critical radius for encounter given an inpput integer scale factor - procedure :: set_renc_DP => util_set_renc_DP !! Sets the critical radius for encounter given an input real scale factor - generic :: set_renc => set_renc_I4B, set_renc_DP - procedure :: sort => util_sort_pl !! Sorts body arrays by a sortable component - procedure :: rearrange => util_sort_rearrange_pl !! Rearranges the order of array elements of body based on an input index array. Used in sorting methods - procedure :: spill => util_spill_pl !! "Spills" bodies from one object to another depending on the results of a mask (uses the PACK intrinsic) - end type swiftest_pl - - !******************************************************************************************************************************** - ! swiftest_tp definitions and methods - !******************************************************************************************************************************** - !> An abstract class for a generic collection of Swiftest test particles - type, abstract, extends(swiftest_body) :: swiftest_tp - !! Superclass that defines the generic elements of a Swiftest test particle - integer(I4B), dimension(:), allocatable :: isperi !! Perihelion passage flag - real(DP), dimension(:), allocatable :: peri !! Perihelion distance - real(DP), dimension(:), allocatable :: atp !! Semimajor axis following perihelion passage - integer(I4B), dimension(:,:), allocatable :: k_pltp !! Index array used to convert flattened the body-body comparison upper triangular matrix - integer(I8B) :: npltp !! Number of pl-tp comparisons in the flattened upper triangular matrix - !! Note to developers: If you add components to this class, be sure to update methods and subroutines that traverse the - !! component list, such as setup_tp and util_spill_tp - contains - ! Test particle-specific concrete methods - ! These are concrete because they are the same implemenation for all integrators - procedure :: discard => discard_tp !! Check to see if test particles should be discarded based on their positions relative to the massive bodies - procedure :: accel_int => kick_getacch_int_tp !! Compute direct cross (third) term heliocentric accelerations of test particles by massive bodies - procedure :: accel_obl => obl_acc_tp !! Compute the barycentric accelerations of bodies due to the oblateness of the central body - procedure :: setup => setup_tp !! A base constructor that sets the number of bodies and - procedure :: append => util_append_tp !! Appends elements from one structure to another - procedure :: h2b => util_coord_h2b_tp !! Convert test particles from heliocentric to barycentric coordinates (position and velocity) - procedure :: b2h => util_coord_b2h_tp !! Convert test particles from barycentric to heliocentric coordinates (position and velocity) - procedure :: vb2vh => util_coord_vb2vh_tp !! Convert test particles from barycentric to heliocentric coordinates (velocity only) - procedure :: vh2vb => util_coord_vh2vb_tp !! Convert test particles from heliocentric to barycentric coordinates (velocity only) - procedure :: rh2rb => util_coord_rh2rb_tp !! Convert test particles from heliocentric to barycentric coordinates (position only) - procedure :: dealloc => util_dealloc_tp !! Deallocates all allocatable arrays - procedure :: fill => util_fill_tp !! "Fills" bodies from one object into another depending on the results of a mask (uses the UNPACK intrinsic) - procedure :: get_peri => util_peri_tp !! Determine system pericenter passages for test particles - procedure :: resize => util_resize_tp !! Checks the current size of a Swiftest body against the requested size and resizes it if it is too small. - procedure :: set_mu => util_set_mu_tp !! Method used to construct the vectorized form of the central body mass - procedure :: sort => util_sort_tp !! Sorts body arrays by a sortable component - procedure :: rearrange => util_sort_rearrange_tp !! Rearranges the order of array elements of body based on an input index array. Used in sorting methods - procedure :: spill => util_spill_tp !! "Spills" bodies from one object to another depending on the results of a mask (uses the PACK intrinsic) - end type swiftest_tp - - !******************************************************************************************************************************** - ! swiftest_nbody_system class definitions and methods - !******************************************************************************************************************************** - !> An abstract class for a basic Swiftest nbody system - type, abstract :: swiftest_nbody_system - !! This superclass contains a minimial system of a set of test particles (tp), massive bodies (pl), and a central body (cb) - class(swiftest_cb), allocatable :: cb !! Central body data structure - class(swiftest_pl), allocatable :: pl !! Massive body data structure - class(swiftest_tp), allocatable :: tp !! Test particle data structure - class(swiftest_tp), allocatable :: tp_discards !! Discarded test particle data structure - class(swiftest_pl), allocatable :: pl_discards !! Discarded massive body particle data structure - real(DP) :: t = -1.0_DP !! Integration current time - real(DP) :: GMtot = 0.0_DP !! Total system mass - used for barycentric coordinate conversion - real(DP) :: ke_orbit = 0.0_DP !! System orbital kinetic energy - real(DP) :: ke_spin = 0.0_DP !! System spin kinetic energy - real(DP) :: pe = 0.0_DP !! System potential energy - real(DP) :: te = 0.0_DP !! System total energy - real(DP) :: oblpot = 0.0_DP !! System potential energy due to oblateness of the central body - real(DP), dimension(NDIM) :: Lorbit = 0.0_DP !! System orbital angular momentum vector - real(DP), dimension(NDIM) :: Lspin = 0.0_DP !! System spin angular momentum vector - real(DP), dimension(NDIM) :: Ltot = 0.0_DP !! System angular momentum vector - real(DP) :: ke_orbit_orig = 0.0_DP !! Initial orbital kinetic energy - real(DP) :: ke_spin_orig = 0.0_DP !! Initial spin kinetic energy - real(DP) :: pe_orig = 0.0_DP !! Initial potential energy - real(DP) :: Eorbit_orig = 0.0_DP !! Initial orbital energy - real(DP) :: GMtot_orig = 0.0_DP !! Initial system mass - real(DP), dimension(NDIM) :: Ltot_orig = 0.0_DP !! Initial total angular momentum vector - real(DP), dimension(NDIM) :: Lorbit_orig = 0.0_DP !! Initial orbital angular momentum - real(DP), dimension(NDIM) :: Lspin_orig = 0.0_DP !! Initial spin angular momentum vector - real(DP), dimension(NDIM) :: Lescape = 0.0_DP !! Angular momentum of bodies that escaped the system (used for bookeeping) - real(DP) :: GMescape = 0.0_DP !! Mass of bodies that escaped the system (used for bookeeping) - real(DP) :: Ecollisions = 0.0_DP !! Energy lost from system due to collisions - real(DP) :: Euntracked = 0.0_DP !! Energy gained from system due to escaped bodies - - ! Energy, momentum, and mass errors (used in error reporting) - real(DP) :: ke_orbit_error = 0.0_DP - real(DP) :: ke_spin_error = 0.0_DP - real(DP) :: pe_error = 0.0_DP - real(DP) :: Eorbit_error = 0.0_DP - real(DP) :: Ecoll_error = 0.0_DP - real(DP) :: Euntracked_error = 0.0_DP - real(DP) :: Etot_error = 0.0_DP - real(DP) :: Lorbit_error = 0.0_DP - real(DP) :: Lspin_error = 0.0_DP - real(DP) :: Lescape_error = 0.0_DP - real(DP) :: Ltot_error = 0.0_DP - real(DP) :: Mtot_error = 0.0_DP - real(DP) :: Mescape_error = 0.0_DP - - logical :: lbeg !! True if this is the beginning of a step. This is used so that test particle steps can be calculated - !! separately from massive bodies. Massive body variables are saved at half steps, and passed to - !! the test particles - contains - !> Each integrator will have its own version of the step - procedure(abstract_step_system), deferred :: step - - ! Concrete classes that are common to the basic integrator (only test particles considered for discard) - procedure :: discard => discard_system !! Perform a discard step on the system - procedure :: compact_output => io_compact_output !! Prints out out terminal output when display_style is set to COMPACT - procedure :: conservation_report => io_conservation_report !! Compute energy and momentum and print out the change with time - procedure :: dump => io_dump_system !! Dump the state of the system to a file - procedure :: get_old_t_final => netcdf_get_old_t_final_system !! Validates the dump file to check whether the dump file initial conditions duplicate the last frame of the netcdf output. - procedure :: read_frame => netcdf_read_frame_system !! Read in a frame of input data from file - procedure :: write_frame_netcdf => netcdf_write_frame_system !! Write a frame of input data from file - procedure :: write_frame_system => io_write_frame_system !! Write a frame of input data from file - procedure :: read_hdr => netcdf_read_hdr_system !! Read a header for an output frame in NetCDF format - procedure :: write_hdr => netcdf_write_hdr_system !! Write a header for an output frame in NetCDF format - procedure :: read_in => io_read_in_system !! Reads the initial conditions for an nbody system - procedure :: read_particle_info => netcdf_read_particle_info_system !! Read in particle metadata from file - procedure :: obl_pot => obl_pot_system !! Compute the contribution to the total gravitational potential due solely to the oblateness of the central body - procedure :: initialize => setup_initialize_system !! Initialize the system from input files - procedure :: init_particle_info => setup_initialize_particle_info_system !! Initialize the system from input files - ! procedure :: step_spin => tides_step_spin_system !! Steps the spins of the massive & central bodies due to tides. - procedure :: set_msys => util_set_msys !! Sets the value of msys from the masses of system bodies. - procedure :: get_energy_and_momentum => util_get_energy_momentum_system !! Calculates the total system energy and momentum - procedure :: get_idvals => util_get_idvalues_system !! Returns an array of all id values in use in the system - procedure :: rescale => util_rescale_system !! Rescales the system into a new set of units - procedure :: validate_ids => util_valid_id_system !! Validate the numerical ids passed to the system and save the maximum value - generic :: write_frame => write_frame_system, write_frame_netcdf !! Generic method call for reading a frame of output data - end type swiftest_nbody_system - - - abstract interface - subroutine abstract_accel(self, system, param, t, lbeg) - import swiftest_body, swiftest_nbody_system, swiftest_parameters, DP - class(swiftest_body), intent(inout) :: self !! Swiftest body data structure - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - real(DP), intent(in) :: t !! Current simulation time - logical, intent(in) :: lbeg !! Optional argument that determines whether or not this is the beginning or end of the step - end subroutine abstract_accel - - subroutine abstract_discard_body(self, system, param) - import swiftest_body, swiftest_nbody_system, swiftest_parameters - class(swiftest_body), intent(inout) :: self !! Swiftest body object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - end subroutine abstract_discard_body - - subroutine abstract_kick_body(self, system, param, t, dt, lbeg) - import swiftest_body, swiftest_nbody_system, swiftest_parameters, DP - implicit none - class(swiftest_body), intent(inout) :: self !! Swiftest generic body object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system objec - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - real(DP), intent(in) :: t !! Current time - real(DP), intent(in) :: dt !! Stepsize - logical, intent(in) :: lbeg !! Logical flag indicating whether this is the beginning of the half step or not. - end subroutine abstract_kick_body - - subroutine abstract_set_mu(self, cb) - import swiftest_body, swiftest_cb - class(swiftest_body), intent(inout) :: self !! Swiftest body object - class(swiftest_cb), intent(inout) :: cb !! Swiftest central body object - end subroutine abstract_set_mu - - subroutine abstract_step_body(self, system, param, t, dt) - import DP, swiftest_body, swiftest_nbody_system, swiftest_parameters - implicit none - class(swiftest_body), intent(inout) :: self !! Swiftest body object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest system object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - real(DP), intent(in) :: t !! Simulation time - real(DP), intent(in) :: dt !! Current stepsize - end subroutine abstract_step_body - - subroutine abstract_step_system(self, param, t, dt) - import DP, swiftest_nbody_system, swiftest_parameters - implicit none - class(swiftest_nbody_system), intent(inout) :: self !! Swiftest system object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - real(DP), intent(in) :: t !! Simulation time - real(DP), intent(in) :: dt !! Current stepsize - end subroutine abstract_step_system - end interface - - interface - module subroutine 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 - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameter - end subroutine discard_pl - - module subroutine discard_system(self, param) - implicit none - class(swiftest_nbody_system), intent(inout) :: self !! Swiftest system object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - end subroutine discard_system - - module subroutine discard_tp(self, system, param) - implicit none - class(swiftest_tp), intent(inout) :: self !! Swiftest test particle object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - end subroutine discard_tp - - module subroutine drift_all(mu, x, v, n, param, dt, lmask, iflag) - implicit none - real(DP), dimension(:), intent(in) :: mu !! Vector of gravitational constants - real(DP), dimension(:,:), intent(inout) :: x, v !! Position and velocity vectors - integer(I4B), intent(in) :: n !! number of bodies - class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters - real(DP), intent(in) :: dt !! Stepsize - logical, dimension(:), intent(in) :: lmask !! Logical mask of size self%nbody that determines which bodies to drift. - integer(I4B), dimension(:), intent(out) :: iflag !! Vector of error flags. 0 means no problem - end subroutine drift_all - - module subroutine drift_body(self, system, param, dt) - implicit none - class(swiftest_body), intent(inout) :: self !! Swiftest particle data structure - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object - class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters - real(DP), intent(in) :: dt !! Stepsize - end subroutine drift_body - - pure elemental module subroutine drift_one(mu, px, py, pz, vx, vy, vz, dt, iflag) - !$omp declare simd(drift_one) - implicit none - real(DP), intent(in) :: mu !! G * (Mcb + m), G = gravitational constant, Mcb = mass of central body, m = mass of body to drift - real(DP), intent(inout) :: px, py, pz, vx, vy, vz !! Position and velocity of body to drift - real(DP), intent(in) :: dt !! Step size - integer(I4B), intent(out) :: iflag !! iflag : error status flag for Danby drift (0 = OK, nonzero = ERROR) - end subroutine drift_one - - pure module subroutine gr_kick_getaccb_ns_body(self, system, param) - implicit none - class(swiftest_body), intent(inout) :: self !! Swiftest generic body object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object - class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters - end subroutine gr_kick_getaccb_ns_body - - pure module subroutine gr_kick_getacch(mu, x, lmask, n, inv_c2, agr) - implicit none - real(DP), dimension(:), intent(in) :: mu !! Gravitational constant - real(DP), dimension(:,:), intent(in) :: x !! Position vectors - logical, dimension(:), intent(in) :: lmask !! Logical mask indicating which bodies to compute - integer(I4B), intent(in) :: n !! Total number of bodies - real(DP), intent(in) :: inv_c2 !! Inverse speed of light squared: 1 / c**2 - real(DP), dimension(:,:), intent(out) :: agr !! Accelerations - end subroutine gr_kick_getacch - - pure module subroutine gr_p4_pos_kick(param, x, v, dt) - implicit none - class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters - real(DP), dimension(:), intent(inout) :: x !! Position vector - real(DP), dimension(:), intent(in) :: v !! Velocity vector - real(DP), intent(in) :: dt !! Step size - end subroutine gr_p4_pos_kick - - pure module subroutine gr_pseudovel2vel(param, mu, rh, pv, vh) - implicit none - class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters - real(DP), intent(in) :: mu !! G * (Mcb + m), G = gravitational constant, Mcb = mass of central body, m = mass of body - real(DP), dimension(:), intent(in) :: rh !! Swiftestcentric position vector - real(DP), dimension(:), intent(in) :: pv !! Pseudovelocity velocity vector - see Saha & Tremain (1994), eq. (32) - real(DP), dimension(:), intent(out) :: vh !! Swiftestcentric velocity vector - end subroutine gr_pseudovel2vel - - pure module subroutine gr_pv2vh_body(self, param) - implicit none - class(swiftest_body), intent(inout) :: self !! Swiftest particle object - class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters - end subroutine gr_pv2vh_body - - pure module subroutine gr_vel2pseudovel(param, mu, rh, vh, pv) - implicit none - class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters - real(DP), intent(in) :: mu !! G * (Mcb + m), G = gravitational constant, Mcb = mass of central body, m = mass of body - real(DP), dimension(:), intent(in) :: rh !! Swiftestcentric position vector - real(DP), dimension(:), intent(in) :: vh !! Swiftestcentric velocity vector - real(DP), dimension(:), intent(out) :: pv !! Pseudovelocity vector - see Saha & Tremain (1994), eq. (32) - end subroutine gr_vel2pseudovel - - pure module subroutine gr_vh2pv_body(self, param) - implicit none - class(swiftest_body), intent(inout) :: self !! Swiftest particle object - class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters - end subroutine gr_vh2pv_body - - module subroutine io_compact_output(self, param, timer) - implicit none - class(swiftest_nbody_system), intent(in) :: self !! Swiftest nbody system object - class(swiftest_parameters), intent(in) :: param !! Input colleciton of user-defined parameters - class(*), intent(in) :: timer !! Object used for computing elapsed wall time - end subroutine io_compact_output - - module subroutine io_conservation_report(self, param, lterminal) - implicit none - class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nbody system object - class(swiftest_parameters), intent(inout) :: param !! Input colleciton of user-defined parameters - logical, intent(in) :: lterminal !! Indicates whether to output information to the terminal screen - end subroutine io_conservation_report - - module subroutine io_dump_param(self, param_file_name) - implicit none - class(swiftest_parameters),intent(in) :: self !! Output collection of parameters - character(len=*), intent(in) :: param_file_name !! Parameter input file name (i.e. param.in) - end subroutine io_dump_param - - module subroutine io_dump_system(self, param) - implicit none - class(swiftest_nbody_system), intent(inout) :: self !! Swiftest system object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - end subroutine io_dump_system - - module 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_storage - - module subroutine io_get_args(integrator, param_file_name, display_style) - implicit none - character(len=:), allocatable, intent(inout) :: integrator !! Symbolic code of the requested integrator - character(len=:), allocatable, intent(inout) :: param_file_name !! Name of the input parameters file - character(len=:), allocatable, intent(inout) :: display_style !! Style of the output display {"STANDARD", "COMPACT"}). Default is "STANDARD" - end subroutine io_get_args - - module function io_get_token(buffer, ifirst, ilast, ierr) result(token) - implicit none - character(len=*), intent(in) :: buffer !! Input string buffer - integer(I4B), intent(inout) :: ifirst !! Index of the buffer at which to start the search for a token - integer(I4B), intent(out) :: ilast !! Index of the buffer at the end of the returned token - integer(I4B), intent(out) :: ierr !! Error code - character(len=:), allocatable :: token !! Returned token string - end function io_get_token - - module subroutine io_log_one_message(file, message) - implicit none - character(len=*), intent(in) :: file !! Name of file to log - character(len=*), intent(in) :: message - end subroutine io_log_one_message - - module subroutine io_log_start(param, file, header) - implicit none - class(swiftest_parameters), intent(in) :: param !! Current Swiftest run configuration parameters - character(len=*), intent(in) :: file !! Name of file to log - character(len=*), intent(in) :: header !! Header to print at top of log file - end subroutine io_log_start - - module subroutine io_param_reader(self, unit, iotype, v_list, iostat, iomsg) - implicit none - class(swiftest_parameters), intent(inout) :: self !! Collection of parameters - integer(I4B), intent(in) :: unit !! File unit number - character(len=*), intent(in) :: iotype !! Dummy argument passed to the input/output procedure contains the text from the char-literal-constant, prefixed with DT. - !! If you do not include a char-literal-constant, the iotype argument contains only DT. - character(len=*), intent(in) :: v_list(:) !! The first element passes the integrator code to the reader - integer(I4B), intent(out) :: iostat !! IO status code - character(len=*), intent(inout) :: iomsg !! Message to pass if iostat /= 0 - end subroutine io_param_reader - - module subroutine io_param_writer(self, unit, iotype, v_list, iostat, iomsg) - implicit none - class(swiftest_parameters), intent(in) :: self !! Collection of parameters - integer(I4B), intent(in) :: unit !! File unit number - character(len=*), intent(in) :: iotype !! Dummy argument passed to the input/output procedure contains the text from the char-literal-constant, prefixed with DT. - !! If you do not include a char-literal-constant, the iotype argument contains only DT. - integer(I4B), intent(in) :: v_list(:) !! Not used in this procedure - integer(I4B), intent(out) :: iostat !! IO status code - character(len=*), intent(inout) :: iomsg !! Message to pass if iostat /= 0 - end subroutine io_param_writer - end interface - - interface io_param_writer_one - module subroutine io_param_writer_one_char(param_name, param_value, unit) - implicit none - character(len=*), intent(in) :: param_name !! Name of parameter to print - character(len=*), intent(in) :: param_value !! Value of parameter to print - integer(I4B), intent(in) :: unit !! Open file unit number to print parameter to - end subroutine io_param_writer_one_char - - module subroutine io_param_writer_one_DP(param_name, param_value, unit) - implicit none - character(len=*), intent(in) :: param_name !! Name of parameter to print - real(DP), intent(in) :: param_value !! Value of parameter to print - integer(I4B), intent(in) :: unit !! Open file unit number to print parameter to - end subroutine io_param_writer_one_DP - - module subroutine io_param_writer_one_DParr(param_name, param_value, unit) - implicit none - character(len=*), intent(in) :: param_name !! Name of parameter to print - real(DP), dimension(:), intent(in) :: param_value !! Value of parameter to print - integer(I4B), intent(in) :: unit !! Open file unit number to print parameter to - end subroutine io_param_writer_one_DParr - - module subroutine io_param_writer_one_I4B(param_name, param_value, unit) - implicit none - character(len=*), intent(in) :: param_name !! Name of parameter to print - integer(I4B), intent(in) :: param_value !! Value of parameter to print - integer(I4B), intent(in) :: unit !! Open file unit number to print parameter to - end subroutine io_param_writer_one_I4B - - module subroutine io_param_writer_one_I4Barr(param_name, param_value, unit) - implicit none - character(len=*), intent(in) :: param_name !! Name of parameter to print - integer(I4B), dimension(:), intent(in) :: param_value !! Value of parameter to print - integer(I4B), intent(in) :: unit !! Open file unit number to print parameter to - end subroutine io_param_writer_one_I4Barr - - module subroutine io_param_writer_one_I8B(param_name, param_value, unit) - implicit none - character(len=*), intent(in) :: param_name !! Name of parameter to print - integer(I8B), intent(in) :: param_value !! Value of parameter to print - integer(I4B), intent(in) :: unit !! Open file unit number to print parameter to - end subroutine io_param_writer_one_I8B - - module subroutine io_param_writer_one_logical(param_name, param_value, unit) - implicit none - character(len=*), intent(in) :: param_name !! Name of parameter to print - logical, intent(in) :: param_value !! Value of parameter to print - integer(I4B), intent(in) :: unit !! Open file unit number to print parameter to - end subroutine io_param_writer_one_logical - - module subroutine io_param_writer_one_QP(param_name, param_value, unit) - implicit none - character(len=*), intent(in) :: param_name !! Name of parameter to print - real(QP), intent(in) :: param_value !! Value of parameter to print - integer(I4B), intent(in) :: unit !! Open file unit number to print parameter to - end subroutine io_param_writer_one_QP - end interface io_param_writer_one - - interface - - module subroutine io_read_in_base(self,param) - implicit none - class(swiftest_base), intent(inout) :: self !! Swiftest base object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - end subroutine io_read_in_base - - module subroutine io_read_in_param(self, param_file_name) - implicit none - class(swiftest_parameters), intent(inout) :: self !! Current run configuration parameters - character(len=*), intent(in) :: param_file_name !! Parameter input file name (i.e. param.in) - end subroutine io_read_in_param - - module subroutine io_read_in_system(self, param) - implicit none - class(swiftest_nbody_system), intent(inout) :: self - class(swiftest_parameters), intent(inout) :: param - end subroutine io_read_in_system - - module function io_read_frame_body(self, iu, param) result(ierr) - implicit none - class(swiftest_body), intent(inout) :: self !! Swiftest body object - integer(I4B), intent(inout) :: iu !! Unit number for the output file to write frame to - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - integer(I4B) :: ierr !! Error code: returns 0 if the read is successful - end function io_read_frame_body - - module function io_read_frame_system(self, iu, param) result(ierr) - implicit none - class(swiftest_nbody_system),intent(inout) :: self !! Swiftest system object - integer(I4B), intent(inout) :: iu !! Unit number for the output file to read frame from - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - integer(I4B) :: ierr !! Error code: returns 0 if the read is successful - end function io_read_frame_system - - module subroutine io_set_display_param(self, display_style) - implicit none - class(swiftest_parameters), intent(inout) :: self !! Current run configuration parameters - character(*), intent(in) :: display_style !! Style of the output display - end subroutine io_set_display_param - - module subroutine io_toupper(string) - implicit none - character(*), intent(inout) :: string !! String to make upper case - end subroutine io_toupper - - module subroutine io_write_frame_system(self, param) - implicit none - class(swiftest_nbody_system), intent(inout) :: self !! Swiftest system object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - end subroutine io_write_frame_system - - module subroutine kick_getacch_int_pl(self, param) - implicit none - class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object - class(swiftest_parameters), intent(inout) :: param !! Current swiftest run configuration parameters - end subroutine kick_getacch_int_pl - - module subroutine kick_getacch_int_tp(self, param, GMpl, rhp, npl) - implicit none - class(swiftest_tp), intent(inout) :: self !! Swiftest test particle object - class(swiftest_parameters), intent(inout) :: param !! Current swiftest run configuration parameters - real(DP), dimension(:), intent(in) :: GMpl !! Massive body masses - real(DP), dimension(:,:), intent(in) :: rhp !! Massive body position vectors - integer(I4B), intent(in) :: npl !! Number of active massive bodies - end subroutine kick_getacch_int_tp - - module subroutine kick_getacch_int_all_flat_pl(npl, nplpl, k_plpl, x, Gmass, radius, acc) - implicit none - integer(I4B), intent(in) :: npl !! Number of massive bodies - integer(I8B), intent(in) :: nplpl !! Number of massive body interactions to compute - integer(I4B), dimension(:,:), intent(in) :: k_plpl !! Array of interaction pair indices (flattened upper triangular matrix) - real(DP), dimension(:,:), intent(in) :: x !! Position vector array - real(DP), dimension(:), intent(in) :: Gmass !! Array of massive body G*mass - real(DP), dimension(:), intent(in), optional :: radius !! Array of massive body radii - real(DP), dimension(:,:), intent(inout) :: acc !! Acceleration vector array - end subroutine kick_getacch_int_all_flat_pl - - module subroutine kick_getacch_int_all_triangular_pl(npl, nplm, x, Gmass, radius, acc) - implicit none - integer(I4B), intent(in) :: npl !! Total number of massive bodies - integer(I4B), intent(in) :: nplm !! Number of fully interacting massive bodies - real(DP), dimension(:,:), intent(in) :: x !! Position vector array - real(DP), dimension(:), intent(in) :: Gmass !! Array of massive body G*mass - real(DP), dimension(:), intent(in), optional :: radius !! Array of massive body radii - real(DP), dimension(:,:), intent(inout) :: acc !! Acceleration vector array - end subroutine kick_getacch_int_all_triangular_pl - - module subroutine kick_getacch_int_all_tp(ntp, npl, xtp, xpl, GMpl, lmask, acc) - implicit none - integer(I4B), intent(in) :: ntp !! Number of test particles - integer(I4B), intent(in) :: npl !! Number of massive bodies - real(DP), dimension(:,:), intent(in) :: xtp !! Test particle position vector array - real(DP), dimension(:,:), intent(in) :: xpl !! Massive body particle position vector array - real(DP), dimension(:), intent(in) :: GMpl !! Array of massive body G*mass - logical, dimension(:), intent(in) :: lmask !! Logical mask indicating which test particles should be computed - real(DP), dimension(:,:), intent(inout) :: acc !! Acceleration vector array - end subroutine kick_getacch_int_all_tp - - pure module subroutine kick_getacch_int_one_pl(rji2, xr, yr, zr, Gmi, Gmj, axi, ayi, azi, axj, ayj, azj) - !$omp declare simd(kick_getacch_int_one_pl) - implicit none - real(DP), intent(in) :: rji2 !! Square of distance between the two bodies - real(DP), intent(in) :: xr, yr, zr !! Distances between the two bodies in x, y, and z directions - real(DP), intent(in) :: Gmi !! G*mass of body i - real(DP), intent(in) :: Gmj !! G*mass of body j - real(DP), intent(inout) :: axi, ayi, azi !! Acceleration vector components of body i - real(DP), intent(inout) :: axj, ayj, azj !! Acceleration vector components of body j - end subroutine kick_getacch_int_one_pl - - pure module subroutine kick_getacch_int_one_tp(rji2, xr, yr, zr, Gmpl, ax, ay, az) - !$omp declare simd(kick_getacch_int_one_tp) - implicit none - real(DP), intent(in) :: rji2 !! Square of distance between the test particle and massive body - real(DP), intent(in) :: xr, yr, zr !! Distances between the two bodies in x, y, and z directions - real(DP), intent(in) :: Gmpl !! G*mass of massive body - real(DP), intent(inout) :: ax, ay, az !! Acceleration vector components of test particle - end subroutine kick_getacch_int_one_tp - - module subroutine netcdf_close(self) - implicit none - class(netcdf_parameters), intent(inout) :: self !! Parameters used to identify a particular NetCDF dataset - end subroutine netcdf_close - - module subroutine netcdf_flush(self, param) - implicit none - class(netcdf_parameters), intent(inout) :: self !! Parameters used to identify a particular NetCDF dataset - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - end subroutine netcdf_flush - - module function netcdf_get_old_t_final_system(self, param) result(old_t_final) - implicit none - class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nbody system object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - real(DP) :: old_t_final !! Final time from last run - end function netcdf_get_old_t_final_system - - module subroutine netcdf_initialize_output(self, param) - implicit none - class(netcdf_parameters), intent(inout) :: self !! Parameters used to for writing a NetCDF dataset to file - class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters - end subroutine netcdf_initialize_output - - module subroutine netcdf_open(self, param, readonly) - implicit none - class(netcdf_parameters), intent(inout) :: self !! Parameters used to identify a particular NetCDF dataset - class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters - logical, optional, intent(in) :: readonly !! Logical flag indicating that this should be open read only - end subroutine netcdf_open - - module subroutine netcdf_sync(self) - implicit none - class(netcdf_parameters), intent(inout) :: self !! Parameters used to identify a particular NetCDF dataset - end subroutine netcdf_sync - - module function netcdf_read_frame_system(self, nc, param) result(ierr) - implicit none - class(swiftest_nbody_system), intent(inout) :: self !! Swiftest system object - class(netcdf_parameters), intent(inout) :: nc !! Parameters used to for reading a NetCDF dataset to file - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - integer(I4B) :: ierr !! Error code: returns 0 if the read is successful - end function netcdf_read_frame_system - - module subroutine netcdf_read_hdr_system(self, nc, param) - implicit none - class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nbody system object - class(netcdf_parameters), intent(inout) :: nc !! Parameters used to for reading a NetCDF dataset to file - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - end subroutine netcdf_read_hdr_system - - module subroutine netcdf_read_particle_info_system(self, nc, param, plmask, tpmask) - implicit none - class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nbody system object - class(netcdf_parameters), intent(inout) :: nc !! Parameters used to identify a particular NetCDF dataset - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - logical, dimension(:), intent(in) :: plmask !! Logical array indicating which index values belong to massive bodies - logical, dimension(:), intent(in) :: tpmask !! Logical array indicating which index values belong to test particles - end subroutine netcdf_read_particle_info_system - - module subroutine netcdf_write_frame_base(self, nc, param) - implicit none - class(swiftest_base), intent(in) :: self !! Swiftest base object - class(netcdf_parameters), intent(inout) :: nc !! Parameters used to for writing a NetCDF dataset to file - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - end subroutine netcdf_write_frame_base - - module subroutine netcdf_write_frame_system(self, nc, param) - implicit none - class(swiftest_nbody_system), intent(inout) :: self !! Swiftest system object - class(netcdf_parameters), intent(inout) :: nc !! Parameters used to for writing a NetCDF dataset to file - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - end subroutine netcdf_write_frame_system - - module subroutine netcdf_write_hdr_system(self, nc, param) - implicit none - class(swiftest_nbody_system), intent(in) :: self !! Swiftest nbody system object - class(netcdf_parameters), intent(inout) :: nc !! Parameters used to for writing a NetCDF dataset to file - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - end subroutine netcdf_write_hdr_system - - module subroutine netcdf_write_info_base(self, nc, param) - implicit none - class(swiftest_base), intent(in) :: self !! Swiftest particle object - class(netcdf_parameters), intent(inout) :: nc !! Parameters used to identify a particular NetCDF dataset - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - end subroutine netcdf_write_info_base - - module subroutine obl_acc_body(self, system) - implicit none - class(swiftest_body), intent(inout) :: self !! Swiftest body object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object - end subroutine obl_acc_body - - module subroutine obl_acc_pl(self, system) - implicit none - class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object - end subroutine obl_acc_pl - - module subroutine obl_acc_tp(self, system) - implicit none - class(swiftest_tp), intent(inout) :: self !! Swiftest test particle object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object - end subroutine obl_acc_tp - - module subroutine obl_pot_system(self) - implicit none - class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nbody system object - end subroutine obl_pot_system - - module subroutine orbel_el2xv_vec(self, cb) - implicit none - class(swiftest_body), intent(inout) :: self !! Swiftest body object - class(swiftest_cb), intent(inout) :: cb !! Swiftest central body object - end subroutine orbel_el2xv_vec - - pure module subroutine orbel_scget(angle, sx, cx) - !$omp declare simd(orbel_scget) - implicit none - real(DP), intent(in) :: angle - real(DP), intent(out) :: sx, cx - end subroutine orbel_scget - - pure module subroutine orbel_xv2aeq(mu, px, py, pz, vx, vy, vz, a, e, q) - !$omp declare simd(orbel_xv2aeq) - implicit none - real(DP), intent(in) :: mu !! Gravitational constant - real(DP), intent(in) :: px,py,pz !! Position vector - real(DP), intent(in) :: vx,vy,vz !! Velocity vector - real(DP), intent(out) :: a !! semimajor axis - real(DP), intent(out) :: e !! eccentricity - real(DP), intent(out) :: q !! periapsis - end subroutine orbel_xv2aeq - - pure module subroutine orbel_xv2aqt(mu, px, py, pz, vx, vy, vz, a, q, capm, tperi) - !$omp declare simd(orbel_xv2aqt) - implicit none - real(DP), intent(in) :: mu !! Gravitational constant - real(DP), intent(in) :: px,py,pz !! Position vector - real(DP), intent(in) :: vx,vy,vz !! Velocity vector - real(DP), intent(out) :: a !! semimajor axis - real(DP), intent(out) :: q !! periapsis - real(DP), intent(out) :: capm !! mean anomaly - real(DP), intent(out) :: tperi !! time of pericenter passage - end subroutine orbel_xv2aqt - - pure module subroutine orbel_xv2el(mu, px, py, pz, vx, vy, vz, a, e, inc, capom, omega, capm, varpi, lam, f, cape, capf) - implicit none - real(DP), intent(in) :: mu !! Gravitational constant - real(DP), intent(in) :: px,py,pz !! Position vector - real(DP), intent(in) :: vx,vy,vz !! Velocity vector - real(DP), intent(out) :: a !! semimajor axis - real(DP), intent(out) :: e !! eccentricity - real(DP), intent(out) :: inc !! inclination - real(DP), intent(out) :: capom !! longitude of ascending node - real(DP), intent(out) :: omega !! argument of periapsis - real(DP), intent(out) :: capm !! mean anomaly - real(DP), intent(out) :: varpi !! longitude of periapsis - real(DP), intent(out) :: lam !! mean longitude - real(DP), intent(out) :: f !! true anomaly - real(DP), intent(out) :: cape !! eccentric anomaly (eccentric orbits) - real(DP), intent(out) :: capf !! hyperbolic anomaly (hyperbolic orbits) - end subroutine orbel_xv2el - - module subroutine orbel_xv2el_vec(self, cb) - implicit none - class(swiftest_body), intent(inout) :: self !! Swiftest body object - class(swiftest_cb), intent(inout) :: cb !! Swiftest central body object - end subroutine orbel_xv2el_vec - - module subroutine setup_body(self, n, param) - implicit none - class(swiftest_body), intent(inout) :: self !! Swiftest body object - integer(I4B), intent(in) :: n !! Number of particles to allocate space for - class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters - end subroutine setup_body - - module subroutine setup_construct_system(system, param) - implicit none - class(swiftest_nbody_system), allocatable, intent(inout) :: system !! Swiftest system object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - end subroutine setup_construct_system - - module subroutine setup_initialize_particle_info_system(self, param) - implicit none - class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nbody system object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - end subroutine setup_initialize_particle_info_system - - module subroutine setup_initialize_system(self, param) - implicit none - class(swiftest_nbody_system), intent(inout) :: self !! Swiftest system object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - end subroutine setup_initialize_system - - module subroutine setup_pl(self, n, param) - implicit none - class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object - integer(I4B), intent(in) :: n !! Number of particles to allocate space for - class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters - end subroutine setup_pl - - module subroutine setup_tp(self, n, param) - implicit none - class(swiftest_tp), intent(inout) :: self !! Swiftest test particle object - integer(I4B), intent(in) :: n !! Number of particles to allocate space for - class(swiftest_parameters), intent(in) :: param !! Current run configuration parametersr - end subroutine setup_tp - - ! TODO: Implement the tides model - module subroutine tides_kick_getacch_pl(self, system) - implicit none - class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object - end subroutine tides_kick_getacch_pl - - module subroutine tides_step_spin_system(self, param, t, dt) - implicit none - class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nbody system object - class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters - real(DP), intent(in) :: t !! Simulation time - real(DP), intent(in) :: dt !! Current stepsize - end subroutine tides_step_spin_system - - module subroutine user_kick_getacch_body(self, system, param, t, lbeg) - implicit none - class(swiftest_body), intent(inout) :: self !! Swiftest massive body particle data structure - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody_system_object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - real(DP), intent(in) :: t !! Current time - logical, intent(in) :: lbeg !! Optional argument that determines whether or not this is the beginning or end of the step - end subroutine user_kick_getacch_body - end interface - - interface util_append - module subroutine util_append_arr_char_string(arr, source, nold, nsrc, lsource_mask) - implicit none - character(len=STRMAX), dimension(:), allocatable, intent(inout) :: arr !! Destination array - character(len=STRMAX), dimension(:), allocatable, intent(in) :: source !! Array to append - integer(I4B), intent(in) :: nold, nsrc !! Extend of the old array and the source array, respectively - logical, dimension(:), intent(in) :: lsource_mask !! Logical mask indicating which elements to append to - end subroutine util_append_arr_char_string - - module subroutine util_append_arr_DP(arr, source, nold, nsrc, lsource_mask) - implicit none - real(DP), dimension(:), allocatable, intent(inout) :: arr !! Destination array - real(DP), dimension(:), allocatable, intent(in) :: source !! Array to append - integer(I4B), intent(in) :: nold, nsrc !! Extend of the old array and the source array, respectively - logical, dimension(:), intent(in) :: lsource_mask !! Logical mask indicating which elements to append to - end subroutine util_append_arr_DP - - module subroutine util_append_arr_DPvec(arr, source, nold, nsrc, lsource_mask) - implicit none - real(DP), dimension(:,:), allocatable, intent(inout) :: arr !! Destination array - real(DP), dimension(:,:), allocatable, intent(in) :: source !! Array to append - integer(I4B), intent(in) :: nold, nsrc !! Extend of the old array and the source array, respectively - logical, dimension(:), intent(in) :: lsource_mask !! Logical mask indicating which elements to append to - end subroutine util_append_arr_DPvec - - module subroutine util_append_arr_I4B(arr, source, nold, nsrc, lsource_mask) - implicit none - integer(I4B), dimension(:), allocatable, intent(inout) :: arr !! Destination array - integer(I4B), dimension(:), allocatable, intent(in) :: source !! Array to append - integer(I4B), intent(in) :: nold, nsrc !! Extend of the old array and the source array, respectively - logical, dimension(:), intent(in) :: lsource_mask !! Logical mask indicating which elements to append to - end subroutine util_append_arr_I4B - - module subroutine util_append_arr_info(arr, source, nold, nsrc, lsource_mask) - implicit none - type(swiftest_particle_info), dimension(:), allocatable, intent(inout) :: arr !! Destination array - type(swiftest_particle_info), dimension(:), allocatable, intent(in) :: source !! Array to append - integer(I4B), intent(in) :: nold, nsrc !! Extend of the old array and the source array, respectively - logical, dimension(:), intent(in) :: lsource_mask !! Logical mask indicating which elements to append to - end subroutine util_append_arr_info - - module subroutine util_append_arr_logical(arr, source, nold, nsrc, lsource_mask) - implicit none - logical, dimension(:), allocatable, intent(inout) :: arr !! Destination array - logical, dimension(:), allocatable, intent(in) :: source !! Array to append - integer(I4B), intent(in) :: nold, nsrc !! Extend of the old array and the source array, respectively - logical, dimension(:), intent(in) :: lsource_mask !! Logical mask indicating which elements to append to - end subroutine util_append_arr_logical - end interface - - interface - module subroutine util_append_body(self, source, lsource_mask) - implicit none - class(swiftest_body), intent(inout) :: self !! Swiftest body object - class(swiftest_body), intent(in) :: source !! Source object to append - logical, dimension(:), intent(in) :: lsource_mask !! Logical mask indicating which elements to append to - end subroutine util_append_body - - module subroutine util_append_pl(self, source, lsource_mask) - implicit none - class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object - class(swiftest_body), intent(in) :: source !! Source object to append - logical, dimension(:), intent(in) :: lsource_mask !! Logical mask indicating which elements to append to - end subroutine util_append_pl - - module subroutine util_append_tp(self, source, lsource_mask) - implicit none - class(swiftest_tp), intent(inout) :: self !! Swiftest test particle object - class(swiftest_body), intent(in) :: source !! Source object to append - logical, dimension(:), intent(in) :: lsource_mask !! Logical mask indicating which elements to append to - end subroutine util_append_tp - - module subroutine util_coord_b2h_pl(self, cb) - implicit none - class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object - class(swiftest_cb), intent(inout) :: cb !! Swiftest central body object - end subroutine util_coord_b2h_pl - - module subroutine util_coord_b2h_tp(self, cb) - implicit none - class(swiftest_tp), intent(inout) :: self !! Swiftest test particle object - class(swiftest_cb), intent(in) :: cb !! Swiftest central body object - end subroutine util_coord_b2h_tp - - module subroutine util_coord_h2b_pl(self, cb) - implicit none - class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object - class(swiftest_cb), intent(inout) :: cb !! Swiftest central body object - end subroutine util_coord_h2b_pl - - module subroutine util_coord_h2b_tp(self, cb) - implicit none - class(swiftest_tp), intent(inout) :: self !! Swiftest test particle object - class(swiftest_cb), intent(in) :: cb !! Swiftest central body object - end subroutine util_coord_h2b_tp - - module subroutine util_coord_vb2vh_pl(self, cb) - implicit none - class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object - class(swiftest_cb), intent(inout) :: cb !! Swiftest central body object - end subroutine util_coord_vb2vh_pl - - module subroutine util_coord_vb2vh_tp(self, vbcb) - implicit none - class(swiftest_tp), intent(inout) :: self !! Swiftest test particle object - real(DP), dimension(:), intent(in) :: vbcb !! Barycentric velocity of the central body - end subroutine util_coord_vb2vh_tp - - module subroutine util_coord_vh2vb_pl(self, cb) - implicit none - class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object - class(swiftest_cb), intent(inout) :: cb !! Swiftest central body object - end subroutine util_coord_vh2vb_pl - - module subroutine util_coord_vh2vb_tp(self, vbcb) - implicit none - class(swiftest_tp), intent(inout) :: self !! Swiftest test particle object - real(DP), dimension(:), intent(in) :: vbcb !! Barycentric velocity of the central body - end subroutine util_coord_vh2vb_tp - - module subroutine util_coord_rh2rb_pl(self, cb) - implicit none - class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object - class(swiftest_cb), intent(inout) :: cb !! Swiftest central body object - end subroutine util_coord_rh2rb_pl - - module subroutine util_coord_rh2rb_tp(self, cb) - implicit none - class(swiftest_tp), intent(inout) :: self !! Swiftest test particle object - class(swiftest_cb), intent(in) :: cb !! Swiftest central body object - end subroutine util_coord_rh2rb_tp - - module subroutine util_copy_particle_info(self, source) - implicit none - class(swiftest_particle_info), intent(inout) :: self - class(swiftest_particle_info), intent(in) :: source - end subroutine util_copy_particle_info - - module subroutine util_copy_particle_info_arr(source, dest, idx) - implicit none - class(swiftest_particle_info), dimension(:), intent(in) :: source !! Source object to copy into - class(swiftest_particle_info), dimension(:), intent(inout) :: dest !! Swiftest body object with particle metadata information object - integer(I4B), dimension(:), intent(in), optional :: idx !! Optional array of indices to draw the source object - end subroutine util_copy_particle_info_arr - - module subroutine util_copy_store(self, source) - implicit none - 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 - class(swiftest_body), intent(inout) :: self - end subroutine util_dealloc_body - - module subroutine util_dealloc_pl(self) - implicit none - class(swiftest_pl), intent(inout) :: self - end subroutine util_dealloc_pl - - module subroutine util_final_system(self) - implicit none - class(swiftest_nbody_system), intent(inout) :: self - end subroutine util_final_system - - module subroutine util_dealloc_tp(self) - implicit none - class(swiftest_tp), intent(inout) :: self - end subroutine util_dealloc_tp - - module subroutine util_exit(code) - implicit none - integer(I4B), intent(in) :: code !! Failure exit code - end subroutine util_exit - - module subroutine util_fill_body(self, inserts, lfill_list) - implicit none - class(swiftest_body), intent(inout) :: self !! Swiftest body object - class(swiftest_body), intent(in) :: inserts !! Swiftest body object to be inserted - logical, dimension(:), intent(in) :: lfill_list !! Logical array of bodies to merge into the keeps - end subroutine util_fill_body - - module subroutine util_fill_pl(self, inserts, lfill_list) - implicit none - class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object - class(swiftest_body), intent(in) :: inserts !! Swiftest body object to be inserted - logical, dimension(:), intent(in) :: lfill_list !! Logical array of bodies to merge into the keeps - end subroutine util_fill_pl - - module subroutine util_fill_tp(self, inserts, lfill_list) - implicit none - class(swiftest_tp), intent(inout) :: self !! Swiftest test particle object - class(swiftest_body), intent(in) :: inserts !! Swiftest body object to be inserted - logical, dimension(:), intent(in) :: lfill_list !! Logical array of bodies to merge into the keeps - end subroutine util_fill_tp - end interface - - interface util_fill - module subroutine util_fill_arr_char_string(keeps, inserts, lfill_list) - implicit none - character(len=STRMAX), dimension(:), allocatable, intent(inout) :: keeps !! Array of values to keep - character(len=STRMAX), dimension(:), allocatable, intent(in) :: inserts !! Array of values to insert into keep - logical, dimension(:), intent(in) :: lfill_list !! Logical array of bodies to merge into the keeps - end subroutine util_fill_arr_char_string - - module subroutine util_fill_arr_DP(keeps, inserts, lfill_list) - implicit none - real(DP), dimension(:), allocatable, intent(inout) :: keeps !! Array of values to keep - real(DP), dimension(:), allocatable, intent(in) :: inserts !! Array of values to insert into keep - logical, dimension(:), intent(in) :: lfill_list !! Logical array of bodies to merge into the keeps - end subroutine util_fill_arr_DP - - module subroutine util_fill_arr_DPvec(keeps, inserts, lfill_list) - implicit none - real(DP), dimension(:,:), allocatable, intent(inout) :: keeps !! Array of values to keep - real(DP), dimension(:,:), allocatable, intent(in) :: inserts !! Array of values to insert into keep - logical, dimension(:), intent(in) :: lfill_list !! Logical array of bodies to merge into the keeps - end subroutine util_fill_arr_DPvec - - module subroutine util_fill_arr_I4B(keeps, inserts, lfill_list) - implicit none - integer(I4B), dimension(:), allocatable, intent(inout) :: keeps !! Array of values to keep - integer(I4B), dimension(:), allocatable, intent(in) :: inserts !! Array of values to insert into keep - logical, dimension(:), intent(in) :: lfill_list !! Logical array of bodies to merge into the keeps - end subroutine util_fill_arr_I4B - - module subroutine util_fill_arr_info(keeps, inserts, lfill_list) - implicit none - type(swiftest_particle_info), dimension(:), allocatable, intent(inout) :: keeps !! Array of values to keep - type(swiftest_particle_info), dimension(:), allocatable, intent(in) :: inserts !! Array of values to insert into keep - logical, dimension(:), intent(in) :: lfill_list !! Logical array of bodies to merge into the keeps - end subroutine util_fill_arr_info - - module subroutine util_fill_arr_logical(keeps, inserts, lfill_list) - implicit none - logical, dimension(:), allocatable, intent(inout) :: keeps !! Array of values to keep - logical, dimension(:), allocatable, intent(in) :: inserts !! Array of values to insert into keep - logical, dimension(:), intent(in) :: lfill_list !! Logical array of bodies to merge into the keeps - end subroutine util_fill_arr_logical - end interface - - interface - - module subroutine util_final_storage(self) - implicit none - type(swiftest_storage(*)) :: self - end subroutine util_final_storage - - module subroutine util_final_storage_frame(self) - implicit none - type(swiftest_storage_frame) :: self - end subroutine util_final_storage_frame - - pure module subroutine util_flatten_eucl_ij_to_k(n, i, j, k) - !$omp declare simd(util_flatten_eucl_ij_to_k) - implicit none - integer(I4B), intent(in) :: n !! Number of bodies - integer(I4B), intent(in) :: i !! Index of the ith body - integer(I4B), intent(in) :: j !! Index of the jth body - integer(I8B), intent(out) :: k !! Index of the flattened matrix - end subroutine util_flatten_eucl_ij_to_k - - pure module subroutine util_flatten_eucl_k_to_ij(n, k, i, j) - implicit none - integer(I4B), intent(in) :: n !! Number of bodies - integer(I8B), intent(in) :: k !! Index of the flattened matrix - integer(I4B), intent(out) :: i !! Index of the ith body - integer(I4B), intent(out) :: j !! Index of the jth body - end subroutine util_flatten_eucl_k_to_ij - - module subroutine util_flatten_eucl_plpl(self, param) - implicit none - class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - end subroutine - - module subroutine util_flatten_eucl_pltp(self, pl, param) - implicit none - class(swiftest_tp), intent(inout) :: self !! Swiftest test particle object - class(swiftest_pl), intent(in) :: pl !! Swiftest massive body object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - end subroutine - - module subroutine util_get_vals_storage(self, idvals, tvals) - class(swiftest_storage(*)), intent(in) :: self !! Swiftest storage object - integer(I4B), dimension(:), allocatable, intent(out) :: idvals !! Array of all id values in all snapshots - real(DP), dimension(:), allocatable, intent(out) :: tvals !! Array of all time values in all snapshots - end subroutine util_get_vals_storage - - module subroutine util_index_array(ind_arr, n) - implicit none - integer(I4B), dimension(:), allocatable, intent(inout) :: ind_arr !! Index array. Input is a pre-existing index array where n /= size(ind_arr). Output is a new index array ind_arr = [1, 2, ... n] - integer(I4B), intent(in) :: n !! The new size of the index array - end subroutine util_index_array - - module subroutine util_index_map_storage(self) - implicit none - class(swiftest_storage(*)), intent(inout) :: self !! Swiftest storage object - end subroutine util_index_map_storage - - module subroutine util_minimize_bfgs(f, N, x0, eps, maxloop, lerr, x1) - use lambda_function - implicit none - integer(I4B), intent(in) :: N - class(lambda_obj), intent(inout) :: f - real(DP), dimension(:), intent(in) :: x0 - real(DP), intent(in) :: eps - logical, intent(out) :: lerr - integer(I4B), intent(in) :: maxloop - real(DP), dimension(:), allocatable, intent(out) :: x1 - end subroutine util_minimize_bfgs - - module subroutine util_peri_tp(self, system, param) - implicit none - class(swiftest_tp), intent(inout) :: self !! Swiftest test particle object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object - class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters - end subroutine util_peri_tp - - module subroutine util_rescale_system(self, param, mscale, dscale, tscale) - implicit none - class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nbody system object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters. Returns with new values of the scale vactors and GU - real(DP), intent(in) :: mscale, dscale, tscale !! Scale factors for mass, distance, and time units, respectively. - end subroutine util_rescale_system - - module subroutine util_reset_storage(self) - implicit none - class(swiftest_storage(*)), intent(inout) :: self !! Swiftest storage object - end subroutine util_reset_storage - end interface - - - interface util_resize - module subroutine util_resize_arr_char_string(arr, nnew) - implicit none - character(len=STRMAX), dimension(:), allocatable, intent(inout) :: arr !! Array to resize - integer(I4B), intent(in) :: nnew !! New size - end subroutine util_resize_arr_char_string - - module subroutine util_resize_arr_DP(arr, nnew) - implicit none - real(DP), dimension(:), allocatable, intent(inout) :: arr !! Array to resize - integer(I4B), intent(in) :: nnew !! New size - end subroutine util_resize_arr_DP - - module subroutine util_resize_arr_DPvec(arr, nnew) - implicit none - real(DP), dimension(:,:), allocatable, intent(inout) :: arr !! Array to resize - integer(I4B), intent(in) :: nnew !! New size - end subroutine util_resize_arr_DPvec - - module subroutine util_resize_arr_I4B(arr, nnew) - implicit none - integer(I4B), dimension(:), allocatable, intent(inout) :: arr !! Array to resize - integer(I4B), intent(in) :: nnew !! New size - end subroutine util_resize_arr_I4B - - module subroutine util_resize_arr_info(arr, nnew) - implicit none - type(swiftest_particle_info), dimension(:), allocatable, intent(inout) :: arr !! Array to resize - integer(I4B), intent(in) :: nnew !! New size - end subroutine util_resize_arr_info - - module subroutine util_resize_arr_logical(arr, nnew) - implicit none - logical, dimension(:), allocatable, intent(inout) :: arr !! Array to resize - integer(I4B), intent(in) :: nnew !! New size - end subroutine util_resize_arr_logical - end interface - - interface - module subroutine util_resize_body(self, nnew) - implicit none - class(swiftest_body), intent(inout) :: self !! Swiftest body object - integer(I4B), intent(in) :: nnew !! New size neded - end subroutine util_resize_body - - module subroutine util_resize_pl(self, nnew) - implicit none - class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object - integer(I4B), intent(in) :: nnew !! New size neded - end subroutine util_resize_pl - - module subroutine util_resize_tp(self, nnew) - implicit none - class(swiftest_tp), intent(inout) :: self !! Swiftest test particle object - integer(I4B), intent(in) :: nnew !! New size neded - end subroutine util_resize_tp - - module subroutine util_get_energy_momentum_system(self, param) - implicit none - class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nbody system object - class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters - end subroutine util_get_energy_momentum_system - - module subroutine util_get_idvalues_system(self, idvals) - implicit none - class(swiftest_nbody_system), intent(in) :: self !! Encounter snapshot object - integer(I4B), dimension(:), allocatable, intent(out) :: idvals !! Array of all id values saved in this snapshot - end subroutine util_get_idvalues_system - - module subroutine util_set_beg_end_pl(self, rbeg, xend, vbeg) - implicit none - class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object - real(DP), dimension(:,:), intent(in), optional :: rbeg !! Position vectors at beginning of step - real(DP), dimension(:,:), intent(in), optional :: xend !! Positions vectors at end of step - real(DP), dimension(:,:), intent(in), optional :: vbeg !! vbeg is an unused variable to keep this method forward compatible with RMVS - end subroutine util_set_beg_end_pl - - module subroutine util_set_ir3h(self) - implicit none - class(swiftest_body), intent(inout) :: self !! Swiftest body object - end subroutine util_set_ir3h - - module subroutine util_set_msys(self) - implicit none - class(swiftest_nbody_system), intent(inout) :: self !! Swiftest system object - end subroutine util_set_msys - - module subroutine util_set_mu_pl(self, cb) - implicit none - class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object - class(swiftest_cb), intent(inout) :: cb !! Swiftest central body object - end subroutine util_set_mu_pl - - module subroutine util_set_mu_tp(self, cb) - implicit none - class(swiftest_tp), intent(inout) :: self !! Swiftest test particle object - class(swiftest_cb), intent(inout) :: cb !! Swiftest central body object - end subroutine util_set_mu_tp - - module subroutine util_set_particle_info(self, name, particle_type, status, origin_type, origin_time, collision_id, & - origin_rh, origin_vh, discard_time, discard_rh, discard_vh, discard_body_id) - implicit none - class(swiftest_particle_info), intent(inout) :: self - character(len=*), intent(in), optional :: name !! Non-unique name - character(len=*), intent(in), optional :: particle_type !! String containing a description of the particle type (e.g. Central Body, Massive Body, Test Particle) - character(len=*), intent(in), optional :: status !! Particle status description: Active, Merged, Fragmented, etc. - character(len=*), intent(in), optional :: origin_type !! String containing a description of the origin of the particle (e.g. Initial Conditions, Supercatastrophic, Disruption, etc.) - real(DP), intent(in), optional :: origin_time !! The time of the particle's formation - integer(I4B), intent(in), optional :: collision_id !! The ID fo the collision that formed the particle - real(DP), dimension(:), intent(in), optional :: origin_rh !! The heliocentric distance vector at the time of the particle's formation - real(DP), dimension(:), intent(in), optional :: origin_vh !! The heliocentric velocity vector at the time of the particle's formation - real(DP), intent(in), optional :: discard_time !! The time of the particle's discard - real(DP), dimension(:), intent(in), optional :: discard_rh !! The heliocentric distance vector at the time of the particle's discard - real(DP), dimension(:), intent(in), optional :: discard_vh !! The heliocentric velocity vector at the time of the particle's discard - integer(I4B), intent(in), optional :: discard_body_id !! The id of the other body involved in the discard (0 if no other body involved) - end subroutine util_set_particle_info - - module subroutine util_set_rhill(self,cb) - implicit none - class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object - class(swiftest_cb), intent(inout) :: cb !! Swiftest central body object - end subroutine util_set_rhill - - module subroutine util_set_renc_I4B(self, scale) - implicit none - class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object - integer(I4B), intent(in) :: scale !! Input scale factor (multiplier of Hill's sphere size) - end subroutine util_set_renc_I4B - - module subroutine util_set_renc_DP(self, scale) - implicit none - class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object - real(DP), intent(in) :: scale !! Input scale factor (multiplier of Hill's sphere size) - end subroutine util_set_renc_DP - - module subroutine util_set_rhill_approximate(self,cb) - implicit none - class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object - class(swiftest_cb), intent(inout) :: cb !! Swiftest central body object - end subroutine util_set_rhill_approximate - - module subroutine util_snapshot_system(self, param, system, t, arg) - implicit none - class(swiftest_storage(*)), intent(inout) :: self !! Swiftest storage object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object to store - real(DP), intent(in), optional :: t !! Time of snapshot if different from system time - character(*), intent(in), optional :: arg !! Optional argument (needed for extended storage type used in encounter snapshots) - end subroutine util_snapshot_system - end interface - - interface util_solve_linear_system - module function util_solve_linear_system_d(A,b,n,lerr) result(x) - implicit none - integer(I4B), intent(in) :: n - real(DP), dimension(:,:), intent(in) :: A - real(DP), dimension(:), intent(in) :: b - logical, intent(out) :: lerr - real(DP), dimension(n) :: x - end function util_solve_linear_system_d - - module function util_solve_linear_system_q(A,b,n,lerr) result(x) - implicit none - integer(I4B), intent(in) :: n - real(QP), dimension(:,:), intent(in) :: A - real(QP), dimension(:), intent(in) :: b - logical, intent(out) :: lerr - real(QP), dimension(n) :: x - end function util_solve_linear_system_q - end interface - - interface - module function util_solve_rkf45(f, y0in, t1, dt0, tol) result(y1) - use lambda_function - implicit none - class(lambda_obj), intent(inout) :: f !! lambda function object that has been initialized to be a function of derivatives. The object will return with components lastarg and lasteval set - real(DP), dimension(:), intent(in) :: y0in !! Initial value at t=0 - real(DP), intent(in) :: t1 !! Final time - real(DP), intent(in) :: dt0 !! Initial step size guess - real(DP), intent(in) :: tol !! Tolerance on solution - real(DP), dimension(:), allocatable :: y1 !! Final result - end function util_solve_rkf45 - end interface - - interface util_sort - pure module subroutine util_sort_i4b(arr) - implicit none - integer(I4B), dimension(:), intent(inout) :: arr - end subroutine util_sort_i4b - - pure module subroutine util_sort_index_i4b(arr,ind) - implicit none - integer(I4B), dimension(:), intent(in) :: arr - integer(I4B), dimension(:), allocatable, intent(inout) :: ind - end subroutine util_sort_index_i4b - - pure module subroutine util_sort_index_I4B_I8Bind(arr,ind) - implicit none - integer(I4B), dimension(:), intent(in) :: arr - integer(I8B), dimension(:), allocatable, intent(inout) :: ind - end subroutine util_sort_index_I4b_I8Bind - - pure module subroutine util_sort_index_I8B_I8Bind(arr,ind) - implicit none - integer(I8B), dimension(:), intent(in) :: arr - integer(I8B), dimension(:), allocatable, intent(inout) :: ind - end subroutine util_sort_index_I8B_I8Bind - - pure module subroutine util_sort_sp(arr) - implicit none - real(SP), dimension(:), intent(inout) :: arr - end subroutine util_sort_sp - - pure module subroutine util_sort_index_sp(arr,ind) - implicit none - real(SP), dimension(:), intent(in) :: arr - integer(I4B), dimension(:), allocatable, intent(inout) :: ind - end subroutine util_sort_index_sp - - pure module subroutine util_sort_dp(arr) - implicit none - real(DP), dimension(:), intent(inout) :: arr - end subroutine util_sort_dp - - pure module subroutine util_sort_index_dp(arr,ind) - implicit none - real(DP), dimension(:), intent(in) :: arr - integer(I4B), dimension(:), allocatable, intent(inout) :: ind - end subroutine util_sort_index_dp - end interface util_sort - - interface util_sort_rearrange - pure module subroutine util_sort_rearrange_arr_char_string(arr, ind, n) - implicit none - character(len=STRMAX), dimension(:), allocatable, intent(inout) :: arr !! Destination array - integer(I4B), dimension(:), intent(in) :: ind !! Index to rearrange against - integer(I4B), intent(in) :: n !! Number of elements in arr and ind to rearrange - end subroutine util_sort_rearrange_arr_char_string - - pure module subroutine util_sort_rearrange_arr_DP(arr, ind, n) - implicit none - real(DP), dimension(:), allocatable, intent(inout) :: arr !! Destination array - integer(I4B), dimension(:), intent(in) :: ind !! Index to rearrange against - integer(I4B), intent(in) :: n !! Number of elements in arr and ind to rearrange - end subroutine util_sort_rearrange_arr_DP - - pure module subroutine util_sort_rearrange_arr_DPvec(arr, ind, n) - implicit none - real(DP), dimension(:,:), allocatable, intent(inout) :: arr !! Destination array - integer(I4B), dimension(:), intent(in) :: ind !! Index to rearrange against - integer(I4B), intent(in) :: n !! Number of elements in arr and ind to rearrange - end subroutine util_sort_rearrange_arr_DPvec - - pure module subroutine util_sort_rearrange_arr_I4B(arr, ind, n) - implicit none - integer(I4B), dimension(:), allocatable, intent(inout) :: arr !! Destination array - integer(I4B), dimension(:), intent(in) :: ind !! Index to rearrange against - integer(I4B), intent(in) :: n !! Number of elements in arr and ind to rearrange - end subroutine util_sort_rearrange_arr_I4B - - pure module subroutine util_sort_rearrange_arr_I4B_I8Bind(arr, ind, n) - implicit none - integer(I4B), dimension(:), allocatable, intent(inout) :: arr !! Destination array - integer(I8B), dimension(:), intent(in) :: ind !! Index to rearrange against - integer(I8B), intent(in) :: n !! Number of elements in arr and ind to rearrange - end subroutine util_sort_rearrange_arr_I4B_I8Bind - - module subroutine util_sort_rearrange_arr_info(arr, ind, n) - implicit none - type(swiftest_particle_info), dimension(:), allocatable, intent(inout) :: arr !! Destination array - integer(I4B), dimension(:), intent(in) :: ind !! Index to rearrange against - integer(I4B), intent(in) :: n !! Number of elements in arr and ind to rearrange - end subroutine util_sort_rearrange_arr_info - - pure module subroutine util_sort_rearrange_arr_logical(arr, ind, n) - implicit none - logical, dimension(:), allocatable, intent(inout) :: arr !! Destination array - integer(I4B), dimension(:), intent(in) :: ind !! Index to rearrange against - integer(I4B), intent(in) :: n !! Number of elements in arr and ind to rearrange - end subroutine util_sort_rearrange_arr_logical - - pure module subroutine util_sort_rearrange_arr_logical_I8Bind(arr, ind, n) - implicit none - logical, dimension(:), allocatable, intent(inout) :: arr !! Destination array - integer(I8B), dimension(:), intent(in) :: ind !! Index to rearrange against - integer(I8B), intent(in) :: n !! Number of elements in arr and ind to rearrange - end subroutine util_sort_rearrange_arr_logical_I8Bind - end interface util_sort_rearrange - - interface - module subroutine util_sort_rearrange_body(self, ind) - implicit none - class(swiftest_body), intent(inout) :: self !! Swiftest body object - integer(I4B), dimension(:), intent(in) :: ind !! Index array used to restructure the body (should contain all 1:n index values in the desired order) - end subroutine util_sort_rearrange_body - - module subroutine util_sort_rearrange_pl(self, ind) - implicit none - class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object - integer(I4B), dimension(:), intent(in) :: ind !! Index array used to restructure the body (should contain all 1:n index values in the desired order) - end subroutine util_sort_rearrange_pl - - module subroutine util_sort_rearrange_tp(self, ind) - implicit none - class(swiftest_tp), intent(inout) :: self !! Swiftest test particle object - integer(I4B), dimension(:), intent(in) :: ind !! Index array used to restructure the body (should contain all 1:n index values in the desired order) - end subroutine util_sort_rearrange_tp - - module subroutine util_sort_body(self, sortby, ascending) - implicit none - class(swiftest_body), intent(inout) :: self !! Swiftest body object - character(*), intent(in) :: sortby !! Sorting attribute - logical, intent(in) :: ascending !! Logical flag indicating whether or not the sorting should be in ascending or descending order - end subroutine util_sort_body - - module subroutine util_sort_pl(self, sortby, ascending) - implicit none - class(swiftest_pl), intent(inout) :: self !! Swiftest body object - character(*), intent(in) :: sortby !! Sorting attribute - logical, intent(in) :: ascending !! Logical flag indicating whether or not the sorting should be in ascending or descending order - end subroutine util_sort_pl - - module subroutine util_sort_tp(self, sortby, ascending) - implicit none - class(swiftest_tp), intent(inout) :: self !! Swiftest body object - character(*), intent(in) :: sortby !! Sorting attribute - logical, intent(in) :: ascending !! Logical flag indicating whether or not the sorting should be in ascending or descending order - end subroutine util_sort_tp - - end interface - - - - interface util_spill - module subroutine util_spill_arr_char_string(keeps, discards, lspill_list, ldestructive) - implicit none - character(len=STRMAX), dimension(:), allocatable, intent(inout) :: keeps !! Array of values to keep - character(len=STRMAX), dimension(:), allocatable, intent(inout) :: discards !! Array of discards - logical, dimension(:), intent(in) :: lspill_list !! Logical array of bodies to spill into the discardss - logical, intent(in) :: ldestructive !! Logical flag indicating whether or not this operation should alter the keeps array or not - end subroutine util_spill_arr_char_string - - module subroutine util_spill_arr_DP(keeps, discards, lspill_list, ldestructive) - implicit none - real(DP), dimension(:), allocatable, intent(inout) :: keeps !! Array of values to keep - real(DP), dimension(:), allocatable, intent(inout) :: discards !! Array of discards - logical, dimension(:), intent(in) :: lspill_list !! Logical array of bodies to spill into the discards - logical, intent(in) :: ldestructive !! Logical flag indicating whether or not this operation should alter the keeps array or not - end subroutine util_spill_arr_DP - - module subroutine util_spill_arr_DPvec(keeps, discards, lspill_list, ldestructive) - implicit none - real(DP), dimension(:,:), allocatable, intent(inout) :: keeps !! Array of values to keep - real(DP), dimension(:,:), allocatable, intent(inout) :: discards !! Array discards - logical, dimension(:), intent(in) :: lspill_list !! Logical array of bodies to spill into the discards - logical, intent(in) :: ldestructive !! Logical flag indicating whether or not this operation should alter the keeps array or not - end subroutine util_spill_arr_DPvec - - module subroutine util_spill_arr_I4B(keeps, discards, lspill_list, ldestructive) - implicit none - integer(I4B), dimension(:), allocatable, intent(inout) :: keeps !! Array of values to keep - integer(I4B), dimension(:), allocatable, intent(inout) :: discards !! Array of discards - logical, dimension(:), intent(in) :: lspill_list !! Logical array of bodies to spill into the discardss - logical, intent(in) :: ldestructive !! Logical flag indicating whether or not this operation should alter the keeps array or not - end subroutine util_spill_arr_I4B - - module subroutine util_spill_arr_I8B(keeps, discards, lspill_list, ldestructive) - implicit none - integer(I8B), dimension(:), allocatable, intent(inout) :: keeps !! Array of values to keep - integer(I8B), dimension(:), allocatable, intent(inout) :: discards !! Array of discards - logical, dimension(:), intent(in) :: lspill_list !! Logical array of bodies to spill into the discardss - logical, intent(in) :: ldestructive !! Logical flag indicating whether or not this operation should alter the keeps array or not - end subroutine util_spill_arr_I8B - - module subroutine util_spill_arr_info(keeps, discards, lspill_list, ldestructive) - implicit none - type(swiftest_particle_info), dimension(:), allocatable, intent(inout) :: keeps !! Array of values to keep - type(swiftest_particle_info), dimension(:), allocatable, intent(inout) :: discards !! Array of discards - logical, dimension(:), intent(in) :: lspill_list !! Logical array of bodies to spill into the discardss - logical, intent(in) :: ldestructive !! Logical flag indicating whether or not this operation should alter the keeps array or not - end subroutine util_spill_arr_info - - module subroutine util_spill_arr_logical(keeps, discards, lspill_list, ldestructive) - implicit none - logical, dimension(:), allocatable, intent(inout) :: keeps !! Array of values to keep - logical, dimension(:), allocatable, intent(inout) :: discards !! Array of discards - logical, dimension(:), intent(in) :: lspill_list !! Logical array of bodies to spill into the discardss - logical, intent(in) :: ldestructive !! Logical flag indicating whether or not this operation should alter the keeps array or not - end subroutine util_spill_arr_logical - end interface - - interface - module subroutine util_spill_body(self, discards, lspill_list, ldestructive) - implicit none - class(swiftest_body), intent(inout) :: self !! Swiftest body object - class(swiftest_body), intent(inout) :: discards !! Discarded object - logical, dimension(:), intent(in) :: lspill_list !! Logical array of bodies to spill into the discards - logical, intent(in) :: ldestructive !! Logical flag indicating whether or not this operation should alter the keeps array or not - end subroutine util_spill_body - - module subroutine util_spill_pl(self, discards, lspill_list, ldestructive) - implicit none - class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object - class(swiftest_body), intent(inout) :: discards !! Discarded object - logical, dimension(:), intent(in) :: lspill_list !! Logical array of bodies to spill into the discards - logical, intent(in) :: ldestructive !! Logical flag indicating whether or not this operation should alter the keeps array or not - end subroutine util_spill_pl - - module subroutine util_spill_tp(self, discards, lspill_list, ldestructive) - implicit none - class(swiftest_tp), intent(inout) :: self !! Swiftest test particle object - class(swiftest_body), intent(inout) :: discards !! Discarded object - logical, dimension(:), intent(in) :: lspill_list !! Logical array of bodies to spill into the discards - logical, intent(in) :: ldestructive !! Logical flag indicating whether or not this operation should alter the keeps array or not - end subroutine util_spill_tp - - end interface - - interface util_unique - module subroutine util_unique_DP(input_array, output_array, index_map) - implicit none - real(DP), dimension(:), intent(in) :: input_array !! Unsorted input array - real(DP), dimension(:), allocatable, intent(out) :: output_array !! Sorted array of unique values - integer(I4B), dimension(:), allocatable, intent(out) :: index_map !! An array of the same size as input_array that such that any for any index i, output_array(index_map(i)) = input_array(i) - end subroutine util_unique_DP - - module subroutine util_unique_I4B(input_array, output_array, index_map) - implicit none - integer(I4B), dimension(:), intent(in) :: input_array !! Unsorted input array - integer(I4B), dimension(:), allocatable, intent(out) :: output_array !! Sorted array of unique values - integer(I4B), dimension(:), allocatable, intent(out) :: index_map !! An array of the same size as input_array that such that any for any index i, output_array(index_map(i)) = input_array(i) - end subroutine util_unique_I4B - end interface util_unique - - interface - module subroutine util_valid_id_system(self, param) - implicit none - class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nbody system object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - end subroutine util_valid_id_system - - module subroutine util_version() - implicit none - end subroutine util_version - end interface - -end module swiftest_classes diff --git a/src/modules/symba_classes.f90 b/src/modules/symba.f90 similarity index 55% rename from src/modules/symba_classes.f90 rename to src/modules/symba.f90 index 86988fc9e..419a2b711 100644 --- a/src/modules/symba_classes.f90 +++ b/src/modules/symba.f90 @@ -7,17 +7,13 @@ !! You should have received a copy of the GNU General Public License along with Swiftest. !! If not, see: https://www.gnu.org/licenses. -module symba_classes +module symba !! author: The Purdue Swiftest Team - David A. Minton, Carlisle A. Wishard, Jennifer L.L. Pouplin, and Jacob R. Elliott !! !! Definition of classes and methods specific to the SyMBA integrator !! Adapted from David E. Kaufmann's Swifter routine: module_symba.f90 - use swiftest_globals - use swiftest_classes, only : swiftest_parameters, swiftest_base, swiftest_particle_info, swiftest_storage, netcdf_parameters - use helio_classes, only : helio_cb, helio_pl, helio_tp, helio_nbody_system - use fraggle_classes, only : collision_impactors, fraggle_fragments - use encounter_classes, only : encounter_list, encounter_storage - use collision_classes, only : collision_storage, collision_system + use swiftest + use helio implicit none public @@ -26,66 +22,17 @@ module symba_classes 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 for fragmentation modeling - logical :: lfragmentation = .false. !! Do fragmentation modeling instead of simple merger. - character(STRMAX) :: encounter_save = "NONE" !! Indicate if and how encounter data should be saved - logical :: lenc_save_trajectory = .false. !! Indicates that when encounters are saved, the full trajectory through recursion steps are saved - logical :: lenc_save_closest = .false. !! Indicates that when encounters are saved, the closest approach distance between pairs of bodies is saved - type(encounter_storage(nframes=:)), allocatable :: encounter_history !! Stores encounter history for later retrieval and saving to file - type(collision_storage(nframes=:)), allocatable :: collision_history !! Stores encounter history for later retrieval and saving to file - contains - procedure :: reader => symba_io_param_reader - procedure :: writer => symba_io_param_writer - end type symba_parameters - - !******************************************************************************************************************************** - ! symba_kinship class definitions and method interfaces - !******************************************************************************************************************************* - !> Class definition for the kinship relationships used in bookkeeping multiple collisions bodies in a single time step. - type symba_kinship - integer(I4B) :: parent !! Index of parent particle - integer(I4B) :: nchild !! number of children in merger list - integer(I4B), dimension(:), allocatable :: child !! Index of children particles - contains - procedure :: dealloc => symba_util_dealloc_kin !! Deallocates all allocatable arrays - final :: symba_util_final_kin !! Finalizes the SyMBA kinship object - deallocates all allocatables - end type symba_kinship - !******************************************************************************************************************************** - ! symba_cb class definitions and method interfaces - !******************************************************************************************************************************* !> SyMBA central body particle class type, extends(helio_cb) :: symba_cb - real(DP) :: GM0 = 0.0_DP !! Initial G*mass of the central body - real(DP) :: dGM = 0.0_DP !! Change in G*mass of the central body - real(DP) :: R0 = 0.0_DP !! Initial radius of the central body - real(DP) :: dR = 0.0_DP !! Change in the radius of the central body - contains end type symba_cb - !******************************************************************************************************************************** - ! symba_pl class definitions and method interfaces - !******************************************************************************************************************************* + !> SyMBA massive body class type, extends(helio_pl) :: symba_pl - logical, dimension(:), allocatable :: lcollision !! flag indicating whether body has merged with another this time step - logical, dimension(:), allocatable :: lencounter !! flag indicating whether body is part of an encounter this time step - logical, dimension(:), allocatable :: lmtiny !! flag indicating whether this body is below the GMTINY cutoff value - integer(I4B) :: nplm !! number of bodies above the GMTINY limit - integer(I8B) :: nplplm !! Number of body (all massive)-body (only those above GMTINY) comparisons in the flattened upper triangular matrix - integer(I4B), dimension(:), allocatable :: nplenc !! number of encounters with other planets this time step - integer(I4B), dimension(:), allocatable :: ntpenc !! number of encounters with test particles this time step integer(I4B), dimension(:), allocatable :: levelg !! level at which this body should be moved integer(I4B), dimension(:), allocatable :: levelm !! deepest encounter level achieved this time step - integer(I4B), dimension(:), allocatable :: isperi !! perihelion passage flag - real(DP), dimension(:), allocatable :: peri !! perihelion distance - real(DP), dimension(:), allocatable :: atp !! semimajor axis following perihelion passage - type(symba_kinship), dimension(:), allocatable :: kin !! Array of merger relationship structures that can account for multiple pairwise mergers in a single step contains - procedure :: make_impactors => symba_collision_make_impactors_pl !! When a single body is involved in more than one collision in a single step, it becomes part of a family procedure :: flatten => symba_util_flatten_eucl_plpl !! Sets up the (i, j) -> k indexing used for the single-loop blocking Euclidean distance matrix procedure :: discard => symba_discard_pl !! Process massive body discards procedure :: drift => symba_drift_pl !! Method for Danby drift in Democratic Heliocentric coordinates. Sets the mask to the current recursion level @@ -98,8 +45,6 @@ module symba_classes procedure :: dealloc => symba_util_dealloc_pl !! Deallocates all allocatable arrays procedure :: fill => symba_util_fill_pl !! "Fills" bodies from one object into another depending on the results of a mask (uses the UNPACK intrinsic) procedure :: get_peri => symba_util_peri_pl !! Determine system pericenter passages for massive bodies - procedure :: rearray => symba_util_rearray_pl !! Clean up the massive body structures to remove discarded bodies and add new bodies - procedure :: reset_kinship => symba_util_reset_kinship !! Resets the kinship status of bodies procedure :: resize => symba_util_resize_pl !! Checks the current size of a SyMBA massive body against the requested size and resizes it if it is too small. procedure :: set_renc_I4B => symba_util_set_renc !! Sets the critical radius for encounter given an input recursion depth procedure :: sort => symba_util_sort_pl !! Sorts body arrays by a sortable componen @@ -108,22 +53,9 @@ module symba_classes final :: symba_util_final_pl !! Finalizes the SyMBA massive body object - deallocates all allocatables end type symba_pl - type, extends(symba_pl) :: symba_merger - integer(I4B), dimension(:), allocatable :: ncomp - contains - procedure :: append => symba_util_append_merger !! Appends elements from one structure to another - procedure :: dealloc => symba_util_dealloc_merger !! Deallocates all allocatable arrays - procedure :: resize => symba_util_resize_merger !! Checks the current size of a SyMBA merger list against the requested size and resizes it if it is too small. - procedure :: setup => symba_setup_merger !! Constructor method - Allocates space for the input number of bodies - final :: symba_util_final_merger !! Finalizes the SyMBA merger object - deallocates all allocatables - end type symba_merger - - !******************************************************************************************************************************** - ! symba_tp class definitions and method interfaces - !******************************************************************************************************************************* + !> SyMBA test particle class type, extends(helio_tp) :: symba_tp - integer(I4B), dimension(:), allocatable :: nplenc !! number of encounters with planets this time step integer(I4B), dimension(:), allocatable :: levelg !! level at which this particle should be moved integer(I4B), dimension(:), allocatable :: levelm !! deepest encounter level achieved this time step contains @@ -142,15 +74,11 @@ module symba_classes final :: symba_util_final_tp !! Finalizes the SyMBA test particle object - deallocates all allocatables end type symba_tp - !******************************************************************************************************************************** - ! symba_encounter class definitions and method interfaces - !******************************************************************************************************************************* + !> SyMBA class for tracking close encounters in a step type, extends(encounter_list) :: symba_encounter integer(I4B), dimension(:), allocatable :: level !! encounter recursion level - 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 procedure :: kick => symba_kick_encounter !! Kick barycentric velocities of active test particles within SyMBA recursion procedure :: setup => symba_setup_encounter_list !! A constructor that sets the number of encounters and allocates and initializes all arrays @@ -161,38 +89,10 @@ module symba_classes final :: symba_util_final_encounter_list !! Finalizes the SyMBA test particle object - deallocates all allocatables end type symba_encounter - !******************************************************************************************************************************** - ! symba_pltpenc class definitions and method interfaces - !******************************************************************************************************************************* - !> SyMBA class for tracking pl-tp close encounters in a step - type, extends(symba_encounter) :: symba_pltpenc - contains - procedure :: resolve_collision => symba_resolve_collision_pltpenc !! Process the pl-tp collision list, then modifiy the massive bodies based on the outcome of the c - end type symba_pltpenc - - !******************************************************************************************************************************** - ! symba_plplenc class definitions and method interfaces - !******************************************************************************************************************************* - !> SyMBA class for tracking pl-pl close encounters in a step - type, extends(symba_encounter) :: symba_plplenc - contains - procedure :: extract_collisions => symba_collision_extract_collisions_from_encounters !! Processes the pl-pl encounter list remove only those encounters that led to a collision - procedure :: resolve_collision => symba_resolve_collision_plplenc !! Process the pl-pl collision list, then modifiy the massive bodies based on the outcome of the c - end type symba_plplenc - - !******************************************************************************************************************************** - ! symba_nbody_system class definitions and method interfaces - !******************************************************************************************************************************** type, extends(helio_nbody_system) :: symba_nbody_system - class(symba_merger), allocatable :: pl_adds !! List of added bodies in mergers or collisions - class(symba_pltpenc), allocatable :: pltpenc_list !! List of massive body-test particle encounters in a single step - class(symba_plplenc), allocatable :: plplenc_list !! List of massive body-massive body encounters in a single step - class(symba_plplenc), allocatable :: plplcollision_list !! List of massive body-massive body collisions in a single step integer(I4B) :: irec !! System recursion level - class(collision_system), allocatable :: collision_system !! Collision system object contains - procedure :: write_discard => symba_io_write_discard !! Write out information about discarded and merged planets and test particles in SyMBA procedure :: initialize => symba_setup_initialize_system !! Performs SyMBA-specific initilization steps procedure :: step => symba_step_system !! Advance the SyMBA nbody system forward in time by one step procedure :: interp => symba_step_interp_system !! Perform an interpolation step on the SymBA nbody system @@ -204,54 +104,7 @@ module symba_classes interface - - module subroutine symba_collision_check_encounter(self, system, param, t, dt, irec, lany_collision) - use swiftest_classes, only : swiftest_parameters - implicit none - class(symba_encounter), intent(inout) :: self !! SyMBA pl-tp encounter list object - class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - real(DP), intent(in) :: t !! current time - real(DP), intent(in) :: dt !! step size - integer(I4B), intent(in) :: irec !! Current recursion level - logical, intent(out) :: lany_collision !! Returns true if any pair of encounters resulted in a collision - end subroutine symba_collision_check_encounter - - module subroutine symba_collision_extract_collisions_from_encounters(self, system, param) - implicit none - class(symba_plplenc), intent(inout) :: self !! SyMBA pl-pl encounter list - class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object - class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters - end subroutine - - module subroutine symba_collision_make_impactors_pl(self,idx) - implicit none - class(symba_pl), intent(inout) :: self !! SyMBA massive body object - integer(I4B), dimension(2), intent(in) :: idx !! Array holding the indices of the two bodies involved in the collision - end subroutine symba_collision_make_impactors_pl - - module subroutine symba_resolve_collision_plplenc(self, system, param, t, dt, irec) - implicit none - class(symba_plplenc), intent(inout) :: self !! SyMBA pl-pl encounter list - class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions - real(DP), intent(in) :: t !! Current simulation time - real(DP), intent(in) :: dt !! Current simulation step size - integer(I4B), intent(in) :: irec !! Current recursion level - end subroutine symba_resolve_collision_plplenc - - module subroutine symba_resolve_collision_pltpenc(self, system, param, t, dt, irec) - implicit none - class(symba_pltpenc), intent(inout) :: self !! SyMBA pl-tp encounter list - class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions - real(DP), intent(in) :: t !! Current simulation time - real(DP), intent(in) :: dt !! Current simulation step size - integer(I4B), intent(in) :: irec !! Current recursion level - end subroutine symba_resolve_collision_pltpenc - module subroutine symba_discard_pl(self, system, param) - use swiftest_classes, only : swiftest_nbody_system, swiftest_parameters implicit none class(symba_pl), intent(inout) :: self !! SyMBA test particle object class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object @@ -259,7 +112,6 @@ module subroutine symba_discard_pl(self, system, param) end subroutine symba_discard_pl module subroutine symba_drift_pl(self, system, param, dt) - use swiftest_classes, only : swiftest_nbody_system, swiftest_parameters implicit none class(symba_pl), intent(inout) :: self !! Helio massive body object class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object @@ -268,7 +120,6 @@ module subroutine symba_drift_pl(self, system, param, dt) end subroutine symba_drift_pl module subroutine symba_drift_tp(self, system, param, dt) - use swiftest_classes, only : swiftest_nbody_system, swiftest_parameters implicit none class(symba_tp), intent(inout) :: self !! Helio massive body object class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object @@ -277,7 +128,6 @@ module subroutine symba_drift_tp(self, system, param, dt) end subroutine symba_drift_tp module function symba_encounter_check_pl(self, param, system, dt, irec) result(lany_encounter) - use swiftest_classes, only : swiftest_nbody_system implicit none class(symba_pl), intent(inout) :: self !! SyMBA test particle object class(swiftest_parameters), intent(inout) :: param !! Current swiftest run configuration parameters @@ -288,7 +138,6 @@ module function symba_encounter_check_pl(self, param, system, dt, irec) result(l end function symba_encounter_check_pl module function symba_encounter_check(self, param, system, dt, irec) result(lany_encounter) - use swiftest_classes, only : swiftest_parameters implicit none class(symba_encounter), intent(inout) :: self !! SyMBA pl-pl encounter list object class(swiftest_parameters), intent(inout) :: param !! Current swiftest run configuration parameters @@ -299,7 +148,6 @@ module function symba_encounter_check(self, param, system, dt, irec) result(lany end function symba_encounter_check module function symba_encounter_check_tp(self, param, system, dt, irec) result(lany_encounter) - use swiftest_classes, only : swiftest_parameters implicit none class(symba_tp), intent(inout) :: self !! SyMBA test particle object class(swiftest_parameters), intent(inout) :: param !! Current swiftest run configuration parameters @@ -310,7 +158,6 @@ module function symba_encounter_check_tp(self, param, system, dt, irec) result(l end function symba_encounter_check_tp pure module subroutine symba_gr_p4_pl(self, system, param, dt) - use swiftest_classes, only : swiftest_parameters, swiftest_nbody_system implicit none class(symba_pl), intent(inout) :: self !! SyMBA massive body object class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object @@ -319,7 +166,6 @@ pure module subroutine symba_gr_p4_pl(self, system, param, dt) end subroutine symba_gr_p4_pl pure module subroutine symba_gr_p4_tp(self, system, param, dt) - use swiftest_classes, only : swiftest_parameters, swiftest_nbody_system implicit none class(symba_tp), intent(inout) :: self !! SyMBA test particle object class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object @@ -327,50 +173,15 @@ pure module subroutine symba_gr_p4_tp(self, system, param, dt) real(DP), intent(in) :: dt !! Step size end subroutine symba_gr_p4_tp - module function symba_collision_casedisruption(system, param, t) result(status) - implicit none - class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object - class(symba_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions - real(DP), intent(in) :: t !! Time of collision - integer(I4B) :: status !! Status flag assigned to this outcome - end function symba_collision_casedisruption - - module function symba_collision_casehitandrun(system, param, t) result(status) - implicit none - class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object - class(symba_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions - real(DP), intent(in) :: t !! Time of collision - integer(I4B) :: status !! Status flag assigned to this outcome - end function symba_collision_casehitandrun - - module function symba_collision_casemerge(system, param, t) result(status) - implicit none - class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object - class(symba_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions - real(DP), intent(in) :: t !! Time of collision - integer(I4B) :: status !! Status flag assigned to this outcome - end function symba_collision_casemerge - module subroutine symba_util_set_renc(self, scale) implicit none class(symba_pl), intent(inout) :: self !! SyMBA massive body object integer(I4B), intent(in) :: scale !! Current recursion depth end subroutine symba_util_set_renc - - module subroutine symba_io_param_reader(self, unit, iotype, v_list, iostat, iomsg) - implicit none - class(symba_parameters), intent(inout) :: self !! Current run configuration parameters with SyMBA additionss - integer, intent(in) :: unit !! File unit number - character(len=*), intent(in) :: iotype !! Dummy argument passed to the input/output procedure contains the text from the char-literal-constant, prefixed with DT. - !! If you do not include a char-literal-constant, the iotype argument contains only DT. - character(len=*), intent(in) :: v_list(:) !! The first element passes the integrator code to the reader - integer, intent(out) :: iostat !! IO status code - character(len=*), intent(inout) :: iomsg !! Message to pass if iostat /= 0 - end subroutine symba_io_param_reader module subroutine symba_io_param_writer(self, unit, iotype, v_list, iostat, iomsg) implicit none - class(symba_parameters),intent(in) :: self !! Current run configuration parameters with SyMBA additions + class(swiftest_parameters),intent(in) :: self !! Current run configuration parameters with SyMBA additions integer, intent(in) :: unit !! File unit number character(len=*), intent(in) :: iotype !! Dummy argument passed to the input/output procedure contains the text from the char-literal-constant, prefixed with DT. !! If you do not include a char-literal-constant, the iotype argument contains only DT. @@ -379,13 +190,6 @@ module subroutine symba_io_param_writer(self, unit, iotype, v_list, iostat, ioms character(len=*), intent(inout) :: iomsg !! Message to pass if iostat /= 0 end subroutine symba_io_param_writer - module subroutine symba_io_write_discard(self, param) - use swiftest_classes, only : swiftest_parameters - implicit none - class(symba_nbody_system), intent(inout) :: self !! SyMBA nbody system object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - end subroutine symba_io_write_discard - module subroutine symba_kick_getacch_int_pl(self, param) implicit none class(symba_pl), intent(inout) :: self !! SyMBA massive body object @@ -393,7 +197,6 @@ module subroutine symba_kick_getacch_int_pl(self, param) end subroutine symba_kick_getacch_int_pl module subroutine symba_kick_getacch_pl(self, system, param, t, lbeg) - use swiftest_classes, only : swiftest_nbody_system, swiftest_parameters implicit none class(symba_pl), intent(inout) :: self !! SyMBA massive body particle data structure class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object @@ -403,7 +206,6 @@ module subroutine symba_kick_getacch_pl(self, system, param, t, lbeg) end subroutine symba_kick_getacch_pl module subroutine symba_kick_getacch_tp(self, system, param, t, lbeg) - use swiftest_classes, only : swiftest_nbody_system, swiftest_parameters implicit none class(symba_tp), intent(inout) :: self !! SyMBA test particle data structure class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object @@ -422,22 +224,13 @@ module subroutine symba_kick_encounter(self, system, dt, irec, sgn) end subroutine symba_kick_encounter module subroutine symba_setup_initialize_system(self, param) - use swiftest_classes, only : swiftest_parameters implicit none class(symba_nbody_system), intent(inout) :: self !! SyMBA system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters end subroutine symba_setup_initialize_system - module subroutine symba_setup_merger(self, n, param) - use swiftest_classes, only : swiftest_parameters - implicit none - class(symba_merger), intent(inout) :: self !! SyMBA merger list object - integer(I4B), intent(in) :: n !! Number of particles to allocate space for - class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters - end subroutine symba_setup_merger module subroutine symba_setup_pl(self, n, param) - use swiftest_classes, only : swiftest_parameters implicit none class(symba_pl), intent(inout) :: self !! SyMBA massive body object integer(I4B), intent(in) :: n !! Number of particles to allocate space for @@ -451,7 +244,6 @@ module subroutine symba_setup_encounter_list(self,n) end subroutine symba_setup_encounter_list module subroutine symba_setup_tp(self, n, param) - use swiftest_classes, only : swiftest_parameters implicit none class(symba_tp), intent(inout) :: self !! SyMBA test particle object integer(I4B), intent(in) :: n !! Number of particles to allocate space for @@ -459,7 +251,6 @@ module subroutine symba_setup_tp(self, n, param) end subroutine symba_setup_tp module subroutine symba_step_system(self, param, t, dt) - use swiftest_classes, only : swiftest_parameters implicit none class(symba_nbody_system), intent(inout) :: self !! SyMBA nbody system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters @@ -468,7 +259,6 @@ module subroutine symba_step_system(self, param, t, dt) end subroutine symba_step_system module subroutine symba_step_interp_system(self, param, t, dt) - use swiftest_classes, only : swiftest_parameters implicit none class(symba_nbody_system), intent(inout) :: self !! SyMBA nbody system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters @@ -483,7 +273,6 @@ module subroutine symba_step_set_recur_levels_system(self, ireci) end subroutine symba_step_set_recur_levels_system recursive module subroutine symba_step_recur_system(self, param, t, ireci) - use swiftest_classes, only : swiftest_parameters implicit none class(symba_nbody_system), intent(inout) :: self !! SyMBA nbody system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters @@ -494,21 +283,9 @@ end subroutine symba_step_recur_system module subroutine symba_step_reset_system(self, param) implicit none class(symba_nbody_system), intent(inout) :: self !! SyMBA nbody system object - class(symba_parameters), intent(in) :: param !! Current run configuration parameters with SyMBA additions + class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters with SyMBA additions end subroutine symba_step_reset_system - end interface - interface util_append - module subroutine symba_util_append_arr_kin(arr, source, nold, nsrc, lsource_mask) - implicit none - type(symba_kinship), dimension(:), allocatable, intent(inout) :: arr !! Destination array - type(symba_kinship), dimension(:), allocatable, intent(in) :: source !! Array to append - integer(I4B), intent(in) :: nold, nsrc !! Extend of the old array and the source array, respectively - logical, dimension(:), intent(in) :: lsource_mask !! Logical mask indicating which elements to append to - end subroutine symba_util_append_arr_kin - end interface - - interface module subroutine symba_util_append_encounter_list(self, source, lsource_mask) implicit none class(symba_encounter), intent(inout) :: self !! SyMBA encounter list object @@ -516,16 +293,7 @@ module subroutine symba_util_append_encounter_list(self, source, lsource_mask) logical, dimension(:), intent(in) :: lsource_mask !! Logical mask indicating which elements to append to end subroutine symba_util_append_encounter_list - module subroutine symba_util_append_merger(self, source, lsource_mask) - use swiftest_classes, only : swiftest_body - implicit none - class(symba_merger), intent(inout) :: self !! SyMBA massive body object - class(swiftest_body), intent(in) :: source !! Source object to append - logical, dimension(:), intent(in) :: lsource_mask !! Logical mask indicating which elements to append to - end subroutine symba_util_append_merger - module subroutine symba_util_append_pl(self, source, lsource_mask) - use swiftest_classes, only : swiftest_body implicit none class(symba_pl), intent(inout) :: self !! SyMBA massive body object class(swiftest_body), intent(in) :: source !! Source object to append @@ -533,7 +301,6 @@ module subroutine symba_util_append_pl(self, source, lsource_mask) end subroutine symba_util_append_pl module subroutine symba_util_append_tp(self, source, lsource_mask) - use swiftest_classes, only : swiftest_body implicit none class(symba_tp), intent(inout) :: self !! SyMBA test particle object class(swiftest_body), intent(in) :: source !! Source object to append @@ -541,7 +308,7 @@ module subroutine symba_util_append_tp(self, source, lsource_mask) end subroutine symba_util_append_tp module subroutine symba_util_copy_encounter_list(self, source) - use encounter_classes, only : encounter_list + use encounter, only : encounter_list implicit none class(symba_encounter), intent(inout) :: self !! Encounter list class(encounter_list), intent(in) :: source !! Source object to copy into @@ -552,16 +319,6 @@ module subroutine symba_util_dealloc_encounter_list(self) class(symba_encounter), intent(inout) :: self !! SyMBA encounter list end subroutine symba_util_dealloc_encounter_list - module subroutine symba_util_dealloc_kin(self) - implicit none - class(symba_kinship), intent(inout) :: self !! SyMBA kinship object - end subroutine symba_util_dealloc_kin - - module subroutine symba_util_dealloc_merger(self) - implicit none - class(symba_merger), intent(inout) :: self !! SyMBA body merger object - end subroutine symba_util_dealloc_merger - module subroutine symba_util_dealloc_pl(self) implicit none class(symba_pl), intent(inout) :: self !! SyMBA massive body object @@ -573,18 +330,9 @@ module subroutine symba_util_dealloc_tp(self) end subroutine symba_util_dealloc_tp end interface - interface util_fill - module subroutine symba_util_fill_arr_kin(keeps, inserts, lfill_list) - implicit none - type(symba_kinship), dimension(:), allocatable, intent(inout) :: keeps !! Array of values to keep - type(symba_kinship), dimension(:), allocatable, intent(in) :: inserts !! Array of values to insert into keep - logical, dimension(:), intent(in) :: lfill_list !! Logical array of bodies to merge into the keeps - end subroutine symba_util_fill_arr_kin - end interface interface module subroutine symba_util_fill_pl(self, inserts, lfill_list) - use swiftest_classes, only : swiftest_body implicit none class(symba_pl), intent(inout) :: self !! SyMBA massive body object class(swiftest_body), intent(in) :: inserts !! Inserted object @@ -592,7 +340,6 @@ module subroutine symba_util_fill_pl(self, inserts, lfill_list) end subroutine symba_util_fill_pl module subroutine symba_util_fill_tp(self, inserts, lfill_list) - use swiftest_classes, only : swiftest_body implicit none class(symba_tp), intent(inout) :: self !! SyMBA test particle object class(swiftest_body), intent(in) :: inserts !! Inserted object @@ -600,7 +347,6 @@ module subroutine symba_util_fill_tp(self, inserts, lfill_list) end subroutine symba_util_fill_tp module subroutine symba_util_flatten_eucl_plpl(self, param) - use swiftest_classes, only : swiftest_parameters implicit none class(symba_pl), intent(inout) :: self !! SyMBA massive body object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters @@ -611,16 +357,6 @@ module subroutine symba_util_final_encounter_list(self) type(symba_encounter), intent(inout) :: self !! SyMBA encounter list object end subroutine symba_util_final_encounter_list - module subroutine symba_util_final_kin(self) - implicit none - type(symba_kinship), intent(inout) :: self !! SyMBA kinship object - end subroutine symba_util_final_kin - - module subroutine symba_util_final_merger(self) - implicit none - type(symba_merger), intent(inout) :: self !! SyMBA merger object - end subroutine symba_util_final_merger - module subroutine symba_util_final_pl(self) implicit none type(symba_pl), intent(inout) :: self !! SyMBA massive body object @@ -637,42 +373,15 @@ module subroutine symba_util_final_tp(self) end subroutine symba_util_final_tp module subroutine symba_util_peri_pl(self, system, param) - use swiftest_classes, only : swiftest_nbody_system, swiftest_parameters implicit none class(symba_pl), intent(inout) :: self !! SyMBA massive body object class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters end subroutine symba_util_peri_pl - module subroutine symba_util_rearray_pl(self, system, param) - implicit none - class(symba_pl), intent(inout) :: self !! SyMBA massive body object - class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object - class(symba_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions - end subroutine symba_util_rearray_pl - - module subroutine symba_util_reset_kinship(self, idx) - implicit none - class(symba_pl), intent(inout) :: self !! SyMBA massive body object - integer(I4B), dimension(:), intent(in) :: idx !! Index array of bodies to reset - end subroutine symba_util_reset_kinship end interface - interface util_resize - module subroutine symba_util_resize_arr_kin(arr, nnew) - implicit none - type(symba_kinship), dimension(:), allocatable, intent(inout) :: arr !! Array to resize - integer(I4B), intent(in) :: nnew !! New size - end subroutine symba_util_resize_arr_kin - end interface - interface - module subroutine symba_util_resize_merger(self, nnew) - implicit none - class(symba_merger), intent(inout) :: self !! SyMBA merger list object - integer(I4B), intent(in) :: nnew !! New size neded - end subroutine symba_util_resize_merger - module subroutine symba_util_resize_pl(self, nnew) implicit none class(symba_pl), intent(inout) :: self !! SyMBA massive body object @@ -700,15 +409,6 @@ module subroutine symba_util_sort_tp(self, sortby, ascending) end subroutine symba_util_sort_tp end interface - interface util_sort_rearrange - module subroutine symba_util_sort_rearrange_arr_kin(arr, ind, n) - implicit none - type(symba_kinship), dimension(:), allocatable, intent(inout) :: arr !! Destination array - integer(I4B), dimension(:), intent(in) :: ind !! Index to rearrange against - integer(I4B), intent(in) :: n !! Number of elements in arr and ind to rearrange - end subroutine symba_util_sort_rearrange_arr_kin - end interface util_sort_rearrange - interface module subroutine symba_util_sort_rearrange_pl(self, ind) implicit none @@ -723,19 +423,8 @@ module subroutine symba_util_sort_rearrange_tp(self, ind) end subroutine symba_util_sort_rearrange_tp end interface - interface util_spill - module subroutine symba_util_spill_arr_kin(keeps, discards, lspill_list, ldestructive) - implicit none - type(symba_kinship), dimension(:), allocatable, intent(inout) :: keeps !! Array of values to keep - type(symba_kinship), dimension(:), allocatable, intent(inout) :: discards !! Array of discards - logical, dimension(:), intent(in) :: lspill_list !! Logical array of bodies to spill into the discardss - logical, intent(in) :: ldestructive !! Logical flag indicating whether or not this operation should alter the keeps array or not - end subroutine symba_util_spill_arr_kin - end interface - interface module subroutine symba_util_spill_pl(self, discards, lspill_list, ldestructive) - use swiftest_classes, only : swiftest_body implicit none class(symba_pl), intent(inout) :: self !! SyMBA massive body object class(swiftest_body), intent(inout) :: discards !! Discarded object @@ -744,7 +433,7 @@ module subroutine symba_util_spill_pl(self, discards, lspill_list, ldestructive) end subroutine symba_util_spill_pl module subroutine symba_util_spill_encounter_list(self, discards, lspill_list, ldestructive) - use encounter_classes, only : encounter_list + use encounter, only : encounter_list implicit none class(symba_encounter), intent(inout) :: self !! SyMBA pl-tp encounter list class(encounter_list), intent(inout) :: discards !! Discarded object @@ -753,7 +442,6 @@ module subroutine symba_util_spill_encounter_list(self, discards, lspill_list, l end subroutine symba_util_spill_encounter_list module subroutine symba_util_spill_tp(self, discards, lspill_list, ldestructive) - use swiftest_classes, only : swiftest_body implicit none class(symba_tp), intent(inout) :: self !! SyMBA test particle object class(swiftest_body), intent(inout) :: discards !! Discarded object @@ -762,4 +450,4 @@ module subroutine symba_util_spill_tp(self, discards, lspill_list, ldestructive) end subroutine symba_util_spill_tp end interface -end module symba_classes \ No newline at end of file +end module symba \ No newline at end of file diff --git a/src/modules/walltime.f90 b/src/modules/walltime.f90 new file mode 100644 index 000000000..6ccce25b1 --- /dev/null +++ b/src/modules/walltime.f90 @@ -0,0 +1,76 @@ +!! Copyright 2022 - David Minton, Carlisle Wishard, Jennifer Pouplin, Jake Elliott, & Dana Singh +!! This file is part of Swiftest. +!! Swiftest is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License +!! as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. +!! Swiftest is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty +!! of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. +!! You should have received a copy of the GNU General Public License along with Swiftest. +!! If not, see: https://www.gnu.org/licenses. + +module walltime + !! author: David A. Minton + !! + !! Classes and methods used to compute elasped wall time + use globals + use base + implicit none + public + + integer(I4B) :: INTERACTION_TIMER_CADENCE = 1000 !! Minimum number of steps to wait before timing an interaction loop in ADAPTIVE mode + character(len=*), parameter :: INTERACTION_TIMER_LOG_OUT = "interaction_timer.log" !! Name of log file for recording results of interaction loop timing + character(len=*), parameter :: ENCOUNTER_PLPL_TIMER_LOG_OUT = "encounter_check_plpl_timer.log" !! Name of log file for recording results of encounter check method timing + character(len=*), parameter :: ENCOUNTER_PLTP_TIMER_LOG_OUT = "encounter_check_pltp_timer.log" !! Name of log file for recording results of encounter check method timing + + type :: walltimer + integer(I8B) :: count_rate !! Rate at wich the clock ticks + integer(I8B) :: count_max !! Maximum value of the clock ticker + integer(I8B) :: count_start_main !! Value of the clock ticker at when the timer is first called + integer(I8B) :: count_start_step !! Value of the clock ticker at the start of a timed step + integer(I8B) :: count_stop_step !! Value of the clock ticker at the end of a timed step + integer(I8B) :: count_pause !! Value of the clock ticker at the end of a timed step + real(DP) :: wall_step !! Value of the step elapsed time + real(DP) :: wall_main !! Value of the main clock elapsed time + real(DP) :: wall_per_substep !! Value of time per substep + logical :: main_is_started = .false. !! Logical flag indicating whether or not the main timer has been reset or not + logical :: is_paused = .false. !! Logical flag indicating whether or not the timer is paused + + contains + procedure :: reset => walltime_reset !! Resets the clock ticker, settting main_start to the current ticker value + procedure :: start => walltime_start !! Starts or resumes the step timer + procedure :: start_main => walltime_start_main !! Starts the main timer + procedure :: stop => walltime_stop !! Pauses the step timer + procedure :: report => walltime_report !! Prints the elapsed time information to the terminal + end type walltimer + + + interface + module subroutine walltime_report(self, message, unit, nsubsteps) + implicit none + class(walltimer), intent(inout) :: self !! Walltimer object + character(len=*), intent(in) :: message !! Message to prepend to the wall time terminal output + integer(I4B), intent(in) :: unit !! Output file unit for report text to be directed + integer(I4B), optional, intent(in) :: nsubsteps !! Number of substeps used to compute the time per step + end subroutine walltime_report + + module subroutine walltime_reset(self) + implicit none + class(walltimer), intent(inout) :: self !! Walltimer object + end subroutine walltime_reset + + module subroutine walltime_start(self) + implicit none + class(walltimer), intent(inout) :: self !! Walltimer object + end subroutine walltime_start + + module subroutine walltime_start_main(self) + implicit none + class(walltimer), intent(inout) :: self !! Walltimer object + end subroutine walltime_start_main + + module subroutine walltime_stop(self) + implicit none + class(walltimer), intent(inout) :: self !! Walltimer object + end subroutine walltime_stop + end interface + +end module walltime \ No newline at end of file diff --git a/src/modules/walltime_classes.f90 b/src/modules/walltime_classes.f90 deleted file mode 100644 index 536272b44..000000000 --- a/src/modules/walltime_classes.f90 +++ /dev/null @@ -1,134 +0,0 @@ -!! Copyright 2022 - David Minton, Carlisle Wishard, Jennifer Pouplin, Jake Elliott, & Dana Singh -!! This file is part of Swiftest. -!! Swiftest is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License -!! as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. -!! Swiftest is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty -!! of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. -!! You should have received a copy of the GNU General Public License along with Swiftest. -!! If not, see: https://www.gnu.org/licenses. - -module walltime_classes - !! author: David A. Minton - !! - !! Classes and methods used to compute elasped wall time - use swiftest_globals - use swiftest_classes, only : swiftest_parameters, swiftest_pl - implicit none - public - - integer(I4B) :: INTERACTION_TIMER_CADENCE = 1000 !! Minimum number of steps to wait before timing an interaction loop in ADAPTIVE mode - character(len=*), parameter :: INTERACTION_TIMER_LOG_OUT = "interaction_timer.log" !! Name of log file for recording results of interaction loop timing - character(len=*), parameter :: ENCOUNTER_PLPL_TIMER_LOG_OUT = "encounter_check_plpl_timer.log" !! Name of log file for recording results of encounter check method timing - character(len=*), parameter :: ENCOUNTER_PLTP_TIMER_LOG_OUT = "encounter_check_pltp_timer.log" !! Name of log file for recording results of encounter check method timing - - type :: walltimer - integer(I8B) :: count_rate !! Rate at wich the clock ticks - integer(I8B) :: count_max !! Maximum value of the clock ticker - integer(I8B) :: count_start_main !! Value of the clock ticker at when the timer is first called - integer(I8B) :: count_start_step !! Value of the clock ticker at the start of a timed step - integer(I8B) :: count_stop_step !! Value of the clock ticker at the end of a timed step - integer(I8B) :: count_pause !! Value of the clock ticker at the end of a timed step - real(DP) :: wall_step !! Value of the step elapsed time - real(DP) :: wall_main !! Value of the main clock elapsed time - real(DP) :: wall_per_substep !! Value of time per substep - logical :: main_is_started = .false. !! Logical flag indicating whether or not the main timer has been reset or not - logical :: is_paused = .false. !! Logical flag indicating whether or not the timer is paused - - contains - procedure :: reset => walltime_reset !! Resets the clock ticker, settting main_start to the current ticker value - procedure :: start => walltime_start !! Starts or resumes the step timer - procedure :: start_main => walltime_start_main !! Starts the main timer - procedure :: stop => walltime_stop !! Pauses the step timer - procedure :: report => walltime_report !! Prints the elapsed time information to the terminal - end type walltimer - - type, extends(walltimer) :: interaction_timer - character(len=STRMAX) :: loopname !! Stores the name of the loop being timed for logging purposes - character(len=NAMELEN) :: looptype !! Stores the type of loop (e.g. INTERACTION or ENCOUNTER) - integer(I8B) :: max_interactions = huge(1_I8B) !! Stores the number of pl-pl interactions that failed when attempting to flatten (e.g. out of memory). Adapting won't occur if ninteractions > max_interactions - integer(I8B) :: last_interactions = 0 !! Number of interactions that were computed last time. The timer is only run if there has been a change to the number of interactions - integer(I4B) :: step_counter = 0 !! Number of steps that have elapsed since the last timed loop - logical :: is_on = .false. !! The loop timer is currently active - integer(I4B) :: stage = 1 !! The stage of the loop timing (1 or 2) - logical :: stage1_is_advanced !! Logical flag indicating whether stage1 was done with a flat loop (.true.) or triangular loop (.false.) - integer(I8B) :: stage1_ninteractions !! Number of interactions computed during stage 1 - real(DP) :: stage1_metric !! Metric used to judge the performance of a timed loop (e.g. (count_finish_step - count_start_step) / ninteractions) - real(DP) :: stage2_metric !! Metric used to judge the performance of a timed loop (e.g. (count_finish_step - count_start_step) / ninteractions) - contains - procedure :: adapt => walltime_interaction_adapt !! Runs the interaction loop adaptation algorithm on an interaction loop - procedure :: check => walltime_interaction_check !! Checks whether or not the loop should be timed and starts the timer if the conditions for starting are met - procedure :: flip => walltime_interaction_flip_loop_style !! Flips the interaction loop style from FLAT to TRIANGULAR or vice vers - procedure :: time_this_loop => walltime_interaction_time_this_loop !! Starts the interaction loop timer - end type interaction_timer - - interface - module subroutine walltime_report(self, message, unit, nsubsteps) - implicit none - class(walltimer), intent(inout) :: self !! Walltimer object - character(len=*), intent(in) :: message !! Message to prepend to the wall time terminal output - integer(I4B), intent(in) :: unit !! Output file unit for report text to be directed - integer(I4B), optional, intent(in) :: nsubsteps !! Number of substeps used to compute the time per step - end subroutine walltime_report - - module subroutine walltime_reset(self) - implicit none - class(walltimer), intent(inout) :: self !! Walltimer object - end subroutine walltime_reset - - module subroutine walltime_start(self) - implicit none - class(walltimer), intent(inout) :: self !! Walltimer object - end subroutine walltime_start - - module subroutine walltime_start_main(self) - implicit none - class(walltimer), intent(inout) :: self !! Walltimer object - end subroutine walltime_start_main - - module subroutine walltime_stop(self) - implicit none - class(walltimer), intent(inout) :: self !! Walltimer object - end subroutine walltime_stop - end interface - - interface - module subroutine walltime_interaction_adapt(self, param, ninteractions, pl) - use swiftest_classes, only : swiftest_parameters - implicit none - class(interaction_timer), intent(inout) :: self !! Interaction loop timer object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - integer(I8B), intent(in) :: ninteractions !! Current number of interactions (used to normalize the timed loop and to determine if number of interactions has changed since the last timing - class(swiftest_pl), intent(inout), optional :: pl !! Swiftest massive body object - end subroutine walltime_interaction_adapt - - module function walltime_interaction_check(self, param, ninteractions) result(ltimeit) - use swiftest_classes, only : swiftest_parameters - implicit none - class(interaction_timer), intent(inout) :: self !! Interaction loop timer object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - integer(I8B), intent(in) :: ninteractions !! Current number of interactions (used to normalize the timed loop and to determine if number of interactions has changed since the last timing - logical :: ltimeit !! Logical flag indicating whether this loop should be timed or not - end function walltime_interaction_check - - module subroutine walltime_interaction_flip_loop_style(self, param, pl) - use swiftest_classes, only : swiftest_parameters, swiftest_pl - implicit none - class(interaction_timer), intent(inout) :: self !! Interaction loop timer object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - class(swiftest_pl), intent(inout), optional :: pl !! Swiftest massive body object - end subroutine walltime_interaction_flip_loop_style - - module subroutine walltime_interaction_time_this_loop(self, param, ninteractions, pl) - use swiftest_classes, only : swiftest_parameters, swiftest_pl - implicit none - class(interaction_timer), intent(inout) :: self !! Interaction loop timer object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - integer(I8B), intent(in) :: ninteractions !! Current number of interactions (used to normalize the timed loop) - class(swiftest_pl), intent(inout), optional :: pl !! Swiftest massive body object - end subroutine walltime_interaction_time_this_loop - - end interface - - - -end module walltime_classes \ No newline at end of file diff --git a/src/modules/whm_classes.f90 b/src/modules/whm.f90 similarity index 86% rename from src/modules/whm_classes.f90 rename to src/modules/whm.f90 index 100e606c4..7b09bbfbc 100644 --- a/src/modules/whm_classes.f90 +++ b/src/modules/whm.f90 @@ -7,27 +7,20 @@ !! You should have received a copy of the GNU General Public License along with Swiftest. !! If not, see: https://www.gnu.org/licenses. -module whm_classes +module whm !! author: David A. Minton !! !! Definition of classes and methods specific to the Democratic Heliocentric Method !! Partially adapted from David E. Kaufmann's Swifter module: module_whm.f90 - use swiftest_globals - use swiftest_classes, only : swiftest_cb, swiftest_pl, swiftest_tp, swiftest_nbody_system + use swiftest implicit none public - !******************************************************************************************************************************** - ! whm_cb class definitions and method interfaces - !******************************************************************************************************************************* !> Swiftest central body particle class type, extends(swiftest_cb) :: whm_cb contains end type whm_cb - !******************************************************************************************************************************** - ! whm_pl class definitions and method interfaces - !******************************************************************************************************************************* !> WHM massive body particle class type, extends(swiftest_pl) :: whm_pl @@ -61,9 +54,6 @@ module whm_classes final :: whm_util_final_pl !! Finalizes the WHM massive body object - deallocates all allocatables end type whm_pl - !******************************************************************************************************************************** - ! whm_tp class definitions and method interfaces - !******************************************************************************************************************************* !! WHM test particle class type, extends(swiftest_tp) :: whm_tp @@ -78,9 +68,6 @@ module whm_classes final :: whm_util_final_tp !! Finalizes the WHM test particle object - deallocates all allocatables end type whm_tp - !******************************************************************************************************************************** - ! whm_nbody_system class definitions and method interfaces - !******************************************************************************************************************************** !> An abstract class for the WHM integrator nbody system type, extends(swiftest_nbody_system) :: whm_nbody_system contains @@ -92,28 +79,24 @@ module whm_classes interface module subroutine whm_coord_h2j_pl(self, cb) - use swiftest_classes, only : swiftest_cb implicit none class(whm_pl), intent(inout) :: self !! WHM massive body particle data structure class(swiftest_cb), intent(inout) :: cb !! Swiftest central body particle data structuree end subroutine whm_coord_h2j_pl module subroutine whm_coord_j2h_pl(self, cb) - use swiftest_classes, only : swiftest_cb implicit none class(whm_pl), intent(inout) :: self !! WHM massive body particle data structure class(swiftest_cb), intent(inout) :: cb !! Swiftest central body particle data structuree end subroutine whm_coord_j2h_pl module subroutine whm_coord_vh2vj_pl(self, cb) - use swiftest_classes, only : swiftest_cb implicit none class(whm_pl), intent(inout) :: self !! WHM massive body particle data structure class(swiftest_cb), intent(inout) :: cb !! Swiftest central body particle data structuree end subroutine whm_coord_vh2vj_pl module subroutine whm_drift_pl(self, system, param, dt) - use swiftest_classes, only : swiftest_nbody_system, swiftest_parameters implicit none class(whm_pl), intent(inout) :: self !! WHM massive body particle data structure class(swiftest_nbody_system), intent(inout) :: system !! WHM nbody system object @@ -123,7 +106,6 @@ end subroutine whm_drift_pl !> Get heliocentric accelration of massive bodies module subroutine whm_kick_getacch_pl(self, system, param, t, lbeg) - use swiftest_classes, only : swiftest_cb, swiftest_parameters implicit none class(whm_pl), intent(inout) :: self !! WHM massive body particle data structure class(swiftest_nbody_system), intent(inout) :: system !! WHM nbody system object @@ -134,7 +116,6 @@ end subroutine whm_kick_getacch_pl !> Get heliocentric accelration of the test particle module subroutine whm_kick_getacch_tp(self, system, param, t, lbeg) - use swiftest_classes, only : swiftest_cb, swiftest_parameters implicit none class(whm_tp), intent(inout) :: self !! WHM test particle data structure class(swiftest_nbody_system), intent(inout) :: system !! WHM nbody system object @@ -144,7 +125,6 @@ module subroutine whm_kick_getacch_tp(self, system, param, t, lbeg) end subroutine whm_kick_getacch_tp module subroutine whm_kick_vh_pl(self, system, param, t, dt, lbeg) - use swiftest_classes, only : swiftest_nbody_system, swiftest_parameters implicit none class(whm_pl), intent(inout) :: self !! WHM massive body object class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object @@ -155,7 +135,6 @@ module subroutine whm_kick_vh_pl(self, system, param, t, dt, lbeg) end subroutine whm_kick_vh_pl module subroutine whm_kick_vh_tp(self, system, param, t, dt, lbeg) - use swiftest_classes, only : swiftest_nbody_system, swiftest_parameters implicit none class(whm_tp), intent(inout) :: self !! WHM test particle object class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object @@ -166,21 +145,18 @@ module subroutine whm_kick_vh_tp(self, system, param, t, dt, lbeg) end subroutine whm_kick_vh_tp pure module subroutine whm_gr_kick_getacch_pl(self, param) - use swiftest_classes, only : swiftest_cb, swiftest_parameters implicit none class(whm_pl), intent(inout) :: self !! WHM massive body particle data structure class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters end subroutine whm_gr_kick_getacch_pl pure module subroutine whm_gr_kick_getacch_tp(self, param) - use swiftest_classes, only : swiftest_cb, swiftest_parameters implicit none class(whm_tp), intent(inout) :: self !! WHM test particle data structure class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters end subroutine whm_gr_kick_getacch_tp pure module subroutine whm_gr_p4_pl(self, system, param, dt) - use swiftest_classes, only : swiftest_parameters implicit none class(whm_pl), intent(inout) :: self !! WHM massive body object class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system @@ -189,7 +165,6 @@ pure module subroutine whm_gr_p4_pl(self, system, param, dt) end subroutine whm_gr_p4_pl pure module subroutine whm_gr_p4_tp(self, system, param, dt) - use swiftest_classes, only : swiftest_parameters implicit none class(whm_tp), intent(inout) :: self !! WHM test particle object class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system @@ -199,7 +174,6 @@ end subroutine whm_gr_p4_tp !> Reads WHM massive body object in from file module subroutine whm_setup_pl(self, n, param) - use swiftest_classes, only : swiftest_parameters implicit none class(whm_pl), intent(inout) :: self !! WHM massive body objectobject integer(I4B), intent(in) :: n !! Number of particles to allocate space for @@ -207,14 +181,12 @@ module subroutine whm_setup_pl(self, n, param) end subroutine whm_setup_pl module subroutine whm_setup_initialize_system(self, param) - use swiftest_classes, only : swiftest_parameters implicit none class(whm_nbody_system), intent(inout) :: self !! WHM nbody system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters end subroutine whm_setup_initialize_system module subroutine whm_step_pl(self, system, param, t, dt) - use swiftest_classes, only : swiftest_nbody_system, swiftest_parameters implicit none class(whm_pl), intent(inout) :: self !! WHM massive body object class(swiftest_nbody_system), intent(inout) :: system !! Swiftest system object @@ -224,7 +196,6 @@ module subroutine whm_step_pl(self, system, param, t, dt) end subroutine whm_step_pl module subroutine whm_step_system(self, param, t, dt) - use swiftest_classes, only : swiftest_parameters implicit none class(whm_nbody_system), intent(inout) :: self !! WHM system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters @@ -233,7 +204,6 @@ module subroutine whm_step_system(self, param, t, dt) end subroutine whm_step_system module subroutine whm_step_tp(self, system, param, t, dt) - use swiftest_classes, only : swiftest_nbody_system, swiftest_parameters implicit none class(whm_tp), intent(inout) :: self !! WHM test particle data structure class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object @@ -243,7 +213,6 @@ module subroutine whm_step_tp(self, system, param, t, dt) end subroutine whm_step_tp module subroutine whm_util_append_pl(self, source, lsource_mask) - use swiftest_classes, only : swiftest_body implicit none class(whm_pl), intent(inout) :: self !! WHM massive body object class(swiftest_body), intent(in) :: source !! Source object to append @@ -271,16 +240,14 @@ module subroutine whm_util_final_tp(self) end subroutine whm_util_final_tp module subroutine whm_util_spill_pl(self, discards, lspill_list, ldestructive) - use swiftest_classes, only : swiftest_body implicit none class(whm_pl), intent(inout) :: self !! WHM massive body object - class(swiftest_body), intent(inout) :: discards !! Discarded object + class(swiftest_body), intent(inout) :: discards !! Discarded object logical, dimension(:), intent(in) :: lspill_list !! Logical array of bodies to spill into the discards logical, intent(in) :: ldestructive !! Logical flag indicating whether or not this operation should alter the keeps array or not end subroutine whm_util_spill_pl module subroutine whm_util_fill_pl(self, inserts, lfill_list) - use swiftest_classes, only : swiftest_body implicit none class(whm_pl), intent(inout) :: self !! WHM massive body object class(swiftest_body), intent(in) :: inserts !! inserted object @@ -299,7 +266,6 @@ module subroutine whm_util_set_ir3j(self) end subroutine whm_util_set_ir3j module subroutine whm_util_set_mu_eta_pl(self, cb) - use swiftest_classes, only : swiftest_cb implicit none class(whm_pl), intent(inout) :: self !! WHM massive body object class(swiftest_cb), intent(inout) :: cb !! Swiftest central body object @@ -319,4 +285,4 @@ module subroutine whm_util_sort_rearrange_pl(self, ind) end subroutine whm_util_sort_rearrange_pl end interface -end module whm_classes +end module whm diff --git a/src/netcdf/netcdf.f90 b/src/netcdf/netcdf.f90 deleted file mode 100644 index eaf11ddd4..000000000 --- a/src/netcdf/netcdf.f90 +++ /dev/null @@ -1,1290 +0,0 @@ -!! Copyright 2022 - David Minton, Carlisle Wishard, Jennifer Pouplin, Jake Elliott, & Dana Singh -!! This file is part of Swiftest. -!! Swiftest is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License -!! as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. -!! Swiftest is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty -!! of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. -!! You should have received a copy of the GNU General Public License along with Swiftest. -!! If not, see: https://www.gnu.org/licenses. - -submodule (swiftest_classes) s_netcdf - use swiftest - use netcdf -contains - - 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 - implicit none - ! Arguments - integer, intent (in) :: status !! The status code returned by a NetCDF function - character(len=*), intent(in), optional :: call_identifier !! String that indicates which calling function caused the error for diagnostic purposes - - if(status /= nf90_noerr) then - if (present(call_identifier)) write(*,*) "NetCDF error in ",trim(call_identifier) - write(*,*) trim(nf90_strerror(status)) - call util_exit(FAILURE) - end if - - return - end subroutine check - - - module subroutine netcdf_close(self) - !! author: Carlisle A. Wishard, Dana Singh, and David A. Minton - !! - !! Closes a NetCDF file - implicit none - ! Arguments - class(netcdf_parameters), intent(inout) :: self !! Parameters used to identify a particular NetCDF dataset - - call check( nf90_close(self%id), "netcdf_close" ) - - return - end subroutine netcdf_close - - - module subroutine netcdf_flush(self, param) - !! author: David A. Minton - !! - !! Flushes the current buffer to disk by closing and re-opening the file. - !! - implicit none - ! Arguments - class(netcdf_parameters), intent(inout) :: self !! Parameters used to identify a particular NetCDF dataset - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - - call self%close() - call self%open(param) - - return - end subroutine netcdf_flush - - - module function netcdf_get_old_t_final_system(self, param) result(old_t_final) - !! author: David A. Minton - !! - !! Validates the dump file to check whether the dump file initial conditions duplicate the last frame of the netcdf output. - !! - implicit none - ! Arguments - class(swiftest_nbody_system), intent(inout) :: self - class(swiftest_parameters), intent(inout) :: param - ! Result - real(DP) :: old_t_final - ! Internals - integer(I4B) :: itmax, idmax - real(DP), dimension(:), allocatable :: vals - real(DP), dimension(1) :: rtemp - real(DP), dimension(NDIM) :: rot0, Ip0, Lnow - real(DP) :: KE_orb_orig, KE_spin_orig, PE_orig - - associate (nc => param%system_history%nc) - call nc%open(param) - call check( nf90_inquire_dimension(nc%id, nc%time_dimid, len=itmax), "netcdf_get_old_t_final_system time_dimid" ) - call check( nf90_inquire_dimension(nc%id, nc%name_dimid, len=idmax), "netcdf_get_old_t_final_system name_dimid" ) - allocate(vals(idmax)) - call check( nf90_get_var(nc%id, nc%time_varid, rtemp, start=[1], count=[1]), "netcdf_get_old_t_final_system time_varid" ) - - !old_t_final = rtemp(1) - old_t_final = param%t0 ! For NetCDF it is safe to overwrite the final t value on a restart - - if (param%lenergy) then - call check( nf90_get_var(nc%id, nc%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(nc%id, nc%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(nc%id, nc%PE_varid, rtemp, start=[1], count=[1]), "netcdf_get_old_t_final_system PE_varid" ) - PE_orig = rtemp(1) - - call check( nf90_get_var(nc%id, nc%Ecollisions_varid, self%Ecollisions, start=[1]), "netcdf_get_old_t_final_system Ecollisions_varid" ) - call check( nf90_get_var(nc%id, nc%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(nc%id, nc%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(nc%id, nc%Lspin_varid, self%Lspin_orig(:), start=[1,1], count=[NDIM,1]), "netcdf_get_old_t_final_system Lspin_varid" ) - call check( nf90_get_var(nc%id, nc%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(nc%id, nc%Gmass_varid, vals, start=[1,1], count=[idmax,1]), "netcdf_get_old_t_final_system Gmass_varid" ) - call check( nf90_get_var(nc%id, nc%GMescape_varid, self%GMescape, start=[1]), "netcdf_get_old_t_final_system GMescape_varid" ) - self%GMtot_orig = vals(1) + sum(vals(2:idmax), vals(2:idmax) == vals(2:idmax)) + self%GMescape - - select type(cb => self%cb) - class is (symba_cb) - cb%GM0 = vals(1) - cb%dGM = cb%Gmass - cb%GM0 - - call check( nf90_get_var(nc%id, nc%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(nc%id, nc%rot_varid, rot0, start=[1,1,1], count=[NDIM,1,1]), "netcdf_get_old_t_final_system rot_varid" ) - call check( nf90_get_var(nc%id, nc%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(:) - - Lnow(:) = cb%Ip(3) * cb%Gmass * cb%radius**2 * cb%rot(:) - cb%dL(:) = Lnow(:) - cb%L0(:) - end if - end select - - end if - - deallocate(vals) - end associate - - return - end function netcdf_get_old_t_final_system - - - module subroutine netcdf_initialize_output(self, param) - !! author: Carlisle A. Wishard, Dana Singh, and David A. Minton - !! - !! Initialize a NetCDF file system and defines all variables. - use, intrinsic :: ieee_arithmetic - implicit none - ! Arguments - class(netcdf_parameters), intent(inout) :: self !! Parameters used to identify a particular NetCDF dataset - class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters - ! Internals - integer(I4B) :: nvar, varid, vartype - real(DP) :: dfill - real(SP) :: sfill - integer(I4B), parameter :: NO_FILL = 0 - logical :: fileExists - character(len=STRMAX) :: errmsg - integer(I4B) :: ndims - - associate(nc => self) - - dfill = ieee_value(dfill, IEEE_QUIET_NAN) - sfill = ieee_value(sfill, IEEE_QUIET_NAN) - - select case (param%out_type) - case("NETCDF_FLOAT") - nc%out_type = NF90_FLOAT - case("NETCDF_DOUBLE") - nc%out_type = NF90_DOUBLE - end select - - ! Check if the file exists, and if it does, delete it - inquire(file=nc%file_name, exist=fileExists) - if (fileExists) then - open(unit=LUN, file=nc%file_name, status="old", err=667, iomsg=errmsg) - close(unit=LUN, status="delete") - end if - - ! Create the file - call check( nf90_create(nc%file_name, NF90_NETCDF4, nc%id), "netcdf_initialize_output nf90_create" ) - - ! Dimensions - call check( nf90_def_dim(nc%id, nc%time_dimname, NF90_UNLIMITED, nc%time_dimid), "netcdf_initialize_output nf90_def_dim time_dimid" ) ! Simulation time dimension - call check( nf90_def_dim(nc%id, nc%space_dimname, NDIM, nc%space_dimid), "netcdf_initialize_output nf90_def_dim space_dimid" ) ! 3D space dimension - call check( nf90_def_dim(nc%id, nc%name_dimname, NF90_UNLIMITED, nc%name_dimid), "netcdf_initialize_output nf90_def_dim name_dimid" ) ! dimension to store particle id numbers - call check( nf90_def_dim(nc%id, nc%str_dimname, NAMELEN, nc%str_dimid), "netcdf_initialize_output nf90_def_dim str_dimid" ) ! Dimension for string variables (aka character arrays) - - ! Dimension coordinates - call check( nf90_def_var(nc%id, nc%time_dimname, nc%out_type, nc%time_dimid, nc%time_varid), "netcdf_initialize_output nf90_def_var time_varid" ) - call check( nf90_def_var(nc%id, nc%space_dimname, NF90_CHAR, nc%space_dimid, nc%space_varid), "netcdf_initialize_output nf90_def_var space_varid" ) - call check( nf90_def_var(nc%id, nc%name_dimname, NF90_CHAR, [nc%str_dimid, nc%name_dimid], nc%name_varid), "netcdf_initialize_output nf90_def_var name_varid" ) - - ! Variables - call check( nf90_def_var(nc%id, nc%id_varname, NF90_INT, nc%name_dimid, nc%id_varid), "netcdf_initialize_output nf90_def_var id_varid" ) - call check( nf90_def_var(nc%id, nc%npl_varname, NF90_INT, nc%time_dimid, nc%npl_varid), "netcdf_initialize_output nf90_def_var npl_varid" ) - call check( nf90_def_var(nc%id, nc%ntp_varname, NF90_INT, nc%time_dimid, nc%ntp_varid), "netcdf_initialize_output nf90_def_var ntp_varid" ) - if (param%integrator == SYMBA) call check( nf90_def_var(nc%id, nc%nplm_varname, NF90_INT, nc%time_dimid, nc%nplm_varid), "netcdf_initialize_output nf90_def_var nplm_varid" ) - call check( nf90_def_var(nc%id, nc%ptype_varname, NF90_CHAR, [nc%str_dimid, nc%name_dimid], nc%ptype_varid), "netcdf_initialize_output nf90_def_var ptype_varid" ) - - if ((param%out_form == "XV") .or. (param%out_form == "XVEL")) then - call check( nf90_def_var(nc%id, nc%rh_varname, nc%out_type, [nc%space_dimid, nc%name_dimid, nc%time_dimid], nc%rh_varid), "netcdf_initialize_output nf90_def_var rh_varid" ) - call check( nf90_def_var(nc%id, nc%vh_varname, nc%out_type, [nc%space_dimid, nc%name_dimid, nc%time_dimid], nc%vh_varid), "netcdf_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(nc%id, nc%gr_pseudo_vh_varname, nc%out_type, [nc%space_dimid, nc%name_dimid, nc%time_dimid], nc%gr_pseudo_vh_varid), "netcdf_initialize_output nf90_def_var gr_psuedo_vh_varid" ) - nc%lpseudo_vel_exists = .true. - end if - - end if - - if ((param%out_form == "EL") .or. (param%out_form == "XVEL")) then - call check( nf90_def_var(nc%id, nc%a_varname, nc%out_type, [nc%name_dimid, nc%time_dimid], nc%a_varid), "netcdf_initialize_output nf90_def_var a_varid" ) - call check( nf90_def_var(nc%id, nc%e_varname, nc%out_type, [nc%name_dimid, nc%time_dimid], nc%e_varid), "netcdf_initialize_output nf90_def_var e_varid" ) - call check( nf90_def_var(nc%id, nc%inc_varname, nc%out_type, [nc%name_dimid, nc%time_dimid], nc%inc_varid), "netcdf_initialize_output nf90_def_var inc_varid" ) - call check( nf90_def_var(nc%id, nc%capom_varname, nc%out_type, [nc%name_dimid, nc%time_dimid], nc%capom_varid), "netcdf_initialize_output nf90_def_var capom_varid" ) - call check( nf90_def_var(nc%id, nc%omega_varname, nc%out_type, [nc%name_dimid, nc%time_dimid], nc%omega_varid), "netcdf_initialize_output nf90_def_var omega_varid" ) - call check( nf90_def_var(nc%id, nc%capm_varname, nc%out_type, [nc%name_dimid, nc%time_dimid], nc%capm_varid), "netcdf_initialize_output nf90_def_var capm_varid" ) - call check( nf90_def_var(nc%id, nc%varpi_varname, nc%out_type, [nc%name_dimid, nc%time_dimid], nc%varpi_varid), "netcdf_initialize_output nf90_def_var varpi_varid" ) - call check( nf90_def_var(nc%id, nc%lam_varname, nc%out_type, [nc%name_dimid, nc%time_dimid], nc%lam_varid), "netcdf_initialize_output nf90_def_var lam_varid" ) - call check( nf90_def_var(nc%id, nc%f_varname, nc%out_type, [nc%name_dimid, nc%time_dimid], nc%f_varid), "netcdf_initialize_output nf90_def_var f_varid" ) - call check( nf90_def_var(nc%id, nc%cape_varname, nc%out_type, [nc%name_dimid, nc%time_dimid], nc%cape_varid), "netcdf_initialize_output nf90_def_var cape_varid" ) - end if - - call check( nf90_def_var(nc%id, nc%gmass_varname, nc%out_type, [nc%name_dimid, nc%time_dimid], nc%Gmass_varid), "netcdf_initialize_output nf90_def_var Gmass_varid" ) - - if (param%lrhill_present) then - call check( nf90_def_var(nc%id, nc%rhill_varname, nc%out_type, [nc%name_dimid, nc%time_dimid], nc%rhill_varid), "netcdf_initialize_output nf90_def_var rhill_varid" ) - end if - - if (param%lclose) then - call check( nf90_def_var(nc%id, nc%radius_varname, nc%out_type, [nc%name_dimid, nc%time_dimid], nc%radius_varid), "netcdf_initialize_output nf90_def_var radius_varid" ) - - call check( nf90_def_var(nc%id, nc%origin_time_varname, nc%out_type, nc%name_dimid, nc%origin_time_varid), "netcdf_initialize_output nf90_def_var origin_time_varid" ) - call check( nf90_def_var(nc%id, nc%origin_type_varname, NF90_CHAR, [nc%str_dimid, nc%name_dimid], & - nc%origin_type_varid), "netcdf_initialize_output nf90_create" ) - call check( nf90_def_var(nc%id, nc%origin_rh_varname, nc%out_type, [nc%space_dimid, nc%name_dimid], nc%origin_rh_varid), "netcdf_initialize_output nf90_def_var origin_rh_varid" ) - call check( nf90_def_var(nc%id, nc%origin_vh_varname, nc%out_type, [nc%space_dimid, nc%name_dimid], nc%origin_vh_varid), "netcdf_initialize_output nf90_def_var origin_vh_varid" ) - - call check( nf90_def_var(nc%id, nc%collision_id_varname, NF90_INT, nc%name_dimid, nc%collision_id_varid), "netcdf_initialize_output nf90_def_var collision_id_varid" ) - call check( nf90_def_var(nc%id, nc%discard_time_varname, nc%out_type, nc%name_dimid, nc%discard_time_varid), "netcdf_initialize_output nf90_def_var discard_time_varid" ) - call check( nf90_def_var(nc%id, nc%discard_rh_varname, nc%out_type, [nc%space_dimid, nc%name_dimid], nc%discard_rh_varid), "netcdf_initialize_output nf90_def_var discard_rh_varid" ) - call check( nf90_def_var(nc%id, nc%discard_vh_varname, nc%out_type, [nc%space_dimid, nc%name_dimid], nc%discard_vh_varid), "netcdf_initialize_output nf90_def_var discard_vh_varid" ) - call check( nf90_def_var(nc%id, nc%discard_body_id_varname, NF90_INT, nc%name_dimid, nc%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(nc%id, nc%Ip_varname, nc%out_type, [nc%space_dimid, nc%name_dimid, nc%time_dimid], nc%Ip_varid), "netcdf_initialize_output nf90_def_var Ip_varid" ) - call check( nf90_def_var(nc%id, nc%rot_varname, nc%out_type, [nc%space_dimid, nc%name_dimid, nc%time_dimid], nc%rot_varid), "netcdf_initialize_output nf90_def_var rot_varid" ) - end if - - ! if (param%ltides) then - ! call check( nf90_def_var(nc%id, nc%k2_varname, nc%out_type, [nc%name_dimid, nc%time_dimid], nc%k2_varid), "netcdf_initialize_output nf90_def_var k2_varid" ) - ! call check( nf90_def_var(nc%id, nc%q_varname, nc%out_type, [nc%name_dimid, nc%time_dimid], nc%Q_varid), "netcdf_initialize_output nf90_def_var Q_varid" ) - ! end if - - if (param%lenergy) then - call check( nf90_def_var(nc%id, nc%ke_orb_varname, nc%out_type, nc%time_dimid, nc%KE_orb_varid), "netcdf_initialize_output nf90_def_var KE_orb_varid" ) - call check( nf90_def_var(nc%id, nc%ke_spin_varname, nc%out_type, nc%time_dimid, nc%KE_spin_varid), "netcdf_initialize_output nf90_def_var KE_spin_varid" ) - call check( nf90_def_var(nc%id, nc%pe_varname, nc%out_type, nc%time_dimid, nc%PE_varid), "netcdf_initialize_output nf90_def_var PE_varid" ) - call check( nf90_def_var(nc%id, nc%L_orb_varname, nc%out_type, [nc%space_dimid, nc%time_dimid], nc%L_orb_varid), "netcdf_initialize_output nf90_def_var L_orb_varid" ) - call check( nf90_def_var(nc%id, nc%Lspin_varname, nc%out_type, [nc%space_dimid, nc%time_dimid], nc%Lspin_varid), "netcdf_initialize_output nf90_def_var Lspin_varid" ) - call check( nf90_def_var(nc%id, nc%L_escape_varname, nc%out_type, [nc%space_dimid, nc%time_dimid], nc%L_escape_varid), "netcdf_initialize_output nf90_def_var L_escape_varid" ) - call check( nf90_def_var(nc%id, nc%Ecollisions_varname, nc%out_type, nc%time_dimid, nc%Ecollisions_varid), "netcdf_initialize_output nf90_def_var Ecollisions_varid" ) - call check( nf90_def_var(nc%id, nc%Euntracked_varname, nc%out_type, nc%time_dimid, nc%Euntracked_varid), "netcdf_initialize_output nf90_def_var Euntracked_varid" ) - call check( nf90_def_var(nc%id, nc%GMescape_varname, nc%out_type, nc%time_dimid, nc%GMescape_varid), "netcdf_initialize_output nf90_def_var GMescape_varid" ) - end if - - call check( nf90_def_var(nc%id, nc%j2rp2_varname, nc%out_type, nc%time_dimid, nc%j2rp2_varid), "netcdf_initialize_output nf90_def_var j2rp2_varid" ) - call check( nf90_def_var(nc%id, nc%j4rp4_varname, nc%out_type, nc%time_dimid, nc%j4rp4_varid), "netcdf_initialize_output nf90_def_var j4rp4_varid" ) - - - ! Set fill mode to NaN for all variables - call check( nf90_inquire(nc%id, nVariables=nvar), "netcdf_initialize_output nf90_inquire nVariables" ) - do varid = 1, nvar - call check( nf90_inquire_variable(nc%id, varid, xtype=vartype, ndims=ndims), "netcdf_initialize_output nf90_inquire_variable" ) - select case(vartype) - case(NF90_INT) - call check( nf90_def_var_fill(nc%id, varid, NO_FILL, NF90_FILL_INT), "netcdf_initialize_output nf90_def_var_fill NF90_INT" ) - case(NF90_FLOAT) - call check( nf90_def_var_fill(nc%id, varid, NO_FILL, sfill), "netcdf_initialize_output nf90_def_var_fill NF90_FLOAT" ) - case(NF90_DOUBLE) - call check( nf90_def_var_fill(nc%id, varid, NO_FILL, dfill), "netcdf_initialize_output nf90_def_var_fill NF90_DOUBLE" ) - case(NF90_CHAR) - call check( nf90_def_var_fill(nc%id, varid, NO_FILL, 0), "netcdf_initialize_output nf90_def_var_fill NF90_CHAR" ) - end select - end do - - ! Set special fill mode for discard time so that we can make use of it for non-discarded bodies. - select case (vartype) - case(NF90_FLOAT) - call check( nf90_def_var_fill(nc%id, nc%discard_time_varid, NO_FILL, huge(1.0_SP)), "netcdf_initialize_output nf90_def_var_fill discard_time NF90_FLOAT" ) - case(NF90_DOUBLE) - call check( nf90_def_var_fill(nc%id, nc%discard_time_varid, NO_FILL, huge(1.0_DP)), "netcdf_initialize_output nf90_def_var_fill discard_time NF90_DOUBLE" ) - end select - - ! Take the file out of define mode - call check( nf90_enddef(nc%id), "netcdf_initialize_output nf90_enddef" ) - - ! Add in the space dimension coordinates - call check( nf90_put_var(nc%id, nc%space_varid, nc%space_coords, start=[1], count=[NDIM]), "netcdf_initialize_output nf90_put_var space" ) - - end associate - return - - 667 continue - write(*,*) "Error creating NetCDF output file. " // trim(adjustl(errmsg)) - call util_exit(FAILURE) - end subroutine netcdf_initialize_output - - - module subroutine netcdf_open(self, param, readonly) - !! author: Carlisle A. Wishard, Dana Singh, and David A. Minton - !! - !! Opens a NetCDF file and does the variable inquiries to activate variable ids - implicit none - ! Arguments - class(netcdf_parameters), intent(inout) :: self !! Parameters used to identify a particular NetCDF dataset - class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters - logical, optional, intent(in) :: readonly !! Logical flag indicating that this should be open read only - ! Internals - integer(I4B) :: mode, status - character(len=STRMAX) :: errmsg - - mode = NF90_WRITE - if (present(readonly)) then - if (readonly) mode = NF90_NOWRITE - end if - - associate(nc => self) - - write(errmsg,*) "netcdf_open nf90_open ",trim(adjustl(nc%file_name)) - call check( nf90_open(nc%file_name, mode, nc%id), errmsg) - - ! Dimensions - call check( nf90_inq_dimid(nc%id, nc%time_dimname, nc%time_dimid), "netcdf_open nf90_inq_dimid time_dimid" ) - call check( nf90_inq_dimid(nc%id, nc%space_dimname, nc%space_dimid), "netcdf_open nf90_inq_dimid space_dimid" ) - call check( nf90_inq_dimid(nc%id, nc%name_dimname, nc%name_dimid), "netcdf_open nf90_inq_dimid name_dimid" ) - call check( nf90_inq_dimid(nc%id, nc%str_dimname, nc%str_dimid), "netcdf_open nf90_inq_dimid str_dimid" ) - - ! Dimension coordinates - call check( nf90_inq_varid(nc%id, nc%time_dimname, nc%time_varid), "netcdf_open nf90_inq_varid time_varid" ) - call check( nf90_inq_varid(nc%id, nc%space_dimname, nc%space_varid), "netcdf_open nf90_inq_varid space_varid" ) - call check( nf90_inq_varid(nc%id, nc%name_dimname, nc%name_varid), "netcdf_open nf90_inq_varid name_varid" ) - - ! Required Variables - call check( nf90_inq_varid(nc%id, nc%id_varname, nc%id_varid), "netcdf_open nf90_inq_varid name_varid" ) - call check( nf90_inq_varid(nc%id, nc%gmass_varname, nc%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(nc%id, nc%rh_varname, nc%rh_varid), "netcdf_open nf90_inq_varid rh_varid" ) - call check( nf90_inq_varid(nc%id, nc%vh_varname, nc%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(nc%id, nc%gr_pseudo_vh_varname, nc%gr_pseudo_vh_varid) - nc%lpseudo_vel_exists = (status == nf90_noerr) - if (param%lrestart .and. .not.nc%lpseudo_vel_exists) then - write(*,*) "Warning! Pseudovelocity not found in input file for GR enabled run. If this is a restarted run, bit-identical trajectories are not guarunteed!" - end if - - end if - end if - - if ((param%out_form == "EL") .or. (param%out_form == "XVEL")) then - call check( nf90_inq_varid(nc%id, nc%a_varname, nc%a_varid), "netcdf_open nf90_inq_varid a_varid" ) - call check( nf90_inq_varid(nc%id, nc%e_varname, nc%e_varid), "netcdf_open nf90_inq_varid e_varid" ) - call check( nf90_inq_varid(nc%id, nc%inc_varname, nc%inc_varid), "netcdf_open nf90_inq_varid inc_varid" ) - call check( nf90_inq_varid(nc%id, nc%capom_varname, nc%capom_varid), "netcdf_open nf90_inq_varid capom_varid" ) - call check( nf90_inq_varid(nc%id, nc%omega_varname, nc%omega_varid), "netcdf_open nf90_inq_varid omega_varid" ) - call check( nf90_inq_varid(nc%id, nc%capm_varname, nc%capm_varid), "netcdf_open nf90_inq_varid capm_varid" ) - end if - - if (param%lclose) then - call check( nf90_inq_varid(nc%id, nc%radius_varname, nc%radius_varid), "netcdf_open nf90_inq_varid radius_varid" ) - end if - - if (param%lrotation) then - call check( nf90_inq_varid(nc%id, nc%Ip_varname, nc%Ip_varid), "netcdf_open nf90_inq_varid Ip_varid" ) - call check( nf90_inq_varid(nc%id, nc%rot_varname, nc%rot_varid), "netcdf_open nf90_inq_varid rot_varid" ) - end if - - ! if (param%ltides) then - ! call check( nf90_inq_varid(nc%id, nc%k2_varname, nc%k2_varid), "netcdf_open nf90_inq_varid k2_varid" ) - ! call check( nf90_inq_varid(nc%id, nc%q_varname, nc%Q_varid), "netcdf_open nf90_inq_varid Q_varid" ) - ! end if - - ! Optional Variables - if (param%lrhill_present) then - status = nf90_inq_varid(nc%id, nc%rhill_varname, nc%rhill_varid) - if (status /= nf90_noerr) write(*,*) "Warning! RHILL variable not set in input file. Calculating." - end if - - ! Optional variables The User Doesn't Need to Know About - status = nf90_inq_varid(nc%id, nc%npl_varname, nc%npl_varid) - status = nf90_inq_varid(nc%id, nc%ntp_varname, nc%ntp_varid) - status = nf90_inq_varid(nc%id, nc%j2rp2_varname, nc%j2rp2_varid) - status = nf90_inq_varid(nc%id, nc%j4rp4_varname, nc%j4rp4_varid) - status = nf90_inq_varid(nc%id, nc%ptype_varname, nc%ptype_varid) - status = nf90_inq_varid(nc%id, nc%varpi_varname, nc%varpi_varid) - status = nf90_inq_varid(nc%id, nc%lam_varname, nc%lam_varid) - status = nf90_inq_varid(nc%id, nc%f_varname, nc%f_varid) - status = nf90_inq_varid(nc%id, nc%cape_varname, nc%cape_varid) - - if (param%integrator == SYMBA) then - status = nf90_inq_varid(nc%id, nc%nplm_varname, nc%nplm_varid) - end if - - if (param%lclose) then - status = nf90_inq_varid(nc%id, nc%origin_type_varname, nc%origin_type_varid) - status = nf90_inq_varid(nc%id, nc%origin_time_varname, nc%origin_time_varid) - status = nf90_inq_varid(nc%id, nc%origin_rh_varname, nc%origin_rh_varid) - status = nf90_inq_varid(nc%id, nc%origin_vh_varname, nc%origin_vh_varid) - status = nf90_inq_varid(nc%id, nc%collision_id_varname, nc%collision_id_varid) - status = nf90_inq_varid(nc%id, nc%discard_time_varname, nc%discard_time_varid) - status = nf90_inq_varid(nc%id, nc%discard_rh_varname, nc%discard_rh_varid) - status = nf90_inq_varid(nc%id, nc%discard_vh_varname, nc%discard_vh_varid) - status = nf90_inq_varid(nc%id, nc%discard_body_id_varname, nc%discard_body_id_varid) - end if - - if (param%lenergy) then - status = nf90_inq_varid(nc%id, nc%ke_orb_varname, nc%KE_orb_varid) - status = nf90_inq_varid(nc%id, nc%ke_spin_varname, nc%KE_spin_varid) - status = nf90_inq_varid(nc%id, nc%pe_varname, nc%PE_varid) - status = nf90_inq_varid(nc%id, nc%L_orb_varname, nc%L_orb_varid) - status = nf90_inq_varid(nc%id, nc%Lspin_varname, nc%Lspin_varid) - status = nf90_inq_varid(nc%id, nc%L_escape_varname, nc%L_escape_varid) - status = nf90_inq_varid(nc%id, nc%Ecollisions_varname, nc%Ecollisions_varid) - status = nf90_inq_varid(nc%id, nc%Euntracked_varname, nc%Euntracked_varid) - status = nf90_inq_varid(nc%id, nc%GMescape_varname, nc%GMescape_varid) - end if - - end associate - - return - end subroutine netcdf_open - - - module function netcdf_read_frame_system(self, nc, param) result(ierr) - !! author: The Purdue Swiftest Team - David A. Minton, Carlisle A. Wishard, Jennifer L.L. Pouplin, and Jacob R. Elliott - !! - !! Read a frame (header plus records for each massive body and active test particle) from an output binary file - implicit none - ! Arguments - class(swiftest_nbody_system), intent(inout) :: self !! Swiftest system object - class(netcdf_parameters), intent(inout) :: nc !! Parameters used to identify a particular NetCDF dataset - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - ! Return - integer(I4B) :: ierr !! Error code: returns 0 if the read is successful - ! Internals - integer(I4B) :: i, tslot, idmax, npl_check, ntp_check, nplm_check, t_max, str_max, status - real(DP), dimension(:), allocatable :: rtemp - real(DP), dimension(:,:), allocatable :: vectemp - integer(I4B), dimension(:), allocatable :: itemp - logical, dimension(:), allocatable :: validmask, tpmask, plmask - - tslot = param%ioutput - - call nc%open(param, readonly=.true.) - call self%read_hdr(nc, param) - - associate(cb => self%cb, pl => self%pl, tp => self%tp, npl => self%pl%nbody, ntp => self%tp%nbody) - - call pl%setup(npl, param) - call tp%setup(ntp, param) - - call check( nf90_inquire_dimension(nc%id, nc%name_dimid, len=idmax), "netcdf_read_frame_system nf90_inquire_dimension name_dimid" ) - allocate(rtemp(idmax)) - allocate(vectemp(NDIM,idmax)) - allocate(itemp(idmax)) - allocate(validmask(idmax)) - allocate(tpmask(idmax)) - allocate(plmask(idmax)) - call check( nf90_inquire_dimension(nc%id, nc%time_dimid, len=t_max), "netcdf_read_frame_system nf90_inquire_dimension time_dimid" ) - call check( nf90_inquire_dimension(nc%id, nc%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(nc%id, nc%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(nc%id, nc%a_varid, rtemp(:), start=[1, tslot]), "netcdf_read_frame_system filter pass nf90_getvar a_varid" ) - validmask(:) = rtemp(:) == rtemp(:) - end if - - ! Next, filter only bodies that don't have mass (test particles) - call check( nf90_get_var(nc%id, nc%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 - - ! Check to make sure the number of bodies is correct - npl_check = count(plmask(:)) - ntp_check = count(tpmask(:)) - - if (npl_check /= npl) then - write(*,*) "Error reading in NetCDF file: The recorded value of npl does not match the number of active massive bodies" - call util_exit(failure) - end if - - if (ntp_check /= ntp) then - write(*,*) "Error reading in NetCDF file: The recorded value of ntp does not match the number of active test particles" - call util_exit(failure) - end if - - select type (pl) - class is (symba_pl) - select type (param) - class is (symba_parameters) - nplm_check = count(pack(rtemp,plmask) > param%GMTINY ) - if (nplm_check /= pl%nplm) then - write(*,*) "Error reading in NetCDF file: The recorded value of nplm does not match the number of active fully interacting massive bodies" - call util_exit(failure) - end if - end select - end select - - ! Now read in each variable and split the outputs by body type - if ((param%in_form == "XV") .or. (param%in_form == "XVEL")) then - call check( nf90_get_var(nc%id, nc%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 - - if (param%lgr .and. nc%lpseudo_vel_exists) then - call check( nf90_get_var(nc%id, nc%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(nc%id, nc%vh_varid, vectemp, start=[1, 1, tslot], count=[NDIM,idmax,1]), "netcdf_read_frame_system nf90_getvar vh_varid" ) - do i = 1, NDIM - if (npl > 0) pl%vh(i,:) = pack(vectemp(i,:), plmask(:)) - if (ntp > 0) tp%vh(i,:) = pack(vectemp(i,:), tpmask(:)) - end do - end if - end if - - if ((param%in_form == "EL") .or. (param%in_form == "XVEL")) then - call check( nf90_get_var(nc%id, nc%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(nc%id, nc%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(nc%id, nc%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(nc%id, nc%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(nc%id, nc%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(nc%id, nc%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)) - if (npl > 0) pl%capm(:) = pack(rtemp, plmask) - if (ntp > 0) tp%capm(:) = pack(rtemp, tpmask) - - end if - - call check( nf90_get_var(nc%id, nc%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 - - ! Set initial central body mass for Helio bookkeeping - select type(cb) - class is (symba_cb) - cb%GM0 = cb%Gmass - end select - - - if (npl > 0) then - pl%Gmass(:) = pack(rtemp, plmask) - pl%mass(:) = pl%Gmass(:) / param%GU - - if (param%lrhill_present) then - call check( nf90_get_var(nc%id, nc%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(nc%id, nc%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 - select type(cb) - class is (symba_cb) - cb%R0 = cb%radius - end select - if (npl > 0) pl%radius(:) = pack(rtemp, plmask) - else - cb%radius = param%rmin - if (npl > 0) pl%radius(:) = 0.0_DP - end if - - if (param%lrotation) then - call check( nf90_get_var(nc%id, nc%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(nc%id, nc%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) - class is (symba_cb) - cb%L0(:) = cb%Ip(3) * cb%GM0 * cb%R0**2 * cb%rot(:) - end select - end if - - ! if (param%ltides) then - ! call check( nf90_get_var(nc%id, nc%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(nc%id, nc%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(nc%id, nc%j2rp2_varname, nc%j2rp2_varid) - if (status == nf90_noerr) then - call check( nf90_get_var(nc%id, nc%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(nc%id, nc%j4rp4_varname, nc%j4rp4_varid) - if (status == nf90_noerr) then - call check( nf90_get_var(nc%id, nc%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(nc, param, plmask, tpmask) - - if (param%in_form == "EL") then - call pl%el2xv(cb) - call tp%el2xv(cb) - end if - ! if this is a GR-enabled run, check to see if we got the pseudovelocities in. Otherwise, we'll need to generate them. - if (param%lgr .and. .not.(nc%lpseudo_vel_exists)) then - call pl%set_mu(cb) - call tp%set_mu(cb) - call pl%v2pv(param) - call tp%v2pv(param) - end if - - end associate - - call nc%close() - - ierr = 0 - return - - 667 continue - write(*,*) "Error reading system frame in netcdf_read_frame_system" - - end function netcdf_read_frame_system - - - module subroutine netcdf_read_hdr_system(self, nc, param) - !! author: David A. Minton - !! - !! Reads header information (variables that change with time, but not particle id). - !! This subroutine significantly improves the output over the original binary file, allowing us to track energy, momentum, and other quantities that - !! previously were handled as separate output files. - implicit none - ! Arguments - class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nbody system object - class(netcdf_parameters), intent(inout) :: nc !! Parameters used to for writing a NetCDF dataset to file - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - ! Internals - integer(I4B) :: tslot, status, idmax - real(DP), dimension(:), allocatable :: gmtemp - logical, dimension(:), allocatable :: plmask, tpmask, plmmask - - - tslot = param%ioutput - call check( nf90_inquire_dimension(nc%id, nc%name_dimid, len=idmax), "netcdf_read_hdr_system nf90_inquire_dimension name_dimid" ) - call check( nf90_get_var(nc%id, nc%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(nc%id, nc%Gmass_varid, gmtemp, start=[1,1], count=[idmax,1]), "netcdf_read_hdr_system nf90_getvar Gmass_varid" ) - - plmask(:) = gmtemp(:) == gmtemp(:) - tpmask(:) = .not. plmask(:) - plmask(1) = .false. ! This is the central body - select type (param) - class is (symba_parameters) - plmmask(:) = plmask(:) - where(plmask(:)) - plmmask(:) = gmtemp(:) > param%GMTINY - endwhere - end select - - status = nf90_inq_varid(nc%id, nc%npl_varname, nc%npl_varid) - if (status == nf90_noerr) then - call check( nf90_get_var(nc%id, nc%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(nc%id, nc%ntp_varname, nc%ntp_varid) - if (status == nf90_noerr) then - call check( nf90_get_var(nc%id, nc%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(nc%id, nc%nplm_varname, nc%nplm_varid) - select type(pl => self%pl) - class is (symba_pl) - if (status == nf90_noerr) then - call check( nf90_get_var(nc%id, nc%nplm_varid, pl%nplm, start=[tslot]), "netcdf_read_hdr_system nf90_getvar nplm_varid" ) - else - pl%nplm = count(plmmask(:)) - end if - end select - end if - - if (param%lenergy) then - status = nf90_inq_varid(nc%id, nc%ke_orb_varname, nc%KE_orb_varid) - if (status == nf90_noerr) call check( nf90_get_var(nc%id, nc%KE_orb_varid, self%ke_orbit, start=[tslot]), "netcdf_read_hdr_system nf90_getvar KE_orb_varid" ) - status = nf90_inq_varid(nc%id, nc%ke_spin_varname, nc%KE_spin_varid) - if (status == nf90_noerr) call check( nf90_get_var(nc%id, nc%KE_spin_varid, self%ke_spin, start=[tslot]), "netcdf_read_hdr_system nf90_getvar KE_spin_varid" ) - status = nf90_inq_varid(nc%id, nc%pe_varname, nc%PE_varid) - if (status == nf90_noerr) call check( nf90_get_var(nc%id, nc%PE_varid, self%pe, start=[tslot]), "netcdf_read_hdr_system nf90_getvar PE_varid" ) - status = nf90_inq_varid(nc%id, nc%L_orb_varname, nc%L_orb_varid) - if (status == nf90_noerr) call check( nf90_get_var(nc%id, nc%L_orb_varid, self%Lorbit(:), start=[1,tslot], count=[NDIM,1]), "netcdf_read_hdr_system nf90_getvar L_orb_varid" ) - status = nf90_inq_varid(nc%id, nc%Lspin_varname, nc%Lspin_varid) - if (status == nf90_noerr) call check( nf90_get_var(nc%id, nc%Lspin_varid, self%Lspin(:), start=[1,tslot], count=[NDIM,1]), "netcdf_read_hdr_system nf90_getvar Lspin_varid" ) - status = nf90_inq_varid(nc%id, nc%L_escape_varname, nc%L_escape_varid) - if (status == nf90_noerr) call check( nf90_get_var(nc%id, nc%L_escape_varid, self%Lescape(:), start=[1, tslot], count=[NDIM,1]), "netcdf_read_hdr_system nf90_getvar L_escape_varid" ) - status = nf90_inq_varid(nc%id, nc%Ecollisions_varname, nc%Ecollisions_varid) - if (status == nf90_noerr) call check( nf90_get_var(nc%id, nc%Ecollisions_varid, self%Ecollisions, start=[tslot]), "netcdf_read_hdr_system nf90_getvar Ecollisions_varid" ) - status = nf90_inq_varid(nc%id, nc%Euntracked_varname, nc%Euntracked_varid) - if (status == nf90_noerr) call check( nf90_get_var(nc%id, nc%Euntracked_varid, self%Euntracked, start=[tslot]), "netcdf_read_hdr_system nf90_getvar Euntracked_varid" ) - status = nf90_inq_varid(nc%id, nc%GMescape_varname, nc%GMescape_varid) - if (status == nf90_noerr) call check( nf90_get_var(nc%id, nc%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, nc, param, plmask, tpmask) - !! author: Carlisle A. Wishard, Dana Singh, and David A. Minton - !! - !! Reads particle information metadata from file - implicit none - ! Arguments - class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nbody system object - class(netcdf_parameters), intent(inout) :: nc !! Parameters used to identify a particular NetCDF dataset - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - logical, dimension(:), intent(in) :: plmask !! Logical array indicating which index values belong to massive bodies - logical, dimension(:), intent(in) :: tpmask !! Logical array indicating which index values belong to test particles - ! Internals - integer(I4B) :: i, idmax, status - real(DP), dimension(:), allocatable :: rtemp - real(DP), dimension(:,:), allocatable :: vectemp - integer(I4B), dimension(:), allocatable :: itemp - character(len=NAMELEN), dimension(:), allocatable :: ctemp - integer(I4B), dimension(:), allocatable :: plind, tpind - - ! This string of spaces of length NAMELEN is used to clear out any old data left behind inside the string variables - idmax = size(plmask) - allocate(rtemp(idmax)) - allocate(vectemp(NDIM,idmax)) - allocate(itemp(idmax)) - allocate(ctemp(idmax)) - - associate(cb => self%cb, pl => self%pl, tp => self%tp, npl => self%pl%nbody, ntp => self%tp%nbody) - - if (npl > 0) then - pl%status(:) = ACTIVE - pl%lmask(:) = .true. - do i = 1, npl - call pl%info(i)%set_value(status="ACTIVE") - end do - allocate(plind(npl)) - plind(:) = pack([(i, i = 1, idmax)], plmask(:)) - end if - if (ntp > 0) then - tp%status(:) = ACTIVE - tp%lmask(:) = .true. - do i = 1, ntp - call tp%info(i)%set_value(status="ACTIVE") - end do - allocate(tpind(ntp)) - tpind(:) = pack([(i, i = 1, idmax)], tpmask(:)) - end if - - call check( nf90_get_var(nc%id, nc%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) - cb%id = 0 - pl%id(:) = pack([(i,i=0,idmax-1)],plmask) - tp%id(:) = pack([(i,i=0,idmax-1)],tpmask) - - call check( nf90_get_var(nc%id, nc%name_varid, ctemp, count=[NAMELEN, idmax]), "netcdf_read_particle_info_system nf90_getvar name_varid" ) - call cb%info%set_value(name=ctemp(1)) - do i = 1, npl - call pl%info(i)%set_value(name=ctemp(plind(i))) - end do - do i = 1, ntp - call tp%info(i)%set_value(name=ctemp(tpind(i))) - end do - - status = nf90_get_var(nc%id, nc%ptype_varid, ctemp, count=[NAMELEN, idmax]) - if (status /= nf90_noerr) then ! Set default particle types - call cb%info%set_value(particle_type=CB_TYPE_NAME) - - ! Handle semi-interacting bodies in SyMBA - 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 - - call cb%info%set_value(status="ACTIVE") - - if (param%lclose) then - - status = nf90_inq_varid(nc%id, nc%origin_type_varname, nc%origin_type_varid) - if (status == nf90_noerr) then - call check( nf90_get_var(nc%id, nc%origin_type_varid, ctemp, count=[NAMELEN, idmax]), "netcdf_read_particle_info_system nf90_getvar origin_type_varid" ) - else - ctemp = "Initial Conditions" - end if - - call cb%info%set_value(origin_type=ctemp(1)) - do i = 1, npl - call pl%info(i)%set_value(origin_type=ctemp(plind(i))) - end do - do i = 1, ntp - call tp%info(i)%set_value(origin_type=ctemp(tpind(i))) - end do - - status = nf90_inq_varid(nc%id, nc%origin_time_varname, nc%origin_time_varid) - if (status == nf90_noerr) then - call check( nf90_get_var(nc%id, nc%origin_time_varid, rtemp), "netcdf_read_particle_info_system nf90_getvar origin_time_varid" ) - else - rtemp = param%t0 - end if - - call cb%info%set_value(origin_time=rtemp(1)) - do i = 1, npl - call pl%info(i)%set_value(origin_time=rtemp(plind(i))) - end do - do i = 1, ntp - call tp%info(i)%set_value(origin_time=rtemp(tpind(i))) - end do - - status = nf90_inq_varid(nc%id, nc%origin_rh_varname, nc%origin_rh_varid) - if (status == nf90_noerr) then - call check( nf90_get_var(nc%id, nc%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(nc%id, nc%rh_varid, vectemp(:,:)), "netcdf_read_particle_info_system nf90_getvar rh_varid" ) - else - vectemp(:,:) = 0._DP - end if - - do i = 1, npl - call pl%info(i)%set_value(origin_rh=vectemp(:,plind(i))) - end do - do i = 1, ntp - call tp%info(i)%set_value(origin_rh=vectemp(:,tpind(i))) - end do - - status = nf90_inq_varid(nc%id, nc%origin_vh_varname, nc%origin_vh_varid) - if (status == nf90_noerr) then - call check( nf90_get_var(nc%id, nc%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(nc%id, nc%vh_varid, vectemp(:,:)), "netcdf_read_particle_info_system nf90_getvar vh_varid" ) - else - vectemp(:,:) = 0._DP - end if - - do i = 1, npl - call pl%info(i)%set_value(origin_vh=vectemp(:,plind(i))) - end do - do i = 1, ntp - call tp%info(i)%set_value(origin_vh=vectemp(:,tpind(i))) - end do - - status = nf90_inq_varid(nc%id, nc%collision_id_varname, nc%collision_id_varid) - if (status == nf90_noerr) then - call check( nf90_get_var(nc%id, nc%collision_id_varid, itemp), "netcdf_read_particle_info_system nf90_getvar collision_id_varid" ) - else - itemp = 0 - end if - - do i = 1, npl - call pl%info(i)%set_value(collision_id=itemp(plind(i))) - end do - do i = 1, ntp - call tp%info(i)%set_value(collision_id=itemp(tpind(i))) - end do - - status = nf90_inq_varid(nc%id, nc%discard_time_varname, nc%discard_time_varid) - if (status == nf90_noerr) then - call check( nf90_get_var(nc%id, nc%discard_time_varid, rtemp), "netcdf_read_particle_info_system nf90_getvar discard_time_varid" ) - else - select case (param%out_type) - case("NETCDF_FLOAT") - rtemp(:) = huge(0.0_SP) - case("NETCDF_DOUBLE") - rtemp(:) = huge(0.0_DP) - end select - end if - - call cb%info%set_value(discard_time=rtemp(1)) - do i = 1, npl - call pl%info(i)%set_value(discard_time=rtemp(plind(i))) - end do - do i = 1, ntp - call tp%info(i)%set_value(discard_time=rtemp(tpind(i))) - end do - - status = nf90_inq_varid(nc%id, nc%discard_rh_varname, nc%discard_rh_varid) - if (status == nf90_noerr) then - call check( nf90_get_var(nc%id, nc%discard_rh_varid, vectemp(:,:)), "netcdf_read_particle_info_system nf90_getvar discard_rh_varid" ) - else - vectemp(:,:) = 0.0_DP - end if - - do i = 1, npl - call pl%info(i)%set_value(discard_rh=vectemp(:,plind(i))) - end do - do i = 1, ntp - call tp%info(i)%set_value(discard_rh=vectemp(:,tpind(i))) - end do - - status = nf90_inq_varid(nc%id, nc%discard_vh_varname, nc%discard_vh_varid) - if (status == nf90_noerr) then - call check( nf90_get_var(nc%id, nc%discard_vh_varid, vectemp(:,:)), "netcdf_read_particle_info_system nf90_getvar discard_vh_varid" ) - else - vectemp(:,:) = 0.0_DP - end if - - do i = 1, npl - call pl%info(i)%set_value(discard_vh=vectemp(:,plind(i))) - end do - do i = 1, ntp - call tp%info(i)%set_value(discard_vh=vectemp(:,tpind(i))) - end do - end if - - end associate - - return - end subroutine netcdf_read_particle_info_system - - - module subroutine netcdf_sync(self) - !! author: David A. Minton - !! - !! Syncrhonize the disk and memory buffer of the NetCDF file (e.g. commit the frame files stored in memory to disk) - !! - implicit none - ! Arguments - class(netcdf_parameters), intent(inout) :: self !! Parameters used to identify a particular NetCDF dataset - - call check( nf90_sync(self%id), "netcdf_sync nf90_sync" ) - - return - end subroutine netcdf_sync - - - module subroutine netcdf_write_frame_base(self, nc, param) - !! author: Carlisle A. Wishard, Dana Singh, and David A. Minton - !! - !! Write a frame of output of either test particle or massive body data to the binary output file - !! Note: If outputting to orbital elements, but sure that the conversion is done prior to calling this method - implicit none - ! Arguments - class(swiftest_base), intent(in) :: self !! Swiftest particle object - class(netcdf_parameters), intent(inout) :: nc !! Parameters used to identify a particular NetCDF dataset - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - ! Internals - integer(I4B) :: i, j, tslot, idslot, old_mode - integer(I4B), dimension(:), allocatable :: ind - real(DP), dimension(NDIM) :: vh !! Temporary variable to store heliocentric velocity values when converting from pseudovelocity in GR-enabled runs - real(DP) :: a, e, inc, omega, capom, capm, varpi, lam, f, cape, capf - - tslot = param%ioutput - - call self%write_info(nc, param) - - call check( nf90_set_fill(nc%id, nf90_nofill, old_mode), "netcdf_write_frame_base nf90_set_fill" ) - select type(self) - class is (swiftest_body) - associate(n => self%nbody) - if (n == 0) return - - call util_sort(self%id(1:n), ind) - - do i = 1, n - j = ind(i) - idslot = self%id(j) + 1 - - !! Convert from pseudovelocity to heliocentric without replacing the current value of pseudovelocity - if (param%lgr) call gr_pseudovel2vel(param, self%mu(j), self%rh(:, j), self%vh(:, j), vh(:)) - - if ((param%out_form == "XV") .or. (param%out_form == "XVEL")) then - call check( nf90_put_var(nc%id, nc%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(nc%id, nc%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(nc%id, nc%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(nc%id, nc%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%rh(1,j), self%rh(2,j), self%rh(3,j), & - vh(1), vh(2), vh(3), & - a, e, inc, capom, omega, capm, varpi, lam, f, cape, capf) - else !! For non-GR runs just convert from the velocity we have - call orbel_xv2el(self%mu(j), self%rh(1,j), self%rh(2,j), self%rh(3,j), & - self%vh(1,j), self%vh(2,j), self%vh(3,j), & - a, e, inc, capom, omega, capm, varpi, lam, f, cape, capf) - end if - call check( nf90_put_var(nc%id, nc%a_varid, a, start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var body a_varid" ) - call check( nf90_put_var(nc%id, nc%e_varid, e, start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var body e_varid" ) - call check( nf90_put_var(nc%id, nc%inc_varid, inc * RAD2DEG, start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var body inc_varid" ) - call check( nf90_put_var(nc%id, nc%capom_varid, capom * RAD2DEG, start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var body capom_varid" ) - call check( nf90_put_var(nc%id, nc%omega_varid, omega * RAD2DEG, start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var body omega_varid" ) - call check( nf90_put_var(nc%id, nc%capm_varid, capm * RAD2DEG, start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var body capm_varid" ) - call check( nf90_put_var(nc%id, nc%varpi_varid, varpi * RAD2DEG, start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var body varpi_varid" ) - call check( nf90_put_var(nc%id, nc%lam_varid, lam * RAD2DEG, start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var body lam_varid" ) - call check( nf90_put_var(nc%id, nc%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(nc%id, nc%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(nc%id, nc%cape_varid, capf * RAD2DEG, start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var body (capf) cape_varid" ) - end if - end if - - select type(self) - class is (swiftest_pl) ! Additional output if the passed polymorphic object is a massive body - call check( nf90_put_var(nc%id, nc%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(nc%id, nc%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(nc%id, nc%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(nc%id, nc%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(nc%id, nc%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(nc%id, nc%k2_varid, self%k2(j), start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var body k2_varid" ) - ! call check( nf90_put_var(nc%id, nc%Q_varid, self%Q(j), start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var body Q_varid" ) - ! end if - - end select - end do - end associate - class is (swiftest_cb) - idslot = self%id + 1 - call check( nf90_put_var(nc%id, nc%id_varid, self%id, start=[idslot]), "netcdf_write_frame_base nf90_put_var cb id_varid" ) - - call check( nf90_put_var(nc%id, nc%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(nc%id, nc%radius_varid, self%radius, start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var cb radius_varid" ) - call check( nf90_put_var(nc%id, nc%j2rp2_varid, self%j2rp2, start=[tslot]), "netcdf_write_frame_base nf90_put_var cb j2rp2_varid" ) - call check( nf90_put_var(nc%id, nc%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(nc%id, nc%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(nc%id, nc%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(nc%id, nc%k2_varid, self%k2, start=[idslot, tslot]), "netcdf_write_frame_base nf90_put_var cb k2_varid" ) - ! call check( nf90_put_var(nc%id, nc%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(nc%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, nc, param) - !! author: The Purdue Swiftest Team - David A. Minton, Carlisle A. Wishard, Jennifer L.L. Pouplin, and Jacob R. Elliott - !! - !! Write a frame (header plus records for each massive body and active test particle) to a output binary file - implicit none - ! Arguments - class(swiftest_nbody_system), intent(inout) :: self !! Swiftest system object - class(netcdf_parameters), intent(inout) :: nc !! Parameters used to identify a particular NetCDF dataset - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - - call self%write_hdr(nc, param) - call self%cb%write_frame(nc, param) - call self%pl%write_frame(nc, param) - call self%tp%write_frame(nc, param) - - return - end subroutine netcdf_write_frame_system - - - module subroutine netcdf_write_info_base(self, nc, 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) :: nc !! Parameters used to identify a particular NetCDF dataset - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - ! Internals - integer(I4B) :: i, j, idslot, old_mode - integer(I4B), dimension(:), allocatable :: ind - character(len=:), allocatable :: charstring - - ! This string of spaces of length NAMELEN is used to clear out any old data left behind inside the string variables - call check( nf90_set_fill(nc%id, nf90_nofill, old_mode), "netcdf_write_info_base nf90_set_fill nf90_nofill" ) - - select type(self) - class is (swiftest_body) - associate(n => self%nbody) - if (n == 0) return - call util_sort(self%id(1:n), ind) - - do i = 1, n - j = ind(i) - idslot = self%id(j) + 1 - call check( nf90_put_var(nc%id, nc%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(nc%id, nc%name_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "netcdf_write_info_base nf90_put_var name_varid" ) - - charstring = trim(adjustl(self%info(j)%particle_type)) - call check( nf90_put_var(nc%id, nc%ptype_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "netcdf_write_info_base nf90_put_var particle_type_varid" ) - - if (param%lclose) then - charstring = trim(adjustl(self%info(j)%origin_type)) - call check( nf90_put_var(nc%id, nc%origin_type_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "netcdf_write_info_base nf90_put_var origin_type_varid" ) - call check( nf90_put_var(nc%id, nc%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(nc%id, nc%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(nc%id, nc%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(nc%id, nc%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(nc%id, nc%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(nc%id, nc%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(nc%id, nc%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 - end associate - - class is (swiftest_cb) - idslot = self%id + 1 - call check( nf90_put_var(nc%id, nc%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(nc%id, nc%name_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "netcdf_write_info_base nf90_put_var cb name_varid" ) - - charstring = trim(adjustl(self%info%particle_type)) - call check( nf90_put_var(nc%id, nc%ptype_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "netcdf_write_info_base nf90_put_var cb ptype_varid" ) - - if (param%lclose) then - charstring = trim(adjustl(self%info%origin_type)) - call check( nf90_put_var(nc%id, nc%origin_type_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "netcdf_write_info_base nf90_put_var cb origin_type_varid" ) - - call check( nf90_put_var(nc%id, nc%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(nc%id, nc%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(nc%id, nc%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(nc%id, nc%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(nc%id, nc%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(nc%id, nc%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(nc%id, nc%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(nc%id, old_mode, old_mode) ) - return - end subroutine netcdf_write_info_base - - - module subroutine netcdf_write_hdr_system(self, nc, param) - !! author: David A. Minton - !! - !! Writes header information (variables that change with time, but not particle id). - !! This subroutine significantly improves the output over the original binary file, allowing us to track energy, momentum, and other quantities that - !! previously were handled as separate output files. - implicit none - ! Arguments - class(swiftest_nbody_system), intent(in) :: self !! Swiftest nbody system object - class(netcdf_parameters), intent(inout) :: nc !! Parameters used to for writing a NetCDF dataset to file - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - ! Internals - integer(I4B) :: tslot - - tslot = param%ioutput - - call check( nf90_put_var(nc%id, nc%time_varid, self%t, start=[tslot]), "netcdf_write_hdr_system nf90_put_var time_varid" ) - call check( nf90_put_var(nc%id, nc%npl_varid, self%pl%nbody, start=[tslot]), "netcdf_write_hdr_system nf90_put_var npl_varid" ) - call check( nf90_put_var(nc%id, nc%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(nc%id, nc%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(nc%id, nc%KE_orb_varid, self%ke_orbit, start=[tslot]), "netcdf_write_hdr_system nf90_put_var KE_orb_varid" ) - call check( nf90_put_var(nc%id, nc%KE_spin_varid, self%ke_spin, start=[tslot]), "netcdf_write_hdr_system nf90_put_var KE_spin_varid" ) - call check( nf90_put_var(nc%id, nc%PE_varid, self%pe, start=[tslot]), "netcdf_write_hdr_system nf90_put_var PE_varid" ) - call check( nf90_put_var(nc%id, nc%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(nc%id, nc%Lspin_varid, self%Lspin(:), start=[1,tslot], count=[NDIM,1]), "netcdf_write_hdr_system nf90_put_var Lspin_varid" ) - call check( nf90_put_var(nc%id, nc%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(nc%id, nc%Ecollisions_varid, self%Ecollisions, start=[tslot]), "netcdf_write_hdr_system nf90_put_var Ecollisions_varid" ) - call check( nf90_put_var(nc%id, nc%Euntracked_varid, self%Euntracked, start=[tslot]), "netcdf_write_hdr_system nf90_put_var Euntracked_varid" ) - call check( nf90_put_var(nc%id, nc%GMescape_varid, self%GMescape, start=[tslot]), "netcdf_write_hdr_system nf90_put_var GMescape_varid" ) - end if - - return - end subroutine netcdf_write_hdr_system - -end submodule s_netcdf diff --git a/src/operators/operator_cross.f90 b/src/operators/operator_cross.f90 index 2a9af1ecf..cec60d23b 100644 --- a/src/operators/operator_cross.f90 +++ b/src/operators/operator_cross.f90 @@ -7,7 +7,7 @@ !! You should have received a copy of the GNU General Public License along with Swiftest. !! If not, see: https://www.gnu.org/licenses. -submodule(swiftest_operators) s_operator_cross +submodule(operators) s_operator_cross use swiftest !! author: David A. Minton !! diff --git a/src/operators/operator_mag.f90 b/src/operators/operator_mag.f90 index 2cf9e643c..cdbd2b773 100644 --- a/src/operators/operator_mag.f90 +++ b/src/operators/operator_mag.f90 @@ -7,7 +7,7 @@ !! You should have received a copy of the GNU General Public License along with Swiftest. !! If not, see: https://www.gnu.org/licenses. -submodule(swiftest_operators) s_operator_mag +submodule(operators) s_operator_mag !! author: David A. Minton !! !! Contains implementations for the .mag. operator for all defined real types diff --git a/src/operators/operator_unit.f90 b/src/operators/operator_unit.f90 index 8ba5d89e5..2b75e3851 100644 --- a/src/operators/operator_unit.f90 +++ b/src/operators/operator_unit.f90 @@ -7,7 +7,7 @@ !! You should have received a copy of the GNU General Public License along with Swiftest. !! If not, see: https://www.gnu.org/licenses. -submodule(swiftest_operators) s_operator_unit +submodule(operators) s_operator_unit !! author: David A. Minton !! !! Contains implementations for the .unit. operator for all defined real types diff --git a/src/rmvs/rmvs_discard.f90 b/src/rmvs/rmvs_discard.f90 index 1b3a58ddc..06086444c 100644 --- a/src/rmvs/rmvs_discard.f90 +++ b/src/rmvs/rmvs_discard.f90 @@ -7,7 +7,7 @@ !! You should have received a copy of the GNU General Public License along with Swiftest. !! If not, see: https://www.gnu.org/licenses. -submodule(rmvs_classes) s_rmvs_discard +submodule(rmvs) s_rmvs_discard use swiftest contains diff --git a/src/rmvs/rmvs_encounter_check.f90 b/src/rmvs/rmvs_encounter_check.f90 index be0c8ba62..664821272 100644 --- a/src/rmvs/rmvs_encounter_check.f90 +++ b/src/rmvs/rmvs_encounter_check.f90 @@ -7,7 +7,7 @@ !! You should have received a copy of the GNU General Public License along with Swiftest. !! If not, see: https://www.gnu.org/licenses. -submodule (rmvs_classes) s_rmvs_chk +submodule (rmvs) s_rmvs_chk use swiftest contains diff --git a/src/rmvs/rmvs_kick.f90 b/src/rmvs/rmvs_kick.f90 index 88b71d0a9..2f36bbb81 100644 --- a/src/rmvs/rmvs_kick.f90 +++ b/src/rmvs/rmvs_kick.f90 @@ -7,7 +7,7 @@ !! You should have received a copy of the GNU General Public License along with Swiftest. !! If not, see: https://www.gnu.org/licenses. -submodule(rmvs_classes) s_rmvs_kick +submodule(rmvs) s_rmvs_kick use swiftest contains diff --git a/src/rmvs/rmvs_setup.f90 b/src/rmvs/rmvs_setup.f90 index 9c0b88876..aeea42dfa 100644 --- a/src/rmvs/rmvs_setup.f90 +++ b/src/rmvs/rmvs_setup.f90 @@ -7,7 +7,7 @@ !! You should have received a copy of the GNU General Public License along with Swiftest. !! If not, see: https://www.gnu.org/licenses. -submodule(rmvs_classes) s_rmvs_setup +submodule(rmvs) s_rmvs_setup use swiftest contains diff --git a/src/rmvs/rmvs_step.f90 b/src/rmvs/rmvs_step.f90 index ab39e6f31..7c602a20b 100644 --- a/src/rmvs/rmvs_step.f90 +++ b/src/rmvs/rmvs_step.f90 @@ -7,7 +7,7 @@ !! You should have received a copy of the GNU General Public License along with Swiftest. !! If not, see: https://www.gnu.org/licenses. -submodule(rmvs_classes) s_rmvs_step +submodule(rmvs) s_rmvs_step use swiftest contains @@ -26,7 +26,7 @@ module subroutine rmvs_step_system(self, param, t, dt) real(DP), intent(in) :: dt !! Current stepsiz ! Internals logical :: lencounter, lfirstpl - real(DP), dimension(:,:), allocatable :: rbeg, xend, vbeg + real(DP), dimension(:,:), allocatable :: rbeg, rend, vbeg if (self%tp%nbody == 0) then call whm_step_system(self, param, t, dt) @@ -54,7 +54,7 @@ module subroutine rmvs_step_system(self, param, t, dt) call rmvs_interp_out(cb, pl, dt) call rmvs_step_out(cb, pl, tp, system, param, t, dt) tp%lmask(1:ntp) = .not. tp%lmask(1:ntp) - call pl%set_beg_end(rbeg = rbeg, xend = xend) + call pl%set_beg_end(rbeg = rbeg, rend = rend) tp%lfirst = .true. call tp%step(system, param, t, dt) tp%lmask(1:ntp) = .true. @@ -106,7 +106,7 @@ subroutine rmvs_interp_out(cb, pl, dt) xtmp(:,1:npl) = pl%outer(0)%x(:, 1:npl) vtmp(:,1:npl) = pl%outer(0)%v(:, 1:npl) do outer_index = 1, NTENC - 1 - call drift_one(GMcb(1:npl), xtmp(1,1:npl), xtmp(2,1:npl), xtmp(3,1:npl), & + call swiftest_drift_one(GMcb(1:npl), xtmp(1,1:npl), xtmp(2,1:npl), xtmp(3,1:npl), & vtmp(1,1:npl), vtmp(2,1:npl), vtmp(3,1:npl), & dto(1:npl), iflag(1:npl)) if (any(iflag(1:npl) /= 0)) then @@ -128,7 +128,7 @@ subroutine rmvs_interp_out(cb, pl, dt) xtmp(:, 1:npl) = pl%outer(NTENC)%x(:, 1:npl) vtmp(:, 1:npl) = pl%outer(NTENC)%v(:, 1:npl) do outer_index = NTENC - 1, 1, -1 - call drift_one(GMcb(1:npl), xtmp(1,1:npl), xtmp(2,1:npl), xtmp(3,1:npl), & + call swiftest_drift_one(GMcb(1:npl), xtmp(1,1:npl), xtmp(2,1:npl), xtmp(3,1:npl), & vtmp(1,1:npl), vtmp(2,1:npl), vtmp(3,1:npl), & -dto(1:npl), iflag(1:npl)) if (any(iflag(1:npl) /= 0)) then @@ -187,7 +187,7 @@ subroutine rmvs_step_out(cb, pl, tp, system, param, t, dt) outer_time = t + (outer_index - 1) * dto call pl%set_beg_end(rbeg = pl%outer(outer_index - 1)%x(:, 1:npl), & vbeg = pl%outer(outer_index - 1)%v(:, 1:npl), & - xend = pl%outer(outer_index )%x(:, 1:npl)) + rend = pl%outer(outer_index )%x(:, 1:npl)) lencounter = tp%encounter_check(param, system, dto) if (lencounter) then ! Interpolate planets in inner encounter region @@ -273,7 +273,7 @@ subroutine rmvs_interp_in(cb, pl, system, param, dt, outer_index) ! end if do inner_index = 1, NTPHENC - 1 - call drift_one(GMcb(1:npl), xtmp(1,1:npl), xtmp(2,1:npl), xtmp(3,1:npl), & + call swiftest_drift_one(GMcb(1:npl), xtmp(1,1:npl), xtmp(2,1:npl), xtmp(3,1:npl), & vtmp(1,1:npl), vtmp(2,1:npl), vtmp(3,1:npl), & dti(1:npl), iflag(1:npl)) if (any(iflag(1:npl) /= 0)) then @@ -297,7 +297,7 @@ subroutine rmvs_interp_in(cb, pl, system, param, dt, outer_index) vtmp(:, 1:npl) = pl%inner(NTPHENC)%v(:, 1:npl) do inner_index = NTPHENC - 1, 1, -1 - call drift_one(GMcb(1:npl), xtmp(1,1:npl), xtmp(2,1:npl), xtmp(3,1:npl), & + call swiftest_drift_one(GMcb(1:npl), xtmp(1,1:npl), xtmp(2,1:npl), xtmp(3,1:npl), & vtmp(1,1:npl), vtmp(2,1:npl), vtmp(3,1:npl), & -dti(1:npl), iflag(1:npl)) if (any(iflag(1:npl) /= 0)) then @@ -390,7 +390,7 @@ subroutine rmvs_step_in(cb, pl, tp, param, outer_time, dto) do inner_index = 1, NTPHENC ! Integrate over the encounter region, using the "substitute" planetocentric systems at each level plenci%rh(:, 1:npl) = plenci%inner(inner_index - 1)%x(:, 1:npl) call plenci%set_beg_end(rbeg = plenci%inner(inner_index - 1)%x, & - xend = plenci%inner(inner_index)%x) + rend = plenci%inner(inner_index)%x) if (param%loblatecb) then cbenci%aoblbeg = cbenci%inner(inner_index - 1)%aobl(:, 1) @@ -557,7 +557,7 @@ subroutine rmvs_peri_tp(tp, pl, t, dt, lfirst, inner_index, ipleP, param) if (tp%isperi(i) == -1) then if (vdotr >= 0.0_DP) then tp%isperi(i) = 0 - call orbel_xv2aqt(mu, xpc(1,i), xpc(2,i), xpc(3,i), vpc(1,i), vpc(2,i), vpc(3,i), & + call swiftest_orbel_xv2aqt(mu, xpc(1,i), xpc(2,i), xpc(3,i), vpc(1,i), vpc(2,i), vpc(3,i), & a, peri, capm, tperi) r2 = dot_product(xpc(:, i), xpc(:, i)) if ((abs(tperi) > FACQDT * dt) .or. (r2 > rhill2)) peri = sqrt(r2) diff --git a/src/rmvs/rmvs_util.f90 b/src/rmvs/rmvs_util.f90 index b62c3ad88..a844507dc 100644 --- a/src/rmvs/rmvs_util.f90 +++ b/src/rmvs/rmvs_util.f90 @@ -7,7 +7,7 @@ !! You should have received a copy of the GNU General Public License along with Swiftest. !! If not, see: https://www.gnu.org/licenses. -submodule(rmvs_classes) s_rmvs_util +submodule(rmvs) s_rmvs_util use swiftest contains diff --git a/src/discard/discard.f90 b/src/swiftest_procedures/swiftest_discard.f90 similarity index 95% rename from src/discard/discard.f90 rename to src/swiftest_procedures/swiftest_discard.f90 index fc5160fd7..35a8cb755 100644 --- a/src/discard/discard.f90 +++ b/src/swiftest_procedures/swiftest_discard.f90 @@ -7,11 +7,10 @@ !! You should have received a copy of the GNU General Public License along with Swiftest. !! If not, see: https://www.gnu.org/licenses. -submodule (swiftest_classes) s_discard - use swiftest +submodule (swiftest) s_discard contains - module subroutine discard_system(self, param) + module subroutine swiftest_discard_system(self, param) !! author: David A. Minton !! !! Calls the discard methods for each body class and then the write method if any discards were detected @@ -47,10 +46,10 @@ module subroutine discard_system(self, param) end associate return - end subroutine discard_system + end subroutine swiftest_discard_system - module subroutine discard_pl(self, system, param) + module subroutine swiftest_discard_pl(self, system, param) !! author: David A. Minton !! !! Placeholder method for discarding massive bodies. This method does nothing except to ensure that the discard flag is set to false. @@ -65,10 +64,10 @@ module subroutine discard_pl(self, system, param) self%ldiscard(1:self%nbody) = .false. return - end subroutine discard_pl + end subroutine swiftest_discard_pl - module subroutine discard_tp(self, system, param) + module subroutine swiftest_discard_tp(self, system, param) !! author: David A. Minton !! !! Check to see if particles should be discarded based on their positions relative to the massive bodies @@ -104,10 +103,10 @@ module subroutine discard_tp(self, system, param) end associate return - end subroutine discard_tp + end subroutine swiftest_discard_tp - subroutine discard_cb_tp(tp, system, param) + subroutine swiftest_discard_cb_tp(tp, system, param) !! author: David A. Minton !! !! Check to see if test particles should be discarded based on their positions relative to the Sun @@ -173,10 +172,10 @@ subroutine discard_cb_tp(tp, system, param) end associate return - end subroutine discard_cb_tp + end subroutine swiftest_discard_cb_tp - subroutine discard_peri_tp(tp, system, param) + subroutine swiftest_discard_peri_tp(tp, system, param) !! author: David A. Minton !! !! Check to see if a test particle should be discarded because its perihelion distance becomes too small @@ -225,10 +224,10 @@ subroutine discard_peri_tp(tp, system, param) end associate return - end subroutine discard_peri_tp + end subroutine swiftest_discard_peri_tp - subroutine discard_pl_tp(tp, system, param) + subroutine swiftest_discard_pl_tp(tp, system, param) !! author: David A. Minton !! !! Check to see if test particles should be discarded based on their positions relative to the massive bodies @@ -275,10 +274,10 @@ subroutine discard_pl_tp(tp, system, param) end associate return - end subroutine discard_pl_tp + end subroutine swiftest_discard_pl_tp - subroutine discard_pl_close(dx, dv, dt, r2crit, iflag, r2min) + subroutine swiftest_discard_pl_close(dx, dv, dt, r2crit, iflag, r2min) !! author: David A. Minton !! !! Check to see if a test particle and massive body are having, or will have within the next time step, an encounter such @@ -320,6 +319,6 @@ subroutine discard_pl_close(dx, dv, dt, r2crit, iflag, r2min) end if return - end subroutine discard_pl_close + end subroutine swiftest_discard_pl_close end submodule s_discard diff --git a/src/drift/drift.f90 b/src/swiftest_procedures/swiftest_drift.f90 similarity index 88% rename from src/drift/drift.f90 rename to src/swiftest_procedures/swiftest_drift.f90 index 7c7c2bdba..23ea00ee5 100644 --- a/src/drift/drift.f90 +++ b/src/swiftest_procedures/swiftest_drift.f90 @@ -7,8 +7,7 @@ !! You should have received a copy of the GNU General Public License along with Swiftest. !! If not, see: https://www.gnu.org/licenses. -submodule (swiftest_classes) drift_implementation - use swiftest +submodule (swiftest) s_drift !> Integration control parameters: real(DP), parameter :: E2MAX = 0.36_DP real(DP), parameter :: DM2MAX = 0.16_DP @@ -19,7 +18,7 @@ contains - module subroutine drift_body(self, system, param, dt) + module subroutine swiftest_drift_body(self, system, param, dt) !! author: David A. Minton !! !! Loop bodies and call Danby drift routine on the heliocentric position and velocities. @@ -39,7 +38,7 @@ module subroutine drift_body(self, system, param, dt) associate(n => self%nbody) allocate(iflag(n)) iflag(:) = 0 - call drift_all(self%mu, self%rh, self%vh, self%nbody, param, dt, self%lmask, iflag) + call swiftest_drift_all(self%mu, self%rh, self%vh, self%nbody, param, dt, self%lmask, iflag) if (any(iflag(1:n) /= 0)) then where(iflag(1:n) /= 0) self%status(1:n) = DISCARDED_DRIFTERR do i = 1, n @@ -51,10 +50,10 @@ module subroutine drift_body(self, system, param, dt) deallocate(iflag) return - end subroutine drift_body + end subroutine swiftest_drift_body - module subroutine drift_all(mu, x, v, n, param, dt, lmask, iflag) + module subroutine swiftest_drift_all(mu, x, v, n, param, dt, lmask, iflag) !! author: David A. Minton !! !! Loop bodies and call Danby drift routine on all bodies for the given position and velocity vector. @@ -91,17 +90,17 @@ module subroutine drift_all(mu, x, v, n, param, dt, lmask, iflag) !!$omp simd ! SIMD does not yet work do i = 1, n - if (lmask(i)) call drift_one(mu(i), x(1,i), x(2,i), x(3,i), v(1,i), v(2,i), v(3,i), dtp(i), iflag(i)) + if (lmask(i)) call swiftest_drift_one(mu(i), x(1,i), x(2,i), x(3,i), v(1,i), v(2,i), v(3,i), dtp(i), iflag(i)) end do !!$omp end simd deallocate(dtp) return - end subroutine drift_all + end subroutine swiftest_drift_all - pure elemental module subroutine drift_one(mu, px, py, pz, vx, vy, vz, dt, iflag) + pure elemental module subroutine swiftest_drift_one(mu, px, py, pz, vx, vy, vz, dt, iflag) !! author: The Purdue Swiftest Team - David A. Minton, Carlisle A. Wishard, Jennifer L.L. Pouplin, and Jacob R. Elliott !! !! Perform Danby drift for one body, redoing drift with smaller substeps if original accuracy is insufficient @@ -118,20 +117,20 @@ pure elemental module subroutine drift_one(mu, px, py, pz, vx, vy, vz, dt, iflag integer(I4B) :: i real(DP) :: dttmp - call drift_dan(mu, px, py, pz, vx, vy, vz, dt, iflag) + call swiftest_drift_dan(mu, px, py, pz, vx, vy, vz, dt, iflag) if (iflag /= 0) then dttmp = 0.1_DP * dt do i = 1, 10 - call drift_dan(mu, px, py, pz, vx, vy, vz, dttmp, iflag) + call swiftest_drift_dan(mu, px, py, pz, vx, vy, vz, dttmp, iflag) if (iflag /= 0) exit end do end if - + return - end subroutine drift_one + end subroutine swiftest_drift_one - pure subroutine drift_dan(mu, px0, py0, pz0, vx0, vy0, vz0, dt0, iflag) + pure subroutine swiftest_drift_dan(mu, px0, py0, pz0, vx0, vy0, vz0, dt0, iflag) !! author: David A. Minton !! !! Perform Kepler drift, solving Kepler's equation in appropriate variables @@ -169,7 +168,7 @@ pure subroutine drift_dan(mu, px0, py0, pz0, vx0, vy0, vz0, dt0, iflag) dm = dt * en - int(dt * en / TWOPI, kind = I4B) * TWOPI dt = dm / en if ((esq < E2MAX) .and. (dm**2 < DM2MAX) .and. (esq * dm**2 < E2DM2MAX)) then - call drift_kepmd(dm, es, ec, xkep, s, c) + call swiftest_drift_kepmd(dm, es, ec, xkep, s, c) fchk = (xkep - ec * s + es * (1.0_DP - c) - dm) ! DEK - original code compared fchk*fchk with DANBYB, but i think it should ! DEK - be compared with DANBYB*DANBYB, and i changed it accordingly - please @@ -192,7 +191,7 @@ pure subroutine drift_dan(mu, px0, py0, pz0, vx0, vy0, vz0, dt0, iflag) end if end if - call drift_kepu(dt, r0, mu, alpha, u, fp, c1, c2, c3, iflag) + call swiftest_drift_kepu(dt, r0, mu, alpha, u, fp, c1, c2, c3, iflag) if (iflag == 0) then f = 1.0_DP - mu / r0 * c2 g = dt - mu * c3 @@ -205,10 +204,10 @@ pure subroutine drift_dan(mu, px0, py0, pz0, vx0, vy0, vz0, dt0, iflag) end if return - end subroutine drift_dan + end subroutine swiftest_drift_dan - pure subroutine drift_kepmd(dm, es, ec, x, s, c) + pure subroutine swiftest_drift_kepmd(dm, es, ec, x, s, c) !! author: David A. Minton !! !! Solve Kepler's equation in difference form for an ellipse for small input dm and eccentricity @@ -250,10 +249,10 @@ pure subroutine drift_kepmd(dm, es, ec, x, s, c) c = sqrt(1.0_DP - s**2) return - end subroutine drift_kepmd + end subroutine swiftest_drift_kepmd - pure subroutine drift_kepu(dt,r0,mu,alpha,u,fp,c1,c2,c3,iflag) + pure subroutine swiftest_drift_kepu(dt,r0,mu,alpha,u,fp,c1,c2,c3,iflag) !! author: David A. Minton !! !! Solve Kepler's equation in universal variables @@ -267,21 +266,21 @@ pure subroutine drift_kepu(dt,r0,mu,alpha,u,fp,c1,c2,c3,iflag) real(DP) :: s, st, fo, fn ! executable code - call drift_kepu_guess(dt, r0, mu, alpha, u, s) + call swiftest_drift_kepu_guess(dt, r0, mu, alpha, u, s) st = s - call drift_kepu_new(s, dt, r0, mu, alpha, u, fp, c1, c2, c3, iflag) + call swiftest_drift_kepu_new(s, dt, r0, mu, alpha, u, fp, c1, c2, c3, iflag) if (iflag /= 0) then - call drift_kepu_fchk(dt, r0, mu, alpha, u, st, fo) - call drift_kepu_fchk(dt, r0, mu, alpha, u, s, fn) + call swiftest_drift_kepu_fchk(dt, r0, mu, alpha, u, st, fo) + call swiftest_drift_kepu_fchk(dt, r0, mu, alpha, u, s, fn) if (abs(fo) < abs(fn)) s = st - call drift_kepu_lag(s, dt, r0, mu, alpha, u, fp, c1, c2, c3, iflag) + call swiftest_drift_kepu_lag(s, dt, r0, mu, alpha, u, fp, c1, c2, c3, iflag) end if return - end subroutine drift_kepu + end subroutine swiftest_drift_kepu - pure subroutine drift_kepu_fchk(dt, r0, mu, alpha, u, s, f) + pure subroutine swiftest_drift_kepu_fchk(dt, r0, mu, alpha, u, s, f) !! author: David A. Minton !! !! Computes the value of f, the function whose root we are trying to find in universal variables @@ -301,17 +300,17 @@ pure subroutine drift_kepu_fchk(dt, r0, mu, alpha, u, s, f) real(DP) :: x, c0, c1, c2, c3 x = s**2 * alpha - call drift_kepu_stumpff(x, c0, c1, c2, c3) + call swiftest_drift_kepu_stumpff(x, c0, c1, c2, c3) c1 = c1 * s c2 = c2 * s**2 c3 = c3 * s**3 f = r0 * c1 + u * c2 + mu * c3 - dt return - end subroutine drift_kepu_fchk + end subroutine swiftest_drift_kepu_fchk - pure subroutine drift_kepu_guess(dt, r0, mu, alpha, u, s) + pure subroutine swiftest_drift_kepu_guess(dt, r0, mu, alpha, u, s) !! author: David A. Minton !! !! Compute initial guess for solving Kepler's equation using universal variables @@ -341,21 +340,21 @@ pure subroutine drift_kepu_guess(dt, r0, mu, alpha, u, s) es = u / (en * a**2) e = sqrt(ec**2 + es**2) y = en * dt - es - call orbel_scget(y, sy, cy) + call swiftest_orbel_scget(y, sy, cy) sigma = sign(1.0_DP, es * cy + ec * sy) x = y + sigma * danbyk * e s = x / sqrt(alpha) end if else - call drift_kepu_p3solve(dt, r0, mu, alpha, u, s, iflag) + call swiftest_drift_kepu_p3solve(dt, r0, mu, alpha, u, s, iflag) if (iflag /= 0) s = dt / r0 end if return - end subroutine drift_kepu_guess + end subroutine swiftest_drift_kepu_guess - pure subroutine drift_kepu_lag(s, dt, r0, mu, alpha, u, fp, c1, c2, c3, iflag) + pure subroutine swiftest_drift_kepu_lag(s, dt, r0, mu, alpha, u, fp, c1, c2, c3, iflag) !! author: David A. Minton !! !! Solve Kepler's equation in universal variables using Laguerre's method @@ -380,7 +379,7 @@ pure subroutine drift_kepu_lag(s, dt, r0, mu, alpha, u, fp, c1, c2, c3, iflag) integer(I4B) :: nc, ncmax real(DP) :: x, fpp, ds, c0, f, fdt integer(I4B), parameter :: ln = 5 - + if (alpha < 0.0_DP) then ncmax = NLAG2 else @@ -388,7 +387,7 @@ pure subroutine drift_kepu_lag(s, dt, r0, mu, alpha, u, fp, c1, c2, c3, iflag) end if do nc = 0, ncmax x = s * s * alpha - call drift_kepu_stumpff(x, c0, c1, c2, c3) + call swiftest_drift_kepu_stumpff(x, c0, c1, c2, c3) c1 = c1 * s c2 = c2 * s**2 c3 = c3 * s**3 @@ -406,10 +405,10 @@ pure subroutine drift_kepu_lag(s, dt, r0, mu, alpha, u, fp, c1, c2, c3, iflag) iflag = 2 return - end subroutine drift_kepu_lag + end subroutine swiftest_drift_kepu_lag - pure subroutine drift_kepu_new(s, dt, r0, mu, alpha, u, fp, c1, c2, c3, iflag) + pure subroutine swiftest_drift_kepu_new(s, dt, r0, mu, alpha, u, fp, c1, c2, c3, iflag) !! author: David A. Minton !! !! Solve Kepler's equation in universal variables using Newton's method @@ -433,10 +432,10 @@ pure subroutine drift_kepu_new(s, dt, r0, mu, alpha, u, fp, c1, c2, c3, iflag) ! Internals integer( I4B) :: nc real(DP) :: x, c0, ds, f, fpp, fppp, fdt - + do nc = 0, 6 x = s**2 * alpha - call drift_kepu_stumpff(x, c0, c1, c2, c3) + call swiftest_drift_kepu_stumpff(x, c0, c1, c2, c3) c1 = c1 * s c2 = c2 * s**2 c3 = c3 * s**3 @@ -455,12 +454,12 @@ pure subroutine drift_kepu_new(s, dt, r0, mu, alpha, u, fp, c1, c2, c3, iflag) end if end do iflag = 1 - + return - end subroutine drift_kepu_new + end subroutine swiftest_drift_kepu_new - pure subroutine drift_kepu_p3solve(dt, r0, mu, alpha, u, s, iflag) + pure subroutine swiftest_drift_kepu_p3solve(dt, r0, mu, alpha, u, s, iflag) !! author: David A. Minton !! !! Computes real root of cubic involved in setting initial guess for solving Kepler's equation in universal variables @@ -507,10 +506,10 @@ pure subroutine drift_kepu_p3solve(dt, r0, mu, alpha, u, s, iflag) end if return - end subroutine drift_kepu_p3solve - + end subroutine swiftest_drift_kepu_p3solve + - pure subroutine drift_kepu_stumpff(x, c0, c1, c2, c3) + pure subroutine swiftest_drift_kepu_stumpff(x, c0, c1, c2, c3) !! author: David A. Minton !! !! Compute Stumpff functions needed for Kepler drift in universal variables @@ -537,10 +536,10 @@ pure subroutine drift_kepu_stumpff(x, c0, c1, c2, c3) end do c2 = (1.0_DP - x * (1.0_DP - x * (1.0_DP - x * (1.0_DP - x * (1.0_DP - x * & (1.0_DP - x / 182.0_DP) / 132.0_DP) / 90.0_DP) / 56.0_DP) / & - 30.0_DP) / 12.0_DP) / 2.0_DP + 30.0_DP) / 12.0_DP) / 2.0_DP c3 = (1.0_DP - x * (1.0_DP - x * (1.0_DP - x * (1.0_DP - x * (1.0_DP - x * & (1.0_DP - x / 210.0_DP) / 156.0_DP) / 110.0_DP) / 72.0_DP) / & - 42.0_DP) / 20.0_DP ) / 6.0_DP + 42.0_DP) / 20.0_DP ) / 6.0_DP c1 = 1.0_DP - x * c3 c0 = 1.0_DP - x * c2 if (n /= 0) then @@ -554,7 +553,7 @@ pure subroutine drift_kepu_stumpff(x, c0, c1, c2, c3) end if return - end subroutine drift_kepu_stumpff + end subroutine swiftest_drift_kepu_stumpff -end submodule drift_implementation +end submodule s_drift diff --git a/src/gr/gr.f90 b/src/swiftest_procedures/swiftest_gr.f90 similarity index 91% rename from src/gr/gr.f90 rename to src/swiftest_procedures/swiftest_gr.f90 index 0d7fb7aaa..e3467b8c0 100644 --- a/src/gr/gr.f90 +++ b/src/swiftest_procedures/swiftest_gr.f90 @@ -7,11 +7,10 @@ !! You should have received a copy of the GNU General Public License along with Swiftest. !! If not, see: https://www.gnu.org/licenses. -submodule(swiftest_classes) s_gr - use swiftest +submodule(swiftest) s_gr contains - pure module subroutine gr_kick_getaccb_ns_body(self, system, param) + pure module subroutine swiftest_gr_kick_getaccb_ns_body(self, system, param) !! author: David A. Minton !! !! Add relativistic correction acceleration for non-symplectic integrators. @@ -51,10 +50,10 @@ pure module subroutine gr_kick_getaccb_ns_body(self, system, param) end associate return - end subroutine gr_kick_getaccb_ns_body + end subroutine swiftest_gr_kick_getaccb_ns_body - pure module subroutine gr_kick_getacch(mu, x, lmask, n, inv_c2, agr) + pure module subroutine swiftest_gr_kick_getacch(mu, x, lmask, n, inv_c2, agr) !! author: David A. Minton !! !! Compute relativisitic accelerations of massive bodies @@ -81,10 +80,10 @@ pure module subroutine gr_kick_getacch(mu, x, lmask, n, inv_c2, agr) end do return - end subroutine gr_kick_getacch + end subroutine swiftest_gr_kick_getacch - pure module subroutine gr_p4_pos_kick(param, x, v, dt) + pure module subroutine swiftest_gr_p4_pos_kick(param, x, v, dt) !! author: David A. Minton !! !! Position kick due to p**4 term in the post-Newtonian correction @@ -110,10 +109,10 @@ pure module subroutine gr_p4_pos_kick(param, x, v, dt) x(:) = x(:) + dr(:) * dt return - end subroutine gr_p4_pos_kick + end subroutine swiftest_gr_p4_pos_kick - pure module subroutine gr_pseudovel2vel(param, mu, rh, pv, vh) + pure module subroutine swiftest_gr_pseudovel2vel(param, mu, rh, pv, vh) !! author: David A. Minton !! !! Converts the relativistic pseudovelocity back into a veliocentric velocity @@ -142,10 +141,10 @@ pure module subroutine gr_pseudovel2vel(param, mu, rh, pv, vh) end associate return - end subroutine gr_pseudovel2vel + end subroutine swiftest_gr_pseudovel2vel - pure module subroutine gr_pv2vh_body(self, param) + pure module subroutine swiftest_gr_pv2vh_body(self, param) !! author: David A. Minton !! !! Wrapper function that converts from pseudovelocity to heliocentric velocity for swiftest bodies @@ -161,16 +160,16 @@ pure module subroutine gr_pv2vh_body(self, param) if (n == 0) return allocate(vh, mold = self%vh) do i = 1, n - call gr_pseudovel2vel(param, self%mu(i), self%rh(:, i), self%vh(:, i), vh(:, i)) + call swiftest_gr_pseudovel2vel(param, self%mu(i), self%rh(:, i), self%vh(:, i), vh(:, i)) end do call move_alloc(vh, self%vh) end associate return - end subroutine gr_pv2vh_body + end subroutine swiftest_gr_pv2vh_body - pure module subroutine gr_vel2pseudovel(param, mu, rh, vh, pv) + pure module subroutine swiftest_gr_vel2pseudovel(param, mu, rh, vh, pv) !! author: David A. Minton !! !! Converts the heliocentric velocity into a pseudovelocity with relativistic corrections. @@ -244,10 +243,10 @@ pure module subroutine gr_vel2pseudovel(param, mu, rh, vh, pv) end associate return - end subroutine gr_vel2pseudovel + end subroutine swiftest_gr_vel2pseudovel - pure module subroutine gr_vh2pv_body(self, param) + pure module subroutine swiftest_gr_vh2pv_body(self, param) !! author: David A. Minton !! !! Wrapper function that converts from heliocentric velocity to pseudovelocity for Swiftest bodies @@ -263,12 +262,12 @@ pure module subroutine gr_vh2pv_body(self, param) if (n == 0) return allocate(pv, mold = self%vh) do i = 1, n - call gr_vel2pseudovel(param, self%mu(i), self%rh(:, i), self%vh(:, i), pv(:, i)) + call swiftest_gr_vel2pseudovel(param, self%mu(i), self%rh(:, i), self%vh(:, i), pv(:, i)) end do call move_alloc(pv, self%vh) end associate return - end subroutine gr_vh2pv_body + end subroutine swiftest_gr_vh2pv_body end submodule s_gr \ No newline at end of file diff --git a/src/io/io.f90 b/src/swiftest_procedures/swiftest_io.f90 similarity index 86% rename from src/io/io.f90 rename to src/swiftest_procedures/swiftest_io.f90 index 1f7852ea2..885e77985 100644 --- a/src/io/io.f90 +++ b/src/swiftest_procedures/swiftest_io.f90 @@ -7,12 +7,11 @@ !! You should have received a copy of the GNU General Public License along with Swiftest. !! If not, see: https://www.gnu.org/licenses. -submodule (swiftest_classes) s_io - use swiftest - +submodule (swiftest) s_io + use symba contains - module subroutine io_compact_output(self, param, timer) + module subroutine swiftest_io_compact_output(self, param, timer) !! author: David Minton !! !! Generates the terminal output displayed when display_style is set to COMPACT. This is used by the Python driver to @@ -29,7 +28,7 @@ module subroutine io_compact_output(self, param, timer) ! Arguments class(swiftest_nbody_system), intent(in) :: self !! Swiftest nbody system object class(swiftest_parameters), intent(in) :: param !! Input colleciton of user-defined parameters - class(*), intent(in) :: timer !! Object used for computing elapsed wall time (must be unlimited polymorphic because the walltimer module requires swiftest_classes) + class(*), intent(in) :: timer !! Object used for computing elapsed wall time (must be unlimited polymorphic because the walltimer module requires base) ! Internals character(len=:), allocatable :: formatted_output @@ -107,10 +106,10 @@ function fmt_DP(varname, val) result(pair_string) return end function fmt_DP - end subroutine io_compact_output + end subroutine swiftest_io_compact_output - module subroutine io_conservation_report(self, param, lterminal) + module subroutine swiftest_io_conservation_report(self, param, lterminal) !! author: The Purdue Swiftest Team - David A. Minton, Carlisle A. Wishard, Jennifer L.L. Pouplin, and Jacob R. Elliott !! !! Reports the current state of energy, mass, and angular momentum conservation in a run @@ -189,10 +188,10 @@ module subroutine io_conservation_report(self, param, lterminal) 667 continue write(*,*) "Error writing energy and momentum tracking file: " // trim(adjustl(errmsg)) call util_exit(FAILURE) - end subroutine io_conservation_report + end subroutine swiftest_io_conservation_report - module subroutine io_dump_param(self, param_file_name) + module subroutine swiftest_io_dump_param(self, param_file_name) !! author: David A. Minton !! !! Dump integration parameters to file @@ -220,10 +219,10 @@ module subroutine io_dump_param(self, param_file_name) 667 continue write(*,*) "Error opening parameter dump file " // trim(adjustl(errmsg)) call util_exit(FAILURE) - end subroutine io_dump_param + end subroutine swiftest_io_dump_param - module subroutine io_dump_system(self, param) + module subroutine swiftest_io_dump_system(self, param) !! author: David A. Minton !! !! Dumps the state of the system to files in case the simulation is interrupted. @@ -266,19 +265,19 @@ module subroutine io_dump_system(self, param) ! Dump the encounter history if necessary select type(param) - class is (symba_parameters) - if (param%lenc_save_trajectory .or. param%lenc_save_closest) call param%encounter_history%dump(param) - call param%collision_history%dump(param) + class is (swiftest_parameters) + if (param%lenc_save_trajectory .or. param%lenc_save_closest) call self%encounter_history%dump(param) + call self%collision_history%dump(param) end select ! Dump the system history to file call param%system_history%dump(param) return - end subroutine io_dump_system + end subroutine swiftest_io_dump_system - module subroutine io_dump_storage(self, param) + module subroutine swiftest_io_dump_storage(self, param) !! author: David A. Minton !! !! Dumps the time history of the simulation to file. Each time it writes a frame to file, it deallocates the system @@ -308,10 +307,10 @@ module subroutine io_dump_storage(self, param) end do call self%reset() return - end subroutine io_dump_storage + end subroutine swiftest_io_dump_storage - module subroutine io_get_args(integrator, param_file_name, display_style) + module subroutine swiftest_io_get_args(integrator, param_file_name, display_style) !! author: David A. Minton !! !! Reads in the name of the parameter file from command line arguments. @@ -348,22 +347,22 @@ module subroutine io_get_args(integrator, param_file_name, display_style) else if (narg >= 2) then call io_toupper(arg(1)) select case(arg(1)) - case('BS') - integrator = BS - case('HELIO') - integrator = HELIO - case('RA15') - integrator = RA15 - case('TU4') - integrator = TU4 + case('INT_BS') + integrator = INT_BS + case('INT_HELIO') + integrator = INT_HELIO + case('INT_RA15') + integrator = INT_RA15 + case('INT_TU4') + integrator = INT_TU4 case('WHM') - integrator = WHM + integrator = INT_WHM case('RMVS') - integrator = RMVS + integrator = INT_RMVS case('SYMBA') - integrator = SYMBA + integrator = INT_SYMBA case('RINGMOONS') - integrator = RINGMOONS + integrator = INT_RINGMOONS case default integrator = UNKNOWN_INTEGRATOR write(*,*) trim(adjustl(arg(1))) // ' is not a valid integrator.' @@ -382,16 +381,16 @@ module subroutine io_get_args(integrator, param_file_name, display_style) end if return - end subroutine io_get_args + end subroutine swiftest_io_get_args - module function io_get_token(buffer, ifirst, ilast, ierr) result(token) + module function swiftest_io_get_token(buffer, ifirst, ilast, ierr) result(token) !! author: David A. Minton !! !! Retrieves a character token from an input string. Here a token is defined as any set of contiguous non-blank characters not !! beginning with or containing "!". If "!" is present, any remaining part of the buffer including the "!" is ignored !! - !! Adapted from David E. Kaufmann's Swifter routine io_get_token.f90 + !! Adapted from David E. Kaufmann's Swifter routine swiftest_io_get_token.f90 implicit none ! Arguments character(len=*), intent(in) :: buffer !! Input string buffer @@ -431,10 +430,10 @@ module function io_get_token(buffer, ifirst, ilast, ierr) result(token) token = buffer(ifirst:ilast) return - end function io_get_token + end function swiftest_io_get_token - module subroutine io_log_one_message(file, message) + module subroutine swiftest_io_log_one_message(file, message) !! author: David A. Minton !! !! Writes a single message to a log file @@ -452,10 +451,10 @@ module subroutine io_log_one_message(file, message) return 667 continue write(*,*) "Error writing message to log file: " // trim(adjustl(errmsg)) - end subroutine io_log_one_message + end subroutine swiftest_io_log_one_message - module subroutine io_log_start(param, file, header) + module subroutine swiftest_io_log_start(param, file, header) !! author: David A. Minton !! !! Checks to see if a log file needs to be created if this is a new run, or appended if this is a restarted run @@ -479,10 +478,10 @@ module subroutine io_log_start(param, file, header) 667 continue write(*,*) "Error writing log file: " // trim(adjustl(errmsg)) - end subroutine io_log_start + end subroutine swiftest_io_log_start - module subroutine io_param_reader(self, unit, iotype, v_list, iostat, iomsg) + module subroutine swiftest_io_param_reader(self, unit, iotype, v_list, iostat, iomsg) !! author: The Purdue Swiftest Team - David A. Minton, Carlisle A. Wishard, Jennifer L.L. Pouplin, and Jacob R. Elliott !! !! Read in parameters for the integration @@ -509,11 +508,16 @@ module subroutine io_param_reader(self, unit, iotype, v_list, iostat, iomsg) character(STRMAX) :: line !! Line of the input file character(len=:), allocatable :: line_trim,param_name, param_value !! Strings used to parse the param file character(*),parameter :: linefmt = '(A)' !! Format code for simple text string + integer(I4B) :: nseeds, nseeds_from_file + logical :: seed_set = .false. !! Is the random seed set in the input file? character(len=:), allocatable :: integrator ! Parse the file line by line, extracting tokens then matching them up with known parameters if possible associate(param => self) + call random_seed(size = nseeds) + if (allocated(param%seed)) deallocate(param%seed) + allocate(param%seed(nseeds)) open(unit = unit, file = param%param_file_name, status = 'old', err = 667, iomsg = iomsg) do read(unit = unit, fmt = linefmt, end = 1, err = 667, iomsg = iomsg) line @@ -522,11 +526,11 @@ module subroutine io_param_reader(self, unit, iotype, v_list, iostat, iomsg) if ((ilength /= 0)) then ifirst = 1 ! Read the pair of tokens. The first one is the parameter name, the second is the value. - param_name = io_get_token(line_trim, ifirst, ilast, iostat) + param_name = swiftest_io_get_token(line_trim, ifirst, ilast, iostat) if (param_name == '') cycle ! No parameter name (usually because this line is commented out) call io_toupper(param_name) ifirst = ilast + 1 - param_value = io_get_token(line_trim, ifirst, ilast, iostat) + param_value = swiftest_io_get_token(line_trim, ifirst, ilast, iostat) select case (param_name) case ("T0") read(param_value, *, err = 667, iomsg = iomsg) param%t0 @@ -585,7 +589,7 @@ module subroutine io_param_reader(self, unit, iotype, v_list, iostat, iomsg) case ("CHK_QMIN_RANGE") read(param_value, *, err = 667, iomsg = iomsg) param%qmin_alo ifirst = ilast + 1 - param_value = io_get_token(line, ifirst, ilast, iostat) + param_value = swiftest_io_get_token(line, ifirst, ilast, iostat) read(param_value, *, err = 667, iomsg = iomsg) param%qmin_ahi case ("EXTRA_FORCE") call io_toupper(param_value) @@ -641,28 +645,28 @@ module subroutine io_param_reader(self, unit, iotype, v_list, iostat, iomsg) read(param_value, *, err = 667, iomsg = iomsg) param%Ltot_orig(1) do i = 2, NDIM ifirst = ilast + 2 - param_value = io_get_token(line, ifirst, ilast, iostat) + param_value = swiftest_io_get_token(line, ifirst, ilast, iostat) read(param_value, *, err = 667, iomsg = iomsg) param%Ltot_orig(i) end do case("LORBIT_ORIG") read(param_value, *, err = 667, iomsg = iomsg) param%Lorbit_orig(1) do i = 2, NDIM ifirst = ilast + 2 - param_value = io_get_token(line, ifirst, ilast, iostat) + param_value = swiftest_io_get_token(line, ifirst, ilast, iostat) read(param_value, *, err = 667, iomsg = iomsg) param%Lorbit_orig(i) end do case("LSPIN_ORIG") read(param_value, *, err = 667, iomsg = iomsg) param%Lspin_orig(1) do i = 2, NDIM ifirst = ilast + 2 - param_value = io_get_token(line, ifirst, ilast, iostat) + param_value = swiftest_io_get_token(line, ifirst, ilast, iostat) read(param_value, *, err = 667, iomsg = iomsg) param%Lspin_orig(i) end do case("LESCAPE") read(param_value, *, err = 667, iomsg = iomsg) param%Lescape(1) do i = 2, NDIM ifirst = ilast + 2 - param_value = io_get_token(line, ifirst, ilast, iostat) + param_value = swiftest_io_get_token(line, ifirst, ilast, iostat) read(param_value, *, err = 667, iomsg = iomsg) param%Lescape(i) end do case("GMESCAPE") @@ -675,6 +679,40 @@ module subroutine io_param_reader(self, unit, iotype, v_list, iostat, iomsg) read(param_value, *, err = 667, iomsg = iomsg) param%maxid case ("MAXID_COLLISION") read(param_value, *, err = 667, iomsg = iomsg) param%maxid_collision + case ("FRAGMENTATION") + call io_toupper(param_value) + if (param_value == "YES" .or. param_value == "T") self%lfragmentation = .true. + case ("GMTINY") + read(param_value, *) param%GMTINY + case ("MIN_GMFRAG") + read(param_value, *) param%min_GMfrag + case ("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 + ! number of seeds than the current system. If the number of seeds in the file is smaller than required, we will use them as a source to fill in the missing elements. + ! If the number of seeds in the file is larger than required, we will truncate the seed array. + if (nseeds_from_file > nseeds) then + nseeds = nseeds_from_file + deallocate(param%seed) + allocate(param%seed(nseeds)) + do i = 1, nseeds + ifirst = ilast + 2 + param_value = swiftest_io_get_token(line, ifirst, ilast, iostat) + read(param_value, *) param%seed(i) + end do + else ! Seed array in file is too small + do i = 1, nseeds_from_file + ifirst = ilast + 2 + param_value = swiftest_io_get_token(line, ifirst, ilast, iostat) + read(param_value, *) param%seed(i) + end do + param%seed(nseeds_from_file+1:nseeds) = [(param%seed(1) - param%seed(nseeds_from_file) + i, & + i=nseeds_from_file+1, nseeds)] + end if + seed_set = .true. case ("RESTART") if (param_value == "NO" .or. param_value == 'F') then param%lrestart = .false. @@ -682,7 +720,7 @@ module subroutine io_param_reader(self, unit, iotype, v_list, iostat, iomsg) param%lrestart = .true. end if ! Ignore SyMBA-specific, not-yet-implemented, or obsolete input parameters - case ("NPLMAX", "NTPMAX", "GMTINY", "MIN_GMFRAG", "FRAGMENTATION", "SEED", "YARKOVSKY", "YORP", "ENCOUNTER_SAVE") + case ("NPLMAX", "NTPMAX", "YARKOVSKY", "YORP") case default write(*,*) "Ignoring unknown parameter -> ",param_name end select @@ -774,8 +812,40 @@ 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)) + + if (self%GMTINY < 0.0_DP) then + write(iomsg,*) "GMTINY invalid or not set: ", self%GMTINY + iostat = -1 + return + end if + + if (param%lfragmentation) then + if (seed_set) then + call random_seed(put = param%seed) + else + call random_seed(get = param%seed) + end if + if (param%min_GMfrag < 0.0_DP) param%min_GMfrag = param%GMTINY + end if + + ! All reporting of collision information in SyMBA (including mergers) is now recorded in the Fraggle logfile + call io_log_start(param, FRAGGLE_LOG_OUT, "Fraggle logfile") + + if ((param%encounter_save /= "NONE") .and. & + (param%encounter_save /= "TRAJECTORY") .and. & + (param%encounter_save /= "CLOSEST") .and. & + (param%encounter_save /= "BOTH")) then + write(iomsg,*) 'Invalid encounter_save parameter: ',trim(adjustl(param%out_type)) + write(iomsg,*) 'Valid options are NONE, TRAJECTORY, CLOSEST, or BOTH' + iostat = -1 + return + end if + + param%lenc_save_trajectory = (param%encounter_save == "TRAJECTORY") .or. (param%encounter_save == "BOTH") + param%lenc_save_closest = (param%encounter_save == "CLOSEST") .or. (param%encounter_save == "BOTH") + integrator = v_list(1) - if ((integrator == RMVS) .or. (integrator == SYMBA)) then + if ((integrator == INT_RMVS) .or. (integrator == INT_SYMBA)) then if (.not.param%lclose) then write(iomsg,*) 'This integrator requires CHK_CLOSE to be enabled.' iostat = -1 @@ -785,7 +855,7 @@ module subroutine io_param_reader(self, unit, iotype, v_list, iostat, iomsg) ! Determine if the GR flag is set correctly for this integrator select case(integrator) - case(WHM, RMVS, HELIO, SYMBA) + case(INT_WHM, INT_RMVS, INT_HELIO, INT_SYMBA) case default if (param%lgr) write(iomsg, *) 'GR is not yet implemented for this integrator. This parameter will be ignored.' param%lgr = .false. @@ -803,7 +873,7 @@ module subroutine io_param_reader(self, unit, iotype, v_list, iostat, iomsg) param%ladaptive_interactions = .true. param%lflatten_interactions = .true. call io_log_start(param, INTERACTION_TIMER_LOG_OUT, "Interaction loop timer logfile") - call io_log_one_message(INTERACTION_TIMER_LOG_OUT, "Diagnostic values: loop style, time count, nplpl, metric") + call swiftest_io_log_one_message(INTERACTION_TIMER_LOG_OUT, "Diagnostic values: loop style, time count, nplpl, metric") case("TRIANGULAR") param%ladaptive_interactions = .false. param%lflatten_interactions = .false. @@ -818,7 +888,7 @@ module subroutine io_param_reader(self, unit, iotype, v_list, iostat, iomsg) param%ladaptive_interactions = .true. param%lflatten_interactions = .true. call io_log_start(param, INTERACTION_TIMER_LOG_OUT, "Interaction loop timer logfile") - call io_log_one_message(INTERACTION_TIMER_LOG_OUT, "Diagnostic values: loop style, time count, nplpl, metric") + call swiftest_io_log_one_message(INTERACTION_TIMER_LOG_OUT, "Diagnostic values: loop style, time count, nplpl, metric") end select select case(trim(adjustl(param%encounter_check_plpl))) @@ -826,7 +896,7 @@ module subroutine io_param_reader(self, unit, iotype, v_list, iostat, iomsg) param%ladaptive_encounters_plpl = .true. param%lencounter_sas_plpl = .true. call io_log_start(param, ENCOUNTER_PLPL_TIMER_LOG_OUT, "Encounter check loop timer logfile") - call io_log_one_message(ENCOUNTER_PLPL_TIMER_LOG_OUT, "Diagnostic values: loop style, time count, nplpl, metric") + call swiftest_io_log_one_message(ENCOUNTER_PLPL_TIMER_LOG_OUT, "Diagnostic values: loop style, time count, nplpl, metric") case("TRIANGULAR") param%ladaptive_encounters_plpl = .false. param%lencounter_sas_plpl = .false. @@ -841,7 +911,7 @@ module subroutine io_param_reader(self, unit, iotype, v_list, iostat, iomsg) param%ladaptive_encounters_plpl = .true. param%lencounter_sas_plpl = .true. call io_log_start(param, ENCOUNTER_PLPL_TIMER_LOG_OUT, "Encounter check loop timer logfile") - call io_log_one_message(ENCOUNTER_PLPL_TIMER_LOG_OUT, "Diagnostic values: loop style, time count, nplpl, metric") + call swiftest_io_log_one_message(ENCOUNTER_PLPL_TIMER_LOG_OUT, "Diagnostic values: loop style, time count, nplpl, metric") end select select case(trim(adjustl(param%encounter_check_pltp))) @@ -849,7 +919,7 @@ module subroutine io_param_reader(self, unit, iotype, v_list, iostat, iomsg) param%ladaptive_encounters_pltp = .true. param%lencounter_sas_pltp = .true. call io_log_start(param, ENCOUNTER_PLTP_TIMER_LOG_OUT, "Encounter check loop timer logfile") - call io_log_one_message(ENCOUNTER_PLTP_TIMER_LOG_OUT, "Diagnostic values: loop style, time count, npltp, metric") + call swiftest_io_log_one_message(ENCOUNTER_PLTP_TIMER_LOG_OUT, "Diagnostic values: loop style, time count, npltp, metric") case("TRIANGULAR") param%ladaptive_encounters_pltp = .false. param%lencounter_sas_pltp = .false. @@ -864,7 +934,7 @@ module subroutine io_param_reader(self, unit, iotype, v_list, iostat, iomsg) param%ladaptive_encounters_pltp = .true. param%lencounter_sas_pltp = .true. call io_log_start(param, ENCOUNTER_PLTP_TIMER_LOG_OUT, "Encounter check loop timer logfile") - call io_log_one_message(ENCOUNTER_PLTP_TIMER_LOG_OUT, "Diagnostic values: loop style, time count, npltp, metric") + call swiftest_io_log_one_message(ENCOUNTER_PLTP_TIMER_LOG_OUT, "Diagnostic values: loop style, time count, npltp, metric") end select iostat = 0 @@ -877,10 +947,10 @@ module subroutine io_param_reader(self, unit, iotype, v_list, iostat, iomsg) return 667 continue write(*,*) "Error reading param file: ", trim(adjustl(iomsg)) - end subroutine io_param_reader + end subroutine swiftest_io_param_reader - module subroutine io_param_writer(self, unit, iotype, v_list, iostat, iomsg) + module subroutine swiftest_io_param_writer(self, unit, iotype, v_list, iostat, iomsg) !! author: David A. Minton !! !! Dump integration parameters to file @@ -959,10 +1029,10 @@ module subroutine io_param_writer(self, unit, iotype, v_list, iostat, iomsg) 667 continue return - end subroutine io_param_writer + end subroutine swiftest_io_param_writer - module subroutine io_param_writer_one_char(param_name, param_value, unit) + module subroutine swiftest_io_param_writer_one_char(param_name, param_value, unit) !! author: David A. Minton !! !! Writes a single parameter name/value pair to a file unit. @@ -982,10 +1052,10 @@ module subroutine io_param_writer_one_char(param_name, param_value, unit) return 667 continue write(*,*) 'Error writing parameter: ',trim(adjustl(iomsg)) - end subroutine io_param_writer_one_char + end subroutine swiftest_io_param_writer_one_char - module subroutine io_param_writer_one_DP(param_name, param_value, unit) + module subroutine swiftest_io_param_writer_one_DP(param_name, param_value, unit) !! author: David A. Minton !! !! Writes a single parameter name/value pair to a file unit. @@ -1003,10 +1073,10 @@ module subroutine io_param_writer_one_DP(param_name, param_value, unit) call io_param_writer_one(param_name, param_value_string, unit) return - end subroutine io_param_writer_one_DP + end subroutine swiftest_io_param_writer_one_DP - module subroutine io_param_writer_one_DParr(param_name, param_value, unit) + module subroutine swiftest_io_param_writer_one_DParr(param_name, param_value, unit) !! author: David A. Minton !! !! Writes a single parameter name/value pair to a file unit. @@ -1035,10 +1105,10 @@ module subroutine io_param_writer_one_DParr(param_name, param_value, unit) call io_param_writer_one(param_name, param_value_string, unit) return - end subroutine io_param_writer_one_DParr + end subroutine swiftest_io_param_writer_one_DParr - module subroutine io_param_writer_one_I4B(param_name, param_value, unit) + module subroutine swiftest_io_param_writer_one_I4B(param_name, param_value, unit) !! author: David A. Minton !! !! Writes a single parameter name/value pair to a file unit. @@ -1056,10 +1126,10 @@ module subroutine io_param_writer_one_I4B(param_name, param_value, unit) call io_param_writer_one(param_name, param_value_string, unit) return - end subroutine io_param_writer_one_I4B + end subroutine swiftest_io_param_writer_one_I4B - module subroutine io_param_writer_one_I8B(param_name, param_value, unit) + module subroutine swiftest_io_param_writer_one_I8B(param_name, param_value, unit) !! author: David A. Minton !! !! Writes a single parameter name/value pair to a file unit. @@ -1077,10 +1147,10 @@ module subroutine io_param_writer_one_I8B(param_name, param_value, unit) call io_param_writer_one(param_name, param_value_string, unit) return - end subroutine io_param_writer_one_I8B + end subroutine swiftest_io_param_writer_one_I8B - module subroutine io_param_writer_one_I4Barr(param_name, param_value, unit) + module subroutine swiftest_io_param_writer_one_I4Barr(param_name, param_value, unit) !! author: David A. Minton !! !! Writes a single parameter name/value pair to a file unit. @@ -1109,10 +1179,10 @@ module subroutine io_param_writer_one_I4Barr(param_name, param_value, unit) call io_param_writer_one(param_name, param_value_string, unit) return - end subroutine io_param_writer_one_I4Barr + end subroutine swiftest_io_param_writer_one_I4Barr - module subroutine io_param_writer_one_logical(param_name, param_value, unit) + module subroutine swiftest_io_param_writer_one_logical(param_name, param_value, unit) !! author: David A. Minton !! !! Writes a single parameter name/value pair to a file unit. @@ -1130,10 +1200,10 @@ module subroutine io_param_writer_one_logical(param_name, param_value, unit) call io_param_writer_one(param_name, param_value_string, unit) return - end subroutine io_param_writer_one_logical + end subroutine swiftest_io_param_writer_one_logical - module subroutine io_param_writer_one_QP(param_name, param_value, unit) + module subroutine swiftest_io_param_writer_one_QP(param_name, param_value, unit) !! author: David A. Minton !! !! Writes a single parameter name/value pair to a file unit. @@ -1151,31 +1221,10 @@ module subroutine io_param_writer_one_QP(param_name, param_value, unit) call io_param_writer_one(param_name, param_value_string, unit) return - end subroutine io_param_writer_one_QP - - - module subroutine io_read_in_base(self,param) - !! author: Carlisle A. Wishard and David A. Minton - !! - !! Reads in either a central body, test particle, or massive body object. For the swiftest_body types (non-central body), it allocates array space for them - implicit none - class(swiftest_base), intent(inout) :: self !! Swiftest base object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - - if (param%in_type /= "ASCII") return ! This method is not used in NetCDF mode, as reading is done for the whole system, not on individual particle types - - select type(self) - class is (swiftest_body) - call io_read_in_body(self, param) - class is (swiftest_cb) - call io_read_in_cb(self, param) - end select - - return - end subroutine io_read_in_base + end subroutine swiftest_io_param_writer_one_QP - subroutine io_read_in_body(self, param) + module subroutine swiftest_io_read_in_body(self, param) !! author: The Purdue Swiftest Team - David A. Minton, Carlisle A. Wishard, Jennifer L.L. Pouplin, and Jacob R. Elliott !! !! Read in either test particle or massive body data @@ -1224,10 +1273,10 @@ subroutine io_read_in_body(self, param) 667 continue write(*,*) 'Error reading in initial conditions file: ',trim(adjustl(errmsg)) return - end subroutine io_read_in_body + end subroutine swiftest_io_read_in_body - subroutine io_read_in_cb(self, param) + module subroutine swiftest_io_read_in_cb(self, param) !! author: David A. Minton !! !! Reads in central body data @@ -1267,26 +1316,23 @@ subroutine io_read_in_cb(self, param) if (param%rmin < 0.0) param%rmin = self%radius - select type(cb => self) - class is (symba_cb) - cb%GM0 = cb%Gmass - cb%dGM = 0.0_DP - cb%R0 = cb%radius - if (param%lrotation) then - cb%L0(:) = cb%Ip(3) * cb%mass * cb%radius**2 * cb%rot(:) - cb%dL(:) = 0.0_DP - end if - end select + self%GM0 = self%Gmass + self%dGM = 0.0_DP + self%R0 = self%radius + if (param%lrotation) then + self%L0(:) = self%Ip(3) * self%mass * self%radius**2 * self%rot(:) + self%dL(:) = 0.0_DP + end if end if return 667 continue write(*,*) "Error reading central body file: " // trim(adjustl(errmsg)) call util_exit(FAILURE) - end subroutine io_read_in_cb + end subroutine swiftest_io_read_in_cb - module subroutine io_read_in_system(self, param) + module subroutine swiftest_io_read_in_system(self, param) !! author: David A. Minton and Carlisle A. Wishard !! !! Reads in the system from input files @@ -1331,16 +1377,16 @@ module subroutine io_read_in_system(self, param) end if return - end subroutine io_read_in_system + end subroutine swiftest_io_read_in_system - module function io_read_frame_body(self, iu, param) result(ierr) + module function swiftest_io_read_frame_body(self, iu, param) result(ierr) !! author: David A. Minton !! !! Reads a frame of output of either test particle or massive body data from a binary output file !! !! Adapted from David E. Kaufmann's Swifter routine io_read_frame.f90 - !! Adapted from Hal Levison's Swift routine io_read_frame.F + !! Adapted from Hal Levison's Swift routine io_read_frame.f implicit none ! Arguments class(swiftest_body), intent(inout) :: self !! Swiftest particle object @@ -1436,10 +1482,10 @@ module function io_read_frame_body(self, iu, param) result(ierr) write(*,*) "Error reading body file: " // trim(adjustl(errmsg)) end select call util_exit(FAILURE) - end function io_read_frame_body + end function swiftest_io_read_frame_body - module subroutine io_read_in_param(self, param_file_name) + module subroutine swiftest_io_read_in_param(self, param_file_name) !! author: David A. Minton !! !! Read in parameters for the integration @@ -1468,10 +1514,10 @@ module subroutine io_read_in_param(self, param_file_name) 667 continue write(self%display_unit,*) "Error reading parameter file: " // trim(adjustl(errmsg)) call util_exit(FAILURE) - end subroutine io_read_in_param + end subroutine swiftest_io_read_in_param - module subroutine io_set_display_param(self, display_style) + module subroutine swiftest_io_set_display_param(self, display_style) !! author: David A. Minton !! !! Sets the display style parameters. If display is "STANDARD" then output goes to stdout. If display is "COMPACT" @@ -1503,10 +1549,10 @@ module subroutine io_set_display_param(self, display_style) 667 continue write(*,*) "Error opening swiftest log file: " // trim(adjustl(errmsg)) call util_exit(FAILURE) - end subroutine io_set_display_param + end subroutine swiftest_io_set_display_param - module subroutine io_toupper(string) + module subroutine swiftest_io_toupper(string) !! author: David A. Minton !! !! Convert string to uppercase @@ -1528,17 +1574,40 @@ module subroutine io_toupper(string) end do return - end subroutine io_toupper + end subroutine swiftest_io_toupper + + + + module subroutine swiftest_io_write_discard(self, param) + !! author: David A. Minton + !! + !! Write the metadata of the discarded body to the output file + implicit none + class(swiftest_nbody_system), intent(inout) :: self !! SyMBA nbody system object + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + ! Internals + + associate(pl => self%pl, npl => self%pl%nbody, pl_adds => self%pl_adds) + + if (self%tp_discards%nbody > 0) call self%tp_discards%write_info(param%system_history%nc, param) + if (self%pl_discards%nbody == 0) return + + call self%pl_discards%write_info(param%system_history%nc, param) + end associate + + return + + end subroutine swiftest_io_write_discard - module subroutine io_write_frame_system(self, param) + module subroutine swiftest_io_write_frame_system(self, param) !! author: The Purdue Swiftest Team - David A. Minton, Carlisle A. Wishard, Jennifer L.L. Pouplin, and Jacob R. Elliott !! !! Write a frame (header plus records for each massive body and active test particle) to output binary file !! There is no direct file output from this subroutine !! !! Adapted from David E. Kaufmann's Swifter routine io_write_frame.f90 - !! Adapted from Hal Levison's Swift routine io_write_frame.F + !! Adapted from Hal Levison's Swift routine io_write_frame.f implicit none ! Arguments class(swiftest_nbody_system), intent(inout) :: self !! Swiftest system object @@ -1582,6 +1651,6 @@ module subroutine io_write_frame_system(self, param) 667 continue write(*,*) "Error writing system frame: " // trim(adjustl(errmsg)) call util_exit(FAILURE) - end subroutine io_write_frame_system + end subroutine swiftest_io_write_frame_system end submodule s_io diff --git a/src/swiftest_procedures/swiftest_io_netcdf.f90 b/src/swiftest_procedures/swiftest_io_netcdf.f90 new file mode 100644 index 000000000..f9d48e366 --- /dev/null +++ b/src/swiftest_procedures/swiftest_io_netcdf.f90 @@ -0,0 +1,1211 @@ +!! Copyright 2022 - David Minton, Carlisle Wishard, Jennifer Pouplin, Jake Elliott, & Dana Singh +!! This file is part of Swiftest. +!! Swiftest is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License +!! as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. +!! Swiftest is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty +!! of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. +!! You should have received a copy of the GNU General Public License along with Swiftest. +!! If not, see: https://www.gnu.org/licenses. + +submodule (swiftest) s_io_netcdf + use netcdf +contains + + + + module function swiftest_io_netcdf_get_old_t_final_system(self, param) result(old_t_final) + !! author: David A. Minton + !! + !! Validates the dump file to check whether the dump file initial conditions duplicate the last frame of the netcdf output. + !! + implicit none + ! Arguments + class(swiftest_nbody_system), intent(inout) :: self + class(base_parameters), intent(inout) :: param + ! Result + real(DP) :: old_t_final + ! Internals + integer(I4B) :: itmax, idmax + real(DP), dimension(:), allocatable :: vals + real(DP), dimension(1) :: rtemp + real(DP), dimension(NDIM) :: rot0, Ip0, Lnow + real(DP) :: KE_orb_orig, KE_spin_orig, PE_orig + + select type(param) + class is (swiftest_parameters) + associate (nc => param%system_history%nc, cb => self%cb) + call nc%open(param) + call netcdf_check( nf90_inquire_dimension(nc%id, nc%time_dimid, len=itmax), "swiftest_io_netcdf_get_old_t_final_system time_dimid" ) + call netcdf_check( nf90_inquire_dimension(nc%id, nc%name_dimid, len=idmax), "swiftest_io_netcdf_get_old_t_final_system name_dimid" ) + allocate(vals(idmax)) + call netcdf_check( nf90_get_var(nc%id, nc%time_varid, rtemp, start=[1], count=[1]), "swiftest_io_netcdf_get_old_t_final_system time_varid" ) + + !old_t_final = rtemp(1) + old_t_final = param%t0 ! For NetCDF it is safe to overwrite the final t value on a restart + + if (param%lenergy) then + call netcdf_check( nf90_get_var(nc%id, nc%KE_orb_varid, rtemp, start=[1], count=[1]), "swiftest_io_netcdf_get_old_t_final_system KE_orb_varid" ) + KE_orb_orig = rtemp(1) + + call netcdf_check( nf90_get_var(nc%id, nc%KE_spin_varid, rtemp, start=[1], count=[1]), "swiftest_io_netcdf_get_old_t_final_system KE_spin_varid" ) + KE_spin_orig = rtemp(1) + + call netcdf_check( nf90_get_var(nc%id, nc%PE_varid, rtemp, start=[1], count=[1]), "swiftest_io_netcdf_get_old_t_final_system PE_varid" ) + PE_orig = rtemp(1) + + call netcdf_check( nf90_get_var(nc%id, nc%Ecollisions_varid, self%Ecollisions, start=[1]), "swiftest_io_netcdf_get_old_t_final_system Ecollisions_varid" ) + call netcdf_check( nf90_get_var(nc%id, nc%Euntracked_varid, self%Euntracked, start=[1]), "swiftest_io_netcdf_get_old_t_final_system Euntracked_varid" ) + + self%Eorbit_orig = KE_orb_orig + KE_spin_orig + PE_orig + self%Ecollisions + self%Euntracked + + call netcdf_check( nf90_get_var(nc%id, nc%L_orb_varid, self%Lorbit_orig(:), start=[1,1], count=[NDIM,1]), "swiftest_io_netcdf_get_old_t_final_system L_orb_varid" ) + call netcdf_check( nf90_get_var(nc%id, nc%Lspin_varid, self%Lspin_orig(:), start=[1,1], count=[NDIM,1]), "swiftest_io_netcdf_get_old_t_final_system Lspin_varid" ) + call netcdf_check( nf90_get_var(nc%id, nc%L_escape_varid, self%Lescape(:), start=[1,1], count=[NDIM,1]), "swiftest_io_netcdf_get_old_t_final_system L_escape_varid" ) + + self%Ltot_orig(:) = self%Lorbit_orig(:) + self%Lspin_orig(:) + self%Lescape(:) + + call netcdf_check( nf90_get_var(nc%id, nc%Gmass_varid, vals, start=[1,1], count=[idmax,1]), "swiftest_io_netcdf_get_old_t_final_system Gmass_varid" ) + call netcdf_check( nf90_get_var(nc%id, nc%GMescape_varid, self%GMescape, start=[1]), "swiftest_io_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 + + cb%GM0 = vals(1) + cb%dGM = cb%Gmass - cb%GM0 + + call netcdf_check( nf90_get_var(nc%id, nc%radius_varid, rtemp, start=[1,1], count=[1,1]), "swiftest_io_netcdf_get_old_t_final_system radius_varid" ) + cb%R0 = rtemp(1) + + if (param%lrotation) then + + call netcdf_check( nf90_get_var(nc%id, nc%rot_varid, rot0, start=[1,1,1], count=[NDIM,1,1]), "swiftest_io_netcdf_get_old_t_final_system rot_varid" ) + call netcdf_check( nf90_get_var(nc%id, nc%Ip_varid, Ip0, start=[1,1,1], count=[NDIM,1,1]), "swiftest_io_netcdf_get_old_t_final_system Ip_varid" ) + + cb%L0(:) = Ip0(3) * cb%GM0 * cb%R0**2 * rot0(:) + + Lnow(:) = cb%Ip(3) * cb%Gmass * cb%radius**2 * cb%rot(:) + cb%dL(:) = Lnow(:) - cb%L0(:) + end if + + end if + + deallocate(vals) + end associate + end select + + return + end function swiftest_io_netcdf_get_old_t_final_system + + + module subroutine swiftest_io_netcdf_initialize_output(self, param) + !! author: Carlisle A. Wishard, Dana Singh, and David A. Minton + !! + !! Initialize a NetCDF file system and defines all variables. + use, intrinsic :: ieee_arithmetic + implicit none + ! Arguments + class(swiftest_io_netcdf_parameters), intent(inout) :: self !! Parameters used to for writing a NetCDF dataset to file + class(base_parameters), intent(in) :: param !! Current run configuration parameters + ! Internals + integer(I4B) :: nvar, varid, vartype + real(DP) :: dfill + real(SP) :: sfill + integer(I4B), parameter :: NO_FILL = 0 + logical :: fileExists + character(len=STRMAX) :: errmsg + integer(I4B) :: ndims + + associate(nc => self) + + dfill = ieee_value(dfill, IEEE_QUIET_NAN) + sfill = ieee_value(sfill, IEEE_QUIET_NAN) + + select case (param%out_type) + case("swiftest_io_netcdf_FLOAT") + nc%out_type = NF90_FLOAT + case("swiftest_io_netcdf_DOUBLE") + nc%out_type = NF90_DOUBLE + end select + + ! Check if the file exists, and if it does, delete it + inquire(file=nc%file_name, exist=fileExists) + if (fileExists) then + open(unit=LUN, file=nc%file_name, status="old", err=667, iomsg=errmsg) + close(unit=LUN, status="delete") + end if + + ! Create the file + call netcdf_check( nf90_create(nc%file_name, NF90io_netcdf4, nc%id), "swiftest_io_netcdf_initialize_output nf90_create" ) + + ! Dimensions + call netcdf_check( nf90_def_dim(nc%id, nc%time_dimname, NF90_UNLIMITED, nc%time_dimid), "swiftest_io_netcdf_initialize_output nf90_def_dim time_dimid" ) ! Simulation time dimension + call netcdf_check( nf90_def_dim(nc%id, nc%space_dimname, NDIM, nc%space_dimid), "swiftest_io_netcdf_initialize_output nf90_def_dim space_dimid" ) ! 3D space dimension + call netcdf_check( nf90_def_dim(nc%id, nc%name_dimname, NF90_UNLIMITED, nc%name_dimid), "swiftest_io_netcdf_initialize_output nf90_def_dim name_dimid" ) ! dimension to store particle id numbers + call netcdf_check( nf90_def_dim(nc%id, nc%str_dimname, NAMELEN, nc%str_dimid), "swiftest_io_netcdf_initialize_output nf90_def_dim str_dimid" ) ! Dimension for string variables (aka character arrays) + + ! Dimension coordinates + call netcdf_check( nf90_def_var(nc%id, nc%time_dimname, nc%out_type, nc%time_dimid, nc%time_varid), "swiftest_io_netcdf_initialize_output nf90_def_var time_varid" ) + call netcdf_check( nf90_def_var(nc%id, nc%space_dimname, NF90_CHAR, nc%space_dimid, nc%space_varid), "swiftest_io_netcdf_initialize_output nf90_def_var space_varid" ) + call netcdf_check( nf90_def_var(nc%id, nc%name_dimname, NF90_CHAR, [nc%str_dimid, nc%name_dimid], nc%name_varid), "swiftest_io_netcdf_initialize_output nf90_def_var name_varid" ) + + ! Variables + call netcdf_check( nf90_def_var(nc%id, nc%id_varname, NF90_INT, nc%name_dimid, nc%id_varid), "swiftest_io_netcdf_initialize_output nf90_def_var id_varid" ) + call netcdf_check( nf90_def_var(nc%id, nc%npl_varname, NF90_INT, nc%time_dimid, nc%npl_varid), "swiftest_io_netcdf_initialize_output nf90_def_var npl_varid" ) + call netcdf_check( nf90_def_var(nc%id, nc%ntp_varname, NF90_INT, nc%time_dimid, nc%ntp_varid), "swiftest_io_netcdf_initialize_output nf90_def_var ntp_varid" ) + if (param%integrator == INT_SYMBA) call netcdf_check( nf90_def_var(nc%id, nc%nplm_varname, NF90_INT, nc%time_dimid, nc%nplm_varid), "swiftest_io_netcdf_initialize_output nf90_def_var nplm_varid" ) + call netcdf_check( nf90_def_var(nc%id, nc%ptype_varname, NF90_CHAR, [nc%str_dimid, nc%name_dimid], nc%ptype_varid), "swiftest_io_netcdf_initialize_output nf90_def_var ptype_varid" ) + + if ((param%out_form == "XV") .or. (param%out_form == "XVEL")) then + call netcdf_check( nf90_def_var(nc%id, nc%rh_varname, nc%out_type, [nc%space_dimid, nc%name_dimid, nc%time_dimid], nc%rh_varid), "swiftest_io_netcdf_initialize_output nf90_def_var rh_varid" ) + call netcdf_check( nf90_def_var(nc%id, nc%vh_varname, nc%out_type, [nc%space_dimid, nc%name_dimid, nc%time_dimid], nc%vh_varid), "swiftest_io_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 netcdf_check( nf90_def_var(nc%id, nc%gr_pseudo_vh_varname, nc%out_type, [nc%space_dimid, nc%name_dimid, nc%time_dimid], nc%gr_pseudo_vh_varid), "swiftest_io_netcdf_initialize_output nf90_def_var gr_psuedo_vh_varid" ) + nc%lpseudo_vel_exists = .true. + end if + + end if + + if ((param%out_form == "EL") .or. (param%out_form == "XVEL")) then + call netcdf_check( nf90_def_var(nc%id, nc%a_varname, nc%out_type, [nc%name_dimid, nc%time_dimid], nc%a_varid), "swiftest_io_netcdf_initialize_output nf90_def_var a_varid" ) + call netcdf_check( nf90_def_var(nc%id, nc%e_varname, nc%out_type, [nc%name_dimid, nc%time_dimid], nc%e_varid), "swiftest_io_netcdf_initialize_output nf90_def_var e_varid" ) + call netcdf_check( nf90_def_var(nc%id, nc%inc_varname, nc%out_type, [nc%name_dimid, nc%time_dimid], nc%inc_varid), "swiftest_io_netcdf_initialize_output nf90_def_var inc_varid" ) + call netcdf_check( nf90_def_var(nc%id, nc%capom_varname, nc%out_type, [nc%name_dimid, nc%time_dimid], nc%capom_varid), "swiftest_io_netcdf_initialize_output nf90_def_var capom_varid" ) + call netcdf_check( nf90_def_var(nc%id, nc%omega_varname, nc%out_type, [nc%name_dimid, nc%time_dimid], nc%omega_varid), "swiftest_io_netcdf_initialize_output nf90_def_var omega_varid" ) + call netcdf_check( nf90_def_var(nc%id, nc%capm_varname, nc%out_type, [nc%name_dimid, nc%time_dimid], nc%capm_varid), "swiftest_io_netcdf_initialize_output nf90_def_var capm_varid" ) + call netcdf_check( nf90_def_var(nc%id, nc%varpi_varname, nc%out_type, [nc%name_dimid, nc%time_dimid], nc%varpi_varid), "swiftest_io_netcdf_initialize_output nf90_def_var varpi_varid" ) + call netcdf_check( nf90_def_var(nc%id, nc%lam_varname, nc%out_type, [nc%name_dimid, nc%time_dimid], nc%lam_varid), "swiftest_io_netcdf_initialize_output nf90_def_var lam_varid" ) + call netcdf_check( nf90_def_var(nc%id, nc%f_varname, nc%out_type, [nc%name_dimid, nc%time_dimid], nc%f_varid), "swiftest_io_netcdf_initialize_output nf90_def_var f_varid" ) + call netcdf_check( nf90_def_var(nc%id, nc%cape_varname, nc%out_type, [nc%name_dimid, nc%time_dimid], nc%cape_varid), "swiftest_io_netcdf_initialize_output nf90_def_var cape_varid" ) + end if + + call netcdf_check( nf90_def_var(nc%id, nc%gmass_varname, nc%out_type, [nc%name_dimid, nc%time_dimid], nc%Gmass_varid), "swiftest_io_netcdf_initialize_output nf90_def_var Gmass_varid" ) + + if (param%lrhill_present) then + call netcdf_check( nf90_def_var(nc%id, nc%rhill_varname, nc%out_type, [nc%name_dimid, nc%time_dimid], nc%rhill_varid), "swiftest_io_netcdf_initialize_output nf90_def_var rhill_varid" ) + end if + + if (param%lclose) then + call netcdf_check( nf90_def_var(nc%id, nc%radius_varname, nc%out_type, [nc%name_dimid, nc%time_dimid], nc%radius_varid), "swiftest_io_netcdf_initialize_output nf90_def_var radius_varid" ) + + call netcdf_check( nf90_def_var(nc%id, nc%origin_time_varname, nc%out_type, nc%name_dimid, nc%origin_time_varid), "swiftest_io_netcdf_initialize_output nf90_def_var origin_time_varid" ) + call netcdf_check( nf90_def_var(nc%id, nc%origin_type_varname, NF90_CHAR, [nc%str_dimid, nc%name_dimid], & + nc%origin_type_varid), "swiftest_io_netcdf_initialize_output nf90_create" ) + call netcdf_check( nf90_def_var(nc%id, nc%origin_rh_varname, nc%out_type, [nc%space_dimid, nc%name_dimid], nc%origin_rh_varid), "swiftest_io_netcdf_initialize_output nf90_def_var origin_rh_varid" ) + call netcdf_check( nf90_def_var(nc%id, nc%origin_vh_varname, nc%out_type, [nc%space_dimid, nc%name_dimid], nc%origin_vh_varid), "swiftest_io_netcdf_initialize_output nf90_def_var origin_vh_varid" ) + + call netcdf_check( nf90_def_var(nc%id, nc%collision_id_varname, NF90_INT, nc%name_dimid, nc%collision_id_varid), "swiftest_io_netcdf_initialize_output nf90_def_var collision_id_varid" ) + call netcdf_check( nf90_def_var(nc%id, nc%discard_time_varname, nc%out_type, nc%name_dimid, nc%discard_time_varid), "swiftest_io_netcdf_initialize_output nf90_def_var discard_time_varid" ) + call netcdf_check( nf90_def_var(nc%id, nc%discard_rh_varname, nc%out_type, [nc%space_dimid, nc%name_dimid], nc%discard_rh_varid), "swiftest_io_netcdf_initialize_output nf90_def_var discard_rh_varid" ) + call netcdf_check( nf90_def_var(nc%id, nc%discard_vh_varname, nc%out_type, [nc%space_dimid, nc%name_dimid], nc%discard_vh_varid), "swiftest_io_netcdf_initialize_output nf90_def_var discard_vh_varid" ) + call netcdf_check( nf90_def_var(nc%id, nc%discard_body_id_varname, NF90_INT, nc%name_dimid, nc%discard_body_id_varid), "swiftest_io_netcdf_initialize_output nf90_def_var discard_body_id_varid" ) + end if + + if (param%lrotation) then + call netcdf_check( nf90_def_var(nc%id, nc%Ip_varname, nc%out_type, [nc%space_dimid, nc%name_dimid, nc%time_dimid], nc%Ip_varid), "swiftest_io_netcdf_initialize_output nf90_def_var Ip_varid" ) + call netcdf_check( nf90_def_var(nc%id, nc%rot_varname, nc%out_type, [nc%space_dimid, nc%name_dimid, nc%time_dimid], nc%rot_varid), "swiftest_io_netcdf_initialize_output nf90_def_var rot_varid" ) + end if + + ! if (param%ltides) then + ! call netcdf_check( nf90_def_var(nc%id, nc%k2_varname, nc%out_type, [nc%name_dimid, nc%time_dimid], nc%k2_varid), "swiftest_io_netcdf_initialize_output nf90_def_var k2_varid" ) + ! call netcdf_check( nf90_def_var(nc%id, nc%q_varname, nc%out_type, [nc%name_dimid, nc%time_dimid], nc%Q_varid), "swiftest_io_netcdf_initialize_output nf90_def_var Q_varid" ) + ! end if + + if (param%lenergy) then + call netcdf_check( nf90_def_var(nc%id, nc%ke_orb_varname, nc%out_type, nc%time_dimid, nc%KE_orb_varid), "swiftest_io_netcdf_initialize_output nf90_def_var KE_orb_varid" ) + call netcdf_check( nf90_def_var(nc%id, nc%ke_spin_varname, nc%out_type, nc%time_dimid, nc%KE_spin_varid), "swiftest_io_netcdf_initialize_output nf90_def_var KE_spin_varid" ) + call netcdf_check( nf90_def_var(nc%id, nc%pe_varname, nc%out_type, nc%time_dimid, nc%PE_varid), "swiftest_io_netcdf_initialize_output nf90_def_var PE_varid" ) + call netcdf_check( nf90_def_var(nc%id, nc%L_orb_varname, nc%out_type, [nc%space_dimid, nc%time_dimid], nc%L_orb_varid), "swiftest_io_netcdf_initialize_output nf90_def_var L_orb_varid" ) + call netcdf_check( nf90_def_var(nc%id, nc%Lspin_varname, nc%out_type, [nc%space_dimid, nc%time_dimid], nc%Lspin_varid), "swiftest_io_netcdf_initialize_output nf90_def_var Lspin_varid" ) + call netcdf_check( nf90_def_var(nc%id, nc%L_escape_varname, nc%out_type, [nc%space_dimid, nc%time_dimid], nc%L_escape_varid), "swiftest_io_netcdf_initialize_output nf90_def_var L_escape_varid" ) + call netcdf_check( nf90_def_var(nc%id, nc%Ecollisions_varname, nc%out_type, nc%time_dimid, nc%Ecollisions_varid), "swiftest_io_netcdf_initialize_output nf90_def_var Ecollisions_varid" ) + call netcdf_check( nf90_def_var(nc%id, nc%Euntracked_varname, nc%out_type, nc%time_dimid, nc%Euntracked_varid), "swiftest_io_netcdf_initialize_output nf90_def_var Euntracked_varid" ) + call netcdf_check( nf90_def_var(nc%id, nc%GMescape_varname, nc%out_type, nc%time_dimid, nc%GMescape_varid), "swiftest_io_netcdf_initialize_output nf90_def_var GMescape_varid" ) + end if + + call netcdf_check( nf90_def_var(nc%id, nc%j2rp2_varname, nc%out_type, nc%time_dimid, nc%j2rp2_varid), "swiftest_io_netcdf_initialize_output nf90_def_var j2rp2_varid" ) + call netcdf_check( nf90_def_var(nc%id, nc%j4rp4_varname, nc%out_type, nc%time_dimid, nc%j4rp4_varid), "swiftest_io_netcdf_initialize_output nf90_def_var j4rp4_varid" ) + + + ! Set fill mode to NaN for all variables + call netcdf_check( nf90_inquire(nc%id, nVariables=nvar), "swiftest_io_netcdf_initialize_output nf90_inquire nVariables" ) + do varid = 1, nvar + call netcdf_check( nf90_inquire_variable(nc%id, varid, xtype=vartype, ndims=ndims), "swiftest_io_netcdf_initialize_output nf90_inquire_variable" ) + select case(vartype) + case(NF90_INT) + call netcdf_check( nf90_def_var_fill(nc%id, varid, NO_FILL, NF90_FILL_INT), "swiftest_io_netcdf_initialize_output nf90_def_var_fill NF90_INT" ) + case(NF90_FLOAT) + call netcdf_check( nf90_def_var_fill(nc%id, varid, NO_FILL, sfill), "swiftest_io_netcdf_initialize_output nf90_def_var_fill NF90_FLOAT" ) + case(NF90_DOUBLE) + call netcdf_check( nf90_def_var_fill(nc%id, varid, NO_FILL, dfill), "swiftest_io_netcdf_initialize_output nf90_def_var_fill NF90_DOUBLE" ) + case(NF90_CHAR) + call netcdf_check( nf90_def_var_fill(nc%id, varid, NO_FILL, 0), "swiftest_io_netcdf_initialize_output nf90_def_var_fill NF90_CHAR" ) + end select + end do + + ! Set special fill mode for discard time so that we can make use of it for non-discarded bodies. + select case (vartype) + case(NF90_FLOAT) + call netcdf_check( nf90_def_var_fill(nc%id, nc%discard_time_varid, NO_FILL, huge(1.0_SP)), "swiftest_io_netcdf_initialize_output nf90_def_var_fill discard_time NF90_FLOAT" ) + case(NF90_DOUBLE) + call netcdf_check( nf90_def_var_fill(nc%id, nc%discard_time_varid, NO_FILL, huge(1.0_DP)), "swiftest_io_netcdf_initialize_output nf90_def_var_fill discard_time NF90_DOUBLE" ) + end select + + ! Take the file out of define mode + call netcdf_check( nf90_enddef(nc%id), "swiftest_io_netcdf_initialize_output nf90_enddef" ) + + ! Add in the space dimension coordinates + call netcdf_check( nf90_put_var(nc%id, nc%space_varid, nc%space_coords, start=[1], count=[NDIM]), "swiftest_io_netcdf_initialize_output nf90_put_var space" ) + + end associate + return + + 667 continue + write(*,*) "Error creating NetCDF output file. " // trim(adjustl(errmsg)) + call util_exit(FAILURE) + end subroutine swiftest_io_netcdf_initialize_output + + + module subroutine swiftest_io_netcdf_open(self, param, readonly) + !! author: Carlisle A. Wishard, Dana Singh, and David A. Minton + !! + !! Opens a NetCDF file and does the variable inquiries to activate variable ids + implicit none + ! Arguments + class(swiftest_io_netcdf_parameters), intent(inout) :: self !! Parameters used to identify a particular NetCDF dataset + class(base_parameters), intent(in) :: param !! Current run configuration parameters + logical, optional, intent(in) :: readonly !! Logical flag indicating that this should be open read only + ! Internals + integer(I4B) :: mode, status + character(len=STRMAX) :: errmsg + + mode = NF90_WRITE + if (present(readonly)) then + if (readonly) mode = NF90_NOWRITE + end if + + associate(nc => self) + + write(errmsg,*) "swiftest_io_netcdf_open nf90_open ",trim(adjustl(nc%file_name)) + call netcdf_check( nf90_open(nc%file_name, mode, nc%id), errmsg) + + ! Dimensions + call netcdf_check( nf90_inq_dimid(nc%id, nc%time_dimname, nc%time_dimid), "swiftest_io_netcdf_open nf90_inq_dimid time_dimid" ) + call netcdf_check( nf90_inq_dimid(nc%id, nc%space_dimname, nc%space_dimid), "swiftest_io_netcdf_open nf90_inq_dimid space_dimid" ) + call netcdf_check( nf90_inq_dimid(nc%id, nc%name_dimname, nc%name_dimid), "swiftest_io_netcdf_open nf90_inq_dimid name_dimid" ) + call netcdf_check( nf90_inq_dimid(nc%id, nc%str_dimname, nc%str_dimid), "swiftest_io_netcdf_open nf90_inq_dimid str_dimid" ) + + ! Dimension coordinates + call netcdf_check( nf90_inq_varid(nc%id, nc%time_dimname, nc%time_varid), "swiftest_io_netcdf_open nf90_inq_varid time_varid" ) + call netcdf_check( nf90_inq_varid(nc%id, nc%space_dimname, nc%space_varid), "swiftest_io_netcdf_open nf90_inq_varid space_varid" ) + call netcdf_check( nf90_inq_varid(nc%id, nc%name_dimname, nc%name_varid), "swiftest_io_netcdf_open nf90_inq_varid name_varid" ) + + ! Required Variables + call netcdf_check( nf90_inq_varid(nc%id, nc%id_varname, nc%id_varid), "swiftest_io_netcdf_open nf90_inq_varid name_varid" ) + call netcdf_check( nf90_inq_varid(nc%id, nc%gmass_varname, nc%Gmass_varid), "swiftest_io_netcdf_open nf90_inq_varid Gmass_varid" ) + + if ((param%out_form == "XV") .or. (param%out_form == "XVEL")) then + call netcdf_check( nf90_inq_varid(nc%id, nc%rh_varname, nc%rh_varid), "swiftest_io_netcdf_open nf90_inq_varid rh_varid" ) + call netcdf_check( nf90_inq_varid(nc%id, nc%vh_varname, nc%vh_varid), "swiftest_io_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(nc%id, nc%gr_pseudo_vh_varname, nc%gr_pseudo_vh_varid) + nc%lpseudo_vel_exists = (status == nf90_noerr) + if (param%lrestart .and. .not.nc%lpseudo_vel_exists) then + write(*,*) "Warning! Pseudovelocity not found in input file for GR enabled run. If this is a restarted run, bit-identical trajectories are not guarunteed!" + end if + + end if + end if + + if ((param%out_form == "EL") .or. (param%out_form == "XVEL")) then + call netcdf_check( nf90_inq_varid(nc%id, nc%a_varname, nc%a_varid), "swiftest_io_netcdf_open nf90_inq_varid a_varid" ) + call netcdf_check( nf90_inq_varid(nc%id, nc%e_varname, nc%e_varid), "swiftest_io_netcdf_open nf90_inq_varid e_varid" ) + call netcdf_check( nf90_inq_varid(nc%id, nc%inc_varname, nc%inc_varid), "swiftest_io_netcdf_open nf90_inq_varid inc_varid" ) + call netcdf_check( nf90_inq_varid(nc%id, nc%capom_varname, nc%capom_varid), "swiftest_io_netcdf_open nf90_inq_varid capom_varid" ) + call netcdf_check( nf90_inq_varid(nc%id, nc%omega_varname, nc%omega_varid), "swiftest_io_netcdf_open nf90_inq_varid omega_varid" ) + call netcdf_check( nf90_inq_varid(nc%id, nc%capm_varname, nc%capm_varid), "swiftest_io_netcdf_open nf90_inq_varid capm_varid" ) + end if + + if (param%lclose) then + call netcdf_check( nf90_inq_varid(nc%id, nc%radius_varname, nc%radius_varid), "swiftest_io_netcdf_open nf90_inq_varid radius_varid" ) + end if + + if (param%lrotation) then + call netcdf_check( nf90_inq_varid(nc%id, nc%Ip_varname, nc%Ip_varid), "swiftest_io_netcdf_open nf90_inq_varid Ip_varid" ) + call netcdf_check( nf90_inq_varid(nc%id, nc%rot_varname, nc%rot_varid), "swiftest_io_netcdf_open nf90_inq_varid rot_varid" ) + end if + + ! if (param%ltides) then + ! call netcdf_check( nf90_inq_varid(nc%id, nc%k2_varname, nc%k2_varid), "swiftest_io_netcdf_open nf90_inq_varid k2_varid" ) + ! call netcdf_check( nf90_inq_varid(nc%id, nc%q_varname, nc%Q_varid), "swiftest_io_netcdf_open nf90_inq_varid Q_varid" ) + ! end if + + ! Optional Variables + if (param%lrhill_present) then + status = nf90_inq_varid(nc%id, nc%rhill_varname, nc%rhill_varid) + if (status /= nf90_noerr) write(*,*) "Warning! RHILL variable not set in input file. Calculating." + end if + + ! Optional variables The User Doesn't Need to Know About + status = nf90_inq_varid(nc%id, nc%npl_varname, nc%npl_varid) + status = nf90_inq_varid(nc%id, nc%ntp_varname, nc%ntp_varid) + status = nf90_inq_varid(nc%id, nc%j2rp2_varname, nc%j2rp2_varid) + status = nf90_inq_varid(nc%id, nc%j4rp4_varname, nc%j4rp4_varid) + status = nf90_inq_varid(nc%id, nc%ptype_varname, nc%ptype_varid) + status = nf90_inq_varid(nc%id, nc%varpi_varname, nc%varpi_varid) + status = nf90_inq_varid(nc%id, nc%lam_varname, nc%lam_varid) + status = nf90_inq_varid(nc%id, nc%f_varname, nc%f_varid) + status = nf90_inq_varid(nc%id, nc%cape_varname, nc%cape_varid) + + if (param%integrator == INT_SYMBA) then + status = nf90_inq_varid(nc%id, nc%nplm_varname, nc%nplm_varid) + end if + + if (param%lclose) then + status = nf90_inq_varid(nc%id, nc%origin_type_varname, nc%origin_type_varid) + status = nf90_inq_varid(nc%id, nc%origin_time_varname, nc%origin_time_varid) + status = nf90_inq_varid(nc%id, nc%origin_rh_varname, nc%origin_rh_varid) + status = nf90_inq_varid(nc%id, nc%origin_vh_varname, nc%origin_vh_varid) + status = nf90_inq_varid(nc%id, nc%collision_id_varname, nc%collision_id_varid) + status = nf90_inq_varid(nc%id, nc%discard_time_varname, nc%discard_time_varid) + status = nf90_inq_varid(nc%id, nc%discard_rh_varname, nc%discard_rh_varid) + status = nf90_inq_varid(nc%id, nc%discard_vh_varname, nc%discard_vh_varid) + status = nf90_inq_varid(nc%id, nc%discard_body_id_varname, nc%discard_body_id_varid) + end if + + if (param%lenergy) then + status = nf90_inq_varid(nc%id, nc%ke_orb_varname, nc%KE_orb_varid) + status = nf90_inq_varid(nc%id, nc%ke_spin_varname, nc%KE_spin_varid) + status = nf90_inq_varid(nc%id, nc%pe_varname, nc%PE_varid) + status = nf90_inq_varid(nc%id, nc%L_orb_varname, nc%L_orb_varid) + status = nf90_inq_varid(nc%id, nc%Lspin_varname, nc%Lspin_varid) + status = nf90_inq_varid(nc%id, nc%L_escape_varname, nc%L_escape_varid) + status = nf90_inq_varid(nc%id, nc%Ecollisions_varname, nc%Ecollisions_varid) + status = nf90_inq_varid(nc%id, nc%Euntracked_varname, nc%Euntracked_varid) + status = nf90_inq_varid(nc%id, nc%GMescape_varname, nc%GMescape_varid) + end if + + end associate + + return + end subroutine swiftest_io_netcdf_open + + + module function swiftest_io_netcdf_read_frame_system(self, nc, param) result(ierr) + !! author: The Purdue Swiftest Team - David A. Minton, Carlisle A. Wishard, Jennifer L.L. Pouplin, and Jacob R. Elliott + !! + !! Read a frame (header plus records for each massive body and active test particle) from an output binary file + implicit none + ! Arguments + class(swiftest_nbody_system), intent(inout) :: self !! Swiftest system object + class(base_io_netcdf_parameters), intent(inout) :: nc !! Parameters used to identify a particular NetCDF dataset + class(base_parameters), intent(inout) :: param !! Current run configuration parameters + ! Return + integer(I4B) :: ierr !! Error code: returns 0 if the read is successful + ! Internals + integer(I4B) :: i, tslot, idmax, npl_check, ntp_check, nplm_check, t_max, str_max, status + real(DP), dimension(:), allocatable :: rtemp + real(DP), dimension(:,:), allocatable :: vectemp + integer(I4B), dimension(:), allocatable :: itemp + logical, dimension(:), allocatable :: validmask, tpmask, plmask + + tslot = param%ioutput + + call nc%open(param, readonly=.true.) + call self%read_hdr(nc, param) + select type(param) + class is (swiftest_parameters) + associate(cb => self%cb, pl => self%pl, tp => self%tp, npl => self%pl%nbody, ntp => self%tp%nbody) + + call pl%setup(npl, param) + call tp%setup(ntp, param) + + call netcdf_check( nf90_inquire_dimension(nc%id, nc%name_dimid, len=idmax), "swiftest_io_netcdf_read_frame_system nf90_inquire_dimension name_dimid" ) + allocate(rtemp(idmax)) + allocate(vectemp(NDIM,idmax)) + allocate(itemp(idmax)) + allocate(validmask(idmax)) + allocate(tpmask(idmax)) + allocate(plmask(idmax)) + call netcdf_check( nf90_inquire_dimension(nc%id, nc%time_dimid, len=t_max), "swiftest_io_netcdf_read_frame_system nf90_inquire_dimension time_dimid" ) + call netcdf_check( nf90_inquire_dimension(nc%id, nc%str_dimid, len=str_max), "swiftest_io_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 netcdf_check( nf90_get_var(nc%id, nc%rh_varid, vectemp(:,:), start=[1, 1, tslot]), "swiftest_io_netcdf_read_frame_system filter pass nf90_getvar rh_varid" ) + validmask(:) = vectemp(1,:) == vectemp(1,:) + else + call netcdf_check( nf90_get_var(nc%id, nc%a_varid, rtemp(:), start=[1, tslot]), "swiftest_io_netcdf_read_frame_system filter pass nf90_getvar a_varid" ) + validmask(:) = rtemp(:) == rtemp(:) + end if + + ! Next, filter only bodies that don't have mass (test particles) + call netcdf_check( nf90_get_var(nc%id, nc%Gmass_varid, rtemp(:), start=[1, tslot]), "swiftest_io_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 + + ! Check to make sure the number of bodies is correct + npl_check = count(plmask(:)) + ntp_check = count(tpmask(:)) + + if (npl_check /= npl) then + write(*,*) "Error reading in NetCDF file: The recorded value of npl does not match the number of active massive bodies" + call util_exit(failure) + end if + + if (ntp_check /= ntp) then + write(*,*) "Error reading in NetCDF file: The recorded value of ntp does not match the number of active test particles" + call util_exit(failure) + end if + + if (param%integrator == INT_SYMBA) then + nplm_check = count(pack(rtemp,plmask) > param%GMTINY ) + if (nplm_check /= pl%nplm) then + write(*,*) "Error reading in NetCDF file: The recorded value of nplm does not match the number of active fully interacting massive bodies" + call util_exit(failure) + end if + end if + + ! Now read in each variable and split the outputs by body type + if ((param%in_form == "XV") .or. (param%in_form == "XVEL")) then + call netcdf_check( nf90_get_var(nc%id, nc%rh_varid, vectemp, start=[1, 1, tslot], count=[NDIM,idmax,1]), "swiftest_io_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 + + if (param%lgr .and. nc%lpseudo_vel_exists) then + call netcdf_check( nf90_get_var(nc%id, nc%gr_pseudo_vh_varid, vectemp, start=[1, 1, tslot], count=[NDIM,idmax,1]), "swiftest_io_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 netcdf_check( nf90_get_var(nc%id, nc%vh_varid, vectemp, start=[1, 1, tslot], count=[NDIM,idmax,1]), "swiftest_io_netcdf_read_frame_system nf90_getvar vh_varid" ) + do i = 1, NDIM + if (npl > 0) pl%vh(i,:) = pack(vectemp(i,:), plmask(:)) + if (ntp > 0) tp%vh(i,:) = pack(vectemp(i,:), tpmask(:)) + end do + end if + end if + + if ((param%in_form == "EL") .or. (param%in_form == "XVEL")) then + call netcdf_check( nf90_get_var(nc%id, nc%a_varid, rtemp, start=[1, tslot], count=[idmax,1]), "swiftest_io_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 netcdf_check( nf90_get_var(nc%id, nc%e_varid, rtemp, start=[1, tslot], count=[idmax,1]), "swiftest_io_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 netcdf_check( nf90_get_var(nc%id, nc%inc_varid, rtemp, start=[1, tslot], count=[idmax,1]), "swiftest_io_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 netcdf_check( nf90_get_var(nc%id, nc%capom_varid, rtemp, start=[1, tslot], count=[idmax,1]), "swiftest_io_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 netcdf_check( nf90_get_var(nc%id, nc%omega_varid, rtemp, start=[1, tslot], count=[idmax,1]), "swiftest_io_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 netcdf_check( nf90_get_var(nc%id, nc%capm_varid, rtemp, start=[1, tslot], count=[idmax,1]), "swiftest_io_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)) + if (npl > 0) pl%capm(:) = pack(rtemp, plmask) + if (ntp > 0) tp%capm(:) = pack(rtemp, tpmask) + + end if + + call netcdf_check( nf90_get_var(nc%id, nc%Gmass_varid, rtemp, start=[1, tslot], count=[idmax,1]), "swiftest_io_netcdf_read_frame_system nf90_getvar Gmass_varid" ) + cb%Gmass = rtemp(1) + cb%mass = cb%Gmass / param%GU + + ! Set initial central body mass for Helio bookkeeping + cb%GM0 = cb%Gmass + + + if (npl > 0) then + pl%Gmass(:) = pack(rtemp, plmask) + pl%mass(:) = pl%Gmass(:) / param%GU + + if (param%lrhill_present) then + call netcdf_check( nf90_get_var(nc%id, nc%rhill_varid, rtemp, start=[1, tslot], count=[idmax,1]), "swiftest_io_netcdf_read_frame_system nf90_getvar rhill_varid" ) + pl%rhill(:) = pack(rtemp, plmask) + end if + end if + + if (param%lclose) then + call netcdf_check( nf90_get_var(nc%id, nc%radius_varid, rtemp, start=[1, tslot], count=[idmax,1]), "swiftest_io_netcdf_read_frame_system nf90_getvar radius_varid" ) + cb%radius = rtemp(1) + + ! Set initial central body radius for SyMBA bookkeeping + cb%R0 = cb%radius + if (npl > 0) pl%radius(:) = pack(rtemp, plmask) + else + cb%radius = param%rmin + if (npl > 0) pl%radius(:) = 0.0_DP + end if + + if (param%lrotation) then + call netcdf_check( nf90_get_var(nc%id, nc%Ip_varid, vectemp, start=[1, 1, tslot], count=[NDIM,idmax,1]), "swiftest_io_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 netcdf_check( nf90_get_var(nc%id, nc%rot_varid, vectemp, start=[1, 1, tslot], count=[NDIM,idmax,1]), "swiftest_io_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 bookkeeping + cb%L0(:) = cb%Ip(3) * cb%GM0 * cb%R0**2 * cb%rot(:) + end if + + ! if (param%ltides) then + ! call netcdf_check( nf90_get_var(nc%id, nc%k2_varid, rtemp, start=[1, tslot]), "swiftest_io_netcdf_read_frame_system nf90_getvar k2_varid" ) + ! cb%k2 = rtemp(1) + ! if (npl > 0) pl%k2(:) = pack(rtemp, plmask) + + ! call netcdf_check( nf90_get_var(nc%id, nc%Q_varid, rtemp, start=[1, tslot]), "swiftest_io_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(nc%id, nc%j2rp2_varname, nc%j2rp2_varid) + if (status == nf90_noerr) then + call netcdf_check( nf90_get_var(nc%id, nc%j2rp2_varid, cb%j2rp2, start=[tslot]), "swiftest_io_netcdf_read_frame_system nf90_getvar j2rp2_varid" ) + else + cb%j2rp2 = 0.0_DP + end if + + status = nf90_inq_varid(nc%id, nc%j4rp4_varname, nc%j4rp4_varid) + if (status == nf90_noerr) then + call netcdf_check( nf90_get_var(nc%id, nc%j4rp4_varid, cb%j4rp4, start=[tslot]), "swiftest_io_netcdf_read_frame_system nf90_getvar j4rp4_varid" ) + else + cb%j4rp4 = 0.0_DP + end if + + call self%read_particle_info(nc, param, plmask, tpmask) + + if (param%in_form == "EL") then + call pl%el2xv(cb) + call tp%el2xv(cb) + end if + ! if this is a GR-enabled run, check to see if we got the pseudovelocities in. Otherwise, we'll need to generate them. + if (param%lgr .and. .not.(nc%lpseudo_vel_exists)) then + call pl%set_mu(cb) + call tp%set_mu(cb) + call pl%v2pv(param) + call tp%v2pv(param) + end if + + end associate + end select + + call nc%close() + + ierr = 0 + return + + 667 continue + write(*,*) "Error reading system frame in io_netcdf_read_frame_system" + + end function swiftest_io_netcdf_read_frame_system + + + module subroutine swiftest_io_netcdf_read_hdr_system(self, nc, param) + !! author: David A. Minton + !! + !! Reads header information (variables that change with time, but not particle id). + !! This subroutine swiftest_significantly improves the output over the original binary file, allowing us to track energy, momentum, and other quantities that + !! previously were handled as separate output files. + implicit none + ! Arguments + class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nbody system object + class(base_io_netcdf_parameters), intent(inout) :: nc !! Parameters used to for reading a NetCDF dataset to file + class(base_parameters), intent(inout) :: param !! Current run configuration parameters + ! Internals + integer(I4B) :: tslot, status, idmax + real(DP), dimension(:), allocatable :: gmtemp + logical, dimension(:), allocatable :: plmask, tpmask, plmmask + + + tslot = param%ioutput + call netcdf_check( nf90_inquire_dimension(nc%id, nc%name_dimid, len=idmax), "swiftest_io_netcdf_read_hdr_system nf90_inquire_dimension name_dimid" ) + call netcdf_check( nf90_get_var(nc%id, nc%time_varid, self%t, start=[tslot]), "swiftest_io_netcdf_read_hdr_system nf90_getvar time_varid" ) + + allocate(gmtemp(idmax)) + allocate(tpmask(idmax)) + allocate(plmask(idmax)) + allocate(plmmask(idmax)) + + call netcdf_check( nf90_get_var(nc%id, nc%Gmass_varid, gmtemp, start=[1,1], count=[idmax,1]), "swiftest_io_netcdf_read_hdr_system nf90_getvar Gmass_varid" ) + + plmask(:) = gmtemp(:) == gmtemp(:) + tpmask(:) = .not. plmask(:) + plmask(1) = .false. ! This is the central body + plmmask(:) = plmask(:) + where(plmask(:)) + plmmask(:) = gmtemp(:) > param%GMTINY + endwhere + + status = nf90_inq_varid(nc%id, nc%npl_varname, nc%npl_varid) + if (status == nf90_noerr) then + call netcdf_check( nf90_get_var(nc%id, nc%npl_varid, self%pl%nbody, start=[tslot]), "swiftest_io_netcdf_read_hdr_system nf90_getvar npl_varid" ) + else + self%pl%nbody = count(plmask(:)) + end if + + status = nf90_inq_varid(nc%id, nc%ntp_varname, nc%ntp_varid) + if (status == nf90_noerr) then + call netcdf_check( nf90_get_var(nc%id, nc%ntp_varid, self%tp%nbody, start=[tslot]), "swiftest_io_netcdf_read_hdr_system nf90_getvar ntp_varid" ) + else + self%tp%nbody = count(tpmask(:)) + end if + + if (param%integrator == INT_SYMBA) then + status = nf90_inq_varid(nc%id, nc%nplm_varname, nc%nplm_varid) + if (status == nf90_noerr) then + call netcdf_check( nf90_get_var(nc%id, nc%nplm_varid, self%pl%nplm, start=[tslot]), "swiftest_io_netcdf_read_hdr_system nf90_getvar nplm_varid" ) + else + self%pl%nplm = count(plmmask(:)) + end if + end if + + if (param%lenergy) then + status = nf90_inq_varid(nc%id, nc%ke_orb_varname, nc%KE_orb_varid) + if (status == nf90_noerr) call netcdf_check( nf90_get_var(nc%id, nc%KE_orb_varid, self%ke_orbit, start=[tslot]), "swiftest_io_netcdf_read_hdr_system nf90_getvar KE_orb_varid" ) + status = nf90_inq_varid(nc%id, nc%ke_spin_varname, nc%KE_spin_varid) + if (status == nf90_noerr) call netcdf_check( nf90_get_var(nc%id, nc%KE_spin_varid, self%ke_spin, start=[tslot]), "swiftest_io_netcdf_read_hdr_system nf90_getvar KE_spin_varid" ) + status = nf90_inq_varid(nc%id, nc%pe_varname, nc%PE_varid) + if (status == nf90_noerr) call netcdf_check( nf90_get_var(nc%id, nc%PE_varid, self%pe, start=[tslot]), "swiftest_io_netcdf_read_hdr_system nf90_getvar PE_varid" ) + status = nf90_inq_varid(nc%id, nc%L_orb_varname, nc%L_orb_varid) + if (status == nf90_noerr) call netcdf_check( nf90_get_var(nc%id, nc%L_orb_varid, self%Lorbit(:), start=[1,tslot], count=[NDIM,1]), "swiftest_io_netcdf_read_hdr_system nf90_getvar L_orb_varid" ) + status = nf90_inq_varid(nc%id, nc%Lspin_varname, nc%Lspin_varid) + if (status == nf90_noerr) call netcdf_check( nf90_get_var(nc%id, nc%Lspin_varid, self%Lspin(:), start=[1,tslot], count=[NDIM,1]), "swiftest_io_netcdf_read_hdr_system nf90_getvar Lspin_varid" ) + status = nf90_inq_varid(nc%id, nc%L_escape_varname, nc%L_escape_varid) + if (status == nf90_noerr) call netcdf_check( nf90_get_var(nc%id, nc%L_escape_varid, self%Lescape(:), start=[1, tslot], count=[NDIM,1]), "swiftest_io_netcdf_read_hdr_system nf90_getvar L_escape_varid" ) + status = nf90_inq_varid(nc%id, nc%Ecollisions_varname, nc%Ecollisions_varid) + if (status == nf90_noerr) call netcdf_check( nf90_get_var(nc%id, nc%Ecollisions_varid, self%Ecollisions, start=[tslot]), "swiftest_io_netcdf_read_hdr_system nf90_getvar Ecollisions_varid" ) + status = nf90_inq_varid(nc%id, nc%Euntracked_varname, nc%Euntracked_varid) + if (status == nf90_noerr) call netcdf_check( nf90_get_var(nc%id, nc%Euntracked_varid, self%Euntracked, start=[tslot]), "swiftest_io_netcdf_read_hdr_system nf90_getvar Euntracked_varid" ) + status = nf90_inq_varid(nc%id, nc%GMescape_varname, nc%GMescape_varid) + if (status == nf90_noerr) call netcdf_check( nf90_get_var(nc%id, nc%GMescape_varid, self%GMescape, start=[tslot]), "swiftest_io_netcdf_read_hdr_system nf90_getvar GMescape_varid" ) + end if + + return + end subroutine swiftest_io_netcdf_read_hdr_system + + + module subroutine swiftest_io_netcdf_read_particle_info_system(self, nc, param, plmask, tpmask) + !! author: Carlisle A. Wishard, Dana Singh, and David A. Minton + !! + !! Reads particle information metadata from file + implicit none + ! Arguments + class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nbody system object + class(base_io_netcdf_parameters), intent(inout) :: nc !! Parameters used to identify a particular NetCDF dataset + class(base_parameters), intent(inout) :: param !! Current run configuration parameters + logical, dimension(:), intent(in) :: plmask !! Logical array indicating which index values belong to massive bodies + logical, dimension(:), intent(in) :: tpmask !! Logical array indicating which index values belong to test particles + + ! Internals + integer(I4B) :: i, idmax, status + real(DP), dimension(:), allocatable :: rtemp + real(DP), dimension(:,:), allocatable :: vectemp + integer(I4B), dimension(:), allocatable :: itemp + character(len=NAMELEN), dimension(:), allocatable :: ctemp + integer(I4B), dimension(:), allocatable :: plind, tpind + + ! This string of spaces of length NAMELEN is used to clear out any old data left behind inside the string variables + idmax = size(plmask) + allocate(rtemp(idmax)) + allocate(vectemp(NDIM,idmax)) + allocate(itemp(idmax)) + allocate(ctemp(idmax)) + + associate(cb => self%cb, pl => self%pl, tp => self%tp, npl => self%pl%nbody, ntp => self%tp%nbody) + + if (npl > 0) then + pl%status(:) = ACTIVE + pl%lmask(:) = .true. + do i = 1, npl + call pl%info(i)%set_value(status="ACTIVE") + end do + allocate(plind(npl)) + plind(:) = pack([(i, i = 1, idmax)], plmask(:)) + end if + if (ntp > 0) then + tp%status(:) = ACTIVE + tp%lmask(:) = .true. + do i = 1, ntp + call tp%info(i)%set_value(status="ACTIVE") + end do + allocate(tpind(ntp)) + tpind(:) = pack([(i, i = 1, idmax)], tpmask(:)) + end if + + call netcdf_check( nf90_get_var(nc%id, nc%id_varid, itemp), "swiftest_io_netcdf_read_particle_info_system nf90_getvar id_varid" ) + cb%id = itemp(1) + pl%id(:) = pack(itemp, plmask) + tp%id(:) = pack(itemp, tpmask) + cb%id = 0 + pl%id(:) = pack([(i,i=0,idmax-1)],plmask) + tp%id(:) = pack([(i,i=0,idmax-1)],tpmask) + + call netcdf_check( nf90_get_var(nc%id, nc%name_varid, ctemp, count=[NAMELEN, idmax]), "swiftest_io_netcdf_read_particle_info_system nf90_getvar name_varid" ) + call cb%info%set_value(name=ctemp(1)) + do i = 1, npl + call pl%info(i)%set_value(name=ctemp(plind(i))) + end do + do i = 1, ntp + call tp%info(i)%set_value(name=ctemp(tpind(i))) + end do + + status = nf90_get_var(nc%id, nc%ptype_varid, ctemp, count=[NAMELEN, idmax]) + if (status /= nf90_noerr) then ! Set default particle types + call cb%info%set_value(particle_type=CB_TYPE_NAME) + + ! Handle semi-interacting bodies in SyMBA + select type(pl) + class is (symba_pl) + select type (param) + class is (swiftest_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 + + call cb%info%set_value(status="ACTIVE") + + if (param%lclose) then + + status = nf90_inq_varid(nc%id, nc%origin_type_varname, nc%origin_type_varid) + if (status == nf90_noerr) then + call netcdf_check( nf90_get_var(nc%id, nc%origin_type_varid, ctemp, count=[NAMELEN, idmax]), "swiftest_io_netcdf_read_particle_info_system nf90_getvar origin_type_varid" ) + else + ctemp = "Initial Conditions" + end if + + call cb%info%set_value(origin_type=ctemp(1)) + do i = 1, npl + call pl%info(i)%set_value(origin_type=ctemp(plind(i))) + end do + do i = 1, ntp + call tp%info(i)%set_value(origin_type=ctemp(tpind(i))) + end do + + status = nf90_inq_varid(nc%id, nc%origin_time_varname, nc%origin_time_varid) + if (status == nf90_noerr) then + call netcdf_check( nf90_get_var(nc%id, nc%origin_time_varid, rtemp), "swiftest_io_netcdf_read_particle_info_system nf90_getvar origin_time_varid" ) + else + rtemp = param%t0 + end if + + call cb%info%set_value(origin_time=rtemp(1)) + do i = 1, npl + call pl%info(i)%set_value(origin_time=rtemp(plind(i))) + end do + do i = 1, ntp + call tp%info(i)%set_value(origin_time=rtemp(tpind(i))) + end do + + status = nf90_inq_varid(nc%id, nc%origin_rh_varname, nc%origin_rh_varid) + if (status == nf90_noerr) then + call netcdf_check( nf90_get_var(nc%id, nc%origin_rh_varid, vectemp(:,:)), "swiftest_io_netcdf_read_particle_info_system nf90_getvar origin_rh_varid" ) + else if ((param%out_form == "XV") .or. (param%out_form == "XVEL")) then + call netcdf_check( nf90_get_var(nc%id, nc%rh_varid, vectemp(:,:)), "swiftest_io_netcdf_read_particle_info_system nf90_getvar rh_varid" ) + else + vectemp(:,:) = 0._DP + end if + + do i = 1, npl + call pl%info(i)%set_value(origin_rh=vectemp(:,plind(i))) + end do + do i = 1, ntp + call tp%info(i)%set_value(origin_rh=vectemp(:,tpind(i))) + end do + + status = nf90_inq_varid(nc%id, nc%origin_vh_varname, nc%origin_vh_varid) + if (status == nf90_noerr) then + call netcdf_check( nf90_get_var(nc%id, nc%origin_vh_varid, vectemp(:,:)), "swiftest_io_netcdf_read_particle_info_system nf90_getvar origin_vh_varid" ) + else if ((param%out_form == "XV") .or. (param%out_form == "XVEL")) then + call netcdf_check( nf90_get_var(nc%id, nc%vh_varid, vectemp(:,:)), "swiftest_io_netcdf_read_particle_info_system nf90_getvar vh_varid" ) + else + vectemp(:,:) = 0._DP + end if + + do i = 1, npl + call pl%info(i)%set_value(origin_vh=vectemp(:,plind(i))) + end do + do i = 1, ntp + call tp%info(i)%set_value(origin_vh=vectemp(:,tpind(i))) + end do + + status = nf90_inq_varid(nc%id, nc%collision_id_varname, nc%collision_id_varid) + if (status == nf90_noerr) then + call netcdf_check( nf90_get_var(nc%id, nc%collision_id_varid, itemp), "swiftest_io_netcdf_read_particle_info_system nf90_getvar collision_id_varid" ) + else + itemp = 0 + end if + + do i = 1, npl + call pl%info(i)%set_value(collision_id=itemp(plind(i))) + end do + do i = 1, ntp + call tp%info(i)%set_value(collision_id=itemp(tpind(i))) + end do + + status = nf90_inq_varid(nc%id, nc%discard_time_varname, nc%discard_time_varid) + if (status == nf90_noerr) then + call netcdf_check( nf90_get_var(nc%id, nc%discard_time_varid, rtemp), "swiftest_io_netcdf_read_particle_info_system nf90_getvar discard_time_varid" ) + else + select case (param%out_type) + case("swiftest_io_netcdf_FLOAT") + rtemp(:) = huge(0.0_SP) + case("swiftest_io_netcdf_DOUBLE") + rtemp(:) = huge(0.0_DP) + end select + end if + + call cb%info%set_value(discard_time=rtemp(1)) + do i = 1, npl + call pl%info(i)%set_value(discard_time=rtemp(plind(i))) + end do + do i = 1, ntp + call tp%info(i)%set_value(discard_time=rtemp(tpind(i))) + end do + + status = nf90_inq_varid(nc%id, nc%discard_rh_varname, nc%discard_rh_varid) + if (status == nf90_noerr) then + call netcdf_check( nf90_get_var(nc%id, nc%discard_rh_varid, vectemp(:,:)), "swiftest_io_netcdf_read_particle_info_system nf90_getvar discard_rh_varid" ) + else + vectemp(:,:) = 0.0_DP + end if + + do i = 1, npl + call pl%info(i)%set_value(discard_rh=vectemp(:,plind(i))) + end do + do i = 1, ntp + call tp%info(i)%set_value(discard_rh=vectemp(:,tpind(i))) + end do + + status = nf90_inq_varid(nc%id, nc%discard_vh_varname, nc%discard_vh_varid) + if (status == nf90_noerr) then + call netcdf_check( nf90_get_var(nc%id, nc%discard_vh_varid, vectemp(:,:)), "swiftest_io_netcdf_read_particle_info_system nf90_getvar discard_vh_varid" ) + else + vectemp(:,:) = 0.0_DP + end if + + do i = 1, npl + call pl%info(i)%set_value(discard_vh=vectemp(:,plind(i))) + end do + do i = 1, ntp + call tp%info(i)%set_value(discard_vh=vectemp(:,tpind(i))) + end do + end if + + end associate + + return + end subroutine swiftest_io_netcdf_read_particle_info_system + + + module subroutine swiftest_io_netcdf_write_frame_body(self, nc, param) + !! author: Carlisle A. Wishard, Dana Singh, and David A. Minton + !! + !! Write a frame of output of either test particle or massive body data to the binary output file + !! Note: If outputting to orbital elements, but sure that the conversion is done prior to calling this method + implicit none + ! Arguments + class(swiftest_body), intent(in) :: self !! Swiftest base object + class(base_io_netcdf_parameters), intent(inout) :: nc !! Parameters used to for writing a NetCDF dataset to file + class(base_parameters), intent(inout) :: param !! Current run configuration parameters + ! Internals + integer(I4B) :: i, j, tslot, idslot, old_mode + integer(I4B), dimension(:), allocatable :: ind + real(DP), dimension(NDIM) :: vh !! Temporary variable to store heliocentric velocity values when converting from pseudovelocity in GR-enabled runs + real(DP) :: a, e, inc, omega, capom, capm, varpi, lam, f, cape, capf + + tslot = param%ioutput + + call self%write_info(nc, param) + + call netcdf_check( nf90_set_fill(nc%id, nf90_nofill, old_mode), "swiftest_io_netcdf_write_frame_body nf90_set_fill" ) + select type(self) + class is (swiftest_body) + associate(n => self%nbody) + if (n == 0) return + + call util_sort(self%id(1:n), ind) + + do i = 1, n + j = ind(i) + idslot = self%id(j) + 1 + + !! Convert from pseudovelocity to heliocentric without replacing the current value of pseudovelocity + if (param%lgr) call swiftest_gr_pseudovel2vel(param, self%mu(j), self%rh(:, j), self%vh(:, j), vh(:)) + + if ((param%out_form == "XV") .or. (param%out_form == "XVEL")) then + call netcdf_check( nf90_put_var(nc%id, nc%rh_varid, self%rh(:, j), start=[1,idslot, tslot], count=[NDIM,1,1]), "swiftest_io_netcdf_write_frame_body nf90_put_var rh_varid" ) + if (param%lgr) then !! Convert from pseudovelocity to heliocentric without replacing the current value of pseudovelocity + call netcdf_check( nf90_put_var(nc%id, nc%vh_varid, vh(:), start=[1,idslot, tslot], count=[NDIM,1,1]), "swiftest_io_netcdf_write_frame_body nf90_put_var vh_varid" ) + call netcdf_check( nf90_put_var(nc%id, nc%gr_pseudo_vh_varid, self%vh(:, j), start=[1,idslot, tslot],count=[NDIM,1,1]), "swiftest_io_netcdf_write_frame_body nf90_put_var gr_pseudo_vhx_varid" ) + + else + call netcdf_check( nf90_put_var(nc%id, nc%vh_varid, self%vh(:, j), start=[1,idslot, tslot], count=[NDIM,1,1]), "swiftest_io_netcdf_write_frame_body nf90_put_var vh_varid" ) + end if + end if + + if ((param%out_form == "EL") .or. (param%out_form == "XVEL")) then + if (param%lgr) then !! For GR-enabled runs, use the true value of velocity computed above + call swiftest_orbel_xv2el(self%mu(j), self%rh(1,j), self%rh(2,j), self%rh(3,j), & + vh(1), vh(2), vh(3), & + a, e, inc, capom, omega, capm, varpi, lam, f, cape, capf) + else !! For non-GR runs just convert from the velocity we have + call swiftest_orbel_xv2el(self%mu(j), self%rh(1,j), self%rh(2,j), self%rh(3,j), & + self%vh(1,j), self%vh(2,j), self%vh(3,j), & + a, e, inc, capom, omega, capm, varpi, lam, f, cape, capf) + end if + call netcdf_check( nf90_put_var(nc%id, nc%a_varid, a, start=[idslot, tslot]), "swiftest_io_netcdf_write_frame_body nf90_put_var body a_varid" ) + call netcdf_check( nf90_put_var(nc%id, nc%e_varid, e, start=[idslot, tslot]), "swiftest_io_netcdf_write_frame_body nf90_put_var body e_varid" ) + call netcdf_check( nf90_put_var(nc%id, nc%inc_varid, inc * RAD2DEG, start=[idslot, tslot]), "swiftest_io_netcdf_write_frame_body nf90_put_var body inc_varid" ) + call netcdf_check( nf90_put_var(nc%id, nc%capom_varid, capom * RAD2DEG, start=[idslot, tslot]), "swiftest_io_netcdf_write_frame_body nf90_put_var body capom_varid" ) + call netcdf_check( nf90_put_var(nc%id, nc%omega_varid, omega * RAD2DEG, start=[idslot, tslot]), "swiftest_io_netcdf_write_frame_body nf90_put_var body omega_varid" ) + call netcdf_check( nf90_put_var(nc%id, nc%capm_varid, capm * RAD2DEG, start=[idslot, tslot]), "swiftest_io_netcdf_write_frame_body nf90_put_var body capm_varid" ) + call netcdf_check( nf90_put_var(nc%id, nc%varpi_varid, varpi * RAD2DEG, start=[idslot, tslot]), "swiftest_io_netcdf_write_frame_body nf90_put_var body varpi_varid" ) + call netcdf_check( nf90_put_var(nc%id, nc%lam_varid, lam * RAD2DEG, start=[idslot, tslot]), "swiftest_io_netcdf_write_frame_body nf90_put_var body lam_varid" ) + call netcdf_check( nf90_put_var(nc%id, nc%f_varid, f * RAD2DEG, start=[idslot, tslot]), "swiftest_io_netcdf_write_frame_body nf90_put_var body f_varid" ) + if (e < 1.0_DP) then + call netcdf_check( nf90_put_var(nc%id, nc%cape_varid, cape * RAD2DEG, start=[idslot, tslot]), "swiftest_io_netcdf_write_frame_body nf90_put_var body cape_varid" ) + else if (e > 1.0_DP) then + call netcdf_check( nf90_put_var(nc%id, nc%cape_varid, capf * RAD2DEG, start=[idslot, tslot]), "swiftest_io_netcdf_write_frame_body nf90_put_var body (capf) cape_varid" ) + end if + end if + + select type(self) + class is (swiftest_pl) ! Additional output if the passed polymorphic object is a massive body + call netcdf_check( nf90_put_var(nc%id, nc%Gmass_varid, self%Gmass(j), start=[idslot, tslot]), "swiftest_io_netcdf_write_frame_body nf90_put_var body Gmass_varid" ) + if (param%lrhill_present) then + call netcdf_check( nf90_put_var(nc%id, nc%rhill_varid, self%rhill(j), start=[idslot, tslot]), "swiftest_io_netcdf_write_frame_body nf90_put_var body rhill_varid" ) + end if + if (param%lclose) call netcdf_check( nf90_put_var(nc%id, nc%radius_varid, self%radius(j), start=[idslot, tslot]), "swiftest_io_netcdf_write_frame_body nf90_put_var body radius_varid" ) + if (param%lrotation) then + call netcdf_check( nf90_put_var(nc%id, nc%Ip_varid, self%Ip(:, j), start=[1,idslot, tslot], count=[NDIM,1,1]), "swiftest_io_netcdf_write_frame_body nf90_put_var body Ip_varid" ) + call netcdf_check( nf90_put_var(nc%id, nc%rot_varid, self%rot(:, j), start=[1,idslot, tslot], count=[NDIM,1,1]), "swiftest_io_netcdf_write_frame_body nf90_put_var body rotx_varid" ) + end if + ! if (param%ltides) then + ! call netcdf_check( nf90_put_var(nc%id, nc%k2_varid, self%k2(j), start=[idslot, tslot]), "swiftest_io_netcdf_write_frame_body nf90_put_var body k2_varid" ) + ! call netcdf_check( nf90_put_var(nc%id, nc%Q_varid, self%Q(j), start=[idslot, tslot]), "swiftest_io_netcdf_write_frame_body nf90_put_var body Q_varid" ) + ! end if + + end select + end do + end associate + class is (swiftest_cb) + idslot = self%id + 1 + call netcdf_check( nf90_put_var(nc%id, nc%id_varid, self%id, start=[idslot]), "swiftest_io_netcdf_write_frame_body nf90_put_var cb id_varid" ) + + call netcdf_check( nf90_put_var(nc%id, nc%Gmass_varid, self%Gmass, start=[idslot, tslot]), "swiftest_io_netcdf_write_frame_body nf90_put_var cb Gmass_varid" ) + if (param%lclose) call netcdf_check( nf90_put_var(nc%id, nc%radius_varid, self%radius, start=[idslot, tslot]), "swiftest_io_netcdf_write_frame_body nf90_put_var cb radius_varid" ) + call netcdf_check( nf90_put_var(nc%id, nc%j2rp2_varid, self%j2rp2, start=[tslot]), "swiftest_io_netcdf_write_frame_body nf90_put_var cb j2rp2_varid" ) + call netcdf_check( nf90_put_var(nc%id, nc%j4rp4_varid, self%j4rp4, start=[tslot]), "swiftest_io_netcdf_write_frame_body nf90_put_var cb j4rp4_varid" ) + if (param%lrotation) then + call netcdf_check( nf90_put_var(nc%id, nc%Ip_varid, self%Ip(:), start=[1, idslot, tslot], count=[NDIM,1,1]), "swiftest_io_netcdf_write_frame_body nf90_put_var cb Ip_varid" ) + call netcdf_check( nf90_put_var(nc%id, nc%rot_varid, self%rot(:), start=[1, idslot, tslot], count=[NDIM,1,1]), "swiftest_io_netcdf_write_frame_body nf90_put_var cb rot_varid" ) + end if + ! if (param%ltides) then + ! call netcdf_check( nf90_put_var(nc%id, nc%k2_varid, self%k2, start=[idslot, tslot]), "swiftest_io_netcdf_write_frame_body nf90_put_var cb k2_varid" ) + ! call netcdf_check( nf90_put_var(nc%id, nc%Q_varid, self%Q, start=[idslot, tslot]), "swiftest_io_netcdf_write_frame_body nf90_put_var cb Q_varid" ) + ! end if + + end select + call netcdf_check( nf90_set_fill(nc%id, old_mode, old_mode), "swiftest_io_netcdf_write_frame_body nf90_set_fill old_mode" ) + + return + end subroutine swiftest_io_netcdf_write_frame_body + + + module subroutine swiftest_io_netcdf_write_frame_system(self, nc, param) + !! author: The Purdue Swiftest Team - David A. Minton, Carlisle A. Wishard, Jennifer L.L. Pouplin, and Jacob R. Elliott + !! + !! Write a frame (header plus records for each massive body and active test particle) to a output binary file + implicit none + ! Arguments + class(swiftest_nbody_system), intent(inout) :: self !! Swiftest system object + class(base_io_netcdf_parameters), intent(inout) :: nc !! Parameters used to for writing a NetCDF dataset to file + class(base_parameters), intent(inout) :: param !! Current run configuration parameters + + call self%write_hdr(nc, param) + call self%cb%write_frame(nc, param) + call self%pl%write_frame(nc, param) + call self%tp%write_frame(nc, param) + + return + end subroutine swiftest_io_netcdf_write_frame_system + + + + module subroutine swiftest_io_netcdf_write_hdr_system(self, nc, param) + !! author: David A. Minton + !! + !! Writes header information (variables that change with time, but not particle id). + !! This subroutine swiftest_significantly improves the output over the original binary file, allowing us to track energy, momentum, and other quantities that + !! previously were handled as separate output files. + implicit none + ! Arguments + class(swiftest_nbody_system), intent(in) :: self !! Swiftest nbody system object + class(base_io_netcdf_parameters), intent(inout) :: nc !! Parameters used to for writing a NetCDF dataset to file + class(base_parameters), intent(inout) :: param !! Current run configuration parameters + ! Internals + integer(I4B) :: tslot + + tslot = param%ioutput + + call netcdf_check( nf90_put_var(nc%id, nc%time_varid, self%t, start=[tslot]), "swiftest_io_netcdf_write_hdr_system nf90_put_var time_varid" ) + call netcdf_check( nf90_put_var(nc%id, nc%npl_varid, self%pl%nbody, start=[tslot]), "swiftest_io_netcdf_write_hdr_system nf90_put_var npl_varid" ) + call netcdf_check( nf90_put_var(nc%id, nc%ntp_varid, self%tp%nbody, start=[tslot]), "swiftest_io_netcdf_write_hdr_system nf90_put_var ntp_varid" ) + select type(pl => self%pl) + class is (symba_pl) + call netcdf_check( nf90_put_var(nc%id, nc%nplm_varid, pl%nplm, start=[tslot]), "swiftest_io_netcdf_write_hdr_system nf90_put_var nplm_varid" ) + end select + + if (param%lenergy) then + call netcdf_check( nf90_put_var(nc%id, nc%KE_orb_varid, self%ke_orbit, start=[tslot]), "swiftest_io_netcdf_write_hdr_system nf90_put_var KE_orb_varid" ) + call netcdf_check( nf90_put_var(nc%id, nc%KE_spin_varid, self%ke_spin, start=[tslot]), "swiftest_io_netcdf_write_hdr_system nf90_put_var KE_spin_varid" ) + call netcdf_check( nf90_put_var(nc%id, nc%PE_varid, self%pe, start=[tslot]), "swiftest_io_netcdf_write_hdr_system nf90_put_var PE_varid" ) + call netcdf_check( nf90_put_var(nc%id, nc%L_orb_varid, self%Lorbit(:), start=[1,tslot], count=[NDIM,1]), "swiftest_io_netcdf_write_hdr_system nf90_put_var L_orb_varid" ) + call netcdf_check( nf90_put_var(nc%id, nc%Lspin_varid, self%Lspin(:), start=[1,tslot], count=[NDIM,1]), "swiftest_io_netcdf_write_hdr_system nf90_put_var Lspin_varid" ) + call netcdf_check( nf90_put_var(nc%id, nc%L_escape_varid, self%Lescape(:), start=[1,tslot], count=[NDIM,1]), "swiftest_io_netcdf_write_hdr_system nf90_put_var L_escape_varid" ) + call netcdf_check( nf90_put_var(nc%id, nc%Ecollisions_varid, self%Ecollisions, start=[tslot]), "swiftest_io_netcdf_write_hdr_system nf90_put_var Ecollisions_varid" ) + call netcdf_check( nf90_put_var(nc%id, nc%Euntracked_varid, self%Euntracked, start=[tslot]), "swiftest_io_netcdf_write_hdr_system nf90_put_var Euntracked_varid" ) + call netcdf_check( nf90_put_var(nc%id, nc%GMescape_varid, self%GMescape, start=[tslot]), "swiftest_io_netcdf_write_hdr_system nf90_put_var GMescape_varid" ) + end if + + return + end subroutine swiftest_io_netcdf_write_hdr_system + + + module subroutine swiftest_io_netcdf_write_info_body(self, nc, param) + !! author: Carlisle A. Wishard, Dana Singh, and David A. Minton + !! + !! Write all current particle to file + implicit none + ! Arguments + class(swiftest_body), intent(in) :: self !! Swiftest particle object + class(base_io_netcdf_parameters), intent(inout) :: nc !! Parameters used to identify a particular NetCDF dataset + class(base_parameters), intent(inout) :: param !! Current run configuration parameters + ! Internals + integer(I4B) :: i, j, idslot, old_mode + integer(I4B), dimension(:), allocatable :: ind + character(len=:), allocatable :: charstring + + ! This string of spaces of length NAMELEN is used to clear out any old data left behind inside the string variables + call netcdf_check( nf90_set_fill(nc%id, nf90_nofill, old_mode), "swiftest_io_netcdf_write_info_body nf90_set_fill nf90_nofill" ) + + select type(self) + class is (swiftest_body) + associate(n => self%nbody) + if (n == 0) return + call util_sort(self%id(1:n), ind) + + do i = 1, n + j = ind(i) + idslot = self%id(j) + 1 + call netcdf_check( nf90_put_var(nc%id, nc%id_varid, self%id(j), start=[idslot]), "swiftest_io_netcdf_write_info_body nf90_put_var id_varid" ) + + charstring = trim(adjustl(self%info(j)%name)) + call netcdf_check( nf90_put_var(nc%id, nc%name_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "swiftest_io_netcdf_write_info_body nf90_put_var name_varid" ) + + charstring = trim(adjustl(self%info(j)%particle_type)) + call netcdf_check( nf90_put_var(nc%id, nc%ptype_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "swiftest_io_netcdf_write_info_body nf90_put_var particle_type_varid" ) + + if (param%lclose) then + charstring = trim(adjustl(self%info(j)%origin_type)) + call netcdf_check( nf90_put_var(nc%id, nc%origin_type_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "swiftest_io_netcdf_write_info_body nf90_put_var origin_type_varid" ) + call netcdf_check( nf90_put_var(nc%id, nc%origin_time_varid, self%info(j)%origin_time, start=[idslot]), "swiftest_io_netcdf_write_info_body nf90_put_var origin_time_varid" ) + call netcdf_check( nf90_put_var(nc%id, nc%origin_rh_varid, self%info(j)%origin_rh(:), start=[1,idslot], count=[NDIM,1]), "swiftest_io_netcdf_write_info_body nf90_put_var origin_rh_varid" ) + call netcdf_check( nf90_put_var(nc%id, nc%origin_vh_varid, self%info(j)%origin_vh(:), start=[1,idslot], count=[NDIM,1]), "swiftest_io_netcdf_write_info_body nf90_put_var origin_vh_varid" ) + + call netcdf_check( nf90_put_var(nc%id, nc%collision_id_varid, self%info(j)%collision_id, start=[idslot]), "swiftest_io_netcdf_write_info_body nf90_put_var collision_id_varid" ) + call netcdf_check( nf90_put_var(nc%id, nc%discard_time_varid, self%info(j)%discard_time, start=[idslot]), "swiftest_io_netcdf_write_info_body nf90_put_var discard_time_varid" ) + call netcdf_check( nf90_put_var(nc%id, nc%discard_rh_varid, self%info(j)%discard_rh(:), start=[1,idslot], count=[NDIM,1]), "swiftest_io_netcdf_write_info_body nf90_put_var discard_rh_varid" ) + call netcdf_check( nf90_put_var(nc%id, nc%discard_vh_varid, self%info(j)%discard_vh(:), start=[1,idslot], count=[NDIM,1]), "swiftest_io_netcdf_write_info_body nf90_put_var discard_vh_varid" ) + end if + + end do + end associate + + class is (swiftest_cb) + idslot = self%id + 1 + call netcdf_check( nf90_put_var(nc%id, nc%id_varid, self%id, start=[idslot]), "swiftest_io_netcdf_write_info_body nf90_put_var cb id_varid" ) + + charstring = trim(adjustl(self%info%name)) + call netcdf_check( nf90_put_var(nc%id, nc%name_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "swiftest_io_netcdf_write_info_body nf90_put_var cb name_varid" ) + + charstring = trim(adjustl(self%info%particle_type)) + call netcdf_check( nf90_put_var(nc%id, nc%ptype_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "swiftest_io_netcdf_write_info_body nf90_put_var cb ptype_varid" ) + + if (param%lclose) then + charstring = trim(adjustl(self%info%origin_type)) + call netcdf_check( nf90_put_var(nc%id, nc%origin_type_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "swiftest_io_netcdf_write_info_body nf90_put_var cb origin_type_varid" ) + + call netcdf_check( nf90_put_var(nc%id, nc%origin_time_varid, self%info%origin_time, start=[idslot]), "swiftest_io_netcdf_write_info_body nf90_put_var cb origin_time_varid" ) + call netcdf_check( nf90_put_var(nc%id, nc%origin_rh_varid, self%info%origin_rh(:), start=[1, idslot], count=[NDIM,1]), "swiftest_io_netcdf_write_info_body nf90_put_var cb origin_rh_varid" ) + call netcdf_check( nf90_put_var(nc%id, nc%origin_vh_varid, self%info%origin_vh(:), start=[1, idslot], count=[NDIM,1]), "swiftest_io_netcdf_write_info_body nf90_put_var cb origin_vh_varid" ) + + call netcdf_check( nf90_put_var(nc%id, nc%collision_id_varid, self%info%collision_id, start=[idslot]), "swiftest_io_netcdf_write_info_body nf90_put_var cb collision_id_varid" ) + call netcdf_check( nf90_put_var(nc%id, nc%discard_time_varid, self%info%discard_time, start=[idslot]), "swiftest_io_netcdf_write_info_body nf90_put_var cb discard_time_varid" ) + call netcdf_check( nf90_put_var(nc%id, nc%discard_rh_varid, self%info%discard_rh(:), start=[1, idslot], count=[NDIM,1]), "swiftest_io_netcdf_write_info_body nf90_put_var cb discard_rh_varid" ) + call netcdf_check( nf90_put_var(nc%id, nc%discard_vh_varid, self%info%discard_vh(:), start=[1, idslot], count=[NDIM,1]), "swiftest_io_netcdf_write_info_body nf90_put_var cb discard_vh_varid" ) + end if + + end select + + call netcdf_check( nf90_set_fill(nc%id, old_mode, old_mode) ) + return + end subroutine swiftest_io_netcdf_write_info_body + +end submodule s_io_netcdf diff --git a/src/kick/kick.f90 b/src/swiftest_procedures/swiftest_kick.f90 similarity index 92% rename from src/kick/kick.f90 rename to src/swiftest_procedures/swiftest_kick.f90 index 8f1ae7e08..b1c9fe20a 100644 --- a/src/kick/kick.f90 +++ b/src/swiftest_procedures/swiftest_kick.f90 @@ -7,11 +7,9 @@ !! You should have received a copy of the GNU General Public License along with Swiftest. !! If not, see: https://www.gnu.org/licenses. -submodule(swiftest_classes) s_kick - use swiftest +submodule(swiftets) s_kick contains - - module subroutine kick_getacch_int_pl(self, param) + module subroutine swiftest_kick_getacch_int_pl(self, param) !! author: David A. Minton !! !! Compute direct cross (third) term heliocentric accelerations of massive bodies @@ -34,7 +32,7 @@ module subroutine kick_getacch_int_pl(self, param) call itimer%time_this_loop(param, self%nplpl, self) lfirst = .false. else - if (itimer%check(param, self%nplpl)) call itimer%time_this_loop(param, self%nplpl, self) + if (itimer%io_netcdf_check(param, self%nplpl)) call itimer%time_this_loop(param, self%nplpl, self) end if else param%lflatten_interactions = .false. @@ -60,10 +58,10 @@ module subroutine kick_getacch_int_pl(self, param) end if return - end subroutine kick_getacch_int_pl + end subroutine swiftest_kick_getacch_int_pl - module subroutine kick_getacch_int_tp(self, param, GMpl, rhp, npl) + module subroutine swiftest_kick_getacch_int_tp(self, param, GMpl, rhp, npl) !! author: David A. Minton !! !! Compute direct cross (third) term heliocentric accelerations of test particles by massive bodies @@ -83,10 +81,10 @@ module subroutine kick_getacch_int_tp(self, param, GMpl, rhp, npl) call kick_getacch_int_all_tp(self%nbody, npl, self%rh, rhp, GMpl, self%lmask, self%ah) return - end subroutine kick_getacch_int_tp + end subroutine swiftest_kick_getacch_int_tp - module subroutine kick_getacch_int_all_flat_pl(npl, nplpl, k_plpl, x, Gmass, radius, acc) + module subroutine swiftest_kick_getacch_int_all_flat_pl(npl, nplpl, k_plpl, x, Gmass, radius, acc) !! author: David A. Minton !! !! Compute direct cross (third) term heliocentric accelerations for massive bodies, with parallelization. @@ -152,10 +150,10 @@ module subroutine kick_getacch_int_all_flat_pl(npl, nplpl, k_plpl, x, Gmass, rad acc(:,:) = acc(:,:) + ahi(:,:) + ahj(:,:) return - end subroutine kick_getacch_int_all_flat_pl + end subroutine swiftest_kick_getacch_int_all_flat_pl - module subroutine kick_getacch_int_all_triangular_pl(npl, nplm, x, Gmass, radius, acc) + module subroutine swiftest_kick_getacch_int_all_triangular_pl(npl, nplm, x, Gmass, radius, acc) !! author: David A. Minton !! !! Compute direct cross (third) term heliocentric accelerations for massive bodies, with parallelization. @@ -221,10 +219,10 @@ module subroutine kick_getacch_int_all_triangular_pl(npl, nplm, x, Gmass, radius end do return - end subroutine kick_getacch_int_all_triangular_pl + end subroutine swiftest_kick_getacch_int_all_triangular_pl - module subroutine kick_getacch_int_all_tp(ntp, npl, xtp, xpl, GMpl, lmask, acc) + module subroutine swiftest_kick_getacch_int_all_tp(ntp, npl, xtp, xpl, GMpl, lmask, acc) !! author: David A. Minton !! !! Compute direct cross (third) term heliocentric accelerations of test particles by massive bodies with parallelisim @@ -261,10 +259,10 @@ module subroutine kick_getacch_int_all_tp(ntp, npl, xtp, xpl, GMpl, lmask, acc) !$omp end parallel do return - end subroutine kick_getacch_int_all_tp + end subroutine swiftest_kick_getacch_int_all_tp - pure module subroutine kick_getacch_int_one_pl(rji2, xr, yr, zr, Gmi, Gmj, axi, ayi, azi, axj, ayj, azj) + pure module subroutine swiftest_kick_getacch_int_one_pl(rji2, xr, yr, zr, Gmi, Gmj, axi, ayi, azi, axj, ayj, azj) !! author: David A. Minton !! !! Compute direct cross (third) term heliocentric accelerations for a single pair of massive bodies @@ -292,10 +290,10 @@ pure module subroutine kick_getacch_int_one_pl(rji2, xr, yr, zr, Gmi, Gmj, axi, azj = azj - faci * zr return - end subroutine kick_getacch_int_one_pl + end subroutine swiftest_kick_getacch_int_one_pl - pure module subroutine kick_getacch_int_one_tp(rji2, xr, yr, zr, GMpl, ax, ay, az) + pure module subroutine swiftest_kick_getacch_int_one_tp(rji2, xr, yr, zr, GMpl, ax, ay, az) !! author: David A. Minton !! !! Compute direct cross (third) term heliocentric accelerations of a single test particle massive body pair. @@ -316,6 +314,6 @@ pure module subroutine kick_getacch_int_one_tp(rji2, xr, yr, zr, GMpl, ax, ay, a az = az - fac * zr return - end subroutine kick_getacch_int_one_tp + end subroutine swiftest_kick_getacch_int_one_tp end submodule s_kick diff --git a/src/obl/obl.f90 b/src/swiftest_procedures/swiftest_obl.f90 similarity index 94% rename from src/obl/obl.f90 rename to src/swiftest_procedures/swiftest_obl.f90 index be964c3e5..3d3109d8c 100644 --- a/src/obl/obl.f90 +++ b/src/swiftest_procedures/swiftest_obl.f90 @@ -7,10 +7,9 @@ !! You should have received a copy of the GNU General Public License along with Swiftest. !! If not, see: https://www.gnu.org/licenses. -submodule (swiftest_classes) s_obl - use swiftest +submodule (swiftest) s_obl contains - module subroutine obl_acc_body(self, system) + module subroutine swiftest_obl_acc_body(self, system) !! author: David A. Minton !! !! Compute the barycentric accelerations of bodies due to the oblateness of the central body @@ -46,10 +45,10 @@ module subroutine obl_acc_body(self, system) end associate return - end subroutine obl_acc_body + end subroutine swiftest_obl_acc_body - module subroutine obl_acc_pl(self, system) + module subroutine swiftest_obl_acc_pl(self, system) !! author: David A. Minton !! !! Compute the barycentric accelerations of massive bodies due to the oblateness of the central body @@ -79,10 +78,10 @@ module subroutine obl_acc_pl(self, system) return - end subroutine obl_acc_pl + end subroutine swiftest_obl_acc_pl - module subroutine obl_acc_tp(self, system) + module subroutine swiftest_obl_acc_tp(self, system) !! author: David A. Minton !! !! Compute the barycentric accelerations of massive bodies due to the oblateness of the central body @@ -114,10 +113,10 @@ module subroutine obl_acc_tp(self, system) end associate return - end subroutine obl_acc_tp + end subroutine swiftest_obl_acc_tp - module subroutine obl_pot_system(self) + module subroutine swiftest_obl_pot_system(self) !! author: David A. Minton !! !! Compute the contribution to the total gravitational potential due solely to the oblateness of the central body @@ -143,7 +142,7 @@ module subroutine obl_pot_system(self) end associate return - end subroutine obl_pot_system + end subroutine swiftest_obl_pot_system elemental function obl_pot_one(GMcb, GMpl, j2rp2, j4rp4, zh, irh) result(oblpot) diff --git a/src/orbel/orbel.f90 b/src/swiftest_procedures/swiftest_orbel.f90 similarity index 87% rename from src/orbel/orbel.f90 rename to src/swiftest_procedures/swiftest_orbel.f90 index 0a4416160..c731c23a4 100644 --- a/src/orbel/orbel.f90 +++ b/src/swiftest_procedures/swiftest_orbel.f90 @@ -7,11 +7,10 @@ !! You should have received a copy of the GNU General Public License along with Swiftest. !! If not, see: https://www.gnu.org/licenses. -submodule (swiftest_classes) s_orbel - use swiftest +submodule (swiftest) s_orbel contains - module subroutine orbel_el2xv_vec(self, cb) + module subroutine swiftest_orbel_el2xv_vec(self, cb) !! author: David A. Minton !! !! A wrapper method that converts all of the orbital element vectors into cartesian position and velocity vectors for a Swiftest body object. @@ -27,14 +26,14 @@ module subroutine orbel_el2xv_vec(self, cb) call self%set_mu(cb) do concurrent (i = 1:self%nbody) - call orbel_el2xv(self%mu(i), self%a(i), self%e(i), self%inc(i), self%capom(i), & + call swiftest_orbel_el2xv(self%mu(i), self%a(i), self%e(i), self%inc(i), self%capom(i), & self%omega(i), self%capm(i), self%rh(:, i), self%vh(:, i)) end do return - end subroutine orbel_el2xv_vec + end subroutine swiftest_orbel_el2xv_vec - pure subroutine orbel_el2xv(mu, a, ie, inc, capom, omega, capm, x, v) + pure subroutine swiftest_orbel_el2xv(mu, a, ie, inc, capom, omega, capm, x, v) !! author: David A. Minton !! !! Compute osculating orbital elements from relative C)rtesian position and velocity @@ -63,7 +62,7 @@ pure subroutine orbel_el2xv(mu, a, ie, inc, capom, omega, capm, x, v) if(ie < 0.0_DP) then - !write(*,*) ' ERROR in orbel_el2xv: e<0, setting e=0!!1' + !write(*,*) ' ERROR in swiftest_orbel_el2xv: e<0, setting e=0!!1' e = 0.0_DP iorbit_type = ELLIPSE else @@ -78,9 +77,9 @@ pure subroutine orbel_el2xv(mu, a, ie, inc, capom, omega, capm, x, v) end if endif - call orbel_scget(omega,sip,cip) - call orbel_scget(capom,so,co) - call orbel_scget(inc,si,ci) + call swiftest_orbel_scget(omega,sip,cip) + call swiftest_orbel_scget(capom,so,co) + call swiftest_orbel_scget(inc,si,ci) d11 = cip * co - sip * so * ci d12 = cip * so + sip * co * ci d13 = sip * si @@ -92,8 +91,8 @@ pure subroutine orbel_el2xv(mu, a, ie, inc, capom, omega, capm, x, v) ! Get the other quantities depending on orbit type ! if (iorbit_type == ELLIPSE) then - cape = orbel_ehybrid(e,capm) - call orbel_scget(cape,scap,ccap) + cape = swiftest_orbel_ehybrid(e,capm) + call swiftest_orbel_scget(cape,scap,ccap) sqe = sqrt(1._DP - e**2) sqgma = sqrt(mu* a) xfac1 = a * (ccap - e) @@ -104,8 +103,8 @@ pure subroutine orbel_el2xv(mu, a, ie, inc, capom, omega, capm, x, v) endif !-- if (iorbit_type == HYPERBOLA) then - capf = orbel_fhybrid(e,capm) - call orbel_schget(capf,shcap,chcap) + capf = swiftest_orbel_fhybrid(e,capm) + call swiftest_orbel_schget(capf,shcap,chcap) sqe = sqrt(e**2 - 1._DP ) sqgma = sqrt(mu * a) xfac1 = a * (e - chcap) @@ -116,7 +115,7 @@ pure subroutine orbel_el2xv(mu, a, ie, inc, capom, omega, capm, x, v) endif !-- if (iorbit_type == PARABOLA) then - zpara = orbel_zget(capm) + zpara = swiftest_orbel_zget(capm) sqgma = sqrt(2 * mu * a) xfac1 = a * (1._DP - zpara * zpara) xfac2 = 2 * a * zpara @@ -133,10 +132,10 @@ pure subroutine orbel_el2xv(mu, a, ie, inc, capom, omega, capm, x, v) v(3) = d13 * vfac1 + d23 * vfac2 return - end subroutine orbel_el2xv + end subroutine swiftest_orbel_el2xv - pure module subroutine orbel_scget(angle, sx, cx) + pure module subroutine swiftest_orbel_scget(angle, sx, cx) !! author: David A. Minton !! !! Efficiently compute the sine and cosine of an input angle @@ -161,14 +160,14 @@ pure module subroutine orbel_scget(angle, sx, cx) return - end subroutine orbel_scget + end subroutine swiftest_orbel_scget !********************************************************************** ! Code converted to Modern Fortran by David A. Minton ! Date: 2020-06-29 !********************************************************************** - ! ORBEL_SCHGET.F + ! swiftest_orbel_SCHGET.F !********************************************************************** ! PURPOSE: Given an angle, efficiently compute sinh and cosh. ! @@ -188,7 +187,7 @@ end subroutine orbel_scget ! DATE WRITTEN: May 6, 1992. ! REVISIONS: !********************************************************************** - pure subroutine orbel_schget(angle,shx,chx) + pure subroutine swiftest_orbel_schget(angle,shx,chx) real(DP), intent(in) :: angle real(DP), intent(out) :: shx,chx @@ -196,13 +195,13 @@ pure subroutine orbel_schget(angle,shx,chx) chx= sqrt(1._DP + shx * shx) return - end subroutine orbel_schget + end subroutine swiftest_orbel_schget !********************************************************************** ! Code converted to Modern Fortran by David A. Minton ! Date: 2020-06-29 - ! ! ORBEL_FLON.F + ! ! swiftest_orbel_FLON.F !********************************************************************** ! PURPOSE: Solves Kepler's eqn. for hyperbola using hybrid approach. ! @@ -210,7 +209,7 @@ end subroutine orbel_schget ! e ==> eccentricity anomaly. (real scalar) ! capn ==> hyperbola mean anomaly. (real scalar) ! Returns: - ! orbel_flon ==> eccentric anomaly. (real scalar) + ! swiftest_orbel_flon ==> eccentric anomaly. (real scalar) ! ! ALGORITHM: Uses power series for N in terms of F and Newton,s method ! REMARKS: ONLY GOOD FOR LOW VALUES OF N (N < 0.636*e -0.6) @@ -218,7 +217,7 @@ end subroutine orbel_schget ! DATE WRITTEN: May 26, 1992. ! REVISIONS: !********************************************************************** - real(DP) pure function orbel_flon(e,icapn) + real(DP) pure function swiftest_orbel_flon(e,icapn) implicit none real(DP), intent(in) :: e, icapn integer(I4B) :: iflag,i @@ -258,7 +257,7 @@ real(DP) pure function orbel_flon(e,icapn) biga = (-0.5_DP * b + sq)**(1.0_DP / 3.0_DP) bigb = -(+0.5_DP * b + sq)**(1.0_DP / 3.0_DP) x = biga + bigb - orbel_flon = x + swiftest_orbel_flon = x ! If capn is VSMALL (or zero) no need to go further than cubic even for ! e =1. if( capn >= VSMALL) then @@ -267,27 +266,27 @@ real(DP) pure function orbel_flon(e,icapn) f = a0 + x * (a1 + x2 * (a3 + x2 * (a5 + x2 * (a7 + x2 * (a9 + x2 * (a11 + x2)))))) fp = b1 + x2 * (b3 + x2 * (b5 + x2 * (b7 + x2 * (b9 + x2 * (b11 + 13 * x2))))) dx = -f / fp - orbel_flon = x + dx + swiftest_orbel_flon = x + dx ! if we have converged here there's no point in going on if(abs(dx) <= VSMALL) exit - x = orbel_flon + x = swiftest_orbel_flon end do end if ! normal return here, but check if capn was originally negative if(iflag == 1) then - orbel_flon = -orbel_flon + swiftest_orbel_flon = -orbel_flon capn = -capn end if return - end function orbel_flon + end function swiftest_orbel_flon !********************************************************************** ! Code converted to Modern Fortran by David A. Minton ! Date: 2020-06-29 - ! ORBEL_FGET.F + ! swiftest_orbel_FGET.F !********************************************************************** ! PURPOSE: Solves Kepler's eqn. for hyperbola using hybrid approach. ! @@ -295,7 +294,7 @@ end function orbel_flon ! e ==> eccentricity anomaly. (real scalar) ! capn ==> hyperbola mean anomaly. (real scalar) ! Returns: - ! orbel_fget ==> eccentric anomaly. (real scalar) + ! swiftest_orbel_fget ==> eccentric anomaly. (real scalar) ! ! ALGORITHM: Based on pp. 70-72 of Fitzpatrick's book "Principles of ! Cel. Mech. ". Quartic convergence from Danby's book. @@ -304,7 +303,7 @@ end function orbel_flon ! DATE WRITTEN: May 11, 1992. ! REVISIONS: 2/26/93 hfl !********************************************************************** - real(DP) pure function orbel_fget(e,capn) + real(DP) pure function swiftest_orbel_fget(e,capn) implicit none real(DP), intent(in) :: e,capn @@ -329,10 +328,10 @@ real(DP) pure function orbel_fget(e,capn) x = log(tmp) end if - orbel_fget = x + swiftest_orbel_fget = x do i = 1, IMAX - call orbel_schget(x,shx,chx) + call swiftest_orbel_schget(x,shx,chx) esh = e * shx ech = e * chx f = esh - x - capn @@ -343,21 +342,21 @@ real(DP) pure function orbel_fget(e,capn) dx = -f / fp dx = -f / (fp + dx * fpp / 2._DP) dx = -f / (fp + dx * fpp / 2._DP + dx**2 * fppp / 6._DP) - orbel_fget = x + dx + swiftest_orbel_fget = x + dx ! if we have converged here there's no point in going on if(abs(dx) <= VSMALL) return - x = orbel_fget + x = swiftest_orbel_fget end do !write(*,*) 'fget : returning without complete convergence' return - end function orbel_fget + end function swiftest_orbel_fget !********************************************************************** ! Code converted to Modern Fortran by David A. Minton ! Date: 2020-06-29 - ! ORBEL_ZGET.F + ! swiftest_orbel_ZGET.F !********************************************************************** ! PURPOSE: Solves the equivalent of Kepler's eqn. for a parabola ! given Q (Fitz. notation.) @@ -365,7 +364,7 @@ end function orbel_fget ! Input: ! q ==> parabola mean anomaly. (real scalar) ! Returns: - ! orbel_zget ==> eccentric anomaly. (real scalar) + ! swiftest_orbel_zget ==> eccentric anomaly. (real scalar) ! ! ALGORITHM: p. 70-72 of Fitzpatrick's book "Princ. of Cel. Mech." ! REMARKS: For a parabola we can solve analytically. @@ -374,7 +373,7 @@ end function orbel_fget ! REVISIONS: May 27 - corrected it for negative Q and use power ! series for small Q. !********************************************************************** - real(DP) pure function orbel_zget(iq) + real(DP) pure function swiftest_orbel_zget(iq) implicit none real(DP), intent(in) :: iq @@ -391,26 +390,26 @@ real(DP) pure function orbel_zget(iq) end if if (q < 1.e-3_DP) then - orbel_zget = q * (1._DP - (q**2 / 3._DP) * (1._DP - q**2)) + swiftest_orbel_zget = q * (1._DP - (q**2 / 3._DP) * (1._DP - q**2)) else x = 0.5_DP * (3 * q + sqrt(9 * q**2 + 4._DP)) tmp = x**(1._DP / 3._DP) - orbel_zget = tmp - 1._DP / tmp + swiftest_orbel_zget = tmp - 1._DP / tmp end if if(iflag == 1) then - orbel_zget = -orbel_zget + swiftest_orbel_zget = -orbel_zget q = -q end if return - end function orbel_zget + end function swiftest_orbel_zget !********************************************************************** ! Code converted to Modern Fortran by David A. Minton ! Date: 2020-06-29 - ! ORBEL_ESOLMD.F + ! swiftest_orbel_ESOLMD.F !********************************************************************** ! PURPOSE: Solves Kepler's eqn. e is ecc. m is mean anomaly. ! @@ -418,7 +417,7 @@ end function orbel_zget ! e ==> eccentricity anomaly. (real scalar) ! m ==> mean anomaly. (real scalar) ! Returns: - ! orbel_esolmd ==> eccentric anomaly. (real scalar) + ! swiftest_orbel_esolmd ==> eccentric anomaly. (real scalar) ! ! ALGORITHM: Some sort of quartic convergence from Wisdom. ! REMARKS: ONLY GOOD FOR SMALL ECCENTRICITY SINCE IT ONLY @@ -429,7 +428,7 @@ end function orbel_zget ! DATE WRITTEN: May 7, 1992. ! REVISIONS: 2/26/93 hfl !********************************************************************** - real(DP) pure function orbel_esolmd(e,m) + real(DP) pure function swiftest_orbel_esolmd(e,m) implicit none real(DP), intent(in) :: e @@ -441,10 +440,10 @@ real(DP) pure function orbel_esolmd(e,m) !... function to solve kepler's eqn for e (here called !... x) for given e and m. returns value of x. - call orbel_scget(m,sm,cm) + call swiftest_orbel_scget(m,sm,cm) x = m + e * sm * (1._DP + e * ( cm + e * (1._DP - 1.5_DP * sm**2))) - call orbel_scget(x,sx,cx) + call swiftest_orbel_scget(x,sx,cx) es = e * sx ec = e * cx f = x - es - m @@ -455,16 +454,16 @@ real(DP) pure function orbel_esolmd(e,m) dx = -f / (fp + dx * fpp / 2._DP) dx = -f / (fp + dx * fpp / 2._DP + dx**2 * fppp / 6._DP) - orbel_esolmd = x + dx + swiftest_orbel_esolmd = x + dx return - end function orbel_esolmd + end function swiftest_orbel_esolmd !********************************************************************** ! Code converted to Modern Fortran by David A. Minton ! Date: 2020-06-29 - ! ORBEL_EHIE.F + ! swiftest_orbel_EHIE.F !********************************************************************** ! PURPOSE: Solves Kepler's eqn. e is ecc. m is mean anomaly. ! @@ -472,7 +471,7 @@ end function orbel_esolmd ! e ==> eccentricity anomaly. (real scalar) ! m ==> mean anomaly. (real scalar) ! Returns: - ! orbel_ehybrid ==> eccentric anomaly. (real scalar) + ! swiftest_orbel_ehybrid ==> eccentric anomaly. (real scalar) ! ! ALGORITHM: Use Danby's quartic for 3 iterations. ! Eqn. is f(x) = x - e*sin(x+M). Note that @@ -484,7 +483,7 @@ end function orbel_esolmd ! DATE WRITTEN: May 25,1992. ! REVISIONS: !********************************************************************** - real(DP) pure function orbel_ehie(e,im) + real(DP) pure function swiftest_orbel_ehie(e,im) implicit none real(DP), intent(in) :: e,im @@ -512,7 +511,7 @@ real(DP) pure function orbel_ehie(e,im) ! iteration loop do niter =1,NMAX - call orbel_scget(x + m,sa,ca) + call swiftest_orbel_scget(x + m,sa,ca) esa = e * sa eca = e * ca f = x - esa @@ -523,21 +522,21 @@ real(DP) pure function orbel_ehie(e,im) x = x + dx end do - orbel_ehie = m + x + swiftest_orbel_ehie = m + x if (iflag == 1) then - orbel_ehie = TWOPI - orbel_ehie + swiftest_orbel_ehie = TWOPI - swiftest_orbel_ehie m = TWOPI - m end if return - end function orbel_ehie + end function swiftest_orbel_ehie !********************************************************************** ! Code converted to Modern Fortran by David A. Minton ! Date: 2020-06-29 - ! ORBEL_EGET.F + ! swiftest_orbel_EGET.F !********************************************************************** ! PURPOSE: Solves Kepler's eqn. e is ecc. m is mean anomaly. ! @@ -545,7 +544,7 @@ end function orbel_ehie ! e ==> eccentricity anomaly. (real scalar) ! m ==> mean anomaly. (real scalar) ! Returns: - ! orbel_eget ==> eccentric anomaly. (real scalar) + ! swiftest_orbel_eget ==> eccentric anomaly. (real scalar) ! ! ALGORITHM: Quartic convergence from Danby ! REMARKS: For results very near roundoff, give it M between @@ -559,7 +558,7 @@ end function orbel_ehie ! with the premise that it will only be called if ! we have an ellipse with e between 0.15 and 0.8 !********************************************************************** - real(DP) pure function orbel_eget(e,m) + real(DP) pure function swiftest_orbel_eget(e,m) implicit none real(DP), intent(in) :: e,m @@ -571,13 +570,13 @@ real(DP) pure function orbel_eget(e,m) ! may 21 : for e < 0.18 use esolmd for speed and sufficient accuracy ! may 21 : for e > 0.8 use ehie - this one may not converge fast enough. - call orbel_scget(m,sm,cm) + call swiftest_orbel_scget(m,sm,cm) ! begin with a guess accurate to order ecc**3 x = m + e * sm * ( 1._DP + e * (cm + e * (1._DP - 1.5_DP * sm * sm))) ! go through one iteration for improved estimate - call orbel_scget(x,sx,cx) + call swiftest_orbel_scget(x,sx,cx) es = e * sx ec = e * cx f = x - es - m @@ -587,14 +586,14 @@ real(DP) pure function orbel_eget(e,m) dx = -f / fp dx = -f / (fp + dx * fpp / 2._DP) dx = -f / (fp + dx * fpp / 2._DP + dx*2 * fppp / 6._DP) - orbel_eget = x + dx + swiftest_orbel_eget = x + dx ! do another iteration. ! for m between 0 and 2*pi this seems to be enough to ! get near roundoff error for eccentricities between 0 and 0.8 - x = orbel_eget - call orbel_scget(x,sx,cx) + x = swiftest_orbel_eget + call swiftest_orbel_scget(x,sx,cx) es = e * sx ec = e * cx f = x - es - m @@ -605,16 +604,16 @@ real(DP) pure function orbel_eget(e,m) dx = -f / (fp + dx * fpp / 2._DP) dx = -f / (fp + dx * fpp / 2._DP + dx**2 * fppp / 6._DP) - orbel_eget = x + dx + swiftest_orbel_eget = x + dx return - end function orbel_eget + end function swiftest_orbel_eget !********************************************************************** ! Code converted to Modern Fortran by David A. Minton ! Date: 2020-06-29 - ! ORBEL_EHYBRID.F + ! swiftest_orbel_EHYBRID.F !********************************************************************** ! PURPOSE: Solves Kepler's eqn. e is ecc. m is mean anomaly. ! @@ -622,7 +621,7 @@ end function orbel_eget ! e ==> eccentricity anomaly. (real scalar) ! m ==> mean anomaly. (real scalar) ! Returns: - ! orbel_ehybrid ==> eccentric anomaly. (real scalar) + ! swiftest_orbel_ehybrid ==> eccentric anomaly. (real scalar) ! ! ALGORITHM: For e < 0.18 uses fast routine ESOLMD ! For larger e but less than 0.8, uses EGET @@ -632,28 +631,28 @@ end function orbel_eget ! DATE WRITTEN: May 25,1992. ! REVISIONS: 2/26/93 hfl !********************************************************************** - real(DP) pure function orbel_ehybrid(e,m) + real(DP) pure function swiftest_orbel_ehybrid(e,m) implicit none real(DP), intent(in) :: e,m - !real(DP) :: orbel_esolmd,orbel_eget,orbel_ehie + !real(DP) :: swiftest_orbel_esolmd,orbel_eget,orbel_ehie if (e < 0.18_DP) then - orbel_ehybrid = orbel_esolmd(e,m) + swiftest_orbel_ehybrid = swiftest_orbel_esolmd(e,m) else if( e <= 0.8_DP) then - orbel_ehybrid = orbel_eget(e,m) + swiftest_orbel_ehybrid = swiftest_orbel_eget(e,m) else - orbel_ehybrid = orbel_ehie(e,m) + swiftest_orbel_ehybrid = swiftest_orbel_ehie(e,m) end if end if return - end function orbel_ehybrid + end function swiftest_orbel_ehybrid !********************************************************************** ! Code converted to Modern Fortran by David A. Minton ! Date: 2020-06-29 - ! ORBEL_FHYBRID.F + ! swiftest_orbel_FHYBRID.F !********************************************************************** ! PURPOSE: Solves Kepler's eqn. for hyperbola using hybrid approach. ! @@ -661,7 +660,7 @@ end function orbel_ehybrid ! e ==> eccentricity anomaly. (real scalar) ! n ==> hyperbola mean anomaly. (real scalar) ! Returns: - ! orbel_fhybrid ==> eccentric anomaly. (real scalar) + ! swiftest_orbel_fhybrid ==> eccentric anomaly. (real scalar) ! ! ALGORITHM: For abs(N) < 0.636*ecc -0.6 , use FLON ! For larger N, uses FGET @@ -671,7 +670,7 @@ end function orbel_ehybrid ! REVISIONS:: ! REVISIONS: 2/26/93 hfl !********************************************************************** - real(DP) pure function orbel_fhybrid(e,n) + real(DP) pure function swiftest_orbel_fhybrid(e,n) implicit none real(DP), intent(in) :: e,n @@ -681,16 +680,16 @@ real(DP) pure function orbel_fhybrid(e,n) if(n < 0._DP) abn = -abn if(abn < 0.636_DP * e -0.6_DP) then - orbel_fhybrid = orbel_flon(e,n) + swiftest_orbel_fhybrid = swiftest_orbel_flon(e,n) else - orbel_fhybrid = orbel_fget(e,n) + swiftest_orbel_fhybrid = swiftest_orbel_fget(e,n) end if return - end function orbel_fhybrid + end function swiftest_orbel_fhybrid - pure module subroutine orbel_xv2aeq(mu, px, py, pz, vx, vy, vz, a, e, q) + pure elemental module subroutine swiftest_orbel_xv2aeq(mu, px, py, pz, vx, vy, vz, a, e, q) !! author: David A. Minton !! !! Compute semimajor axis, eccentricity, and pericentric distance from relative Cartesian position and velocity @@ -752,10 +751,10 @@ pure module subroutine orbel_xv2aeq(mu, px, py, pz, vx, vy, vz, a, e, q) return - end subroutine orbel_xv2aeq + end subroutine swiftest_orbel_xv2aeq - pure module subroutine orbel_xv2aqt(mu, px, py, pz, vx, vy, vz, a, q, capm, tperi) + pure module subroutine swiftest_orbel_xv2aqt(mu, px, py, pz, vx, vy, vz, a, q, capm, tperi) !! author: David A. Minton !! !! Compute semimajor axis, pericentric distance, mean anomaly, and time to nearest pericenter passage from @@ -861,10 +860,10 @@ pure module subroutine orbel_xv2aqt(mu, px, py, pz, vx, vy, vz, a, q, capm, tper return - end subroutine orbel_xv2aqt + end subroutine swiftest_orbel_xv2aqt - module subroutine orbel_xv2el_vec(self, cb) + module subroutine swiftest_orbel_xv2el_vec(self, cb) !! author: David A. Minton !! !! A wrapper method that converts all of the cartesian position and velocity vectors of a Swiftest body object to orbital elements. @@ -886,7 +885,7 @@ 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%rh(1,i), self%rh(2,i), self%rh(3,i), & + call swiftest_orbel_xv2el(self%mu(i), self%rh(1,i), self%rh(2,i), self%rh(3,i), & self%vh(1,i), self%vh(2,i), self%vh(3,i), & self%a(i), self%e(i), self%inc(i), & self%capom(i), self%omega(i), self%capm(i), & @@ -894,10 +893,10 @@ module subroutine orbel_xv2el_vec(self, cb) end do return - end subroutine orbel_xv2el_vec + end subroutine swiftest_orbel_xv2el_vec - pure module subroutine orbel_xv2el(mu, px, py, pz, vx, vy, vz, a, e, inc, capom, omega, capm, varpi, lam, f, cape, capf) + pure module subroutine swiftest_orbel_xv2el(mu, px, py, pz, vx, vy, vz, a, e, inc, capom, omega, capm, varpi, lam, f, cape, capf) !! author: David A. Minton !! !! Compute osculating orbital elements from relative Cartesian position and velocity @@ -1044,7 +1043,7 @@ pure module subroutine orbel_xv2el(mu, px, py, pz, vx, vy, vz, a, e, inc, capom, return - end subroutine orbel_xv2el + end subroutine swiftest_orbel_xv2el end submodule s_orbel diff --git a/src/setup/setup.f90 b/src/swiftest_procedures/swiftest_setup.f90 similarity index 67% rename from src/setup/setup.f90 rename to src/swiftest_procedures/swiftest_setup.f90 index df55a53e9..5e20ede68 100644 --- a/src/setup/setup.f90 +++ b/src/swiftest_procedures/swiftest_setup.f90 @@ -7,84 +7,83 @@ !! You should have received a copy of the GNU General Public License along with Swiftest. !! If not, see: https://www.gnu.org/licenses. -submodule (swiftest_classes) s_setup - use swiftest +submodule (swiftest) s_setup + use whm + use rmvs + use helio + use symba contains - module subroutine setup_construct_system(system, param) + module subroutine swiftest_setup_construct_system(system, param) !! author: David A. Minton !! !! Constructor for a Swiftest nbody system. Creates the nbody system object based on the user-input integrator !! implicit none ! Arguments - class(swiftest_nbody_system), allocatable, intent(inout) :: system !! Swiftest system object - class(swiftest_parameters), intent(inout) :: param !! Swiftest parameters + class(base_nbody_system), allocatable, intent(inout) :: system !! Swiftest system object + class(base_parameters), intent(inout) :: param !! Swiftest parameters ! Internals type(encounter_storage) :: encounter_history type(collision_storage) :: collision_history - allocate(swiftest_storage(param%dump_cadence) :: param%system_history) - allocate(netcdf_parameters :: param%system_history%nc) - call param%system_history%reset() - - select case(param%integrator) - case (BS) - write(*,*) 'Bulirsch-Stoer integrator not yet enabled' - case (HELIO) - allocate(helio_nbody_system :: system) - select type(system) - class is (helio_nbody_system) - allocate(helio_cb :: system%cb) - allocate(helio_pl :: system%pl) - allocate(helio_tp :: system%tp) - allocate(helio_tp :: system%tp_discards) - end select - case (RA15) - write(*,*) 'Radau integrator not yet enabled' - case (TU4) - write(*,*) 'TU4 integrator not yet enabled' - case (WHM) - allocate(whm_nbody_system :: system) - select type(system) - class is (whm_nbody_system) - allocate(whm_cb :: system%cb) - allocate(whm_pl :: system%pl) - allocate(whm_tp :: system%tp) - allocate(whm_tp :: system%tp_discards) - end select - case (RMVS) - allocate(rmvs_nbody_system :: system) - select type(system) - class is (rmvs_nbody_system) - allocate(rmvs_cb :: system%cb) - allocate(rmvs_pl :: system%pl) - allocate(rmvs_tp :: system%tp) - allocate(rmvs_tp :: system%tp_discards) - end select - case (SYMBA) - allocate(symba_nbody_system :: system) - select type(system) - class is (symba_nbody_system) - allocate(symba_cb :: system%cb) - allocate(symba_pl :: system%pl) - allocate(symba_tp :: system%tp) - allocate(symba_tp :: system%tp_discards) - allocate(symba_merger :: system%pl_adds) - allocate(symba_merger :: system%pl_discards) - allocate(symba_pltpenc :: system%pltpenc_list) - allocate(symba_plplenc :: system%plplenc_list) - allocate(symba_plplenc :: system%plplcollision_list) - - select type(param) - class is (symba_parameters) + select type(param) + class is (swiftest_parameters) + allocate(swiftest_storage(param%dump_cadence) :: param%system_history) + allocate(swiftest_io_netcdf_parameters :: param%system_history%nc) + call param%system_history%reset() + + select case(param%integrator) + case (INT_BS) + write(*,*) 'Bulirsch-Stoer integrator not yet enabled' + case (INT_HELIO) + allocate(helio_nbody_system :: system) + select type(system) + class is (helio_nbody_system) + allocate(helio_cb :: system%cb) + allocate(helio_pl :: system%pl) + allocate(helio_tp :: system%tp) + allocate(helio_tp :: system%tp_discards) + end select + case (INT_RA15) + write(*,*) 'Radau integrator not yet enabled' + case (INT_TU4) + write(*,*) 'INT_TU4 integrator not yet enabled' + case (INT_WHM) + allocate(whm_nbody_system :: system) + select type(system) + class is (whm_nbody_system) + allocate(whm_cb :: system%cb) + allocate(whm_pl :: system%pl) + allocate(whm_tp :: system%tp) + allocate(whm_tp :: system%tp_discards) + end select + case (INT_RMVS) + allocate(rmvs_nbody_system :: system) + select type(system) + class is (rmvs_nbody_system) + allocate(rmvs_cb :: system%cb) + allocate(rmvs_pl :: system%pl) + allocate(rmvs_tp :: system%tp) + allocate(rmvs_tp :: system%tp_discards) + end select + case (INT_SYMBA) + allocate(symba_nbody_system :: system) + select type(system) + class is (symba_nbody_system) + allocate(symba_cb :: system%cb) + allocate(symba_pl :: system%pl) + allocate(symba_tp :: system%tp) + allocate(symba_tp :: system%tp_discards) + allocate(symba_pl :: system%pl_adds) + allocate(symba_pl :: system%pl_discards) + allocate(collision_list_pltp :: system%pltp_encounter) + allocate(collision_list_plpl :: system%plpl_encounter) + allocate(collision_list_plpl :: system%plpl_collision) if (param%lfragmentation) then allocate(fraggle_system :: system%collision_system) - call system%collision_system%setup(param) - - allocate(symba_nbody_system :: system%collision_system%before) - allocate(symba_nbody_system :: system%collision_system%after) + call system%collision_system%setup(system) end if if (param%lenc_save_trajectory .or. param%lenc_save_closest) then @@ -94,7 +93,7 @@ module subroutine setup_construct_system(system, param) class is (encounter_io_parameters) nc%file_number = param%iloop / param%dump_cadence end select - allocate(param%encounter_history, source=encounter_history) + allocate(system%encounter_history, source=encounter_history) end if allocate(collision_io_parameters :: collision_history%nc) @@ -103,24 +102,24 @@ module subroutine setup_construct_system(system, param) class is (collision_io_parameters) nc%file_number = param%iloop / param%dump_cadence end select - allocate(param%collision_history, source=collision_history) - end select + allocate(system%collision_history, source=collision_history) + end select + case (INT_RINGMOONS) + write(*,*) 'RINGMOONS-SyMBA integrator not yet enabled' + case default + write(*,*) 'Unkown integrator',param%integrator + call util_exit(FAILURE) end select - case (RINGMOONS) - write(*,*) 'RINGMOONS-SyMBA integrator not yet enabled' - case default - write(*,*) 'Unkown integrator',param%integrator - call util_exit(FAILURE) end select return - end subroutine setup_construct_system + end subroutine swiftest_setup_construct_system - module subroutine setup_initialize_particle_info_system(self, param) + module subroutine swiftest_setup_initialize_particle_info_system(self, param) !! author: David A. Minton !! !! Setup up particle information metadata from initial conditions @@ -132,9 +131,11 @@ module subroutine setup_initialize_particle_info_system(self, param) ! Internals integer(I4B) :: i - associate(cb => self%cb, pl => self%pl, npl => self%pl%nbody, tp => self%tp, ntp => self%tp%nbody) + associate(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", & + if (.not. allocated(self%cb%info)) allocate(swiftest_particle_info :: self%cb%info) + + call self%cb%info%set_value(particle_type=CB_TYPE_NAME, status="ACTIVE", origin_type="Initial conditions", & origin_time=param%t0, origin_rh=[0.0_DP, 0.0_DP, 0.0_DP], origin_vh=[0.0_DP, 0.0_DP, 0.0_DP]) do i = 1, self%pl%nbody call pl%info(i)%set_value(particle_type=PL_TYPE_NAME, status="ACTIVE", origin_type="Initial conditions", & @@ -148,10 +149,10 @@ module subroutine setup_initialize_particle_info_system(self, param) end associate return - end subroutine setup_initialize_particle_info_system + end subroutine swiftest_setup_initialize_particle_info_system - module subroutine setup_initialize_system(self, param) + module subroutine swiftest_setup_initialize_system(self, param) !! author: David A. Minton !! !! Wrapper method to initialize a basic Swiftest nbody system from files @@ -183,10 +184,10 @@ module subroutine setup_initialize_system(self, param) end associate return - end subroutine setup_initialize_system + end subroutine swiftest_setup_initialize_system - module subroutine setup_body(self, n, param) + module subroutine swiftest_setup_body(self, n, param) !! author: David A. Minton !! !! Constructor for base Swiftest particle class. Allocates space for all particles and @@ -209,7 +210,7 @@ module subroutine setup_body(self, n, param) self%nbody = n if (n == 0) return - allocate(self%info(n)) + allocate(swiftest_particle_info :: self%info(n)) allocate(self%id(n)) allocate(self%status(n)) allocate(self%ldiscard(n)) @@ -222,6 +223,12 @@ module subroutine setup_body(self, n, param) allocate(self%ah(NDIM, n)) allocate(self%ir3h(n)) allocate(self%aobl(NDIM, n)) + if (param%lclose) then + allocate(self%lcollision(n)) + allocate(self%lencounter(n)) + self%lcollision(:) = .false. + self%lencounter(:) = .false. + end if self%id(:) = 0 do i = 1, n @@ -263,10 +270,10 @@ module subroutine setup_body(self, n, param) end if return - end subroutine setup_body + end subroutine swiftest_setup_body - module subroutine setup_pl(self, n, param) + module subroutine swiftest_setup_pl(self, n, param) !! author: David A. Minton !! !! Constructor for base Swiftest massive body class. Allocates space for all particles and @@ -295,10 +302,18 @@ module subroutine setup_pl(self, n, param) self%nplpl = 0 if (param%lclose) then + allocate(self%lmtiny(n)) + allocate(self%nplenc(n)) + allocate(self%ntpenc(n)) allocate(self%radius(n)) allocate(self%density(n)) + + self%lmtiny(:) = .false. + self%nplenc(:) = 0 + self%ntpenc(:) = 0 self%radius(:) = 0.0_DP self%density(:) = 1.0_DP + end if if (param%lrotation) then @@ -318,10 +333,10 @@ module subroutine setup_pl(self, n, param) end if return - end subroutine setup_pl + end subroutine swiftest_setup_pl - module subroutine setup_tp(self, n, param) + module subroutine swiftest_setup_tp(self, n, param) !! author: David A. Minton !! !! Constructor for base Swiftest test particle particle class. Allocates space for @@ -340,12 +355,14 @@ module subroutine setup_tp(self, n, param) allocate(self%isperi(n)) allocate(self%peri(n)) allocate(self%atp(n)) + allocate(self%nplenc(n)) self%isperi(:) = 0 self%peri(:) = 0.0_DP self%atp(:) = 0.0_DP + self%nplenc(:) = 0 return - end subroutine setup_tp + end subroutine swiftest_setup_tp end submodule s_setup diff --git a/src/swiftest_procedures/swiftest_util.f90 b/src/swiftest_procedures/swiftest_util.f90 new file mode 100644 index 000000000..40f614f42 --- /dev/null +++ b/src/swiftest_procedures/swiftest_util.f90 @@ -0,0 +1,4923 @@ +!! Copyright 2022 - David Minton, Carlisle Wishard, Jennifer Pouplin, Jake Elliott, & Dana Singh +!! This file is part of Swiftest. +!! Swiftest is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License +!! as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. +!! Swiftest is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty +!! of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. +!! You should have received a copy of the GNU General Public License along with Swiftest. +!! If not, see: https://www.gnu.org/licenses. + +submodule (swiftest) s_util +contains + + module subroutine swiftest_util_append_arr_char_string(arr, source, nold, nsrc, lsource_mask) + !! author: David A. Minton + !! + !! Append a single array of character string type onto another. If the destination array is not allocated, or is not big enough, this will allocate space for it. + implicit none + ! Arguments + character(len=STRMAX), dimension(:), allocatable, intent(inout) :: arr !! Destination array + character(len=STRMAX), dimension(:), allocatable, intent(in) :: source !! Array to append + integer(I4B), intent(in) :: nold, nsrc !! Extend of the old array and the source array, respectively + logical, dimension(:), intent(in) :: lsource_mask !! Logical mask indicating which elements to append to + ! Internals + integer(I4B) :: nnew + + if (.not. allocated(source)) return + + nnew = count(lsource_mask(1:nsrc)) + if (.not.allocated(arr)) then + allocate(arr(nold+nnew)) + else + call util_resize(arr, nold + nnew) + end if + + arr(nold + 1:nold + nnew) = pack(source(1:nsrc), lsource_mask(1:nsrc)) + + return + end subroutine swiftest_util_append_arr_char_string + + + module subroutine swiftest_util_append_arr_DP(arr, source, nold, nsrc, lsource_mask) + !! author: David A. Minton + !! + !! Append a single array of double precision type onto another. If the destination array is not allocated, or is not big enough, this will allocate space for it. + implicit none + ! Arguments + real(DP), dimension(:), allocatable, intent(inout) :: arr !! Destination array + real(DP), dimension(:), allocatable, intent(in) :: source !! Array to append + integer(I4B), intent(in) :: nold, nsrc !! Extend of the old array and the source array, respectively + logical, dimension(:), intent(in) :: lsource_mask !! Logical mask indicating which elements to append to + ! Internals + integer(I4B) :: nnew + + if (.not. allocated(source)) return + + nnew = count(lsource_mask(1:nsrc)) + if (.not.allocated(arr)) then + allocate(arr(nold+nnew)) + else + call util_resize(arr, nold + nnew) + end if + + arr(nold + 1:nold + nnew) = pack(source(1:nsrc), lsource_mask(1:nsrc)) + + return + end subroutine swiftest_util_append_arr_DP + + + module subroutine swiftest_util_append_arr_DPvec(arr, source, nold, nsrc, lsource_mask) + !! author: David A. Minton + !! + !! Append a single array of double precision vector type of size (NDIM, n) onto another. If the destination array is not allocated, or is not big enough, this will allocate space for it. + implicit none + ! Arguments + real(DP), dimension(:,:), allocatable, intent(inout) :: arr !! Destination array + real(DP), dimension(:,:), allocatable, intent(in) :: source !! Array to append + integer(I4B), intent(in) :: nold, nsrc !! Extend of the old array and the source array, respectively + logical, dimension(:), intent(in) :: lsource_mask !! Logical mask indicating which elements to append to + ! Internals + integer(I4B) :: nnew + + if (.not. allocated(source)) return + + nnew = count(lsource_mask(1:nsrc)) + if (.not.allocated(arr)) then + allocate(arr(NDIM,nold+nnew)) + else + call util_resize(arr, nold + nnew) + end if + + arr(1, nold + 1:nold + nnew) = pack(source(1,1:nsrc), lsource_mask(1:nsrc)) + arr(2, nold + 1:nold + nnew) = pack(source(2,1:nsrc), lsource_mask(1:nsrc)) + arr(3, nold + 1:nold + nnew) = pack(source(3,1:nsrc), lsource_mask(1:nsrc)) + + return + end subroutine swiftest_util_append_arr_DPvec + + + module subroutine swiftest_util_append_arr_I4B(arr, source, nold, nsrc, lsource_mask) + !! author: David A. Minton + !! + !! Append a single array of integer(I4B) onto another. If the destination array is not allocated, or is not big enough, this will allocate space for it. + implicit none + ! Arguments + integer(I4B), dimension(:), allocatable, intent(inout) :: arr !! Destination array + integer(I4B), dimension(:), allocatable, intent(in) :: source !! Array to append + integer(I4B), intent(in) :: nold, nsrc !! Extend of the old array and the source array, respectively + logical, dimension(:), intent(in) :: lsource_mask !! Logical mask indicating which elements to append to + ! Internals + integer(I4B) :: nnew + + if (.not. allocated(source)) return + + nnew = count(lsource_mask(1:nsrc)) + if (.not.allocated(arr)) then + allocate(arr(nold+nnew)) + else + call util_resize(arr, nold + nnew) + end if + + arr(nold + 1:nold + nnew) = pack(source(1:nsrc), lsource_mask(1:nsrc)) + + return + end subroutine swiftest_util_append_arr_I4B + + + module subroutine swiftest_util_append_arr_info(arr, source, nold, nsrc, lsource_mask) + !! author: David A. Minton + !! + !! Append a single array of particle information type onto another. If the destination array is not allocated, or is not big enough, this will allocate space for it. + implicit none + ! Arguments + type(swiftest_particle_info), dimension(:), allocatable, intent(inout) :: arr !! Destination array + type(swiftest_particle_info), dimension(:), allocatable, intent(in) :: source !! Array to append + integer(I4B), intent(in) :: nold, nsrc !! Extend of the old array and the source array, respectively + logical, dimension(:), intent(in) :: lsource_mask !! Logical mask indicating which elements to append to + ! Internals + integer(I4B) :: nnew, i + integer(I4B), dimension(:), allocatable :: idx + + if (.not. allocated(source)) return + + nnew = count(lsource_mask(1:nsrc)) + if (.not.allocated(arr)) then + allocate(arr(nold+nnew)) + else + call util_resize(arr, nold + nnew) + end if + + allocate(idx(nnew)) + + idx = pack([(i, i = 1, nsrc)], lsource_mask(1:nsrc)) + + call util_copy_particle_info_arr(source(1:nsrc), arr(nold+1:nold+nnew), idx) + + return + end subroutine swiftest_util_append_arr_info + + + module subroutine swiftest_util_append_arr_logical(arr, source, nold, nsrc, lsource_mask) + !! author: David A. Minton + !! + !! Append a single array of logical type onto another. If the destination array is not allocated, or is not big enough, this will allocate space for it. + implicit none + ! Arguments + logical, dimension(:), allocatable, intent(inout) :: arr !! Destination array + logical, dimension(:), allocatable, intent(in) :: source !! Array to append + integer(I4B), intent(in) :: nold, nsrc !! Extend of the old array and the source array, respectively + logical, dimension(:), intent(in) :: lsource_mask !! Logical mask indicating which elements to append to + ! Internals + integer(I4B) :: nnew + + if (.not. allocated(source)) return + + nnew = count(lsource_mask(1:nsrc)) + if (.not.allocated(arr)) then + allocate(arr(nold+nnew)) + else + call util_resize(arr, nold + nnew) + end if + + arr(nold + 1:nold + nnew) = pack(source(1:nsrc), lsource_mask(1:nsrc)) + + return + end subroutine swiftest_util_append_arr_logical + + + module subroutine swiftest_util_append_body(self, source, lsource_mask) + !! author: David A. Minton + !! + !! Append components from one Swiftest body object to another. + !! This method will automatically resize the destination body if it is too small + implicit none + ! Arguments + class(swiftest_body), intent(inout) :: self !! Swiftest body object + class(swiftest_body), intent(in) :: source !! Source object to append + logical, dimension(:), intent(in) :: lsource_mask !! Logical mask indicating which elements to append to + ! Internals + integer(I4B) :: nold, nsrc, nnew + + nold = self%nbody + nsrc = source%nbody + nnew = count(lsource_mask(1:nsrc)) + + call util_append(self%info, source%info, nold, nsrc, lsource_mask) + call util_append(self%id, source%id, nold, nsrc, lsource_mask) + call util_append(self%status, source%status, nold, nsrc, lsource_mask) + call util_append(self%ldiscard, source%ldiscard, nold, nsrc, lsource_mask) + call util_append(self%lmask, source%lmask, nold, nsrc, lsource_mask) + call util_append(self%mu, source%mu, nold, nsrc, lsource_mask) + call util_append(self%rh, source%rh, nold, nsrc, lsource_mask) + call util_append(self%vh, source%vh, nold, nsrc, lsource_mask) + call util_append(self%rb, source%rb, nold, nsrc, lsource_mask) + call util_append(self%vb, source%vb, nold, nsrc, lsource_mask) + call util_append(self%ah, source%ah, nold, nsrc, lsource_mask) + call util_append(self%aobl, source%aobl, nold, nsrc, lsource_mask) + call util_append(self%atide, source%atide, nold, nsrc, lsource_mask) + call util_append(self%agr, source%agr, nold, nsrc, lsource_mask) + call util_append(self%ir3h, source%ir3h, nold, nsrc, lsource_mask) + call util_append(self%a, source%a, nold, nsrc, lsource_mask) + call util_append(self%e, source%e, nold, nsrc, lsource_mask) + call util_append(self%inc, source%inc, nold, nsrc, lsource_mask) + call util_append(self%capom, source%capom, nold, nsrc, lsource_mask) + call util_append(self%omega, source%omega, nold, nsrc, lsource_mask) + call util_append(self%capm, source%capm, nold, nsrc, lsource_mask) + + self%nbody = nold + nnew + + return + end subroutine swiftest_util_append_body + + + module subroutine swiftest_util_append_pl(self, source, lsource_mask) + !! author: David A. Minton + !! + !! Append components from one Swiftest body object to another. + !! This method will automatically resize the destination body if it is too small + implicit none + ! Arguments + class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object + class(swiftest_body), intent(in) :: source !! Source object to append + logical, dimension(:), intent(in) :: lsource_mask !! Logical mask indicating which elements to append to + + select type(source) + class is (swiftest_pl) + associate(nold => self%nbody, nsrc => source%nbody) + call util_append(self%mass, source%mass, nold, nsrc, lsource_mask) + call util_append(self%Gmass, source%Gmass, nold, nsrc, lsource_mask) + call util_append(self%rhill, source%rhill, nold, nsrc, lsource_mask) + call util_append(self%renc, source%renc, nold, nsrc, lsource_mask) + call util_append(self%radius, source%radius, nold, nsrc, lsource_mask) + call util_append(self%rbeg, source%rbeg, nold, nsrc, lsource_mask) + call util_append(self%rend, source%rend, nold, nsrc, lsource_mask) + call util_append(self%vbeg, source%vbeg, nold, nsrc, lsource_mask) + call util_append(self%density, source%density, nold, nsrc, lsource_mask) + call util_append(self%Ip, source%Ip, nold, nsrc, lsource_mask) + call util_append(self%rot, source%rot, nold, nsrc, lsource_mask) + call util_append(self%k2, source%k2, nold, nsrc, lsource_mask) + call util_append(self%Q, source%Q, nold, nsrc, lsource_mask) + call util_append(self%tlag, source%tlag, nold, nsrc, lsource_mask) + + if (allocated(self%k_plpl)) deallocate(self%k_plpl) + + call util_append_body(self, source, lsource_mask) + end associate + class default + write(*,*) "Invalid object passed to the append method. Source must be of class swiftest_pl or its descendents" + call util_exit(FAILURE) + end select + + return + end subroutine swiftest_util_append_pl + + + module subroutine swiftest_util_append_tp(self, source, lsource_mask) + !! author: David A. Minton + !! + !! Append components from one Swiftest body object to another. + !! This method will automatically resize the destination body if it is too small + implicit none + ! Arguments + class(swiftest_tp), intent(inout) :: self !! Swiftest test particle object + class(swiftest_body), intent(in) :: source !! Source object to append + logical, dimension(:), intent(in) :: lsource_mask !! Logical mask indicating which elements to append to + + select type(source) + class is (swiftest_tp) + associate(nold => self%nbody, nsrc => source%nbody) + call util_append(self%isperi, source%isperi, nold, nsrc, lsource_mask) + call util_append(self%peri, source%peri, nold, nsrc, lsource_mask) + call util_append(self%atp, source%atp, nold, nsrc, lsource_mask) + + call util_append_body(self, source, lsource_mask) + end associate + class default + write(*,*) "Invalid object passed to the append method. Source must be of class swiftest_tp or its descendents" + call util_exit(FAILURE) + end select + + return + end subroutine swiftest_util_append_tp + + + module subroutine swiftest_util_coord_h2b_pl(self, cb) + !! author: David A. Minton + !! + !! Convert massive bodies from heliocentric to barycentric coordinates (position and velocity) + !! + !! Adapted from David E. Kaufmann's Swifter routine coord_h2b.f90 + !! Adapted from Hal Levison's Swift routine coord_h2b.f + implicit none + ! Arguments + class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object + class(swiftest_cb), intent(inout) :: cb !! Swiftest central body object + ! Internals + integer(I4B) :: i + real(DP) :: Gmtot + real(DP), dimension(NDIM) :: xtmp, vtmp + + if (self%nbody == 0) return + associate(pl => self, npl => self%nbody) + Gmtot = cb%Gmass + xtmp(:) = 0.0_DP + vtmp(:) = 0.0_DP + do i = 1, npl + if (pl%status(i) == INACTIVE) cycle + Gmtot = Gmtot + pl%Gmass(i) + xtmp(:) = xtmp(:) + pl%Gmass(i) * pl%rh(:,i) + vtmp(:) = vtmp(:) + pl%Gmass(i) * pl%vh(:,i) + end do + cb%rb(:) = -xtmp(:) / Gmtot + cb%vb(:) = -vtmp(:) / Gmtot + do i = 1, npl + if (pl%status(i) == INACTIVE) cycle + pl%rb(:,i) = pl%rh(:,i) + cb%rb(:) + pl%vb(:,i) = pl%vh(:,i) + cb%vb(:) + end do + end associate + + return + end subroutine swiftest_util_coord_h2b_pl + + + module subroutine swiftest_util_coord_h2b_tp(self, cb) + !! author: David A. Minton + !! + !! Convert test particles from heliocentric to barycentric coordinates (position and velocity) + !! + !! Adapted from David E. Kaufmann's Swifter routine coord_h2b_tp.f90 + !! Adapted from Hal Levison's Swift routine coord_h2b_tp.f + implicit none + ! Arguments + class(swiftest_tp), intent(inout) :: self !! Swiftest test particle object + class(swiftest_cb), intent(in) :: cb !! Swiftest central body object + ! Internals + integer(I4B) :: i + + if (self%nbody == 0) return + associate(tp => self, ntp => self%nbody) + do concurrent (i = 1:ntp, tp%status(i) /= INACTIVE) + tp%rb(:, i) = tp%rh(:, i) + cb%rb(:) + tp%vb(:, i) = tp%vh(:, i) + cb%vb(:) + end do + end associate + + return + end subroutine swiftest_util_coord_h2b_tp + + + module subroutine swiftest_util_coord_b2h_pl(self, cb) + !! author: David A. Minton + !! + !! Convert massive bodies from barycentric to heliocentric coordinates (position and velocity) + !! + !! Adapted from David E. Kaufmann's Swifter routine coord_b2h.f90 + !! Adapted from Hal Levison's Swift routine coord_b2h.f + implicit none + ! Arguments + class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object + class(swiftest_cb), intent(inout) :: cb !! Swiftest central body object + ! Internals + integer(I4B) :: i + + if (self%nbody == 0) return + + associate(pl => self, npl => self%nbody) + do concurrent (i = 1:npl, pl%status(i) /= INACTIVE) + pl%rh(:, i) = pl%rb(:, i) - cb%rb(:) + pl%vh(:, i) = pl%vb(:, i) - cb%vb(:) + end do + end associate + + return + end subroutine swiftest_util_coord_b2h_pl + + + module subroutine swiftest_util_coord_b2h_tp(self, cb) + !! author: David A. Minton + !! + !! Convert test particles from barycentric to heliocentric coordinates (position and velocity) + !! + !! Adapted from David E. Kaufmann's Swifter routine coord_b2h_tp.f90 + !! Adapted from Hal Levison's Swift routine coord_b2h_tp.f + implicit none + ! Arguments + class(swiftest_tp), intent(inout) :: self !! Swiftest massive body object + class(swiftest_cb), intent(in) :: cb !! Swiftest central body object + ! Internals + integer(I4B) :: i + + if (self%nbody == 0) return + + associate(tp => self, ntp => self%nbody) + do concurrent(i = 1:ntp, tp%status(i) /= INACTIVE) + tp%rh(:, i) = tp%rb(:, i) - cb%rb(:) + tp%vh(:, i) = tp%vb(:, i) - cb%vb(:) + end do + end associate + + return + end subroutine swiftest_util_coord_b2h_tp + + + module subroutine swiftest_util_coord_vb2vh_pl(self, cb) + !! author: David A. Minton + !! + !! Convert massive bodies from barycentric to heliocentric coordinates (velocity only) + !! + !! Adapted from David E. Kaufmann's Swifter routine coord_vb2vh.f90 + !! Adapted from Hal Levison's Swift routine coord_vb2vh.f + implicit none + ! Arguments + class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object + class(swiftest_cb), intent(inout) :: cb !! Swiftest central body object + ! Internals + integer(I4B) :: i + + if (self%nbody == 0) return + + associate(pl => self, npl => self%nbody) + cb%vb(:) = 0.0_DP + do i = npl, 1, -1 + cb%vb(:) = cb%vb(:) - pl%Gmass(i) * pl%vb(:, i) / cb%Gmass + end do + do concurrent(i = 1:npl) + pl%vh(:, i) = pl%vb(:, i) - cb%vb(:) + end do + end associate + + return + end subroutine swiftest_util_coord_vb2vh_pl + + + module subroutine swiftest_util_coord_vb2vh_tp(self, vbcb) + !! author: David A. Minton + !! + !! Convert test particles from barycentric to heliocentric coordinates (velocity only) + !! + !! Adapted from David E. Kaufmann's Swifter routine coord_vb2vh_tp.f90 + !! Adapted from Hal Levison's Swift routine coord_vb2h_tp.f + implicit none + ! Arguments + class(swiftest_tp), intent(inout) :: self !! Swiftest test particle object + real(DP), dimension(:), intent(in) :: vbcb !! Barycentric velocity of the central body + + if (self%nbody == 0) return + + associate(tp => self, ntp => self%nbody) + where (tp%lmask(1:ntp)) + tp%vh(1, 1:ntp) = tp%vb(1, 1:ntp) - vbcb(1) + tp%vh(2, 1:ntp) = tp%vb(2, 1:ntp) - vbcb(2) + tp%vh(3, 1:ntp) = tp%vb(3, 1:ntp) - vbcb(3) + end where + end associate + + return + end subroutine swiftest_util_coord_vb2vh_tp + + + module subroutine swiftest_util_coord_vh2vb_pl(self, cb) + !! author: David A. Minton + !! + !! Convert massive bodies from heliocentric to barycentric coordinates (velocity only) + !! + !! Adapted from David E. Kaufmann's Swifter routine coord_vh2vb.f90 + !! Adapted from Hal Levison's Swift routine coord_vh2b.f + implicit none + ! Arguments + class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object + class(swiftest_cb), intent(inout) :: cb !! Swiftest central body object + ! Internals + integer(I4B) :: i + real(DP) :: Gmtot + + if (self%nbody == 0) return + + associate(pl => self, npl => self%nbody) + Gmtot = cb%Gmass + sum(pl%Gmass(1:npl)) + cb%vb(:) = 0.0_DP + do i = 1, npl + cb%vb(:) = cb%vb(:) - pl%Gmass(i) * pl%vh(:, i) + end do + cb%vb(:) = cb%vb(:) / Gmtot + do concurrent(i = 1:npl) + pl%vb(:, i) = pl%vh(:, i) + cb%vb(:) + end do + end associate + + return + end subroutine swiftest_util_coord_vh2vb_pl + + + module subroutine swiftest_util_coord_vh2vb_tp(self, vbcb) + !! author: David A. Minton + !! + !! Convert test particles from heliocentric to barycentric coordinates (velocity only) + !! + !! Adapted from David E. Kaufmann's Swifter routine coord_vh2vb_tp.f90 + !! Adapted from Hal Levison's Swift routine coord_vh2b_tp.f + implicit none + ! Arguments + class(swiftest_tp), intent(inout) :: self !! Swiftest test particle object + real(DP), dimension(:), intent(in) :: vbcb !! Barycentric velocity of the central body + + if (self%nbody == 0) return + + associate(tp => self, ntp => self%nbody) + where (tp%lmask(1:ntp)) + tp%vb(1, 1:ntp) = tp%vh(1, 1:ntp) + vbcb(1) + tp%vb(2, 1:ntp) = tp%vh(2, 1:ntp) + vbcb(2) + tp%vb(3, 1:ntp) = tp%vh(3, 1:ntp) + vbcb(3) + end where + end associate + + return + end subroutine swiftest_util_coord_vh2vb_tp + + + module subroutine swiftest_util_coord_rh2rb_pl(self, cb) + !! author: David A. Minton + !! + !! Convert position vectors of massive bodies from heliocentric to barycentric coordinates (position only) + !! + !! Adapted from David E. Kaufmann's Swifter routine coord_h2b.f90 + !! Adapted from Hal Levison's Swift routine coord_h2b.f + implicit none + ! Arguments + class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object + class(swiftest_cb), intent(inout) :: cb !! Swiftest central body object + ! Internals + integer(I4B) :: i + real(DP) :: Gmtot + real(DP), dimension(NDIM) :: xtmp + + if (self%nbody == 0) return + associate(pl => self, npl => self%nbody) + Gmtot = cb%Gmass + xtmp(:) = 0.0_DP + do i = 1, npl + if (pl%status(i) == INACTIVE) cycle + Gmtot = Gmtot + pl%Gmass(i) + xtmp(:) = xtmp(:) + pl%Gmass(i) * pl%rh(:,i) + end do + cb%rb(:) = -xtmp(:) / Gmtot + do i = 1, npl + if (pl%status(i) == INACTIVE) cycle + pl%rb(:,i) = pl%rh(:,i) + cb%rb(:) + end do + end associate + + return + end subroutine swiftest_util_coord_rh2rb_pl + + + module subroutine swiftest_util_coord_rh2rb_tp(self, cb) + !! author: David A. Minton + !! + !! Convert test particles from heliocentric to barycentric coordinates (position only) + !! + !! Adapted from David E. Kaufmann's Swifter routine coord_h2b_tp.f90 + !! Adapted from Hal Levison's Swift routine coord_h2b_tp.f + implicit none + ! Arguments + class(swiftest_tp), intent(inout) :: self !! Swiftest test particle object + class(swiftest_cb), intent(in) :: cb !! Swiftest central body object + ! Internals + integer(I4B) :: i + + if (self%nbody == 0) return + associate(tp => self, ntp => self%nbody) + do concurrent (i = 1:ntp, tp%status(i) /= INACTIVE) + tp%rb(:, i) = tp%rh(:, i) + cb%rb(:) + end do + end associate + + return + end subroutine swiftest_util_coord_rh2rb_tp + + + module subroutine swiftest_util_copy_particle_info(self, source) + !! author: David A. Minton + !! + !! Copies one set of information object components into another, component-by-component + implicit none + class(swiftest_particle_info), intent(inout) :: self + class(swiftest_particle_info), intent(in) :: source + + call self%set_value(& + name = source%name, & + particle_type = source%particle_type, & + status = source%status, & + origin_type = source%origin_type, & + origin_time = source%origin_time, & + collision_id = source%collision_id, & + origin_rh = source%origin_rh(:), & + origin_vh = source%origin_vh(:), & + discard_time = source%discard_time, & + discard_rh = source%discard_rh(:), & + discard_vh = source%discard_vh(:), & + discard_body_id = source%discard_body_id & + ) + + return + end subroutine swiftest_util_copy_particle_info + + + module subroutine swiftest_util_copy_particle_info_arr(source, dest, idx) + !! author: David A. Minton + !! + !! Copies contents from an array of one particle information objects to another. + implicit none + class(swiftest_particle_info), dimension(:), intent(in) :: source !! Source object to copy into + class(swiftest_particle_info), dimension(:), intent(inout) :: dest !! Swiftest body object with particle metadata information object + integer(I4B), dimension(:), intent(in), optional :: idx !! Optional array of indices to draw the source object + ! Internals + integer(I4B) :: i, j, n, nsource, ndest + + if (size(source) == 0) return + + if (present(idx)) then + n = size(idx) + else + n = size(source) + end if + + nsource = size(source) + ndest = size(dest) + + if ((n == 0) .or. (n > ndest) .or. (n > nsource)) then + write(*,*) 'Particle info copy operation failed. n, nsource, ndest: ',n, nsource, ndest + return + end if + + do i = 1, n + if (present(idx)) then + j = idx(i) + else + j = i + end if + call dest(i)%copy(source(j)) + end do + + return + end subroutine swiftest_util_copy_particle_info_arr + + + module subroutine swiftest_util_dealloc_body(self) + !! author: David A. Minton + !! + !! Finalize the swiftest body object - deallocates all allocatables + implicit none + ! Argument + class(swiftest_body), intent(inout) :: self + + if (allocated(self%info)) deallocate(self%info) + if (allocated(self%id)) deallocate(self%id) + if (allocated(self%status)) deallocate(self%status) + if (allocated(self%ldiscard)) deallocate(self%ldiscard) + if (allocated(self%lcollision)) deallocate(self%lcollision) + if (allocated(self%lencounter)) deallocate(self%lencounter) + if (allocated(self%lmask)) deallocate(self%lmask) + if (allocated(self%mu)) deallocate(self%mu) + if (allocated(self%rh)) deallocate(self%rh) + if (allocated(self%vh)) deallocate(self%vh) + if (allocated(self%rb)) deallocate(self%rb) + if (allocated(self%vb)) deallocate(self%vb) + if (allocated(self%ah)) deallocate(self%ah) + if (allocated(self%aobl)) deallocate(self%aobl) + if (allocated(self%agr)) deallocate(self%agr) + if (allocated(self%atide)) deallocate(self%atide) + if (allocated(self%ir3h)) deallocate(self%ir3h) + if (allocated(self%a)) deallocate(self%a) + if (allocated(self%e)) deallocate(self%e) + if (allocated(self%e)) deallocate(self%e) + if (allocated(self%inc)) deallocate(self%inc) + if (allocated(self%capom)) deallocate(self%capom) + if (allocated(self%omega)) deallocate(self%omega) + if (allocated(self%capm)) deallocate(self%capm) + + return + end subroutine swiftest_util_dealloc_body + + + module subroutine swiftest_util_dealloc_kin(self) + !! author: David A. Minton + !! + !! Deallocates all allocatabale arrays + implicit none + ! Arguments + class(swiftest_kinship), intent(inout) :: self !! Swiftest kinship object + + if (allocated(self%child)) deallocate(self%child) + + return + end subroutine swiftest_util_dealloc_kin + + + + module subroutine swiftest_util_dealloc_pl(self) + !! author: David A. Minton + !! + !! Finalize the swiftest massive body object - deallocates all allocatables + implicit none + ! Argument + class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object + ! Internals + integer(I4B) :: i + + if (allocated(self%mass)) deallocate(self%mass) + if (allocated(self%Gmass)) deallocate(self%Gmass) + if (allocated(self%rhill)) deallocate(self%rhill) + if (allocated(self%renc)) deallocate(self%renc) + if (allocated(self%radius)) deallocate(self%radius) + if (allocated(self%density)) deallocate(self%density) + if (allocated(self%rot)) deallocate(self%rot) + if (allocated(self%Ip)) deallocate(self%Ip) + if (allocated(self%k2)) deallocate(self%k2) + if (allocated(self%Q)) deallocate(self%Q) + if (allocated(self%tlag)) deallocate(self%tlag) + if (allocated(self%k_plpl)) deallocate(self%k_plpl) + if (allocated(self%lmtiny)) deallocate(self%lmtiny) + if (allocated(self%nplenc)) deallocate(self%nplenc) + if (allocated(self%ntpenc)) deallocate(self%ntpenc) + + + if (allocated(self%kin)) then + do i = 1, self%nbody + call self%kin(i)%dealloc() + end do + deallocate(self%kin) + end if + + call util_dealloc_body(self) + + return + end subroutine swiftest_util_dealloc_pl + + + module subroutine swiftest_util_dealloc_tp(self) + !! author: David A. Minton + !! + !! Finalize the swiftest test particle object - deallocates all allocatables + implicit none + ! Argument + class(swiftest_tp), intent(inout) :: self !! Swiftest test particle object + + if (allocated(self%nplenc)) deallocate(self%nplenc) + if (allocated(self%isperi)) deallocate(self%isperi) + if (allocated(self%peri)) deallocate(self%peri) + if (allocated(self%atp)) deallocate(self%atp) + if (allocated(self%k_pltp)) deallocate(self%k_pltp) + + call util_dealloc_body(self) + + return + end subroutine swiftest_util_dealloc_tp + + + module subroutine swiftest_util_exit(code) + !! author: David A. Minton + !! + !! Print termination message and exit program + !! + !! Adapted from David E. Kaufmann's Swifter routine: util_exit.f90 + !! Adapted from Hal Levison's Swift routine util_exit.f + implicit none + ! Arguments + integer(I4B), intent(in) :: code + ! Internals + character(*), parameter :: BAR = '("------------------------------------------------")' + character(*), parameter :: SUCCESS_MSG = '(/, "Normal termination of Swiftest (version ", f3.1, ")")' + character(*), parameter :: FAIL_MSG = '(/, "Terminating Swiftest (version ", f3.1, ") due to error!!")' + character(*), parameter :: USAGE_MSG = '("Usage: swiftest [bs|helio|ra15|rmvs|symba|tu4|whm] [standard|compact|progress|NONE]")' + character(*), parameter :: HELP_MSG = USAGE_MSG + + select case(code) + case(SUCCESS) + write(*, SUCCESS_MSG) VERSION_NUMBER + write(*, BAR) + case(USAGE) + write(*, USAGE_MSG) + case(HELP) + write(*, HELP_MSG) + case default + write(*, FAIL_MSG) VERSION_NUMBER + write(*, BAR) + error stop + end select + + stop + + end subroutine swiftest_util_exit + + + module subroutine swiftest_util_fill_arr_char_string(keeps, inserts, lfill_list) + !! author: David A. Minton + !! + !! Performs a fill operation on a single array of type character strings + !! This is the inverse of a spill operation + implicit none + ! Arguments + character(len=STRMAX), dimension(:), allocatable, intent(inout) :: keeps !! Array of values to keep + character(len=STRMAX), dimension(:), allocatable, intent(in) :: inserts !! Array of values to insert into keep + logical, dimension(:), intent(in) :: lfill_list !! Logical array of bodies to merge into the keeps + + if (.not.allocated(keeps) .or. .not.allocated(inserts)) return + + keeps(:) = unpack(keeps(:), .not.lfill_list(:), keeps(:)) + keeps(:) = unpack(inserts(:), lfill_list(:), keeps(:)) + + return + end subroutine swiftest_util_fill_arr_char_string + + + module subroutine swiftest_util_fill_arr_DP(keeps, inserts, lfill_list) + !! author: David A. Minton + !! + !! Performs a fill operation on a single array of type DP + !! This is the inverse of a spill operation + implicit none + ! Arguments + real(DP), dimension(:), allocatable, intent(inout) :: keeps !! Array of values to keep + real(DP), dimension(:), allocatable, intent(in) :: inserts !! Array of values to insert into keep + logical, dimension(:), intent(in) :: lfill_list !! Logical array of bodies to merge into the keeps + + if (.not.allocated(keeps) .or. .not.allocated(inserts)) return + + keeps(:) = unpack(keeps(:), .not.lfill_list(:), keeps(:)) + keeps(:) = unpack(inserts(:), lfill_list(:), keeps(:)) + + return + end subroutine swiftest_util_fill_arr_DP + + module subroutine swiftest_util_fill_arr_DPvec(keeps, inserts, lfill_list) + !! author: David A. Minton + !! + !! Performs a fill operation on a single array of DP vectors with shape (NDIM, n) + !! This is the inverse of a spill operation + implicit none + ! Arguments + real(DP), dimension(:,:), allocatable, intent(inout) :: keeps !! Array of values to keep + real(DP), dimension(:,:), allocatable, intent(in) :: inserts !! Array of values to insert into keep + logical, dimension(:), intent(in) :: lfill_list !! Logical array of bodies to merge into the keeps + ! Internals + integer(I4B) :: i + + if (.not.allocated(keeps) .or. .not.allocated(inserts)) return + + do i = 1, NDIM + keeps(i,:) = unpack(keeps(i,:), .not.lfill_list(:), keeps(i,:)) + keeps(i,:) = unpack(inserts(i,:), lfill_list(:), keeps(i,:)) + end do + + return + end subroutine swiftest_util_fill_arr_DPvec + + module subroutine swiftest_util_fill_arr_I4B(keeps, inserts, lfill_list) + !! author: David A. Minton + !! + !! Performs a fill operation on a single array of type I4B + !! This is the inverse of a spill operation + implicit none + ! Arguments + integer(I4B), dimension(:), allocatable, intent(inout) :: keeps !! Array of values to keep + integer(I4B), dimension(:), allocatable, intent(in) :: inserts !! Array of values to insert into keep + logical, dimension(:), intent(in) :: lfill_list !! Logical array of bodies to merge into the keeps + + if (.not.allocated(keeps) .or. .not.allocated(inserts)) return + + keeps(:) = unpack(keeps(:), .not.lfill_list(:), keeps(:)) + keeps(:) = unpack(inserts(:), lfill_list(:), keeps(:)) + + return + end subroutine swiftest_util_fill_arr_I4B + + + module subroutine swiftest_util_fill_arr_info(keeps, inserts, lfill_list) + !! author: David A. Minton + !! + !! Performs a fill operation on a single array of particle origin information types + !! This is the inverse of a spill operation + implicit none + ! Arguments + type(swiftest_particle_info), dimension(:), allocatable, intent(inout) :: keeps !! Array of values to keep + type(swiftest_particle_info), dimension(:), allocatable, intent(in) :: inserts !! Array of values to insert into keep + logical, dimension(:), intent(in) :: lfill_list !! Logical array of bodies to merge into the keeps + ! Internals + integer(I4B), dimension(:), allocatable :: insert_idx + integer(I4B) :: i, nkeep, ninsert + + if (.not.allocated(keeps) .or. .not.allocated(inserts)) return + + nkeep = size(keeps) + ninsert = count(lfill_list) + + allocate(insert_idx(ninsert)) + + insert_idx(:) = pack([(i, i = 1, nkeep)], lfill_list) + call util_copy_particle_info_arr(inserts, keeps, insert_idx) + + return + end subroutine swiftest_util_fill_arr_info + + + module subroutine swiftest_util_fill_arr_logical(keeps, inserts, lfill_list) + !! author: David A. Minton + !! + !! Performs a fill operation on a single array of logicals + !! This is the inverse of a spill operation + implicit none + ! Arguments + logical, dimension(:), allocatable, intent(inout) :: keeps !! Array of values to keep + logical, dimension(:), allocatable, intent(in) :: inserts !! Array of values to insert into keep + logical, dimension(:), intent(in) :: lfill_list !! Logical array of bodies to merge into the keeps + + if (.not.allocated(keeps) .or. .not.allocated(inserts)) return + + keeps(:) = unpack(keeps(:), .not.lfill_list(:), keeps(:)) + keeps(:) = unpack(inserts(:), lfill_list(:), keeps(:)) + + return + end subroutine swiftest_util_fill_arr_logical + + + module subroutine swiftest_util_fill_body(self, inserts, lfill_list) + !! author: David A. Minton + !! + !! Insert new Swiftest generic particle structure into an old one. + !! This is the inverse of a spill operation. + implicit none + ! Arguments + class(swiftest_body), intent(inout) :: self !! Swiftest generic body object + class(swiftest_body), intent(in) :: inserts !! Inserted object + logical, dimension(:), intent(in) :: lfill_list !! Logical array of bodies to merge into the keeps + + ! For each component, pack the discarded bodies into the discard object and do the inverse with the keeps + !> Fill all the common components + associate(keeps => self) + call util_fill(keeps%id, inserts%id, lfill_list) + call util_fill(keeps%info, inserts%info, lfill_list) + call util_fill(keeps%lmask, inserts%lmask, lfill_list) + call util_fill(keeps%status, inserts%status, lfill_list) + call util_fill(keeps%ldiscard, inserts%ldiscard, lfill_list) + call util_fill(keeps%lcollision, inserts%lcollision, lfill_list) + call util_fill(keeps%lencounter, inserts%lencounter, lfill_list) + call util_fill(keeps%mu, inserts%mu, lfill_list) + call util_fill(keeps%rh, inserts%rh, lfill_list) + call util_fill(keeps%vh, inserts%vh, lfill_list) + call util_fill(keeps%rb, inserts%rb, lfill_list) + call util_fill(keeps%vb, inserts%vb, lfill_list) + call util_fill(keeps%ah, inserts%ah, lfill_list) + call util_fill(keeps%aobl, inserts%aobl, lfill_list) + call util_fill(keeps%agr, inserts%agr, lfill_list) + call util_fill(keeps%atide, inserts%atide, lfill_list) + call util_fill(keeps%ir3h, inserts%ir3h, lfill_list) + call util_fill(keeps%isperi, inserts%isperi, lfill_list) + call util_fill(keeps%peri, inserts%peri, lfill_list) + call util_fill(keeps%atp, inserts%atp, lfill_list) + call util_fill(keeps%a, inserts%a, lfill_list) + call util_fill(keeps%e, inserts%e, lfill_list) + call util_fill(keeps%inc, inserts%inc, lfill_list) + call util_fill(keeps%capom, inserts%capom, lfill_list) + call util_fill(keeps%omega, inserts%omega, lfill_list) + call util_fill(keeps%capm, inserts%capm, lfill_list) + + ! This is the base class, so will be the last to be called in the cascade. + keeps%nbody = size(keeps%id(:)) + end associate + + return + end subroutine swiftest_util_fill_body + + + module subroutine swiftest_util_fill_pl(self, inserts, lfill_list) + !! author: David A. Minton + !! + !! Insert new Swiftest massive body structure into an old one. + !! This is the inverse of a spill operation. + implicit none + ! Arguments + class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object + class(swiftest_body), intent(in) :: inserts !! Swiftest body object to be inserted + logical, dimension(:), intent(in) :: lfill_list !! Logical array of bodies to merge into the keeps + + associate(keeps => self) + + select type (inserts) ! The standard requires us to select the type of both arguments in order to access all the components + class is (swiftest_pl) + !> Fill components specific to the massive body class + call util_fill(keeps%mass, inserts%mass, lfill_list) + call util_fill(keeps%Gmass, inserts%Gmass, lfill_list) + call util_fill(keeps%rhill, inserts%rhill, lfill_list) + call util_fill(keeps%renc, inserts%renc, lfill_list) + call util_fill(keeps%radius, inserts%radius, lfill_list) + call util_fill(keeps%density, inserts%density, lfill_list) + call util_fill(keeps%rbeg, inserts%rbeg, lfill_list) + call util_fill(keeps%rend, inserts%rend, lfill_list) + call util_fill(keeps%vbeg, inserts%vbeg, lfill_list) + call util_fill(keeps%Ip, inserts%Ip, lfill_list) + call util_fill(keeps%rot, inserts%rot, lfill_list) + call util_fill(keeps%k2, inserts%k2, lfill_list) + call util_fill(keeps%Q, inserts%Q, lfill_list) + call util_fill(keeps%tlag, inserts%tlag, lfill_list) + call util_fill(keeps%kin, inserts%kin, lfill_list) + call util_fill(keeps%nplenc, inserts%nplenc, lfill_list) + call util_fill(keeps%ntpenc, inserts%ntpenc, lfill_list) + + if (allocated(keeps%k_plpl)) deallocate(keeps%k_plpl) + + call util_fill_body(keeps, inserts, lfill_list) + class default + write(*,*) 'Error! fill method called for incompatible return type on swiftest_pl' + end select + end associate + + return + end subroutine swiftest_util_fill_pl + + + module subroutine swiftest_util_fill_tp(self, inserts, lfill_list) + !! author: David A. Minton + !! + !! Insert new Swiftest test particle structure into an old one. + !! This is the inverse of a fill operation. + implicit none + ! Arguments + class(swiftest_tp), intent(inout) :: self !! Swiftest test particle object + class(swiftest_body), intent(in) :: inserts !! Swiftest body object to be inserted + logical, dimension(:), intent(in) :: lfill_list !! Logical array of bodies to merge into the keeps + + associate(keeps => self) + select type(inserts) + class is (swiftest_tp) + !> Spill components specific to the test particle class + call util_fill(keeps%nplenc, inserts%nplenc, lfill_list) + + call util_fill_body(keeps, inserts, lfill_list) + class default + write(*,*) 'Error! fill method called for incompatible return type on swiftest_tp' + end select + end associate + + return + end subroutine swiftest_util_fill_tp + + + module subroutine swiftest_util_final_storage(self) + !! author: David A. Minton + !! + !! Finalizer for the storage data type + implicit none + ! Arguments + type(swiftest_storage(*)) :: self + ! Internals + integer(I4B) :: i + + do i = 1, self%nframes + if (allocated(self%frame(i)%item)) deallocate(self%frame(i)%item) + end do + + return + end subroutine swiftest_util_final_storage + + + module subroutine swiftest_util_final_system(self) + !! author: David A. Minton + !! + !! Finalize the swiftest nbody system object - deallocates all allocatables + implicit none + ! Argument + class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nbody system object + + if (allocated(self%cb)) deallocate(self%cb) + if (allocated(self%pl)) deallocate(self%pl) + if (allocated(self%tp)) deallocate(self%tp) + if (allocated(self%tp_discards)) deallocate(self%tp_discards) + if (allocated(self%pl_discards)) deallocate(self%pl_discards) + + return + end subroutine swiftest_util_final_system + + + pure module subroutine swiftest_util_flatten_eucl_ij_to_k(n, i, j, k) + !! author: Jacob R. Elliott and David A. Minton + !! + !! Turns i,j indices into k index for use in the Euclidean distance matrix for pl-pl interactions. + !! + !! Reference: + !! + !! Mélodie Angeletti, Jean-Marie Bonny, Jonas Koko. Parallel Euclidean distance matrix computation on big datasets *. + !! 2019. hal-0204751 + implicit none + ! Arguments + integer(I4B), intent(in) :: n !! Number of bodies + integer(I4B), intent(in) :: i !! Index of the ith body + integer(I4B), intent(in) :: j !! Index of the jth body + integer(I8B), intent(out) :: k !! Index of the flattened matrix + ! Internals + integer(I8B) :: i8, j8, n8 + + i8 = int(i, kind=I8B) + j8 = int(j, kind=I8B) + n8 = int(n, kind=I8B) + k = (i8 - 1_I8B) * n8 - i8 * (i8 - 1_I8B) / 2_I8B + (j8 - i8) + + return + end subroutine swiftest_util_flatten_eucl_ij_to_k + + + pure module subroutine swiftest_util_flatten_eucl_k_to_ij(n, k, i, j) + !! author: Jacob R. Elliott and David A. Minton + !! + !! Turns k index into i,j indices for use in the Euclidean distance matrix for pl-pl interactions. + !! + !! Reference: + !! + !! Mélodie Angeletti, Jean-Marie Bonny, Jonas Koko. Parallel Euclidean distance matrix computation on big datasets *. + !! 2019. hal-0204751 + implicit none + ! Arguments + integer(I4B), intent(in) :: n !! Number of bodies + integer(I8B), intent(in) :: k !! Index of the flattened matrix + integer(I4B), intent(out) :: i !! Index of the ith body + integer(I4B), intent(out) :: j !! Index of the jth body + ! Internals + integer(I8B) :: kp, p, i8, j8, n8 + + n8 = int(n, kind=I8B) + + kp = n8 * (n8 - 1_I8B) / 2_I8B - k + p = floor((sqrt(1._DP + 8_I8B * kp) - 1_I8B) / 2_I8B) + i8 = n8 - 1_I8B - p + j8 = k - (n8 - 1_I8B) * (n8 - 2_I8B) / 2_I8B + p * (p + 1_I8B) / 2_I8B + 1_I8B + + i = int(i8, kind=I4B) + j = int(j8, kind=I4B) + + return + end subroutine swiftest_util_flatten_eucl_k_to_ij + + + module subroutine swiftest_util_flatten_eucl_plpl(self, param) + !! author: Jacob R. Elliott and David A. Minton + !! + !! Turns i,j indices into k index for use in the Euclidean distance matrix for pl-pl interactions for a Swiftest massive body object + !! + !! Reference: + !! + !! Mélodie Angeletti, Jean-Marie Bonny, Jonas Koko. Parallel Euclidean distance matrix computation on big datasets *. + !! 2019. hal-0204751 + implicit none + ! Arguments + class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + ! Internals + integer(I4B) :: i, j, err + integer(I8B) :: k, npl + + npl = int(self%nbody, kind=I8B) + associate(nplpl => self%nplpl) + nplpl = npl * (npl - 1_I8B) / 2_I8B ! number of entries in a strict lower triangle, npl x npl + if (param%lflatten_interactions) then + if (allocated(self%k_plpl)) deallocate(self%k_plpl) ! Reset the index array if it's been set previously + allocate(self%k_plpl(2, nplpl), stat=err) + if (err /=0) then ! An error occurred trying to allocate this big array. This probably means it's too big to fit in memory, and so we will force the run back into triangular mode + param%lflatten_interactions = .false. + else + do concurrent (i=1:npl, j=1:npl, j>i) + call util_flatten_eucl_ij_to_k(self%nbody, i, j, k) + self%k_plpl(1, k) = i + self%k_plpl(2, k) = j + end do + end if + end if + end associate + + return + end subroutine swiftest_util_flatten_eucl_plpl + + + module subroutine swiftest_util_flatten_eucl_pltp(self, pl, param) + !! author: Jacob R. Elliott and David A. Minton + !! + !! Turns i,j indices into k index for use in the Euclidean distance matrix for pl-tp interactions + !! + !! Reference: + !! + !! Mélodie Angeletti, Jean-Marie Bonny, Jonas Koko. Parallel Euclidean distance matrix computation on big datasets *. + !! 2019. hal-0204751 + implicit none + ! Arguments + class(swiftest_tp), intent(inout) :: self !! Swiftest test particle object + class(swiftest_pl), intent(in) :: pl !! Swiftest massive body object + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + ! Internals + integer(I8B) :: i, j, counter, npl, ntp + + ntp = int(self%nbody, kind=I8B) + npl = int(pl%nbody, kind=I8B) + associate(npltp => self%npltp) + npltp = npl * ntp + if (allocated(self%k_pltp)) deallocate(self%k_pltp) ! Reset the index array if it's been set previously + allocate(self%k_pltp(2, npltp)) + do i = 1_I8B, npl + counter = (i - 1_I8B) * npl + 1_I8B + do j = 1_I8B, ntp + self%k_pltp(1, counter) = i + self%k_pltp(2, counter) = j + counter = counter + 1_I8B + end do + end do + end associate + + return + end subroutine swiftest_util_flatten_eucl_pltp + + + module subroutine swiftest_util_get_energy_momentum_system(self, param) + !! author: David A. Minton + !! + !! Compute total system angular momentum vector and kinetic, potential and total system energy + !! + !! Adapted from David E. Kaufmann Swifter routine symba_energy_eucl.f90 + !! + !! Adapted from Martin Duncan's Swift routine anal_energy.f + implicit none + class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nbody system object + class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters + ! Internals + integer(I4B) :: i + real(DP) :: kecb, kespincb + real(DP), dimension(self%pl%nbody) :: kepl, kespinpl + real(DP), dimension(self%pl%nbody) :: Lplorbitx, Lplorbity, Lplorbitz + real(DP), dimension(self%pl%nbody) :: Lplspinx, Lplspiny, Lplspinz + real(DP), dimension(NDIM) :: Lcborbit, Lcbspin + real(DP) :: hx, hy, hz + + associate(system => self, pl => self%pl, npl => self%pl%nbody, cb => self%cb) + system%Lorbit(:) = 0.0_DP + system%Lspin(:) = 0.0_DP + system%Ltot(:) = 0.0_DP + system%ke_orbit = 0.0_DP + system%ke_spin = 0.0_DP + + kepl(:) = 0.0_DP + Lplorbitx(:) = 0.0_DP + Lplorbity(:) = 0.0_DP + Lplorbitz(:) = 0.0_DP + Lplspinx(:) = 0.0_DP + Lplspiny(:) = 0.0_DP + Lplspinz(:) = 0.0_DP + + pl%lmask(1:npl) = pl%status(1:npl) /= INACTIVE + + system%GMtot = cb%Gmass + sum(pl%Gmass(1:npl), pl%lmask(1:npl)) + kecb = cb%mass * dot_product(cb%vb(:), cb%vb(:)) + Lcborbit(:) = cb%mass * (cb%rb(:) .cross. cb%vb(:)) + + do concurrent (i = 1:npl, pl%lmask(i)) + hx = pl%rb(2,i) * pl%vb(3,i) - pl%rb(3,i) * pl%vb(2,i) + hy = pl%rb(3,i) * pl%vb(1,i) - pl%rb(1,i) * pl%vb(3,i) + hz = pl%rb(1,i) * pl%vb(2,i) - pl%rb(2,i) * pl%vb(1,i) + + ! Angular momentum from orbit + Lplorbitx(i) = pl%mass(i) * hx + Lplorbity(i) = pl%mass(i) * hy + Lplorbitz(i) = pl%mass(i) * hz + + ! Kinetic energy from orbit + kepl(i) = pl%mass(i) * dot_product(pl%vb(:,i), pl%vb(:,i)) + end do + + if (param%lrotation) then + kespincb = cb%mass * cb%Ip(3) * cb%radius**2 * dot_product(cb%rot(:), cb%rot(:)) + + ! For simplicity, we always assume that the rotation pole is the 3rd principal axis + Lcbspin(:) = cb%Ip(3) * cb%mass * cb%radius**2 * cb%rot(:) + + do concurrent (i = 1:npl, pl%lmask(i)) + ! Currently we assume that the rotation pole is the 3rd principal axis + ! Angular momentum from spin + Lplspinx(i) = pl%mass(i) * pl%Ip(3,i) * pl%radius(i)**2 * pl%rot(1,i) + Lplspiny(i) = pl%mass(i) * pl%Ip(3,i) * pl%radius(i)**2 * pl%rot(2,i) + Lplspinz(i) = pl%mass(i) * pl%Ip(3,i) * pl%radius(i)**2 * pl%rot(3,i) + + ! Kinetic energy from spin + kespinpl(i) = pl%mass(i) * pl%Ip(3,i) * pl%radius(i)**2 * dot_product(pl%rot(:,i), pl%rot(:,i)) + end do + else + kespincb = 0.0_DP + kespinpl(:) = 0.0_DP + end if + + if (param%lflatten_interactions) then + call util_get_energy_potential_flat(npl, pl%nplpl, pl%k_plpl, pl%lmask, cb%Gmass, pl%Gmass, pl%mass, pl%rb, system%pe) + else + call util_get_energy_potential_triangular(npl, pl%lmask, cb%Gmass, pl%Gmass, pl%mass, pl%rb, system%pe) + end if + + ! Potential energy from the oblateness term + if (param%loblatecb) then + call system%obl_pot() + system%pe = system%pe + system%oblpot + end if + + system%ke_orbit = 0.5_DP * (kecb + sum(kepl(1:npl), pl%lmask(1:npl))) + if (param%lrotation) system%ke_spin = 0.5_DP * (kespincb + sum(kespinpl(1:npl), pl%lmask(1:npl))) + + system%Lorbit(1) = Lcborbit(1) + sum(Lplorbitx(1:npl), pl%lmask(1:npl)) + system%Lorbit(2) = Lcborbit(2) + sum(Lplorbity(1:npl), pl%lmask(1:npl)) + system%Lorbit(3) = Lcborbit(3) + sum(Lplorbitz(1:npl), pl%lmask(1:npl)) + + if (param%lrotation) then + system%Lspin(1) = Lcbspin(1) + sum(Lplspinx(1:npl), pl%lmask(1:npl)) + system%Lspin(2) = Lcbspin(2) + sum(Lplspiny(1:npl), pl%lmask(1:npl)) + system%Lspin(3) = Lcbspin(3) + sum(Lplspinz(1:npl), pl%lmask(1:npl)) + end if + + system%te = system%ke_orbit + system%ke_spin + system%pe + system%Ltot(:) = system%Lorbit(:) + system%Lspin(:) + end associate + + return + end subroutine swiftest_util_get_energy_momentum_system + + + subroutine swiftest_util_get_energy_potential_flat(npl, nplpl, k_plpl, lmask, GMcb, Gmass, mass, rb, pe) + !! author: David A. Minton + !! + !! Compute total system potential energy + implicit none + ! Arguments + integer(I4B), intent(in) :: npl + integer(I8B), intent(in) :: nplpl + integer(I4B), dimension(:,:), intent(in) :: k_plpl + logical, dimension(:), intent(in) :: lmask + real(DP), intent(in) :: GMcb + real(DP), dimension(:), intent(in) :: Gmass + real(DP), dimension(:), intent(in) :: mass + real(DP), dimension(:,:), intent(in) :: rb + real(DP), intent(out) :: pe + ! Internals + integer(I4B) :: i, j + integer(I8B) :: k + real(DP), dimension(npl) :: pecb + real(DP), dimension(nplpl) :: pepl + logical, dimension(nplpl) :: lstatpl + + ! Do the central body potential energy component first + where(.not. lmask(1:npl)) + pecb(1:npl) = 0.0_DP + end where + + do concurrent(i = 1:npl, lmask(i)) + pecb(i) = -GMcb * mass(i) / norm2(rb(:,i)) + end do + + !$omp parallel do default(private) schedule(static)& + !$omp shared(k_plpl, rb, mass, Gmass, pepl, lstatpl, lmask) & + !$omp firstprivate(nplpl) + do k = 1, nplpl + i = k_plpl(1,k) + j = k_plpl(2,k) + lstatpl(k) = (lmask(i) .and. lmask(j)) + if (lstatpl(k)) then + pepl(k) = -(Gmass(i) * mass(j)) / norm2(rb(:, i) - rb(:, j)) + else + pepl(k) = 0.0_DP + end if + end do + !$omp end parallel do + + pe = sum(pepl(:), lstatpl(:)) + sum(pecb(1:npl), lmask(1:npl)) + + return + end subroutine swiftest_util_get_energy_potential_flat + + + subroutine swiftest_util_get_energy_potential_triangular(npl, lmask, GMcb, Gmass, mass, rb, pe) + !! author: David A. Minton + !! + !! Compute total system potential energy + implicit none + ! Arguments + integer(I4B), intent(in) :: npl + logical, dimension(:), intent(in) :: lmask + real(DP), intent(in) :: GMcb + real(DP), dimension(:), intent(in) :: Gmass + real(DP), dimension(:), intent(in) :: mass + real(DP), dimension(:,:), intent(in) :: rb + real(DP), intent(out) :: pe + ! Internals + integer(I4B) :: i, j + real(DP), dimension(npl) :: pecb, pepl + + ! Do the central body potential energy component first + where(.not. lmask(1:npl)) + pecb(1:npl) = 0.0_DP + end where + + do concurrent(i = 1:npl, lmask(i)) + pecb(i) = -GMcb * mass(i) / norm2(rb(:,i)) + end do + + pe = 0.0_DP + !$omp parallel do default(private) schedule(static)& + !$omp shared(lmask, Gmass, mass, rb) & + !$omp firstprivate(npl) & + !$omp reduction(+:pe) + do i = 1, npl + if (lmask(i)) then + do concurrent(j = i+1:npl, lmask(i) .and. lmask(j)) + pepl(j) = - (Gmass(i) * mass(j)) / norm2(rb(:, i) - rb(:, j)) + end do + pe = pe + sum(pepl(i+1:npl), lmask(i+1:npl)) + end if + end do + !$omp end parallel do + pe = pe + sum(pecb(1:npl), lmask(1:npl)) + + return + end subroutine swiftest_util_get_energy_potential_triangular + + + module subroutine swiftest_util_index_array(ind_arr, n) + !! author: David A. Minton + !! + !! Creates or resizes an index array of size n where ind_arr = [1, 2, ... n]. + !! This subroutine swiftest_assumes that if ind_arr is already allocated, it is a pre-existing index array of a different size. + implicit none + ! Arguments + integer(I4B), dimension(:), allocatable, intent(inout) :: ind_arr !! Index array. Input is a pre-existing index array where n /= size(ind_arr). Output is a new index array ind_arr = [1, 2, ... n] + integer(I4B), intent(in) :: n !! The new size of the index array + ! Internals + integer(I4B) :: nold, i + integer(I4B), dimension(:), allocatable :: itmp + + if (allocated(ind_arr)) then + nold = size(ind_arr) + if (nold == n) return ! Nothing to do, so go home + else + nold = 0 + end if + + allocate(itmp(n)) + if (n >= nold) then + if (nold > 0) itmp(1:nold) = ind_arr(1:nold) + itmp(nold+1:n) = [(i, i = nold + 1, n)] + call move_alloc(itmp, ind_arr) + else + itmp(1:n) = ind_arr(1:n) + call move_alloc(itmp, ind_arr) + end if + + return + end subroutine swiftest_util_index_array + + + module subroutine swiftest_util_get_idvalues_system(self, idvals) + !! author: David A. Minton + !! + !! Returns an array of all id values saved in this snapshot + implicit none + ! Arguments + class(swiftest_nbody_system), intent(in) :: self !! Encounter snapshot object + integer(I4B), dimension(:), allocatable, intent(out) :: idvals !! Array of all id values saved in this snapshot + ! Internals + integer(I4B) :: npl, ntp + + if (allocated(self%pl)) then + npl = self%pl%nbody + else + npl = 0 + end if + if (allocated(self%tp)) then + ntp = self%tp%nbody + else + ntp = 0 + end if + + allocate(idvals(1 + npl+ntp)) + + idvals(1) = self%cb%id + if (npl > 0) idvals(2:npl+1) = self%pl%id(:) + if (ntp > 0) idvals(npl+2:npl+ntp+1) = self%tp%id(:) + + return + + end subroutine swiftest_util_get_idvalues_system + + + module subroutine swiftest_util_get_vals_storage(self, idvals, tvals) + !! author: David A. Minton + !! + !! Gets the id values in a storage object, regardless of whether it is encounter of collision + ! Argument + class(swiftest_storage(*)), intent(in) :: self !! Swiftest storage object + integer(I4B), dimension(:), allocatable, intent(out) :: idvals !! Array of all id values in all snapshots + real(DP), dimension(:), allocatable, intent(out) :: tvals !! Array of all time values in all snapshots + ! Internals + integer(I4B) :: i, n, nlo, nhi, ntotal + integer(I4B), dimension(:), allocatable :: itmp + + associate(storage => self, nsnaps => self%iframe) + + allocate(tvals(nsnaps)) + tvals(:) = 0.0_DP + + ! First pass to get total number of ids + ntotal = 0 + do i = 1, nsnaps + if (allocated(storage%frame(i)%item)) then + select type(snapshot => storage%frame(i)%item) + class is (swiftest_nbody_system) + tvals(i) = snapshot%t + call snapshot%get_idvals(itmp) + if (allocated(itmp)) then + n = size(itmp) + ntotal = ntotal + n + end if + end select + end if + end do + + allocate(idvals(ntotal)) + nlo = 1 + ! Second pass to store all ids get all of the ids stored + do i = 1, nsnaps + if (allocated(storage%frame(i)%item)) then + select type(snapshot => storage%frame(i)%item) + class is (swiftest_nbody_system) + tvals(i) = snapshot%t + call snapshot%get_idvals(itmp) + if (allocated(itmp)) then + n = size(itmp) + nhi = nlo + n - 1 + idvals(nlo:nhi) = itmp(1:n) + nlo = nhi + 1 + end if + end select + end if + end do + + end associate + return + end subroutine swiftest_util_get_vals_storage + + + module subroutine swiftest_util_index_map_storage(self) + !! author: David A. Minton + !! + !! Maps body id values to storage index values so we don't have to use unlimited dimensions for id + implicit none + ! Arguments + class(swiftest_storage(*)), intent(inout) :: self !! Swiftest storage object + ! Internals + integer(I4B), dimension(:), allocatable :: idvals + real(DP), dimension(:), allocatable :: tvals + + call util_get_vals_storage(self, idvals, tvals) + + call util_unique(idvals,self%idvals,self%idmap) + self%nid = size(self%idvals) + + call util_unique(tvals,self%tvals,self%tmap) + self%nt = size(self%tvals) + + return + end subroutine swiftest_util_index_map_storage + + module subroutine swiftest_util_minimize_bfgs(f, N, x0, eps, maxloop, lerr, x1) + !! author: David A. Minton + !! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + !! This function implements the Broyden-Fletcher-Goldfarb-Shanno method to determine the minimum of a function of N variables. + !! It recieves as input: + !! f%eval(x) : lambda function object containing the objective function as the eval metho + !! N : Number of variables of function f + !! x0 : Initial starting value of x + !! eps : Accuracy of 1 - dimensional minimization at each step + !! maxloop : Maximum number of loops to attempt to find a solution + !! The outputs include + !! lerr : Returns .true. if it could not find the minimum + !! Returns + !! x1 : Final minimum (all 0 if none found) + !! 0 = No miniumum found + !! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + use, intrinsic :: ieee_exceptions + implicit none + ! Arguments + integer(I4B), intent(in) :: N + class(lambda_obj), intent(inout) :: f + real(DP), dimension(:), intent(in) :: x0 + real(DP), intent(in) :: eps + integer(I4B), intent(in) :: maxloop + logical, intent(out) :: lerr + ! Result + real(DP), dimension(:), intent(out), allocatable :: x1 + ! Internals + integer(I4B) :: i, j, k, l, conv + real(DP), parameter :: graddelta = 1e-4_DP !! Delta x for gradient calculations + real(DP), dimension(N) :: S !! Direction vectors + real(DP), dimension(N,N) :: H !! Approximated inverse Hessian matrix + real(DP), dimension(N) :: grad1 !! gradient of f + real(DP), dimension(N) :: grad0 !! old value of gradient + real(DP) :: astar !! 1D minimized value + real(DP), dimension(N) :: y, P + real(DP), dimension(N,N) :: PP, PyH, HyP + real(DP), save :: yHy, Py + type(ieee_status_type) :: original_fpe_status + logical, dimension(:), allocatable :: fpe_flag + + call ieee_get_status(original_fpe_status) ! Save the original floating point exception status + call ieee_set_flag(ieee_all, .false.) ! Set all flags to quiet + allocate(fpe_flag(size(ieee_usual))) + + lerr = .false. + allocate(x1, source=x0) + ! Initialize approximate Hessian with the identity matrix (i.e. begin with method of steepest descent) + ! Get initial gradient and initialize arrays for updated values of gradient and x + H(:,:) = reshape([((0._DP, i=1, j-1), 1._DP, (0._DP, i=j+1, N), j=1, N)], [N,N]) + grad0 = gradf(f, N, x0(:), graddelta, lerr) + if (lerr) then + call ieee_set_status(original_fpe_status) + return + end if + grad1(:) = grad0(:) + do i = 1, maxloop + !check for convergence + conv = count(abs(grad1(:)) > eps) + if (conv == 0) exit + S(:) = -matmul(H(:,:), grad1(:)) + astar = minimize1D(f, x1, S, N, graddelta, lerr) + if (lerr) exit + ! Get new x values + P(:) = astar * S(:) + x1(:) = x1(:) + P(:) + ! Calculate new gradient + grad0(:) = grad1(:) + grad1 = gradf(f, N, x1, graddelta, lerr) + y(:) = grad1(:) - grad0(:) + Py = sum(P(:) * y(:)) + ! set up factors for H matrix update + yHy = 0._DP + !$omp do simd schedule(static)& + !$omp firstprivate(N, y, H) & + !$omp reduction(+:yHy) + do k = 1, N + do j = 1, N + yHy = yHy + y(j) * H(j,k) * y(k) + end do + end do + !$omp end do simd + ! prevent divide by zero (convergence) + if (abs(Py) < tiny(Py)) exit + ! set up update + PyH(:,:) = 0._DP + HyP(:,:) = 0._DP + !$omp parallel do default(private) schedule(static)& + !$omp shared(N, PP, P, y, H) & + !$omp reduction(+:PyH, HyP) + do k = 1, N + do j = 1, N + PP(j, k) = P(j) * P(k) + do l = 1, N + PyH(j, k) = PyH(j, k) + P(j) * y(l) * H(l,k) + HyP(j, k) = HyP(j, k) + P(k) * y(l) * H(j,l) + end do + end do + end do + !$omp end parallel do + ! update H matrix + H(:,:) = H(:,:) + ((1._DP - yHy / Py) * PP(:,:) - PyH(:,:) - HyP(:,:)) / Py + ! Normalize to prevent it from blowing up if it takes many iterations to find a solution + H(:,:) = H(:,:) / norm2(H(:,:)) + ! Stop everything if there are any exceptions to allow the routine to fail gracefully + call ieee_get_flag(ieee_usual, fpe_flag) + if (any(fpe_flag)) exit + if (i == maxloop) then + lerr = .true. + end if + end do + call ieee_get_flag(ieee_usual, fpe_flag) + lerr = lerr .or. any(fpe_flag) + call ieee_set_status(original_fpe_status) + + return + + contains + + function gradf(f, N, x1, dx, lerr) result(grad) + !! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + !! Purpose: Estimates the gradient of a function using a central difference + !! approximation + !! Inputs: + !! f%eval(x) : lambda function object containing the objective function as the eval metho + !! N : number of variables N + !! x1 : x value array + !! dx : step size to use when calculating derivatives + !! Outputs: + !! lerr : .true. if an error occurred. Otherwise returns .false. + !! Returns + !! grad : N sized array containing estimated gradient of f at x1 + !! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + implicit none + ! Arguments + integer(I4B), intent(in) :: N + class(lambda_obj), intent(inout) :: f + real(DP), dimension(:), intent(in) :: x1 + real(DP), intent(in) :: dx + logical, intent(out) :: lerr + ! Result + real(DP), dimension(N) :: grad + ! Internals + integer(I4B) :: i, j + real(DP), dimension(N) :: xp, xm + real(DP) :: fp, fm + logical :: lerrp, lerrm + + do i = 1, N + do j = 1, N + if (j == i) then + xp(j) = x1(j) + dx + xm(j) = x1(j) - dx + else + xp(j) = x1(j) + xm(j) = x1(j) + end if + end do + select type (f) + class is (lambda_obj_err) + fp = f%eval(xp) + lerrp = f%lerr + fm = f%eval(xm) + lerrm = f%lerr + lerr = lerrp .or. lerrm + class is (lambda_obj) + fp = f%eval(xp) + fm = f%eval(xm) + lerr = .false. + end select + grad(i) = (fp - fm) / (2 * dx) + if (lerr) return + end do + return + end function gradf + + + function minimize1D(f, x0, S, N, eps, lerr) result(astar) + !! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + !! This program find the minimum of a function of N variables in a single direction + !! S using in sequence: + !! 1. A Bracketing method + !! 2. The golden section method + !! 3. A quadratic polynomial fit + !! Inputs + !! f%eval(x) : lambda function object containing the objective function as the eval metho + !! x0 : Array of size N of initial x values + !! S : Array of size N that determines the direction of minimization + !! N : Number of variables of function f + !! eps : Accuracy of 1 - dimensional minimization at each step + !! Output + !! lerr : .true. if an error occurred. Otherwise returns .false. + !! Returns + !! astar : Final minimum along direction S + !! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + implicit none + ! Arguments + integer(I4B), intent(in) :: N + class(lambda_obj), intent(inout) :: f + real(DP), dimension(:), intent(in) :: x0, S + real(DP), intent(in) :: eps + logical, intent(out) :: lerr + ! Result + real(DP) :: astar + ! Internals + integer(I4B) :: num = 0 + real(DP), parameter :: step = 0.7_DP !! Bracketing method step size + real(DP), parameter :: gam = 1.2_DP !! Bracketing method expansion parameter + real(DP), parameter :: greduce = 0.2_DP !! Golden section method reduction factor + real(DP), parameter :: greduce2 = 0.1_DP ! Secondary golden section method reduction factor + real(DP) :: alo, ahi !! High and low values for 1 - D minimization routines + real(DP), parameter :: a0 = epsilon(1.0_DP) !! Initial guess of alpha + + alo = a0 + call bracket(f, x0, S, N, gam, step, alo, ahi, lerr) + if (lerr) then + !write(*,*) "BFGS bracketing step failed!" + !write(*,*) "alo: ",alo, "ahi: ", ahi + return + end if + if (abs(alo - ahi) < eps) then + astar = alo + lerr = .false. + return + end if + call golden(f, x0, S, N, greduce, alo, ahi, lerr) + if (lerr) then + !write(*,*) "BFGS golden section step failed!" + return + end if + if (abs(alo - ahi) < eps) then + astar = alo + lerr = .false. + return + end if + call quadfit(f, x0, S, N, eps, alo, ahi, lerr) + if (lerr) then + !write(*,*) "BFGS quadfit failed!" + return + end if + if (abs(alo - ahi) < eps) then + astar = alo + lerr = .false. + return + end if + ! Quadratic fit method won't converge, so finish off with another golden section + call golden(f, x0, S, N, greduce2, alo, ahi, lerr) + if (.not. lerr) astar = (alo + ahi) / 2.0_DP + return + end function minimize1D + + + function n2one(f, x0, S, N, a, lerr) result(fnew) + implicit none + ! Arguments + integer(I4B), intent(in) :: N + class(lambda_obj), intent(inout) :: f + real(DP), dimension(:), intent(in) :: x0, S + real(DP), intent(in) :: a + logical, intent(out) :: lerr + + ! Return + real(DP) :: fnew + ! Internals + real(DP), dimension(N) :: xnew + integer(I4B) :: i + + xnew(:) = x0(:) + a * S(:) + fnew = f%eval(xnew(:)) + select type(f) + class is (lambda_obj_err) + lerr = f%lerr + class is (lambda_obj) + lerr = .false. + end select + return + end function n2one + + ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + subroutine swiftest_bracket(f, x0, S, N, gam, step, lo, hi, lerr) + ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + !! This subroutine swiftest_brackets the minimum. It recieves as input: + !! f%eval(x) : lambda function object containing the objective function as the eval metho + !! x0 : Array of size N of initial x values + !! S : Array of size N that determines the direction of minimization + !! gam : expansion parameter + !! step : step size + !! lo : initial guess of lo bracket value + !! The outputs include + !! lo : lo bracket + !! hi : hi bracket + !! lerr : .true. if an error occurred. Otherwise returns .false. + !! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + implicit none + ! Arguments + integer(I4B), intent(in) :: N + class(lambda_obj), intent(inout) :: f + real(DP), dimension(:), intent(in) :: x0, S + real(DP), intent(in) :: gam, step + real(DP), intent(inout) :: lo + real(DP), intent(out) :: hi + logical, intent(out) :: lerr + ! Internals + real(DP) :: a0, a1, a2, atmp, da + real(DP) :: f0, f1, f2 + integer(I4B) :: i, j + integer(I4B), parameter :: MAXLOOP = 100 ! maximum number of loops before method is determined to have failed + real(DP), parameter :: eps = epsilon(lo) ! small number precision to test floating point equality + + ! set up initial bracket points + a0 = lo + da = step + a1 = a0 + da + a2 = a0 + 2 * da + f0 = n2one(f, x0, S, N, a0, lerr) + if (lerr) return + f1 = n2one(f, x0, S, N, a1, lerr) + if (lerr) return + f2 = n2one(f, x0, S, N, a2, lerr) + if (lerr) return + ! loop over bracket method until either min is bracketed method fails + do i = 1, MAXLOOP + if ((f0 > f1) .and. (f1 < f2)) then ! Minimum was found + lo = a0 + hi = a2 + return + else if ((f0 >= f1) .and. (f1 > f2)) then ! Function appears to decrease + da = da * gam + atmp = a2 + da + a0 = a1 + a1 = a2 + a2 = atmp + f0 = f1 + f1 = f2 + f2 = n2one(f, x0, S, N, a2, lerr) + else if ((f0 < f1) .and. (f1 <= f2)) then ! Function appears to increase + da = da * gam + atmp = a0 - da + a2 = a1 + a1 = a0 + a0 = atmp + f2 = f1 + f0 = n2one(f, x0, S, N, a0, lerr) + else if ((f0 < f1) .and. (f1 > f2)) then ! We are at a peak. Pick the direction that descends the fastest + da = da * gam + if (f2 > f0) then ! LHS is lower than RHS + atmp = a2 + da + a0 = a1 + a1 = a2 + a2 = atmp + f0 = f1 + f1 = f2 + f2 = n2one(f, x0, S, N, a2, lerr) + else ! RHS is lower than LHS + atmp = a0 - da + a2 = a1 + a1 = a0 + a0 = atmp + f2 = f1 + f1 = f2 + f0 = n2one(f, x0, S, N, a0, lerr) + end if + else if ((f0 > f1) .and. (abs(f2 - f1) <= eps)) then ! Decrasging but RHS equal + da = da * gam + atmp = a2 + da + a2 = atmp + f2 = n2one(f, x0, S, N, a2, lerr) + else if ((abs(f0 - f1) < eps) .and. (f1 < f2)) then ! Increasing but LHS equal + da = da * gam + atmp = a0 - da + a0 = atmp + f0 = n2one(f, x0, S, N, a0, lerr) + else ! all values equal. Expand in either direction and try again + a0 = a0 - da + a2 = a2 + da + f0 = n2one(f, x0, S, N, a0, lerr) + if (lerr) exit ! An error occurred while evaluating the function + f2 = n2one(f, x0, S, N, a2, lerr) + end if + if (lerr) exit ! An error occurred while evaluating the function + end do + lerr = .true. + return ! no minimum found + end subroutine swiftest_bracket + + ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + subroutine swiftest_golden(f, x0, S, N, eps, lo, hi, lerr) + ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + !! This function uses the golden section method to reduce the starting interval lo, hi by some amount sigma. + !! It recieves as input: + !! f%eval(x) : lambda function object containing the objective function as the eval metho + !! x0 : Array of size N of initial x values + !! S : Array of size N that determines the direction of minimization + !! gam : expansion parameter + !! eps : reduction interval in range (0 < sigma < 1) such that: + !! hi(new) - lo(new) = eps * (hi(old) - lo(old)) + !! lo : initial guess of lo bracket value + !! The outputs include + !! lo : lo bracket + !! hi : hi bracket + !! lerr : .true. if an error occurred. Otherwise returns .false. + !! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + implicit none + ! Arguments + integer(I4B), intent(in) :: N + class(lambda_obj), intent(inout) :: f + real(DP), dimension(:), intent(in) :: x0, S + real(DP), intent(in) :: eps + real(DP), intent(inout) :: lo + real(DP), intent(out) :: hi + logical, intent(out) :: lerr + ! Internals + real(DP), parameter :: tau = 0.5_DP * (sqrt(5.0_DP) - 1.0_DP) ! Golden section constant + integer(I4B), parameter :: MAXLOOP = 40 ! maximum number of loops before method is determined to have failed (unlikely, but could occur if no minimum exists between lo and hi) + real(DP) :: i0 ! Initial interval value + real(DP) :: a1, a2 + real(DP) :: f1, f2 + integer(I4B) :: i, j + + i0 = hi - lo + a1 = hi - tau * i0 + a2 = lo + tau * i0 + f1 = n2one(f, x0, S, N, a1, lerr) + if (lerr) return + f2 = n2one(f, x0, S, N, a2, lerr) + if (lerr) return + do i = 1, MAXLOOP + if (abs((hi - lo) / i0) <= eps) return ! interval reduced to input amount + if (f2 > f1) then + hi = a2 + a2 = a1 + f2 = f1 + a1 = hi - tau * (hi - lo) + f1 = n2one(f, x0, S, N, a1, lerr) + else + lo = a1 + a1 = a2 + f2 = f1 + a2 = hi - (1.0_DP - tau) * (hi - lo) + f2 = n2one(f, x0, S, N, a2, lerr) + end if + if (lerr) exit + end do + lerr = .true. + return ! search took too many iterations - no minimum found + end subroutine swiftest_golden + + ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + subroutine swiftest_quadfit(f, x0, S, N, eps, lo, hi, lerr) + ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + !! This function uses a quadratic polynomial fit to locate the minimum of a function + !! to some accuracy eps. It recieves as input: + !! f%eval(x) : lambda function object containing the objective function as the eval metho + !! lo : low bracket value + !! hi : high bracket value + !! eps : desired accuracy of final minimum location + !! The outputs include + !! lo : final minimum location + !! hi : final minimum location + !! Notes: Uses the ieee_exceptions intrinsic module to allow for graceful failure due to floating point exceptions, which won't terminate the run. + !! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + implicit none + ! Arguments + integer(I4B), intent(in) :: N + class(lambda_obj), intent(inout) :: f + real(DP), dimension(:), intent(in) :: x0, S + real(DP), intent(in) :: eps + real(DP), intent(inout) :: lo + real(DP), intent(out) :: hi + logical, intent(out) :: lerr + ! Internals + integer(I4B), parameter :: MAXLOOP = 20 ! maximum number of loops before method is determined to have failed. + real(DP) :: a1, a2, a3, astar ! three points for the polynomial fit and polynomial minimum + real(DP) :: f1, f2, f3, fstar ! three function values for the polynomial and polynomial minimum + real(DP), dimension(3) :: row_1, row_2, row_3, rhs, soln ! matrix for 3 equation solver (gaussian elimination) + real(DP), dimension(3,3) :: lhs + real(DP) :: d1, d2, d3, aold, denom, errval + integer(I4B) :: i + + lerr = .false. + ! Get initial a1, a2, a3 values + a1 = lo + a2 = lo + 0.5_DP * (hi - lo) + a3 = hi + aold = a1 + astar = a2 + f1 = n2one(f, x0, S, N, a1, lerr) + if (lerr) return + f2 = n2one(f, x0, S, N, a2, lerr) + if (lerr) return + f3 = n2one(f, x0, S, N, a3, lerr) + if (lerr) return + do i = 1, MAXLOOP + ! check to see if convergence is reached and exit + errval = abs((astar - aold) / astar) + call ieee_get_flag(ieee_usual, fpe_flag) + if (any(fpe_flag)) then + !write(*,*) 'quadfit fpe' + !write(*,*) 'aold : ',aold + !write(*,*) 'astar: ',astar + lerr = .true. + exit + end if + if (errval < eps) then + lo = astar + hi = astar + exit + end if + ! Set up system for gaussian elimination equation solver + row_1 = [1.0_DP, a1, a1**2] + row_2 = [1.0_DP, a2, a2**2] + row_3 = [1.0_DP, a3, a3**2] + rhs = [f1, f2, f3] + lhs(1, :) = row_1 + lhs(2, :) = row_2 + lhs(3, :) = row_3 + ! Solve system of equations + soln(:) = util_solve_linear_system(lhs, rhs, 3, lerr) + call ieee_set_flag(ieee_all, .false.) ! Set all flags back to quiet + call ieee_set_halting_mode(ieee_divide_by_zero, .false.) + if (lerr) then + !write(*,*) 'quadfit fpe:' + !write(*,*) 'util_solve_linear_system failed' + exit + end if + aold = astar + if (soln(2) == soln(3)) then ! Handles the case where they are both 0. 0/0 is an unhandled exception + astar = -0.5_DP + else + astar = -soln(2) / (2 * soln(3)) + end if + call ieee_get_flag(ieee_usual, fpe_flag) + if (any(fpe_flag)) then + !write(*,*) 'quadfit fpe' + !write(*,*) 'soln(2:3): ',soln(2:3) + !write(*,*) 'a1, a2, a3' + !write(*,*) a1, a2, a3 + !write(*,*) 'f1, f2, f3' + !write(*,*) f1, f2, f3 + lerr = .true. + exit + end if + fstar = n2one(f, x0, S, N, astar, lerr) + if (lerr) exit + ! keep the three closest a values to astar and discard the fourth + d1 = abs(a1 - astar) + d2 = abs(a2 - astar) + d3 = abs(a3 - astar) + + if (d1 > d2) then + if (d1 > d3) then + f1 = fstar + a1 = astar + else if (d3 > d2) then + f3 = fstar + a3 = astar + end if + else + if (d2 > d3) then + f2 = fstar + a2 = astar + else if (d3 > d1) then + f3 = fstar + a3 = astar + end if + end if + end do + if (lerr) return + lo = a1 + hi = a3 + return + end subroutine swiftest_quadfit + + end subroutine swiftest_util_minimize_bfgs + + subroutine swiftest_util_peri(n,m, r, v, atp, q, isperi) + !! author: David A. Minton + !! + !! Helper function that does the pericenter passage computation for any body + !! + !! Adapted from David E. Kaufmann's Swifter routine: symba_peri.f90 + !! Adapted from Hal Levison's Swift routine util_mass_peri.f + implicit none + ! Arguments + integer(I4B), intent(in) :: n !! Number of bodies + real(DP), dimension(:), intent(in) :: m !! Mass term (mu for HELIO coordinates, and Gmtot for BARY) + real(DP), dimension(:,:), intent(in) :: r !! Position vectors (rh for HELIO coordinates, rb for BARY) + real(DP), dimension(:,:), intent(in) :: v !! Position vectors (vh for HELIO coordinates, rb for BARY) + real(DP), dimension(:), intent(out) :: atp !! Semimajor axis + real(DP), dimension(:), intent(out) :: q !! Periapsis + integer(I4B), dimension(:), intent(inout) :: isperi !! Periapsis passage flag + ! Internals + integer(I4B) :: i + real(DP), dimension(n) :: e !! Temporary, just to make use of the xv2aeq subroutine + real(DP) :: vdotr + + do concurrent(i = 1:n) + vdotr = dot_product(r(:,i),v(:,i)) + if (isperi(i) == -1) then + if (vdotr >= 0.0) then + isperi(i) = 0 + call swiftest_orbel_xv2aeq(m(i),r(1,i),r(2,i),r(3,i),v(1,i),v(2,i),v(3,i),atp(i),e(i),q(i)) + end if + else + if (vdotr > 0.0) then + isperi(i) = -1 + else + isperi(i) = 1 + end if + end if + end do + + return + end subroutine swiftest_util_peri + + + module subroutine swiftest_util_peri_body(self, system, param) + !! author: David A. Minton + !! + !! Determine system pericenter passages for bodies + !! + !! Adapted from David E. Kaufmann's Swifter routine: symba_peri.f90 + !! Adapted from Hal Levison's Swift routine util_mass_peri.f + implicit none + ! Arguments + class(swiftest_body), intent(inout) :: self !! SyMBA massive body object + class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters + ! Internals + integer(I4B) :: i + + select type(self) + class is (swiftest_pl) + if (self%lfirst) self%isperi(:) = 0 + end select + + if (param%qmin_coord == "HELIO") then + call swiftest_util_peri(self%nbody, self%mu, self%rh, self%vh, self%atp, self%peri, self%isperi) + else + call swiftest_util_peri(self%nbody, [(system%Gmtot,i=1,self%nbody)], self%rb, self%vb, self%atp, self%peri, self%isperi) + end if + + return + end subroutine swiftest_util_peri_body + + + module subroutine swiftest_util_rearray_pl(self, system, param) + !! Author: the Purdue Swiftest Team - David A. Minton, Carlisle A. Wishard, Jennifer L.L. Pouplin, and Jacob R. Elliott + !! + !! Clean up the massive body structures to remove discarded bodies and add new bodies + use symba + implicit none + ! Arguments + class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object + class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + ! Internals + class(swiftest_pl), allocatable :: tmp !! The discarded body list. + integer(I4B) :: i, k, npl, nadd, nencmin, nenc_old, idnew1, idnew2, idold1, idold2 + logical, dimension(:), allocatable :: lmask, ldump_mask + class(collision_list_plpl), allocatable :: plplenc_old + logical :: lencounter + integer(I4B), dimension(:), allocatable :: levelg_orig_pl, levelm_orig_pl, levelg_orig_tp, levelm_orig_tp + integer(I4B), dimension(:), allocatable :: nplenc_orig_pl, nplenc_orig_tp, ntpenc_orig_pl + + associate(pl => self, pl_adds => system%pl_adds) + + npl = pl%nbody + nadd = pl_adds%nbody + if (npl == 0) return + ! Deallocate any temporary variables + if (allocated(pl%rbeg)) deallocate(pl%rbeg) + if (allocated(pl%rend)) deallocate(pl%rend) + + ! Remove the discards and destroy the list, as the system already tracks pl_discards elsewhere + allocate(lmask(npl)) + lmask(1:npl) = pl%ldiscard(1:npl) + if (count(lmask(:)) > 0) then + allocate(tmp, mold=self) + call pl%spill(tmp, lspill_list=lmask, ldestructive=.true.) + npl = pl%nbody + call tmp%setup(0,param) + deallocate(tmp) + deallocate(lmask) + end if + + ! Store the original plplenc list so we don't remove any of the original encounters + nenc_old = system%plpl_encounter%nenc + if (nenc_old > 0) then + allocate(plplenc_old, source=system%plpl_encounter) + call plplenc_old%copy(system%plpl_encounter) + end if + + ! Add in any new bodies + if (nadd > 0) then + ! Append the adds to the main pl object + call pl%append(pl_adds, lsource_mask=[(.true., i=1, nadd)]) + + allocate(ldump_mask(npl+nadd)) ! This mask is used only to append the original Fortran binary particle.dat file with new bodies. This is ignored for NetCDF output + ldump_mask(1:npl) = .false. + ldump_mask(npl+1:npl+nadd) = pl%status(npl+1:npl+nadd) == NEW_PARTICLE + npl = pl%nbody + else + allocate(ldump_mask(npl)) + ldump_mask(:) = .false. + end if + + ! Reset all of the status flags for this body + pl%status(1:npl) = ACTIVE + do i = 1, npl + call pl%info(i)%set_value(status="ACTIVE") + end do + pl%ldiscard(1:npl) = .false. + pl%lcollision(1:npl) = .false. + pl%lmask(1:npl) = .true. + + pl%lmtiny(1:npl) = pl%Gmass(1:npl) < param%GMTINY + where(pl%lmtiny(1:npl)) + pl%info(1:npl)%particle_type = PL_TINY_TYPE_NAME + elsewhere + pl%info(1:npl)%particle_type = PL_TYPE_NAME + end where + + call pl%write_info(param%system_history%nc, param) + deallocate(ldump_mask) + + ! Reindex the new list of bodies + call pl%sort("mass", ascending=.false.) + call pl%flatten(param) + + ! Reset the kinship trackers + call pl%reset_kinship([(i, i=1, npl)]) + + ! Re-build the zero-level encounter list, being sure to save the original level information for all bodies + allocate(nplenc_orig_pl, source=pl%nplenc) + select type(pl) + class is (symba_pl) + allocate(levelg_orig_pl, source=pl%levelg) + allocate(levelm_orig_pl, source=pl%levelm) + call move_alloc(levelg_orig_pl, pl%levelg) + call move_alloc(levelm_orig_pl, pl%levelm) + end select + lencounter = pl%encounter_check(param, system, param%dt, system%irec) + if (system%tp%nbody > 0) then + allocate(ntpenc_orig_pl, source=pl%ntpenc) + allocate(nplenc_orig_tp, source=tp%nplenc) + select type(tp => system%tp) + class is (symba_tp) + allocate(levelg_orig_tp, source=tp%levelg) + allocate(levelm_orig_tp, source=tp%levelm) + lencounter = tp%encounter_check(param, system, param%dt, system%irec) + call move_alloc(levelg_orig_tp, tp%levelg) + call move_alloc(levelm_orig_tp, tp%levelm) + call move_alloc(nplenc_orig_tp, tp%nplenc) + call move_alloc(ntpenc_orig_pl, pl%ntpenc) + end select + end if + + call move_alloc(nplenc_orig_pl, pl%nplenc) + + ! Re-index the encounter list as the index values may have changed + if (nenc_old > 0) then + nencmin = min(system%plpl_encounter%nenc, plplenc_old%nenc) + system%plpl_encounter%nenc = nencmin + do k = 1, nencmin + idnew1 = system%plpl_encounter%id1(k) + idnew2 = system%plpl_encounter%id2(k) + idold1 = plplenc_old%id1(k) + idold2 = plplenc_old%id2(k) + if ((idnew1 == idold1) .and. (idnew2 == idold2)) then + ! This is an encounter we already know about, so save the old information + system%plpl_encounter%lvdotr(k) = plplenc_old%lvdotr(k) + system%plpl_encounter%lclosest(k) = plplenc_old%lclosest(k) + system%plpl_encounter%status(k) = plplenc_old%status(k) + system%plpl_encounter%r1(:,k) = plplenc_old%r1(:,k) + system%plpl_encounter%r2(:,k) = plplenc_old%r2(:,k) + system%plpl_encounter%v1(:,k) = plplenc_old%v1(:,k) + system%plpl_encounter%v2(:,k) = plplenc_old%v2(:,k) + system%plpl_encounter%tcollision(k) = plplenc_old%tcollision(k) + system%plpl_encounter%level(k) = plplenc_old%level(k) + else if (((idnew1 == idold2) .and. (idnew2 == idold1))) then + ! This is an encounter we already know about, but with the order reversed, so save the old information + system%plpl_encounter%lvdotr(k) = plplenc_old%lvdotr(k) + system%plpl_encounter%lclosest(k) = plplenc_old%lclosest(k) + system%plpl_encounter%status(k) = plplenc_old%status(k) + system%plpl_encounter%r1(:,k) = plplenc_old%r2(:,k) + system%plpl_encounter%r2(:,k) = plplenc_old%r1(:,k) + system%plpl_encounter%v1(:,k) = plplenc_old%v2(:,k) + system%plpl_encounter%v2(:,k) = plplenc_old%v1(:,k) + system%plpl_encounter%tcollision(k) = plplenc_old%tcollision(k) + system%plpl_encounter%level(k) = plplenc_old%level(k) + end if + system%plpl_encounter%index1(k) = findloc(pl%id(1:npl), system%plpl_encounter%id1(k), dim=1) + system%plpl_encounter%index2(k) = findloc(pl%id(1:npl), system%plpl_encounter%id2(k), dim=1) + end do + if (allocated(lmask)) deallocate(lmask) + allocate(lmask(nencmin)) + nenc_old = nencmin + if (any(system%plpl_encounter%index1(1:nencmin) == 0) .or. any(system%plpl_encounter%index2(1:nencmin) == 0)) then + lmask(:) = system%plpl_encounter%index1(1:nencmin) /= 0 .and. system%plpl_encounter%index2(1:nencmin) /= 0 + else + return + end if + nencmin = count(lmask(:)) + system%plpl_encounter%nenc = nencmin + if (nencmin > 0) then + system%plpl_encounter%index1(1:nencmin) = pack(system%plpl_encounter%index1(1:nenc_old), lmask(1:nenc_old)) + system%plpl_encounter%index2(1:nencmin) = pack(system%plpl_encounter%index2(1:nenc_old), lmask(1:nenc_old)) + system%plpl_encounter%id1(1:nencmin) = pack(system%plpl_encounter%id1(1:nenc_old), lmask(1:nenc_old)) + system%plpl_encounter%id2(1:nencmin) = pack(system%plpl_encounter%id2(1:nenc_old), lmask(1:nenc_old)) + system%plpl_encounter%lvdotr(1:nencmin) = pack(system%plpl_encounter%lvdotr(1:nenc_old), lmask(1:nenc_old)) + system%plpl_encounter%lclosest(1:nencmin) = pack(system%plpl_encounter%lclosest(1:nenc_old), lmask(1:nenc_old)) + system%plpl_encounter%status(1:nencmin) = pack(system%plpl_encounter%status(1:nenc_old), lmask(1:nenc_old)) + system%plpl_encounter%tcollision(1:nencmin) = pack(system%plpl_encounter%tcollision(1:nenc_old), lmask(1:nenc_old)) + system%plpl_encounter%level(1:nencmin) = pack(system%plpl_encounter%level(1:nenc_old), lmask(1:nenc_old)) + do i = 1, NDIM + system%plpl_encounter%r1(i, 1:nencmin) = pack(system%plpl_encounter%r1(i, 1:nenc_old), lmask(1:nenc_old)) + system%plpl_encounter%r2(i, 1:nencmin) = pack(system%plpl_encounter%r2(i, 1:nenc_old), lmask(1:nenc_old)) + system%plpl_encounter%v1(i, 1:nencmin) = pack(system%plpl_encounter%v1(i, 1:nenc_old), lmask(1:nenc_old)) + system%plpl_encounter%v2(i, 1:nencmin) = pack(system%plpl_encounter%v2(i, 1:nenc_old), lmask(1:nenc_old)) + end do + end if + end if + end associate + + return + end subroutine swiftest_util_rearray_pl + + + module subroutine swiftest_util_rescale_system(self, param, mscale, dscale, tscale) + !! author: David A. Minton + !! + !! Rescales an nbody system to a new set of units. Inputs are the multipliers on the mass (mscale), distance (dscale), and time units (tscale). + !! Rescales all united quantities in the system, as well as the mass conversion factors, gravitational constant, and Einstein's constant in the parameter object. + implicit none + class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nbody system object + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters. Returns with new values of the scale vactors and GU + real(DP), intent(in) :: mscale, dscale, tscale !! Scale factors for mass, distance, and time units, respectively. + ! Internals + real(DP) :: vscale + + param%MU2KG = param%MU2KG * mscale + param%DU2M = param%DU2M * dscale + param%TU2S = param%TU2S * tscale + + ! Calculate the G for the system units + param%GU = GC / (param%DU2M**3 / (param%MU2KG * param%TU2S**2)) + + if (param%lgr) then + ! Calculate the inverse speed of light in the system units + param%inv_c2 = einsteinC * param%TU2S / param%DU2M + param%inv_c2 = (param%inv_c2)**(-2) + end if + + vscale = dscale / tscale + + associate(cb => self%cb, pl => self%pl, npl => self%pl%nbody, tp => self%tp, ntp => self%tp%nbody) + + cb%mass = cb%mass / mscale + cb%Gmass = param%GU * cb%mass + cb%radius = cb%radius / dscale + cb%rb(:) = cb%rb(:) / dscale + cb%vb(:) = cb%vb(:) / vscale + cb%rot(:) = cb%rot(:) * tscale + pl%mass(1:npl) = pl%mass(1:npl) / mscale + pl%Gmass(1:npl) = param%GU * pl%mass(1:npl) + pl%radius(1:npl) = pl%radius(1:npl) / dscale + pl%rh(:,1:npl) = pl%rh(:,1:npl) / dscale + pl%vh(:,1:npl) = pl%vh(:,1:npl) / vscale + pl%rb(:,1:npl) = pl%rb(:,1:npl) / dscale + pl%vb(:,1:npl) = pl%vb(:,1:npl) / vscale + pl%rot(:,1:npl) = pl%rot(:,1:npl) * tscale + + end associate + + + return + end subroutine swiftest_util_rescale_system + + + module subroutine swiftest_util_resize_arr_char_string(arr, nnew) + !! author: David A. Minton + !! + !! Resizes an array component of type character string. nnew = 0 will deallocate. + implicit none + ! Arguments + character(len=STRMAX), dimension(:), allocatable, intent(inout) :: arr !! Array to resize + integer(I4B), intent(in) :: nnew !! New size + ! Internals + character(len=STRMAX), dimension(:), allocatable :: tmp !! Temporary storage array in case the input array is already allocated + integer(I4B) :: nold !! Old size + + if (nnew < 0) return + + if (nnew == 0) then + if (allocated(arr)) deallocate(arr) + return + end if + + if (allocated(arr)) then + nold = size(arr) + else + nold = 0 + end if + + if (nnew == nold) return + + allocate(tmp(nnew)) + if (nold > 0) then + if (nnew > nold) then + tmp(1:nold) = arr(1:nold) + tmp(nold+1:nnew) = "" + else + tmp(1:nnew) = arr(1:nnew) + end if + else + tmp(1:nnew) = "" + end if + call move_alloc(tmp, arr) + + return + end subroutine swiftest_util_resize_arr_char_string + + + module subroutine swiftest_util_resize_arr_DP(arr, nnew) + !! author: David A. Minton + !! + !! Resizes an array component of double precision type. Passing nnew = 0 will deallocate. + implicit none + ! Arguments + real(DP), dimension(:), allocatable, intent(inout) :: arr !! Array to resize + integer(I4B), intent(in) :: nnew !! New size + ! Internals + real(DP), dimension(:), allocatable :: tmp !! Temporary storage array in case the input array is already allocated + integer(I4B) :: nold !! Old size + real(DP), parameter :: init_val = 0.0_DP + + if (nnew < 0) return + + if (nnew == 0) then + if (allocated(arr)) deallocate(arr) + return + end if + + if (allocated(arr)) then + nold = size(arr) + else + nold = 0 + end if + + if (nnew == nold) return + + allocate(tmp(nnew)) + if (nold > 0) then + if (nnew > nold) then + tmp(1:nold) = arr(1:nold) + tmp(nold+1:nnew) = init_val + else + tmp(1:nnew) = arr(1:nnew) + end if + else + tmp(1:nnew) = init_val + end if + call move_alloc(tmp, arr) + + return + end subroutine swiftest_util_resize_arr_DP + + + module subroutine swiftest_util_resize_arr_DPvec(arr, nnew) + !! author: David A. Minton + !! + !! Resizes an array component of double precision vectors of size (NDIM, n). Passing nnew = 0 will deallocate. + implicit none + ! Arguments + real(DP), dimension(:,:), allocatable, intent(inout) :: arr !! Array to resize + integer(I4B), intent(in) :: nnew !! New size + ! Internals + real(DP), dimension(:,:), allocatable :: tmp !! Temporary storage array in case the input array is already allocated + integer(I4B) :: nold !! Old size + real(DP), dimension(NDIM), parameter :: init_val = 0.0_DP + integer(I4B) :: i + + if (nnew < 0) return + + if (nnew == 0) then + if (allocated(arr)) deallocate(arr) + return + end if + + if (allocated(arr)) then + nold = size(arr, dim=2) + else + nold = 0 + end if + + if (nnew == nold) return + + allocate(tmp(NDIM, nnew)) + if (nold > 0) then + if (nnew > nold) then + tmp(:,1:nold) = arr(:,1:nold) + do i = nold+1, nnew + tmp(:,i) = init_val(:) + end do + else + tmp(:,1:nnew) = arr(:,1:nnew) + end if + else + do i = 1, nnew + tmp(:, i) = init_val(:) + end do + end if + call move_alloc(tmp, arr) + + return + + return + end subroutine swiftest_util_resize_arr_DPvec + + + module subroutine swiftest_util_resize_arr_I4B(arr, nnew) + !! author: David A. Minton + !! + !! Resizes an array component of integer type. Passing nnew = 0 will deallocate. + implicit none + ! Arguments + integer(I4B), dimension(:), allocatable, intent(inout) :: arr !! Array to resize + integer(I4B), intent(in) :: nnew !! New size + ! Internals + integer(I4B), dimension(:), allocatable :: tmp !! Temporary storage array in case the input array is already allocated + integer(I4B) :: nold !! Old size + integer(I4B), parameter :: init_val = -1 + + if (nnew < 0) return + + if (nnew == 0) then + if (allocated(arr)) deallocate(arr) + return + end if + + if (allocated(arr)) then + nold = size(arr) + else + nold = 0 + end if + + if (nnew == nold) return + + allocate(tmp(nnew)) + if (nold > 0) then + if (nnew > nold) then + tmp(1:nold) = arr(1:nold) + tmp(nold+1:nnew) = init_val + else + tmp(1:nnew) = arr(1:nnew) + end if + else + tmp(1:nnew) = init_val + end if + call move_alloc(tmp, arr) + + return + end subroutine swiftest_util_resize_arr_I4B + + + module subroutine swiftest_util_resize_arr_info(arr, nnew) + !! author: David A. Minton + !! + !! Resizes an array component of type character string. Array will only be resized if has previously been allocated. Passing nnew = 0 will deallocate. + implicit none + ! Arguments + type(swiftest_particle_info), dimension(:), allocatable, intent(inout) :: arr !! Array to resize + integer(I4B), intent(in) :: nnew !! New size + ! Internals + type(swiftest_particle_info), dimension(:), allocatable :: tmp !! Temporary storage array in case the input array is already allocated + integer(I4B) :: nold !! Old size + + if (nnew < 0) return + + if (nnew == 0) then + if (allocated(arr)) deallocate(arr) + return + end if + + if (allocated(arr)) then + nold = size(arr) + else + nold = 0 + end if + + if (nnew == nold) return + + allocate(tmp(nnew)) + if (nnew > nold) then + call util_copy_particle_info_arr(arr(1:nold), tmp(1:nold)) + else + call util_copy_particle_info_arr(arr(1:nnew), tmp(1:nnew)) + end if + + call move_alloc(tmp, arr) + + return + end subroutine swiftest_util_resize_arr_info + + + module subroutine swiftest_util_resize_arr_logical(arr, nnew) + !! author: David A. Minton + !! + !! Resizes an array component of logical type. Passing nnew = 0 will deallocate. + implicit none + ! Arguments + logical, dimension(:), allocatable, intent(inout) :: arr !! Array to resize + integer(I4B), intent(in) :: nnew !! New size + ! Internals + logical, dimension(:), allocatable :: tmp !! Temporary storage array in case the input array is already allocated + integer(I4B) :: nold !! Old size + logical, parameter :: init_val = .false. + + if (nnew < 0) return + + if (nnew == 0) then + if (allocated(arr)) deallocate(arr) + return + end if + + if (allocated(arr)) then + nold = size(arr) + else + nold = 0 + end if + + if (nnew == nold) return + + allocate(tmp(nnew)) + if (nold > 0) then + if (nnew > nold) then + tmp(1:nold) = arr(1:nold) + tmp(nold+1:nnew) = init_val + else + tmp(1:nnew) = arr(1:nnew) + end if + else + tmp(1:nnew) = init_val + end if + call move_alloc(tmp, arr) + + return + end subroutine swiftest_util_resize_arr_logical + + + module subroutine swiftest_util_resize_body(self, nnew) + !! author: David A. Minton + !! + !! Checks the current size of a Swiftest body against the requested size and resizes it if it is too small. + implicit none + ! Arguments + class(swiftest_body), intent(inout) :: self !! Swiftest body object + integer(I4B), intent(in) :: nnew !! New size neded + + call util_resize(self%info, nnew) + call util_resize(self%id, nnew) + call util_resize(self%status, nnew) + call util_resize(self%lcollision, nnew) + call util_resize(self%lencounter, nnew) + call util_resize(self%ldiscard, nnew) + call util_resize(self%lmask, nnew) + call util_resize(self%mu, nnew) + call util_resize(self%rh, nnew) + call util_resize(self%vh, nnew) + call util_resize(self%rb, nnew) + call util_resize(self%vb, nnew) + call util_resize(self%ah, nnew) + call util_resize(self%aobl, nnew) + call util_resize(self%atide, nnew) + call util_resize(self%agr, nnew) + call util_resize(self%ir3h, nnew) + call util_resize(self%a, nnew) + call util_resize(self%e, nnew) + call util_resize(self%inc, nnew) + call util_resize(self%capom, nnew) + call util_resize(self%omega, nnew) + call util_resize(self%capm, nnew) + self%nbody = count(self%status(1:nnew) /= INACTIVE) + + return + end subroutine swiftest_util_resize_body + + + module subroutine swiftest_util_resize_pl(self, nnew) + !! author: David A. Minton + !! + !! Checks the current size of a Swiftest massive body against the requested size and resizes it if it is too small. + implicit none + ! Arguments + class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object + integer(I4B), intent(in) :: nnew !! New size neded + + call util_resize_body(self, nnew) + + call util_resize(self%mass, nnew) + call util_resize(self%Gmass, nnew) + call util_resize(self%rhill, nnew) + call util_resize(self%renc, nnew) + call util_resize(self%radius, nnew) + call util_resize(self%rbeg, nnew) + call util_resize(self%rend, nnew) + call util_resize(self%vbeg, nnew) + call util_resize(self%density, nnew) + call util_resize(self%Ip, nnew) + call util_resize(self%rot, nnew) + call util_resize(self%k2, nnew) + call util_resize(self%Q, nnew) + call util_resize(self%tlag, nnew) + call util_resize(self%kin, nnew) + call util_resize(self%lmtiny, nnew) + call util_resize(self%nplenc, nnew) + call util_resize(self%ntpenc, nnew) + + + + if (allocated(self%k_plpl)) deallocate(self%k_plpl) + + return + end subroutine swiftest_util_resize_pl + + + module subroutine swiftest_util_resize_tp(self, nnew) + !! author: David A. Minton + !! + !! Checks the current size of a Swiftest test particle against the requested size and resizes it if it is too small. + implicit none + ! Arguments + class(swiftest_tp), intent(inout) :: self !! Swiftest test particle object + integer(I4B), intent(in) :: nnew !! New size neded + + call util_resize_body(self, nnew) + + call util_resize(self%nplenc, nnew) + call util_resize(self%isperi, nnew) + call util_resize(self%peri, nnew) + call util_resize(self%atp, nnew) + + return + end subroutine swiftest_util_resize_tp + + + module subroutine swiftest_util_set_beg_end_pl(self, rbeg, rend, vbeg) + !! author: David A. Minton + !! + !! Sets one or more of the values of rbeg, rend, and vbeg + implicit none + ! Arguments + class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object + real(DP), dimension(:,:), intent(in), optional :: rbeg, rend, vbeg + + if (present(rbeg)) then + if (allocated(self%rbeg)) deallocate(self%rbeg) + allocate(self%rbeg, source=rbeg) + end if + if (present(rend)) then + if (allocated(self%rend)) deallocate(self%rend) + allocate(self%rend, source=rend) + end if + if (present(vbeg)) then + if (allocated(self%vbeg)) deallocate(self%vbeg) + allocate(self%vbeg, source=vbeg) + end if + + return + end subroutine swiftest_util_set_beg_end_pl + + + module subroutine swiftest_util_set_ir3h(self) + !! author: David A. Minton + !! + !! Sets the inverse heliocentric radius term (1/rh**3) for all bodies in a structure + implicit none + ! Arguments + class(swiftest_body), intent(inout) :: self !! Swiftest generic body object + ! Internals + integer(I4B) :: i + real(DP) :: r2, irh + + if (self%nbody > 0) then + + do i = 1, self%nbody + r2 = dot_product(self%rh(:, i), self%rh(:, i)) + irh = 1.0_DP / sqrt(r2) + self%ir3h(i) = irh / r2 + end do + end if + + return + end subroutine swiftest_util_set_ir3h + + + module subroutine swiftest_util_set_msys(self) + !! author: David A. Minton + !! + !! Sets the value of msys and the vector mass quantities based on the total mass of the system + implicit none + ! Arguments + class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nobdy system object + + self%Gmtot = self%cb%Gmass + sum(self%pl%Gmass(1:self%pl%nbody), self%pl%status(1:self%pl%nbody) /= INACTIVE) + + return + end subroutine swiftest_util_set_msys + + + module subroutine swiftest_util_set_mu_pl(self, cb) + !! author: David A. Minton + !! + !! Computes G * (M + m) for each massive body + implicit none + ! Arguments + class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object + class(swiftest_cb), intent(inout) :: cb !! Swiftest central body object + + if (self%nbody > 0) self%mu(1:self%nbody) = cb%Gmass + self%Gmass(1:self%nbody) + + return + end subroutine swiftest_util_set_mu_pl + + + module subroutine swiftest_util_set_mu_tp(self, cb) + !! author: David A. Minton + !! + !! Converts certain scalar values to arrays so that they can be used in elemental functions + implicit none + ! Arguments + class(swiftest_tp), intent(inout) :: self !! Swiftest test particle object + class(swiftest_cb), intent(inout) :: cb !! Swiftest central body object + + if (self%nbody == 0) return + self%mu(1:self%nbody) = cb%Gmass + + return + end subroutine swiftest_util_set_mu_tp + + + module subroutine swiftest_util_set_particle_info(self, name, particle_type, status, origin_type, origin_time, collision_id, origin_rh,& + origin_vh, discard_time, discard_rh, discard_vh, discard_body_id) + !! author: David A. Minton + !! + !! Sets one or more values of the particle information metadata object + implicit none + ! Arguments + class(swiftest_particle_info), intent(inout) :: self + character(len=*), intent(in), optional :: name !! Non-unique name + character(len=*), intent(in), optional :: particle_type !! String containing a description of the particle type (e.g. Central Body, Massive Body, Test Particle) + character(len=*), intent(in), optional :: status !! Particle status description: ACTIVE, MERGED, FRAGMENTED, etc. + character(len=*), intent(in), optional :: origin_type !! String containing a description of the origin of the particle (e.g. Initial Conditions, Supercatastrophic, Disruption, etc.) + real(DP), intent(in), optional :: origin_time !! The time of the particle's formation + integer(I4B), intent(in), optional :: collision_id !! The ID fo the collision that formed the particle + real(DP), dimension(:), intent(in), optional :: origin_rh !! The heliocentric distance vector at the time of the particle's formation + real(DP), dimension(:), intent(in), optional :: origin_vh !! The heliocentric velocity vector at the time of the particle's formation + real(DP), intent(in), optional :: discard_time !! The time of the particle's discard + real(DP), dimension(:), intent(in), optional :: discard_rh !! The heliocentric distance vector at the time of the particle's discard + real(DP), dimension(:), intent(in), optional :: discard_vh !! The heliocentric velocity vector at the time of the particle's discard + integer(I4B), intent(in), optional :: discard_body_id !! The id of the other body involved in the discard (0 if no other body involved) + ! Internals + character(len=NAMELEN) :: lenstr + character(len=:), allocatable :: fmtlabel + + write(lenstr, *) NAMELEN + fmtlabel = "(A" // trim(adjustl(lenstr)) // ")" + + if (present(name)) then + write(self%name, fmtlabel) trim(adjustl(name)) + end if + if (present(particle_type)) then + write(self%particle_type, fmtlabel) trim(adjustl(particle_type)) + end if + if (present(status)) then + write(self%status, fmtlabel) trim(adjustl(status)) + end if + if (present(origin_type)) then + write(self%origin_type, fmtlabel) trim(adjustl(origin_type)) + end if + if (present(origin_time)) then + self%origin_time = origin_time + end if + if (present(collision_id)) then + self%collision_id = collision_id + end if + if (present(origin_rh)) then + self%origin_rh(:) = origin_rh(:) + end if + if (present(origin_vh)) then + self%origin_vh(:) = origin_vh(:) + end if + if (present(discard_time)) then + self%discard_time = discard_time + end if + if (present(discard_rh)) then + self%discard_rh(:) = discard_rh(:) + end if + if (present(discard_vh)) then + self%discard_vh(:) = discard_vh(:) + end if + if (present(discard_body_id)) then + self%discard_body_id = discard_body_id + end if + + return + end subroutine swiftest_util_set_particle_info + + + module subroutine swiftest_util_set_renc_I4B(self, scale) + !! author: David A. Minton + !! + !! Sets the critical radius for encounter given an input scale factor + !! + implicit none + ! Arguments + class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object + integer(I4B), intent(in) :: scale !! Input scale factor (multiplier of Hill's sphere size) + + associate(pl => self, npl => self%nbody) + pl%renc(1:npl) = pl%rhill(1:npl) * scale + end associate + + return + end subroutine swiftest_util_set_renc_I4B + + + module subroutine swiftest_util_set_renc_DP(self, scale) + !! author: David A. Minton + !! + !! Sets the critical radius for encounter given an input scale factor + !! + implicit none + ! Arguments + class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object + real(DP), intent(in) :: scale !! Input scale factor (multiplier of Hill's sphere size) + + associate(pl => self, npl => self%nbody) + pl%renc(1:npl) = pl%rhill(1:npl) * scale + end associate + + return + end subroutine swiftest_util_set_renc_DP + + + module subroutine swiftest_util_set_rhill(self,cb) + !! author: David A. Minton + !! + !! Sets the value of the Hill's radius + implicit none + ! Arguments + class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object + class(swiftest_cb), intent(inout) :: cb !! Swiftest central body object + + if (self%nbody == 0) return + + call self%xv2el(cb) + self%rhill(1:self%nbody) = self%a(1:self%nbody) * (self%Gmass(1:self%nbody) / cb%Gmass / 3)**THIRD + + return + end subroutine swiftest_util_set_rhill + + + module subroutine swiftest_util_set_rhill_approximate(self,cb) + !! author: David A. Minton + !! + !! Sets the approximate value of the Hill's radius using the heliocentric radius instead of computing the semimajor axis + implicit none + ! Arguments + class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object + class(swiftest_cb), intent(inout) :: cb !! Swiftest central body object + ! Internals + real(DP), dimension(:), allocatable :: rh + + if (self%nbody == 0) return + + rh(1:self%nbody) = .mag. self%rh(:,1:self%nbody) + self%rhill(1:self%nbody) = rh(1:self%nbody) * (self%Gmass(1:self%nbody) / cb%Gmass / 3)**THIRD + + return + end subroutine swiftest_util_set_rhill_approximate + + + module subroutine swiftest_util_snapshot_system(self, param, system, t, arg) + !! author: David A. Minton + !! + !! Takes a snapshot of the system for later file storage + implicit none + ! Arguments + class(swiftest_storage(*)), intent(inout) :: self !! Swiftest storage object + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object to store + real(DP), intent(in), optional :: t !! Time of snapshot if different from system time + character(*), intent(in), optional :: arg !! Optional argument (needed for extended storage type used in collision snapshots) + + self%iframe = self%iframe + 1 + self%nt = self%iframe + self%frame(self%iframe) = system ! Store a snapshot of the system for posterity + self%nid = self%nid + 1 ! Central body + if (allocated(system%pl)) self%nid = self%nid + system%pl%nbody + if (allocated(system%tp)) self%nid = self%nid + system%tp%nbody + + return + end subroutine swiftest_util_snapshot_system + + + module function swiftest_util_solve_linear_system_d(A,b,n,lerr) result(x) + !! Author: David A. Minton + !! + !! Solves the linear equation of the form A*x = b for x. + !! A is an (n,n) arrays + !! x and b are (n) arrays + !! Uses Gaussian elimination, so will have issues if system is ill-conditioned. + !! Uses quad precision intermidiate values, so works best on small arrays. + use, intrinsic :: ieee_exceptions + implicit none + ! Arguments + integer(I4B), intent(in) :: n + real(DP), dimension(:,:), intent(in) :: A + real(DP), dimension(:), intent(in) :: b + logical, intent(out) :: lerr + ! Result + real(DP), dimension(n) :: x + ! Internals + real(QP), dimension(:), allocatable :: qx + type(ieee_status_type) :: original_fpe_status + logical, dimension(:), allocatable :: fpe_flag + + call ieee_get_status(original_fpe_status) ! Save the original floating point exception status + call ieee_set_flag(ieee_all, .false.) ! Set all flags to quiet + allocate(fpe_flag(size(ieee_usual))) + + qx = solve_wbs(ge_wpp(real(A, kind=QP), real(b, kind=QP))) + + call ieee_get_flag(ieee_usual, fpe_flag) + lerr = any(fpe_flag) + if (lerr .or. (any(abs(qx) > huge(x))) .or. (any(abs(qx) < tiny(x)))) then + x = 0.0_DP + else + x = real(qx, kind=DP) + end if + call ieee_set_status(original_fpe_status) + + return + end function util_solve_linear_system_d + + + module function swiftest_util_solve_linear_system_q(A,b,n,lerr) result(x) + !! Author: David A. Minton + !! + !! Solves the linear equation of the form A*x = b for x. + !! A is an (n,n) arrays + !! x and b are (n) arrays + !! Uses Gaussian elimination, so will have issues if system is ill-conditioned. + !! Uses quad precision intermidiate values, so works best on small arrays. + use, intrinsic :: ieee_exceptions + implicit none + ! Arguments + integer(I4B), intent(in) :: n + real(QP), dimension(:,:), intent(in) :: A + real(QP), dimension(:), intent(in) :: b + logical, intent(out) :: lerr + ! Result + real(QP), dimension(n) :: x + ! Internals + type(ieee_status_type) :: original_fpe_status + logical, dimension(:), allocatable :: fpe_flag + + call ieee_get_status(original_fpe_status) ! Save the original floating point exception status + call ieee_set_flag(ieee_all, .false.) ! Set all flags to quiet + allocate(fpe_flag(size(ieee_usual))) + + x = solve_wbs(ge_wpp(A, b)) + + call ieee_get_flag(ieee_usual, fpe_flag) + lerr = any(fpe_flag) + if (lerr) x = 0.0_DP + call ieee_set_status(original_fpe_status) + + return + end function util_solve_linear_system_q + + function solve_wbs(u) result(x) ! solve with backward substitution + !! Based on code available on Rosetta Code: https://rosettacode.org/wiki/Gaussian_elimination#Fortran + use, intrinsic :: ieee_exceptions + use swiftest + implicit none + ! Arguments + real(QP), intent(in), dimension(:,:), allocatable :: u + ! Result + real(QP), dimension(:), allocatable :: x + ! Internals + integer(I4B) :: i,n + + n = size(u, 1) + if (allocated(x)) deallocate(x) + if (.not.allocated(x)) allocate(x(n)) + if (any(abs(u) < tiny(1._DP)) .or. any(abs(u) > huge(1._DP))) then + x(:) = 0._DP + return + end if + call ieee_set_halting_mode(ieee_divide_by_zero, .false.) + do i = n, 1, -1 + x(i) = (u(i, n + 1) - sum(u(i, i + 1:n) * x(i + 1:n))) / u(i, i) + end do + return + end function solve_wbs + + + function ge_wpp(A, b) result(u) ! gaussian eliminate with partial pivoting + !! Solve Ax=b using Gaussian elimination then backwards substitution. + !! A being an n by n matrix. + !! x and b are n by 1 vectors. + !! Based on code available on Rosetta Code: https://rosettacode.org/wiki/Gaussian_elimination#Fortran + use, intrinsic :: ieee_exceptions + use swiftest + implicit none + ! Arguments + real(QP), dimension(:,:), intent(in) :: A + real(QP), dimension(:), intent(in) :: b + ! Result + real(QP), dimension(:,:), allocatable :: u + ! Internals + integer(I4B) :: i,j,n,p + real(QP) :: upi + + n = size(a, 1) + allocate(u(n, (n + 1))) + u = reshape([A, b], [n, n + 1]) + call ieee_set_halting_mode(ieee_divide_by_zero, .false.) + do j = 1, n + p = maxloc(abs(u(j:n, j)), 1) + j - 1 ! maxloc returns indices between (1, n - j + 1) + if (p /= j) u([p, j], j) = u([j, p], j) + u(j + 1:, j) = u(j + 1:, j) / u(j, j) + do i = j + 1, n + 1 + upi = u(p, i) + if (p /= j) u([p, j], i) = u([j, p], i) + u(j + 1:n, i) = u(j + 1:n, i) - upi * u(j + 1:n, j) + end do + end do + return + end function ge_wpp + + + module function swiftest_util_solve_rkf45(f, y0in, t1, dt0, tol) result(y1) + !! author: David A. Minton + !! + !! Implements the 4th order Runge-Kutta-Fehlberg ODE solver for initial value problems of the form f=dy/dt, y0 = y(t=0), solving for y1 = y(t=t1). Uses a 5th order adaptive step size control. + !! Uses a lambda function object as defined in the lambda_function module + implicit none + ! Arguments + class(lambda_obj), intent(inout) :: f !! lambda function object that has been initialized to be a function of derivatives. The object will return with components lastarg and lasteval set + real(DP), dimension(:), intent(in) :: y0in !! Initial value at t=0 + real(DP), intent(in) :: t1 !! Final time + real(DP), intent(in) :: dt0 !! Initial step size guess + real(DP), intent(in) :: tol !! Tolerance on solution + ! Result + real(DP), dimension(:), allocatable :: y1 !! Final result + ! Internals + integer(I4B), parameter :: MAXREDUX = 1000 !! Maximum number of times step size can be reduced + real(DP), parameter :: DTFAC = 0.95_DP !! Step size reduction safety factor (Value just under 1.0 to prevent adaptive step size control from discarding steps too aggressively) + integer(I4B), parameter :: RKS = 6 !! Number of RK stages + real(DP), dimension(RKS, RKS - 1), parameter :: rkf45_btab = reshape( & !! Butcher tableau for Runge-Kutta-Fehlberg method + (/ 1./4., 1./4., 0., 0., 0., 0.,& + 3./8., 3./32., 9./32., 0., 0., 0.,& + 12./13., 1932./2197., -7200./2197., 7296./2197., 0., 0.,& + 1., 439./216., -8., 3680./513., -845./4104., 0.,& + 1./2., -8./27., 2., -3544./2565., 1859./4104., -11./40./), shape(rkf45_btab)) + real(DP), dimension(RKS), parameter :: rkf4_coeff = (/ 25./216., 0., 1408./2565. , 2197./4104. , -1./5., 0. /) + real(DP), dimension(RKS), parameter :: rkf5_coeff = (/ 16./135., 0., 6656./12825., 28561./56430., -9./50., 2./55. /) + real(DP), dimension(:, :), allocatable :: k !! Runge-Kutta coefficient vector + real(DP), dimension(:), allocatable :: ynorm !! Normalized y value used for adaptive step size control + real(DP), dimension(:), allocatable :: y0 !! Value of y at the beginning of each substep + integer(I4B) :: Nvar !! Number of variables in problem + integer(I4B) :: rkn !! Runge-Kutta loop index + real(DP) :: t, x1, dt, trem !! Current time, step size and total time remaining + real(DP) :: s, yerr, yscale !! Step size reduction factor, error in dependent variable, and error scale factor + integer(I4B) :: i + + allocate(y0, source=y0in) + allocate(y1, mold=y0) + allocate(ynorm, mold=y0) + Nvar = size(y0) + allocate(k(Nvar, RKS)) + + dt = dt0 + + trem = t1 + t = 0._DP + do + yscale = norm2(y0(:)) + do i = 1, MAXREDUX + select type(f) + class is (lambda_obj_tvar) + do rkn = 1, RKS + y1(:) = y0(:) + matmul(k(:, 1:rkn - 1), rkf45_btab(2:rkn, rkn - 1)) + if (rkn == 1) then + x1 = t + else + x1 = t + rkf45_btab(1,rkn-1) + end if + k(:, rkn) = dt * f%evalt(y1(:), t) + end do + class is (lambda_obj) + do rkn = 1, RKS + y1(:) = y0(:) + matmul(k(:, 1:rkn - 1), rkf45_btab(2:rkn, rkn - 1)) + k(:, rkn) = dt * f%eval(y1(:)) + end do + end select + ! Now determine if the step size needs adjusting + ynorm(:) = matmul(k(:,:), (rkf5_coeff(:) - rkf4_coeff(:))) / yscale + yerr = norm2(ynorm(:)) + s = (tol / (2 * yerr))**(0.25_DP) + dt = min(s * DTFAC * dt, trem) ! Alter step size either up or down, but never bigger than the remaining time + if (s >= 1.0_DP) exit ! Good step! + if (i == MAXREDUX) then + write(*,*) "Something has gone wrong in util_solve_rkf45!! Step size reduction has gone too far this time!" + call util_exit(FAILURE) + end if + end do + + ! Compute new value then step ahead in time + y1(:) = y0(:) + matmul(k(:, :), rkf4_coeff(:)) + trem = trem - dt + t = t + dt + if (trem <= 0._DP) exit + y0(:) = y1(:) + end do + + return + end function util_solve_rkf45 + + + + module subroutine swiftest_util_sort_body(self, sortby, ascending) + !! author: David A. Minton + !! + !! Sort a Swiftest body structure in-place. + !! sortby is a string indicating which array component to sort. + implicit none + ! Arguments + class(swiftest_body), intent(inout) :: self !! Swiftest body object + character(*), intent(in) :: sortby !! Sorting attribute + logical, intent(in) :: ascending !! Logical flag indicating whether or not the sorting should be in ascending or descending order + ! Internals + integer(I4B), dimension(:), allocatable :: ind + integer(I4B) :: direction + + if (self%nbody == 0) return + + if (ascending) then + direction = 1 + else + direction = -1 + end if + + associate(body => self, n => self%nbody) + select case(sortby) + case("id") + call util_sort(direction * body%id(1:n), ind) + case("status") + call util_sort(direction * body%status(1:n), ind) + case("ir3h") + call util_sort(direction * body%ir3h(1:n), ind) + case("a") + call util_sort(direction * body%a(1:n), ind) + case("e") + call util_sort(direction * body%e(1:n), ind) + case("inc") + call util_sort(direction * body%inc(1:n), ind) + case("capom") + call util_sort(direction * body%capom(1:n), ind) + case("mu") + call util_sort(direction * body%mu(1:n), ind) + case("lfirst", "nbody", "ldiscard", "rh", "vh", "rb", "vb", "ah", "aobl", "atide", "agr") + write(*,*) 'Cannot sort by ' // trim(adjustl(sortby)) // '. Component not sortable!' + case default + write(*,*) 'Cannot sort by ' // trim(adjustl(sortby)) // '. Component not found!' + return + end select + + call body%rearrange(ind) + + end associate + + return + end subroutine swiftest_util_sort_body + + + pure module subroutine swiftest_util_sort_dp(arr) + !! author: David A. Minton + !! + !! Sort input DP precision array in place into ascending numerical order using quicksort. + !! + implicit none + ! Arguments + real(DP), dimension(:), intent(inout) :: arr + + call qsort_DP(arr) + + return + end subroutine swiftest_util_sort_dp + + + pure module subroutine swiftest_util_sort_index_dp(arr, ind) + !! author: David A. Minton + !! + !! Sort input DP precision array by index in ascending numerical order using quick sort. + !! This algorithm works well for partially sorted arrays (which is usually the case here). + !! If ind is supplied already allocated, we assume it is an existing index array (e.g. a previously + !! sorted array). If it is not allocated, this subroutine swiftest_allocates it. + !! + implicit none + ! Arguments + real(DP), dimension(:), intent(in) :: arr + integer(I4B), dimension(:), allocatable, intent(inout) :: ind + ! Internals + integer(I4B) :: n, i + real(DP), dimension(:), allocatable :: tmparr + + n = size(arr) + if (.not.allocated(ind)) then + allocate(ind(n)) + ind = [(i, i=1, n)] + end if + allocate(tmparr, mold=arr) + tmparr(:) = arr(ind(:)) + call qsort_DP(tmparr, ind) + + return + end subroutine swiftest_util_sort_index_dp + + + recursive pure subroutine swiftest_qsort_DP(arr, ind) + !! author: David A. Minton + !! + !! Sort input DP precision array by index in ascending numerical order using quicksort sort. + !! + implicit none + ! Arguments + real(DP), dimension(:), intent(inout) :: arr + integer(I4B),dimension(:),intent(out), optional :: ind + !! Internals + integer :: iq + + if (size(arr) > 1) then + if (present(ind)) then + call partition_DP(arr, iq, ind) + call qsort_DP(arr(:iq-1),ind(:iq-1)) + call qsort_DP(arr(iq:), ind(iq:)) + else + call partition_DP(arr, iq) + call qsort_DP(arr(:iq-1)) + call qsort_DP(arr(iq:)) + end if + end if + + return + end subroutine swiftest_qsort_DP + + + pure subroutine swiftest_partition_DP(arr, marker, ind) + !! author: David A. Minton + !! + !! Partition function for quicksort on DP type + !! + implicit none + ! Arguments + real(DP), intent(inout), dimension(:) :: arr + integer(I4B), intent(inout), dimension(:), optional :: ind + integer(I4B), intent(out) :: marker + ! Internals + integer(I4B) :: i, j, itmp, narr, ipiv + real(DP) :: temp + real(DP) :: x ! pivot point + + narr = size(arr) + + ! Get center as pivot, as this is likely partially sorted + ipiv = narr / 2 + x = arr(ipiv) + i = 0 + j = narr + 1 + + do + j = j - 1 + do + if (arr(j) <= x) exit + j = j - 1 + end do + i = i + 1 + do + if (arr(i) >= x) exit + i = i + 1 + end do + if (i < j) then + ! exchange A(i) and A(j) + temp = arr(i) + arr(i) = arr(j) + arr(j) = temp + if (present(ind)) then + itmp = ind(i) + ind(i) = ind(j) + ind(j) = itmp + end if + else if (i == j) then + marker = i + 1 + return + else + marker = i + return + endif + end do + + return + end subroutine swiftest_partition_DP + + + pure module subroutine swiftest_util_sort_i4b(arr) + !! author: David A. Minton + !! + !! Sort input integer array in place into ascending numerical order using quick sort. + !! This algorithm works well for partially sorted arrays (which is usually the case here) + !! + implicit none + ! Arguments + integer(I4B), dimension(:), intent(inout) :: arr + + call qsort_I4B(arr) + + return + end subroutine swiftest_util_sort_i4b + + + pure module subroutine swiftest_util_sort_index_I4B(arr, ind) + !! author: David A. Minton + !! + !! Sort input integer array by index in ascending numerical order using quicksort. + !! If ind is supplied already allocated, we assume it is an existing index array (e.g. a previously + !! sorted array). If it is not allocated, this subroutine swiftest_allocates it. + !! + implicit none + ! Arguments + integer(I4B), dimension(:), intent(in) :: arr + integer(I4B), dimension(:), allocatable, intent(inout) :: ind + ! Internals + integer(I4B) :: n, i + integer(I4B), dimension(:), allocatable :: tmparr + + n = size(arr) + if (.not.allocated(ind)) then + allocate(ind(n)) + ind = [(i, i=1, n)] + end if + allocate(tmparr, mold=arr) + tmparr(:) = arr(ind(:)) + call qsort_I4B(tmparr, ind) + + return + end subroutine swiftest_util_sort_index_I4B + + + pure module subroutine swiftest_util_sort_index_I4B_I8Bind(arr, ind) + !! author: David A. Minton + !! + !! Sort input integer array by index in ascending numerical order using quicksort. + !! If ind is supplied already allocated, we assume it is an existing index array (e.g. a previously + !! sorted array). If it is not allocated, this subroutine swiftest_allocates it. + !! + implicit none + ! Arguments + integer(I4B), dimension(:), intent(in) :: arr + integer(I8B), dimension(:), allocatable, intent(inout) :: ind + ! Internals + integer(I8B) :: n, i + integer(I4B), dimension(:), allocatable :: tmparr + + n = size(arr) + if (.not.allocated(ind)) then + allocate(ind(n)) + ind = [(i, i=1_I8B, n)] + end if + allocate(tmparr, mold=arr) + tmparr(:) = arr(ind(:)) + call qsort_I4B_I8Bind(tmparr, ind) + + return + end subroutine swiftest_util_sort_index_I4B_I8Bind + + + recursive pure subroutine swiftest_qsort_I4B(arr, ind) + !! author: David A. Minton + !! + !! Sort input I4B array by index in ascending numerical order using quicksort. + !! + implicit none + ! Arguments + integer(I4B), dimension(:), intent(inout) :: arr + integer(I4B), dimension(:), intent(out), optional :: ind + ! Internals + integer(I4B) :: iq + + if (size(arr) > 1) then + if (present(ind)) then + call partition_I4B(arr, iq, ind) + call qsort_I4B(arr(:iq-1),ind(:iq-1)) + call qsort_I4B(arr(iq:), ind(iq:)) + else + call partition_I4B(arr, iq) + call qsort_I4B(arr(:iq-1)) + call qsort_I4B(arr(iq:)) + end if + end if + + return + end subroutine swiftest_qsort_I4B + + recursive pure subroutine swiftest_qsort_I4B_I8Bind(arr, ind) + !! author: David A. Minton + !! + !! Sort input I4B array by index in ascending numerical order using quicksort. + !! + implicit none + ! Arguments + integer(I4B), dimension(:), intent(inout) :: arr + integer(I8B), dimension(:), intent(out), optional :: ind + ! Internals + integer(I8B) :: iq + + if (size(arr) > 1_I8B) then + if (present(ind)) then + call partition_I4B_I8Bind(arr, iq, ind) + call qsort_I4B_I8Bind(arr(:iq-1_I8B),ind(:iq-1_I8B)) + call qsort_I4B_I8Bind(arr(iq:), ind(iq:)) + else + call partition_I4B_I8Bind(arr, iq) + call qsort_I4B_I8Bind(arr(:iq-1_I8B)) + call qsort_I4B_I8Bind(arr(iq:)) + end if + end if + + return + end subroutine swiftest_qsort_I4B_I8Bind + + + recursive pure subroutine swiftest_qsort_I8B_I8Bind(arr, ind) + !! author: David A. Minton + !! + !! Sort input I8B array by index in ascending numerical order using quicksort. + !! + implicit none + ! Arguments + integer(I8B), dimension(:), intent(inout) :: arr + integer(I8B), dimension(:), intent(out), optional :: ind + ! Internals + integer(I8B) :: iq + + if (size(arr) > 1_I8B) then + if (present(ind)) then + call partition_I8B_I8Bind(arr, iq, ind) + call qsort_I8B_I8Bind(arr(:iq-1_I8B),ind(:iq-1_I8B)) + call qsort_I8B_I8Bind(arr(iq:), ind(iq:)) + else + call partition_I8B_I8Bind(arr, iq) + call qsort_I8B_I8Bind(arr(:iq-1_I8B)) + call qsort_I8B_I8Bind(arr(iq:)) + end if + end if + + return + end subroutine swiftest_qsort_I8B_I8Bind + + + pure subroutine swiftest_partition_I4B(arr, marker, ind) + !! author: David A. Minton + !! + !! Partition function for quicksort on I4B type + !! + implicit none + ! Arguments + integer(I4B), intent(inout), dimension(:) :: arr + integer(I4B), intent(inout), dimension(:), optional :: ind + integer(I4B), intent(out) :: marker + ! Internals + integer(I4B) :: i, j, itmp, narr, ipiv + integer(I4B) :: temp + integer(I4B) :: x ! pivot point + + narr = size(arr) + + ! Get center as pivot, as this is likely partially sorted + ipiv = narr / 2 + x = arr(ipiv) + i = 0 + j = narr + 1 + + do + j = j - 1 + do + if (arr(j) <= x) exit + j = j - 1 + end do + i = i + 1 + do + if (arr(i) >= x) exit + i = i + 1 + end do + if (i < j) then + ! exchange A(i) and A(j) + temp = arr(i) + arr(i) = arr(j) + arr(j) = temp + if (present(ind)) then + itmp = ind(i) + ind(i) = ind(j) + ind(j) = itmp + end if + else if (i == j) then + marker = i + 1 + return + else + marker = i + return + endif + end do + + return + end subroutine swiftest_partition_I4B + + pure subroutine swiftest_partition_I4B_I8Bind(arr, marker, ind) + !! author: David A. Minton + !! + !! Partition function for quicksort on I4B type + !! + implicit none + ! Arguments + integer(I4B), intent(inout), dimension(:) :: arr + integer(I8B), intent(inout), dimension(:), optional :: ind + integer(I8B), intent(out) :: marker + ! Internals + integer(I8B) :: i, j, itmp, narr, ipiv + integer(I4B) :: temp + integer(I8B) :: x ! pivot point + + narr = size(arr) + + ! Get center as pivot, as this is likely partially sorted + ipiv = narr / 2_I8B + x = arr(ipiv) + i = 0_I8B + j = narr + 1_I8B + + do + j = j - 1_I8B + do + if (arr(j) <= x) exit + j = j - 1_I8B + end do + i = i + 1_I8B + do + if (arr(i) >= x) exit + i = i + 1_I8B + end do + if (i < j) then + ! exchange A(i) and A(j) + temp = arr(i) + arr(i) = arr(j) + arr(j) = temp + if (present(ind)) then + itmp = ind(i) + ind(i) = ind(j) + ind(j) = itmp + end if + else if (i == j) then + marker = i + 1_I8B + return + else + marker = i + return + endif + end do + + return + end subroutine swiftest_partition_I4B_I8Bind + + pure subroutine swiftest_partition_I8B_I8Bind(arr, marker, ind) + !! author: David A. Minton + !! + !! Partition function for quicksort on I8B type with I8B index + !! + implicit none + ! Arguments + integer(I8B), intent(inout), dimension(:) :: arr + integer(I8B), intent(inout), dimension(:), optional :: ind + integer(I8B), intent(out) :: marker + ! Internals + integer(I8B) :: i, j, itmp, narr, ipiv + integer(I8B) :: temp + integer(I8B) :: x ! pivot point + + narr = size(arr) + + ! Get center as pivot, as this is likely partially sorted + ipiv = narr / 2_I8B + x = arr(ipiv) + i = 0_I8B + j = narr + 1_I8B + + do + j = j - 1_I8B + do + if (arr(j) <= x) exit + j = j - 1_I8B + end do + i = i + 1_I8B + do + if (arr(i) >= x) exit + i = i + 1_I8B + end do + if (i < j) then + ! exchange A(i) and A(j) + temp = arr(i) + arr(i) = arr(j) + arr(j) = temp + if (present(ind)) then + itmp = ind(i) + ind(i) = ind(j) + ind(j) = itmp + end if + else if (i == j) then + marker = i + 1_I8B + return + else + marker = i + return + endif + end do + + return + end subroutine swiftest_partition_I8B_I8Bind + + + pure module subroutine swiftest_util_sort_sp(arr) + !! author: David A. Minton + !! + !! Sort input DP precision array in place into ascending numerical order using quicksort. + !! + implicit none + ! Arguments + real(SP), dimension(:), intent(inout) :: arr + + call qsort_SP(arr) + + return + end subroutine swiftest_util_sort_sp + + + pure module subroutine swiftest_util_sort_index_sp(arr, ind) + !! author: David A. Minton + !! + !! Sort input DP precision array by index in ascending numerical order using quicksort. + !! If ind is supplied already allocated, we assume it is an existing index array (e.g. a previously + !! sorted array). If it is not allocated, this subroutine swiftest_allocates it. + !! + implicit none + ! Arguments + real(SP), dimension(:), intent(in) :: arr + integer(I4B), dimension(:), allocatable, intent(inout) :: ind + ! Internals + integer(I4B) :: n, i + real(SP), dimension(:), allocatable :: tmparr + + n = size(arr) + if (.not.allocated(ind)) then + allocate(ind(n)) + ind = [(i, i=1, n)] + end if + allocate(tmparr, mold=arr) + tmparr(:) = arr(ind(:)) + call qsort_SP(tmparr, ind) + + return + end subroutine swiftest_util_sort_index_sp + + + recursive pure subroutine swiftest_qsort_SP(arr, ind) + !! author: David A. Minton + !! + !! Sort input DP precision array by index in ascending numerical order using quicksort. + !! + implicit none + ! Arguments + real(SP), dimension(:), intent(inout) :: arr + integer(I4B),dimension(:),intent(out), optional :: ind + !! Internals + integer :: iq + + if (size(arr) > 1) then + if (present(ind)) then + call partition_SP(arr, iq, ind) + call qsort_SP(arr(:iq-1),ind(:iq-1)) + call qsort_SP(arr(iq:), ind(iq:)) + else + call partition_SP(arr, iq) + call qsort_SP(arr(:iq-1)) + call qsort_SP(arr(iq:)) + end if + end if + + return + end subroutine swiftest_qsort_SP + + + pure subroutine swiftest_partition_SP(arr, marker, ind) + !! author: David A. Minton + !! + !! Partition function for quicksort on SP type + !! + implicit none + ! Arguments + real(SP), intent(inout), dimension(:) :: arr + integer(I4B), intent(inout), dimension(:), optional :: ind + integer(I4B), intent(out) :: marker + ! Internals + integer(I4B) :: i, j, itmp, narr, ipiv + real(SP) :: temp + real(SP) :: x ! pivot point + + narr = size(arr) + + ! Get center as pivot, as this is likely partially sorted + ipiv = narr / 2 + x = arr(ipiv) + i = 0 + j = narr + 1 + + do + j = j - 1 + do + if (arr(j) <= x) exit + j = j - 1 + end do + i = i + 1 + do + if (arr(i) >= x) exit + i = i + 1 + end do + if (i < j) then + ! exchange A(i) and A(j) + temp = arr(i) + arr(i) = arr(j) + arr(j) = temp + if (present(ind)) then + itmp = ind(i) + ind(i) = ind(j) + ind(j) = itmp + end if + else if (i == j) then + marker = i + 1 + return + else + marker = i + return + endif + end do + + return + end subroutine swiftest_partition_SP + + + module subroutine swiftest_util_sort_pl(self, sortby, ascending) + !! author: David A. Minton + !! + !! Sort a Swiftest massive body object in-place. + !! sortby is a string indicating which array component to sort. + implicit none + ! Arguments + class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object + character(*), intent(in) :: sortby !! Sorting attribute + logical, intent(in) :: ascending !! Logical flag indicating whether or not the sorting should be in ascending or descending order + ! Internals + integer(I4B), dimension(:), allocatable :: ind + integer(I4B) :: direction + + if (self%nbody == 0) return + + if (ascending) then + direction = 1 + else + direction = -1 + end if + + associate(pl => self, npl => self%nbody) + select case(sortby) + case("Gmass","mass") + call util_sort(direction * pl%Gmass(1:npl), ind) + case("rhill") + call util_sort(direction * pl%rhill(1:npl), ind) + case("renc") + call util_sort(direction * pl%renc(1:npl), ind) + case("radius") + call util_sort(direction * pl%radius(1:npl), ind) + case("density") + call util_sort(direction * pl%density(1:npl), ind) + case("k2") + call util_sort(direction * pl%k2(1:npl), ind) + case("Q") + call util_sort(direction * pl%Q(1:npl), ind) + case("tlag") + call util_sort(direction * pl%tlag(1:npl), ind) + case("rbeg", "rend", "vbeg", "Ip", "rot", "k_plpl", "nplpl") + write(*,*) 'Cannot sort by ' // trim(adjustl(sortby)) // '. Component not sortable!' + case default ! Look for components in the parent class + call util_sort_body(pl, sortby, ascending) + return + end select + + call pl%rearrange(ind) + + end associate + + return + end subroutine swiftest_util_sort_pl + + + module subroutine swiftest_util_sort_tp(self, sortby, ascending) + !! author: David A. Minton + !! + !! Sort a Swiftest test particle object in-place. + !! sortby is a string indicating which array component to sort. + implicit none + ! Arguments + class(swiftest_tp), intent(inout) :: self !! Swiftest test particle object + character(*), intent(in) :: sortby !! Sorting attribute + logical, intent(in) :: ascending !! Logical flag indicating whether or not the sorting should be in ascending or descending order + ! Internals + integer(I4B), dimension(:), allocatable :: ind + integer(I4B) :: direction + + if (self%nbody == 0) return + + if (ascending) then + direction = 1 + else + direction = -1 + end if + + associate(tp => self, ntp => self%nbody) + select case(sortby) + case("peri") + call util_sort(direction * tp%peri(1:ntp), ind) + case("atp") + call util_sort(direction * tp%atp(1:ntp), ind) + case("isperi") + write(*,*) 'Cannot sort by ' // trim(adjustl(sortby)) // '. Component not sortable!' + case default ! Look for components in the parent class + call util_sort_body(tp, sortby, ascending) + return + end select + + call tp%rearrange(ind) + + end associate + + return + end subroutine swiftest_util_sort_tp + + + module subroutine swiftest_util_sort_rearrange_body(self, ind) + !! author: David A. Minton + !! + !! Rearrange Swiftest body structure in-place from an index list. + !! This is a helper utility used to make polymorphic sorting work on Swiftest structures. + implicit none + ! Arguments + class(swiftest_body), intent(inout) :: self !! Swiftest body object + integer(I4B), dimension(:), intent(in) :: ind !! Index array used to restructure the body (should contain all 1:n index values in the desired order) + + associate(n => self%nbody) + call util_sort_rearrange(self%id, ind, n) + call util_sort_rearrange(self%lmask, ind, n) + call util_sort_rearrange(self%info, ind, n) + call util_sort_rearrange(self%status, ind, n) + call util_sort_rearrange(self%ldiscard, ind, n) + call util_sort_rearrange(pl%lcollision, ind, n) + call util_sort_rearrange(pl%lencounter, ind, n) + call util_sort_rearrange(self%rh, ind, n) + call util_sort_rearrange(self%vh, ind, n) + call util_sort_rearrange(self%rb, ind, n) + call util_sort_rearrange(self%vb, ind, n) + call util_sort_rearrange(self%ah, ind, n) + call util_sort_rearrange(self%aobl, ind, n) + call util_sort_rearrange(self%agr, ind, n) + call util_sort_rearrange(self%atide, ind, n) + call util_sort_rearrange(self%ir3h, ind, n) + call util_sort_rearrange(self%isperi, ind, n) + call util_sort_rearrange(self%peri, ind, n) + call util_sort_rearrange(self%atp, ind, n) + call util_sort_rearrange(self%mu, ind, n) + call util_sort_rearrange(self%a, ind, n) + call util_sort_rearrange(self%e, ind, n) + call util_sort_rearrange(self%inc, ind, n) + call util_sort_rearrange(self%capom, ind, n) + call util_sort_rearrange(self%omega, ind, n) + call util_sort_rearrange(self%capm, ind, n) + end associate + + return + end subroutine swiftest_util_sort_rearrange_body + + + pure module subroutine swiftest_util_sort_rearrange_arr_char_string(arr, ind, n) + !! author: David A. Minton + !! + !! Rearrange a single array of character string in-place from an index list. + implicit none + ! Arguments + character(len=STRMAX), dimension(:), allocatable, intent(inout) :: arr !! Destination array + integer(I4B), dimension(:), intent(in) :: ind !! Index to rearrange against + integer(I4B), intent(in) :: n !! Number of elements in arr and ind to rearrange + ! Internals + character(len=STRMAX), dimension(:), allocatable :: tmp !! Temporary copy of arry used during rearrange operation + + if (.not. allocated(arr) .or. n <= 0) return + allocate(tmp, mold=arr) + tmp(1:n) = arr(ind) + call move_alloc(tmp, arr) + + return + end subroutine swiftest_util_sort_rearrange_arr_char_string + + + pure module subroutine swiftest_util_sort_rearrange_arr_DP(arr, ind, n) + !! author: David A. Minton + !! + !! Rearrange a single array of DP type in-place from an index list. + implicit none + ! Arguments + real(DP), dimension(:), allocatable, intent(inout) :: arr !! Destination array + integer(I4B), dimension(:), intent(in) :: ind !! Index to rearrange against + integer(I4B), intent(in) :: n !! Number of elements in arr and ind to rearrange + ! Internals + real(DP), dimension(:), allocatable :: tmp !! Temporary copy of array used during rearrange operation + + if (.not. allocated(arr) .or. n <= 0) return + allocate(tmp, mold=arr) + tmp(1:n) = arr(ind) + call move_alloc(tmp, arr) + + return + end subroutine swiftest_util_sort_rearrange_arr_DP + + + pure module subroutine swiftest_util_sort_rearrange_arr_DPvec(arr, ind, n) + !! author: David A. Minton + !! + !! Rearrange a single array of (NDIM,n) DP-type vectors in-place from an index list. + implicit none + ! Arguments + real(DP), dimension(:,:), allocatable, intent(inout) :: arr !! Destination array + integer(I4B), dimension(:), intent(in) :: ind !! Index to rearrange against + integer(I4B), intent(in) :: n !! Number of elements in arr and ind to rearrange + ! Internals + real(DP), dimension(:,:), allocatable :: tmp !! Temporary copy of array used during rearrange operation + + if (.not. allocated(arr) .or. n <= 0) return + allocate(tmp, mold=arr) + tmp(:,1:n) = arr(:, ind) + call move_alloc(tmp, arr) + + return + end subroutine swiftest_util_sort_rearrange_arr_DPvec + + + pure module subroutine swiftest_util_sort_rearrange_arr_I4B(arr, ind, n) + !! author: David A. Minton + !! + !! Rearrange a single array of integers in-place from an index list. + implicit none + ! Arguments + integer(I4B), dimension(:), allocatable, intent(inout) :: arr !! Destination array + integer(I4B), dimension(:), intent(in) :: ind !! Index to rearrange against + integer(I4B), intent(in) :: n !! Number of elements in arr and ind to rearrange + ! Internals + integer(I4B), dimension(:), allocatable :: tmp !! Temporary copy of array used during rearrange operation + + if (.not. allocated(arr) .or. n <= 0) return + allocate(tmp, mold=arr) + tmp(1:n) = arr(ind) + call move_alloc(tmp, arr) + + return + end subroutine swiftest_util_sort_rearrange_arr_I4B + + pure module subroutine swiftest_util_sort_rearrange_arr_I4B_I8Bind(arr, ind, n) + !! author: David A. Minton + !! + !! Rearrange a single array of integers in-place from an index list. + implicit none + ! Arguments + integer(I4B), dimension(:), allocatable, intent(inout) :: arr !! Destination array + integer(I8B), dimension(:), intent(in) :: ind !! Index to rearrange against + integer(I8B), intent(in) :: n !! Number of elements in arr and ind to rearrange + ! Internals + integer(I4B), dimension(:), allocatable :: tmp !! Temporary copy of array used during rearrange operation + + if (.not. allocated(arr) .or. n <= 0_I8B) return + allocate(tmp, mold=arr) + tmp(1:n) = arr(ind) + call move_alloc(tmp, arr) + + return + end subroutine swiftest_util_sort_rearrange_arr_I4B_I8Bind + + + pure module subroutine swiftest_util_sort_rearrange_arr_logical(arr, ind, n) + !! author: David A. Minton + !! + !! Rearrange a single array of logicals in-place from an index list. + implicit none + ! Arguments + logical, dimension(:), allocatable, intent(inout) :: arr !! Destination array + integer(I4B), dimension(:), intent(in) :: ind !! Index to rearrange against + integer(I4B), intent(in) :: n !! Number of elements in arr and ind to rearrange + ! Internals + logical, dimension(:), allocatable :: tmp !! Temporary copy of array used during rearrange operation + + if (.not. allocated(arr) .or. n <= 0) return + allocate(tmp, mold=arr) + tmp(1:n) = arr(ind) + call move_alloc(tmp, arr) + + return + end subroutine swiftest_util_sort_rearrange_arr_logical + + + pure module subroutine swiftest_util_sort_rearrange_arr_logical_I8Bind(arr, ind, n) + !! author: David A. Minton + !! + !! Rearrange a single array of logicals in-place from an index list. + implicit none + ! Arguments + logical, dimension(:), allocatable, intent(inout) :: arr !! Destination array + integer(I8B), dimension(:), intent(in) :: ind !! Index to rearrange against + integer(I8B), intent(in) :: n !! Number of elements in arr and ind to rearrange + ! Internals + logical, dimension(:), allocatable :: tmp !! Temporary copy of array used during rearrange operation + + if (.not. allocated(arr) .or. n <= 0) return + allocate(tmp, mold=arr) + tmp(1:n) = arr(ind) + call move_alloc(tmp, arr) + + return + end subroutine swiftest_util_sort_rearrange_arr_logical_I8Bind + + + module subroutine swiftest_util_sort_rearrange_arr_info(arr, ind, n) + !! author: David A. Minton + !! + !! Rearrange a single array of particle information type in-place from an index list. + implicit none + ! Arguments + type(swiftest_particle_info), dimension(:), allocatable, intent(inout) :: arr !! Destination array + integer(I4B), dimension(:), intent(in) :: ind !! Index to rearrange against + integer(I4B), intent(in) :: n !! Number of elements in arr and ind to rearrange + ! Internals + type(swiftest_particle_info), dimension(:), allocatable :: tmp !! Temporary copy of array used during rearrange operation + + if (.not. allocated(arr) .or. n <= 0) return + allocate(tmp, mold=arr) + + call util_copy_particle_info_arr(arr, tmp, ind) + call move_alloc(tmp, arr) + + return + end subroutine swiftest_util_sort_rearrange_arr_info + + + module subroutine swiftest_util_sort_rearrange_pl(self, ind) + !! author: David A. Minton + !! + !! Rearrange Swiftest massive body structure in-place from an index list. + !! This is a helper utility used to make polymorphic sorting work on Swiftest structures. + implicit none + class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object + integer(I4B), dimension(:), intent(in) :: ind !! Index array used to restructure the body (should contain all 1:n index values in the desired order) + + associate(pl => self, npl => self%nbody) + call util_sort_rearrange(pl%mass, ind, npl) + call util_sort_rearrange(pl%Gmass, ind, npl) + call util_sort_rearrange(pl%rhill, ind, npl) + call util_sort_rearrange(pl%renc, ind, npl) + call util_sort_rearrange(pl%radius, ind, npl) + call util_sort_rearrange(pl%density, ind, npl) + call util_sort_rearrange(pl%rbeg, ind, npl) + call util_sort_rearrange(pl%vbeg, ind, npl) + call util_sort_rearrange(pl%Ip, ind, npl) + call util_sort_rearrange(pl%rot, ind, npl) + call util_sort_rearrange(pl%k2, ind, npl) + call util_sort_rearrange(pl%Q, ind, npl) + call util_sort_rearrange(pl%tlag, ind, npl) + call util_sort_rearrange(pl%kin, ind, npl) + call util_sort_rearrange(pl%lmtiny, ind, npl) + call util_sort_rearrange(pl%nplenc, ind, npl) + call util_sort_rearrange(pl%ntpenc, ind, npl) + + if (allocated(pl%k_plpl)) deallocate(pl%k_plpl) + + call util_sort_rearrange_body(pl, ind) + end associate + + return + end subroutine swiftest_util_sort_rearrange_pl + + + module subroutine swiftest_util_sort_rearrange_tp(self, ind) + !! author: David A. Minton + !! + !! Rearrange Swiftest massive body structure in-place from an index list. + !! This is a helper utility used to make polymorphic sorting work on Swiftest structures. + implicit none + ! Arguments + class(swiftest_tp), intent(inout) :: self !! Swiftest test particle object + integer(I4B), dimension(:), intent(in) :: ind !! Index array used to restructure the body (should contain all 1:n index values in the desired order) + + associate(tp => self, ntp => self%nbody) + call util_sort_rearrange(tp%nplenc, ind, ntp) + + if (allocated(tp%k_pltp)) deallocate(tp%k_pltp) + + call util_sort_rearrange_body(tp, ind) + end associate + + return + end subroutine swiftest_util_sort_rearrange_tp + + + module subroutine swiftest_util_spill_arr_char_string(keeps, discards, lspill_list, ldestructive) + !! author: David A. Minton + !! + !! Performs a spill operation on a single array of type character strings + !! This is the inverse of a spill operation + implicit none + ! Arguments + character(len=STRMAX), dimension(:), allocatable, intent(inout) :: keeps !! Array of values to keep + character(len=STRMAX), dimension(:), allocatable, intent(inout) :: discards !! Array of discards + logical, dimension(:), intent(in) :: lspill_list !! Logical array of bodies to spill into the discards + logical, intent(in) :: ldestructive !! Logical flag indicating whether or not this operation should alter the keeps array or not + ! Internals + integer(I4B) :: nspill, nkeep, nlist + character(len=STRMAX), dimension(:), allocatable :: tmp !! Array of values to keep + + nkeep = count(.not.lspill_list(:)) + nspill = count(lspill_list(:)) + nlist = size(lspill_list(:)) + + if (.not.allocated(keeps) .or. nspill == 0) return + if (.not.allocated(discards)) then + allocate(discards(nspill)) + else if (size(discards) /= nspill) then + deallocate(discards) + allocate(discards(nspill)) + end if + + discards(:) = pack(keeps(1:nlist), lspill_list(1:nlist)) + if (ldestructive) then + if (nkeep > 0) then + allocate(tmp(nkeep)) + tmp(:) = pack(keeps(1:nlist), .not. lspill_list(1:nlist)) + call move_alloc(tmp, keeps) + else + deallocate(keeps) + end if + end if + + return + end subroutine swiftest_util_spill_arr_char_string + + + module subroutine swiftest_util_spill_arr_DP(keeps, discards, lspill_list, ldestructive) + !! author: David A. Minton + !! + !! Performs a spill operation on a single array of type DP + !! This is the inverse of a spill operation + implicit none + ! Arguments + real(DP), dimension(:), allocatable, intent(inout) :: keeps !! Array of values to keep + real(DP), dimension(:), allocatable, intent(inout) :: discards !! Array of discards + logical, dimension(:), intent(in) :: lspill_list !! Logical array of bodies to spill into the discardss + logical, intent(in) :: ldestructive !! Logical flag indicating whether or not this operation should alter the keeps array or not + ! Internals + integer(I4B) :: nspill, nkeep, nlist + real(DP), dimension(:), allocatable :: tmp !! Array of values to keep + + nkeep = count(.not.lspill_list(:)) + nspill = count(lspill_list(:)) + nlist = size(lspill_list(:)) + + if (.not.allocated(keeps) .or. nspill == 0) return + if (.not.allocated(discards)) then + allocate(discards(nspill)) + else if (size(discards) /= nspill) then + deallocate(discards) + allocate(discards(nspill)) + end if + + discards(:) = pack(keeps(1:nlist), lspill_list(1:nlist)) + if (ldestructive) then + if (nkeep > 0) then + allocate(tmp(nkeep)) + tmp(:) = pack(keeps(1:nlist), .not. lspill_list(1:nlist)) + call move_alloc(tmp, keeps) + else + deallocate(keeps) + end if + end if + + return + end subroutine swiftest_util_spill_arr_DP + + + module subroutine swiftest_util_spill_arr_DPvec(keeps, discards, lspill_list, ldestructive) + !! author: David A. Minton + !! + !! Performs a spill operation on a single array of DP vectors with shape (NDIM, n) + !! This is the inverse of a spill operation + implicit none + ! Arguments + real(DP), dimension(:,:), allocatable, intent(inout) :: keeps !! Array of values to keep + real(DP), dimension(:,:), allocatable, intent(inout) :: discards !! Array discards + logical, dimension(:), intent(in) :: lspill_list !! Logical array of bodies to spill into the discards + logical, intent(in) :: ldestructive !! Logical flag indicating whether or not this operation should alter the keeps array or not + ! Internals + integer(I4B) :: i, nspill, nkeep, nlist + real(DP), dimension(:,:), allocatable :: tmp !! Array of values to keep + + nkeep = count(.not.lspill_list(:)) + nspill = count(lspill_list(:)) + nlist = size(lspill_list(:)) + + if (.not.allocated(keeps) .or. nspill == 0) return + if (.not.allocated(discards)) then + allocate(discards(NDIM, nspill)) + else if (size(discards, dim=2) /= nspill) then + deallocate(discards) + allocate(discards(NDIM, nspill)) + end if + + do i = 1, NDIM + discards(i,:) = pack(keeps(i,1:nlist), lspill_list(1:nlist)) + end do + if (ldestructive) then + if (nkeep > 0) then + allocate(tmp(NDIM, nkeep)) + do i = 1, NDIM + tmp(i, :) = pack(keeps(i, 1:nlist), .not. lspill_list(1:nlist)) + end do + call move_alloc(tmp, keeps) + else + deallocate(keeps) + end if + end if + + return + end subroutine swiftest_util_spill_arr_DPvec + + + module subroutine swiftest_util_spill_arr_I4B(keeps, discards, lspill_list, ldestructive) + !! author: David A. Minton + !! + !! Performs a spill operation on a single array of type I4B + !! This is the inverse of a spill operation + implicit none + ! Arguments + integer(I4B), dimension(:), allocatable, intent(inout) :: keeps !! Array of values to keep + integer(I4B), dimension(:), allocatable, intent(inout) :: discards !! Array of discards + logical, dimension(:), intent(in) :: lspill_list !! Logical array of bodies to spill into the discards + logical, intent(in) :: ldestructive !! Logical flag indicating whether or not this operation should alter the keeps array or not + ! Internals + integer(I4B) :: nspill, nkeep, nlist + integer(I4B), dimension(:), allocatable :: tmp !! Array of values to keep + + nkeep = count(.not.lspill_list(:)) + nspill = count(lspill_list(:)) + nlist = size(lspill_list(:)) + + if (.not.allocated(keeps) .or. nspill == 0) return + if (.not.allocated(discards)) then + allocate(discards(nspill)) + else if (size(discards) /= nspill) then + deallocate(discards) + allocate(discards(nspill)) + end if + + discards(:) = pack(keeps(1:nlist), lspill_list(1:nlist)) + if (ldestructive) then + if (nkeep > 0) then + allocate(tmp(nkeep)) + tmp(:) = pack(keeps(1:nlist), .not. lspill_list(1:nlist)) + call move_alloc(tmp, keeps) + else + deallocate(keeps) + end if + end if + + return + end subroutine swiftest_util_spill_arr_I4B + + + module subroutine swiftest_util_spill_arr_I8B(keeps, discards, lspill_list, ldestructive) + !! author: David A. Minton + !! + !! Performs a spill operation on a single array of type I4B + !! This is the inverse of a spill operation + implicit none + ! Arguments + integer(I8B), dimension(:), allocatable, intent(inout) :: keeps !! Array of values to keep + integer(I8B), dimension(:), allocatable, intent(inout) :: discards !! Array of discards + logical, dimension(:), intent(in) :: lspill_list !! Logical array of bodies to spill into the discards + logical, intent(in) :: ldestructive !! Logical flag indicating whether or not this operation should alter the keeps array or not + ! Internals + integer(I4B) :: nspill, nkeep, nlist + integer(I8B), dimension(:), allocatable :: tmp !! Array of values to keep + + nkeep = count(.not.lspill_list(:)) + nspill = count(lspill_list(:)) + nlist = size(lspill_list(:)) + + if (.not.allocated(keeps) .or. nspill == 0) return + if (.not.allocated(discards)) then + allocate(discards(nspill)) + else if (size(discards) /= nspill) then + deallocate(discards) + allocate(discards(nspill)) + end if + + discards(:) = pack(keeps(1:nlist), lspill_list(1:nlist)) + if (ldestructive) then + if (nkeep > 0) then + allocate(tmp(nkeep)) + tmp(:) = pack(keeps(1:nlist), .not. lspill_list(1:nlist)) + call move_alloc(tmp, keeps) + else + deallocate(keeps) + end if + end if + + return + end subroutine swiftest_util_spill_arr_I8B + + + module subroutine swiftest_util_spill_arr_info(keeps, discards, lspill_list, ldestructive) + !! author: David A. Minton + !! + !! Performs a spill operation on a single array of particle origin information types + !! This is the inverse of a spill operation + implicit none + ! Arguments + type(swiftest_particle_info), dimension(:), allocatable, intent(inout) :: keeps !! Array of values to keep + type(swiftest_particle_info), dimension(:), allocatable, intent(inout) :: discards !! Array of discards + logical, dimension(:), intent(in) :: lspill_list !! Logical array of bodies to spill into the discardss + logical, intent(in) :: ldestructive !! Logical flag indicating whether or not this operation should alter the keeps array or not + ! Internals + integer(I4B) :: i, nspill, nkeep, nlist + integer(I4B), dimension(:), allocatable :: idx + type(swiftest_particle_info), dimension(:), allocatable :: tmp + + nkeep = count(.not.lspill_list(:)) + nspill = count(lspill_list(:)) + nlist = size(lspill_list(:)) + + if (.not.allocated(keeps) .or. nspill == 0) return + if (.not.allocated(discards)) then + allocate(discards(nspill)) + else if (size(discards) /= nspill) then + deallocate(discards) + allocate(discards(nspill)) + end if + + allocate(idx(nspill)) + idx(:) = pack([(i, i = 1, nlist)], lspill_list) + call util_copy_particle_info_arr(keeps, discards, idx) + if (ldestructive) then + if (nkeep > 0) then + deallocate(idx) + allocate(idx(nkeep)) + allocate(tmp(nkeep)) + idx(:) = pack([(i, i = 1, nlist)], .not. lspill_list) + call util_copy_particle_info_arr(keeps, tmp, idx) + call move_alloc(tmp, keeps) + else + deallocate(keeps) + end if + end if + + return + end subroutine swiftest_util_spill_arr_info + + + module subroutine swiftest_util_spill_arr_logical(keeps, discards, lspill_list, ldestructive) + !! author: David A. Minton + !! + !! Performs a spill operation on a single array of logicals + !! This is the inverse of a spill operation + implicit none + ! Arguments + logical, dimension(:), allocatable, intent(inout) :: keeps !! Array of values to keep + logical, dimension(:), allocatable, intent(inout) :: discards !! Array of discards + logical, dimension(:), intent(in) :: lspill_list !! Logical array of bodies to spill into the discards + logical, intent(in) :: ldestructive !! Logical flag indicating whether or not this operation should alter the keeps array or no + ! Internals + integer(I4B) :: nspill, nkeep, nlist + logical, dimension(:), allocatable :: tmp !! Array of values to keep + + nkeep = count(.not.lspill_list(:)) + nspill = count(lspill_list(:)) + nlist = size(lspill_list(:)) + + if (.not.allocated(keeps) .or. nspill == 0) return + if (.not.allocated(discards)) then + allocate(discards(nspill)) + else if (size(discards) /= nspill) then + deallocate(discards) + allocate(discards(nspill)) + end if + + discards(:) = pack(keeps(1:nlist), lspill_list(1:nlist)) + if (ldestructive) then + if (nkeep > 0) then + allocate(tmp(nkeep)) + tmp(:) = pack(keeps(1:nlist), .not. lspill_list(1:nlist)) + call move_alloc(tmp, keeps) + else + deallocate(keeps) + end if + end if + + return + end subroutine swiftest_util_spill_arr_logical + + + module subroutine swiftest_util_spill_body(self, discards, lspill_list, ldestructive) + !! author: David A. Minton + !! + !! Move spilled (discarded) Swiftest generic particle structure from active list to discard list + !! Adapted from David E. Kaufmann's Swifter routine whm_discard_spill.f90 + implicit none + ! Arguments + class(swiftest_body), intent(inout) :: self !! Swiftest generic body object + class(swiftest_body), intent(inout) :: discards !! Discarded object + logical, dimension(:), intent(in) :: lspill_list !! Logical array of bodies to spill into the discards + logical, intent(in) :: ldestructive !! Logical flag indicating whether or not this operation should alter body by removing the discard list + ! Internals + integer(I4B) :: nbody_old + + ! For each component, pack the discarded bodies into the discard object and do the inverse with the keeps + !> Spill all the common components + associate(keeps => self) + + call util_spill(keeps%id, discards%id, lspill_list, ldestructive) + call util_spill(keeps%info, discards%info, lspill_list, ldestructive) + call util_spill(keeps%lmask, discards%lmask, lspill_list, ldestructive) + call util_spill(keeps%status, discards%status, lspill_list, ldestructive) + call util_spill(keeps%ldiscard, discards%ldiscard, lspill_list, ldestructive) + call util_spill(keeps%lcollision, discards%lcollision, lspill_list, ldestructive) + call util_spill(keeps%lencounter, discards%lencounter, lspill_list, ldestructive) + call util_spill(keeps%mu, discards%mu, 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%rb, discards%rb, lspill_list, ldestructive) + call util_spill(keeps%vb, discards%vb, lspill_list, ldestructive) + call util_spill(keeps%ah, discards%ah, lspill_list, ldestructive) + call util_spill(keeps%aobl, discards%aobl, lspill_list, ldestructive) + call util_spill(keeps%agr, discards%agr, lspill_list, ldestructive) + call util_spill(keeps%atide, discards%atide, lspill_list, ldestructive) + call util_spill(keeps%ir3h, discards%ir3h, lspill_list, ldestructive) + call util_spill(keeps%isperi, discards%isperi, lspill_list, ldestructive) + call util_spill(keeps%peri, discards%peri, lspill_list, ldestructive) + call util_spill(keeps%atp, discards%atp, lspill_list, ldestructive) + call util_spill(keeps%a, discards%a, lspill_list, ldestructive) + call util_spill(keeps%e, discards%e, lspill_list, ldestructive) + call util_spill(keeps%inc, discards%inc, lspill_list, ldestructive) + call util_spill(keeps%capom, discards%capom, lspill_list, ldestructive) + call util_spill(keeps%omega, discards%omega, lspill_list, ldestructive) + call util_spill(keeps%capm, discards%capm, lspill_list, ldestructive) + + nbody_old = keeps%nbody + + ! This is the base class, so will be the last to be called in the cascade. + ! Therefore we need to set the nbody values for both the keeps and discareds + discards%nbody = count(lspill_list(1:nbody_old)) + if (ldestructive) keeps%nbody = nbody_old- discards%nbody + end associate + + return + end subroutine swiftest_util_spill_body + + + module subroutine swiftest_util_spill_pl(self, discards, lspill_list, ldestructive) + !! author: David A. Minton + !! + !! Move spilled (discarded) Swiftest massive body structure from active list to discard list + !! Adapted from David E. Kaufmann's Swifter routine whm_discard_spill.f90 + implicit none + ! Arguments + class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object + class(swiftest_body), intent(inout) :: discards !! Discarded object + logical, dimension(:), intent(in) :: lspill_list !! Logical array of bodies to spill into the discards + logical, intent(in) :: ldestructive !! Logical flag indicating whether or not this operation should alter body by removing the discard list + + associate(keeps => self) + select type (discards) ! The standard requires us to select the type of both arguments in order to access all the components + class is (swiftest_pl) + !> Spill components specific to the massive body class + call util_spill(keeps%mass, discards%mass, lspill_list, ldestructive) + call util_spill(keeps%Gmass, discards%Gmass, lspill_list, ldestructive) + call util_spill(keeps%rhill, discards%rhill, lspill_list, ldestructive) + call util_spill(keeps%renc, discards%renc, lspill_list, ldestructive) + call util_spill(keeps%radius, discards%radius, lspill_list, ldestructive) + call util_spill(keeps%density, discards%density, lspill_list, ldestructive) + call util_spill(keeps%rbeg, discards%rbeg, lspill_list, ldestructive) + call util_spill(keeps%rend, discards%rend, lspill_list, ldestructive) + call util_spill(keeps%vbeg, discards%vbeg, lspill_list, ldestructive) + call util_spill(keeps%Ip, discards%Ip, lspill_list, ldestructive) + call util_spill(keeps%rot, discards%rot, lspill_list, ldestructive) + call util_spill(keeps%k2, discards%k2, lspill_list, ldestructive) + call util_spill(keeps%Q, discards%Q, lspill_list, ldestructive) + call util_spill(keeps%tlag, discards%tlag, lspill_list, ldestructive) + call util_spill(keeps%kin, discards%kin, lspill_list, ldestructive) + call util_spill(keeps%lmtiny, discards%lmtiny, lspill_list, ldestructive) + call util_spill(keeps%nplenc, discards%nplenc, lspill_list, ldestructive) + call util_spill(keeps%ntpenc, discards%ntpenc, lspill_list, ldestructive) + + if (ldestructive .and. allocated(keeps%k_plpl)) deallocate(keeps%k_plpl) + + call util_spill_body(keeps, discards, lspill_list, ldestructive) + class default + write(*,*) 'Error! spill method called for incompatible return type on swiftest_pl' + end select + end associate + + return + end subroutine swiftest_util_spill_pl + + + module subroutine swiftest_util_spill_tp(self, discards, lspill_list, ldestructive) + !! author: David A. Minton + !! + !! Move spilled (discarded) Swiftest test particle structure from active list to discard list + !! Adapted from David E. Kaufmann's Swifter routine whm_discard_spill.f90 + implicit none + ! Arguments + class(swiftest_tp), intent(inout) :: self !! Swiftest test particle object + class(swiftest_body), intent(inout) :: discards !! Discarded object + logical, dimension(:), intent(in) :: lspill_list !! Logical array of bodies to spill into the discardse + logical, intent(in) :: ldestructive !! Logical flag indicating whether or not this operation should alter body by removing the discard list + + associate(keeps => self, ntp => self%nbody) + select type(discards) + class is (swiftest_tp) + !> Spill components specific to the test particle class + call util_spill(keeps%nplenc, discards%nplenc, lspill_list, ldestructive) + call util_spill_body(keeps, discards, lspill_list, ldestructive) + class default + write(*,*) 'Error! spill method called for incompatible return type on swiftest_tp' + end select + end associate + + return + end subroutine swiftest_util_spill_tp + + + module subroutine swiftest_util_unique_DP(input_array, output_array, index_map) + !! author: David A. Minton + !! + !! Takes an input unsorted integer array and returns a new array of sorted, unique values (DP version) + implicit none + ! Arguments + real(DP), dimension(:), intent(in) :: input_array !! Unsorted input array + real(DP), dimension(:), allocatable, intent(out) :: output_array !! Sorted array of unique values + integer(I4B), dimension(:), allocatable, intent(out) :: index_map !! An array of the same size as input_array that such that any for any index i, output_array(index_map(i)) = input_array(i) + ! Internals + real(DP), dimension(:), allocatable :: unique_array + integer(I4B) :: n + real(DP) :: lo, hi + + allocate(unique_array, mold=input_array) + allocate(index_map(size(input_array))) + lo = minval(input_array) - 1 + hi = maxval(input_array) + + n = 0 + do + n = n + 1 + lo = minval(input_array(:), mask=input_array(:) > lo) + unique_array(n) = lo + where(input_array(:) == lo) index_map(:) = n + if (lo >= hi) exit + enddo + allocate(output_array(n), source=unique_array(1:n)) + + return + end subroutine swiftest_util_unique_DP + + + module subroutine swiftest_util_unique_I4B(input_array, output_array, index_map) + !! author: David A. Minton + !! + !! Takes an input unsorted integer array and returns a new array of sorted, unique values (I4B version) + implicit none + ! Arguments + integer(I4B), dimension(:), intent(in) :: input_array !! Unsorted input array + integer(I4B), dimension(:), allocatable, intent(out) :: output_array !! Sorted array of unique values + integer(I4B), dimension(:), allocatable, intent(out) :: index_map !! An array of the same size as input_array that such that any for any index i, output_array(index_map(i)) = input_array(i) + ! Internals + integer(I4B), dimension(:), allocatable :: unique_array + integer(I4B) :: n, lo, hi + + allocate(unique_array, mold=input_array) + allocate(index_map, mold=input_array) + lo = minval(input_array) - 1 + hi = maxval(input_array) + + n = 0 + do + n = n + 1 + lo = minval(input_array(:), mask=input_array(:) > lo) + unique_array(n) = lo + where(input_array(:) == lo) index_map(:) = n + if (lo >= hi) exit + enddo + allocate(output_array(n), source=unique_array(1:n)) + + return + end subroutine swiftest_util_unique_I4B + + + module subroutine swiftest_util_valid_id_system(self, param) + !! author: David A. Minton + !! + !! Validate massive body and test particle ids + !! subroutine swiftest_causes program to exit with error if any ids are not unique + !! + !! Adapted from David E. Kaufmann's Swifter routine: util_valid.f90 + implicit none + ! Arguments + class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nbody system object + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + ! Internals + integer(I4B) :: i + integer(I4B), dimension(:), allocatable :: idarr + + associate(cb => self%cb, pl => self%pl, npl => self%pl%nbody, tp => self%tp, ntp => self%tp%nbody) + allocate(idarr(1+npl+ntp)) + idarr(1) = cb%id + do i = 1, npl + idarr(1+i) = pl%id(i) + end do + do i = 1, ntp + idarr(1+npl+i) = tp%id(i) + end do + call util_sort(idarr) + do i = 1, npl + ntp + if (idarr(i) == idarr(i+1)) then + write(*, *) "Swiftest error:" + write(*, *) " more than one body/particle has id = ", idarr(i) + call util_exit(FAILURE) + end if + end do + param%maxid = max(param%maxid, maxval(idarr)) + end associate + + return + end subroutine swiftest_util_valid_id_system + + + module subroutine swiftest_util_version() + !! author: David A. Minton + !! + !! Print program version information to terminale + !! + !! Adapted from David E. Kaufmann's Swifter routine: util_version.f90 + implicit none + write(*, 200) VERSION_NUMBER + 200 format(/, "************* Swiftest: Version ", f3.1, " *************", //, & + "Based off of Swifter:", //, & + "Authors:", //, & + " The Purdue University Swiftest Development team ", /, & + " Lead by David A. Minton ", /, & + " Single loop blocking by Jacob R. Elliott", /, & + " Fragmentation by Carlisle A. Wishard and", //, & + " Jennifer L. L. Poutplin ", //, & + "Please address comments and questions to:", //, & + " David A. Minton", /, & + " Department Earth, Atmospheric, & Planetary Sciences ",/, & + " Purdue University", /, & + " 550 Stadium Mall Drive", /, & + " West Lafayette, Indiana 47907", /, & + " 765-250-8034 ", /, & + " daminton@purdue.edu", /, & + "Special thanks to Hal Levison and Martin Duncan for the original",/,& + "SWIFTER and SWIFT codes that made this possible.", //, & + "************************************************", /) + + + 100 FORMAT(/, "************* SWIFTER: Version ", F3.1, " *************", //, & + "Authors:", //, & + " Martin Duncan: Queen's University", /, & + " Hal Levison : Southwest Research Institute", //, & + "Please address comments and questions to:", //, & + " Hal Levison or David Kaufmann", /, & + " Department of Space Studies", /, & + " Southwest Research Institute", /, & + " 1050 Walnut Street, Suite 400", /, & + " Boulder, Colorado 80302", /, & + " 303-546-0290 (HFL), 720-240-0119 (DEK)", /, & + " 303-546-9687 (fax)", /, & + " hal@gort.boulder.swri.edu (HFL)", /, & + " kaufmann@boulder.swri.edu (DEK)", //, & + "************************************************", /) + + return + end subroutine swiftest_util_version + +end submodule s_util \ No newline at end of file diff --git a/src/symba/symba_collision.f90 b/src/symba/symba_collision.f90 deleted file mode 100644 index 0c0150997..000000000 --- a/src/symba/symba_collision.f90 +++ /dev/null @@ -1,1081 +0,0 @@ -!! Copyright 2022 - David Minton, Carlisle Wishard, Jennifer Pouplin, Jake Elliott, & Dana Singh -!! This file is part of Swiftest. -!! Swiftest is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License -!! as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. -!! Swiftest is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty -!! of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. -!! You should have received a copy of the GNU General Public License along with Swiftest. -!! If not, see: https://www.gnu.org/licenses. - -submodule (symba_classes) s_symba_collision - use swiftest - -contains - - module function symba_collision_casedisruption(system, param, t) result(status) - !! author: Jennifer L.L. Pouplin, Carlisle A. Wishard, and David A. Minton - !! - !! Create the fragments resulting from a non-catastrophic disruption collision - !! - implicit none - ! Arguments - class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object - class(symba_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions - real(DP), intent(in) :: t !! Time of collision - ! Result - integer(I4B) :: status !! Status flag assigned to this outcome - ! Internals - integer(I4B) :: i, ibiggest, nfrag - logical :: lfailure - character(len=STRMAX) :: message - real(DP) :: dpe - - associate(collision_system => system%collision_system, impactors => system%collision_system%impactors, fragments => system%collision_system%fragments) - select case(impactors%regime) - case(COLLRESOLVE_REGIME_DISRUPTION) - message = "Disruption between" - case(COLLRESOLVE_REGIME_SUPERCATASTROPHIC) - message = "Supercatastrophic disruption between" - end select - call symba_collision_collider_message(system%pl, impactors%idx, message) - call io_log_one_message(FRAGGLE_LOG_OUT, message) - - ! Collisional fragments will be uniformly distributed around the pre-impact barycenter - call collision_system%set_mass_dist(param) - - ! Generate the position and velocity distributions of the fragments - call collision_system%generate_fragments(system, param, lfailure) - - dpe = collision_system%pe(2) - collision_system%pe(1) - system%Ecollisions = system%Ecollisions - dpe - system%Euntracked = system%Euntracked + dpe - - if (lfailure) then - call io_log_one_message(FRAGGLE_LOG_OUT, "No fragment solution found, so treat as a pure hit-and-run") - status = ACTIVE - nfrag = 0 - select type(pl => system%pl) - class is (symba_pl) - pl%status(impactors%idx(:)) = status - pl%ldiscard(impactors%idx(:)) = .false. - pl%lcollision(impactors%idx(:)) = .false. - end select - allocate(collision_system%after%pl, source=collision_system%before%pl) ! Be sure to save the pl so that snapshots still work - else - ! Populate the list of new bodies - nfrag = fragments%nbody - write(message, *) nfrag - call io_log_one_message(FRAGGLE_LOG_OUT, "Generating " // trim(adjustl(message)) // " fragments") - select case(impactors%regime) - case(COLLRESOLVE_REGIME_DISRUPTION) - status = DISRUPTION - ibiggest = impactors%idx(maxloc(system%pl%Gmass(impactors%idx(:)), dim=1)) - fragments%id(1) = system%pl%id(ibiggest) - fragments%id(2:nfrag) = [(i, i = param%maxid + 1, param%maxid + nfrag - 1)] - param%maxid = fragments%id(nfrag) - case(COLLRESOLVE_REGIME_SUPERCATASTROPHIC) - status = SUPERCATASTROPHIC - fragments%id(1:nfrag) = [(i, i = param%maxid + 1, param%maxid + nfrag)] - param%maxid = fragments%id(nfrag) - end select - - call symba_collision_mergeaddsub(system, param, t, status) - end if - end associate - - return - end function symba_collision_casedisruption - - - module function symba_collision_casehitandrun(system, param, t) result(status) - !! author: Jennifer L.L. Pouplin, Carlisle A. Wishard, and David A. Minton - !! - !! Create the fragments resulting from a non-catastrophic hit-and-run collision - !! - implicit none - ! Arguments - class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object - class(symba_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions - real(DP), intent(in) :: t !! Time of collision - ! Result - integer(I4B) :: status !! Status flag assigned to this outcom - ! Internals - integer(I4B) :: i, ibiggest, nfrag, jtarg, jproj - logical :: lpure - character(len=STRMAX) :: message - real(DP) :: dpe - - associate(collision_system => system%collision_system, impactors => system%collision_system%impactors, fragments => system%collision_system%fragments) - message = "Hit and run between" - call symba_collision_collider_message(system%pl, impactors%idx, message) - call io_log_one_message(FRAGGLE_LOG_OUT, trim(adjustl(message))) - - if (impactors%mass(1) > impactors%mass(2)) then - jtarg = 1 - jproj = 2 - else - jtarg = 2 - jproj = 1 - end if - - if (impactors%mass_dist(2) > 0.9_DP * impactors%mass(jproj)) then ! Pure hit and run, so we'll just keep the two bodies untouched - call io_log_one_message(FRAGGLE_LOG_OUT, "Pure hit and run. No new fragments generated.") - nfrag = 0 - lpure = .true. - else ! Imperfect hit and run, so we'll keep the largest body and destroy the other - lpure = .false. - call collision_system%set_mass_dist(param) - - ! Generate the position and velocity distributions of the fragments - call collision_system%generate_fragments(system, param, lpure) - - dpe = collision_system%pe(2) - collision_system%pe(1) - system%Ecollisions = system%Ecollisions - dpe - system%Euntracked = system%Euntracked + dpe - - if (lpure) then - call io_log_one_message(FRAGGLE_LOG_OUT, "Should have been a pure hit and run instead") - nfrag = 0 - else - nfrag = fragments%nbody - write(message, *) nfrag - call io_log_one_message(FRAGGLE_LOG_OUT, "Generating " // trim(adjustl(message)) // " fragments") - end if - end if - if (lpure) then ! Reset these bodies back to being active so that nothing further is done to them - status = HIT_AND_RUN_PURE - select type(pl => system%pl) - class is (symba_pl) - pl%status(impactors%idx(:)) = ACTIVE - pl%ldiscard(impactors%idx(:)) = .false. - pl%lcollision(impactors%idx(:)) = .false. - end select - allocate(collision_system%after%pl, source=collision_system%before%pl) ! Be sure to save the pl so that snapshots still work - else - ibiggest = impactors%idx(maxloc(system%pl%Gmass(impactors%idx(:)), dim=1)) - fragments%id(1) = system%pl%id(ibiggest) - fragments%id(2:nfrag) = [(i, i = param%maxid + 1, param%maxid + nfrag - 1)] - param%maxid = fragments%id(nfrag) - status = HIT_AND_RUN_DISRUPT - call symba_collision_mergeaddsub(system, param, t, status) - end if - - end associate - - return - end function symba_collision_casehitandrun - - - module function symba_collision_casemerge(system, param, t) result(status) - !! author: Jennifer L.L. Pouplin, Carlisle A. Wishard, and David A. Minton - !! - !! Merge massive bodies. - !! - !! Adapted from David E. Kaufmann's Swifter routines symba_merge_pl.f90 and symba_discard_merge_pl.f90 - !! - !! Adapted from Hal Levison's Swift routines symba5_merge.f and discard_mass_merge.f - implicit none - ! Arguments - class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object - class(symba_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions - real(DP), intent(in) :: t !! Time of collision - ! Result - integer(I4B) :: status !! Status flag assigned to this outcome - ! Internals - integer(I4B) :: i, j, k, ibiggest - real(DP), dimension(NDIM) :: Lspin_new - real(DP) :: dpe - character(len=STRMAX) :: message - - associate(collision_system => system%collision_system, impactors => system%collision_system%impactors, fragments => system%collision_system%fragments) - message = "Merging" - call symba_collision_collider_message(system%pl, impactors%idx, message) - call io_log_one_message(FRAGGLE_LOG_OUT, message) - - select type(pl => system%pl) - class is (symba_pl) - - call collision_system%set_mass_dist(param) - - ! Calculate the initial energy of the system without the collisional family - call collision_system%get_energy_and_momentum(system, param, lbefore=.true.) - - ibiggest = impactors%idx(maxloc(pl%Gmass(impactors%idx(:)), dim=1)) - fragments%id(1) = pl%id(ibiggest) - fragments%rb(:,1) = impactors%rbcom(:) - fragments%vb(:,1) = impactors%vbcom(:) - - if (param%lrotation) then - ! Conserve angular momentum by putting pre-impact orbital momentum into spin of the new body - Lspin_new(:) = impactors%Lorbit(:,1) + impactors%Lorbit(:,2) + impactors%Lspin(:,1) + impactors%Lspin(:,2) - - ! Assume prinicpal axis rotation on 3rd Ip axis - fragments%rot(:,1) = Lspin_new(:) / (fragments%Ip(3,1) * fragments%mass(1) * fragments%radius(1)**2) - else ! If spin is not enabled, we will consider the lost pre-collision angular momentum as "escaped" and add it to our bookkeeping variable - system%Lescape(:) = system%Lescape(:) + impactors%Lorbit(:,1) + impactors%Lorbit(:,2) - end if - - ! Keep track of the component of potential energy due to the pre-impact impactors%idx for book-keeping - ! Get the energy of the system after the collision - call collision_system%get_energy_and_momentum(system, param, lbefore=.false.) - dpe = collision_system%pe(2) - collision_system%pe(1) - system%Ecollisions = system%Ecollisions - dpe - system%Euntracked = system%Euntracked + dpe - - - ! Update any encounter lists that have the removed bodies in them so that they instead point to the new - do k = 1, system%plplenc_list%nenc - do j = 1, impactors%ncoll - i = impactors%idx(j) - if (i == ibiggest) cycle - if (system%plplenc_list%id1(k) == pl%id(i)) then - system%plplenc_list%id1(k) = pl%id(ibiggest) - system%plplenc_list%index1(k) = i - end if - if (system%plplenc_list%id2(k) == pl%id(i)) then - system%plplenc_list%id2(k) = pl%id(ibiggest) - system%plplenc_list%index2(k) = i - end if - if (system%plplenc_list%id1(k) == system%plplenc_list%id2(k)) system%plplenc_list%status(k) = INACTIVE - end do - end do - - status = MERGED - - call symba_collision_mergeaddsub(system, param, t, status) - - end select - end associate - return - end function symba_collision_casemerge - - - subroutine symba_collision_collider_message(pl, collidx, collider_message) - !! author: David A. Minton - !! - !! Prints a nicely formatted message about which bodies collided, including their names and ids. - !! This subroutine appends the body names and ids to an input message. - implicit none - ! Arguments - class(swiftest_pl), intent(in) :: pl !! Swiftest massive body object - integer(I4B), dimension(:), intent(in) :: collidx !! Index of collisional impactors%idx members - character(*), intent(inout) :: collider_message !! The message to print to the screen. - ! Internals - integer(I4B) :: i, n - character(len=STRMAX) :: idstr - - n = size(collidx) - if (n == 0) return - - do i = 1, n - if (i > 1) collider_message = trim(adjustl(collider_message)) // " and " - collider_message = " " // trim(adjustl(collider_message)) // " " // trim(adjustl(pl%info(collidx(i))%name)) - write(idstr, '(I10)') pl%id(collidx(i)) - collider_message = trim(adjustl(collider_message)) // " (" // trim(adjustl(idstr)) // ") " - end do - - return - end subroutine symba_collision_collider_message - - - module subroutine symba_collision_check_encounter(self, system, param, t, dt, irec, lany_collision) - !! author: David A. Minton - !! - !! Check for merger between massive bodies and test particles in SyMBA - !! - !! Adapted from David E. Kaufmann's Swifter routine symba_merge.f90 and symba_merge_tp.f90 - !! - !! Adapted from Hal Levison's Swift routine symba5_merge.f - implicit none - ! Arguments - class(symba_encounter), intent(inout) :: self !! SyMBA pl-tp encounter list object - class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - real(DP), intent(in) :: t !! current time - real(DP), intent(in) :: dt !! step size - integer(I4B), intent(in) :: irec !! Current recursion level - logical, intent(out) :: lany_collision !! Returns true if cany pair of encounters resulted in a collision - ! Internals - logical, dimension(:), allocatable :: lcollision, lmask - real(DP), dimension(NDIM) :: xr, vr - integer(I4B) :: i, j, k, nenc - real(DP) :: rlim, Gmtot - logical :: isplpl, lany_closest - character(len=STRMAX) :: timestr, idstri, idstrj, message - class(symba_encounter), allocatable :: tmp - - lany_collision = .false. - if (self%nenc == 0) return - - select type(self) - class is (symba_plplenc) - isplpl = .true. - class default - isplpl = .false. - end select - - select type(pl => system%pl) - class is (symba_pl) - select type(tp => system%tp) - class is (symba_tp) - select type (param) - class is (symba_parameters) - nenc = self%nenc - allocate(lmask(nenc)) - lmask(:) = ((self%status(1:nenc) == ACTIVE) .and. (pl%levelg(self%index1(1:nenc)) >= irec)) - if (isplpl) then - lmask(:) = lmask(:) .and. (pl%levelg(self%index2(1:nenc)) >= irec) - else - lmask(:) = lmask(:) .and. (tp%levelg(self%index2(1:nenc)) >= irec) - end if - if (.not.any(lmask(:))) return - - allocate(lcollision(nenc)) - lcollision(:) = .false. - self%lclosest(:) = .false. - - if (isplpl) then - do concurrent(k = 1:nenc, lmask(k)) - i = self%index1(k) - j = self%index2(k) - xr(:) = pl%rh(:, i) - pl%rh(:, j) - vr(:) = pl%vb(:, i) - pl%vb(:, j) - rlim = pl%radius(i) + pl%radius(j) - Gmtot = pl%Gmass(i) + pl%Gmass(j) - call symba_collision_check_one(xr(1), xr(2), xr(3), vr(1), vr(2), vr(3), Gmtot, rlim, dt, self%lvdotr(k), lcollision(k), self%lclosest(k)) - end do - else - do concurrent(k = 1:nenc, lmask(k)) - i = self%index1(k) - j = self%index2(k) - xr(:) = pl%rh(:, i) - tp%rh(:, j) - vr(:) = pl%vb(:, i) - tp%vb(:, j) - call 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), lcollision(k), self%lclosest(k)) - end do - end if - - lany_collision = any(lcollision(:)) - lany_closest = (param%lenc_save_closest .and. any(self%lclosest(:))) - - - if (lany_collision .or. lany_closest) then - call pl%rh2rb(system%cb) ! Update the central body barycenteric position vector to get us out of DH and into bary - do k = 1, nenc - if (.not.lcollision(k) .and. .not. self%lclosest(k)) cycle - i = self%index1(k) - j = self%index2(k) - self%r1(:,k) = pl%rh(:,i) + system%cb%rb(:) - self%v1(:,k) = pl%vb(:,i) - if (lcollision(k)) then - self%status(k) = COLLISION - self%tcollision(k) = t - end if - if (isplpl) then - self%r2(:,k) = pl%rh(:,j) + system%cb%rb(:) - self%v2(:,k) = pl%vb(:,j) - if (lcollision(k)) then - ! Check to see if either of these bodies has been involved with a collision before, and if so, make this a collider pair - if (pl%lcollision(i) .or. pl%lcollision(j)) call pl%make_impactors([i,j]) - - ! Set the collision flag for these to bodies to true in case they become involved in another collision later in the step - pl%lcollision([i, j]) = .true. - pl%status([i, j]) = COLLISION - call pl%info(i)%set_value(status="COLLISION") - call pl%info(j)%set_value(status="COLLISION") - end if - else - self%r2(:,k) = tp%rh(:,j) + system%cb%rb(:) - self%v2(:,k) = tp%vb(:,j) - if (lcollision(k)) then - tp%status(j) = DISCARDED_PLR - tp%ldiscard(j) = .true. - write(idstri, *) pl%id(i) - write(idstrj, *) tp%id(j) - write(timestr, *) t - call tp%info(j)%set_value(status="DISCARDED_PLR", discard_time=t, discard_rh=tp%rh(:,j), discard_vh=tp%vh(:,j)) - write(message, *) "Particle " // trim(adjustl(tp%info(j)%name)) // " (" // trim(adjustl(idstrj)) // ")" & - // " collided with massive body " // trim(adjustl(pl%info(i)%name)) // " (" // trim(adjustl(idstri)) // ")" & - // " at t = " // trim(adjustl(timestr)) - call io_log_one_message(FRAGGLE_LOG_OUT, message) - end if - end if - end do - - ! Extract the pl-pl or pl-tp encounter list and return the pl-pl or pl-tp collision_list - select type(self) - class is (symba_plplenc) - call self%extract_collisions(system, param) - class is (symba_pltpenc) - allocate(tmp, mold=self) - call self%spill(tmp, lcollision, ldestructive=.true.) ! Remove this encounter pair from the encounter list - end select - end if - - ! Take snapshots of pairs of bodies at close approach (but not collision) if requested - if (lany_closest) call param%encounter_history%take_snapshot(param, system, t, "closest") - - end select - - end select - end select - - return - end subroutine symba_collision_check_encounter - - - pure elemental subroutine symba_collision_check_one(xr, yr, zr, vxr, vyr, vzr, Gmtot, rlim, dt, lvdotr, lcollision, lclosest) - !! author: David A. Minton - !! - !! Check for a merger between a single pair of particles - !! - !! Adapted from David E. Kaufmann's Swifter routines symba_merge_tp.f90 and symba_merge_pl.f90 - !! - !! Adapted from Hal Levison's Swift routine symba5_merge.f - implicit none - ! Arguments - real(DP), intent(in) :: xr, yr, zr !! Relative position vector components - real(DP), intent(in) :: vxr, vyr, vzr !! Relative velocity vector components - real(DP), intent(in) :: Gmtot !! Sum of G*mass of colliding bodies - real(DP), intent(in) :: rlim !! Collision limit - Typically the sum of the radii of colliding bodies - real(DP), intent(in) :: dt !! Step size - logical, intent(in) :: lvdotr !! Logical flag indicating that these two bodies are approaching in the current substep - logical, intent(out) :: lcollision !! Logical flag indicating whether these two bodies will collide or not - logical, intent(out) :: lclosest !! Logical flag indicating that, while not a collision, this is the closest approach for this pair of bodies - ! Internals - real(DP) :: r2, rlim2, a, e, q, vdotr, tcr2, dt2 - - r2 = xr**2 + yr**2 + zr**2 - rlim2 = rlim**2 - lclosest = .false. - if (r2 <= rlim2) then ! checks if bodies are actively colliding in this time step - lcollision = .true. - else ! if they are not actively colliding in this time step, checks if they are going to collide next time step based on velocities and q - lcollision = .false. - vdotr = xr * vxr + yr * vyr + zr * vzr - if (lvdotr .and. (vdotr > 0.0_DP)) then - tcr2 = r2 / (vxr**2 + vyr**2 + vzr**2) - dt2 = dt**2 - if (tcr2 <= dt2) then - call orbel_xv2aeq(Gmtot, xr, yr, zr, vxr, vyr, vzr, a, e, q) - lcollision = (q < rlim) - end if - lclosest = .not. lcollision - end if - end if - - return - end subroutine symba_collision_check_one - - - function symba_collision_consolidate_impactors(pl, cb, param, idx_parent, impactors) result(lflag) - !! author: David A. Minton - !! - !! Loops through the pl-pl collision list and groups families together by index. Outputs the indices of all impactors%idx members, - !! and pairs of quantities (x and v vectors, mass, radius, Lspin, and Ip) that can be used to resolve the collisional outcome. - implicit none - ! Arguments - class(symba_pl), intent(inout) :: pl !! SyMBA massive body object - class(symba_cb), intent(inout) :: cb !! SyMBA central body object - class(symba_parameters), intent(in) :: param !! Current run configuration parameters with SyMBA additions - integer(I4B), dimension(2), intent(inout) :: idx_parent !! Index of the two bodies considered the "parents" of the collision - class(collision_impactors), intent(out) :: impactors - ! Result - logical :: lflag !! Logical flag indicating whether a impactors%idx was successfully created or not - ! Internals - type collidx_array - integer(I4B), dimension(:), allocatable :: id - integer(I4B), dimension(:), allocatable :: idx - end type collidx_array - type(collidx_array), dimension(2) :: parent_child_index_array - integer(I4B), dimension(2) :: nchild - integer(I4B) :: i, j, nimpactors, idx_child - real(DP), dimension(2) :: volume, density - real(DP) :: mchild, volchild - real(DP), dimension(NDIM) :: xc, vc, xcom, vcom, xchild, vchild, xcrossv - real(DP), dimension(NDIM,2) :: mxc, vcc - - nchild(:) = pl%kin(idx_parent(:))%nchild - ! If all of these bodies share a parent, but this is still a unique collision, move the last child - ! out of the parent's position and make it the secondary body - if (idx_parent(1) == idx_parent(2)) then - if (nchild(1) == 0) then ! There is only one valid body recorded in this pair (this could happen due to restructuring of the kinship relationships, though it should be rare) - lflag = .false. - call pl%reset_kinship([idx_parent(1)]) - return - end if - idx_parent(2) = pl%kin(idx_parent(1))%child(nchild(1)) - nchild(1) = nchild(1) - 1 - nchild(2) = 0 - pl%kin(idx_parent(:))%nchild = nchild(:) - pl%kin(idx_parent(2))%parent = idx_parent(1) - end if - - impactors%mass(:) = pl%mass(idx_parent(:)) ! Note: This is meant to mass, not G*mass, as the collisional regime determination uses mass values that will be converted to Si - impactors%radius(:) = pl%radius(idx_parent(:)) - volume(:) = (4.0_DP / 3.0_DP) * PI * impactors%radius(:)**3 - - ! Group together the ids and indexes of each collisional parent and its children - do j = 1, 2 - allocate(parent_child_index_array(j)%idx(nchild(j)+ 1)) - allocate(parent_child_index_array(j)%id(nchild(j)+ 1)) - associate(idx_arr => parent_child_index_array(j)%idx, & - id_arr => parent_child_index_array(j)%id, & - ncj => nchild(j), & - plkinj => pl%kin(idx_parent(j))) - idx_arr(1) = idx_parent(j) - if (ncj > 0) idx_arr(2:ncj + 1) = plkinj%child(1:ncj) - id_arr(:) = pl%id(idx_arr(:)) - end associate - end do - - ! Consolidate the groups of collsional parents with any children they may have into a single "impactors%idx" index array - nimpactors = 2 + sum(nchild(:)) - allocate(impactors%idx(nimpactors)) - impactors%idx = [parent_child_index_array(1)%idx(:),parent_child_index_array(2)%idx(:)] - - impactors%ncoll = count(pl%lcollision(impactors%idx(:))) - impactors%idx = pack(impactors%idx(:), pl%lcollision(impactors%idx(:))) - impactors%Lspin(:,:) = 0.0_DP - impactors%Ip(:,:) = 0.0_DP - - ! Find the barycenter of each body along with its children, if it has any - do j = 1, 2 - impactors%rb(:, j) = pl%rh(:, idx_parent(j)) + cb%rb(:) - impactors%vb(:, j) = pl%vb(:, idx_parent(j)) - ! Assume principal axis rotation about axis corresponding to highest moment of inertia (3rd Ip) - if (param%lrotation) then - impactors%Ip(:, j) = impactors%mass(j) * pl%Ip(:, idx_parent(j)) - impactors%Lspin(:, j) = impactors%Ip(3, j) * impactors%radius(j)**2 * pl%rot(:, idx_parent(j)) - end if - - if (nchild(j) > 0) then - do i = 1, nchild(j) ! Loop over all children and take the mass weighted mean of the properties - idx_child = parent_child_index_array(j)%idx(i + 1) - if (.not. pl%lcollision(idx_child)) cycle - mchild = pl%mass(idx_child) - xchild(:) = pl%rh(:, idx_child) + cb%rb(:) - vchild(:) = pl%vb(:, idx_child) - volchild = (4.0_DP / 3.0_DP) * PI * pl%radius(idx_child)**3 - volume(j) = volume(j) + volchild - ! Get angular momentum of the child-parent pair and add that to the spin - ! Add the child's spin - if (param%lrotation) then - xcom(:) = (impactors%mass(j) * impactors%rb(:,j) + mchild * xchild(:)) / (impactors%mass(j) + mchild) - vcom(:) = (impactors%mass(j) * impactors%vb(:,j) + mchild * vchild(:)) / (impactors%mass(j) + mchild) - xc(:) = impactors%rb(:, j) - xcom(:) - vc(:) = impactors%vb(:, j) - vcom(:) - xcrossv(:) = xc(:) .cross. vc(:) - impactors%Lspin(:, j) = impactors%Lspin(:, j) + impactors%mass(j) * xcrossv(:) - - xc(:) = xchild(:) - xcom(:) - vc(:) = vchild(:) - vcom(:) - xcrossv(:) = xc(:) .cross. vc(:) - impactors%Lspin(:, j) = impactors%Lspin(:, j) + mchild * xcrossv(:) - - impactors%Lspin(:, j) = impactors%Lspin(:, j) + mchild * pl%Ip(3, idx_child) & - * pl%radius(idx_child)**2 & - * pl%rot(:, idx_child) - impactors%Ip(:, j) = impactors%Ip(:, j) + mchild * pl%Ip(:, idx_child) - end if - - ! Merge the child and parent - impactors%mass(j) = impactors%mass(j) + mchild - impactors%rb(:, j) = xcom(:) - impactors%vb(:, j) = vcom(:) - end do - end if - density(j) = impactors%mass(j) / volume(j) - impactors%radius(j) = (3 * volume(j) / (4 * PI))**(1.0_DP / 3.0_DP) - if (param%lrotation) impactors%Ip(:, j) = impactors%Ip(:, j) / impactors%mass(j) - end do - lflag = .true. - - xcom(:) = (impactors%mass(1) * impactors%rb(:, 1) + impactors%mass(2) * impactors%rb(:, 2)) / sum(impactors%mass(:)) - vcom(:) = (impactors%mass(1) * impactors%vb(:, 1) + impactors%mass(2) * impactors%vb(:, 2)) / sum(impactors%mass(:)) - mxc(:, 1) = impactors%mass(1) * (impactors%rb(:, 1) - xcom(:)) - mxc(:, 2) = impactors%mass(2) * (impactors%rb(:, 2) - xcom(:)) - vcc(:, 1) = impactors%vb(:, 1) - vcom(:) - vcc(:, 2) = impactors%vb(:, 2) - vcom(:) - impactors%Lorbit(:,:) = mxc(:,:) .cross. vcc(:,:) - - ! Destroy the kinship relationships for all members of this impactors%idx - call pl%reset_kinship(impactors%idx(:)) - - return - end function symba_collision_consolidate_impactors - - - module subroutine symba_collision_extract_collisions_from_encounters(self, system, param) - !! author: David A. Minton - !! - !! Processes the pl-pl encounter list remove only those encounters that led to a collision - !! - implicit none - ! Arguments - class(symba_plplenc), intent(inout) :: self !! SyMBA pl-pl encounter list - class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object - class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters - ! Internals - logical, dimension(:), allocatable :: lplpl_collision - logical, dimension(:), allocatable :: lplpl_unique_parent - integer(I4B), dimension(:), pointer :: plparent - integer(I4B), dimension(:), allocatable :: collision_idx, unique_parent_idx - integer(I4B) :: i, index_coll, ncollisions, nunique_parent, nplplenc - - select type (pl => system%pl) - class is (symba_pl) - associate(plplenc_list => self, idx1 => self%index1, idx2 => self%index2, plparent => pl%kin%parent) - nplplenc = plplenc_list%nenc - allocate(lplpl_collision(nplplenc)) - lplpl_collision(:) = plplenc_list%status(1:nplplenc) == COLLISION - if (.not.any(lplpl_collision)) return - ! Collisions have been detected in this step. So we need to determine which of them are between unique bodies. - - ! Get the subset of pl-pl encounters that lead to a collision - ncollisions = count(lplpl_collision(:)) - allocate(collision_idx(ncollisions)) - collision_idx = pack([(i, i=1, nplplenc)], lplpl_collision) - - ! Get the subset of collisions that involve a unique pair of parents - allocate(lplpl_unique_parent(ncollisions)) - - lplpl_unique_parent(:) = plparent(idx1(collision_idx(:))) /= plparent(idx2(collision_idx(:))) - nunique_parent = count(lplpl_unique_parent(:)) - allocate(unique_parent_idx(nunique_parent)) - unique_parent_idx = pack(collision_idx(:), lplpl_unique_parent(:)) - - ! Scrub all pl-pl collisions involving unique pairs of parents, which will remove all duplicates and leave behind - ! all pairs that have themselves as parents but are not part of the unique parent list. This can hapepn in rare cases - ! due to restructuring of parent/child relationships when there are large numbers of multi-body collisions in a single - ! step - lplpl_unique_parent(:) = .true. - do index_coll = 1, ncollisions - associate(ip1 => plparent(idx1(collision_idx(index_coll))), ip2 => plparent(idx2(collision_idx(index_coll)))) - lplpl_unique_parent(:) = .not. ( any(plparent(idx1(unique_parent_idx(:))) == ip1) .or. & - any(plparent(idx2(unique_parent_idx(:))) == ip1) .or. & - any(plparent(idx1(unique_parent_idx(:))) == ip2) .or. & - any(plparent(idx2(unique_parent_idx(:))) == ip2) ) - end associate - end do - - ! Reassemble collision index list to include only those containing the unique pairs of parents, plus all the non-unique pairs that don't - ! contain a parent body on the unique parent list. - ncollisions = nunique_parent + count(lplpl_unique_parent) - collision_idx = [unique_parent_idx(:), pack(collision_idx(:), lplpl_unique_parent(:))] - - ! Create a mask that contains only the pl-pl encounters that did not result in a collision, and then discard them - lplpl_collision(:) = .false. - lplpl_collision(collision_idx(:)) = .true. - call plplenc_list%spill(system%plplcollision_list, lplpl_collision, ldestructive=.true.) ! Extract any encounters that are not collisions from the list. - end associate - end select - - return - end subroutine symba_collision_extract_collisions_from_encounters - - - module subroutine symba_collision_make_impactors_pl(self, idx) - !! author: Jennifer L.L. Pouplin, Carlisle A. wishard, and David A. Minton - !! - !! When a single body is involved in more than one collision in a single step, it becomes part of a impactors%idx. - !! The largest body involved in a multi-body collision is the "parent" and all bodies that collide with it are its "children," - !! including those that collide with the children. - !! - !! Adapted from David E. Kaufmann's Swifter routine symba_merge_pl.f90 - !! - !! Adapted from Hal Levison's Swift routine symba5_merge.f - implicit none - ! Arguments - class(symba_pl), intent(inout) :: self !! SyMBA massive body object - integer(I4B), dimension(2), intent(in) :: idx !! Array holding the indices of the two bodies involved in the collision - ! Internals - integer(I4B) :: i, j, index_parent, index_child, p1, p2 - integer(I4B) :: nchild_inherit, nchild_orig, nchild_new - integer(I4B), dimension(:), allocatable :: temp - - associate(pl => self) - p1 = pl%kin(idx(1))%parent - p2 = pl%kin(idx(2))%parent - if (p1 == p2) return ! This is a collision between to children of a shared parent. We will ignore it. - - if (pl%mass(p1) > pl%mass(p2)) then - index_parent = p1 - index_child = p2 - else - index_parent = p2 - index_child = p1 - end if - - ! Expand the child array (or create it if necessary) and copy over the previous lists of children - nchild_orig = pl%kin(index_parent)%nchild - nchild_inherit = pl%kin(index_child)%nchild - nchild_new = nchild_orig + nchild_inherit + 1 - allocate(temp(nchild_new)) - - if (nchild_orig > 0) temp(1:nchild_orig) = pl%kin(index_parent)%child(1:nchild_orig) - ! Find out if the child body has any children of its own. The new parent wil inherit these children - if (nchild_inherit > 0) then - temp(nchild_orig+1:nchild_orig+nchild_inherit) = pl%kin(index_child)%child(1:nchild_inherit) - do i = 1, nchild_inherit - j = pl%kin(index_child)%child(i) - ! Set the childrens' parent to the new parent - pl%kin(j)%parent = index_parent - end do - end if - call pl%reset_kinship([index_child]) - ! Add the new child to its parent - pl%kin(index_child)%parent = index_parent - temp(nchild_new) = index_child - ! Save the new child array to the parent - pl%kin(index_parent)%nchild = nchild_new - call move_alloc(from=temp, to=pl%kin(index_parent)%child) - end associate - - return - end subroutine symba_collision_make_impactors_pl - - - subroutine symba_collision_mergeaddsub(system, param, t, status) - !! author: David A. Minton - !! - !! Fills the pl_discards and pl_adds with removed and added bodies - !! - implicit none - ! Arguments - class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object - class(symba_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions - real(DP), intent(in) :: t !! Time of collision - integer(I4B), intent(in) :: status !! Status flag to assign to adds - ! Internals - integer(I4B) :: i, ibiggest, ismallest, iother, nstart, nend, nimpactors, nfrag - logical, dimension(system%pl%nbody) :: lmask - class(symba_pl), allocatable :: plnew, plsub - character(*), parameter :: FRAGFMT = '("Newbody",I0.7)' - character(len=NAMELEN) :: newname, origin_type - - select type(pl => system%pl) - class is (symba_pl) - select type(pl_discards => system%pl_discards) - class is (symba_merger) - associate(info => pl%info, pl_adds => system%pl_adds, cb => system%cb, npl => pl%nbody, & - collision_system => system%collision_system, impactors => system%collision_system%impactors, fragments => system%collision_system%fragments) - ! Add the impactors%idx bodies to the subtraction list - nimpactors = impactors%ncoll - nfrag = fragments%nbody - - param%maxid_collision = max(param%maxid_collision, maxval(system%pl%info(:)%collision_id)) - param%maxid_collision = param%maxid_collision + 1 - - ! Setup new bodies - allocate(plnew, mold=pl) - call plnew%setup(nfrag, param) - ibiggest = impactors%idx(maxloc(pl%Gmass(impactors%idx(:)), dim=1)) - ismallest = impactors%idx(minloc(pl%Gmass(impactors%idx(:)), dim=1)) - - ! Copy over identification, information, and physical properties of the new bodies from the fragment list - plnew%id(1:nfrag) = fragments%id(1:nfrag) - plnew%rb(:, 1:nfrag) = fragments%rb(:, 1:nfrag) - plnew%vb(:, 1:nfrag) = fragments%vb(:, 1:nfrag) - call pl%vb2vh(cb) - call pl%rh2rb(cb) - do i = 1, nfrag - plnew%rh(:,i) = fragments%rb(:, i) - cb%rb(:) - plnew%vh(:,i) = fragments%vb(:, i) - cb%vb(:) - end do - plnew%mass(1:nfrag) = fragments%mass(1:nfrag) - plnew%Gmass(1:nfrag) = param%GU * fragments%mass(1:nfrag) - plnew%radius(1:nfrag) = fragments%radius(1:nfrag) - plnew%density(1:nfrag) = fragments%mass(1:nfrag) / fragments%radius(1:nfrag) - call plnew%set_rhill(cb) - - select case(status) - case(SUPERCATASTROPHIC) - plnew%status(1:nfrag) = NEW_PARTICLE - do i = 1, nfrag - write(newname, FRAGFMT) fragments%id(i) - call plnew%info(i)%set_value(origin_type="Supercatastrophic", origin_time=t, name=newname, & - origin_rh=plnew%rh(:,i), origin_vh=plnew%vh(:,i), & - collision_id=param%maxid_collision) - end do - do i = 1, nimpactors - if (impactors%idx(i) == ibiggest) then - iother = ismallest - else - iother = ibiggest - end if - call pl%info(impactors%idx(i))%set_value(status="Supercatastrophic", discard_time=t, & - discard_rh=pl%rh(:,i), discard_vh=pl%vh(:,i), & - discard_body_id=iother) - end do - case(DISRUPTION,HIT_AND_RUN_DISRUPT) - if (status == DISRUPTION) then - write(origin_type,*) "Disruption" - else if (status == HIT_AND_RUN_DISRUPT) then - write(origin_type,*) "Hit and run fragmention" - end if - call plnew%info(1)%copy(pl%info(ibiggest)) - plnew%status(1) = OLD_PARTICLE - do i = 2, nfrag - write(newname, FRAGFMT) fragments%id(i) - call plnew%info(i)%set_value(origin_type=origin_type, origin_time=t, name=newname, & - origin_rh=plnew%rh(:,i), origin_vh=plnew%vh(:,i), & - collision_id=param%maxid_collision) - end do - do i = 1, nimpactors - if (impactors%idx(i) == ibiggest) cycle - iother = ibiggest - call pl%info(impactors%idx(i))%set_value(status=origin_type, discard_time=t, & - discard_rh=pl%rh(:,i), discard_vh=pl%vh(:,i), & - discard_body_id=iother) - end do - case(MERGED) - call plnew%info(1)%copy(pl%info(ibiggest)) - plnew%status(1) = OLD_PARTICLE - do i = 1, nimpactors - if (impactors%idx(i) == ibiggest) cycle - - iother = ibiggest - call pl%info(impactors%idx(i))%set_value(status="MERGED", discard_time=t, discard_rh=pl%rh(:,i), & - discard_vh=pl%vh(:,i), discard_body_id=iother) - end do - end select - - if (param%lrotation) then - plnew%Ip(:, 1:nfrag) = fragments%Ip(:, 1:nfrag) - plnew%rot(:, 1:nfrag) = fragments%rot(:, 1:nfrag) - end if - - ! if (param%ltides) then - ! plnew%Q = pl%Q(ibiggest) - ! plnew%k2 = pl%k2(ibiggest) - ! plnew%tlag = pl%tlag(ibiggest) - ! end if - - !Copy over or set integration parameters for new bodies - plnew%lcollision(1:nfrag) = .false. - plnew%ldiscard(1:nfrag) = .false. - plnew%levelg(1:nfrag) = pl%levelg(ibiggest) - plnew%levelm(1:nfrag) = pl%levelm(ibiggest) - - plnew%lmtiny(1:nfrag) = plnew%Gmass(1:nfrag) < param%GMTINY - where(plnew%lmtiny(1:nfrag)) - plnew%info(1:nfrag)%particle_type = PL_TINY_TYPE_NAME - elsewhere - plnew%info(1:nfrag)%particle_type = PL_TYPE_NAME - end where - - ! Log the properties of the new bodies - allocate(collision_system%after%pl, source=plnew) - - ! Append the new merged body to the list - nstart = pl_adds%nbody + 1 - nend = pl_adds%nbody + nfrag - call pl_adds%append(plnew, lsource_mask=[(.true., i=1, nfrag)]) - ! Record how many bodies were added in this event - pl_adds%ncomp(nstart:nend) = plnew%nbody - - ! Add the discarded bodies to the discard list - pl%status(impactors%idx(:)) = MERGED - pl%ldiscard(impactors%idx(:)) = .true. - pl%lcollision(impactors%idx(:)) = .true. - lmask(:) = .false. - lmask(impactors%idx(:)) = .true. - - call plnew%setup(0, param) - deallocate(plnew) - - allocate(plsub, mold=pl) - call pl%spill(plsub, lmask, ldestructive=.false.) - - nstart = pl_discards%nbody + 1 - nend = pl_discards%nbody + nimpactors - call pl_discards%append(plsub, lsource_mask=[(.true., i = 1, nimpactors)]) - - ! Record how many bodies were subtracted in this event - pl_discards%ncomp(nstart:nend) = nimpactors - - call plsub%setup(0, param) - deallocate(plsub) - end associate - end select - end select - - return - end subroutine symba_collision_mergeaddsub - - - subroutine symba_resolve_collision(plplcollision_list , system, param, t) - !! author: David A. Minton - !! - !! Process list of collisions, determine the collisional regime, and then create fragments. - !! - implicit none - ! Arguments - class(symba_plplenc), intent(inout) :: plplcollision_list !! SyMBA pl-pl encounter list - class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object - class(symba_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions - real(DP), intent(in) :: t !! Time of collision - ! Internals - ! Internals - integer(I4B), dimension(2) :: idx_parent !! Index of the two bodies considered the "parents" of the collision - logical :: lgoodcollision - integer(I4B) :: i - - associate(ncollisions => plplcollision_list%nenc, idx1 => plplcollision_list%index1, idx2 => plplcollision_list%index2, collision_history => param%collision_history, & - collision_system => system%collision_system, impactors => system%collision_system%impactors, fragments => system%collision_system%fragments) - select type(pl => system%pl) - class is (symba_pl) - select type (cb => system%cb) - class is (symba_cb) - do i = 1, ncollisions - idx_parent(1) = pl%kin(idx1(i))%parent - idx_parent(2) = pl%kin(idx2(i))%parent - lgoodcollision = symba_collision_consolidate_impactors(pl, cb, param, idx_parent, impactors) - if ((.not. lgoodcollision) .or. any(pl%status(idx_parent(:)) /= COLLISION)) cycle - - if (param%lfragmentation) then - call impactors%get_regime(system, param) - else - impactors%regime = COLLRESOLVE_REGIME_MERGE - fragments%mtot = sum(impactors%mass(:)) - impactors%mass_dist(1) = fragments%mtot - impactors%mass_dist(2) = 0.0_DP - impactors%mass_dist(3) = 0.0_DP - impactors%rbcom(:) = (impactors%mass(1) * impactors%rb(:,1) + impactors%mass(2) * impactors%rb(:,2)) / fragments%mtot - impactors%vbcom(:) = (impactors%mass(1) * impactors%vb(:,1) + impactors%mass(2) * impactors%vb(:,2)) / fragments%mtot - end if - - call collision_history%take_snapshot(param,system, t, "before") - select case (impactors%regime) - case (COLLRESOLVE_REGIME_DISRUPTION, COLLRESOLVE_REGIME_SUPERCATASTROPHIC) - plplcollision_list%status(i) = symba_collision_casedisruption(system, param, t) - case (COLLRESOLVE_REGIME_HIT_AND_RUN) - plplcollision_list%status(i) = symba_collision_casehitandrun(system, param, t) - case (COLLRESOLVE_REGIME_MERGE, COLLRESOLVE_REGIME_GRAZE_AND_MERGE) - plplcollision_list%status(i) = symba_collision_casemerge(system, param, t) - case default - write(*,*) "Error in symba_collision, unrecognized collision regime" - call util_exit(FAILURE) - end select - call collision_history%take_snapshot(param,system, t, "after") - call impactors%reset() - end do - end select - end select - end associate - - return - end subroutine symba_resolve_collision - - - module subroutine symba_resolve_collision_plplenc(self, system, param, t, dt, irec) - !! author: David A. Minton - !! - !! Process the pl-pl collision list, then modifiy the massive bodies based on the outcome of the collision - !! - implicit none - ! Arguments - class(symba_plplenc), intent(inout) :: self !! SyMBA pl-pl encounter list - class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions - real(DP), intent(in) :: t !! Current simulation time - real(DP), intent(in) :: dt !! Current simulation step size - integer(I4B), intent(in) :: irec !! Current recursion level - ! Internals - real(DP) :: Eorbit_before, Eorbit_after - logical :: lplpl_collision - character(len=STRMAX) :: timestr - class(symba_parameters), allocatable :: tmp_param - - associate(plplenc_list => self, plplcollision_list => system%plplcollision_list) - select type(pl => system%pl) - class is (symba_pl) - select type(param) - class is (symba_parameters) - if (plplcollision_list%nenc == 0) return ! No collisions to resolve - ! Make sure that the heliocentric and barycentric coordinates are consistent with each other - call pl%vb2vh(system%cb) - call pl%rh2rb(system%cb) - - ! Get the energy before the collision is resolved - if (param%lenergy) then - call system%get_energy_and_momentum(param) - Eorbit_before = system%te - end if - - do - write(timestr,*) t - call io_log_one_message(FRAGGLE_LOG_OUT, "") - call io_log_one_message(FRAGGLE_LOG_OUT, "***********************************************************" // & - "***********************************************************") - call io_log_one_message(FRAGGLE_LOG_OUT, "Collision between massive bodies detected at time t = " // & - trim(adjustl(timestr))) - call io_log_one_message(FRAGGLE_LOG_OUT, "***********************************************************" // & - "***********************************************************") - allocate(tmp_param, source=param) - - call symba_resolve_collision(plplcollision_list, system, param, t) - - ! Destroy the collision list now that the collisions are resolved - call plplcollision_list%setup(0_I8B) - - if ((system%pl_adds%nbody == 0) .and. (system%pl_discards%nbody == 0)) exit - - ! Save the add/discard information to file - call system%write_discard(tmp_param) - - ! Rearrange the arrays: Remove discarded bodies, add any new bodies, resort, and recompute all indices and encounter lists - call pl%rearray(system, tmp_param) - - ! Destroy the add/discard list so that we don't append the same body multiple times if another collision is detected - call system%pl_discards%setup(0, param) - call system%pl_adds%setup(0, param) - deallocate(tmp_param) - - ! Check whether or not any of the particles that were just added are themselves in a collision state. This will generate a new plplcollision_list - call plplenc_list%collision_check(system, param, t, dt, irec, lplpl_collision) - - if (.not.lplpl_collision) exit - end do - - if (param%lenergy) then - call system%get_energy_and_momentum(param) - Eorbit_after = system%te - system%Ecollisions = system%Ecollisions + (Eorbit_after - Eorbit_before) - end if - - end select - end select - end associate - - return - end subroutine symba_resolve_collision_plplenc - - - module subroutine symba_resolve_collision_pltpenc(self, system, param, t, dt, irec) - !! author: David A. Minton - !! - !! Process the pl-tp collision list, then modifiy the massive bodies based on the outcome of the collision - !! - implicit none - ! Arguments - class(symba_pltpenc), intent(inout) :: self !! SyMBA pl-pl encounter list - class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions - real(DP), intent(in) :: t !! Current simulation tim - real(DP), intent(in) :: dt !! Current simulation step size - integer(I4B), intent(in) :: irec !! Current recursion level - - ! Make sure coordinate systems are all synced up due to being inside the recursion at this point - call system%pl%vb2vh(system%cb) - call system%tp%vb2vh(system%cb%vb) - call system%pl%b2h(system%cb) - call system%tp%b2h(system%cb) - - ! Discard the collider - call system%tp%discard(system, param) - - return - end subroutine symba_resolve_collision_pltpenc - -end submodule s_symba_collision \ No newline at end of file diff --git a/src/symba/symba_discard.f90 b/src/symba/symba_discard.f90 index 82741d695..a14911daa 100644 --- a/src/symba/symba_discard.f90 +++ b/src/symba/symba_discard.f90 @@ -7,7 +7,7 @@ !! You should have received a copy of the GNU General Public License along with Swiftest. !! If not, see: https://www.gnu.org/licenses. -submodule (symba_classes) s_symba_discard +submodule (symba) s_symba_discard use swiftest contains @@ -47,13 +47,13 @@ subroutine symba_discard_cb_pl(pl, system, param) write(timestr, *) system%t write(message, *) trim(adjustl(pl%info(i)%name)) // " (" // trim(adjustl(idstr)) // ")" // & " too far from the central body at t = " // trim(adjustl(timestr)) - call io_log_one_message(FRAGGLE_LOG_OUT, "") - call io_log_one_message(FRAGGLE_LOG_OUT, "***********************************************************" // & + call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, "") + call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, "***********************************************************" // & "***********************************************************") - call io_log_one_message(FRAGGLE_LOG_OUT, message) - call io_log_one_message(FRAGGLE_LOG_OUT, "***********************************************************" // & + call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, message) + call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, "***********************************************************" // & "***********************************************************") - call io_log_one_message(FRAGGLE_LOG_OUT, "") + call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, "") 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 @@ -64,13 +64,13 @@ subroutine symba_discard_cb_pl(pl, system, param) write(timestr, *) system%t write(message, *) trim(adjustl(pl%info(i)%name)) // " (" // trim(adjustl(idstr)) // ")" // & " too close to the central body at t = " // trim(adjustl(timestr)) - call io_log_one_message(FRAGGLE_LOG_OUT, "") - call io_log_one_message(FRAGGLE_LOG_OUT, "************************************************************" // & + call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, "") + call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, "************************************************************" // & "************************************************************") - call io_log_one_message(FRAGGLE_LOG_OUT, message) - call io_log_one_message(FRAGGLE_LOG_OUT, "************************************************************" // & + call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, message) + call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, "************************************************************" // & "************************************************************") - call io_log_one_message(FRAGGLE_LOG_OUT, "") + call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, "") 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 @@ -85,13 +85,13 @@ subroutine symba_discard_cb_pl(pl, system, param) write(timestr, *) system%t write(message, *) trim(adjustl(pl%info(i)%name)) // " (" // trim(adjustl(idstr)) // ")" // & " is unbound and too far from barycenter at t = " // trim(adjustl(timestr)) - call io_log_one_message(FRAGGLE_LOG_OUT, "") - call io_log_one_message(FRAGGLE_LOG_OUT, "************************************************************" // & + call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, "") + call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, "************************************************************" // & "************************************************************") - call io_log_one_message(FRAGGLE_LOG_OUT, message) - call io_log_one_message(FRAGGLE_LOG_OUT, "************************************************************" // & + call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, message) + call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, "************************************************************" // & "************************************************************") - call io_log_one_message(FRAGGLE_LOG_OUT, "") + call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, "") 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 @@ -112,7 +112,7 @@ subroutine symba_discard_conserve_mtm(pl, system, param, ipl, lescape_body) ! Arguments class(symba_pl), intent(inout) :: pl class(symba_nbody_system), intent(inout) :: system - class(symba_parameters), intent(inout) :: param + class(swiftest_parameters), intent(inout) :: param integer(I4B), intent(in) :: ipl logical, intent(in) :: lescape_body ! Internals @@ -243,8 +243,6 @@ subroutine symba_discard_nonplpl(pl, system, param) nend = pl_discards%nbody + nsub call pl_discards%append(plsub, lsource_mask=[(.true., i = 1, nsub)]) - ! Record how many bodies were subtracted in this event - pl_discards%ncomp(nstart:nend) = nsub end if end select end associate @@ -262,7 +260,7 @@ subroutine symba_discard_nonplpl_conservation(pl, system, param) ! Arguments class(symba_pl), intent(inout) :: pl !! SyMBA test particle object class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object - class(symba_parameters), intent(inout) :: param !! Current run configuration parameters + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters ! Internals integer(I4B) :: i, ndiscard, dstat logical :: lescape @@ -357,11 +355,11 @@ module subroutine symba_discard_pl(self, system, param) select type(system) class is (symba_nbody_system) select type(param) - class is (symba_parameters) - associate(pl => self, plplenc_list => system%plplenc_list, plplcollision_list => system%plplcollision_list) + class is (swiftest_parameters) + associate(pl => self, plpl_encounter => system%plpl_encounter, plpl_collision => system%plpl_collision) call pl%vb2vh(system%cb) call pl%rh2rb(system%cb) - !call plplenc_list%write(pl, pl, param) TODO: write the encounter list writer for NetCDF + !call plpl_encounter%write(pl, pl, param) TODO: write the encounter list writer for NetCDF call symba_discard_nonplpl(self, system, param) diff --git a/src/symba/symba_drift.f90 b/src/symba/symba_drift.f90 index 767ea8b01..126196c6c 100644 --- a/src/symba/symba_drift.f90 +++ b/src/symba/symba_drift.f90 @@ -7,7 +7,7 @@ !! You should have received a copy of the GNU General Public License along with Swiftest. !! If not, see: https://www.gnu.org/licenses. - submodule (symba_classes) s_symba_drift + submodule (symba) s_symba_drift use swiftest contains diff --git a/src/symba/symba_encounter_check.f90 b/src/symba/symba_encounter_check.f90 index f53061b93..eb05f0664 100644 --- a/src/symba/symba_encounter_check.f90 +++ b/src/symba/symba_encounter_check.f90 @@ -7,7 +7,7 @@ !! You should have received a copy of the GNU General Public License along with Swiftest. !! If not, see: https://www.gnu.org/licenses. -submodule (symba_classes) s_symba_encounter_check +submodule (symba) s_symba_encounter_check use swiftest contains @@ -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, cb => system%cb) + associate(pl => self, plpl_encounter => system%plpl_encounter, cb => system%cb) npl = pl%nbody nplm = pl%nplm @@ -51,25 +51,25 @@ module function symba_encounter_check_pl(self, param, system, dt, irec) result(l lany_encounter = nenc > 0_I8B if (lany_encounter) then - call plplenc_list%resize(nenc) - call move_alloc(lvdotr, plplenc_list%lvdotr) - call move_alloc(index1, plplenc_list%index1) - call move_alloc(index2, plplenc_list%index2) + call plpl_encounter%resize(nenc) + call move_alloc(lvdotr, plpl_encounter%lvdotr) + call move_alloc(index1, plpl_encounter%index1) + call move_alloc(index2, plpl_encounter%index2) end if if (lany_encounter) then do k = 1_I8B, nenc - plplenc_list%t = system%t - i = plplenc_list%index1(k) - j = plplenc_list%index2(k) - plplenc_list%id1(k) = pl%id(i) - plplenc_list%id2(k) = pl%id(j) - plplenc_list%status(k) = ACTIVE - plplenc_list%level(k) = irec - plplenc_list%r1(:,k) = pl%rh(:,i) - plplenc_list%r2(:,k) = pl%rh(:,j) - plplenc_list%v1(:,k) = pl%vb(:,i) - cb%vb(:) - plplenc_list%v2(:,k) = pl%vb(:,j) - cb%vb(:) + plpl_encounter%t = system%t + i = plpl_encounter%index1(k) + j = plpl_encounter%index2(k) + plpl_encounter%id1(k) = pl%id(i) + plpl_encounter%id2(k) = pl%id(j) + plpl_encounter%status(k) = ACTIVE + plpl_encounter%level(k) = irec + plpl_encounter%r1(:,k) = pl%rh(:,i) + plpl_encounter%r2(:,k) = pl%rh(:,j) + plpl_encounter%v1(:,k) = pl%vb(:,i) - cb%vb(:) + plpl_encounter%v2(:,k) = pl%vb(:,j) - cb%vb(:) pl%lencounter(i) = .true. pl%lencounter(j) = .true. pl%levelg(i) = irec @@ -87,11 +87,11 @@ module function symba_encounter_check_pl(self, param, system, dt, irec) result(l end function symba_encounter_check_pl - module function symba_encounter_check(self, param, system, dt, irec) result(lany_encounter) + module function symba_encounter_io_netcdf_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 plplenc and pltpenc list. - !! Note: This method works for the polymorphic symba_pltpenc and symba_plplenc types. + !! Note: This method works for the polymorphic pltp_encounter and plpl_encounter types. !! !! Adapted from portions of David E. Kaufmann's Swifter routine: symba_step_recur.f90 implicit none @@ -114,9 +114,9 @@ module function symba_encounter_check(self, param, system, dt, irec) result(lany if (self%nenc == 0) return select type(self) - class is (symba_plplenc) + class is (plpl_encounter) isplpl = .true. - class is (symba_pltpenc) + class is (pltp_encounter) isplpl = .false. end select @@ -222,21 +222,21 @@ module function symba_encounter_check_tp(self, param, system, dt, irec) result(l lany_encounter = nenc > 0 if (lany_encounter) then - associate(pltpenc_list => system%pltpenc_list) - call pltpenc_list%resize(nenc) - pltpenc_list%status(1:nenc) = ACTIVE - pltpenc_list%level(1:nenc) = irec - call move_alloc(index1, pltpenc_list%index1) - call move_alloc(index2, pltpenc_list%index2) - call move_alloc(lvdotr, pltpenc_list%lvdotr) - pltpenc_list%id1(1:nenc) = pl%id(pltpenc_list%index1(1:nenc)) - pltpenc_list%id2(1:nenc) = tp%id(pltpenc_list%index2(1:nenc)) + associate(pltp_encounter => system%pltp_encounter) + call pltp_encounter%resize(nenc) + pltp_encounter%status(1:nenc) = ACTIVE + pltp_encounter%level(1:nenc) = irec + call move_alloc(index1, pltp_encounter%index1) + call move_alloc(index2, pltp_encounter%index2) + call move_alloc(lvdotr, pltp_encounter%lvdotr) + pltp_encounter%id1(1:nenc) = pl%id(pltp_encounter%index1(1:nenc)) + pltp_encounter%id2(1:nenc) = tp%id(pltp_encounter%index2(1:nenc)) select type(pl) class is (symba_pl) pl%lencounter(1:npl) = .false. do k = 1_I8B, nenc - plind = pltpenc_list%index1(k) - tpind = pltpenc_list%index2(k) + plind = pltp_encounter%index1(k) + tpind = pltp_encounter%index2(k) pl%lencounter(plind) = .true. pl%levelg(plind) = irec pl%levelm(plind) = irec diff --git a/src/symba/symba_gr.f90 b/src/symba/symba_gr.f90 index fea0f46d9..5457417e0 100644 --- a/src/symba/symba_gr.f90 +++ b/src/symba/symba_gr.f90 @@ -7,7 +7,7 @@ !! You should have received a copy of the GNU General Public License along with Swiftest. !! If not, see: https://www.gnu.org/licenses. -submodule(symba_classes) s_symba_gr +submodule(symba) s_symba_gr use swiftest contains diff --git a/src/symba/symba_io.f90 b/src/symba/symba_io.f90 index 29f1c1fbe..e5fdbc25d 100644 --- a/src/symba/symba_io.f90 +++ b/src/symba/symba_io.f90 @@ -7,206 +7,10 @@ !! You should have received a copy of the GNU General Public License along with Swiftest. !! If not, see: https://www.gnu.org/licenses. -submodule (symba_classes) s_symba_io +submodule (symba) s_symba_io use swiftest contains - - module subroutine symba_io_param_reader(self, unit, iotype, v_list, iostat, iomsg) - !! author: The Purdue Swiftest Team - David A. Minton, Carlisle A. Wishard, Jennifer L.L. Pouplin, and Jacob R. Elliott - !! - !! Read in parameters specific to the SyMBA integrator, then calls the base io_param_reader. - !! - !! Adapted from David E. Kaufmann's Swifter routine io_init_param.f90 - !! Adapted from Martin Duncan's Swift routine io_init_param.f - implicit none - ! Arguments - class(symba_parameters), intent(inout) :: self !! Collection of parameters - integer, intent(in) :: unit !! File unit number - character(len=*), intent(in) :: iotype !! Dummy argument passed to the input/output procedure contains the text from the char-literal-constant, prefixed with DT. - !! If you do not include a char-literal-constant, the iotype argument contains only DT. - character(len=*), intent(in) :: v_list(:) !! The first element passes the integrator code to the reader - integer, intent(out) :: iostat !! IO status code - character(len=*), intent(inout) :: iomsg !! Message to pass if iostat /= 0 - ! internals - integer(I4B) :: ilength, ifirst, ilast !! Variables used to parse input file - character(STRMAX) :: line !! Line of the input file - character (len=:), allocatable :: line_trim,param_name, param_value !! Strings used to parse the param file - integer(I4B) :: nseeds, nseeds_from_file, i - logical :: seed_set = .false. !! Is the random seed set in the input file? - character(len=*),parameter :: linefmt = '(A)' - - associate(param => self) - open(unit = unit, file = param%param_file_name, status = 'old', err = 667, iomsg = iomsg) - call random_seed(size = nseeds) - if (allocated(param%seed)) deallocate(param%seed) - allocate(param%seed(nseeds)) - do - read(unit = unit, fmt = linefmt, iostat = iostat, end = 1, err = 667, iomsg = iomsg) line - line_trim = trim(adjustl(line)) - ilength = len(line_trim) - if ((ilength /= 0)) then - ifirst = 1 - ! Read the pair of tokens. The first one is the parameter name, the second is the value. - param_name = io_get_token(line_trim, ifirst, ilast, iostat) - if (param_name == '') cycle ! No parameter name (usually because this line is commented out) - call io_toupper(param_name) - ifirst = ilast + 1 - param_value = io_get_token(line_trim, ifirst, ilast, iostat) - select case (param_name) - case ("OUT_STAT") ! We need to duplicate this from the standard io_param_reader in order to make sure that the restart flag gets set properly in SyMBA - call io_toupper(param_value) - param%out_stat = param_value - case ("FRAGMENTATION") - call io_toupper(param_value) - if (param_value == "YES" .or. param_value == "T") self%lfragmentation = .true. - case ("GMTINY") - read(param_value, *) param%GMTINY - case ("MIN_GMFRAG") - read(param_value, *) param%min_GMfrag - case ("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 - ! number of seeds than the current system. If the number of seeds in the file is smaller than required, we will use them as a source to fill in the missing elements. - ! If the number of seeds in the file is larger than required, we will truncate the seed array. - if (nseeds_from_file > nseeds) then - nseeds = nseeds_from_file - deallocate(param%seed) - allocate(param%seed(nseeds)) - do i = 1, nseeds - ifirst = ilast + 2 - param_value = io_get_token(line, ifirst, ilast, iostat) - read(param_value, *) param%seed(i) - end do - else ! Seed array in file is too small - do i = 1, nseeds_from_file - ifirst = ilast + 2 - param_value = io_get_token(line, ifirst, ilast, iostat) - read(param_value, *) param%seed(i) - end do - param%seed(nseeds_from_file+1:nseeds) = [(param%seed(1) - param%seed(nseeds_from_file) + i, & - i=nseeds_from_file+1, nseeds)] - end if - seed_set = .true. - end select - end if - end do - 1 continue - close(unit) - - param%lrestart = (param%out_stat == "APPEND") - - if (self%GMTINY < 0.0_DP) then - write(iomsg,*) "GMTINY invalid or not set: ", self%GMTINY - iostat = -1 - return - end if - - if (param%lfragmentation) then - if (seed_set) then - call random_seed(put = param%seed) - else - call random_seed(get = param%seed) - end if - if (param%min_GMfrag < 0.0_DP) param%min_GMfrag = param%GMTINY - end if - - ! All reporting of collision information in SyMBA (including mergers) is now recorded in the Fraggle logfile - call io_log_start(param, FRAGGLE_LOG_OUT, "Fraggle logfile") - - if ((param%encounter_save /= "NONE") .and. & - (param%encounter_save /= "TRAJECTORY") .and. & - (param%encounter_save /= "CLOSEST") .and. & - (param%encounter_save /= "BOTH")) then - write(iomsg,*) 'Invalid encounter_save parameter: ',trim(adjustl(param%out_type)) - write(iomsg,*) 'Valid options are NONE, TRAJECTORY, CLOSEST, or BOTH' - iostat = -1 - return - end if - - param%lenc_save_trajectory = (param%encounter_save == "TRAJECTORY") .or. (param%encounter_save == "BOTH") - param%lenc_save_closest = (param%encounter_save == "CLOSEST") .or. (param%encounter_save == "BOTH") - - ! Call the base method (which also prints the contents to screen) - call io_param_reader(param, unit, iotype, v_list, iostat, iomsg) - end associate - - iostat = 0 - - return - 667 continue - write(*,*) "Error reading SyMBA parameters in param file: ", trim(adjustl(iomsg)) - end subroutine symba_io_param_reader - - - module subroutine symba_io_param_writer(self, unit, iotype, v_list, iostat, iomsg) - !! author: David A. Minton - !! - !! Dump integration parameters specific to SyMBA to file and then call the base io_param_writer method. - !! - !! Adapted from David E. Kaufmann's Swifter routine io_dump_param.f90 - !! Adapted from Martin Duncan's Swift routine io_dump_param.f - implicit none - ! Arguments - class(symba_parameters),intent(in) :: self !! Collection of SyMBA parameters - integer, intent(in) :: unit !! File unit number - character(len=*), intent(in) :: iotype !! Dummy argument passed to the input/output procedure contains the text from the char-literal-constant, prefixed with DT. - !! If you do not include a char-literal-constant, the iotype argument contains only DT. - integer, intent(in) :: v_list(:) !! Not used in this procedure - integer, intent(out) :: iostat !! IO status code - character(len=*), intent(inout) :: iomsg !! Message to pass if iostat /= 0 - ! Internals - integer(I4B) :: nseeds - - associate(param => self) - call io_param_writer(param, unit, iotype, v_list, iostat, iomsg) - - ! Special handling is required for writing the random number seed array as its size is not known until runtime - ! For the "SEED" parameter line, the first value will be the size of the seed array and the rest will be the seed array elements - call io_param_writer_one("GMTINY",param%GMTINY, unit) - call io_param_writer_one("MIN_GMFRAG",param%min_GMfrag, unit) - call io_param_writer_one("FRAGMENTATION",param%lfragmentation, unit) - if (param%lfragmentation) then - nseeds = size(param%seed) - call io_param_writer_one("SEED", [nseeds, param%seed(:)], unit) - end if - - iostat = 0 - end associate - - return - 667 continue - write(*,*) "Error writing parameter file for SyMBA: " // trim(adjustl(iomsg)) - end subroutine symba_io_param_writer - - - module subroutine symba_io_write_discard(self, param) - !! author: David A. Minton - !! - !! Write the metadata of the discarded body to the output file - implicit none - class(symba_nbody_system), intent(inout) :: self !! SyMBA nbody system object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - ! Internals - - associate(pl => self%pl, npl => self%pl%nbody, pl_adds => self%pl_adds) - - if (self%tp_discards%nbody > 0) call self%tp_discards%write_info(param%system_history%nc, param) - select type(pl_discards => self%pl_discards) - class is (symba_merger) - if (pl_discards%nbody == 0) return - - call pl_discards%write_info(param%system_history%nc, param) - end select - end associate - - return - - end subroutine symba_io_write_discard - end submodule s_symba_io diff --git a/src/symba/symba_kick.f90 b/src/symba/symba_kick.f90 index cdad09045..5fbe3d8f6 100644 --- a/src/symba/symba_kick.f90 +++ b/src/symba/symba_kick.f90 @@ -7,7 +7,7 @@ !! You should have received a copy of the GNU General Public License along with Swiftest. !! If not, see: https://www.gnu.org/licenses. -submodule(symba_classes) s_symba_kick +submodule(symba) s_symba_kick use swiftest contains @@ -34,7 +34,7 @@ module subroutine symba_kick_getacch_int_pl(self, param) call itimer%time_this_loop(param, self%nplplm, self) lfirst = .false. else - if (itimer%check(param, self%nplplm)) call itimer%time_this_loop(param, self%nplplm, self) + if (itimer%io_netcdf_check(param, self%nplplm)) call itimer%time_this_loop(param, self%nplplm, self) end if else param%lflatten_interactions = .false. @@ -77,16 +77,16 @@ module subroutine symba_kick_getacch_pl(self, system, param, t, lbeg) if (self%nbody == 0) return select type(system) class is (symba_nbody_system) - associate(pl => self, npl => self%nbody, nplm => self%nplm, plplenc_list => system%plplenc_list, radius => self%radius) + associate(pl => self, npl => self%nbody, nplm => self%nplm, plpl_encounter => system%plpl_encounter, radius => self%radius) ! Apply kicks to all bodies (including those in the encounter list) call helio_kick_getacch_pl(pl, system, param, t, lbeg) - if (plplenc_list%nenc > 0) then + if (plpl_encounter%nenc > 0) then ! Remove kicks from bodies involved currently in the encounter list, as these are dealt with separately. ah_enc(:,:) = 0.0_DP - nplplenc = int(plplenc_list%nenc, kind=I8B) + nplplenc = int(plpl_encounter%nenc, kind=I8B) allocate(k_plpl_enc(2,nplplenc)) - k_plpl_enc(1,1:nplplenc) = plplenc_list%index1(1:nplplenc) - k_plpl_enc(2,1:nplplenc) = plplenc_list%index2(1:nplplenc) + k_plpl_enc(1,1:nplplenc) = plpl_encounter%index1(1:nplplenc) + k_plpl_enc(2,1:nplplenc) = plpl_encounter%index2(1:nplplenc) 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 @@ -121,17 +121,17 @@ module subroutine symba_kick_getacch_tp(self, system, param, t, lbeg) select type(system) class is (symba_nbody_system) associate(tp => self, cb => system%cb, pl => system%pl, & - pltpenc_list => system%pltpenc_list, npltpenc => system%pltpenc_list%nenc) + pltp_encounter => system%pltp_encounter, npltpenc => system%pltp_encounter%nenc) call helio_kick_getacch_tp(tp, system, param, t, lbeg) ! Remove accelerations from encountering pairs do k = 1, npltpenc - i = pltpenc_list%index1(k) - j = pltpenc_list%index2(k) + i = pltp_encounter%index1(k) + j = pltp_encounter%index2(k) if (tp%lmask(j)) then if (lbeg) then dx(:) = tp%rh(:,j) - pl%rbeg(:,i) else - dx(:) = tp%rh(:,j) - pl%xend(:,i) + dx(:) = tp%rh(:,j) - pl%rend(:,i) end if rjj = dot_product(dx(:), dx(:)) fac = pl%Gmass(i) / (rjj * sqrt(rjj)) @@ -148,7 +148,7 @@ module subroutine symba_kick_encounter(self, system, dt, irec, sgn) !! author: David A. Minton !! !! Kick barycentric velocities of massive bodies and ACTIVE test particles within SyMBA recursion. - !! Note: This method works for the polymorphic symba_pltpenc and symba_plplenc types + !! Note: This method works for the polymorphic pltp_encounter and plpl_encounter types !! !! Adapted from David E. Kaufmann's Swifter routine: symba_kick.f90 !! Adapted from Hal Levison's Swift routine symba5_kick.f @@ -171,9 +171,9 @@ module subroutine symba_kick_encounter(self, system, dt, irec, sgn) if (self%nenc == 0) return select type(self) - class is (symba_plplenc) + class is (plpl_encounter) isplpl = .true. - class is (symba_pltpenc) + class is (pltp_encounter) isplpl = .false. end select select type(pl => system%pl) diff --git a/src/symba/symba_setup.f90 b/src/symba/symba_setup.f90 index 9a4ace98f..efd60f636 100644 --- a/src/symba/symba_setup.f90 +++ b/src/symba/symba_setup.f90 @@ -7,7 +7,7 @@ !! You should have received a copy of the GNU General Public License along with Swiftest. !! If not, see: https://www.gnu.org/licenses. -submodule(symba_classes) s_symba_setup +submodule(symba) s_symba_setup use swiftest contains @@ -25,42 +25,15 @@ module subroutine symba_setup_initialize_system(self, param) ! Call parent method associate(system => self) call helio_setup_initialize_system(system, param) - call system%pltpenc_list%setup(0_I8B) - call system%plplenc_list%setup(0_I8B) - call system%plplcollision_list%setup(0_I8B) + call system%pltp_encounter%setup(0_I8B) + call system%plpl_encounter%setup(0_I8B) + call system%plpl_collision%setup(0_I8B) end associate return end subroutine symba_setup_initialize_system - module subroutine symba_setup_merger(self, n, param) - !! author: David A. Minton - !! - !! Allocate SyMBA test particle structure - !! - !! Equivalent in functionality to David E. Kaufmann's Swifter routine symba_setup.f90 - implicit none - ! Arguments - class(symba_merger), intent(inout) :: self !! SyMBA merger list object - integer(I4B), intent(in) :: n !! Number of particles to allocate space for - class(swiftest_parameters), intent(in) :: param !! Current run configuration parameter - - !> Call allocation method for parent class. In this case, helio_pl does not have its own setup method so we use the base method for swiftest_pl - call symba_setup_pl(self, n, param) - if (n < 0) return - - if (allocated(self%ncomp)) deallocate(self%ncomp) - - if (n == 0) return - - allocate(self%ncomp(n)) - self%ncomp(:) = 0 - - return - end subroutine symba_setup_merger - - module subroutine symba_setup_pl(self, n, param) !! author: David A. Minton !! @@ -79,11 +52,6 @@ module subroutine symba_setup_pl(self, n, param) call setup_pl(self, n, param) if (n == 0) return - allocate(self%lcollision(n)) - allocate(self%lencounter(n)) - allocate(self%lmtiny(n)) - allocate(self%nplenc(n)) - allocate(self%ntpenc(n)) allocate(self%levelg(n)) allocate(self%levelm(n)) allocate(self%isperi(n)) @@ -91,11 +59,7 @@ module subroutine symba_setup_pl(self, n, param) allocate(self%atp(n)) allocate(self%kin(n)) - self%lcollision(:) = .false. - self%lencounter(:) = .false. - self%lmtiny(:) = .false. - self%nplenc(:) = 0 - self%ntpenc(:) = 0 + self%levelg(:) = -1 self%levelm(:) = -1 self%isperi(:) = 0 @@ -147,11 +111,9 @@ module subroutine symba_setup_tp(self, n, param) call setup_tp(self, n, param) if (n == 0) return - allocate(self%nplenc(n)) allocate(self%levelg(n)) allocate(self%levelm(n)) - self%nplenc(:) = 0 self%levelg(:) = -1 self%levelm(:) = -1 diff --git a/src/symba/symba_step.f90 b/src/symba/symba_step.f90 index 68645d7b8..d51f66d89 100644 --- a/src/symba/symba_step.f90 +++ b/src/symba/symba_step.f90 @@ -7,7 +7,7 @@ !! You should have received a copy of the GNU General Public License along with Swiftest. !! If not, see: https://www.gnu.org/licenses. -submodule (symba_classes) s_symba_step +submodule (symba) s_symba_step use swiftest contains @@ -33,7 +33,7 @@ module subroutine symba_step_system(self, param, t, dt) select type(tp => self%tp) class is (symba_tp) select type(param) - class is (symba_parameters) + class is (swiftest_parameters) associate(encounter_history => param%encounter_history) call self%reset(param) lencounter = pl%encounter_check(param, self, dt, 0) .or. tp%encounter_check(param, self, dt, 0) @@ -132,7 +132,7 @@ module subroutine symba_step_set_recur_levels_system(self, ireci) ! Internals integer(I4B) :: irecp - associate(system => self, plplenc_list => self%plplenc_list, pltpenc_list => self%pltpenc_list, & + associate(system => self, plpl_encounter => self%plpl_encounter, pltp_encounter => self%pltp_encounter, & npl => self%pl%nbody, ntp => self%tp%nbody) select type(pl => self%pl) class is (symba_pl) @@ -142,14 +142,14 @@ module subroutine symba_step_set_recur_levels_system(self, ireci) if (npl >0) where(pl%levelg(1:npl) == irecp) pl%levelg(1:npl) = ireci if (ntp > 0) where(tp%levelg(1:ntp) == irecp) tp%levelg(1:ntp) = ireci - if (plplenc_list%nenc > 0) then - where(plplenc_list%level(1:plplenc_list%nenc) == irecp) - plplenc_list%level(1:plplenc_list%nenc) = ireci + if (plpl_encounter%nenc > 0) then + where(plpl_encounter%level(1:plpl_encounter%nenc) == irecp) + plpl_encounter%level(1:plpl_encounter%nenc) = ireci endwhere end if - if (pltpenc_list%nenc > 0) then - where(pltpenc_list%level(1:pltpenc_list%nenc) == irecp) - pltpenc_list%level(1:pltpenc_list%nenc) = ireci + if (pltp_encounter%nenc > 0) then + where(pltp_encounter%level(1:pltp_encounter%nenc) == irecp) + pltp_encounter%level(1:pltp_encounter%nenc) = ireci endwhere end if @@ -183,13 +183,13 @@ recursive module subroutine symba_step_recur_system(self, param, t, ireci) logical :: lencounter select type(param) - class is (symba_parameters) + class is (swiftest_parameters) select type(pl => self%pl) class is (symba_pl) select type(tp => self%tp) class is (symba_tp) - associate(system => self, plplenc_list => self%plplenc_list, pltpenc_list => self%pltpenc_list, & - lplpl_collision => self%plplenc_list%lcollision, lpltp_collision => self%pltpenc_list%lcollision, & + associate(system => self, plpl_encounter => self%plpl_encounter, pltp_encounter => self%pltp_encounter, & + lplpl_collision => self%plpl_encounter%lcollision, lpltp_collision => self%pltp_encounter%lcollision, & encounter_history => param%encounter_history) system%irec = ireci dtl = param%dt / (NTENC**ireci) @@ -207,14 +207,14 @@ recursive module subroutine symba_step_recur_system(self, param, t, ireci) nloops = NTENC end if do j = 1, nloops - lencounter = plplenc_list%encounter_check(param, system, dtl, irecp) & - .or. pltpenc_list%encounter_check(param, system, dtl, irecp) + lencounter = plpl_encounter%encounter_check(param, system, dtl, irecp) & + .or. pltp_encounter%encounter_check(param, system, dtl, irecp) - call plplenc_list%kick(system, dth, irecp, 1) - call pltpenc_list%kick(system, dth, irecp, 1) + call plpl_encounter%kick(system, dth, irecp, 1) + call pltp_encounter%kick(system, dth, irecp, 1) if (ireci /= 0) then - call plplenc_list%kick(system, dth, irecp, -1) - call pltpenc_list%kick(system, dth, irecp, -1) + call plpl_encounter%kick(system, dth, irecp, -1) + call pltp_encounter%kick(system, dth, irecp, -1) end if if (param%lgr) then @@ -233,19 +233,19 @@ recursive module subroutine symba_step_recur_system(self, param, t, ireci) call tp%gr_pos_kick(system, param, dth) end if - call plplenc_list%kick(system, dth, irecp, 1) - call pltpenc_list%kick(system, dth, irecp, 1) + call plpl_encounter%kick(system, dth, irecp, 1) + call pltp_encounter%kick(system, dth, irecp, 1) if (ireci /= 0) then - call plplenc_list%kick(system, dth, irecp, -1) - call pltpenc_list%kick(system, dth, irecp, -1) + call plpl_encounter%kick(system, dth, irecp, -1) + call pltp_encounter%kick(system, dth, irecp, -1) end if if (param%lclose) then - call plplenc_list%collision_check(system, param, t+j*dtl, dtl, ireci, lplpl_collision) - call pltpenc_list%collision_check(system, param, t+j*dtl, dtl, ireci, lpltp_collision) + call plpl_encounter%collision_io_netcdf_check(system, param, t+j*dtl, dtl, ireci, lplpl_collision) + call pltp_encounter%collision_io_netcdf_check(system, param, t+j*dtl, dtl, ireci, lpltp_collision) - if (lplpl_collision) call plplenc_list%resolve_collision(system, param, t+j*dtl, dtl, ireci) - if (lpltp_collision) call pltpenc_list%resolve_collision(system, param, t+j*dtl, dtl, ireci) + if (lplpl_collision) call plpl_encounter%resolve_collision(system, param, t+j*dtl, dtl, ireci) + if (lpltp_collision) call pltp_encounter%resolve_collision(system, param, t+j*dtl, dtl, ireci) end if if (param%lenc_save_trajectory) call encounter_history%take_snapshot(param, self, t+j*dtl, "trajectory") @@ -271,7 +271,7 @@ module subroutine symba_step_reset_system(self, param) implicit none ! Arguments class(symba_nbody_system), intent(inout) :: self !! SyMBA nbody system object - class(symba_parameters), intent(in) :: param !! Current run configuration parameters with SyMBA additions + class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters with SyMBA additions ! Internals integer(I4B) :: i integer(I8B) :: nenc_old @@ -282,9 +282,9 @@ module subroutine symba_step_reset_system(self, param) select type(tp => system%tp) class is (symba_tp) associate(npl => pl%nbody, ntp => tp%nbody) - nenc_old = system%plplenc_list%nenc - call system%plplenc_list%setup(0_I8B) - call system%plplcollision_list%setup(0_I8B) + nenc_old = system%plpl_encounter%nenc + call system%plpl_encounter%setup(0_I8B) + call system%plpl_collision%setup(0_I8B) if (npl > 0) then pl%lcollision(1:npl) = .false. call pl%reset_kinship([(i, i=1, npl)]) @@ -297,22 +297,22 @@ module subroutine symba_step_reset_system(self, param) pl%ldiscard(1:npl) = .false. pl%lmask(1:npl) = .true. call pl%set_renc(0) - call system%plplenc_list%setup(nenc_old) ! This resizes the pl-pl encounter list to be the same size as it was the last step, to decrease the number of potential resize operations that have to be one inside the step - system%plplenc_list%nenc = 0 ! Sets the true number of encounters back to 0 after resizing - system%plplenc_list%lcollision = .false. + call system%plpl_encounter%setup(nenc_old) ! This resizes the pl-pl encounter list to be the same size as it was the last step, to decrease the number of potential resize operations that have to be one inside the step + system%plpl_encounter%nenc = 0 ! Sets the true number of encounters back to 0 after resizing + system%plpl_encounter%lcollision = .false. end if - nenc_old = system%pltpenc_list%nenc - call system%pltpenc_list%setup(0_I8B) + nenc_old = system%pltp_encounter%nenc + call system%pltp_encounter%setup(0_I8B) if (ntp > 0) then tp%nplenc(1:ntp) = 0 tp%levelg(1:ntp) = -1 tp%levelm(1:ntp) = -1 tp%lmask(1:ntp) = .true. tp%ldiscard(1:ntp) = .false. - call system%pltpenc_list%setup(nenc_old)! This resizes the pl-tp encounter list to be the same size as it was the last step, to decrease the number of potential resize operations that have to be one inside the step - system%pltpenc_list%nenc = 0 ! Sets the true number of encounters back to 0 after resizing - system%pltpenc_list%lcollision = .false. + call system%pltp_encounter%setup(nenc_old)! This resizes the pl-tp encounter list to be the same size as it was the last step, to decrease the number of potential resize operations that have to be one inside the step + system%pltp_encounter%nenc = 0 ! Sets the true number of encounters back to 0 after resizing + system%pltp_encounter%lcollision = .false. end if call system%pl_adds%setup(0, param) diff --git a/src/symba/symba_util.f90 b/src/symba/symba_util.f90 index cf817622e..f4b143c3d 100644 --- a/src/symba/symba_util.f90 +++ b/src/symba/symba_util.f90 @@ -7,39 +7,11 @@ !! You should have received a copy of the GNU General Public License along with Swiftest. !! If not, see: https://www.gnu.org/licenses. -submodule(symba_classes) s_symba_util +submodule(symba) s_symba_util use swiftest contains - module subroutine symba_util_append_arr_kin(arr, source, nold, nsrc, lsource_mask) - !! author: David A. Minton - !! - !! Append a single array of kinship type onto another. If the destination array is not allocated, or is not big enough, this will allocate space for it. - implicit none - ! Arguments - type(symba_kinship), dimension(:), allocatable, intent(inout) :: arr !! Destination array - type(symba_kinship), dimension(:), allocatable, intent(in) :: source !! Array to append - integer(I4B), intent(in) :: nold, nsrc !! Extend of the old array and the source array, respectively - logical, dimension(:), intent(in) :: lsource_mask !! Logical mask indicating which elements to append to - ! Internals - integer(I4B) :: nnew - - if (.not. allocated(source)) return - - nnew = count(lsource_mask(1:nsrc)) - if (.not.allocated(arr)) then - allocate(arr(nold+nnew)) - else - call util_resize(arr, nold + nnew) - end if - - arr(nold + 1:nold + nnew) = pack(source(1:nsrc), lsource_mask(1:nsrc)) - - return - end subroutine symba_util_append_arr_kin - - module subroutine symba_util_append_encounter_list(self, source, lsource_mask) !! author: David A. Minton !! @@ -210,20 +182,6 @@ module subroutine symba_util_dealloc_encounter_list(self) end subroutine symba_util_dealloc_encounter_list - module subroutine symba_util_dealloc_kin(self) - !! author: David A. Minton - !! - !! Deallocates all allocatabale arrays - implicit none - ! Arguments - class(symba_kinship), intent(inout) :: self !! SyMBA kinship object - - if (allocated(self%child)) deallocate(self%child) - - return - end subroutine symba_util_dealloc_kin - - module subroutine symba_util_dealloc_merger(self) !! author: David A. Minton !! @@ -250,24 +208,12 @@ module subroutine symba_util_dealloc_pl(self) ! Internals integer(I4B) :: i - if (allocated(self%lcollision)) deallocate(self%lcollision) - if (allocated(self%lencounter)) deallocate(self%lencounter) - if (allocated(self%lmtiny)) deallocate(self%lmtiny) - if (allocated(self%nplenc)) deallocate(self%nplenc) - if (allocated(self%ntpenc)) deallocate(self%ntpenc) if (allocated(self%levelg)) deallocate(self%levelg) if (allocated(self%levelm)) deallocate(self%levelm) if (allocated(self%isperi)) deallocate(self%isperi) if (allocated(self%peri)) deallocate(self%peri) if (allocated(self%atp)) deallocate(self%atp) - if (allocated(self%kin)) then - do i = 1, self%nbody - call self%kin(i)%dealloc() - end do - deallocate(self%kin) - end if - call self%helio_pl%dealloc() return @@ -282,7 +228,6 @@ module subroutine symba_util_dealloc_tp(self) ! Arguments class(symba_tp), intent(inout) :: self !! SyMBA test particle object - if (allocated(self%nplenc)) deallocate(self%nplenc) if (allocated(self%levelg)) deallocate(self%levelg) if (allocated(self%levelm)) deallocate(self%levelm) @@ -292,26 +237,6 @@ module subroutine symba_util_dealloc_tp(self) end subroutine symba_util_dealloc_tp - module subroutine symba_util_fill_arr_kin(keeps, inserts, lfill_list) - !! author: David A. Minton - !! - !! Performs a fill operation on a single array of particle kinship types - !! This is the inverse of a spill operation - implicit none - ! Arguments - type(symba_kinship), dimension(:), allocatable, intent(inout) :: keeps !! Array of values to keep - type(symba_kinship), dimension(:), allocatable, intent(in) :: inserts !! Array of values to insert into keep - logical, dimension(:), intent(in) :: lfill_list !! Logical array of bodies to merge into the keeps - - if (.not.allocated(keeps) .or. .not.allocated(inserts)) return - - keeps(:) = unpack(keeps(:), .not.lfill_list(:), keeps(:)) - keeps(:) = unpack(inserts(:), lfill_list(:), keeps(:)) - - return - end subroutine symba_util_fill_arr_kin - - module subroutine symba_util_fill_pl(self, inserts, lfill_list) !! author: David A. Minton !! @@ -401,7 +326,7 @@ module subroutine symba_util_flatten_eucl_plpl(self, param) associate(pl => self, nplplm => self%nplplm) npl = int(self%nbody, kind=I8B) select type(param) - class is (symba_parameters) + class is (swiftest_parameters) pl%lmtiny(1:npl) = pl%Gmass(1:npl) < param%GMTINY end select nplm = count(.not. pl%lmtiny(1:npl)) @@ -428,18 +353,6 @@ module subroutine symba_util_final_encounter_list(self) return end subroutine symba_util_final_encounter_list - module subroutine symba_util_final_kin(self) - !! author: David A. Minton - !! - !! Finalize the SyMBA kinship object - deallocates all allocatables - implicit none - ! Argument - type(symba_kinship), intent(inout) :: self !! SyMBA kinship object - - call self%dealloc() - - return - end subroutine symba_util_final_kin module subroutine symba_util_final_merger(self) !! author: David A. Minton @@ -478,9 +391,9 @@ module subroutine symba_util_final_system(self) type(symba_nbody_system), intent(inout) :: self !! SyMBA nbody system object if (allocated(self%pl_adds)) deallocate(self%pl_adds) - if (allocated(self%pltpenc_list)) deallocate(self%pltpenc_list) - if (allocated(self%plplenc_list)) deallocate(self%plplenc_list) - if (allocated(self%plplcollision_list)) deallocate(self%plplcollision_list) + if (allocated(self%pltp_encounter)) deallocate(self%pltp_encounter) + if (allocated(self%plpl_encounter)) deallocate(self%plpl_encounter) + if (allocated(self%plpl_collision)) deallocate(self%plpl_collision) call helio_util_final_system(self%helio_nbody_system) @@ -502,348 +415,6 @@ module subroutine symba_util_final_tp(self) end subroutine symba_util_final_tp - module subroutine symba_util_peri_pl(self, system, param) - !! author: David A. Minton - !! - !! Determine system pericenter passages for planets in SyMBA - !! - !! Adapted from David E. Kaufmann's Swifter routine: symba_peri.f90 - !! Adapted from Hal Levison's Swift routine util_mass_peri.f - implicit none - ! Arguments - class(symba_pl), intent(inout) :: self !! SyMBA massive body object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object - class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters - ! Internals - integer(I4B) :: i - real(DP) :: vdotr, e - - associate(pl => self, npl => self%nbody) - if (pl%lfirst) then - if (param%qmin_coord == "HELIO") then - do i = 1, npl - if (pl%status(i) == ACTIVE) then - vdotr = dot_product(pl%rh(:,i), pl%vh(:,i)) - if (vdotr > 0.0_DP) then - pl%isperi(i) = 1 - else - pl%isperi(i) = -1 - end if - end if - end do - else - do i = 1, npl - if (pl%status(i) == ACTIVE) then - vdotr = dot_product(pl%rb(:,i), pl%vb(:,i)) - if (vdotr > 0.0_DP) then - pl%isperi(i) = 1 - else - pl%isperi(i) = -1 - end if - end if - end do - end if - else - if (param%qmin_coord == "HELIO") then - do i = 1, npl - if (pl%status(i) == ACTIVE) then - vdotr = dot_product(pl%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%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 - if (vdotr > 0.0_DP) then - pl%isperi(i) = 1 - else - pl%isperi(i) = -1 - end if - end if - end if - end do - else - do i = 1, npl - if (pl%status(i) == ACTIVE) then - vdotr = dot_product(pl%rb(:,i), pl%vb(:,i)) - if (pl%isperi(i) == -1) then - if (vdotr >= 0.0_DP) then - pl%isperi(i) = 0 - CALL orbel_xv2aeq(system%Gmtot, pl%rb(1,i), pl%rb(2,i), pl%rb(3,i), pl%vb(1,i), pl%vb(2,i), pl%vb(3,i),& - pl%atp(i), e, pl%peri(i)) - end if - else - if (vdotr > 0.0_DP) then - pl%isperi(i) = 1 - else - pl%isperi(i) = -1 - end if - end if - end if - end do - end if - end if - end associate - - return - end subroutine symba_util_peri_pl - - - module subroutine symba_util_rearray_pl(self, system, param) - !! Author: the Purdue Swiftest Team - David A. Minton, Carlisle A. Wishard, Jennifer L.L. Pouplin, and Jacob R. Elliott - !! - !! Clean up the massive body structures to remove discarded bodies and add new bodies - implicit none - ! Arguments - class(symba_pl), intent(inout) :: self !! SyMBA massive body object - class(symba_nbody_system), intent(inout) :: system !! Swiftest nbody system object - class(symba_parameters), intent(inout) :: param !! Current run configuration parameters - ! Internals - class(symba_pl), allocatable :: tmp !! The discarded body list. - integer(I4B) :: i, k, npl, nadd, nencmin, nenc_old, idnew1, idnew2, idold1, idold2 - logical, dimension(:), allocatable :: lmask, ldump_mask - class(symba_plplenc), allocatable :: plplenc_old - logical :: lencounter - integer(I4B), dimension(:), allocatable :: levelg_orig_pl, levelm_orig_pl, levelg_orig_tp, levelm_orig_tp - integer(I4B), dimension(:), allocatable :: nplenc_orig_pl, nplenc_orig_tp, ntpenc_orig_pl - - associate(pl => self, pl_adds => system%pl_adds) - - npl = pl%nbody - nadd = pl_adds%nbody - if (npl == 0) return - ! Deallocate any temporary variables - if (allocated(pl%rbeg)) deallocate(pl%rbeg) - if (allocated(pl%xend)) deallocate(pl%xend) - - ! Remove the discards and destroy the list, as the system already tracks pl_discards elsewhere - allocate(lmask(npl)) - lmask(1:npl) = pl%ldiscard(1:npl) - if (count(lmask(:)) > 0) then - allocate(tmp, mold=self) - call pl%spill(tmp, lspill_list=lmask, ldestructive=.true.) - npl = pl%nbody - call tmp%setup(0,param) - deallocate(tmp) - deallocate(lmask) - end if - - ! Store the original plplenc list so we don't remove any of the original encounters - nenc_old = system%plplenc_list%nenc - if (nenc_old > 0) then - allocate(plplenc_old, source=system%plplenc_list) - call plplenc_old%copy(system%plplenc_list) - end if - - ! Add in any new bodies - if (nadd > 0) then - ! Append the adds to the main pl object - call pl%append(pl_adds, lsource_mask=[(.true., i=1, nadd)]) - - allocate(ldump_mask(npl+nadd)) ! This mask is used only to append the original Fortran binary particle.dat file with new bodies. This is ignored for NetCDF output - ldump_mask(1:npl) = .false. - ldump_mask(npl+1:npl+nadd) = pl%status(npl+1:npl+nadd) == NEW_PARTICLE - npl = pl%nbody - else - allocate(ldump_mask(npl)) - ldump_mask(:) = .false. - end if - - ! Reset all of the status flags for this body - pl%status(1:npl) = ACTIVE - do i = 1, npl - call pl%info(i)%set_value(status="ACTIVE") - end do - pl%ldiscard(1:npl) = .false. - pl%lcollision(1:npl) = .false. - pl%lmask(1:npl) = .true. - - pl%lmtiny(1:npl) = pl%Gmass(1:npl) < param%GMTINY - where(pl%lmtiny(1:npl)) - pl%info(1:npl)%particle_type = PL_TINY_TYPE_NAME - elsewhere - pl%info(1:npl)%particle_type = PL_TYPE_NAME - end where - - call pl%write_info(param%system_history%nc, param) - deallocate(ldump_mask) - - ! Reindex the new list of bodies - call pl%sort("mass", ascending=.false.) - call pl%flatten(param) - - ! Reset the kinship trackers - call pl%reset_kinship([(i, i=1, npl)]) - - ! Re-build the zero-level encounter list, being sure to save the original level information for all bodies - allocate(levelg_orig_pl, source=pl%levelg) - allocate(levelm_orig_pl, source=pl%levelm) - allocate(nplenc_orig_pl, source=pl%nplenc) - lencounter = pl%encounter_check(param, system, param%dt, system%irec) - if (system%tp%nbody > 0) then - select type(tp => system%tp) - class is (symba_tp) - allocate(ntpenc_orig_pl, source=pl%ntpenc) - allocate(levelg_orig_tp, source=tp%levelg) - allocate(levelm_orig_tp, source=tp%levelm) - allocate(nplenc_orig_tp, source=tp%nplenc) - lencounter = tp%encounter_check(param, system, param%dt, system%irec) - call move_alloc(levelg_orig_tp, tp%levelg) - call move_alloc(levelm_orig_tp, tp%levelm) - call move_alloc(nplenc_orig_tp, tp%nplenc) - call move_alloc(ntpenc_orig_pl, pl%ntpenc) - end select - end if - call move_alloc(levelg_orig_pl, pl%levelg) - call move_alloc(levelm_orig_pl, pl%levelm) - call move_alloc(nplenc_orig_pl, pl%nplenc) - - ! Re-index the encounter list as the index values may have changed - if (nenc_old > 0) then - nencmin = min(system%plplenc_list%nenc, plplenc_old%nenc) - system%plplenc_list%nenc = nencmin - do k = 1, nencmin - idnew1 = system%plplenc_list%id1(k) - idnew2 = system%plplenc_list%id2(k) - idold1 = plplenc_old%id1(k) - idold2 = plplenc_old%id2(k) - if ((idnew1 == idold1) .and. (idnew2 == idold2)) then - ! This is an encounter we already know about, so save the old information - system%plplenc_list%lvdotr(k) = plplenc_old%lvdotr(k) - system%plplenc_list%lclosest(k) = plplenc_old%lclosest(k) - system%plplenc_list%status(k) = plplenc_old%status(k) - system%plplenc_list%r1(:,k) = plplenc_old%r1(:,k) - system%plplenc_list%r2(:,k) = plplenc_old%r2(:,k) - system%plplenc_list%v1(:,k) = plplenc_old%v1(:,k) - system%plplenc_list%v2(:,k) = plplenc_old%v2(:,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%lclosest(k) = plplenc_old%lclosest(k) - system%plplenc_list%status(k) = plplenc_old%status(k) - system%plplenc_list%r1(:,k) = plplenc_old%r2(:,k) - system%plplenc_list%r2(:,k) = plplenc_old%r1(:,k) - system%plplenc_list%v1(:,k) = plplenc_old%v2(:,k) - system%plplenc_list%v2(:,k) = plplenc_old%v1(:,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) - system%plplenc_list%index2(k) = findloc(pl%id(1:npl), system%plplenc_list%id2(k), dim=1) - end do - if (allocated(lmask)) deallocate(lmask) - allocate(lmask(nencmin)) - nenc_old = nencmin - if (any(system%plplenc_list%index1(1:nencmin) == 0) .or. any(system%plplenc_list%index2(1:nencmin) == 0)) then - lmask(:) = system%plplenc_list%index1(1:nencmin) /= 0 .and. system%plplenc_list%index2(1:nencmin) /= 0 - else - return - end if - nencmin = count(lmask(:)) - system%plplenc_list%nenc = nencmin - if (nencmin > 0) then - system%plplenc_list%index1(1:nencmin) = pack(system%plplenc_list%index1(1:nenc_old), lmask(1:nenc_old)) - system%plplenc_list%index2(1:nencmin) = pack(system%plplenc_list%index2(1:nenc_old), lmask(1:nenc_old)) - system%plplenc_list%id1(1:nencmin) = pack(system%plplenc_list%id1(1:nenc_old), lmask(1:nenc_old)) - system%plplenc_list%id2(1:nencmin) = pack(system%plplenc_list%id2(1:nenc_old), lmask(1:nenc_old)) - system%plplenc_list%lvdotr(1:nencmin) = pack(system%plplenc_list%lvdotr(1:nenc_old), lmask(1:nenc_old)) - system%plplenc_list%lclosest(1:nencmin) = pack(system%plplenc_list%lclosest(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%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%r1(i, 1:nencmin) = pack(system%plplenc_list%r1(i, 1:nenc_old), lmask(1:nenc_old)) - system%plplenc_list%r2(i, 1:nencmin) = pack(system%plplenc_list%r2(i, 1:nenc_old), lmask(1:nenc_old)) - system%plplenc_list%v1(i, 1:nencmin) = pack(system%plplenc_list%v1(i, 1:nenc_old), lmask(1:nenc_old)) - system%plplenc_list%v2(i, 1:nencmin) = pack(system%plplenc_list%v2(i, 1:nenc_old), lmask(1:nenc_old)) - end do - end if - end if - end associate - - return - end subroutine symba_util_rearray_pl - - - module subroutine symba_util_reset_kinship(self, idx) - !! author: David A. Minton - !! - !! Resets the kinship status of bodies. - !! - implicit none - class(symba_pl), intent(inout) :: self !! SyMBA massive body object - integer(I4B), dimension(:), intent(in) :: idx !! Index array of bodies to reset - ! Internals - integer(I4B) :: i, j - - self%kin(idx(:))%parent = idx(:) - self%kin(idx(:))%nchild = 0 - do j = 1, size(idx(:)) - i = idx(j) - if (allocated(self%kin(i)%child)) deallocate(self%kin(i)%child) - end do - - return - end subroutine symba_util_reset_kinship - - - module subroutine symba_util_resize_arr_kin(arr, nnew) - !! author: David A. Minton - !! - !! Resizes an array component of type character string. Array will only be resized if has previously been allocated. Passing nnew = 0 will deallocate. - implicit none - ! Arguments - type(symba_kinship), dimension(:), allocatable, intent(inout) :: arr !! Array to resize - integer(I4B), intent(in) :: nnew !! New size - ! Internals - type(symba_kinship), dimension(:), allocatable :: tmp !! Temporary storage array in case the input array is already allocated - integer(I4B) :: nold !! Old size - - if (nnew < 0) return - - if (nnew == 0) then - if (allocated(arr)) deallocate(arr) - return - end if - - if (allocated(arr)) then - nold = size(arr) - else - nold = 0 - end if - - allocate(tmp(nnew)) - if (nnew > nold) then - tmp(1:nold) = arr(1:nold) - else - tmp(1:nnew) = arr(1:nnew) - end if - call move_alloc(tmp, arr) - - return - end subroutine symba_util_resize_arr_kin - - - module subroutine symba_util_resize_merger(self, nnew) - !! author: David A. Minton - !! - !! Checks the current size of a SyMBA merger list against the requested size and resizes it if it is too small. - implicit none - ! Arguments - class(symba_merger), intent(inout) :: self !! SyMBA massive body object - integer(I4B), intent(in) :: nnew !! New size neded - - call util_resize(self%ncomp, nnew) - - call symba_util_resize_pl(self, nnew) - - return - end subroutine symba_util_resize_merger - - module subroutine symba_util_resize_pl(self, nnew) !! author: David A. Minton !! @@ -853,17 +424,11 @@ module subroutine symba_util_resize_pl(self, nnew) class(symba_pl), intent(inout) :: self !! SyMBA massive body object integer(I4B), intent(in) :: nnew !! New size neded - call util_resize(self%lcollision, nnew) - call util_resize(self%lencounter, nnew) - call util_resize(self%lmtiny, nnew) - call util_resize(self%nplenc, nnew) - call util_resize(self%ntpenc, nnew) call util_resize(self%levelg, nnew) call util_resize(self%levelm, nnew) call util_resize(self%isperi, nnew) call util_resize(self%peri, nnew) call util_resize(self%atp, nnew) - call util_resize(self%kin, nnew) call util_resize_pl(self, nnew) @@ -879,7 +444,6 @@ module subroutine symba_util_resize_tp(self, nnew) class(symba_tp), intent(inout) :: self !! SyMBA test particle object integer(I4B), intent(in) :: nnew !! New size neded - call util_resize(self%nplenc, nnew) call util_resize(self%levelg, nnew) call util_resize(self%levelm, nnew) @@ -1006,35 +570,6 @@ module subroutine symba_util_sort_tp(self, sortby, ascending) end subroutine symba_util_sort_tp - - module subroutine symba_util_sort_rearrange_arr_kin(arr, ind, n) - !! author: David A. Minton - !! - !! Rearrange a single array of particle kinship type in-place from an index list. - implicit none - ! Arguments - type(symba_kinship), dimension(:), allocatable, intent(inout) :: arr !! Destination array - integer(I4B), dimension(:), intent(in) :: ind !! Index to rearrange against - integer(I4B), intent(in) :: n !! Number of elements in arr and ind to rearrange - ! Internals - type(symba_kinship), dimension(:), allocatable :: tmp !! Temporary copy of array used during rearrange operation - integer(I4B) :: i,j - - if (.not. allocated(arr) .or. n <= 0) return - allocate(tmp, source=arr) - tmp(1:n) = arr(ind(1:n)) - - do i = 1, n - do j = 1, tmp(i)%nchild - tmp(i)%child(j) = ind(tmp(i)%child(j)) - end do - end do - - call move_alloc(tmp, arr) - return - end subroutine symba_util_sort_rearrange_arr_kin - - module subroutine symba_util_sort_rearrange_pl(self, ind) !! author: David A. Minton !! @@ -1046,18 +581,8 @@ module subroutine symba_util_sort_rearrange_pl(self, ind) integer(I4B), dimension(:), intent(in) :: ind !! Index array used to restructure the body (should contain all 1:n index values in the desired order) associate(pl => self, npl => self%nbody) - call util_sort_rearrange(pl%lcollision, ind, npl) - call util_sort_rearrange(pl%lencounter, ind, npl) - call util_sort_rearrange(pl%lmtiny, ind, npl) - call util_sort_rearrange(pl%nplenc, ind, npl) - call util_sort_rearrange(pl%ntpenc, ind, npl) call util_sort_rearrange(pl%levelg, ind, npl) call util_sort_rearrange(pl%levelm, ind, npl) - call util_sort_rearrange(pl%isperi, ind, npl) - call util_sort_rearrange(pl%peri, ind, npl) - call util_sort_rearrange(pl%atp, ind, npl) - call util_sort_rearrange(pl%kin, ind, npl) - call util_sort_rearrange_pl(pl,ind) end associate @@ -1087,46 +612,6 @@ module subroutine symba_util_sort_rearrange_tp(self, ind) end subroutine symba_util_sort_rearrange_tp - module subroutine symba_util_spill_arr_kin(keeps, discards, lspill_list, ldestructive) - !! author: David A. Minton - !! - !! Performs a spill operation on a single array of particle kinships - !! This is the inverse of a spill operation - implicit none - ! Arguments - type(symba_kinship), dimension(:), allocatable, intent(inout) :: keeps !! Array of values to keep - type(symba_kinship), dimension(:), allocatable, intent(inout) :: discards !! Array of discards - logical, dimension(:), intent(in) :: lspill_list !! Logical array of bodies to spill into the discardss - logical, intent(in) :: ldestructive !! Logical flag indicating whether or not this operation should alter the keeps array or not - ! Internals - integer(I4B) :: nspill, nkeep, nlist - type(symba_kinship), dimension(:), allocatable :: tmp - - nkeep = count(.not.lspill_list(:)) - nspill = count(lspill_list(:)) - nlist = size(lspill_list(:)) - - if (.not.allocated(keeps) .or. nspill == 0) return - if (.not.allocated(discards)) then - allocate(discards(nspill)) - else if (size(discards) /= nspill) then - deallocate(discards) - allocate(discards(nspill)) - end if - - discards(:) = pack(keeps(1:nlist), lspill_list(1:nlist)) - if (ldestructive) then - if (nkeep > 0) then - allocate(tmp(nkeep)) - tmp(:) = pack(keeps(1:nlist), .not. lspill_list(1:nlist)) - call move_alloc(tmp, keeps) - else - deallocate(keeps) - end if - end if - - return - end subroutine symba_util_spill_arr_kin module subroutine symba_util_spill_pl(self, discards, lspill_list, ldestructive) @@ -1173,7 +658,7 @@ module subroutine symba_util_spill_encounter_list(self, discards, lspill_list, l !! author: David A. Minton !! !! Move spilled (discarded) SyMBA encounter structure from active list to discard list - !! Note: Because the symba_plplenc currently does not contain any additional variable components, this method can recieve it as an input as well. + !! Note: Because the plpl_encounter currently does not contain any additional variable components, this method can recieve it as an input as well. implicit none ! Arguments class(symba_encounter), intent(inout) :: self !! SyMBA pl-tp encounter list diff --git a/src/tides/tides_getacch_pl.f90 b/src/tides/tides_getacch_pl.f90 index c37e84b88..aed941e8f 100644 --- a/src/tides/tides_getacch_pl.f90 +++ b/src/tides/tides_getacch_pl.f90 @@ -1,4 +1,4 @@ -submodule(swiftest_classes) s_tides_kick_getacch +submodule(base) s_tides_kick_getacch use swiftest contains @@ -17,8 +17,8 @@ module subroutine tides_kick_getacch_pl(self, system) !! Applications to Kepler-62. A&A 583, A116. https://doi.org/10.1051/0004-6361/201525909 implicit none ! Arguments - class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(base_object), intent(inout) :: self !! Swiftest massive body object + class(base_nbody_system), intent(inout) :: system !! Swiftest nbody system object ! Internals integer(I4B) :: i real(DP) :: rmag, vmag diff --git a/src/tides/tides_spin_step.f90 b/src/tides/tides_spin_step.f90 index ee4309eb6..3fadfc704 100644 --- a/src/tides/tides_spin_step.f90 +++ b/src/tides/tides_spin_step.f90 @@ -1,11 +1,11 @@ -submodule(swiftest_classes) s_tides_step_spin +submodule(base) s_tides_step_spin use swiftest type, extends(lambda_obj_tvar) :: tides_derivs_func !! Base class for an lambda function object. This object takes no additional arguments other than the dependent variable x, an array of real numbers procedure(tidederiv), pointer, nopass :: lambdaptr_tides_deriv real(DP), dimension(:,:), allocatable :: rbeg - real(DP), dimension(:,:), allocatable :: xend + real(DP), dimension(:,:), allocatable :: rend real(DP) :: dt contains generic :: init => tides_derivs_init @@ -16,14 +16,14 @@ module procedure tides_derivs_init end interface abstract interface - function tidederiv(x, t, dt, rbeg, xend) result(y) + function tidederiv(x, t, dt, rbeg, rend) result(y) ! Template for a 0 argument function - import DP, swiftest_nbody_system + import DP, base_nbody_system real(DP), dimension(:), intent(in) :: x real(DP), intent(in) :: t real(DP), intent(in) :: dt real(DP), dimension(:,:), intent(in) :: rbeg - real(DP), dimension(:,:), intent(in) :: xend + real(DP), dimension(:,:), intent(in) :: rend real(DP), dimension(:), allocatable :: y end function end interface @@ -36,8 +36,8 @@ module subroutine tides_step_spin_system(self, param, t, dt) !! Integrates the spin equations for central and massive bodies of the system subjected to tides. implicit none ! Arguments - class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nbody system object - class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters + class(base_nbody_system), intent(inout) :: self !! Swiftest nbody system object + class(base_parameters), intent(in) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! Simulation time real(DP), intent(in) :: dt !! Current stepsize ! Internals @@ -51,7 +51,7 @@ module subroutine tides_step_spin_system(self, param, t, dt) rot0 = [pack(pl%rot(:,1:npl),.true.), pack(cb%rot(:),.true.)] ! Use this space call the ode_solver, passing tides_spin_derivs as the function: subdt = dt / 20._DP - !rot1(:) = util_solve_rkf45(lambda_obj(tides_spin_derivs, subdt, pl%rbeg, pl%xend), rot0, dt, subdt tol) + !rot1(:) = util_solve_rkf45(lambda_obj(tides_spin_derivs, subdt, pl%rbeg, pl%rend), rot0, dt, subdt tol) ! Recover with unpack !pl%rot(:,1:npl) = unpack(rot1... !cb%rot(:) = unpack(rot1... @@ -61,7 +61,7 @@ module subroutine tides_step_spin_system(self, param, t, dt) end subroutine tides_step_spin_system - function tides_spin_derivs(rot_pl_cb, t, dt, rbeg, xend) result(drot) !! Need to add more arguments so we can pull in mass, radius, Ip, J2, etc... + function tides_spin_derivs(rot_pl_cb, t, dt, rbeg, rend) result(drot) !! Need to add more arguments so we can pull in mass, radius, Ip, J2, etc... !! author: Jennifer L.L. Pouplin and David A. Minton !! !! function used to calculate the derivatives that are fed to the ODE solver @@ -71,7 +71,7 @@ function tides_spin_derivs(rot_pl_cb, t, dt, rbeg, xend) result(drot) !! Need to real(DP), intent(in) :: t !! Current time, which is used to interpolate the massive body positions real(DP), intent(in) :: dt !! Total step size real(DP), dimension(:,:), intent(in) :: rbeg - real(DP), dimension(:,:), intent(in) :: xend + real(DP), dimension(:,:), intent(in) :: rend ! Internals real(DP), dimension(:,:), allocatable :: drot real(DP), dimension(:), allocatable :: flatrot @@ -85,7 +85,7 @@ function tides_spin_derivs(rot_pl_cb, t, dt, rbeg, xend) result(drot) !! Need to allocate(drot, mold=rot_pl_cb) drot(:,:) = 0.0_DP do i = 1,n-1 - xinterp(:) = rbeg(:,i) + t / dt * (xend(:,i) - rbeg(:,i)) + xinterp(:) = rbeg(:,i) + t / dt * (rend(:,i) - rbeg(:,i)) ! Calculate Ncb and Npl as a function of xinterp !drot(:,i) = -Mcb / (Mcb + Mpl(i)) * (N_Tpl + N_Rpl) !drot(:,n) = drot(:,n) - Mcb / (Mcb + Mpl(i) * (N_Tcb + N_Rcb) @@ -104,7 +104,7 @@ function tides_derivs_eval(self, x, t) result(y) ! Result real(DP), dimension(:), allocatable :: y if (associated(self%lambdaptr_tides_deriv)) then - y = self%lambdaptr_tides_deriv(x, t, self%dt, self%rbeg, self%xend) + y = self%lambdaptr_tides_deriv(x, t, self%dt, self%rbeg, self%rend) else error stop "Lambda function was not initialized" end if @@ -112,19 +112,19 @@ function tides_derivs_eval(self, x, t) result(y) return end function tides_derivs_eval - function tides_derivs_init(lambda, dt, rbeg, xend) result(f) + function tides_derivs_init(lambda, dt, rbeg, rend) result(f) implicit none ! Arguments procedure(tidederiv) :: lambda real(DP), intent(in) :: dt real(DP), dimension(:,:), intent(in) :: rbeg - real(DP), dimension(:,:), intent(in) :: xend + real(DP), dimension(:,:), intent(in) :: rend ! Result type(tides_derivs_func) :: f f%lambdaptr_tides_deriv => lambda f%dt = dt allocate(f%rbeg, source = rbeg) - allocate(f%xend, source = xend) + allocate(f%rend, source = rend) return end function tides_derivs_init diff --git a/src/user/user_getacch.f90 b/src/user/user_getacch.f90 index 0ba61bd8d..deb54e93f 100644 --- a/src/user/user_getacch.f90 +++ b/src/user/user_getacch.f90 @@ -7,7 +7,7 @@ !! You should have received a copy of the GNU General Public License along with Swiftest. !! If not, see: https://www.gnu.org/licenses. -submodule(swiftest_classes) s_user_kick_getacch +submodule(base) s_user_kick_getacch use swiftest contains module subroutine user_kick_getacch_body(self, system, param, t, lbeg) @@ -18,11 +18,11 @@ module subroutine user_kick_getacch_body(self, system, param, t, lbeg) !! Adapted from David E. Kaufmann's Swifter routine whm_user_kick_getacch.f90 implicit none ! Arguments - class(swiftest_body), intent(inout) :: self !! Swiftest massive body particle data structure - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody_system_object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters user parameters - real(DP), intent(in) :: t !! Current time - logical, intent(in) :: lbeg !! Logical flag that determines whether or not this is the beginning or end of the ste + class(swiftest_body), intent(inout) :: self !! Swiftest massive body particle data structure + class(swiftest_system), intent(inout) :: system !! Swiftest nbody_system_object + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters user parameters + real(DP), intent(in) :: t !! Current time + logical, intent(in) :: lbeg !! Logical flag that determines whether or not this is the beginning or end of the ste return end subroutine user_kick_getacch_body diff --git a/src/util/util_append.f90 b/src/util/util_append.f90 deleted file mode 100644 index 7470bace4..000000000 --- a/src/util/util_append.f90 +++ /dev/null @@ -1,304 +0,0 @@ -!! Copyright 2022 - David Minton, Carlisle Wishard, Jennifer Pouplin, Jake Elliott, & Dana Singh -!! This file is part of Swiftest. -!! Swiftest is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License -!! as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. -!! Swiftest is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty -!! of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. -!! You should have received a copy of the GNU General Public License along with Swiftest. -!! If not, see: https://www.gnu.org/licenses. - -submodule (swiftest_classes) s_util_append - use swiftest -contains - - module subroutine util_append_arr_char_string(arr, source, nold, nsrc, lsource_mask) - !! author: David A. Minton - !! - !! Append a single array of character string type onto another. If the destination array is not allocated, or is not big enough, this will allocate space for it. - implicit none - ! Arguments - character(len=STRMAX), dimension(:), allocatable, intent(inout) :: arr !! Destination array - character(len=STRMAX), dimension(:), allocatable, intent(in) :: source !! Array to append - integer(I4B), intent(in) :: nold, nsrc !! Extend of the old array and the source array, respectively - logical, dimension(:), intent(in) :: lsource_mask !! Logical mask indicating which elements to append to - ! Internals - integer(I4B) :: nnew - - if (.not. allocated(source)) return - - nnew = count(lsource_mask(1:nsrc)) - if (.not.allocated(arr)) then - allocate(arr(nold+nnew)) - else - call util_resize(arr, nold + nnew) - end if - - arr(nold + 1:nold + nnew) = pack(source(1:nsrc), lsource_mask(1:nsrc)) - - return - end subroutine util_append_arr_char_string - - - module subroutine util_append_arr_DP(arr, source, nold, nsrc, lsource_mask) - !! author: David A. Minton - !! - !! Append a single array of double precision type onto another. If the destination array is not allocated, or is not big enough, this will allocate space for it. - implicit none - ! Arguments - real(DP), dimension(:), allocatable, intent(inout) :: arr !! Destination array - real(DP), dimension(:), allocatable, intent(in) :: source !! Array to append - integer(I4B), intent(in) :: nold, nsrc !! Extend of the old array and the source array, respectively - logical, dimension(:), intent(in) :: lsource_mask !! Logical mask indicating which elements to append to - ! Internals - integer(I4B) :: nnew - - if (.not. allocated(source)) return - - nnew = count(lsource_mask(1:nsrc)) - if (.not.allocated(arr)) then - allocate(arr(nold+nnew)) - else - call util_resize(arr, nold + nnew) - end if - - arr(nold + 1:nold + nnew) = pack(source(1:nsrc), lsource_mask(1:nsrc)) - - return - end subroutine util_append_arr_DP - - - module subroutine util_append_arr_DPvec(arr, source, nold, nsrc, lsource_mask) - !! author: David A. Minton - !! - !! Append a single array of double precision vector type of size (NDIM, n) onto another. If the destination array is not allocated, or is not big enough, this will allocate space for it. - implicit none - ! Arguments - real(DP), dimension(:,:), allocatable, intent(inout) :: arr !! Destination array - real(DP), dimension(:,:), allocatable, intent(in) :: source !! Array to append - integer(I4B), intent(in) :: nold, nsrc !! Extend of the old array and the source array, respectively - logical, dimension(:), intent(in) :: lsource_mask !! Logical mask indicating which elements to append to - ! Internals - integer(I4B) :: nnew - - if (.not. allocated(source)) return - - nnew = count(lsource_mask(1:nsrc)) - if (.not.allocated(arr)) then - allocate(arr(NDIM,nold+nnew)) - else - call util_resize(arr, nold + nnew) - end if - - arr(1, nold + 1:nold + nnew) = pack(source(1,1:nsrc), lsource_mask(1:nsrc)) - arr(2, nold + 1:nold + nnew) = pack(source(2,1:nsrc), lsource_mask(1:nsrc)) - arr(3, nold + 1:nold + nnew) = pack(source(3,1:nsrc), lsource_mask(1:nsrc)) - - return - end subroutine util_append_arr_DPvec - - - module subroutine util_append_arr_I4B(arr, source, nold, nsrc, lsource_mask) - !! author: David A. Minton - !! - !! Append a single array of integer(I4B) onto another. If the destination array is not allocated, or is not big enough, this will allocate space for it. - implicit none - ! Arguments - integer(I4B), dimension(:), allocatable, intent(inout) :: arr !! Destination array - integer(I4B), dimension(:), allocatable, intent(in) :: source !! Array to append - integer(I4B), intent(in) :: nold, nsrc !! Extend of the old array and the source array, respectively - logical, dimension(:), intent(in) :: lsource_mask !! Logical mask indicating which elements to append to - ! Internals - integer(I4B) :: nnew - - if (.not. allocated(source)) return - - nnew = count(lsource_mask(1:nsrc)) - if (.not.allocated(arr)) then - allocate(arr(nold+nnew)) - else - call util_resize(arr, nold + nnew) - end if - - arr(nold + 1:nold + nnew) = pack(source(1:nsrc), lsource_mask(1:nsrc)) - - return - end subroutine util_append_arr_I4B - - - module subroutine util_append_arr_info(arr, source, nold, nsrc, lsource_mask) - !! author: David A. Minton - !! - !! Append a single array of particle information type onto another. If the destination array is not allocated, or is not big enough, this will allocate space for it. - implicit none - ! Arguments - type(swiftest_particle_info), dimension(:), allocatable, intent(inout) :: arr !! Destination array - type(swiftest_particle_info), dimension(:), allocatable, intent(in) :: source !! Array to append - integer(I4B), intent(in) :: nold, nsrc !! Extend of the old array and the source array, respectively - logical, dimension(:), intent(in) :: lsource_mask !! Logical mask indicating which elements to append to - ! Internals - integer(I4B) :: nnew, i - integer(I4B), dimension(:), allocatable :: idx - - if (.not. allocated(source)) return - - nnew = count(lsource_mask(1:nsrc)) - if (.not.allocated(arr)) then - allocate(arr(nold+nnew)) - else - call util_resize(arr, nold + nnew) - end if - - allocate(idx(nnew)) - - idx = pack([(i, i = 1, nsrc)], lsource_mask(1:nsrc)) - - call util_copy_particle_info_arr(source(1:nsrc), arr(nold+1:nold+nnew), idx) - - return - end subroutine util_append_arr_info - - - module subroutine util_append_arr_logical(arr, source, nold, nsrc, lsource_mask) - !! author: David A. Minton - !! - !! Append a single array of logical type onto another. If the destination array is not allocated, or is not big enough, this will allocate space for it. - implicit none - ! Arguments - logical, dimension(:), allocatable, intent(inout) :: arr !! Destination array - logical, dimension(:), allocatable, intent(in) :: source !! Array to append - integer(I4B), intent(in) :: nold, nsrc !! Extend of the old array and the source array, respectively - logical, dimension(:), intent(in) :: lsource_mask !! Logical mask indicating which elements to append to - ! Internals - integer(I4B) :: nnew - - if (.not. allocated(source)) return - - nnew = count(lsource_mask(1:nsrc)) - if (.not.allocated(arr)) then - allocate(arr(nold+nnew)) - else - call util_resize(arr, nold + nnew) - end if - - arr(nold + 1:nold + nnew) = pack(source(1:nsrc), lsource_mask(1:nsrc)) - - return - end subroutine util_append_arr_logical - - - module subroutine util_append_body(self, source, lsource_mask) - !! author: David A. Minton - !! - !! Append components from one Swiftest body object to another. - !! This method will automatically resize the destination body if it is too small - implicit none - ! Arguments - class(swiftest_body), intent(inout) :: self !! Swiftest body object - class(swiftest_body), intent(in) :: source !! Source object to append - logical, dimension(:), intent(in) :: lsource_mask !! Logical mask indicating which elements to append to - ! Internals - integer(I4B) :: nold, nsrc, nnew - - nold = self%nbody - nsrc = source%nbody - nnew = count(lsource_mask(1:nsrc)) - - call util_append(self%info, source%info, nold, nsrc, lsource_mask) - call util_append(self%id, source%id, nold, nsrc, lsource_mask) - call util_append(self%status, source%status, nold, nsrc, lsource_mask) - call util_append(self%ldiscard, source%ldiscard, nold, nsrc, lsource_mask) - call util_append(self%lmask, source%lmask, nold, nsrc, lsource_mask) - call util_append(self%mu, source%mu, nold, nsrc, lsource_mask) - call util_append(self%rh, source%rh, nold, nsrc, lsource_mask) - call util_append(self%vh, source%vh, nold, nsrc, lsource_mask) - call util_append(self%rb, source%rb, nold, nsrc, lsource_mask) - call util_append(self%vb, source%vb, nold, nsrc, lsource_mask) - call util_append(self%ah, source%ah, nold, nsrc, lsource_mask) - call util_append(self%aobl, source%aobl, nold, nsrc, lsource_mask) - call util_append(self%atide, source%atide, nold, nsrc, lsource_mask) - call util_append(self%agr, source%agr, nold, nsrc, lsource_mask) - call util_append(self%ir3h, source%ir3h, nold, nsrc, lsource_mask) - call util_append(self%a, source%a, nold, nsrc, lsource_mask) - call util_append(self%e, source%e, nold, nsrc, lsource_mask) - call util_append(self%inc, source%inc, nold, nsrc, lsource_mask) - call util_append(self%capom, source%capom, nold, nsrc, lsource_mask) - call util_append(self%omega, source%omega, nold, nsrc, lsource_mask) - call util_append(self%capm, source%capm, nold, nsrc, lsource_mask) - - self%nbody = nold + nnew - - return - end subroutine util_append_body - - - module subroutine util_append_pl(self, source, lsource_mask) - !! author: David A. Minton - !! - !! Append components from one Swiftest body object to another. - !! This method will automatically resize the destination body if it is too small - implicit none - ! Arguments - class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object - class(swiftest_body), intent(in) :: source !! Source object to append - logical, dimension(:), intent(in) :: lsource_mask !! Logical mask indicating which elements to append to - - select type(source) - class is (swiftest_pl) - associate(nold => self%nbody, nsrc => source%nbody) - call util_append(self%mass, source%mass, nold, nsrc, lsource_mask) - call util_append(self%Gmass, source%Gmass, nold, nsrc, lsource_mask) - call util_append(self%rhill, source%rhill, nold, nsrc, lsource_mask) - call util_append(self%renc, source%renc, nold, nsrc, lsource_mask) - call util_append(self%radius, source%radius, nold, nsrc, lsource_mask) - call util_append(self%rbeg, source%rbeg, nold, nsrc, lsource_mask) - call util_append(self%xend, source%xend, nold, nsrc, lsource_mask) - call util_append(self%vbeg, source%vbeg, nold, nsrc, lsource_mask) - call util_append(self%density, source%density, nold, nsrc, lsource_mask) - call util_append(self%Ip, source%Ip, nold, nsrc, lsource_mask) - call util_append(self%rot, source%rot, nold, nsrc, lsource_mask) - call util_append(self%k2, source%k2, nold, nsrc, lsource_mask) - call util_append(self%Q, source%Q, nold, nsrc, lsource_mask) - call util_append(self%tlag, source%tlag, nold, nsrc, lsource_mask) - - if (allocated(self%k_plpl)) deallocate(self%k_plpl) - - call util_append_body(self, source, lsource_mask) - end associate - class default - write(*,*) "Invalid object passed to the append method. Source must be of class swiftest_pl or its descendents" - call util_exit(FAILURE) - end select - - return - end subroutine util_append_pl - - - module subroutine util_append_tp(self, source, lsource_mask) - !! author: David A. Minton - !! - !! Append components from one Swiftest body object to another. - !! This method will automatically resize the destination body if it is too small - implicit none - ! Arguments - class(swiftest_tp), intent(inout) :: self !! Swiftest test particle object - class(swiftest_body), intent(in) :: source !! Source object to append - logical, dimension(:), intent(in) :: lsource_mask !! Logical mask indicating which elements to append to - - select type(source) - class is (swiftest_tp) - associate(nold => self%nbody, nsrc => source%nbody) - call util_append(self%isperi, source%isperi, nold, nsrc, lsource_mask) - call util_append(self%peri, source%peri, nold, nsrc, lsource_mask) - call util_append(self%atp, source%atp, nold, nsrc, lsource_mask) - - call util_append_body(self, source, lsource_mask) - end associate - class default - write(*,*) "Invalid object passed to the append method. Source must be of class swiftest_tp or its descendents" - call util_exit(FAILURE) - end select - - return - end subroutine util_append_tp - -end submodule s_util_append \ No newline at end of file diff --git a/src/util/util_coord.f90 b/src/util/util_coord.f90 deleted file mode 100644 index 78c2eca83..000000000 --- a/src/util/util_coord.f90 +++ /dev/null @@ -1,309 +0,0 @@ -!! Copyright 2022 - David Minton, Carlisle Wishard, Jennifer Pouplin, Jake Elliott, & Dana Singh -!! This file is part of Swiftest. -!! Swiftest is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License -!! as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. -!! Swiftest is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty -!! of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. -!! You should have received a copy of the GNU General Public License along with Swiftest. -!! If not, see: https://www.gnu.org/licenses. - -submodule(swiftest_classes) s_util_coord - use swiftest -contains - - module subroutine util_coord_h2b_pl(self, cb) - !! author: David A. Minton - !! - !! Convert massive bodies from heliocentric to barycentric coordinates (position and velocity) - !! - !! Adapted from David E. Kaufmann's Swifter routine coord_h2b.f90 - !! Adapted from Hal Levison's Swift routine coord_h2b.f - implicit none - ! Arguments - class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object - class(swiftest_cb), intent(inout) :: cb !! Swiftest central body object - ! Internals - integer(I4B) :: i - real(DP) :: Gmtot - real(DP), dimension(NDIM) :: xtmp, vtmp - - if (self%nbody == 0) return - associate(pl => self, npl => self%nbody) - Gmtot = cb%Gmass - xtmp(:) = 0.0_DP - vtmp(:) = 0.0_DP - do i = 1, npl - if (pl%status(i) == INACTIVE) cycle - Gmtot = Gmtot + pl%Gmass(i) - xtmp(:) = xtmp(:) + pl%Gmass(i) * pl%rh(:,i) - vtmp(:) = vtmp(:) + pl%Gmass(i) * pl%vh(:,i) - end do - cb%rb(:) = -xtmp(:) / Gmtot - cb%vb(:) = -vtmp(:) / Gmtot - do i = 1, npl - if (pl%status(i) == INACTIVE) cycle - pl%rb(:,i) = pl%rh(:,i) + cb%rb(:) - pl%vb(:,i) = pl%vh(:,i) + cb%vb(:) - end do - end associate - - return - end subroutine util_coord_h2b_pl - - - module subroutine util_coord_h2b_tp(self, cb) - !! author: David A. Minton - !! - !! Convert test particles from heliocentric to barycentric coordinates (position and velocity) - !! - !! Adapted from David E. Kaufmann's Swifter routine coord_h2b_tp.f90 - !! Adapted from Hal Levison's Swift routine coord_h2b_tp.f - implicit none - ! Arguments - class(swiftest_tp), intent(inout) :: self !! Swiftest test particle object - class(swiftest_cb), intent(in) :: cb !! Swiftest central body object - ! Internals - integer(I4B) :: i - - if (self%nbody == 0) return - associate(tp => self, ntp => self%nbody) - do concurrent (i = 1:ntp, tp%status(i) /= INACTIVE) - tp%rb(:, i) = tp%rh(:, i) + cb%rb(:) - tp%vb(:, i) = tp%vh(:, i) + cb%vb(:) - end do - end associate - - return - end subroutine util_coord_h2b_tp - - - module subroutine util_coord_b2h_pl(self, cb) - !! author: David A. Minton - !! - !! Convert massive bodies from barycentric to heliocentric coordinates (position and velocity) - !! - !! Adapted from David E. Kaufmann's Swifter routine coord_b2h.f90 - !! Adapted from Hal Levison's Swift routine coord_b2h.f - implicit none - ! Arguments - class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object - class(swiftest_cb), intent(inout) :: cb !! Swiftest central body object - ! Internals - integer(I4B) :: i - - if (self%nbody == 0) return - - associate(pl => self, npl => self%nbody) - do concurrent (i = 1:npl, pl%status(i) /= INACTIVE) - pl%rh(:, i) = pl%rb(:, i) - cb%rb(:) - pl%vh(:, i) = pl%vb(:, i) - cb%vb(:) - end do - end associate - - return - end subroutine util_coord_b2h_pl - - - module subroutine util_coord_b2h_tp(self, cb) - !! author: David A. Minton - !! - !! Convert test particles from barycentric to heliocentric coordinates (position and velocity) - !! - !! Adapted from David E. Kaufmann's Swifter routine coord_b2h_tp.f90 - !! Adapted from Hal Levison's Swift routine coord_b2h_tp.f - implicit none - ! Arguments - class(swiftest_tp), intent(inout) :: self !! Swiftest massive body object - class(swiftest_cb), intent(in) :: cb !! Swiftest central body object - ! Internals - integer(I4B) :: i - - if (self%nbody == 0) return - - associate(tp => self, ntp => self%nbody) - do concurrent(i = 1:ntp, tp%status(i) /= INACTIVE) - tp%rh(:, i) = tp%rb(:, i) - cb%rb(:) - tp%vh(:, i) = tp%vb(:, i) - cb%vb(:) - end do - end associate - - return - end subroutine util_coord_b2h_tp - - - module subroutine util_coord_vb2vh_pl(self, cb) - !! author: David A. Minton - !! - !! Convert massive bodies from barycentric to heliocentric coordinates (velocity only) - !! - !! Adapted from David E. Kaufmann's Swifter routine coord_vb2vh.f90 - !! Adapted from Hal Levison's Swift routine coord_vb2vh.f - implicit none - ! Arguments - class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object - class(swiftest_cb), intent(inout) :: cb !! Swiftest central body object - ! Internals - integer(I4B) :: i - - if (self%nbody == 0) return - - associate(pl => self, npl => self%nbody) - cb%vb(:) = 0.0_DP - do i = npl, 1, -1 - cb%vb(:) = cb%vb(:) - pl%Gmass(i) * pl%vb(:, i) / cb%Gmass - end do - do concurrent(i = 1:npl) - pl%vh(:, i) = pl%vb(:, i) - cb%vb(:) - end do - end associate - - return - end subroutine util_coord_vb2vh_pl - - - module subroutine util_coord_vb2vh_tp(self, vbcb) - !! author: David A. Minton - !! - !! Convert test particles from barycentric to heliocentric coordinates (velocity only) - !! - !! Adapted from David E. Kaufmann's Swifter routine coord_vb2vh_tp.f90 - !! Adapted from Hal Levison's Swift routine coord_vb2h_tp.f - implicit none - ! Arguments - class(swiftest_tp), intent(inout) :: self !! Swiftest test particle object - real(DP), dimension(:), intent(in) :: vbcb !! Barycentric velocity of the central body - - if (self%nbody == 0) return - - associate(tp => self, ntp => self%nbody) - where (tp%lmask(1:ntp)) - tp%vh(1, 1:ntp) = tp%vb(1, 1:ntp) - vbcb(1) - tp%vh(2, 1:ntp) = tp%vb(2, 1:ntp) - vbcb(2) - tp%vh(3, 1:ntp) = tp%vb(3, 1:ntp) - vbcb(3) - end where - end associate - - return - end subroutine util_coord_vb2vh_tp - - - module subroutine util_coord_vh2vb_pl(self, cb) - !! author: David A. Minton - !! - !! Convert massive bodies from heliocentric to barycentric coordinates (velocity only) - !! - !! Adapted from David E. Kaufmann's Swifter routine coord_vh2vb.f90 - !! Adapted from Hal Levison's Swift routine coord_vh2b.f - implicit none - ! Arguments - class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object - class(swiftest_cb), intent(inout) :: cb !! Swiftest central body object - ! Internals - integer(I4B) :: i - real(DP) :: Gmtot - - if (self%nbody == 0) return - - associate(pl => self, npl => self%nbody) - Gmtot = cb%Gmass + sum(pl%Gmass(1:npl)) - cb%vb(:) = 0.0_DP - do i = 1, npl - cb%vb(:) = cb%vb(:) - pl%Gmass(i) * pl%vh(:, i) - end do - cb%vb(:) = cb%vb(:) / Gmtot - do concurrent(i = 1:npl) - pl%vb(:, i) = pl%vh(:, i) + cb%vb(:) - end do - end associate - - return - end subroutine util_coord_vh2vb_pl - - - module subroutine util_coord_vh2vb_tp(self, vbcb) - !! author: David A. Minton - !! - !! Convert test particles from heliocentric to barycentric coordinates (velocity only) - !! - !! Adapted from David E. Kaufmann's Swifter routine coord_vh2vb_tp.f90 - !! Adapted from Hal Levison's Swift routine coord_vh2b_tp.f - implicit none - ! Arguments - class(swiftest_tp), intent(inout) :: self !! Swiftest test particle object - real(DP), dimension(:), intent(in) :: vbcb !! Barycentric velocity of the central body - - if (self%nbody == 0) return - - associate(tp => self, ntp => self%nbody) - where (tp%lmask(1:ntp)) - tp%vb(1, 1:ntp) = tp%vh(1, 1:ntp) + vbcb(1) - tp%vb(2, 1:ntp) = tp%vh(2, 1:ntp) + vbcb(2) - tp%vb(3, 1:ntp) = tp%vh(3, 1:ntp) + vbcb(3) - end where - end associate - - return - end subroutine util_coord_vh2vb_tp - - - module subroutine util_coord_rh2rb_pl(self, cb) - !! author: David A. Minton - !! - !! Convert position vectors of massive bodies from heliocentric to barycentric coordinates (position only) - !! - !! Adapted from David E. Kaufmann's Swifter routine coord_h2b.f90 - !! Adapted from Hal Levison's Swift routine coord_h2b.f - implicit none - ! Arguments - class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object - class(swiftest_cb), intent(inout) :: cb !! Swiftest central body object - ! Internals - integer(I4B) :: i - real(DP) :: Gmtot - real(DP), dimension(NDIM) :: xtmp - - if (self%nbody == 0) return - associate(pl => self, npl => self%nbody) - Gmtot = cb%Gmass - xtmp(:) = 0.0_DP - do i = 1, npl - if (pl%status(i) == INACTIVE) cycle - Gmtot = Gmtot + pl%Gmass(i) - xtmp(:) = xtmp(:) + pl%Gmass(i) * pl%rh(:,i) - end do - cb%rb(:) = -xtmp(:) / Gmtot - do i = 1, npl - if (pl%status(i) == INACTIVE) cycle - pl%rb(:,i) = pl%rh(:,i) + cb%rb(:) - end do - end associate - - return - end subroutine util_coord_rh2rb_pl - - - module subroutine util_coord_rh2rb_tp(self, cb) - !! author: David A. Minton - !! - !! Convert test particles from heliocentric to barycentric coordinates (position only) - !! - !! Adapted from David E. Kaufmann's Swifter routine coord_h2b_tp.f90 - !! Adapted from Hal Levison's Swift routine coord_h2b_tp.f - implicit none - ! Arguments - class(swiftest_tp), intent(inout) :: self !! Swiftest test particle object - class(swiftest_cb), intent(in) :: cb !! Swiftest central body object - ! Internals - integer(I4B) :: i - - if (self%nbody == 0) return - associate(tp => self, ntp => self%nbody) - do concurrent (i = 1:ntp, tp%status(i) /= INACTIVE) - tp%rb(:, i) = tp%rh(:, i) + cb%rb(:) - end do - end associate - - return - end subroutine util_coord_rh2rb_tp - -end submodule s_util_coord \ No newline at end of file diff --git a/src/util/util_copy.f90 b/src/util/util_copy.f90 deleted file mode 100644 index bef861d07..000000000 --- a/src/util/util_copy.f90 +++ /dev/null @@ -1,95 +0,0 @@ -!! Copyright 2022 - David Minton, Carlisle Wishard, Jennifer Pouplin, Jake Elliott, & Dana Singh -!! This file is part of Swiftest. -!! Swiftest is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License -!! as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. -!! Swiftest is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty -!! of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. -!! You should have received a copy of the GNU General Public License along with Swiftest. -!! If not, see: https://www.gnu.org/licenses. - -submodule(swiftest_classes) s_util_copy - use swiftest -contains - - module subroutine util_copy_particle_info(self, source) - !! author: David A. Minton - !! - !! Copies one set of information object components into another, component-by-component - implicit none - class(swiftest_particle_info), intent(inout) :: self - class(swiftest_particle_info), intent(in) :: source - - call self%set_value(& - name = source%name, & - particle_type = source%particle_type, & - status = source%status, & - origin_type = source%origin_type, & - origin_time = source%origin_time, & - collision_id = source%collision_id, & - origin_rh = source%origin_rh(:), & - origin_vh = source%origin_vh(:), & - discard_time = source%discard_time, & - discard_rh = source%discard_rh(:), & - discard_vh = source%discard_vh(:), & - discard_body_id = source%discard_body_id & - ) - - return - end subroutine util_copy_particle_info - - - module subroutine util_copy_particle_info_arr(source, dest, idx) - !! author: David A. Minton - !! - !! Copies contents from an array of one particle information objects to another. - implicit none - class(swiftest_particle_info), dimension(:), intent(in) :: source !! Source object to copy into - class(swiftest_particle_info), dimension(:), intent(inout) :: dest !! Swiftest body object with particle metadata information object - integer(I4B), dimension(:), intent(in), optional :: idx !! Optional array of indices to draw the source object - ! Internals - integer(I4B) :: i, j, n, nsource, ndest - - if (size(source) == 0) return - - if (present(idx)) then - n = size(idx) - else - n = size(source) - end if - - nsource = size(source) - ndest = size(dest) - - if ((n == 0) .or. (n > ndest) .or. (n > nsource)) then - write(*,*) 'Particle info copy operation failed. n, nsource, ndest: ',n, nsource, ndest - return - end if - - do i = 1, n - if (present(idx)) then - j = idx(i) - else - j = i - end if - call dest(i)%copy(source(j)) - end do - - return - end subroutine util_copy_particle_info_arr - - - 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(swiftest_storage_frame), intent(inout) :: self !! Swiftest storage frame object - class(*), intent(in) :: source !! Swiftest n-body system object - - if (allocated(self%item)) deallocate(self%item) - allocate(self%item, source=source) - - return - end subroutine util_copy_store - -end submodule s_util_copy diff --git a/src/util/util_dealloc.f90 b/src/util/util_dealloc.f90 deleted file mode 100644 index 14309d2a6..000000000 --- a/src/util/util_dealloc.f90 +++ /dev/null @@ -1,93 +0,0 @@ -!! Copyright 2022 - David Minton, Carlisle Wishard, Jennifer Pouplin, Jake Elliott, & Dana Singh -!! This file is part of Swiftest. -!! Swiftest is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License -!! as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. -!! Swiftest is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty -!! of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. -!! You should have received a copy of the GNU General Public License along with Swiftest. -!! If not, see: https://www.gnu.org/licenses. - -submodule (swiftest_classes) s_util_dealloc - use swiftest -contains - - module subroutine util_dealloc_body(self) - !! author: David A. Minton - !! - !! Finalize the swiftest body object - deallocates all allocatables - implicit none - ! Argument - class(swiftest_body), intent(inout) :: self - - if (allocated(self%info)) deallocate(self%info) - if (allocated(self%id)) deallocate(self%id) - if (allocated(self%status)) deallocate(self%status) - if (allocated(self%ldiscard)) deallocate(self%ldiscard) - if (allocated(self%lmask)) deallocate(self%lmask) - if (allocated(self%mu)) deallocate(self%mu) - if (allocated(self%rh)) deallocate(self%rh) - if (allocated(self%vh)) deallocate(self%vh) - if (allocated(self%rb)) deallocate(self%rb) - if (allocated(self%vb)) deallocate(self%vb) - if (allocated(self%ah)) deallocate(self%ah) - if (allocated(self%aobl)) deallocate(self%aobl) - if (allocated(self%agr)) deallocate(self%agr) - if (allocated(self%atide)) deallocate(self%atide) - if (allocated(self%ir3h)) deallocate(self%ir3h) - if (allocated(self%a)) deallocate(self%a) - if (allocated(self%e)) deallocate(self%e) - if (allocated(self%e)) deallocate(self%e) - if (allocated(self%inc)) deallocate(self%inc) - if (allocated(self%capom)) deallocate(self%capom) - if (allocated(self%omega)) deallocate(self%omega) - if (allocated(self%capm)) deallocate(self%capm) - - return - end subroutine util_dealloc_body - - - module subroutine util_dealloc_pl(self) - !! author: David A. Minton - !! - !! Finalize the swiftest massive body object - deallocates all allocatables - implicit none - ! Argument - class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object - - if (allocated(self%mass)) deallocate(self%mass) - if (allocated(self%Gmass)) deallocate(self%Gmass) - if (allocated(self%rhill)) deallocate(self%rhill) - if (allocated(self%renc)) deallocate(self%renc) - if (allocated(self%radius)) deallocate(self%radius) - if (allocated(self%density)) deallocate(self%density) - if (allocated(self%rot)) deallocate(self%rot) - if (allocated(self%Ip)) deallocate(self%Ip) - if (allocated(self%k2)) deallocate(self%k2) - if (allocated(self%Q)) deallocate(self%Q) - if (allocated(self%tlag)) deallocate(self%tlag) - if (allocated(self%k_plpl)) deallocate(self%k_plpl) - - call util_dealloc_body(self) - - return - end subroutine util_dealloc_pl - - module subroutine util_dealloc_tp(self) - !! author: David A. Minton - !! - !! Finalize the swiftest test particle object - deallocates all allocatables - implicit none - ! Argument - class(swiftest_tp), intent(inout) :: self !! Swiftest test particle object - - if (allocated(self%isperi)) deallocate(self%isperi) - if (allocated(self%peri)) deallocate(self%peri) - if (allocated(self%atp)) deallocate(self%atp) - if (allocated(self%k_pltp)) deallocate(self%k_pltp) - - call util_dealloc_body(self) - - return - end subroutine util_dealloc_tp - -end submodule s_util_dealloc \ No newline at end of file diff --git a/src/util/util_exit.f90 b/src/util/util_exit.f90 deleted file mode 100644 index a7b77c197..000000000 --- a/src/util/util_exit.f90 +++ /dev/null @@ -1,49 +0,0 @@ -!! Copyright 2022 - David Minton, Carlisle Wishard, Jennifer Pouplin, Jake Elliott, & Dana Singh -!! This file is part of Swiftest. -!! Swiftest is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License -!! as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. -!! Swiftest is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty -!! of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. -!! You should have received a copy of the GNU General Public License along with Swiftest. -!! If not, see: https://www.gnu.org/licenses. - -submodule (swiftest_classes) s_util_exit - use swiftest -contains - - module subroutine util_exit(code) - !! author: David A. Minton - !! - !! Print termination message and exit program - !! - !! Adapted from David E. Kaufmann's Swifter routine: util_exit.f90 - !! Adapted from Hal Levison's Swift routine util_exit.f - implicit none - ! Arguments - integer(I4B), intent(in) :: code - ! Internals - character(*), parameter :: BAR = '("------------------------------------------------")' - character(*), parameter :: SUCCESS_MSG = '(/, "Normal termination of Swiftest (version ", f3.1, ")")' - character(*), parameter :: FAIL_MSG = '(/, "Terminating Swiftest (version ", f3.1, ") due to error!!")' - character(*), parameter :: USAGE_MSG = '("Usage: swiftest [bs|helio|ra15|rmvs|symba|tu4|whm] [standard|compact|progress|NONE]")' - character(*), parameter :: HELP_MSG = USAGE_MSG - - select case(code) - case(SUCCESS) - write(*, SUCCESS_MSG) VERSION_NUMBER - write(*, BAR) - case(USAGE) - write(*, USAGE_MSG) - case(HELP) - write(*, HELP_MSG) - case default - write(*, FAIL_MSG) VERSION_NUMBER - write(*, BAR) - error stop - end select - - stop - - end subroutine util_exit - -end submodule s_util_exit diff --git a/src/util/util_fill.f90 b/src/util/util_fill.f90 deleted file mode 100644 index 265138238..000000000 --- a/src/util/util_fill.f90 +++ /dev/null @@ -1,256 +0,0 @@ -!! Copyright 2022 - David Minton, Carlisle Wishard, Jennifer Pouplin, Jake Elliott, & Dana Singh -!! This file is part of Swiftest. -!! Swiftest is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License -!! as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. -!! Swiftest is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty -!! of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. -!! You should have received a copy of the GNU General Public License along with Swiftest. -!! If not, see: https://www.gnu.org/licenses. - -submodule (swiftest_classes) s_util_fill - use swiftest -contains - - module subroutine util_fill_arr_char_string(keeps, inserts, lfill_list) - !! author: David A. Minton - !! - !! Performs a fill operation on a single array of type character strings - !! This is the inverse of a spill operation - implicit none - ! Arguments - character(len=STRMAX), dimension(:), allocatable, intent(inout) :: keeps !! Array of values to keep - character(len=STRMAX), dimension(:), allocatable, intent(in) :: inserts !! Array of values to insert into keep - logical, dimension(:), intent(in) :: lfill_list !! Logical array of bodies to merge into the keeps - - if (.not.allocated(keeps) .or. .not.allocated(inserts)) return - - keeps(:) = unpack(keeps(:), .not.lfill_list(:), keeps(:)) - keeps(:) = unpack(inserts(:), lfill_list(:), keeps(:)) - - return - end subroutine util_fill_arr_char_string - - module subroutine util_fill_arr_DP(keeps, inserts, lfill_list) - !! author: David A. Minton - !! - !! Performs a fill operation on a single array of type DP - !! This is the inverse of a spill operation - implicit none - ! Arguments - real(DP), dimension(:), allocatable, intent(inout) :: keeps !! Array of values to keep - real(DP), dimension(:), allocatable, intent(in) :: inserts !! Array of values to insert into keep - logical, dimension(:), intent(in) :: lfill_list !! Logical array of bodies to merge into the keeps - - if (.not.allocated(keeps) .or. .not.allocated(inserts)) return - - keeps(:) = unpack(keeps(:), .not.lfill_list(:), keeps(:)) - keeps(:) = unpack(inserts(:), lfill_list(:), keeps(:)) - - return - end subroutine util_fill_arr_DP - - module subroutine util_fill_arr_DPvec(keeps, inserts, lfill_list) - !! author: David A. Minton - !! - !! Performs a fill operation on a single array of DP vectors with shape (NDIM, n) - !! This is the inverse of a spill operation - implicit none - ! Arguments - real(DP), dimension(:,:), allocatable, intent(inout) :: keeps !! Array of values to keep - real(DP), dimension(:,:), allocatable, intent(in) :: inserts !! Array of values to insert into keep - logical, dimension(:), intent(in) :: lfill_list !! Logical array of bodies to merge into the keeps - ! Internals - integer(I4B) :: i - - if (.not.allocated(keeps) .or. .not.allocated(inserts)) return - - do i = 1, NDIM - keeps(i,:) = unpack(keeps(i,:), .not.lfill_list(:), keeps(i,:)) - keeps(i,:) = unpack(inserts(i,:), lfill_list(:), keeps(i,:)) - end do - - return - end subroutine util_fill_arr_DPvec - - module subroutine util_fill_arr_I4B(keeps, inserts, lfill_list) - !! author: David A. Minton - !! - !! Performs a fill operation on a single array of type I4B - !! This is the inverse of a spill operation - implicit none - ! Arguments - integer(I4B), dimension(:), allocatable, intent(inout) :: keeps !! Array of values to keep - integer(I4B), dimension(:), allocatable, intent(in) :: inserts !! Array of values to insert into keep - logical, dimension(:), intent(in) :: lfill_list !! Logical array of bodies to merge into the keeps - - if (.not.allocated(keeps) .or. .not.allocated(inserts)) return - - keeps(:) = unpack(keeps(:), .not.lfill_list(:), keeps(:)) - keeps(:) = unpack(inserts(:), lfill_list(:), keeps(:)) - - return - end subroutine util_fill_arr_I4B - - - module subroutine util_fill_arr_info(keeps, inserts, lfill_list) - !! author: David A. Minton - !! - !! Performs a fill operation on a single array of particle origin information types - !! This is the inverse of a spill operation - implicit none - ! Arguments - type(swiftest_particle_info), dimension(:), allocatable, intent(inout) :: keeps !! Array of values to keep - type(swiftest_particle_info), dimension(:), allocatable, intent(in) :: inserts !! Array of values to insert into keep - logical, dimension(:), intent(in) :: lfill_list !! Logical array of bodies to merge into the keeps - ! Internals - integer(I4B), dimension(:), allocatable :: insert_idx - integer(I4B) :: i, nkeep, ninsert - - if (.not.allocated(keeps) .or. .not.allocated(inserts)) return - - nkeep = size(keeps) - ninsert = count(lfill_list) - - allocate(insert_idx(ninsert)) - - insert_idx(:) = pack([(i, i = 1, nkeep)], lfill_list) - call util_copy_particle_info_arr(inserts, keeps, insert_idx) - - return - end subroutine util_fill_arr_info - - - module subroutine util_fill_arr_logical(keeps, inserts, lfill_list) - !! author: David A. Minton - !! - !! Performs a fill operation on a single array of logicals - !! This is the inverse of a spill operation - implicit none - ! Arguments - logical, dimension(:), allocatable, intent(inout) :: keeps !! Array of values to keep - logical, dimension(:), allocatable, intent(in) :: inserts !! Array of values to insert into keep - logical, dimension(:), intent(in) :: lfill_list !! Logical array of bodies to merge into the keeps - - if (.not.allocated(keeps) .or. .not.allocated(inserts)) return - - keeps(:) = unpack(keeps(:), .not.lfill_list(:), keeps(:)) - keeps(:) = unpack(inserts(:), lfill_list(:), keeps(:)) - - return - end subroutine util_fill_arr_logical - - - module subroutine util_fill_body(self, inserts, lfill_list) - !! author: David A. Minton - !! - !! Insert new Swiftest generic particle structure into an old one. - !! This is the inverse of a spill operation. - implicit none - ! Arguments - class(swiftest_body), intent(inout) :: self !! Swiftest generic body object - class(swiftest_body), intent(in) :: inserts !! Inserted object - logical, dimension(:), intent(in) :: lfill_list !! Logical array of bodies to merge into the keeps - - ! For each component, pack the discarded bodies into the discard object and do the inverse with the keeps - !> Fill all the common components - associate(keeps => self) - call util_fill(keeps%id, inserts%id, lfill_list) - call util_fill(keeps%info, inserts%info, lfill_list) - call util_fill(keeps%status, inserts%status, lfill_list) - call util_fill(keeps%ldiscard, inserts%ldiscard, lfill_list) - call util_fill(keeps%lmask, inserts%lmask, lfill_list) - call util_fill(keeps%mu, inserts%mu, lfill_list) - call util_fill(keeps%rh, inserts%rh, lfill_list) - call util_fill(keeps%vh, inserts%vh, lfill_list) - call util_fill(keeps%rb, inserts%rb, lfill_list) - call util_fill(keeps%vb, inserts%vb, lfill_list) - call util_fill(keeps%ah, inserts%ah, lfill_list) - call util_fill(keeps%aobl, inserts%aobl, lfill_list) - call util_fill(keeps%agr, inserts%agr, lfill_list) - call util_fill(keeps%atide, inserts%atide, lfill_list) - call util_fill(keeps%a, inserts%a, lfill_list) - call util_fill(keeps%e, inserts%e, lfill_list) - call util_fill(keeps%inc, inserts%inc, lfill_list) - call util_fill(keeps%capom, inserts%capom, lfill_list) - call util_fill(keeps%omega, inserts%omega, lfill_list) - call util_fill(keeps%capm, inserts%capm, lfill_list) - - ! This is the base class, so will be the last to be called in the cascade. - keeps%nbody = size(keeps%id(:)) - end associate - - return - end subroutine util_fill_body - - - module subroutine util_fill_pl(self, inserts, lfill_list) - !! author: David A. Minton - !! - !! Insert new Swiftest massive body structure into an old one. - !! This is the inverse of a spill operation. - implicit none - ! Arguments - class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object - class(swiftest_body), intent(in) :: inserts !! Swiftest body object to be inserted - logical, dimension(:), intent(in) :: lfill_list !! Logical array of bodies to merge into the keeps - - associate(keeps => self) - - select type (inserts) ! The standard requires us to select the type of both arguments in order to access all the components - class is (swiftest_pl) - !> Fill components specific to the massive body class - call util_fill(keeps%mass, inserts%mass, lfill_list) - call util_fill(keeps%Gmass, inserts%Gmass, lfill_list) - call util_fill(keeps%rhill, inserts%rhill, lfill_list) - call util_fill(keeps%renc, inserts%renc, lfill_list) - call util_fill(keeps%radius, inserts%radius, lfill_list) - call util_fill(keeps%density, inserts%density, lfill_list) - call util_fill(keeps%k2, inserts%k2, lfill_list) - call util_fill(keeps%Q, inserts%Q, lfill_list) - call util_fill(keeps%tlag, inserts%tlag, lfill_list) - call util_fill(keeps%rbeg, inserts%rbeg, lfill_list) - call util_fill(keeps%vbeg, inserts%vbeg, lfill_list) - call util_fill(keeps%Ip, inserts%Ip, lfill_list) - call util_fill(keeps%rot, inserts%rot, lfill_list) - - if (allocated(keeps%k_plpl)) deallocate(keeps%k_plpl) - - call util_fill_body(keeps, inserts, lfill_list) - class default - write(*,*) 'Error! fill method called for incompatible return type on swiftest_pl' - end select - end associate - - return - end subroutine util_fill_pl - - - module subroutine util_fill_tp(self, inserts, lfill_list) - !! author: David A. Minton - !! - !! Insert new Swiftest test particle structure into an old one. - !! This is the inverse of a fill operation. - implicit none - ! Arguments - class(swiftest_tp), intent(inout) :: self !! Swiftest test particle object - class(swiftest_body), intent(in) :: inserts !! Swiftest body object to be inserted - logical, dimension(:), intent(in) :: lfill_list !! Logical array of bodies to merge into the keeps - - associate(keeps => self) - select type(inserts) - class is (swiftest_tp) - !> Spill components specific to the test particle class - call util_fill(keeps%isperi, inserts%isperi, lfill_list) - call util_fill(keeps%peri, inserts%peri, lfill_list) - call util_fill(keeps%atp, inserts%atp, lfill_list) - - call util_fill_body(keeps, inserts, lfill_list) - class default - write(*,*) 'Error! fill method called for incompatible return type on swiftest_tp' - end select - end associate - - return - end subroutine util_fill_tp - -end submodule s_util_fill \ No newline at end of file diff --git a/src/util/util_final.f90 b/src/util/util_final.f90 deleted file mode 100644 index 4f4a6dd28..000000000 --- a/src/util/util_final.f90 +++ /dev/null @@ -1,62 +0,0 @@ -!! Copyright 2022 - David Minton, Carlisle Wishard, Jennifer Pouplin, Jake Elliott, & Dana Singh -!! This file is part of Swiftest. -!! Swiftest is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License -!! as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. -!! Swiftest is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty -!! of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. -!! You should have received a copy of the GNU General Public License along with Swiftest. -!! If not, see: https://www.gnu.org/licenses. - -submodule (swiftest_classes) s_util_final - use swiftest -contains - - module subroutine util_final_storage(self) - !! author: David A. Minton - !! - !! Finalizer for the storage data type - implicit none - ! Arguments - type(swiftest_storage(*)) :: self - ! Internals - integer(I4B) :: i - - do i = 1, self%nframes - if (allocated(self%frame(i)%item)) deallocate(self%frame(i)%item) - end do - - return - end subroutine util_final_storage - - module subroutine util_final_storage_frame(self) - !! author: David A. Minton - !! - !! Finalizer for the storage frame data type - implicit none - type(swiftest_storage_frame) :: self - - if (allocated(self%item)) deallocate(self%item) - - return - end subroutine util_final_storage_frame - - - module subroutine util_final_system(self) - !! author: David A. Minton - !! - !! Finalize the swiftest nbody system object - deallocates all allocatables - implicit none - ! Argument - class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nbody system object - - if (allocated(self%cb)) deallocate(self%cb) - if (allocated(self%pl)) deallocate(self%pl) - if (allocated(self%tp)) deallocate(self%tp) - if (allocated(self%tp_discards)) deallocate(self%tp_discards) - if (allocated(self%pl_discards)) deallocate(self%pl_discards) - - return - end subroutine util_final_system - - -end submodule s_util_final diff --git a/src/util/util_flatten.f90 b/src/util/util_flatten.f90 deleted file mode 100644 index 36fee2489..000000000 --- a/src/util/util_flatten.f90 +++ /dev/null @@ -1,148 +0,0 @@ -!! Copyright 2022 - David Minton, Carlisle Wishard, Jennifer Pouplin, Jake Elliott, & Dana Singh -!! This file is part of Swiftest. -!! Swiftest is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License -!! as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. -!! Swiftest is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty -!! of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. -!! You should have received a copy of the GNU General Public License along with Swiftest. -!! If not, see: https://www.gnu.org/licenses. - -submodule (swiftest_classes) s_util_index - use swiftest -contains - - pure module subroutine util_flatten_eucl_ij_to_k(n, i, j, k) - !! author: Jacob R. Elliott and David A. Minton - !! - !! Turns i,j indices into k index for use in the Euclidean distance matrix for pl-pl interactions. - !! - !! Reference: - !! - !! Mélodie Angeletti, Jean-Marie Bonny, Jonas Koko. Parallel Euclidean distance matrix computation on big datasets *. - !! 2019. hal-0204751 - implicit none - ! Arguments - integer(I4B), intent(in) :: n !! Number of bodies - integer(I4B), intent(in) :: i !! Index of the ith body - integer(I4B), intent(in) :: j !! Index of the jth body - integer(I8B), intent(out) :: k !! Index of the flattened matrix - ! Internals - integer(I8B) :: i8, j8, n8 - - i8 = int(i, kind=I8B) - j8 = int(j, kind=I8B) - n8 = int(n, kind=I8B) - k = (i8 - 1_I8B) * n8 - i8 * (i8 - 1_I8B) / 2_I8B + (j8 - i8) - - return - end subroutine util_flatten_eucl_ij_to_k - - - pure module subroutine util_flatten_eucl_k_to_ij(n, k, i, j) - !! author: Jacob R. Elliott and David A. Minton - !! - !! Turns k index into i,j indices for use in the Euclidean distance matrix for pl-pl interactions. - !! - !! Reference: - !! - !! Mélodie Angeletti, Jean-Marie Bonny, Jonas Koko. Parallel Euclidean distance matrix computation on big datasets *. - !! 2019. hal-0204751 - implicit none - ! Arguments - integer(I4B), intent(in) :: n !! Number of bodies - integer(I8B), intent(in) :: k !! Index of the flattened matrix - integer(I4B), intent(out) :: i !! Index of the ith body - integer(I4B), intent(out) :: j !! Index of the jth body - ! Internals - integer(I8B) :: kp, p, i8, j8, n8 - - n8 = int(n, kind=I8B) - - kp = n8 * (n8 - 1_I8B) / 2_I8B - k - p = floor((sqrt(1._DP + 8_I8B * kp) - 1_I8B) / 2_I8B) - i8 = n8 - 1_I8B - p - j8 = k - (n8 - 1_I8B) * (n8 - 2_I8B) / 2_I8B + p * (p + 1_I8B) / 2_I8B + 1_I8B - - i = int(i8, kind=I4B) - j = int(j8, kind=I4B) - - return - end subroutine util_flatten_eucl_k_to_ij - - - module subroutine util_flatten_eucl_plpl(self, param) - !! author: Jacob R. Elliott and David A. Minton - !! - !! Turns i,j indices into k index for use in the Euclidean distance matrix for pl-pl interactions for a Swiftest massive body object - !! - !! Reference: - !! - !! Mélodie Angeletti, Jean-Marie Bonny, Jonas Koko. Parallel Euclidean distance matrix computation on big datasets *. - !! 2019. hal-0204751 - implicit none - ! Arguments - class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - ! Internals - integer(I4B) :: i, j, err - integer(I8B) :: k, npl - - npl = int(self%nbody, kind=I8B) - associate(nplpl => self%nplpl) - nplpl = npl * (npl - 1_I8B) / 2_I8B ! number of entries in a strict lower triangle, npl x npl - if (param%lflatten_interactions) then - if (allocated(self%k_plpl)) deallocate(self%k_plpl) ! Reset the index array if it's been set previously - allocate(self%k_plpl(2, nplpl), stat=err) - if (err /=0) then ! An error occurred trying to allocate this big array. This probably means it's too big to fit in memory, and so we will force the run back into triangular mode - param%lflatten_interactions = .false. - else - do concurrent (i=1:npl, j=1:npl, j>i) - call util_flatten_eucl_ij_to_k(self%nbody, i, j, k) - self%k_plpl(1, k) = i - self%k_plpl(2, k) = j - end do - end if - end if - end associate - - return - end subroutine util_flatten_eucl_plpl - - - module subroutine util_flatten_eucl_pltp(self, pl, param) - !! author: Jacob R. Elliott and David A. Minton - !! - !! Turns i,j indices into k index for use in the Euclidean distance matrix for pl-tp interactions - !! - !! Reference: - !! - !! Mélodie Angeletti, Jean-Marie Bonny, Jonas Koko. Parallel Euclidean distance matrix computation on big datasets *. - !! 2019. hal-0204751 - implicit none - ! Arguments - class(swiftest_tp), intent(inout) :: self !! Swiftest test particle object - class(swiftest_pl), intent(in) :: pl !! Swiftest massive body object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - ! Internals - integer(I8B) :: i, j, counter, npl, ntp - - ntp = int(self%nbody, kind=I8B) - npl = int(pl%nbody, kind=I8B) - associate(npltp => self%npltp) - npltp = npl * ntp - if (allocated(self%k_pltp)) deallocate(self%k_pltp) ! Reset the index array if it's been set previously - allocate(self%k_pltp(2, npltp)) - do i = 1_I8B, npl - counter = (i - 1_I8B) * npl + 1_I8B - do j = 1_I8B, ntp - self%k_pltp(1, counter) = i - self%k_pltp(2, counter) = j - counter = counter + 1_I8B - end do - end do - end associate - - return - end subroutine util_flatten_eucl_pltp - -end submodule s_util_index diff --git a/src/util/util_get_energy_momentum.f90 b/src/util/util_get_energy_momentum.f90 deleted file mode 100644 index cc1e64d15..000000000 --- a/src/util/util_get_energy_momentum.f90 +++ /dev/null @@ -1,219 +0,0 @@ -!! Copyright 2022 - David Minton, Carlisle Wishard, Jennifer Pouplin, Jake Elliott, & Dana Singh -!! This file is part of Swiftest. -!! Swiftest is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License -!! as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. -!! Swiftest is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty -!! of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. -!! You should have received a copy of the GNU General Public License along with Swiftest. -!! If not, see: https://www.gnu.org/licenses. - -submodule (swiftest_classes) s_util_get_energy_momentum - use swiftest -contains - module subroutine util_get_energy_momentum_system(self, param) - !! author: David A. Minton - !! - !! Compute total system angular momentum vector and kinetic, potential and total system energy - !! - !! Adapted from David E. Kaufmann Swifter routine symba_energy_eucl.f90 - !! - !! Adapted from Martin Duncan's Swift routine anal_energy.f - implicit none - class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nbody system object - class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters - ! Internals - integer(I4B) :: i - real(DP) :: kecb, kespincb - real(DP), dimension(self%pl%nbody) :: kepl, kespinpl - real(DP), dimension(self%pl%nbody) :: Lplorbitx, Lplorbity, Lplorbitz - real(DP), dimension(self%pl%nbody) :: Lplspinx, Lplspiny, Lplspinz - real(DP), dimension(NDIM) :: Lcborbit, Lcbspin - real(DP) :: hx, hy, hz - - associate(system => self, pl => self%pl, npl => self%pl%nbody, cb => self%cb) - system%Lorbit(:) = 0.0_DP - system%Lspin(:) = 0.0_DP - system%Ltot(:) = 0.0_DP - system%ke_orbit = 0.0_DP - system%ke_spin = 0.0_DP - - kepl(:) = 0.0_DP - Lplorbitx(:) = 0.0_DP - Lplorbity(:) = 0.0_DP - Lplorbitz(:) = 0.0_DP - Lplspinx(:) = 0.0_DP - Lplspiny(:) = 0.0_DP - Lplspinz(:) = 0.0_DP - - pl%lmask(1:npl) = pl%status(1:npl) /= INACTIVE - - system%GMtot = cb%Gmass + sum(pl%Gmass(1:npl), pl%lmask(1:npl)) - kecb = cb%mass * dot_product(cb%vb(:), cb%vb(:)) - Lcborbit(:) = cb%mass * (cb%rb(:) .cross. cb%vb(:)) - - do concurrent (i = 1:npl, pl%lmask(i)) - hx = pl%rb(2,i) * pl%vb(3,i) - pl%rb(3,i) * pl%vb(2,i) - hy = pl%rb(3,i) * pl%vb(1,i) - pl%rb(1,i) * pl%vb(3,i) - hz = pl%rb(1,i) * pl%vb(2,i) - pl%rb(2,i) * pl%vb(1,i) - - ! Angular momentum from orbit - Lplorbitx(i) = pl%mass(i) * hx - Lplorbity(i) = pl%mass(i) * hy - Lplorbitz(i) = pl%mass(i) * hz - - ! Kinetic energy from orbit - kepl(i) = pl%mass(i) * dot_product(pl%vb(:,i), pl%vb(:,i)) - end do - - if (param%lrotation) then - kespincb = cb%mass * cb%Ip(3) * cb%radius**2 * dot_product(cb%rot(:), cb%rot(:)) - - ! For simplicity, we always assume that the rotation pole is the 3rd principal axis - Lcbspin(:) = cb%Ip(3) * cb%mass * cb%radius**2 * cb%rot(:) - - do concurrent (i = 1:npl, pl%lmask(i)) - ! Currently we assume that the rotation pole is the 3rd principal axis - ! Angular momentum from spin - Lplspinx(i) = pl%mass(i) * pl%Ip(3,i) * pl%radius(i)**2 * pl%rot(1,i) - Lplspiny(i) = pl%mass(i) * pl%Ip(3,i) * pl%radius(i)**2 * pl%rot(2,i) - Lplspinz(i) = pl%mass(i) * pl%Ip(3,i) * pl%radius(i)**2 * pl%rot(3,i) - - ! Kinetic energy from spin - kespinpl(i) = pl%mass(i) * pl%Ip(3,i) * pl%radius(i)**2 * dot_product(pl%rot(:,i), pl%rot(:,i)) - end do - else - kespincb = 0.0_DP - kespinpl(:) = 0.0_DP - end if - - if (param%lflatten_interactions) then - call util_get_energy_potential_flat(npl, pl%nplpl, pl%k_plpl, pl%lmask, cb%Gmass, pl%Gmass, pl%mass, pl%rb, system%pe) - else - call util_get_energy_potential_triangular(npl, pl%lmask, cb%Gmass, pl%Gmass, pl%mass, pl%rb, system%pe) - end if - - ! Potential energy from the oblateness term - if (param%loblatecb) then - call system%obl_pot() - system%pe = system%pe + system%oblpot - end if - - system%ke_orbit = 0.5_DP * (kecb + sum(kepl(1:npl), pl%lmask(1:npl))) - if (param%lrotation) system%ke_spin = 0.5_DP * (kespincb + sum(kespinpl(1:npl), pl%lmask(1:npl))) - - system%Lorbit(1) = Lcborbit(1) + sum(Lplorbitx(1:npl), pl%lmask(1:npl)) - system%Lorbit(2) = Lcborbit(2) + sum(Lplorbity(1:npl), pl%lmask(1:npl)) - system%Lorbit(3) = Lcborbit(3) + sum(Lplorbitz(1:npl), pl%lmask(1:npl)) - - if (param%lrotation) then - system%Lspin(1) = Lcbspin(1) + sum(Lplspinx(1:npl), pl%lmask(1:npl)) - system%Lspin(2) = Lcbspin(2) + sum(Lplspiny(1:npl), pl%lmask(1:npl)) - system%Lspin(3) = Lcbspin(3) + sum(Lplspinz(1:npl), pl%lmask(1:npl)) - end if - - system%te = system%ke_orbit + system%ke_spin + system%pe - system%Ltot(:) = system%Lorbit(:) + system%Lspin(:) - end associate - - return - end subroutine util_get_energy_momentum_system - - - subroutine util_get_energy_potential_flat(npl, nplpl, k_plpl, lmask, GMcb, Gmass, mass, rb, pe) - !! author: David A. Minton - !! - !! Compute total system potential energy - implicit none - ! Arguments - integer(I4B), intent(in) :: npl - integer(I8B), intent(in) :: nplpl - integer(I4B), dimension(:,:), intent(in) :: k_plpl - logical, dimension(:), intent(in) :: lmask - real(DP), intent(in) :: GMcb - real(DP), dimension(:), intent(in) :: Gmass - real(DP), dimension(:), intent(in) :: mass - real(DP), dimension(:,:), intent(in) :: rb - real(DP), intent(out) :: pe - ! Internals - integer(I4B) :: i, j - integer(I8B) :: k - real(DP), dimension(npl) :: pecb - real(DP), dimension(nplpl) :: pepl - logical, dimension(nplpl) :: lstatpl - - ! Do the central body potential energy component first - where(.not. lmask(1:npl)) - pecb(1:npl) = 0.0_DP - end where - - do concurrent(i = 1:npl, lmask(i)) - pecb(i) = -GMcb * mass(i) / norm2(rb(:,i)) - end do - - !$omp parallel do default(private) schedule(static)& - !$omp shared(k_plpl, rb, mass, Gmass, pepl, lstatpl, lmask) & - !$omp firstprivate(nplpl) - do k = 1, nplpl - i = k_plpl(1,k) - j = k_plpl(2,k) - lstatpl(k) = (lmask(i) .and. lmask(j)) - if (lstatpl(k)) then - pepl(k) = -(Gmass(i) * mass(j)) / norm2(rb(:, i) - rb(:, j)) - else - pepl(k) = 0.0_DP - end if - end do - !$omp end parallel do - - pe = sum(pepl(:), lstatpl(:)) + sum(pecb(1:npl), lmask(1:npl)) - - return - end subroutine util_get_energy_potential_flat - - - subroutine util_get_energy_potential_triangular(npl, lmask, GMcb, Gmass, mass, rb, pe) - !! author: David A. Minton - !! - !! Compute total system potential energy - implicit none - ! Arguments - integer(I4B), intent(in) :: npl - logical, dimension(:), intent(in) :: lmask - real(DP), intent(in) :: GMcb - real(DP), dimension(:), intent(in) :: Gmass - real(DP), dimension(:), intent(in) :: mass - real(DP), dimension(:,:), intent(in) :: rb - real(DP), intent(out) :: pe - ! Internals - integer(I4B) :: i, j - real(DP), dimension(npl) :: pecb, pepl - - ! Do the central body potential energy component first - where(.not. lmask(1:npl)) - pecb(1:npl) = 0.0_DP - end where - - do concurrent(i = 1:npl, lmask(i)) - pecb(i) = -GMcb * mass(i) / norm2(rb(:,i)) - end do - - pe = 0.0_DP - !$omp parallel do default(private) schedule(static)& - !$omp shared(lmask, Gmass, mass, rb) & - !$omp firstprivate(npl) & - !$omp reduction(+:pe) - do i = 1, npl - if (lmask(i)) then - do concurrent(j = i+1:npl, lmask(i) .and. lmask(j)) - pepl(j) = - (Gmass(i) * mass(j)) / norm2(rb(:, i) - rb(:, j)) - end do - pe = pe + sum(pepl(i+1:npl), lmask(i+1:npl)) - end if - end do - !$omp end parallel do - pe = pe + sum(pecb(1:npl), lmask(1:npl)) - - return - end subroutine util_get_energy_potential_triangular - -end submodule s_util_get_energy_momentum diff --git a/src/util/util_index.f90 b/src/util/util_index.f90 deleted file mode 100644 index e268b3789..000000000 --- a/src/util/util_index.f90 +++ /dev/null @@ -1,160 +0,0 @@ -!! Copyright 2022 - David Minton, Carlisle Wishard, Jennifer Pouplin, Jake Elliott, & Dana Singh -!! This file is part of Swiftest. -!! Swiftest is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License -!! as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. -!! Swiftest is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty -!! of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. -!! You should have received a copy of the GNU General Public License along with Swiftest. -!! If not, see: https://www.gnu.org/licenses. - -submodule (swiftest_classes) s_util_index_array - use swiftest -contains - - module subroutine util_index_array(ind_arr, n) - !! author: David A. Minton - !! - !! Creates or resizes an index array of size n where ind_arr = [1, 2, ... n]. - !! This subroutine assumes that if ind_arr is already allocated, it is a pre-existing index array of a different size. - implicit none - ! Arguments - integer(I4B), dimension(:), allocatable, intent(inout) :: ind_arr !! Index array. Input is a pre-existing index array where n /= size(ind_arr). Output is a new index array ind_arr = [1, 2, ... n] - integer(I4B), intent(in) :: n !! The new size of the index array - ! Internals - integer(I4B) :: nold, i - integer(I4B), dimension(:), allocatable :: itmp - - if (allocated(ind_arr)) then - nold = size(ind_arr) - if (nold == n) return ! Nothing to do, so go home - else - nold = 0 - end if - - allocate(itmp(n)) - if (n >= nold) then - if (nold > 0) itmp(1:nold) = ind_arr(1:nold) - itmp(nold+1:n) = [(i, i = nold + 1, n)] - call move_alloc(itmp, ind_arr) - else - itmp(1:n) = ind_arr(1:n) - call move_alloc(itmp, ind_arr) - end if - - return - end subroutine util_index_array - - - module subroutine util_get_idvalues_system(self, idvals) - !! author: David A. Minton - !! - !! Returns an array of all id values saved in this snapshot - implicit none - ! Arguments - class(swiftest_nbody_system), intent(in) :: self !! Encounter snapshot object - integer(I4B), dimension(:), allocatable, intent(out) :: idvals !! Array of all id values saved in this snapshot - ! Internals - integer(I4B) :: npl, ntp - - if (allocated(self%pl)) then - npl = self%pl%nbody - else - npl = 0 - end if - if (allocated(self%tp)) then - ntp = self%tp%nbody - else - ntp = 0 - end if - - allocate(idvals(1 + npl+ntp)) - - idvals(1) = self%cb%id - if (npl > 0) idvals(2:npl+1) = self%pl%id(:) - if (ntp > 0) idvals(npl+2:npl+ntp+1) = self%tp%id(:) - - return - - end subroutine util_get_idvalues_system - - - module subroutine util_get_vals_storage(self, idvals, tvals) - !! author: David A. Minton - !! - !! Gets the id values in a storage object, regardless of whether it is encounter of collision - ! Argument - class(swiftest_storage(*)), intent(in) :: self !! Swiftest storage object - integer(I4B), dimension(:), allocatable, intent(out) :: idvals !! Array of all id values in all snapshots - real(DP), dimension(:), allocatable, intent(out) :: tvals !! Array of all time values in all snapshots - ! Internals - integer(I4B) :: i, n, nlo, nhi, ntotal - integer(I4B), dimension(:), allocatable :: itmp - - associate(nsnaps => self%iframe) - - allocate(tvals(nsnaps)) - tvals(:) = 0.0_DP - - ! First pass to get total number of ids - ntotal = 0 - do i = 1, nsnaps - if (allocated(self%frame(i)%item)) then - select type(snapshot => self%frame(i)%item) - class is (swiftest_nbody_system) - tvals(i) = snapshot%t - call snapshot%get_idvals(itmp) - if (allocated(itmp)) then - n = size(itmp) - ntotal = ntotal + n - end if - end select - end if - end do - - allocate(idvals(ntotal)) - nlo = 1 - ! Second pass to store all ids get all of the ids stored - do i = 1, nsnaps - if (allocated(self%frame(i)%item)) then - select type(snapshot => self%frame(i)%item) - class is (swiftest_nbody_system) - tvals(i) = snapshot%t - call snapshot%get_idvals(itmp) - if (allocated(itmp)) then - n = size(itmp) - nhi = nlo + n - 1 - idvals(nlo:nhi) = itmp(1:n) - nlo = nhi + 1 - end if - end select - end if - end do - - end associate - return - end subroutine util_get_vals_storage - - - module subroutine util_index_map_storage(self) - !! author: David A. Minton - !! - !! Maps body id values to storage index values so we don't have to use unlimited dimensions for id - implicit none - ! Arguments - class(swiftest_storage(*)), intent(inout) :: self !! Swiftest storage object - ! Internals - integer(I4B), dimension(:), allocatable :: idvals - real(DP), dimension(:), allocatable :: tvals - - call self%get_index_values(idvals, tvals) - - call util_unique(idvals,self%idvals,self%idmap) - self%nid = size(self%idvals) - - call util_unique(tvals,self%tvals,self%tmap) - self%nt = size(self%tvals) - - return - end subroutine util_index_map_storage - -end submodule s_util_index_array \ No newline at end of file diff --git a/src/util/util_minimize_bfgs.f90 b/src/util/util_minimize_bfgs.f90 deleted file mode 100644 index 970a0ae45..000000000 --- a/src/util/util_minimize_bfgs.f90 +++ /dev/null @@ -1,593 +0,0 @@ -!! Copyright 2022 - David Minton, Carlisle Wishard, Jennifer Pouplin, Jake Elliott, & Dana Singh -!! This file is part of Swiftest. -!! Swiftest is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License -!! as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. -!! Swiftest is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty -!! of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. -!! You should have received a copy of the GNU General Public License along with Swiftest. -!! If not, see: https://www.gnu.org/licenses. - -submodule (swiftest_classes) s_util_minimize_bfgs - use swiftest -contains - module subroutine util_minimize_bfgs(f, N, x0, eps, maxloop, lerr, x1) - !! author: David A. Minton - !! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - !! This function implements the Broyden-Fletcher-Goldfarb-Shanno method to determine the minimum of a function of N variables. - !! It recieves as input: - !! f%eval(x) : lambda function object containing the objective function as the eval metho - !! N : Number of variables of function f - !! x0 : Initial starting value of x - !! eps : Accuracy of 1 - dimensional minimization at each step - !! maxloop : Maximum number of loops to attempt to find a solution - !! The outputs include - !! lerr : Returns .true. if it could not find the minimum - !! Returns - !! x1 : Final minimum (all 0 if none found) - !! 0 = No miniumum found - !! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - use, intrinsic :: ieee_exceptions - implicit none - ! Arguments - integer(I4B), intent(in) :: N - class(lambda_obj), intent(inout) :: f - real(DP), dimension(:), intent(in) :: x0 - real(DP), intent(in) :: eps - integer(I4B), intent(in) :: maxloop - logical, intent(out) :: lerr - ! Result - real(DP), dimension(:), intent(out), allocatable :: x1 - ! Internals - integer(I4B) :: i, j, k, l, conv - real(DP), parameter :: graddelta = 1e-4_DP !! Delta x for gradient calculations - real(DP), dimension(N) :: S !! Direction vectors - real(DP), dimension(N,N) :: H !! Approximated inverse Hessian matrix - real(DP), dimension(N) :: grad1 !! gradient of f - real(DP), dimension(N) :: grad0 !! old value of gradient - real(DP) :: astar !! 1D minimized value - real(DP), dimension(N) :: y, P - real(DP), dimension(N,N) :: PP, PyH, HyP - real(DP), save :: yHy, Py - type(ieee_status_type) :: original_fpe_status - logical, dimension(:), allocatable :: fpe_flag - - call ieee_get_status(original_fpe_status) ! Save the original floating point exception status - call ieee_set_flag(ieee_all, .false.) ! Set all flags to quiet - allocate(fpe_flag(size(ieee_usual))) - - lerr = .false. - allocate(x1, source=x0) - ! Initialize approximate Hessian with the identity matrix (i.e. begin with method of steepest descent) - ! Get initial gradient and initialize arrays for updated values of gradient and x - H(:,:) = reshape([((0._DP, i=1, j-1), 1._DP, (0._DP, i=j+1, N), j=1, N)], [N,N]) - grad0 = gradf(f, N, x0(:), graddelta, lerr) - if (lerr) then - call ieee_set_status(original_fpe_status) - return - end if - grad1(:) = grad0(:) - do i = 1, maxloop - !check for convergence - conv = count(abs(grad1(:)) > eps) - if (conv == 0) exit - S(:) = -matmul(H(:,:), grad1(:)) - astar = minimize1D(f, x1, S, N, graddelta, lerr) - if (lerr) exit - ! Get new x values - P(:) = astar * S(:) - x1(:) = x1(:) + P(:) - ! Calculate new gradient - grad0(:) = grad1(:) - grad1 = gradf(f, N, x1, graddelta, lerr) - y(:) = grad1(:) - grad0(:) - Py = sum(P(:) * y(:)) - ! set up factors for H matrix update - yHy = 0._DP - !$omp do simd schedule(static)& - !$omp firstprivate(N, y, H) & - !$omp reduction(+:yHy) - do k = 1, N - do j = 1, N - yHy = yHy + y(j) * H(j,k) * y(k) - end do - end do - !$omp end do simd - ! prevent divide by zero (convergence) - if (abs(Py) < tiny(Py)) exit - ! set up update - PyH(:,:) = 0._DP - HyP(:,:) = 0._DP - !$omp parallel do default(private) schedule(static)& - !$omp shared(N, PP, P, y, H) & - !$omp reduction(+:PyH, HyP) - do k = 1, N - do j = 1, N - PP(j, k) = P(j) * P(k) - do l = 1, N - PyH(j, k) = PyH(j, k) + P(j) * y(l) * H(l,k) - HyP(j, k) = HyP(j, k) + P(k) * y(l) * H(j,l) - end do - end do - end do - !$omp end parallel do - ! update H matrix - H(:,:) = H(:,:) + ((1._DP - yHy / Py) * PP(:,:) - PyH(:,:) - HyP(:,:)) / Py - ! Normalize to prevent it from blowing up if it takes many iterations to find a solution - H(:,:) = H(:,:) / norm2(H(:,:)) - ! Stop everything if there are any exceptions to allow the routine to fail gracefully - call ieee_get_flag(ieee_usual, fpe_flag) - if (any(fpe_flag)) exit - if (i == maxloop) then - lerr = .true. - end if - end do - call ieee_get_flag(ieee_usual, fpe_flag) - lerr = lerr .or. any(fpe_flag) - call ieee_set_status(original_fpe_status) - - return - - contains - - function gradf(f, N, x1, dx, lerr) result(grad) - !! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - !! Purpose: Estimates the gradient of a function using a central difference - !! approximation - !! Inputs: - !! f%eval(x) : lambda function object containing the objective function as the eval metho - !! N : number of variables N - !! x1 : x value array - !! dx : step size to use when calculating derivatives - !! Outputs: - !! lerr : .true. if an error occurred. Otherwise returns .false. - !! Returns - !! grad : N sized array containing estimated gradient of f at x1 - !! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - implicit none - ! Arguments - integer(I4B), intent(in) :: N - class(lambda_obj), intent(inout) :: f - real(DP), dimension(:), intent(in) :: x1 - real(DP), intent(in) :: dx - logical, intent(out) :: lerr - ! Result - real(DP), dimension(N) :: grad - ! Internals - integer(I4B) :: i, j - real(DP), dimension(N) :: xp, xm - real(DP) :: fp, fm - logical :: lerrp, lerrm - - do i = 1, N - do j = 1, N - if (j == i) then - xp(j) = x1(j) + dx - xm(j) = x1(j) - dx - else - xp(j) = x1(j) - xm(j) = x1(j) - end if - end do - select type (f) - class is (lambda_obj_err) - fp = f%eval(xp) - lerrp = f%lerr - fm = f%eval(xm) - lerrm = f%lerr - lerr = lerrp .or. lerrm - class is (lambda_obj) - fp = f%eval(xp) - fm = f%eval(xm) - lerr = .false. - end select - grad(i) = (fp - fm) / (2 * dx) - if (lerr) return - end do - return - end function gradf - - - function minimize1D(f, x0, S, N, eps, lerr) result(astar) - !! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - !! This program find the minimum of a function of N variables in a single direction - !! S using in sequence: - !! 1. A Bracketing method - !! 2. The golden section method - !! 3. A quadratic polynomial fit - !! Inputs - !! f%eval(x) : lambda function object containing the objective function as the eval metho - !! x0 : Array of size N of initial x values - !! S : Array of size N that determines the direction of minimization - !! N : Number of variables of function f - !! eps : Accuracy of 1 - dimensional minimization at each step - !! Output - !! lerr : .true. if an error occurred. Otherwise returns .false. - !! Returns - !! astar : Final minimum along direction S - !! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - implicit none - ! Arguments - integer(I4B), intent(in) :: N - class(lambda_obj), intent(inout) :: f - real(DP), dimension(:), intent(in) :: x0, S - real(DP), intent(in) :: eps - logical, intent(out) :: lerr - ! Result - real(DP) :: astar - ! Internals - integer(I4B) :: num = 0 - real(DP), parameter :: step = 0.7_DP !! Bracketing method step size - real(DP), parameter :: gam = 1.2_DP !! Bracketing method expansion parameter - real(DP), parameter :: greduce = 0.2_DP !! Golden section method reduction factor - real(DP), parameter :: greduce2 = 0.1_DP ! Secondary golden section method reduction factor - real(DP) :: alo, ahi !! High and low values for 1 - D minimization routines - real(DP), parameter :: a0 = epsilon(1.0_DP) !! Initial guess of alpha - - alo = a0 - call bracket(f, x0, S, N, gam, step, alo, ahi, lerr) - if (lerr) then - !write(*,*) "BFGS bracketing step failed!" - !write(*,*) "alo: ",alo, "ahi: ", ahi - return - end if - if (abs(alo - ahi) < eps) then - astar = alo - lerr = .false. - return - end if - call golden(f, x0, S, N, greduce, alo, ahi, lerr) - if (lerr) then - !write(*,*) "BFGS golden section step failed!" - return - end if - if (abs(alo - ahi) < eps) then - astar = alo - lerr = .false. - return - end if - call quadfit(f, x0, S, N, eps, alo, ahi, lerr) - if (lerr) then - !write(*,*) "BFGS quadfit failed!" - return - end if - if (abs(alo - ahi) < eps) then - astar = alo - lerr = .false. - return - end if - ! Quadratic fit method won't converge, so finish off with another golden section - call golden(f, x0, S, N, greduce2, alo, ahi, lerr) - if (.not. lerr) astar = (alo + ahi) / 2.0_DP - return - end function minimize1D - - - function n2one(f, x0, S, N, a, lerr) result(fnew) - implicit none - ! Arguments - integer(I4B), intent(in) :: N - class(lambda_obj), intent(inout) :: f - real(DP), dimension(:), intent(in) :: x0, S - real(DP), intent(in) :: a - logical, intent(out) :: lerr - - ! Return - real(DP) :: fnew - ! Internals - real(DP), dimension(N) :: xnew - integer(I4B) :: i - - xnew(:) = x0(:) + a * S(:) - fnew = f%eval(xnew(:)) - select type(f) - class is (lambda_obj_err) - lerr = f%lerr - class is (lambda_obj) - lerr = .false. - end select - return - end function n2one - - ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - subroutine bracket(f, x0, S, N, gam, step, lo, hi, lerr) - ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - !! This subroutine brackets the minimum. It recieves as input: - !! f%eval(x) : lambda function object containing the objective function as the eval metho - !! x0 : Array of size N of initial x values - !! S : Array of size N that determines the direction of minimization - !! gam : expansion parameter - !! step : step size - !! lo : initial guess of lo bracket value - !! The outputs include - !! lo : lo bracket - !! hi : hi bracket - !! lerr : .true. if an error occurred. Otherwise returns .false. - !! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - implicit none - ! Arguments - integer(I4B), intent(in) :: N - class(lambda_obj), intent(inout) :: f - real(DP), dimension(:), intent(in) :: x0, S - real(DP), intent(in) :: gam, step - real(DP), intent(inout) :: lo - real(DP), intent(out) :: hi - logical, intent(out) :: lerr - ! Internals - real(DP) :: a0, a1, a2, atmp, da - real(DP) :: f0, f1, f2 - integer(I4B) :: i, j - integer(I4B), parameter :: MAXLOOP = 100 ! maximum number of loops before method is determined to have failed - real(DP), parameter :: eps = epsilon(lo) ! small number precision to test floating point equality - - ! set up initial bracket points - a0 = lo - da = step - a1 = a0 + da - a2 = a0 + 2 * da - f0 = n2one(f, x0, S, N, a0, lerr) - if (lerr) return - f1 = n2one(f, x0, S, N, a1, lerr) - if (lerr) return - f2 = n2one(f, x0, S, N, a2, lerr) - if (lerr) return - ! loop over bracket method until either min is bracketed method fails - do i = 1, MAXLOOP - if ((f0 > f1) .and. (f1 < f2)) then ! Minimum was found - lo = a0 - hi = a2 - return - else if ((f0 >= f1) .and. (f1 > f2)) then ! Function appears to decrease - da = da * gam - atmp = a2 + da - a0 = a1 - a1 = a2 - a2 = atmp - f0 = f1 - f1 = f2 - f2 = n2one(f, x0, S, N, a2, lerr) - else if ((f0 < f1) .and. (f1 <= f2)) then ! Function appears to increase - da = da * gam - atmp = a0 - da - a2 = a1 - a1 = a0 - a0 = atmp - f2 = f1 - f0 = n2one(f, x0, S, N, a0, lerr) - else if ((f0 < f1) .and. (f1 > f2)) then ! We are at a peak. Pick the direction that descends the fastest - da = da * gam - if (f2 > f0) then ! LHS is lower than RHS - atmp = a2 + da - a0 = a1 - a1 = a2 - a2 = atmp - f0 = f1 - f1 = f2 - f2 = n2one(f, x0, S, N, a2, lerr) - else ! RHS is lower than LHS - atmp = a0 - da - a2 = a1 - a1 = a0 - a0 = atmp - f2 = f1 - f1 = f2 - f0 = n2one(f, x0, S, N, a0, lerr) - end if - else if ((f0 > f1) .and. (abs(f2 - f1) <= eps)) then ! Decrasging but RHS equal - da = da * gam - atmp = a2 + da - a2 = atmp - f2 = n2one(f, x0, S, N, a2, lerr) - else if ((abs(f0 - f1) < eps) .and. (f1 < f2)) then ! Increasing but LHS equal - da = da * gam - atmp = a0 - da - a0 = atmp - f0 = n2one(f, x0, S, N, a0, lerr) - else ! all values equal. Expand in either direction and try again - a0 = a0 - da - a2 = a2 + da - f0 = n2one(f, x0, S, N, a0, lerr) - if (lerr) exit ! An error occurred while evaluating the function - f2 = n2one(f, x0, S, N, a2, lerr) - end if - if (lerr) exit ! An error occurred while evaluating the function - end do - lerr = .true. - return ! no minimum found - end subroutine bracket - - ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - subroutine golden(f, x0, S, N, eps, lo, hi, lerr) - ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - !! This function uses the golden section method to reduce the starting interval lo, hi by some amount sigma. - !! It recieves as input: - !! f%eval(x) : lambda function object containing the objective function as the eval metho - !! x0 : Array of size N of initial x values - !! S : Array of size N that determines the direction of minimization - !! gam : expansion parameter - !! eps : reduction interval in range (0 < sigma < 1) such that: - !! hi(new) - lo(new) = eps * (hi(old) - lo(old)) - !! lo : initial guess of lo bracket value - !! The outputs include - !! lo : lo bracket - !! hi : hi bracket - !! lerr : .true. if an error occurred. Otherwise returns .false. - !! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - implicit none - ! Arguments - integer(I4B), intent(in) :: N - class(lambda_obj), intent(inout) :: f - real(DP), dimension(:), intent(in) :: x0, S - real(DP), intent(in) :: eps - real(DP), intent(inout) :: lo - real(DP), intent(out) :: hi - logical, intent(out) :: lerr - ! Internals - real(DP), parameter :: tau = 0.5_DP * (sqrt(5.0_DP) - 1.0_DP) ! Golden section constant - integer(I4B), parameter :: MAXLOOP = 40 ! maximum number of loops before method is determined to have failed (unlikely, but could occur if no minimum exists between lo and hi) - real(DP) :: i0 ! Initial interval value - real(DP) :: a1, a2 - real(DP) :: f1, f2 - integer(I4B) :: i, j - - i0 = hi - lo - a1 = hi - tau * i0 - a2 = lo + tau * i0 - f1 = n2one(f, x0, S, N, a1, lerr) - if (lerr) return - f2 = n2one(f, x0, S, N, a2, lerr) - if (lerr) return - do i = 1, MAXLOOP - if (abs((hi - lo) / i0) <= eps) return ! interval reduced to input amount - if (f2 > f1) then - hi = a2 - a2 = a1 - f2 = f1 - a1 = hi - tau * (hi - lo) - f1 = n2one(f, x0, S, N, a1, lerr) - else - lo = a1 - a1 = a2 - f2 = f1 - a2 = hi - (1.0_DP - tau) * (hi - lo) - f2 = n2one(f, x0, S, N, a2, lerr) - end if - if (lerr) exit - end do - lerr = .true. - return ! search took too many iterations - no minimum found - end subroutine golden - - ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - subroutine quadfit(f, x0, S, N, eps, lo, hi, lerr) - ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - !! This function uses a quadratic polynomial fit to locate the minimum of a function - !! to some accuracy eps. It recieves as input: - !! f%eval(x) : lambda function object containing the objective function as the eval metho - !! lo : low bracket value - !! hi : high bracket value - !! eps : desired accuracy of final minimum location - !! The outputs include - !! lo : final minimum location - !! hi : final minimum location - !! Notes: Uses the ieee_exceptions intrinsic module to allow for graceful failure due to floating point exceptions, which won't terminate the run. - !! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - implicit none - ! Arguments - integer(I4B), intent(in) :: N - class(lambda_obj), intent(inout) :: f - real(DP), dimension(:), intent(in) :: x0, S - real(DP), intent(in) :: eps - real(DP), intent(inout) :: lo - real(DP), intent(out) :: hi - logical, intent(out) :: lerr - ! Internals - integer(I4B), parameter :: MAXLOOP = 20 ! maximum number of loops before method is determined to have failed. - real(DP) :: a1, a2, a3, astar ! three points for the polynomial fit and polynomial minimum - real(DP) :: f1, f2, f3, fstar ! three function values for the polynomial and polynomial minimum - real(DP), dimension(3) :: row_1, row_2, row_3, rhs, soln ! matrix for 3 equation solver (gaussian elimination) - real(DP), dimension(3,3) :: lhs - real(DP) :: d1, d2, d3, aold, denom, errval - integer(I4B) :: i - - lerr = .false. - ! Get initial a1, a2, a3 values - a1 = lo - a2 = lo + 0.5_DP * (hi - lo) - a3 = hi - aold = a1 - astar = a2 - f1 = n2one(f, x0, S, N, a1, lerr) - if (lerr) return - f2 = n2one(f, x0, S, N, a2, lerr) - if (lerr) return - f3 = n2one(f, x0, S, N, a3, lerr) - if (lerr) return - do i = 1, MAXLOOP - ! check to see if convergence is reached and exit - errval = abs((astar - aold) / astar) - call ieee_get_flag(ieee_usual, fpe_flag) - if (any(fpe_flag)) then - !write(*,*) 'quadfit fpe' - !write(*,*) 'aold : ',aold - !write(*,*) 'astar: ',astar - lerr = .true. - exit - end if - if (errval < eps) then - lo = astar - hi = astar - exit - end if - ! Set up system for gaussian elimination equation solver - row_1 = [1.0_DP, a1, a1**2] - row_2 = [1.0_DP, a2, a2**2] - row_3 = [1.0_DP, a3, a3**2] - rhs = [f1, f2, f3] - lhs(1, :) = row_1 - lhs(2, :) = row_2 - lhs(3, :) = row_3 - ! Solve system of equations - soln(:) = util_solve_linear_system(lhs, rhs, 3, lerr) - call ieee_set_flag(ieee_all, .false.) ! Set all flags back to quiet - call ieee_set_halting_mode(ieee_divide_by_zero, .false.) - if (lerr) then - !write(*,*) 'quadfit fpe:' - !write(*,*) 'util_solve_linear_system failed' - exit - end if - aold = astar - if (soln(2) == soln(3)) then ! Handles the case where they are both 0. 0/0 is an unhandled exception - astar = -0.5_DP - else - astar = -soln(2) / (2 * soln(3)) - end if - call ieee_get_flag(ieee_usual, fpe_flag) - if (any(fpe_flag)) then - !write(*,*) 'quadfit fpe' - !write(*,*) 'soln(2:3): ',soln(2:3) - !write(*,*) 'a1, a2, a3' - !write(*,*) a1, a2, a3 - !write(*,*) 'f1, f2, f3' - !write(*,*) f1, f2, f3 - lerr = .true. - exit - end if - fstar = n2one(f, x0, S, N, astar, lerr) - if (lerr) exit - ! keep the three closest a values to astar and discard the fourth - d1 = abs(a1 - astar) - d2 = abs(a2 - astar) - d3 = abs(a3 - astar) - - if (d1 > d2) then - if (d1 > d3) then - f1 = fstar - a1 = astar - else if (d3 > d2) then - f3 = fstar - a3 = astar - end if - else - if (d2 > d3) then - f2 = fstar - a2 = astar - else if (d3 > d1) then - f3 = fstar - a3 = astar - end if - end if - end do - if (lerr) return - lo = a1 - hi = a3 - return - end subroutine quadfit - - end subroutine util_minimize_bfgs -end submodule s_util_minimize_bfgs \ No newline at end of file diff --git a/src/util/util_peri.f90 b/src/util/util_peri.f90 deleted file mode 100644 index 76252828e..000000000 --- a/src/util/util_peri.f90 +++ /dev/null @@ -1,75 +0,0 @@ -!! Copyright 2022 - David Minton, Carlisle Wishard, Jennifer Pouplin, Jake Elliott, & Dana Singh -!! This file is part of Swiftest. -!! Swiftest is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License -!! as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. -!! Swiftest is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty -!! of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. -!! You should have received a copy of the GNU General Public License along with Swiftest. -!! If not, see: https://www.gnu.org/licenses. - -submodule (swiftest_classes) s_util_peri - use swiftest -contains - - module subroutine util_peri_tp(self, system, param) - !! author: David A. Minton - !! - !! Determine system pericenter passages for test particles - !! Note: If the coordinate system used is barycentric, then this routine assumes that the barycentric coordinates in the - !! test particle structures are up-to-date and are not recomputed - !! - !! Adapted from David E. Kaufmann's Swifter routine: util_peri.f90 - !! Adapted from Hal Levison's Swift routine util_peri.f - implicit none - ! Arguments - class(swiftest_tp), intent(inout) :: self !! Swiftest test particle object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object - class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters - ! Internals - integer(I4B) :: i - real(DP) :: e - real(DP), dimension(:), allocatable :: vdotr - - associate(tp => self, ntp => self%nbody) - allocate(vdotr(ntp)) - if (param%qmin_coord == "HELIO") then - do i = 1, ntp - vdotr(i) = dot_product(tp%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%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 - if (vdotr(i) > 0.0_DP) then - tp%isperi(i) = 1 - else - tp%isperi(i) = -1 - end if - end if - end do - else - do i = 1, ntp - vdotr(i) = dot_product(tp%rb(:, i), tp%vb(:, i)) - if (tp%isperi(i) == -1) then - if (vdotr(i) >= 0.0_DP) then - tp%isperi(i) = 0 - call orbel_xv2aeq(system%Gmtot, tp%rb(1,i), tp%rb(2,i), tp%rb(3,i), tp%vb(1,i), tp%vb(2,i), tp%vb(3,i), & - tp%atp(i), e, tp%peri(i)) - end if - else - if (vdotr(i) > 0.0_DP) then - tp%isperi(i) = 1 - else - tp%isperi(i) = -1 - end if - end if - end do - end if - end associate - - return - end subroutine util_peri_tp - -end submodule s_util_peri diff --git a/src/util/util_rescale.f90 b/src/util/util_rescale.f90 deleted file mode 100644 index 372edd3fb..000000000 --- a/src/util/util_rescale.f90 +++ /dev/null @@ -1,63 +0,0 @@ -!! Copyright 2022 - David Minton, Carlisle Wishard, Jennifer Pouplin, Jake Elliott, & Dana Singh -!! This file is part of Swiftest. -!! Swiftest is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License -!! as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. -!! Swiftest is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty -!! of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. -!! You should have received a copy of the GNU General Public License along with Swiftest. -!! If not, see: https://www.gnu.org/licenses. - -submodule (swiftest_classes) s_util_rescale - use swiftest -contains - module subroutine util_rescale_system(self, param, mscale, dscale, tscale) - !! author: David A. Minton - !! - !! Rescales an nbody system to a new set of units. Inputs are the multipliers on the mass (mscale), distance (dscale), and time units (tscale). - !! Rescales all united quantities in the system, as well as the mass conversion factors, gravitational constant, and Einstein's constant in the parameter object. - implicit none - class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nbody system object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters. Returns with new values of the scale vactors and GU - real(DP), intent(in) :: mscale, dscale, tscale !! Scale factors for mass, distance, and time units, respectively. - ! Internals - real(DP) :: vscale - - param%MU2KG = param%MU2KG * mscale - param%DU2M = param%DU2M * dscale - param%TU2S = param%TU2S * tscale - - ! Calculate the G for the system units - param%GU = GC / (param%DU2M**3 / (param%MU2KG * param%TU2S**2)) - - if (param%lgr) then - ! Calculate the inverse speed of light in the system units - param%inv_c2 = einsteinC * param%TU2S / param%DU2M - param%inv_c2 = (param%inv_c2)**(-2) - end if - - vscale = dscale / tscale - - associate(cb => self%cb, pl => self%pl, npl => self%pl%nbody, tp => self%tp, ntp => self%tp%nbody) - - cb%mass = cb%mass / mscale - cb%Gmass = param%GU * cb%mass - cb%radius = cb%radius / dscale - cb%rb(:) = cb%rb(:) / dscale - cb%vb(:) = cb%vb(:) / vscale - cb%rot(:) = cb%rot(:) * tscale - pl%mass(1:npl) = pl%mass(1:npl) / mscale - pl%Gmass(1:npl) = param%GU * pl%mass(1:npl) - pl%radius(1:npl) = pl%radius(1:npl) / dscale - pl%rh(:,1:npl) = pl%rh(:,1:npl) / dscale - pl%vh(:,1:npl) = pl%vh(:,1:npl) / vscale - pl%rb(:,1:npl) = pl%rb(:,1:npl) / dscale - pl%vb(:,1:npl) = pl%vb(:,1:npl) / vscale - pl%rot(:,1:npl) = pl%rot(:,1:npl) * tscale - - end associate - - - return - end subroutine util_rescale_system - -end submodule s_util_rescale \ No newline at end of file diff --git a/src/util/util_reset.f90 b/src/util/util_reset.f90 deleted file mode 100644 index 9b37f7d15..000000000 --- a/src/util/util_reset.f90 +++ /dev/null @@ -1,37 +0,0 @@ -!! Copyright 2022 - David Minton, Carlisle Wishard, Jennifer Pouplin, Jake Elliott, & Dana Singh -!! This file is part of Swiftest. -!! Swiftest is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License -!! as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. -!! Swiftest is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty -!! of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. -!! You should have received a copy of the GNU General Public License along with Swiftest. -!! If not, see: https://www.gnu.org/licenses. - -submodule (swiftest_classes) s_util_reset - use swiftest -contains - - module subroutine util_reset_storage(self) - !! author: David A. Minton - !! - !! Resets a storage object by deallocating all items and resetting the frame counter to 0 - implicit none - ! Arguments - class(swiftest_storage(*)), intent(inout) :: self !! Swiftest storage object - ! Internals - integer(I4B) :: i - - do i = 1, self%nframes - if (allocated(self%frame(i)%item)) deallocate(self%frame(i)%item) - end do - - if (allocated(self%idmap)) deallocate(self%idmap) - if (allocated(self%tmap)) deallocate(self%tmap) - self%nid = 0 - self%nt = 0 - self%iframe = 0 - - return - end subroutine util_reset_storage - -end submodule s_util_reset \ No newline at end of file diff --git a/src/util/util_resize.f90 b/src/util/util_resize.f90 deleted file mode 100644 index 4963fd689..000000000 --- a/src/util/util_resize.f90 +++ /dev/null @@ -1,372 +0,0 @@ -!! Copyright 2022 - David Minton, Carlisle Wishard, Jennifer Pouplin, Jake Elliott, & Dana Singh -!! This file is part of Swiftest. -!! Swiftest is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License -!! as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. -!! Swiftest is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty -!! of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. -!! You should have received a copy of the GNU General Public License along with Swiftest. -!! If not, see: https://www.gnu.org/licenses. - -submodule (swiftest_classes) s_util_resize - use swiftest -contains - - module subroutine util_resize_arr_char_string(arr, nnew) - !! author: David A. Minton - !! - !! Resizes an array component of type character string. nnew = 0 will deallocate. - implicit none - ! Arguments - character(len=STRMAX), dimension(:), allocatable, intent(inout) :: arr !! Array to resize - integer(I4B), intent(in) :: nnew !! New size - ! Internals - character(len=STRMAX), dimension(:), allocatable :: tmp !! Temporary storage array in case the input array is already allocated - integer(I4B) :: nold !! Old size - - if (nnew < 0) return - - if (nnew == 0) then - if (allocated(arr)) deallocate(arr) - return - end if - - if (allocated(arr)) then - nold = size(arr) - else - nold = 0 - end if - - if (nnew == nold) return - - allocate(tmp(nnew)) - if (nold > 0) then - if (nnew > nold) then - tmp(1:nold) = arr(1:nold) - tmp(nold+1:nnew) = "" - else - tmp(1:nnew) = arr(1:nnew) - end if - else - tmp(1:nnew) = "" - end if - call move_alloc(tmp, arr) - - return - end subroutine util_resize_arr_char_string - - - module subroutine util_resize_arr_DP(arr, nnew) - !! author: David A. Minton - !! - !! Resizes an array component of double precision type. Passing nnew = 0 will deallocate. - implicit none - ! Arguments - real(DP), dimension(:), allocatable, intent(inout) :: arr !! Array to resize - integer(I4B), intent(in) :: nnew !! New size - ! Internals - real(DP), dimension(:), allocatable :: tmp !! Temporary storage array in case the input array is already allocated - integer(I4B) :: nold !! Old size - real(DP), parameter :: init_val = 0.0_DP - - if (nnew < 0) return - - if (nnew == 0) then - if (allocated(arr)) deallocate(arr) - return - end if - - if (allocated(arr)) then - nold = size(arr) - else - nold = 0 - end if - - if (nnew == nold) return - - allocate(tmp(nnew)) - if (nold > 0) then - if (nnew > nold) then - tmp(1:nold) = arr(1:nold) - tmp(nold+1:nnew) = init_val - else - tmp(1:nnew) = arr(1:nnew) - end if - else - tmp(1:nnew) = init_val - end if - call move_alloc(tmp, arr) - - return - end subroutine util_resize_arr_DP - - - module subroutine util_resize_arr_DPvec(arr, nnew) - !! author: David A. Minton - !! - !! Resizes an array component of double precision vectors of size (NDIM, n). Passing nnew = 0 will deallocate. - implicit none - ! Arguments - real(DP), dimension(:,:), allocatable, intent(inout) :: arr !! Array to resize - integer(I4B), intent(in) :: nnew !! New size - ! Internals - real(DP), dimension(:,:), allocatable :: tmp !! Temporary storage array in case the input array is already allocated - integer(I4B) :: nold !! Old size - real(DP), dimension(NDIM), parameter :: init_val = 0.0_DP - integer(I4B) :: i - - if (nnew < 0) return - - if (nnew == 0) then - if (allocated(arr)) deallocate(arr) - return - end if - - if (allocated(arr)) then - nold = size(arr, dim=2) - else - nold = 0 - end if - - if (nnew == nold) return - - allocate(tmp(NDIM, nnew)) - if (nold > 0) then - if (nnew > nold) then - tmp(:,1:nold) = arr(:,1:nold) - do i = nold+1, nnew - tmp(:,i) = init_val(:) - end do - else - tmp(:,1:nnew) = arr(:,1:nnew) - end if - else - do i = 1, nnew - tmp(:, i) = init_val(:) - end do - end if - call move_alloc(tmp, arr) - - return - - return - end subroutine util_resize_arr_DPvec - - - module subroutine util_resize_arr_I4B(arr, nnew) - !! author: David A. Minton - !! - !! Resizes an array component of integer type. Passing nnew = 0 will deallocate. - implicit none - ! Arguments - integer(I4B), dimension(:), allocatable, intent(inout) :: arr !! Array to resize - integer(I4B), intent(in) :: nnew !! New size - ! Internals - integer(I4B), dimension(:), allocatable :: tmp !! Temporary storage array in case the input array is already allocated - integer(I4B) :: nold !! Old size - integer(I4B), parameter :: init_val = -1 - - if (nnew < 0) return - - if (nnew == 0) then - if (allocated(arr)) deallocate(arr) - return - end if - - if (allocated(arr)) then - nold = size(arr) - else - nold = 0 - end if - - if (nnew == nold) return - - allocate(tmp(nnew)) - if (nold > 0) then - if (nnew > nold) then - tmp(1:nold) = arr(1:nold) - tmp(nold+1:nnew) = init_val - else - tmp(1:nnew) = arr(1:nnew) - end if - else - tmp(1:nnew) = init_val - end if - call move_alloc(tmp, arr) - - return - end subroutine util_resize_arr_I4B - - - module subroutine util_resize_arr_info(arr, nnew) - !! author: David A. Minton - !! - !! Resizes an array component of type character string. Array will only be resized if has previously been allocated. Passing nnew = 0 will deallocate. - implicit none - ! Arguments - type(swiftest_particle_info), dimension(:), allocatable, intent(inout) :: arr !! Array to resize - integer(I4B), intent(in) :: nnew !! New size - ! Internals - type(swiftest_particle_info), dimension(:), allocatable :: tmp !! Temporary storage array in case the input array is already allocated - integer(I4B) :: nold !! Old size - - if (nnew < 0) return - - if (nnew == 0) then - if (allocated(arr)) deallocate(arr) - return - end if - - if (allocated(arr)) then - nold = size(arr) - else - nold = 0 - end if - - if (nnew == nold) return - - allocate(tmp(nnew)) - if (nnew > nold) then - call util_copy_particle_info_arr(arr(1:nold), tmp(1:nold)) - else - call util_copy_particle_info_arr(arr(1:nnew), tmp(1:nnew)) - end if - - call move_alloc(tmp, arr) - - return - end subroutine util_resize_arr_info - - - module subroutine util_resize_arr_logical(arr, nnew) - !! author: David A. Minton - !! - !! Resizes an array component of logical type. Passing nnew = 0 will deallocate. - implicit none - ! Arguments - logical, dimension(:), allocatable, intent(inout) :: arr !! Array to resize - integer(I4B), intent(in) :: nnew !! New size - ! Internals - logical, dimension(:), allocatable :: tmp !! Temporary storage array in case the input array is already allocated - integer(I4B) :: nold !! Old size - logical, parameter :: init_val = .false. - - if (nnew < 0) return - - if (nnew == 0) then - if (allocated(arr)) deallocate(arr) - return - end if - - if (allocated(arr)) then - nold = size(arr) - else - nold = 0 - end if - - if (nnew == nold) return - - allocate(tmp(nnew)) - if (nold > 0) then - if (nnew > nold) then - tmp(1:nold) = arr(1:nold) - tmp(nold+1:nnew) = init_val - else - tmp(1:nnew) = arr(1:nnew) - end if - else - tmp(1:nnew) = init_val - end if - call move_alloc(tmp, arr) - - return - end subroutine util_resize_arr_logical - - - module subroutine util_resize_body(self, nnew) - !! author: David A. Minton - !! - !! Checks the current size of a Swiftest body against the requested size and resizes it if it is too small. - implicit none - ! Arguments - class(swiftest_body), intent(inout) :: self !! Swiftest body object - integer(I4B), intent(in) :: nnew !! New size neded - - call util_resize(self%info, nnew) - call util_resize(self%id, nnew) - call util_resize(self%status, nnew) - call util_resize(self%ldiscard, nnew) - call util_resize(self%lmask, nnew) - call util_resize(self%mu, nnew) - call util_resize(self%rh, nnew) - call util_resize(self%vh, nnew) - call util_resize(self%rb, nnew) - call util_resize(self%vb, nnew) - call util_resize(self%ah, nnew) - call util_resize(self%aobl, nnew) - call util_resize(self%atide, nnew) - call util_resize(self%agr, nnew) - call util_resize(self%ir3h, nnew) - call util_resize(self%a, nnew) - call util_resize(self%e, nnew) - call util_resize(self%inc, nnew) - call util_resize(self%capom, nnew) - call util_resize(self%omega, nnew) - call util_resize(self%capm, nnew) - self%nbody = count(self%status(1:nnew) /= INACTIVE) - - return - end subroutine util_resize_body - - - module subroutine util_resize_pl(self, nnew) - !! author: David A. Minton - !! - !! Checks the current size of a Swiftest massive body against the requested size and resizes it if it is too small. - implicit none - ! Arguments - class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object - integer(I4B), intent(in) :: nnew !! New size neded - - call util_resize_body(self, nnew) - - call util_resize(self%mass, nnew) - call util_resize(self%Gmass, nnew) - call util_resize(self%rhill, nnew) - call util_resize(self%renc, nnew) - call util_resize(self%radius, nnew) - call util_resize(self%rbeg, nnew) - call util_resize(self%xend, nnew) - call util_resize(self%vbeg, nnew) - call util_resize(self%density, nnew) - call util_resize(self%Ip, nnew) - call util_resize(self%rot, nnew) - call util_resize(self%k2, nnew) - call util_resize(self%Q, nnew) - call util_resize(self%tlag, nnew) - - if (allocated(self%k_plpl)) deallocate(self%k_plpl) - - return - end subroutine util_resize_pl - - - module subroutine util_resize_tp(self, nnew) - !! author: David A. Minton - !! - !! Checks the current size of a Swiftest test particle against the requested size and resizes it if it is too small. - implicit none - ! Arguments - class(swiftest_tp), intent(inout) :: self !! Swiftest test particle object - integer(I4B), intent(in) :: nnew !! New size neded - - call util_resize_body(self, nnew) - - call util_resize(self%isperi, nnew) - call util_resize(self%peri, nnew) - call util_resize(self%atp, nnew) - - return - end subroutine util_resize_tp - - -end submodule s_util_resize \ No newline at end of file diff --git a/src/util/util_set.f90 b/src/util/util_set.f90 deleted file mode 100644 index 3e7719bff..000000000 --- a/src/util/util_set.f90 +++ /dev/null @@ -1,251 +0,0 @@ -!! Copyright 2022 - David Minton, Carlisle Wishard, Jennifer Pouplin, Jake Elliott, & Dana Singh -!! This file is part of Swiftest. -!! Swiftest is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License -!! as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. -!! Swiftest is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty -!! of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. -!! You should have received a copy of the GNU General Public License along with Swiftest. -!! If not, see: https://www.gnu.org/licenses. - -submodule(swiftest_classes) s_util_set - !! author: David A. Minton - !! This submodule contains a collection of setter method implementations - use swiftest -contains - - module subroutine util_set_beg_end_pl(self, rbeg, xend, vbeg) - !! author: David A. Minton - !! - !! Sets one or more of the values of rbeg, xend, and vbeg - implicit none - ! Arguments - class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object - real(DP), dimension(:,:), intent(in), optional :: rbeg, xend, vbeg - - if (present(rbeg)) then - if (allocated(self%rbeg)) deallocate(self%rbeg) - allocate(self%rbeg, source=rbeg) - end if - if (present(xend)) then - if (allocated(self%xend)) deallocate(self%xend) - allocate(self%xend, source=xend) - end if - if (present(vbeg)) then - if (allocated(self%vbeg)) deallocate(self%vbeg) - allocate(self%vbeg, source=vbeg) - end if - - return - end subroutine util_set_beg_end_pl - - - module subroutine util_set_ir3h(self) - !! author: David A. Minton - !! - !! Sets the inverse heliocentric radius term (1/rh**3) for all bodies in a structure - implicit none - ! Arguments - class(swiftest_body), intent(inout) :: self !! Swiftest generic body object - ! Internals - integer(I4B) :: i - real(DP) :: r2, irh - - if (self%nbody > 0) then - - do i = 1, self%nbody - r2 = dot_product(self%rh(:, i), self%rh(:, i)) - irh = 1.0_DP / sqrt(r2) - self%ir3h(i) = irh / r2 - end do - end if - - return - end subroutine util_set_ir3h - - - module subroutine util_set_msys(self) - !! author: David A. Minton - !! - !! Sets the value of msys and the vector mass quantities based on the total mass of the system - implicit none - ! Arguments - class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nobdy system object - - self%Gmtot = self%cb%Gmass + sum(self%pl%Gmass(1:self%pl%nbody), self%pl%status(1:self%pl%nbody) /= INACTIVE) - - return - end subroutine util_set_msys - - - module subroutine util_set_mu_pl(self, cb) - !! author: David A. Minton - !! - !! Computes G * (M + m) for each massive body - implicit none - ! Arguments - class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object - class(swiftest_cb), intent(inout) :: cb !! Swiftest central body object - - if (self%nbody > 0) self%mu(1:self%nbody) = cb%Gmass + self%Gmass(1:self%nbody) - - return - end subroutine util_set_mu_pl - - - module subroutine util_set_mu_tp(self, cb) - !! author: David A. Minton - !! - !! Converts certain scalar values to arrays so that they can be used in elemental functions - implicit none - ! Arguments - class(swiftest_tp), intent(inout) :: self !! Swiftest test particle object - class(swiftest_cb), intent(inout) :: cb !! Swiftest central body object - - if (self%nbody == 0) return - self%mu(1:self%nbody) = cb%Gmass - - return - end subroutine util_set_mu_tp - - module subroutine util_set_particle_info(self, name, particle_type, status, origin_type, origin_time, collision_id, origin_rh,& - origin_vh, discard_time, discard_rh, discard_vh, discard_body_id) - !! author: David A. Minton - !! - !! Sets one or more values of the particle information metadata object - implicit none - ! Arguments - class(swiftest_particle_info), intent(inout) :: self - character(len=*), intent(in), optional :: name !! Non-unique name - character(len=*), intent(in), optional :: particle_type !! String containing a description of the particle type (e.g. Central Body, Massive Body, Test Particle) - character(len=*), intent(in), optional :: status !! Particle status description: ACTIVE, MERGED, FRAGMENTED, etc. - character(len=*), intent(in), optional :: origin_type !! String containing a description of the origin of the particle (e.g. Initial Conditions, Supercatastrophic, Disruption, etc.) - real(DP), intent(in), optional :: origin_time !! The time of the particle's formation - integer(I4B), intent(in), optional :: collision_id !! The ID fo the collision that formed the particle - real(DP), dimension(:), intent(in), optional :: origin_rh !! The heliocentric distance vector at the time of the particle's formation - real(DP), dimension(:), intent(in), optional :: origin_vh !! The heliocentric velocity vector at the time of the particle's formation - real(DP), intent(in), optional :: discard_time !! The time of the particle's discard - real(DP), dimension(:), intent(in), optional :: discard_rh !! The heliocentric distance vector at the time of the particle's discard - real(DP), dimension(:), intent(in), optional :: discard_vh !! The heliocentric velocity vector at the time of the particle's discard - integer(I4B), intent(in), optional :: discard_body_id !! The id of the other body involved in the discard (0 if no other body involved) - ! Internals - character(len=NAMELEN) :: lenstr - character(len=:), allocatable :: fmtlabel - - write(lenstr, *) NAMELEN - fmtlabel = "(A" // trim(adjustl(lenstr)) // ")" - - if (present(name)) then - write(self%name, fmtlabel) trim(adjustl(name)) - end if - if (present(particle_type)) then - write(self%particle_type, fmtlabel) trim(adjustl(particle_type)) - end if - if (present(status)) then - write(self%status, fmtlabel) trim(adjustl(status)) - end if - if (present(origin_type)) then - write(self%origin_type, fmtlabel) trim(adjustl(origin_type)) - end if - if (present(origin_time)) then - self%origin_time = origin_time - end if - if (present(collision_id)) then - self%collision_id = collision_id - end if - if (present(origin_rh)) then - self%origin_rh(:) = origin_rh(:) - end if - if (present(origin_vh)) then - self%origin_vh(:) = origin_vh(:) - end if - if (present(discard_time)) then - self%discard_time = discard_time - end if - if (present(discard_rh)) then - self%discard_rh(:) = discard_rh(:) - end if - if (present(discard_vh)) then - self%discard_vh(:) = discard_vh(:) - end if - if (present(discard_body_id)) then - self%discard_body_id = discard_body_id - end if - - return - end subroutine util_set_particle_info - - - module subroutine util_set_renc_I4B(self, scale) - !! author: David A. Minton - !! - !! Sets the critical radius for encounter given an input scale factor - !! - implicit none - ! Arguments - class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object - integer(I4B), intent(in) :: scale !! Input scale factor (multiplier of Hill's sphere size) - - associate(pl => self, npl => self%nbody) - pl%renc(1:npl) = pl%rhill(1:npl) * scale - end associate - - return - end subroutine util_set_renc_I4B - - - module subroutine util_set_renc_DP(self, scale) - !! author: David A. Minton - !! - !! Sets the critical radius for encounter given an input scale factor - !! - implicit none - ! Arguments - class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object - real(DP), intent(in) :: scale !! Input scale factor (multiplier of Hill's sphere size) - - associate(pl => self, npl => self%nbody) - pl%renc(1:npl) = pl%rhill(1:npl) * scale - end associate - - return - end subroutine util_set_renc_DP - - - module subroutine util_set_rhill(self,cb) - !! author: David A. Minton - !! - !! Sets the value of the Hill's radius - implicit none - ! Arguments - class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object - class(swiftest_cb), intent(inout) :: cb !! Swiftest central body object - - if (self%nbody == 0) return - - call self%xv2el(cb) - self%rhill(1:self%nbody) = self%a(1:self%nbody) * (self%Gmass(1:self%nbody) / cb%Gmass / 3)**THIRD - - return - end subroutine util_set_rhill - - - module subroutine util_set_rhill_approximate(self,cb) - !! author: David A. Minton - !! - !! Sets the approximate value of the Hill's radius using the heliocentric radius instead of computing the semimajor axis - implicit none - ! Arguments - class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object - class(swiftest_cb), intent(inout) :: cb !! Swiftest central body object - ! Internals - real(DP), dimension(:), allocatable :: rh - - if (self%nbody == 0) return - - rh(1:self%nbody) = .mag. self%rh(:,1:self%nbody) - self%rhill(1:self%nbody) = rh(1:self%nbody) * (self%Gmass(1:self%nbody) / cb%Gmass / 3)**THIRD - - return - end subroutine util_set_rhill_approximate - -end submodule s_util_set \ No newline at end of file diff --git a/src/util/util_snapshot.f90 b/src/util/util_snapshot.f90 deleted file mode 100644 index c3a98855b..000000000 --- a/src/util/util_snapshot.f90 +++ /dev/null @@ -1,36 +0,0 @@ -!! Copyright 2022 - David Minton, Carlisle Wishard, Jennifer Pouplin, Jake Elliott, & Dana Singh -!! This file is part of Swiftest. -!! Swiftest is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License -!! as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. -!! Swiftest is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty -!! of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. -!! You should have received a copy of the GNU General Public License along with Swiftest. -!! If not, see: https://www.gnu.org/licenses. - -submodule(swiftest_classes) s_util_snapshot - use swiftest -contains - - module subroutine util_snapshot_system(self, param, system, t, arg) - !! author: David A. Minton - !! - !! Takes a snapshot of the system for later file storage - implicit none - ! Arguments - class(swiftest_storage(*)), intent(inout) :: self !! Swiftest storage object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object to store - real(DP), intent(in), optional :: t !! Time of snapshot if different from system time - character(*), intent(in), optional :: arg !! Optional argument (needed for extended storage type used in collision snapshots) - - self%iframe = self%iframe + 1 - self%nt = self%iframe - self%frame(self%iframe) = system ! Store a snapshot of the system for posterity - self%nid = self%nid + 1 ! Central body - if (allocated(system%pl)) self%nid = self%nid + system%pl%nbody - if (allocated(system%tp)) self%nid = self%nid + system%tp%nbody - - return - end subroutine util_snapshot_system - -end submodule s_util_snapshot \ No newline at end of file diff --git a/src/util/util_solve.f90 b/src/util/util_solve.f90 deleted file mode 100644 index 2480eae46..000000000 --- a/src/util/util_solve.f90 +++ /dev/null @@ -1,237 +0,0 @@ -!! Copyright 2022 - David Minton, Carlisle Wishard, Jennifer Pouplin, Jake Elliott, & Dana Singh -!! This file is part of Swiftest. -!! Swiftest is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License -!! as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. -!! Swiftest is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty -!! of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. -!! You should have received a copy of the GNU General Public License along with Swiftest. -!! If not, see: https://www.gnu.org/licenses. - -submodule(swiftest_classes) s_util_solve - use swiftest -contains - - module function util_solve_linear_system_d(A,b,n,lerr) result(x) - !! Author: David A. Minton - !! - !! Solves the linear equation of the form A*x = b for x. - !! A is an (n,n) arrays - !! x and b are (n) arrays - !! Uses Gaussian elimination, so will have issues if system is ill-conditioned. - !! Uses quad precision intermidiate values, so works best on small arrays. - use, intrinsic :: ieee_exceptions - implicit none - ! Arguments - integer(I4B), intent(in) :: n - real(DP), dimension(:,:), intent(in) :: A - real(DP), dimension(:), intent(in) :: b - logical, intent(out) :: lerr - ! Result - real(DP), dimension(n) :: x - ! Internals - real(QP), dimension(:), allocatable :: qx - type(ieee_status_type) :: original_fpe_status - logical, dimension(:), allocatable :: fpe_flag - - call ieee_get_status(original_fpe_status) ! Save the original floating point exception status - call ieee_set_flag(ieee_all, .false.) ! Set all flags to quiet - allocate(fpe_flag(size(ieee_usual))) - - qx = solve_wbs(ge_wpp(real(A, kind=QP), real(b, kind=QP))) - - call ieee_get_flag(ieee_usual, fpe_flag) - lerr = any(fpe_flag) - if (lerr .or. (any(abs(qx) > huge(x))) .or. (any(abs(qx) < tiny(x)))) then - x = 0.0_DP - else - x = real(qx, kind=DP) - end if - call ieee_set_status(original_fpe_status) - - return - end function util_solve_linear_system_d - - module function util_solve_linear_system_q(A,b,n,lerr) result(x) - !! Author: David A. Minton - !! - !! Solves the linear equation of the form A*x = b for x. - !! A is an (n,n) arrays - !! x and b are (n) arrays - !! Uses Gaussian elimination, so will have issues if system is ill-conditioned. - !! Uses quad precision intermidiate values, so works best on small arrays. - use, intrinsic :: ieee_exceptions - implicit none - ! Arguments - integer(I4B), intent(in) :: n - real(QP), dimension(:,:), intent(in) :: A - real(QP), dimension(:), intent(in) :: b - logical, intent(out) :: lerr - ! Result - real(QP), dimension(n) :: x - ! Internals - type(ieee_status_type) :: original_fpe_status - logical, dimension(:), allocatable :: fpe_flag - - call ieee_get_status(original_fpe_status) ! Save the original floating point exception status - call ieee_set_flag(ieee_all, .false.) ! Set all flags to quiet - allocate(fpe_flag(size(ieee_usual))) - - x = solve_wbs(ge_wpp(A, b)) - - call ieee_get_flag(ieee_usual, fpe_flag) - lerr = any(fpe_flag) - if (lerr) x = 0.0_DP - call ieee_set_status(original_fpe_status) - - return - end function util_solve_linear_system_q - - function solve_wbs(u) result(x) ! solve with backward substitution - !! Based on code available on Rosetta Code: https://rosettacode.org/wiki/Gaussian_elimination#Fortran - use, intrinsic :: ieee_exceptions - use swiftest - implicit none - ! Arguments - real(QP), intent(in), dimension(:,:), allocatable :: u - ! Result - real(QP), dimension(:), allocatable :: x - ! Internals - integer(I4B) :: i,n - - n = size(u, 1) - if (allocated(x)) deallocate(x) - if (.not.allocated(x)) allocate(x(n)) - if (any(abs(u) < tiny(1._DP)) .or. any(abs(u) > huge(1._DP))) then - x(:) = 0._DP - return - end if - call ieee_set_halting_mode(ieee_divide_by_zero, .false.) - do i = n, 1, -1 - x(i) = (u(i, n + 1) - sum(u(i, i + 1:n) * x(i + 1:n))) / u(i, i) - end do - return - end function solve_wbs - - function ge_wpp(A, b) result(u) ! gaussian eliminate with partial pivoting - !! Solve Ax=b using Gaussian elimination then backwards substitution. - !! A being an n by n matrix. - !! x and b are n by 1 vectors. - !! Based on code available on Rosetta Code: https://rosettacode.org/wiki/Gaussian_elimination#Fortran - use, intrinsic :: ieee_exceptions - use swiftest - implicit none - ! Arguments - real(QP), dimension(:,:), intent(in) :: A - real(QP), dimension(:), intent(in) :: b - ! Result - real(QP), dimension(:,:), allocatable :: u - ! Internals - integer(I4B) :: i,j,n,p - real(QP) :: upi - - n = size(a, 1) - allocate(u(n, (n + 1))) - u = reshape([A, b], [n, n + 1]) - call ieee_set_halting_mode(ieee_divide_by_zero, .false.) - do j = 1, n - p = maxloc(abs(u(j:n, j)), 1) + j - 1 ! maxloc returns indices between (1, n - j + 1) - if (p /= j) u([p, j], j) = u([j, p], j) - u(j + 1:, j) = u(j + 1:, j) / u(j, j) - do i = j + 1, n + 1 - upi = u(p, i) - if (p /= j) u([p, j], i) = u([j, p], i) - u(j + 1:n, i) = u(j + 1:n, i) - upi * u(j + 1:n, j) - end do - end do - return - end function ge_wpp - - module function util_solve_rkf45(f, y0in, t1, dt0, tol) result(y1) - !! author: David A. Minton - !! - !! Implements the 4th order Runge-Kutta-Fehlberg ODE solver for initial value problems of the form f=dy/dt, y0 = y(t=0), solving for y1 = y(t=t1). Uses a 5th order adaptive step size control. - !! Uses a lambda function object as defined in the lambda_function module - implicit none - ! Arguments - class(lambda_obj), intent(inout) :: f !! lambda function object that has been initialized to be a function of derivatives. The object will return with components lastarg and lasteval set - real(DP), dimension(:), intent(in) :: y0in !! Initial value at t=0 - real(DP), intent(in) :: t1 !! Final time - real(DP), intent(in) :: dt0 !! Initial step size guess - real(DP), intent(in) :: tol !! Tolerance on solution - ! Result - real(DP), dimension(:), allocatable :: y1 !! Final result - ! Internals - integer(I4B), parameter :: MAXREDUX = 1000 !! Maximum number of times step size can be reduced - real(DP), parameter :: DTFAC = 0.95_DP !! Step size reduction safety factor (Value just under 1.0 to prevent adaptive step size control from discarding steps too aggressively) - integer(I4B), parameter :: RKS = 6 !! Number of RK stages - real(DP), dimension(RKS, RKS - 1), parameter :: rkf45_btab = reshape( & !! Butcher tableau for Runge-Kutta-Fehlberg method - (/ 1./4., 1./4., 0., 0., 0., 0.,& - 3./8., 3./32., 9./32., 0., 0., 0.,& - 12./13., 1932./2197., -7200./2197., 7296./2197., 0., 0.,& - 1., 439./216., -8., 3680./513., -845./4104., 0.,& - 1./2., -8./27., 2., -3544./2565., 1859./4104., -11./40./), shape(rkf45_btab)) - real(DP), dimension(RKS), parameter :: rkf4_coeff = (/ 25./216., 0., 1408./2565. , 2197./4104. , -1./5., 0. /) - real(DP), dimension(RKS), parameter :: rkf5_coeff = (/ 16./135., 0., 6656./12825., 28561./56430., -9./50., 2./55. /) - real(DP), dimension(:, :), allocatable :: k !! Runge-Kutta coefficient vector - real(DP), dimension(:), allocatable :: ynorm !! Normalized y value used for adaptive step size control - real(DP), dimension(:), allocatable :: y0 !! Value of y at the beginning of each substep - integer(I4B) :: Nvar !! Number of variables in problem - integer(I4B) :: rkn !! Runge-Kutta loop index - real(DP) :: t, x1, dt, trem !! Current time, step size and total time remaining - real(DP) :: s, yerr, yscale !! Step size reduction factor, error in dependent variable, and error scale factor - integer(I4B) :: i - - allocate(y0, source=y0in) - allocate(y1, mold=y0) - allocate(ynorm, mold=y0) - Nvar = size(y0) - allocate(k(Nvar, RKS)) - - dt = dt0 - - trem = t1 - t = 0._DP - do - yscale = norm2(y0(:)) - do i = 1, MAXREDUX - select type(f) - class is (lambda_obj_tvar) - do rkn = 1, RKS - y1(:) = y0(:) + matmul(k(:, 1:rkn - 1), rkf45_btab(2:rkn, rkn - 1)) - if (rkn == 1) then - x1 = t - else - x1 = t + rkf45_btab(1,rkn-1) - end if - k(:, rkn) = dt * f%evalt(y1(:), t) - end do - class is (lambda_obj) - do rkn = 1, RKS - y1(:) = y0(:) + matmul(k(:, 1:rkn - 1), rkf45_btab(2:rkn, rkn - 1)) - k(:, rkn) = dt * f%eval(y1(:)) - end do - end select - ! Now determine if the step size needs adjusting - ynorm(:) = matmul(k(:,:), (rkf5_coeff(:) - rkf4_coeff(:))) / yscale - yerr = norm2(ynorm(:)) - s = (tol / (2 * yerr))**(0.25_DP) - dt = min(s * DTFAC * dt, trem) ! Alter step size either up or down, but never bigger than the remaining time - if (s >= 1.0_DP) exit ! Good step! - if (i == MAXREDUX) then - write(*,*) "Something has gone wrong in util_solve_rkf45!! Step size reduction has gone too far this time!" - call util_exit(FAILURE) - end if - end do - - ! Compute new value then step ahead in time - y1(:) = y0(:) + matmul(k(:, :), rkf4_coeff(:)) - trem = trem - dt - t = t + dt - if (trem <= 0._DP) exit - y0(:) = y1(:) - end do - - return - end function util_solve_rkf45 - -end submodule s_util_solve \ No newline at end of file diff --git a/src/util/util_sort.f90 b/src/util/util_sort.f90 deleted file mode 100644 index 6b48103d5..000000000 --- a/src/util/util_sort.f90 +++ /dev/null @@ -1,1007 +0,0 @@ -!! Copyright 2022 - David Minton, Carlisle Wishard, Jennifer Pouplin, Jake Elliott, & Dana Singh -!! This file is part of Swiftest. -!! Swiftest is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License -!! as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. -!! Swiftest is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty -!! of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. -!! You should have received a copy of the GNU General Public License along with Swiftest. -!! If not, see: https://www.gnu.org/licenses. - -submodule (swiftest_classes) s_util_sort - use swiftest -contains - - module subroutine util_sort_body(self, sortby, ascending) - !! author: David A. Minton - !! - !! Sort a Swiftest body structure in-place. - !! sortby is a string indicating which array component to sort. - implicit none - ! Arguments - class(swiftest_body), intent(inout) :: self !! Swiftest body object - character(*), intent(in) :: sortby !! Sorting attribute - logical, intent(in) :: ascending !! Logical flag indicating whether or not the sorting should be in ascending or descending order - ! Internals - integer(I4B), dimension(:), allocatable :: ind - integer(I4B) :: direction - - if (self%nbody == 0) return - - if (ascending) then - direction = 1 - else - direction = -1 - end if - - associate(body => self, n => self%nbody) - select case(sortby) - case("id") - call util_sort(direction * body%id(1:n), ind) - case("status") - call util_sort(direction * body%status(1:n), ind) - case("ir3h") - call util_sort(direction * body%ir3h(1:n), ind) - case("a") - call util_sort(direction * body%a(1:n), ind) - case("e") - call util_sort(direction * body%e(1:n), ind) - case("inc") - call util_sort(direction * body%inc(1:n), ind) - case("capom") - call util_sort(direction * body%capom(1:n), ind) - case("mu") - call util_sort(direction * body%mu(1:n), ind) - case("lfirst", "nbody", "ldiscard", "rh", "vh", "rb", "vb", "ah", "aobl", "atide", "agr") - write(*,*) 'Cannot sort by ' // trim(adjustl(sortby)) // '. Component not sortable!' - case default - write(*,*) 'Cannot sort by ' // trim(adjustl(sortby)) // '. Component not found!' - return - end select - - call body%rearrange(ind) - - end associate - - return - end subroutine util_sort_body - - - pure module subroutine util_sort_dp(arr) - !! author: David A. Minton - !! - !! Sort input DP precision array in place into ascending numerical order using quicksort. - !! - implicit none - ! Arguments - real(DP), dimension(:), intent(inout) :: arr - - call qsort_DP(arr) - - return - end subroutine util_sort_dp - - - pure module subroutine util_sort_index_dp(arr, ind) - !! author: David A. Minton - !! - !! Sort input DP precision array by index in ascending numerical order using quick sort. - !! This algorithm works well for partially sorted arrays (which is usually the case here). - !! If ind is supplied already allocated, we assume it is an existing index array (e.g. a previously - !! sorted array). If it is not allocated, this subroutine allocates it. - !! - implicit none - ! Arguments - real(DP), dimension(:), intent(in) :: arr - integer(I4B), dimension(:), allocatable, intent(inout) :: ind - ! Internals - integer(I4B) :: n, i - real(DP), dimension(:), allocatable :: tmparr - - n = size(arr) - if (.not.allocated(ind)) then - allocate(ind(n)) - ind = [(i, i=1, n)] - end if - allocate(tmparr, mold=arr) - tmparr(:) = arr(ind(:)) - call qsort_DP(tmparr, ind) - - return - end subroutine util_sort_index_dp - - - recursive pure subroutine qsort_DP(arr, ind) - !! author: David A. Minton - !! - !! Sort input DP precision array by index in ascending numerical order using quicksort sort. - !! - implicit none - ! Arguments - real(DP), dimension(:), intent(inout) :: arr - integer(I4B),dimension(:),intent(out), optional :: ind - !! Internals - integer :: iq - - if (size(arr) > 1) then - if (present(ind)) then - call partition_DP(arr, iq, ind) - call qsort_DP(arr(:iq-1),ind(:iq-1)) - call qsort_DP(arr(iq:), ind(iq:)) - else - call partition_DP(arr, iq) - call qsort_DP(arr(:iq-1)) - call qsort_DP(arr(iq:)) - end if - end if - - return - end subroutine qsort_DP - - - pure subroutine partition_DP(arr, marker, ind) - !! author: David A. Minton - !! - !! Partition function for quicksort on DP type - !! - implicit none - ! Arguments - real(DP), intent(inout), dimension(:) :: arr - integer(I4B), intent(inout), dimension(:), optional :: ind - integer(I4B), intent(out) :: marker - ! Internals - integer(I4B) :: i, j, itmp, narr, ipiv - real(DP) :: temp - real(DP) :: x ! pivot point - - narr = size(arr) - - ! Get center as pivot, as this is likely partially sorted - ipiv = narr / 2 - x = arr(ipiv) - i = 0 - j = narr + 1 - - do - j = j - 1 - do - if (arr(j) <= x) exit - j = j - 1 - end do - i = i + 1 - do - if (arr(i) >= x) exit - i = i + 1 - end do - if (i < j) then - ! exchange A(i) and A(j) - temp = arr(i) - arr(i) = arr(j) - arr(j) = temp - if (present(ind)) then - itmp = ind(i) - ind(i) = ind(j) - ind(j) = itmp - end if - else if (i == j) then - marker = i + 1 - return - else - marker = i - return - endif - end do - - return - end subroutine partition_DP - - - pure module subroutine util_sort_i4b(arr) - !! author: David A. Minton - !! - !! Sort input integer array in place into ascending numerical order using quick sort. - !! This algorithm works well for partially sorted arrays (which is usually the case here) - !! - implicit none - ! Arguments - integer(I4B), dimension(:), intent(inout) :: arr - - call qsort_I4B(arr) - - return - end subroutine util_sort_i4b - - - pure module subroutine util_sort_index_I4B(arr, ind) - !! author: David A. Minton - !! - !! Sort input integer array by index in ascending numerical order using quicksort. - !! If ind is supplied already allocated, we assume it is an existing index array (e.g. a previously - !! sorted array). If it is not allocated, this subroutine allocates it. - !! - implicit none - ! Arguments - integer(I4B), dimension(:), intent(in) :: arr - integer(I4B), dimension(:), allocatable, intent(inout) :: ind - ! Internals - integer(I4B) :: n, i - integer(I4B), dimension(:), allocatable :: tmparr - - n = size(arr) - if (.not.allocated(ind)) then - allocate(ind(n)) - ind = [(i, i=1, n)] - end if - allocate(tmparr, mold=arr) - tmparr(:) = arr(ind(:)) - call qsort_I4B(tmparr, ind) - - return - end subroutine util_sort_index_I4B - - - pure module subroutine util_sort_index_I4B_I8Bind(arr, ind) - !! author: David A. Minton - !! - !! Sort input integer array by index in ascending numerical order using quicksort. - !! If ind is supplied already allocated, we assume it is an existing index array (e.g. a previously - !! sorted array). If it is not allocated, this subroutine allocates it. - !! - implicit none - ! Arguments - integer(I4B), dimension(:), intent(in) :: arr - integer(I8B), dimension(:), allocatable, intent(inout) :: ind - ! Internals - integer(I8B) :: n, i - integer(I4B), dimension(:), allocatable :: tmparr - - n = size(arr) - if (.not.allocated(ind)) then - allocate(ind(n)) - ind = [(i, i=1_I8B, n)] - end if - allocate(tmparr, mold=arr) - tmparr(:) = arr(ind(:)) - call qsort_I4B_I8Bind(tmparr, ind) - - return - end subroutine util_sort_index_I4B_I8Bind - - - recursive pure subroutine qsort_I4B(arr, ind) - !! author: David A. Minton - !! - !! Sort input I4B array by index in ascending numerical order using quicksort. - !! - implicit none - ! Arguments - integer(I4B), dimension(:), intent(inout) :: arr - integer(I4B), dimension(:), intent(out), optional :: ind - ! Internals - integer(I4B) :: iq - - if (size(arr) > 1) then - if (present(ind)) then - call partition_I4B(arr, iq, ind) - call qsort_I4B(arr(:iq-1),ind(:iq-1)) - call qsort_I4B(arr(iq:), ind(iq:)) - else - call partition_I4B(arr, iq) - call qsort_I4B(arr(:iq-1)) - call qsort_I4B(arr(iq:)) - end if - end if - - return - end subroutine qsort_I4B - - recursive pure subroutine qsort_I4B_I8Bind(arr, ind) - !! author: David A. Minton - !! - !! Sort input I4B array by index in ascending numerical order using quicksort. - !! - implicit none - ! Arguments - integer(I4B), dimension(:), intent(inout) :: arr - integer(I8B), dimension(:), intent(out), optional :: ind - ! Internals - integer(I8B) :: iq - - if (size(arr) > 1_I8B) then - if (present(ind)) then - call partition_I4B_I8Bind(arr, iq, ind) - call qsort_I4B_I8Bind(arr(:iq-1_I8B),ind(:iq-1_I8B)) - call qsort_I4B_I8Bind(arr(iq:), ind(iq:)) - else - call partition_I4B_I8Bind(arr, iq) - call qsort_I4B_I8Bind(arr(:iq-1_I8B)) - call qsort_I4B_I8Bind(arr(iq:)) - end if - end if - - return - end subroutine qsort_I4B_I8Bind - - - recursive pure subroutine qsort_I8B_I8Bind(arr, ind) - !! author: David A. Minton - !! - !! Sort input I8B array by index in ascending numerical order using quicksort. - !! - implicit none - ! Arguments - integer(I8B), dimension(:), intent(inout) :: arr - integer(I8B), dimension(:), intent(out), optional :: ind - ! Internals - integer(I8B) :: iq - - if (size(arr) > 1_I8B) then - if (present(ind)) then - call partition_I8B_I8Bind(arr, iq, ind) - call qsort_I8B_I8Bind(arr(:iq-1_I8B),ind(:iq-1_I8B)) - call qsort_I8B_I8Bind(arr(iq:), ind(iq:)) - else - call partition_I8B_I8Bind(arr, iq) - call qsort_I8B_I8Bind(arr(:iq-1_I8B)) - call qsort_I8B_I8Bind(arr(iq:)) - end if - end if - - return - end subroutine qsort_I8B_I8Bind - - - pure subroutine partition_I4B(arr, marker, ind) - !! author: David A. Minton - !! - !! Partition function for quicksort on I4B type - !! - implicit none - ! Arguments - integer(I4B), intent(inout), dimension(:) :: arr - integer(I4B), intent(inout), dimension(:), optional :: ind - integer(I4B), intent(out) :: marker - ! Internals - integer(I4B) :: i, j, itmp, narr, ipiv - integer(I4B) :: temp - integer(I4B) :: x ! pivot point - - narr = size(arr) - - ! Get center as pivot, as this is likely partially sorted - ipiv = narr / 2 - x = arr(ipiv) - i = 0 - j = narr + 1 - - do - j = j - 1 - do - if (arr(j) <= x) exit - j = j - 1 - end do - i = i + 1 - do - if (arr(i) >= x) exit - i = i + 1 - end do - if (i < j) then - ! exchange A(i) and A(j) - temp = arr(i) - arr(i) = arr(j) - arr(j) = temp - if (present(ind)) then - itmp = ind(i) - ind(i) = ind(j) - ind(j) = itmp - end if - else if (i == j) then - marker = i + 1 - return - else - marker = i - return - endif - end do - - return - end subroutine partition_I4B - - pure subroutine partition_I4B_I8Bind(arr, marker, ind) - !! author: David A. Minton - !! - !! Partition function for quicksort on I4B type - !! - implicit none - ! Arguments - integer(I4B), intent(inout), dimension(:) :: arr - integer(I8B), intent(inout), dimension(:), optional :: ind - integer(I8B), intent(out) :: marker - ! Internals - integer(I8B) :: i, j, itmp, narr, ipiv - integer(I4B) :: temp - integer(I8B) :: x ! pivot point - - narr = size(arr) - - ! Get center as pivot, as this is likely partially sorted - ipiv = narr / 2_I8B - x = arr(ipiv) - i = 0_I8B - j = narr + 1_I8B - - do - j = j - 1_I8B - do - if (arr(j) <= x) exit - j = j - 1_I8B - end do - i = i + 1_I8B - do - if (arr(i) >= x) exit - i = i + 1_I8B - end do - if (i < j) then - ! exchange A(i) and A(j) - temp = arr(i) - arr(i) = arr(j) - arr(j) = temp - if (present(ind)) then - itmp = ind(i) - ind(i) = ind(j) - ind(j) = itmp - end if - else if (i == j) then - marker = i + 1_I8B - return - else - marker = i - return - endif - end do - - return - end subroutine partition_I4B_I8Bind - - pure subroutine partition_I8B_I8Bind(arr, marker, ind) - !! author: David A. Minton - !! - !! Partition function for quicksort on I8B type with I8B index - !! - implicit none - ! Arguments - integer(I8B), intent(inout), dimension(:) :: arr - integer(I8B), intent(inout), dimension(:), optional :: ind - integer(I8B), intent(out) :: marker - ! Internals - integer(I8B) :: i, j, itmp, narr, ipiv - integer(I8B) :: temp - integer(I8B) :: x ! pivot point - - narr = size(arr) - - ! Get center as pivot, as this is likely partially sorted - ipiv = narr / 2_I8B - x = arr(ipiv) - i = 0_I8B - j = narr + 1_I8B - - do - j = j - 1_I8B - do - if (arr(j) <= x) exit - j = j - 1_I8B - end do - i = i + 1_I8B - do - if (arr(i) >= x) exit - i = i + 1_I8B - end do - if (i < j) then - ! exchange A(i) and A(j) - temp = arr(i) - arr(i) = arr(j) - arr(j) = temp - if (present(ind)) then - itmp = ind(i) - ind(i) = ind(j) - ind(j) = itmp - end if - else if (i == j) then - marker = i + 1_I8B - return - else - marker = i - return - endif - end do - - return - end subroutine partition_I8B_I8Bind - - - pure module subroutine util_sort_sp(arr) - !! author: David A. Minton - !! - !! Sort input DP precision array in place into ascending numerical order using quicksort. - !! - implicit none - ! Arguments - real(SP), dimension(:), intent(inout) :: arr - - call qsort_SP(arr) - - return - end subroutine util_sort_sp - - - pure module subroutine util_sort_index_sp(arr, ind) - !! author: David A. Minton - !! - !! Sort input DP precision array by index in ascending numerical order using quicksort. - !! If ind is supplied already allocated, we assume it is an existing index array (e.g. a previously - !! sorted array). If it is not allocated, this subroutine allocates it. - !! - implicit none - ! Arguments - real(SP), dimension(:), intent(in) :: arr - integer(I4B), dimension(:), allocatable, intent(inout) :: ind - ! Internals - integer(I4B) :: n, i - real(SP), dimension(:), allocatable :: tmparr - - n = size(arr) - if (.not.allocated(ind)) then - allocate(ind(n)) - ind = [(i, i=1, n)] - end if - allocate(tmparr, mold=arr) - tmparr(:) = arr(ind(:)) - call qsort_SP(tmparr, ind) - - return - end subroutine util_sort_index_sp - - - recursive pure subroutine qsort_SP(arr, ind) - !! author: David A. Minton - !! - !! Sort input DP precision array by index in ascending numerical order using quicksort. - !! - implicit none - ! Arguments - real(SP), dimension(:), intent(inout) :: arr - integer(I4B),dimension(:),intent(out), optional :: ind - !! Internals - integer :: iq - - if (size(arr) > 1) then - if (present(ind)) then - call partition_SP(arr, iq, ind) - call qsort_SP(arr(:iq-1),ind(:iq-1)) - call qsort_SP(arr(iq:), ind(iq:)) - else - call partition_SP(arr, iq) - call qsort_SP(arr(:iq-1)) - call qsort_SP(arr(iq:)) - end if - end if - - return - end subroutine qsort_SP - - - pure subroutine partition_SP(arr, marker, ind) - !! author: David A. Minton - !! - !! Partition function for quicksort on SP type - !! - implicit none - ! Arguments - real(SP), intent(inout), dimension(:) :: arr - integer(I4B), intent(inout), dimension(:), optional :: ind - integer(I4B), intent(out) :: marker - ! Internals - integer(I4B) :: i, j, itmp, narr, ipiv - real(SP) :: temp - real(SP) :: x ! pivot point - - narr = size(arr) - - ! Get center as pivot, as this is likely partially sorted - ipiv = narr / 2 - x = arr(ipiv) - i = 0 - j = narr + 1 - - do - j = j - 1 - do - if (arr(j) <= x) exit - j = j - 1 - end do - i = i + 1 - do - if (arr(i) >= x) exit - i = i + 1 - end do - if (i < j) then - ! exchange A(i) and A(j) - temp = arr(i) - arr(i) = arr(j) - arr(j) = temp - if (present(ind)) then - itmp = ind(i) - ind(i) = ind(j) - ind(j) = itmp - end if - else if (i == j) then - marker = i + 1 - return - else - marker = i - return - endif - end do - - return - end subroutine partition_SP - - - module subroutine util_sort_pl(self, sortby, ascending) - !! author: David A. Minton - !! - !! Sort a Swiftest massive body object in-place. - !! sortby is a string indicating which array component to sort. - implicit none - ! Arguments - class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object - character(*), intent(in) :: sortby !! Sorting attribute - logical, intent(in) :: ascending !! Logical flag indicating whether or not the sorting should be in ascending or descending order - ! Internals - integer(I4B), dimension(:), allocatable :: ind - integer(I4B) :: direction - - if (self%nbody == 0) return - - if (ascending) then - direction = 1 - else - direction = -1 - end if - - associate(pl => self, npl => self%nbody) - select case(sortby) - case("Gmass","mass") - call util_sort(direction * pl%Gmass(1:npl), ind) - case("rhill") - call util_sort(direction * pl%rhill(1:npl), ind) - case("renc") - call util_sort(direction * pl%renc(1:npl), ind) - case("radius") - call util_sort(direction * pl%radius(1:npl), ind) - case("density") - call util_sort(direction * pl%density(1:npl), ind) - case("k2") - call util_sort(direction * pl%k2(1:npl), ind) - case("Q") - call util_sort(direction * pl%Q(1:npl), ind) - case("tlag") - call util_sort(direction * pl%tlag(1:npl), ind) - case("rbeg", "xend", "vbeg", "Ip", "rot", "k_plpl", "nplpl") - write(*,*) 'Cannot sort by ' // trim(adjustl(sortby)) // '. Component not sortable!' - case default ! Look for components in the parent class - call util_sort_body(pl, sortby, ascending) - return - end select - - call pl%rearrange(ind) - - end associate - - return - end subroutine util_sort_pl - - - module subroutine util_sort_tp(self, sortby, ascending) - !! author: David A. Minton - !! - !! Sort a Swiftest test particle object in-place. - !! sortby is a string indicating which array component to sort. - implicit none - ! Arguments - class(swiftest_tp), intent(inout) :: self !! Swiftest test particle object - character(*), intent(in) :: sortby !! Sorting attribute - logical, intent(in) :: ascending !! Logical flag indicating whether or not the sorting should be in ascending or descending order - ! Internals - integer(I4B), dimension(:), allocatable :: ind - integer(I4B) :: direction - - if (self%nbody == 0) return - - if (ascending) then - direction = 1 - else - direction = -1 - end if - - associate(tp => self, ntp => self%nbody) - select case(sortby) - case("peri") - call util_sort(direction * tp%peri(1:ntp), ind) - case("atp") - call util_sort(direction * tp%atp(1:ntp), ind) - case("isperi") - write(*,*) 'Cannot sort by ' // trim(adjustl(sortby)) // '. Component not sortable!' - case default ! Look for components in the parent class - call util_sort_body(tp, sortby, ascending) - return - end select - - call tp%rearrange(ind) - - end associate - - return - end subroutine util_sort_tp - - - module subroutine util_sort_rearrange_body(self, ind) - !! author: David A. Minton - !! - !! Rearrange Swiftest body structure in-place from an index list. - !! This is a helper utility used to make polymorphic sorting work on Swiftest structures. - implicit none - ! Arguments - class(swiftest_body), intent(inout) :: self !! Swiftest body object - integer(I4B), dimension(:), intent(in) :: ind !! Index array used to restructure the body (should contain all 1:n index values in the desired order) - - associate(n => self%nbody) - call util_sort_rearrange(self%id, ind, n) - call util_sort_rearrange(self%info, ind, n) - call util_sort_rearrange(self%status, ind, n) - call util_sort_rearrange(self%ldiscard, ind, n) - call util_sort_rearrange(self%rh, ind, n) - call util_sort_rearrange(self%vh, ind, n) - call util_sort_rearrange(self%rb, ind, n) - call util_sort_rearrange(self%vb, ind, n) - call util_sort_rearrange(self%ah, ind, n) - call util_sort_rearrange(self%ir3h, ind, n) - call util_sort_rearrange(self%mu, ind, n) - call util_sort_rearrange(self%lmask, ind, n) - call util_sort_rearrange(self%a, ind, n) - call util_sort_rearrange(self%e, ind, n) - call util_sort_rearrange(self%inc, ind, n) - call util_sort_rearrange(self%capom, ind, n) - call util_sort_rearrange(self%omega, ind, n) - call util_sort_rearrange(self%capm, ind, n) - call util_sort_rearrange(self%aobl, ind, n) - call util_sort_rearrange(self%atide, ind, n) - call util_sort_rearrange(self%agr, ind, n) - end associate - - return - end subroutine util_sort_rearrange_body - - - pure module subroutine util_sort_rearrange_arr_char_string(arr, ind, n) - !! author: David A. Minton - !! - !! Rearrange a single array of character string in-place from an index list. - implicit none - ! Arguments - character(len=STRMAX), dimension(:), allocatable, intent(inout) :: arr !! Destination array - integer(I4B), dimension(:), intent(in) :: ind !! Index to rearrange against - integer(I4B), intent(in) :: n !! Number of elements in arr and ind to rearrange - ! Internals - character(len=STRMAX), dimension(:), allocatable :: tmp !! Temporary copy of arry used during rearrange operation - - if (.not. allocated(arr) .or. n <= 0) return - allocate(tmp, mold=arr) - tmp(1:n) = arr(ind) - call move_alloc(tmp, arr) - - return - end subroutine util_sort_rearrange_arr_char_string - - - pure module subroutine util_sort_rearrange_arr_DP(arr, ind, n) - !! author: David A. Minton - !! - !! Rearrange a single array of DP type in-place from an index list. - implicit none - ! Arguments - real(DP), dimension(:), allocatable, intent(inout) :: arr !! Destination array - integer(I4B), dimension(:), intent(in) :: ind !! Index to rearrange against - integer(I4B), intent(in) :: n !! Number of elements in arr and ind to rearrange - ! Internals - real(DP), dimension(:), allocatable :: tmp !! Temporary copy of array used during rearrange operation - - if (.not. allocated(arr) .or. n <= 0) return - allocate(tmp, mold=arr) - tmp(1:n) = arr(ind) - call move_alloc(tmp, arr) - - return - end subroutine util_sort_rearrange_arr_DP - - - pure module subroutine util_sort_rearrange_arr_DPvec(arr, ind, n) - !! author: David A. Minton - !! - !! Rearrange a single array of (NDIM,n) DP-type vectors in-place from an index list. - implicit none - ! Arguments - real(DP), dimension(:,:), allocatable, intent(inout) :: arr !! Destination array - integer(I4B), dimension(:), intent(in) :: ind !! Index to rearrange against - integer(I4B), intent(in) :: n !! Number of elements in arr and ind to rearrange - ! Internals - real(DP), dimension(:,:), allocatable :: tmp !! Temporary copy of array used during rearrange operation - - if (.not. allocated(arr) .or. n <= 0) return - allocate(tmp, mold=arr) - tmp(:,1:n) = arr(:, ind) - call move_alloc(tmp, arr) - - return - end subroutine util_sort_rearrange_arr_DPvec - - - pure module subroutine util_sort_rearrange_arr_I4B(arr, ind, n) - !! author: David A. Minton - !! - !! Rearrange a single array of integers in-place from an index list. - implicit none - ! Arguments - integer(I4B), dimension(:), allocatable, intent(inout) :: arr !! Destination array - integer(I4B), dimension(:), intent(in) :: ind !! Index to rearrange against - integer(I4B), intent(in) :: n !! Number of elements in arr and ind to rearrange - ! Internals - integer(I4B), dimension(:), allocatable :: tmp !! Temporary copy of array used during rearrange operation - - if (.not. allocated(arr) .or. n <= 0) return - allocate(tmp, mold=arr) - tmp(1:n) = arr(ind) - call move_alloc(tmp, arr) - - return - end subroutine util_sort_rearrange_arr_I4B - - pure module subroutine util_sort_rearrange_arr_I4B_I8Bind(arr, ind, n) - !! author: David A. Minton - !! - !! Rearrange a single array of integers in-place from an index list. - implicit none - ! Arguments - integer(I4B), dimension(:), allocatable, intent(inout) :: arr !! Destination array - integer(I8B), dimension(:), intent(in) :: ind !! Index to rearrange against - integer(I8B), intent(in) :: n !! Number of elements in arr and ind to rearrange - ! Internals - integer(I4B), dimension(:), allocatable :: tmp !! Temporary copy of array used during rearrange operation - - if (.not. allocated(arr) .or. n <= 0_I8B) return - allocate(tmp, mold=arr) - tmp(1:n) = arr(ind) - call move_alloc(tmp, arr) - - return - end subroutine util_sort_rearrange_arr_I4B_I8Bind - - - pure module subroutine util_sort_rearrange_arr_logical(arr, ind, n) - !! author: David A. Minton - !! - !! Rearrange a single array of logicals in-place from an index list. - implicit none - ! Arguments - logical, dimension(:), allocatable, intent(inout) :: arr !! Destination array - integer(I4B), dimension(:), intent(in) :: ind !! Index to rearrange against - integer(I4B), intent(in) :: n !! Number of elements in arr and ind to rearrange - ! Internals - logical, dimension(:), allocatable :: tmp !! Temporary copy of array used during rearrange operation - - if (.not. allocated(arr) .or. n <= 0) return - allocate(tmp, mold=arr) - tmp(1:n) = arr(ind) - call move_alloc(tmp, arr) - - return - end subroutine util_sort_rearrange_arr_logical - - - pure module subroutine util_sort_rearrange_arr_logical_I8Bind(arr, ind, n) - !! author: David A. Minton - !! - !! Rearrange a single array of logicals in-place from an index list. - implicit none - ! Arguments - logical, dimension(:), allocatable, intent(inout) :: arr !! Destination array - integer(I8B), dimension(:), intent(in) :: ind !! Index to rearrange against - integer(I8B), intent(in) :: n !! Number of elements in arr and ind to rearrange - ! Internals - logical, dimension(:), allocatable :: tmp !! Temporary copy of array used during rearrange operation - - if (.not. allocated(arr) .or. n <= 0) return - allocate(tmp, mold=arr) - tmp(1:n) = arr(ind) - call move_alloc(tmp, arr) - - return - end subroutine util_sort_rearrange_arr_logical_I8Bind - - - module subroutine util_sort_rearrange_arr_info(arr, ind, n) - !! author: David A. Minton - !! - !! Rearrange a single array of particle information type in-place from an index list. - implicit none - ! Arguments - type(swiftest_particle_info), dimension(:), allocatable, intent(inout) :: arr !! Destination array - integer(I4B), dimension(:), intent(in) :: ind !! Index to rearrange against - integer(I4B), intent(in) :: n !! Number of elements in arr and ind to rearrange - ! Internals - type(swiftest_particle_info), dimension(:), allocatable :: tmp !! Temporary copy of array used during rearrange operation - - if (.not. allocated(arr) .or. n <= 0) return - allocate(tmp, mold=arr) - - call util_copy_particle_info_arr(arr, tmp, ind) - call move_alloc(tmp, arr) - - return - end subroutine util_sort_rearrange_arr_info - - - module subroutine util_sort_rearrange_pl(self, ind) - !! author: David A. Minton - !! - !! Rearrange Swiftest massive body structure in-place from an index list. - !! This is a helper utility used to make polymorphic sorting work on Swiftest structures. - implicit none - class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object - integer(I4B), dimension(:), intent(in) :: ind !! Index array used to restructure the body (should contain all 1:n index values in the desired order) - - associate(pl => self, npl => self%nbody) - call util_sort_rearrange(pl%mass, ind, npl) - call util_sort_rearrange(pl%Gmass, ind, npl) - call util_sort_rearrange(pl%rhill, ind, npl) - call util_sort_rearrange(pl%rbeg, ind, npl) - call util_sort_rearrange(pl%vbeg, ind, npl) - call util_sort_rearrange(pl%radius, ind, npl) - call util_sort_rearrange(pl%density, ind, npl) - call util_sort_rearrange(pl%Ip, ind, npl) - call util_sort_rearrange(pl%rot, ind, npl) - call util_sort_rearrange(pl%k2, ind, npl) - call util_sort_rearrange(pl%Q, ind, npl) - call util_sort_rearrange(pl%tlag, ind, npl) - - if (allocated(pl%k_plpl)) deallocate(pl%k_plpl) - - call util_sort_rearrange_body(pl, ind) - end associate - - return - end subroutine util_sort_rearrange_pl - - - module subroutine util_sort_rearrange_tp(self, ind) - !! author: David A. Minton - !! - !! Rearrange Swiftest massive body structure in-place from an index list. - !! This is a helper utility used to make polymorphic sorting work on Swiftest structures. - implicit none - ! Arguments - class(swiftest_tp), intent(inout) :: self !! Swiftest test particle object - integer(I4B), dimension(:), intent(in) :: ind !! Index array used to restructure the body (should contain all 1:n index values in the desired order) - - associate(tp => self, ntp => self%nbody) - call util_sort_rearrange(tp%isperi, ind, ntp) - call util_sort_rearrange(tp%peri, ind, ntp) - call util_sort_rearrange(tp%atp, ind, ntp) - - call util_sort_rearrange_body(tp, ind) - end associate - - return - end subroutine util_sort_rearrange_tp - -end submodule s_util_sort diff --git a/src/util/util_spill.f90 b/src/util/util_spill.f90 deleted file mode 100644 index 1ba4b4a2f..000000000 --- a/src/util/util_spill.f90 +++ /dev/null @@ -1,440 +0,0 @@ -!! Copyright 2022 - David Minton, Carlisle Wishard, Jennifer Pouplin, Jake Elliott, & Dana Singh -!! This file is part of Swiftest. -!! Swiftest is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License -!! as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. -!! Swiftest is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty -!! of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. -!! You should have received a copy of the GNU General Public License along with Swiftest. -!! If not, see: https://www.gnu.org/licenses. - -submodule (swiftest_classes) s_util_spill - use swiftest -contains - - module subroutine util_spill_arr_char_string(keeps, discards, lspill_list, ldestructive) - !! author: David A. Minton - !! - !! Performs a spill operation on a single array of type character strings - !! This is the inverse of a spill operation - implicit none - ! Arguments - character(len=STRMAX), dimension(:), allocatable, intent(inout) :: keeps !! Array of values to keep - character(len=STRMAX), dimension(:), allocatable, intent(inout) :: discards !! Array of discards - logical, dimension(:), intent(in) :: lspill_list !! Logical array of bodies to spill into the discards - logical, intent(in) :: ldestructive !! Logical flag indicating whether or not this operation should alter the keeps array or not - ! Internals - integer(I4B) :: nspill, nkeep, nlist - character(len=STRMAX), dimension(:), allocatable :: tmp !! Array of values to keep - - nkeep = count(.not.lspill_list(:)) - nspill = count(lspill_list(:)) - nlist = size(lspill_list(:)) - - if (.not.allocated(keeps) .or. nspill == 0) return - if (.not.allocated(discards)) then - allocate(discards(nspill)) - else if (size(discards) /= nspill) then - deallocate(discards) - allocate(discards(nspill)) - end if - - discards(:) = pack(keeps(1:nlist), lspill_list(1:nlist)) - if (ldestructive) then - if (nkeep > 0) then - allocate(tmp(nkeep)) - tmp(:) = pack(keeps(1:nlist), .not. lspill_list(1:nlist)) - call move_alloc(tmp, keeps) - else - deallocate(keeps) - end if - end if - - return - end subroutine util_spill_arr_char_string - - - module subroutine util_spill_arr_DP(keeps, discards, lspill_list, ldestructive) - !! author: David A. Minton - !! - !! Performs a spill operation on a single array of type DP - !! This is the inverse of a spill operation - implicit none - ! Arguments - real(DP), dimension(:), allocatable, intent(inout) :: keeps !! Array of values to keep - real(DP), dimension(:), allocatable, intent(inout) :: discards !! Array of discards - logical, dimension(:), intent(in) :: lspill_list !! Logical array of bodies to spill into the discardss - logical, intent(in) :: ldestructive !! Logical flag indicating whether or not this operation should alter the keeps array or not - ! Internals - integer(I4B) :: nspill, nkeep, nlist - real(DP), dimension(:), allocatable :: tmp !! Array of values to keep - - nkeep = count(.not.lspill_list(:)) - nspill = count(lspill_list(:)) - nlist = size(lspill_list(:)) - - if (.not.allocated(keeps) .or. nspill == 0) return - if (.not.allocated(discards)) then - allocate(discards(nspill)) - else if (size(discards) /= nspill) then - deallocate(discards) - allocate(discards(nspill)) - end if - - discards(:) = pack(keeps(1:nlist), lspill_list(1:nlist)) - if (ldestructive) then - if (nkeep > 0) then - allocate(tmp(nkeep)) - tmp(:) = pack(keeps(1:nlist), .not. lspill_list(1:nlist)) - call move_alloc(tmp, keeps) - else - deallocate(keeps) - end if - end if - - return - end subroutine util_spill_arr_DP - - - module subroutine util_spill_arr_DPvec(keeps, discards, lspill_list, ldestructive) - !! author: David A. Minton - !! - !! Performs a spill operation on a single array of DP vectors with shape (NDIM, n) - !! This is the inverse of a spill operation - implicit none - ! Arguments - real(DP), dimension(:,:), allocatable, intent(inout) :: keeps !! Array of values to keep - real(DP), dimension(:,:), allocatable, intent(inout) :: discards !! Array discards - logical, dimension(:), intent(in) :: lspill_list !! Logical array of bodies to spill into the discards - logical, intent(in) :: ldestructive !! Logical flag indicating whether or not this operation should alter the keeps array or not - ! Internals - integer(I4B) :: i, nspill, nkeep, nlist - real(DP), dimension(:,:), allocatable :: tmp !! Array of values to keep - - nkeep = count(.not.lspill_list(:)) - nspill = count(lspill_list(:)) - nlist = size(lspill_list(:)) - - if (.not.allocated(keeps) .or. nspill == 0) return - if (.not.allocated(discards)) then - allocate(discards(NDIM, nspill)) - else if (size(discards, dim=2) /= nspill) then - deallocate(discards) - allocate(discards(NDIM, nspill)) - end if - - do i = 1, NDIM - discards(i,:) = pack(keeps(i,1:nlist), lspill_list(1:nlist)) - end do - if (ldestructive) then - if (nkeep > 0) then - allocate(tmp(NDIM, nkeep)) - do i = 1, NDIM - tmp(i, :) = pack(keeps(i, 1:nlist), .not. lspill_list(1:nlist)) - end do - call move_alloc(tmp, keeps) - else - deallocate(keeps) - end if - end if - - return - end subroutine util_spill_arr_DPvec - - - module subroutine util_spill_arr_I4B(keeps, discards, lspill_list, ldestructive) - !! author: David A. Minton - !! - !! Performs a spill operation on a single array of type I4B - !! This is the inverse of a spill operation - implicit none - ! Arguments - integer(I4B), dimension(:), allocatable, intent(inout) :: keeps !! Array of values to keep - integer(I4B), dimension(:), allocatable, intent(inout) :: discards !! Array of discards - logical, dimension(:), intent(in) :: lspill_list !! Logical array of bodies to spill into the discards - logical, intent(in) :: ldestructive !! Logical flag indicating whether or not this operation should alter the keeps array or not - ! Internals - integer(I4B) :: nspill, nkeep, nlist - integer(I4B), dimension(:), allocatable :: tmp !! Array of values to keep - - nkeep = count(.not.lspill_list(:)) - nspill = count(lspill_list(:)) - nlist = size(lspill_list(:)) - - if (.not.allocated(keeps) .or. nspill == 0) return - if (.not.allocated(discards)) then - allocate(discards(nspill)) - else if (size(discards) /= nspill) then - deallocate(discards) - allocate(discards(nspill)) - end if - - discards(:) = pack(keeps(1:nlist), lspill_list(1:nlist)) - if (ldestructive) then - if (nkeep > 0) then - allocate(tmp(nkeep)) - tmp(:) = pack(keeps(1:nlist), .not. lspill_list(1:nlist)) - call move_alloc(tmp, keeps) - else - deallocate(keeps) - end if - end if - - return - end subroutine util_spill_arr_I4B - - - module subroutine util_spill_arr_I8B(keeps, discards, lspill_list, ldestructive) - !! author: David A. Minton - !! - !! Performs a spill operation on a single array of type I4B - !! This is the inverse of a spill operation - implicit none - ! Arguments - integer(I8B), dimension(:), allocatable, intent(inout) :: keeps !! Array of values to keep - integer(I8B), dimension(:), allocatable, intent(inout) :: discards !! Array of discards - logical, dimension(:), intent(in) :: lspill_list !! Logical array of bodies to spill into the discards - logical, intent(in) :: ldestructive !! Logical flag indicating whether or not this operation should alter the keeps array or not - ! Internals - integer(I4B) :: nspill, nkeep, nlist - integer(I8B), dimension(:), allocatable :: tmp !! Array of values to keep - - nkeep = count(.not.lspill_list(:)) - nspill = count(lspill_list(:)) - nlist = size(lspill_list(:)) - - if (.not.allocated(keeps) .or. nspill == 0) return - if (.not.allocated(discards)) then - allocate(discards(nspill)) - else if (size(discards) /= nspill) then - deallocate(discards) - allocate(discards(nspill)) - end if - - discards(:) = pack(keeps(1:nlist), lspill_list(1:nlist)) - if (ldestructive) then - if (nkeep > 0) then - allocate(tmp(nkeep)) - tmp(:) = pack(keeps(1:nlist), .not. lspill_list(1:nlist)) - call move_alloc(tmp, keeps) - else - deallocate(keeps) - end if - end if - - return - end subroutine util_spill_arr_I8B - - - module subroutine util_spill_arr_info(keeps, discards, lspill_list, ldestructive) - !! author: David A. Minton - !! - !! Performs a spill operation on a single array of particle origin information types - !! This is the inverse of a spill operation - implicit none - ! Arguments - type(swiftest_particle_info), dimension(:), allocatable, intent(inout) :: keeps !! Array of values to keep - type(swiftest_particle_info), dimension(:), allocatable, intent(inout) :: discards !! Array of discards - logical, dimension(:), intent(in) :: lspill_list !! Logical array of bodies to spill into the discardss - logical, intent(in) :: ldestructive !! Logical flag indicating whether or not this operation should alter the keeps array or not - ! Internals - integer(I4B) :: i, nspill, nkeep, nlist - integer(I4B), dimension(:), allocatable :: idx - type(swiftest_particle_info), dimension(:), allocatable :: tmp - - nkeep = count(.not.lspill_list(:)) - nspill = count(lspill_list(:)) - nlist = size(lspill_list(:)) - - if (.not.allocated(keeps) .or. nspill == 0) return - if (.not.allocated(discards)) then - allocate(discards(nspill)) - else if (size(discards) /= nspill) then - deallocate(discards) - allocate(discards(nspill)) - end if - - allocate(idx(nspill)) - idx(:) = pack([(i, i = 1, nlist)], lspill_list) - call util_copy_particle_info_arr(keeps, discards, idx) - if (ldestructive) then - if (nkeep > 0) then - deallocate(idx) - allocate(idx(nkeep)) - allocate(tmp(nkeep)) - idx(:) = pack([(i, i = 1, nlist)], .not. lspill_list) - call util_copy_particle_info_arr(keeps, tmp, idx) - call move_alloc(tmp, keeps) - else - deallocate(keeps) - end if - end if - - return - end subroutine util_spill_arr_info - - - module subroutine util_spill_arr_logical(keeps, discards, lspill_list, ldestructive) - !! author: David A. Minton - !! - !! Performs a spill operation on a single array of logicals - !! This is the inverse of a spill operation - implicit none - ! Arguments - logical, dimension(:), allocatable, intent(inout) :: keeps !! Array of values to keep - logical, dimension(:), allocatable, intent(inout) :: discards !! Array of discards - logical, dimension(:), intent(in) :: lspill_list !! Logical array of bodies to spill into the discards - logical, intent(in) :: ldestructive !! Logical flag indicating whether or not this operation should alter the keeps array or no - ! Internals - integer(I4B) :: nspill, nkeep, nlist - logical, dimension(:), allocatable :: tmp !! Array of values to keep - - nkeep = count(.not.lspill_list(:)) - nspill = count(lspill_list(:)) - nlist = size(lspill_list(:)) - - if (.not.allocated(keeps) .or. nspill == 0) return - if (.not.allocated(discards)) then - allocate(discards(nspill)) - else if (size(discards) /= nspill) then - deallocate(discards) - allocate(discards(nspill)) - end if - - discards(:) = pack(keeps(1:nlist), lspill_list(1:nlist)) - if (ldestructive) then - if (nkeep > 0) then - allocate(tmp(nkeep)) - tmp(:) = pack(keeps(1:nlist), .not. lspill_list(1:nlist)) - call move_alloc(tmp, keeps) - else - deallocate(keeps) - end if - end if - - return - end subroutine util_spill_arr_logical - - - module subroutine util_spill_body(self, discards, lspill_list, ldestructive) - !! author: David A. Minton - !! - !! Move spilled (discarded) Swiftest generic particle structure from active list to discard list - !! Adapted from David E. Kaufmann's Swifter routine whm_discard_spill.f90 - implicit none - ! Arguments - class(swiftest_body), intent(inout) :: self !! Swiftest generic body object - class(swiftest_body), intent(inout) :: discards !! Discarded object - logical, dimension(:), intent(in) :: lspill_list !! Logical array of bodies to spill into the discards - logical, intent(in) :: ldestructive !! Logical flag indicating whether or not this operation should alter body by removing the discard list - ! Internals - integer(I4B) :: nbody_old - - ! For each component, pack the discarded bodies into the discard object and do the inverse with the keeps - !> Spill all the common components - associate(keeps => self) - - call util_spill(keeps%id, discards%id, lspill_list, ldestructive) - call util_spill(keeps%info, discards%info, lspill_list, ldestructive) - call util_spill(keeps%status, discards%status, lspill_list, ldestructive) - call util_spill(keeps%lmask, discards%lmask, lspill_list, ldestructive) - call util_spill(keeps%ldiscard, discards%ldiscard, lspill_list, ldestructive) - call util_spill(keeps%mu, discards%mu, lspill_list, ldestructive) - call util_spill(keeps%rh, discards%rh, lspill_list, ldestructive) - call util_spill(keeps%vh, discards%vh, lspill_list, ldestructive) - call util_spill(keeps%rb, discards%rb, lspill_list, ldestructive) - call util_spill(keeps%vb, discards%vb, lspill_list, ldestructive) - call util_spill(keeps%ah, discards%ah, lspill_list, ldestructive) - call util_spill(keeps%aobl, discards%aobl, lspill_list, ldestructive) - call util_spill(keeps%agr, discards%agr, lspill_list, ldestructive) - call util_spill(keeps%atide, discards%atide, lspill_list, ldestructive) - call util_spill(keeps%a, discards%a, lspill_list, ldestructive) - call util_spill(keeps%e, discards%e, lspill_list, ldestructive) - call util_spill(keeps%inc, discards%inc, lspill_list, ldestructive) - call util_spill(keeps%capom, discards%capom, lspill_list, ldestructive) - call util_spill(keeps%omega, discards%omega, lspill_list, ldestructive) - call util_spill(keeps%capm, discards%capm, lspill_list, ldestructive) - - nbody_old = keeps%nbody - - ! This is the base class, so will be the last to be called in the cascade. - ! Therefore we need to set the nbody values for both the keeps and discareds - discards%nbody = count(lspill_list(1:nbody_old)) - if (ldestructive) keeps%nbody = nbody_old- discards%nbody - end associate - - return - end subroutine util_spill_body - - - module subroutine util_spill_pl(self, discards, lspill_list, ldestructive) - !! author: David A. Minton - !! - !! Move spilled (discarded) Swiftest massive body structure from active list to discard list - !! Adapted from David E. Kaufmann's Swifter routine whm_discard_spill.f90 - implicit none - ! Arguments - class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object - class(swiftest_body), intent(inout) :: discards !! Discarded object - logical, dimension(:), intent(in) :: lspill_list !! Logical array of bodies to spill into the discards - logical, intent(in) :: ldestructive !! Logical flag indicating whether or not this operation should alter body by removing the discard list - - associate(keeps => self) - select type (discards) ! The standard requires us to select the type of both arguments in order to access all the components - class is (swiftest_pl) - !> Spill components specific to the massive body class - call util_spill(keeps%mass, discards%mass, lspill_list, ldestructive) - call util_spill(keeps%Gmass, discards%Gmass, lspill_list, ldestructive) - call util_spill(keeps%rhill, discards%rhill, lspill_list, ldestructive) - call util_spill(keeps%renc, discards%renc, lspill_list, ldestructive) - call util_spill(keeps%radius, discards%radius, lspill_list, ldestructive) - call util_spill(keeps%density, discards%density, lspill_list, ldestructive) - call util_spill(keeps%k2, discards%k2, lspill_list, ldestructive) - call util_spill(keeps%Q, discards%Q, lspill_list, ldestructive) - call util_spill(keeps%tlag, discards%tlag, lspill_list, ldestructive) - call util_spill(keeps%rbeg, discards%rbeg, lspill_list, ldestructive) - call util_spill(keeps%vbeg, discards%vbeg, lspill_list, ldestructive) - call util_spill(keeps%Ip, discards%Ip, lspill_list, ldestructive) - call util_spill(keeps%rot, discards%rot, lspill_list, ldestructive) - - if (ldestructive .and. allocated(keeps%k_plpl)) deallocate(keeps%k_plpl) - - call util_spill_body(keeps, discards, lspill_list, ldestructive) - class default - write(*,*) 'Error! spill method called for incompatible return type on swiftest_pl' - end select - end associate - - return - end subroutine util_spill_pl - - - module subroutine util_spill_tp(self, discards, lspill_list, ldestructive) - !! author: David A. Minton - !! - !! Move spilled (discarded) Swiftest test particle structure from active list to discard list - !! Adapted from David E. Kaufmann's Swifter routine whm_discard_spill.f90 - implicit none - ! Arguments - class(swiftest_tp), intent(inout) :: self !! Swiftest test particle object - class(swiftest_body), intent(inout) :: discards !! Discarded object - logical, dimension(:), intent(in) :: lspill_list !! Logical array of bodies to spill into the discardse - logical, intent(in) :: ldestructive !! Logical flag indicating whether or not this operation should alter body by removing the discard list - - associate(keeps => self, ntp => self%nbody) - select type(discards) - class is (swiftest_tp) - !> Spill components specific to the test particle class - call util_spill(keeps%isperi, discards%isperi, lspill_list, ldestructive) - call util_spill(keeps%peri, discards%peri, lspill_list, ldestructive) - call util_spill(keeps%atp, discards%atp, lspill_list, ldestructive) - - call util_spill_body(keeps, discards, lspill_list, ldestructive) - class default - write(*,*) 'Error! spill method called for incompatible return type on swiftest_tp' - end select - end associate - - return - end subroutine util_spill_tp - -end submodule s_util_spill \ No newline at end of file diff --git a/src/util/util_unique.f90 b/src/util/util_unique.f90 deleted file mode 100644 index 19eb4ba78..000000000 --- a/src/util/util_unique.f90 +++ /dev/null @@ -1,80 +0,0 @@ -!! Copyright 2022 - David Minton, Carlisle Wishard, Jennifer Pouplin, Jake Elliott, & Dana Singh -!! This file is part of Swiftest. -!! Swiftest is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License -!! as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. -!! Swiftest is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty -!! of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. -!! You should have received a copy of the GNU General Public License along with Swiftest. -!! If not, see: https://www.gnu.org/licenses. - -submodule (swiftest_classes) s_util_unique - use swiftest -contains - - module subroutine util_unique_DP(input_array, output_array, index_map) - !! author: David A. Minton - !! - !! Takes an input unsorted integer array and returns a new array of sorted, unique values (DP version) - implicit none - ! Arguments - real(DP), dimension(:), intent(in) :: input_array !! Unsorted input array - real(DP), dimension(:), allocatable, intent(out) :: output_array !! Sorted array of unique values - integer(I4B), dimension(:), allocatable, intent(out) :: index_map !! An array of the same size as input_array that such that any for any index i, output_array(index_map(i)) = input_array(i) - ! Internals - real(DP), dimension(:), allocatable :: unique_array - integer(I4B) :: n - real(DP) :: lo, hi - - allocate(unique_array, mold=input_array) - allocate(index_map(size(input_array))) - lo = minval(input_array) - 1 - hi = maxval(input_array) - - n = 0 - do - n = n + 1 - lo = minval(input_array(:), mask=input_array(:) > lo) - unique_array(n) = lo - where(input_array(:) == lo) index_map(:) = n - if (lo >= hi) exit - enddo - allocate(output_array(n), source=unique_array(1:n)) - - return - end subroutine util_unique_DP - - - module subroutine util_unique_I4B(input_array, output_array, index_map) - !! author: David A. Minton - !! - !! Takes an input unsorted integer array and returns a new array of sorted, unique values (I4B version) - implicit none - ! Arguments - integer(I4B), dimension(:), intent(in) :: input_array !! Unsorted input array - integer(I4B), dimension(:), allocatable, intent(out) :: output_array !! Sorted array of unique values - integer(I4B), dimension(:), allocatable, intent(out) :: index_map !! An array of the same size as input_array that such that any for any index i, output_array(index_map(i)) = input_array(i) - ! Internals - integer(I4B), dimension(:), allocatable :: unique_array - integer(I4B) :: n, lo, hi - - allocate(unique_array, mold=input_array) - allocate(index_map, mold=input_array) - lo = minval(input_array) - 1 - hi = maxval(input_array) - - n = 0 - do - n = n + 1 - lo = minval(input_array(:), mask=input_array(:) > lo) - unique_array(n) = lo - where(input_array(:) == lo) index_map(:) = n - if (lo >= hi) exit - enddo - allocate(output_array(n), source=unique_array(1:n)) - - return - end subroutine util_unique_I4B - - - -end submodule s_util_unique \ No newline at end of file diff --git a/src/util/util_valid.f90 b/src/util/util_valid.f90 deleted file mode 100644 index e6a4b6663..000000000 --- a/src/util/util_valid.f90 +++ /dev/null @@ -1,52 +0,0 @@ -!! Copyright 2022 - David Minton, Carlisle Wishard, Jennifer Pouplin, Jake Elliott, & Dana Singh -!! This file is part of Swiftest. -!! Swiftest is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License -!! as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. -!! Swiftest is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty -!! of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. -!! You should have received a copy of the GNU General Public License along with Swiftest. -!! If not, see: https://www.gnu.org/licenses. - -submodule (swiftest_classes) s_util_valid - use swiftest -contains - - module subroutine util_valid_id_system(self, param) - !! author: David A. Minton - !! - !! Validate massive body and test particle ids - !! Subroutine causes program to exit with error if any ids are not unique - !! - !! Adapted from David E. Kaufmann's Swifter routine: util_valid.f90 - implicit none - ! Arguments - class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nbody system object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - ! Internals - integer(I4B) :: i - integer(I4B), dimension(:), allocatable :: idarr - - associate(cb => self%cb, pl => self%pl, npl => self%pl%nbody, tp => self%tp, ntp => self%tp%nbody) - allocate(idarr(1+npl+ntp)) - idarr(1) = cb%id - do i = 1, npl - idarr(1+i) = pl%id(i) - end do - do i = 1, ntp - idarr(1+npl+i) = tp%id(i) - end do - call util_sort(idarr) - do i = 1, npl + ntp - if (idarr(i) == idarr(i+1)) then - write(*, *) "Swiftest error:" - write(*, *) " more than one body/particle has id = ", idarr(i) - call util_exit(FAILURE) - end if - end do - param%maxid = max(param%maxid, maxval(idarr)) - end associate - - return - end subroutine util_valid_id_system - -end submodule s_util_valid diff --git a/src/util/util_version.f90 b/src/util/util_version.f90 deleted file mode 100644 index f44062e5e..000000000 --- a/src/util/util_version.f90 +++ /dev/null @@ -1,62 +0,0 @@ -!! Copyright 2022 - David Minton, Carlisle Wishard, Jennifer Pouplin, Jake Elliott, & Dana Singh -!! This file is part of Swiftest. -!! Swiftest is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License -!! as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. -!! Swiftest is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty -!! of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. -!! You should have received a copy of the GNU General Public License along with Swiftest. -!! If not, see: https://www.gnu.org/licenses. - -submodule (swiftest_classes) s_util_version - use swiftest -contains - - module subroutine util_version() - !! author: David A. Minton - !! - !! Print program version information to terminale - !! - !! Adapted from David E. Kaufmann's Swifter routine: util_version.f90 - implicit none - write(*, 200) VERSION_NUMBER -200 format(/, "************* Swiftest: Version ", f3.1, " *************", //, & - "Based off of Swifter:", //, & - "Authors:", //, & - " The Purdue University Swiftest Development team ", /, & - " Lead by David A. Minton ", /, & - " Single loop blocking by Jacob R. Elliott", /, & - " Fragmentation by Carlisle A. Wishard and", //, & - " Jennifer L. L. Poutplin ", //, & - "Please address comments and questions to:", //, & - " David A. Minton", /, & - " Department Earth, Atmospheric, & Planetary Sciences ",/, & - " Purdue University", /, & - " 550 Stadium Mall Drive", /, & - " West Lafayette, Indiana 47907", /, & - " 765-250-8034 ", /, & - " daminton@purdue.edu", /, & - "Special thanks to Hal Levison and Martin Duncan for the original",/,& - "SWIFTER and SWIFT codes that made this possible.", //, & - "************************************************", /) - - - 100 FORMAT(/, "************* SWIFTER: Version ", F3.1, " *************", //, & - "Authors:", //, & - " Martin Duncan: Queen's University", /, & - " Hal Levison : Southwest Research Institute", //, & - "Please address comments and questions to:", //, & - " Hal Levison or David Kaufmann", /, & - " Department of Space Studies", /, & - " Southwest Research Institute", /, & - " 1050 Walnut Street, Suite 400", /, & - " Boulder, Colorado 80302", /, & - " 303-546-0290 (HFL), 720-240-0119 (DEK)", /, & - " 303-546-9687 (fax)", /, & - " hal@gort.boulder.swri.edu (HFL)", /, & - " kaufmann@boulder.swri.edu (DEK)", //, & - "************************************************", /) - - return - end subroutine util_version - -end submodule s_util_version diff --git a/src/walltime/walltime.f90 b/src/walltime/walltime.f90 deleted file mode 100644 index 491a2e478..000000000 --- a/src/walltime/walltime.f90 +++ /dev/null @@ -1,352 +0,0 @@ -!! Copyright 2022 - David Minton, Carlisle Wishard, Jennifer Pouplin, Jake Elliott, & Dana Singh -!! This file is part of Swiftest. -!! Swiftest is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License -!! as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. -!! Swiftest is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty -!! of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. -!! You should have received a copy of the GNU General Public License along with Swiftest. -!! If not, see: https://www.gnu.org/licenses. - -submodule(walltime_classes) s_walltime - use swiftest -contains - - module subroutine walltime_stop(self) - !! author: David A. Minton - !! - !! Pauses the step timer (but not the main timer). - implicit none - ! Arguments - class(walltimer), intent(inout) :: self !! Walltimer object - ! Internals - integer(I8B) :: count_delta - - if (self%is_paused) then - write(*,*) "Wall timer error: Timer is already paused!" - return - end if - - call system_clock(self%count_pause) - self%is_paused = .true. - - self%count_stop_step = self%count_pause - - count_delta = self%count_stop_step - self%count_start_step - self%wall_step = count_delta / (self%count_rate * 1.0_DP) - - return - end subroutine walltime_stop - - - module subroutine walltime_report(self, message, unit, nsubsteps) - !! author: David A. Minton - !! - !! Prints the elapsed time information to the terminal - implicit none - ! Arguments - class(walltimer), intent(inout) :: self !! Walltimer object - character(len=*), intent(in) :: message !! Message to prepend to the wall time terminal output - integer(I4B), intent(in) :: unit !! Output file unit for report text to be directed - integer(I4B), optional, intent(in) :: nsubsteps !! Number of substeps used to compute the time per step - ! Internals - character(len=*), parameter :: nosubstepfmt = '" Total wall time: ", es12.5, "; Interval wall time: ", es12.5 ' - character(len=*), parameter :: substepfmt = '" Total wall time: ", es12.5, "; Interval wall time: ", es12.5, ";' //& - 'Interval wall time/step: ", es12.5' - character(len=STRMAX) :: fmt - integer(I8B) :: count_delta_step, count_delta_main, count_now - - if (.not.self%main_is_started) then - write(*,*) "Wall timer error: The step finish time cannot be calculated because the timer is not started!" - return - end if - - call system_clock(count_now) - count_delta_main = count_now - self%count_start_main - count_delta_step = count_now - self%count_start_step - self%wall_main = count_delta_main / (self%count_rate * 1.0_DP) - self%wall_step = count_delta_step / (self%count_rate * 1.0_DP) - if (present(nsubsteps)) then - self%wall_per_substep = self%wall_step / nsubsteps - fmt = '("' // adjustl(message) // '",' // substepfmt // ')' - write(unit,trim(adjustl(fmt))) self%wall_main, self%wall_step, self%wall_per_substep - else - fmt = '("' // adjustl(message) // '",' // nosubstepfmt // ')' - write(unit,trim(adjustl(fmt))) self%wall_main, self%wall_step - end if - - return - end subroutine walltime_report - - - module subroutine walltime_reset(self) - !! author: David A. Minton - !! - !! Resets the step timer - implicit none - ! Arguments - class(walltimer), intent(inout) :: self !! Walltimer object - ! Internals - - self%is_paused = .false. - self%wall_step = 0.0_DP - self%wall_per_substep = 0.0_DP - - return - end subroutine walltime_reset - - - module subroutine walltime_start_main(self) - !! author: David A. Minton - !! - !! Resets the clock ticker, settting main_start to the current ticker value - implicit none - ! Arguments - class(walltimer), intent(inout) :: self !! Walltimer object - - call system_clock(self%count_start_main, self%count_rate, self%count_max) - self%main_is_started = .true. - self%wall_main = 0.0_DP - - return - end subroutine walltime_start_main - - - module subroutine walltime_start(self) - !! author: David A. Minton - !! - !! Starts or resumes the step timer - !! - implicit none - ! Arguments - class(walltimer), intent(inout) :: self !! Walltimer object - ! Internals - integer(I8B) :: count_resume, count_delta - - if (.not.self%main_is_started) then - call self%reset() - call self%start_main() - end if - - if (self%is_paused) then ! Resume a paused step timer - call system_clock(count_resume) - count_delta = count_resume - self%count_pause - self%count_pause = 0_I8B - self%count_start_step = self%count_start_step + count_delta - self%is_paused = .false. - else ! Start a new step timer - call system_clock(self%count_start_step) - end if - - return - end subroutine walltime_start - - - module subroutine walltime_interaction_adapt(self, param, ninteractions, pl) - !! author: David A. Minton - !! - !! Determines which of the two loop styles is fastest and keeps that one - implicit none - ! Arguments - class(interaction_timer), intent(inout) :: self !! Walltimer object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - integer(I8B), intent(in) :: ninteractions !! Current number of interactions (used to normalize the timed loop and to determine if number of interactions has changed since the last timing - class(swiftest_pl), intent(inout), optional :: pl !! Swiftest massive body object - ! Internals - character(len=STRMAX) :: nstr, cstr, mstr - character(len=11) :: lstyle, advancedstyle, standardstyle - character(len=1) :: schar - logical :: ladvanced_final - character(len=NAMELEN) :: logfile - - ! Record the elapsed time - call self%stop() - - select case(trim(adjustl(self%looptype))) - case("INTERACTION") - write(advancedstyle, *) "FLAT " - write(standardstyle, *) "TRIANGULAR" - write(logfile,*) INTERACTION_TIMER_LOG_OUT - case("ENCOUNTER_PLPL") - write(advancedstyle, *) "SORTSWEEP " - write(standardstyle, *) "TRIANGULAR" - write(logfile,*) ENCOUNTER_PLPL_TIMER_LOG_OUT - case("ENCOUNTER_PLTP") - write(advancedstyle, *) "SORTSWEEP " - write(standardstyle, *) "TRIANGULAR" - write(logfile,*) ENCOUNTER_PLTP_TIMER_LOG_OUT - case default - write(logfile,*) "unknown_looptimer.log" - end select - - write(schar,'(I1)') self%stage - write(nstr,*) ninteractions - - select case(self%stage) - case(1) - if (self%stage1_is_advanced) then - lstyle = advancedstyle - else - lstyle = standardstyle - end if - self%stage1_metric = (self%count_stop_step - self%count_start_step) / real(ninteractions, kind=DP) - write(mstr,*) self%stage1_metric - case(2) - if (.not.self%stage1_is_advanced) then - lstyle = advancedstyle - else - lstyle = standardstyle - end if - - self%stage2_metric = (self%count_stop_step - self%count_start_step) / real(ninteractions, kind=DP) - self%is_on = .false. - self%step_counter = 0 - if (self%stage1_metric < self%stage2_metric) then - ladvanced_final = self%stage1_is_advanced - call self%flip(param, pl) ! Go back to the original style, otherwise keep the stage2 style - else - ladvanced_final = .not.self%stage1_is_advanced - end if - write(mstr,*) self%stage2_metric - end select - - write(cstr,*) self%count_stop_step - self%count_start_step - - call io_log_one_message(logfile, adjustl(lstyle) // " " // trim(adjustl(cstr)) // " " // & - trim(adjustl(nstr)) // " " // trim(adjustl(mstr))) - - if (self%stage == 2) then - if (ladvanced_final) then - lstyle = advancedstyle - else - lstyle = standardstyle - end if - call io_log_one_message(logfile, trim(adjustl(self%loopname)) // & - ": the fastest loop method tested is " // trim(adjustl(lstyle))) - end if - - return - end subroutine walltime_interaction_adapt - - - module function walltime_interaction_check(self, param, ninteractions) result(ltimeit) - !! author: David A. Minton - !! - !! Checks whether or not the loop should be timed and starts the timer if the conditions for starting are met - implicit none - ! Arguments - class(interaction_timer), intent(inout) :: self !! Walltimer object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - integer(I8B), intent(in) :: ninteractions !! Current number of interactions (used to normalize the timed loop and to determine if number of interactions has changed since the last timing - logical :: ltimeit !! Logical flag indicating whether this loop should be timed or not - - if (self%is_on) then ! Entering the second stage of the loop timing. Therefore we will swap the interaction style and time this loop - self%stage = self%stage + 1 - ltimeit = (self%stage == 2) - else - self%step_counter = min(self%step_counter + 1, INTERACTION_TIMER_CADENCE) - ltimeit = .false. - if (self%step_counter == INTERACTION_TIMER_CADENCE) then - ltimeit = (ninteractions /= self%last_interactions) - if (ltimeit) self%stage = 1 - end if - end if - self%is_on = ltimeit - - return - end function walltime_interaction_check - - - module subroutine walltime_interaction_flip_loop_style(self, param, pl) - !! author: David A. Minton - !! - !! Flips the interaction loop style from FLAT to TRIANGULAR or vice versa - implicit none - ! Arguments - class(interaction_timer), intent(inout) :: self !! Interaction loop timer object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - class(swiftest_pl), intent(inout), optional :: pl !! Swiftest massive body object - - select case(trim(adjustl(self%looptype))) - case("INTERACTION") - param%lflatten_interactions = .not. param%lflatten_interactions - case("ENCOUNTER_PLPL") - param%lencounter_sas_plpl= .not. param%lencounter_sas_plpl - case("ENCOUNTER_PLTP") - param%lencounter_sas_pltp= .not. param%lencounter_sas_pltp - end select - - if (present(pl)) then - if (param%lflatten_interactions) then - call pl%flatten(param) - else - if (allocated(pl%k_plpl)) deallocate(pl%k_plpl) - end if - end if - - return - end subroutine walltime_interaction_flip_loop_style - - - module subroutine walltime_interaction_time_this_loop(self, param, ninteractions, pl) - !! author: David A. Minton - !! - !! Resets the interaction loop timer, and saves the current value of the array flatten parameter - implicit none - ! Arguments - class(interaction_timer), intent(inout) :: self !! Interaction loop timer object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - integer(I8B), intent(in) :: ninteractions !! Current number of interactions (used to normalize the timed loop) - class(swiftest_pl), intent(inout), optional :: pl !! Swiftest massive body object - ! Internals - character(len=STRMAX) :: tstr - character(len=1) :: schar - character(len=NAMELEN) :: logfile - - select case(trim(adjustl(self%looptype))) - case("INTERACTION") - write(logfile,*) INTERACTION_TIMER_LOG_OUT - case("ENCOUNTER_PLPL") - write(logfile,*) ENCOUNTER_PLPL_TIMER_LOG_OUT - case("ENCOUNTER_PLTP") - write(logfile,*) ENCOUNTER_PLTP_TIMER_LOG_OUT - case default - write(logfile,*) "unknown_looptimer.log" - end select - - self%is_on = .true. - select case(self%stage) - case(1) - self%stage1_ninteractions = ninteractions - select case(trim(adjustl(self%looptype))) - case("INTERACTION") - self%stage1_is_advanced = param%lflatten_interactions - case("ENCOUNTER_PLPL") - self%stage1_is_advanced = param%lencounter_sas_plpl - case("ENCOUNTER_PLTP") - self%stage1_is_advanced = param%lencounter_sas_pltp - end select - call io_log_one_message(logfile, trim(adjustl(self%loopname)) // ": loop timer turned on at t = " // trim(adjustl(tstr))) - case(2) - select case(trim(adjustl(self%looptype))) - case("INTERACTION") - param%lflatten_interactions = self%stage1_is_advanced - case("ENCOUNTER_PLPL") - param%lencounter_sas_plpl= self%stage1_is_advanced - case("ENCOUNTER_PLTP") - param%lencounter_sas_pltp= self%stage1_is_advanced - end select - call self%flip(param, pl) - case default - self%stage = 1 - end select - - write(schar,'(I1)') self%stage - call io_log_one_message(logfile, trim(adjustl(self%loopname)) // ": stage " // schar ) - - call self%reset() - call self%start() - - return - end subroutine walltime_interaction_time_this_loop - -end submodule s_walltime \ No newline at end of file diff --git a/src/walltime/walltime_implementations.f90 b/src/walltime/walltime_implementations.f90 new file mode 100644 index 000000000..c0804b664 --- /dev/null +++ b/src/walltime/walltime_implementations.f90 @@ -0,0 +1,143 @@ +!! Copyright 2022 - David Minton, Carlisle Wishard, Jennifer Pouplin, Jake Elliott, & Dana Singh +!! This file is part of Swiftest. +!! Swiftest is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License +!! as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. +!! Swiftest is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty +!! of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. +!! You should have received a copy of the GNU General Public License along with Swiftest. +!! If not, see: https://www.gnu.org/licenses. + +submodule(walltime) s_walltime + use swiftest +contains + + module subroutine walltime_stop(self) + !! author: David A. Minton + !! + !! Pauses the step timer (but not the main timer). + implicit none + ! Arguments + class(walltimer), intent(inout) :: self !! Walltimer object + ! Internals + integer(I8B) :: count_delta + + if (self%is_paused) then + write(*,*) "Wall timer error: Timer is already paused!" + return + end if + + call system_clock(self%count_pause) + self%is_paused = .true. + + self%count_stop_step = self%count_pause + + count_delta = self%count_stop_step - self%count_start_step + self%wall_step = count_delta / (self%count_rate * 1.0_DP) + + return + end subroutine walltime_stop + + + module subroutine walltime_report(self, message, unit, nsubsteps) + !! author: David A. Minton + !! + !! Prints the elapsed time information to the terminal + implicit none + ! Arguments + class(walltimer), intent(inout) :: self !! Walltimer object + character(len=*), intent(in) :: message !! Message to prepend to the wall time terminal output + integer(I4B), intent(in) :: unit !! Output file unit for report text to be directed + integer(I4B), optional, intent(in) :: nsubsteps !! Number of substeps used to compute the time per step + ! Internals + character(len=*), parameter :: nosubstepfmt = '" Total wall time: ", es12.5, "; Interval wall time: ", es12.5 ' + character(len=*), parameter :: substepfmt = '" Total wall time: ", es12.5, "; Interval wall time: ", es12.5, ";' //& + 'Interval wall time/step: ", es12.5' + character(len=STRMAX) :: fmt + integer(I8B) :: count_delta_step, count_delta_main, count_now + + if (.not.self%main_is_started) then + write(*,*) "Wall timer error: The step finish time cannot be calculated because the timer is not started!" + return + end if + + call system_clock(count_now) + count_delta_main = count_now - self%count_start_main + count_delta_step = count_now - self%count_start_step + self%wall_main = count_delta_main / (self%count_rate * 1.0_DP) + self%wall_step = count_delta_step / (self%count_rate * 1.0_DP) + if (present(nsubsteps)) then + self%wall_per_substep = self%wall_step / nsubsteps + fmt = '("' // adjustl(message) // '",' // substepfmt // ')' + write(unit,trim(adjustl(fmt))) self%wall_main, self%wall_step, self%wall_per_substep + else + fmt = '("' // adjustl(message) // '",' // nosubstepfmt // ')' + write(unit,trim(adjustl(fmt))) self%wall_main, self%wall_step + end if + + return + end subroutine walltime_report + + + module subroutine walltime_reset(self) + !! author: David A. Minton + !! + !! Resets the step timer + implicit none + ! Arguments + class(walltimer), intent(inout) :: self !! Walltimer object + ! Internals + + self%is_paused = .false. + self%wall_step = 0.0_DP + self%wall_per_substep = 0.0_DP + + return + end subroutine walltime_reset + + + module subroutine walltime_start_main(self) + !! author: David A. Minton + !! + !! Resets the clock ticker, settting main_start to the current ticker value + implicit none + ! Arguments + class(walltimer), intent(inout) :: self !! Walltimer object + + call system_clock(self%count_start_main, self%count_rate, self%count_max) + self%main_is_started = .true. + self%wall_main = 0.0_DP + + return + end subroutine walltime_start_main + + + module subroutine walltime_start(self) + !! author: David A. Minton + !! + !! Starts or resumes the step timer + !! + implicit none + ! Arguments + class(walltimer), intent(inout) :: self !! Walltimer object + ! Internals + integer(I8B) :: count_resume, count_delta + + if (.not.self%main_is_started) then + call self%reset() + call self%start_main() + end if + + if (self%is_paused) then ! Resume a paused step timer + call system_clock(count_resume) + count_delta = count_resume - self%count_pause + self%count_pause = 0_I8B + self%count_start_step = self%count_start_step + count_delta + self%is_paused = .false. + else ! Start a new step timer + call system_clock(self%count_start_step) + end if + + return + end subroutine walltime_start + +end submodule s_walltime \ No newline at end of file diff --git a/src/whm/whm_coord.f90 b/src/whm/whm_coord.f90 index 4af8b56a9..5ecfeedcc 100644 --- a/src/whm/whm_coord.f90 +++ b/src/whm/whm_coord.f90 @@ -7,7 +7,7 @@ !! You should have received a copy of the GNU General Public License along with Swiftest. !! If not, see: https://www.gnu.org/licenses. -submodule (whm_classes) s_whm_coord +submodule (whm) s_whm_coord use swiftest contains diff --git a/src/whm/whm_drift.f90 b/src/whm/whm_drift.f90 index 4efefe2b5..31d041505 100644 --- a/src/whm/whm_drift.f90 +++ b/src/whm/whm_drift.f90 @@ -7,7 +7,7 @@ !! You should have received a copy of the GNU General Public License along with Swiftest. !! If not, see: https://www.gnu.org/licenses. -submodule(whm_classes) whm_drift +submodule(whm) whm_drift use swiftest contains @@ -33,7 +33,7 @@ module subroutine whm_drift_pl(self, system, param, dt) associate(pl => self, npl => self%nbody) allocate(iflag(npl)) iflag(:) = 0 - call drift_all(pl%muj, pl%xj, pl%vj, npl, param, dt, pl%lmask, iflag) + call swiftest_drift_all(pl%muj, pl%xj, pl%vj, npl, param, dt, pl%lmask, iflag) if (any(iflag(1:npl) /= 0)) then where(iflag(1:npl) /= 0) pl%status(1:npl) = DISCARDED_DRIFTERR diff --git a/src/whm/whm_gr.f90 b/src/whm/whm_gr.f90 index 01bd6f285..dc694a168 100644 --- a/src/whm/whm_gr.f90 +++ b/src/whm/whm_gr.f90 @@ -7,7 +7,7 @@ !! You should have received a copy of the GNU General Public License along with Swiftest. !! If not, see: https://www.gnu.org/licenses. -submodule(whm_classes) s_whm_gr +submodule(whm) s_whm_gr use swiftest contains @@ -31,7 +31,7 @@ pure module subroutine whm_gr_kick_getacch_pl(self, param) if (self%nbody == 0) return associate(pl => self, npl => self%nbody, inv_c2 => param%inv_c2) - call gr_kick_getacch(pl%muj, pl%xj, pl%lmask, npl, param%inv_c2, pl%agr) + call swiftest_gr_kick_getacch(pl%muj, pl%xj, pl%lmask, npl, param%inv_c2, pl%agr) suma(:) = 0.0_DP pl%ah(:, 1) = pl%ah(:, 1) + pl%agr(:, 1) do i = 2, npl @@ -62,7 +62,7 @@ pure module subroutine whm_gr_kick_getacch_tp(self, param) if (self%nbody == 0) return associate(tp => self, ntp => self%nbody, inv_c2 => param%inv_c2) - call gr_kick_getacch(tp%mu, tp%rh, tp%lmask, ntp, param%inv_c2, tp%agr) + call swiftest_gr_kick_getacch(tp%mu, tp%rh, tp%lmask, ntp, param%inv_c2, tp%agr) tp%ah(:,1:ntp) = tp%ah(:,1:ntp) + tp%agr(:,1:ntp) end associate @@ -89,7 +89,7 @@ pure module subroutine whm_gr_p4_pl(self, system, param, dt) associate(pl => self, npl => self%nbody) if (npl == 0) return do concurrent(i = 1:npl, pl%lmask(i)) - call gr_p4_pos_kick(param, pl%xj(:, i), pl%vj(:, i), dt) + call swiftest_gr_p4_pos_kick(param, pl%xj(:, i), pl%vj(:, i), dt) end do end associate @@ -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%rh(:, i), tp%vh(:, i), dt) + call swiftest_gr_p4_pos_kick(param, tp%rh(:, i), tp%vh(:, i), dt) end do end associate diff --git a/src/whm/whm_kick.f90 b/src/whm/whm_kick.f90 index b675e4370..0b0746b87 100644 --- a/src/whm/whm_kick.f90 +++ b/src/whm/whm_kick.f90 @@ -7,7 +7,7 @@ !! You should have received a copy of the GNU General Public License along with Swiftest. !! If not, see: https://www.gnu.org/licenses. -submodule(whm_classes) s_whm_kick +submodule(whm) s_whm_kick use swiftest contains @@ -96,11 +96,11 @@ module subroutine whm_kick_getacch_tp(self, system, param, t, lbeg) end do call tp%accel_int(param, pl%Gmass(1:npl), pl%rbeg(:, 1:npl), npl) else - ah0(:) = whm_kick_getacch_ah0(pl%Gmass(1:npl), pl%xend(:, 1:npl), npl) + ah0(:) = whm_kick_getacch_ah0(pl%Gmass(1:npl), pl%rend(:, 1:npl), npl) do concurrent(i = 1:ntp, tp%lmask(i)) tp%ah(:, i) = tp%ah(:, i) + ah0(:) end do - call tp%accel_int(param, pl%Gmass(1:npl), pl%xend(:, 1:npl), npl) + call tp%accel_int(param, pl%Gmass(1:npl), pl%rend(:, 1:npl), npl) end if if (param%loblatecb) call tp%accel_obl(system) @@ -231,7 +231,7 @@ module subroutine whm_kick_vh_pl(self, system, param, t, dt, lbeg) else pl%ah(:, 1:npl) = 0.0_DP call pl%accel(system, param, t, lbeg) - call pl%set_beg_end(xend = pl%rh) + call pl%set_beg_end(rend = pl%rh) end if do concurrent(i = 1:npl, pl%lmask(i)) pl%vh(:, i) = pl%vh(:, i) + pl%ah(:, i) * dt diff --git a/src/whm/whm_setup.f90 b/src/whm/whm_setup.f90 index a9755d0d4..ae54fa9e8 100644 --- a/src/whm/whm_setup.f90 +++ b/src/whm/whm_setup.f90 @@ -7,7 +7,7 @@ !! You should have received a copy of the GNU General Public License along with Swiftest. !! If not, see: https://www.gnu.org/licenses. -submodule(whm_classes) s_whm_setup +submodule(whm) s_whm_setup use swiftest contains diff --git a/src/whm/whm_step.f90 b/src/whm/whm_step.f90 index 9f6b9bea1..f592bdf66 100644 --- a/src/whm/whm_step.f90 +++ b/src/whm/whm_step.f90 @@ -7,7 +7,7 @@ !! You should have received a copy of the GNU General Public License along with Swiftest. !! If not, see: https://www.gnu.org/licenses. -submodule(whm_classes) s_whm_step +submodule(whm) s_whm_step use swiftest contains diff --git a/src/whm/whm_util.f90 b/src/whm/whm_util.f90 index c58f5730f..f6a16a44c 100644 --- a/src/whm/whm_util.f90 +++ b/src/whm/whm_util.f90 @@ -7,7 +7,7 @@ !! You should have received a copy of the GNU General Public License along with Swiftest. !! If not, see: https://www.gnu.org/licenses. -submodule(whm_classes) s_whm_util +submodule(whm) s_whm_util use swiftest contains From cc37144ec2bd8031e269b2414af709a6bad9acbc Mon Sep 17 00:00:00 2001 From: David A Minton Date: Tue, 20 Dec 2022 18:31:15 -0500 Subject: [PATCH 466/569] More cleanup --- src/modules/swiftest.f90 | 18 ++- .../swiftest_io_netcdf.f90 | 133 +++++++++++------- src/swiftest_procedures/swiftest_kick.f90 | 72 +++++----- src/swiftest_procedures/swiftest_orbel.f90 | 4 +- src/symba/symba_kick.f90 | 6 +- 5 files changed, 142 insertions(+), 91 deletions(-) diff --git a/src/modules/swiftest.f90 b/src/modules/swiftest.f90 index 3cd04545e..bd329f0d9 100644 --- a/src/modules/swiftest.f90 +++ b/src/modules/swiftest.f90 @@ -205,7 +205,9 @@ module swiftest real(DP) :: R0 = 0.0_DP !! Initial radius of the central body real(DP) :: dR = 0.0_DP !! Change in the radius of the central body contains - procedure :: read_in => swiftest_io_read_in_cb !! Read in central body initial conditions from an ASCII file + procedure :: read_in => swiftest_io_read_in_cb !! Read in central body initial conditions from an ASCII file + procedure :: write_frame => swiftest_io_netcdf_write_frame_cb !! I/O routine for writing out a single frame of time-series data for all bodies in the system in NetCDF format + procedure :: write_info => swiftest_io_netcdf_write_info_cb !! Dump contents of particle information metadata to file end type swiftest_cb @@ -870,6 +872,13 @@ module subroutine swiftest_io_netcdf_write_frame_body(self, nc, param) class(base_parameters), intent(inout) :: param !! Current run configuration parameters end subroutine swiftest_io_netcdf_write_frame_body + module subroutine swiftest_io_netcdf_write_frame_cb(self, nc, param) + implicit none + class(swiftest_cb), intent(in) :: self !! Swiftest base object + class(base_io_netcdf_parameters), intent(inout) :: nc !! Parameters used to for writing a NetCDF dataset to file + class(base_parameters), intent(inout) :: param !! Current run configuration parameters + end subroutine swiftest_io_netcdf_write_frame_cb + module subroutine swiftest_io_netcdf_write_frame_system(self, nc, param) implicit none class(swiftest_nbody_system), intent(inout) :: self !! Swiftest system object @@ -891,6 +900,13 @@ module subroutine swiftest_io_netcdf_write_info_body(self, nc, param) class(base_parameters), intent(inout) :: param !! Current run configuration parameters end subroutine swiftest_io_netcdf_write_info_body + module subroutine swiftest_io_netcdf_write_info_cb(self, nc, param) + implicit none + class(swiftest_cb), intent(in) :: self !! Swiftest particle object + class(base_io_netcdf_parameters), intent(inout) :: nc !! Parameters used to identify a particular NetCDF dataset + class(base_parameters), intent(inout) :: param !! Current run configuration parameters + end subroutine swiftest_io_netcdf_write_info_cb + module subroutine swiftest_io_write_discard(self, param) implicit none class(swiftest_nbody_system), intent(inout) :: self !! SyMBA nbody system object diff --git a/src/swiftest_procedures/swiftest_io_netcdf.f90 b/src/swiftest_procedures/swiftest_io_netcdf.f90 index f9d48e366..f45c29639 100644 --- a/src/swiftest_procedures/swiftest_io_netcdf.f90 +++ b/src/swiftest_procedures/swiftest_io_netcdf.f90 @@ -133,7 +133,7 @@ module subroutine swiftest_io_netcdf_initialize_output(self, param) end if ! Create the file - call netcdf_check( nf90_create(nc%file_name, NF90io_netcdf4, nc%id), "swiftest_io_netcdf_initialize_output nf90_create" ) + call netcdf_check( nf90_create(nc%file_name, NF90_NETCDF4, nc%id), "swiftest_io_netcdf_initialize_output nf90_create" ) ! Dimensions call netcdf_check( nf90_def_dim(nc%id, nc%time_dimname, NF90_UNLIMITED, nc%time_dimid), "swiftest_io_netcdf_initialize_output nf90_def_dim time_dimid" ) ! Simulation time dimension @@ -788,8 +788,7 @@ module subroutine swiftest_io_netcdf_read_particle_info_system(self, nc, param, call cb%info%set_value(particle_type=CB_TYPE_NAME) ! Handle semi-interacting bodies in SyMBA - select type(pl) - class is (symba_pl) + if (param%integrator == INT_SYMBA) then select type (param) class is (swiftest_parameters) do i = 1, npl @@ -800,11 +799,11 @@ module subroutine swiftest_io_netcdf_read_particle_info_system(self, nc, param, end if end do end select - class default ! Non-SyMBA massive bodies + else ! Non-SyMBA massive bodies do i = 1, npl call pl%info(i)%set_value(particle_type=PL_TYPE_NAME) end do - end select + end if do i = 1, ntp call tp%info(i)%set_value(particle_type=TP_TYPE_NAME) end do @@ -975,7 +974,9 @@ module subroutine swiftest_io_netcdf_write_frame_body(self, nc, param) call netcdf_check( nf90_set_fill(nc%id, nf90_nofill, old_mode), "swiftest_io_netcdf_write_frame_body nf90_set_fill" ) select type(self) - class is (swiftest_body) + class is (swiftest_body) + select type (param) + class is (swiftest_parameters) associate(n => self%nbody) if (n == 0) return @@ -1044,23 +1045,7 @@ module subroutine swiftest_io_netcdf_write_frame_body(self, nc, param) end select end do end associate - class is (swiftest_cb) - idslot = self%id + 1 - call netcdf_check( nf90_put_var(nc%id, nc%id_varid, self%id, start=[idslot]), "swiftest_io_netcdf_write_frame_body nf90_put_var cb id_varid" ) - - call netcdf_check( nf90_put_var(nc%id, nc%Gmass_varid, self%Gmass, start=[idslot, tslot]), "swiftest_io_netcdf_write_frame_body nf90_put_var cb Gmass_varid" ) - if (param%lclose) call netcdf_check( nf90_put_var(nc%id, nc%radius_varid, self%radius, start=[idslot, tslot]), "swiftest_io_netcdf_write_frame_body nf90_put_var cb radius_varid" ) - call netcdf_check( nf90_put_var(nc%id, nc%j2rp2_varid, self%j2rp2, start=[tslot]), "swiftest_io_netcdf_write_frame_body nf90_put_var cb j2rp2_varid" ) - call netcdf_check( nf90_put_var(nc%id, nc%j4rp4_varid, self%j4rp4, start=[tslot]), "swiftest_io_netcdf_write_frame_body nf90_put_var cb j4rp4_varid" ) - if (param%lrotation) then - call netcdf_check( nf90_put_var(nc%id, nc%Ip_varid, self%Ip(:), start=[1, idslot, tslot], count=[NDIM,1,1]), "swiftest_io_netcdf_write_frame_body nf90_put_var cb Ip_varid" ) - call netcdf_check( nf90_put_var(nc%id, nc%rot_varid, self%rot(:), start=[1, idslot, tslot], count=[NDIM,1,1]), "swiftest_io_netcdf_write_frame_body nf90_put_var cb rot_varid" ) - end if - ! if (param%ltides) then - ! call netcdf_check( nf90_put_var(nc%id, nc%k2_varid, self%k2, start=[idslot, tslot]), "swiftest_io_netcdf_write_frame_body nf90_put_var cb k2_varid" ) - ! call netcdf_check( nf90_put_var(nc%id, nc%Q_varid, self%Q, start=[idslot, tslot]), "swiftest_io_netcdf_write_frame_body nf90_put_var cb Q_varid" ) - ! end if - + end select end select call netcdf_check( nf90_set_fill(nc%id, old_mode, old_mode), "swiftest_io_netcdf_write_frame_body nf90_set_fill old_mode" ) @@ -1068,6 +1053,42 @@ module subroutine swiftest_io_netcdf_write_frame_body(self, nc, param) end subroutine swiftest_io_netcdf_write_frame_body + module subroutine swiftest_io_netcdf_write_frame_cb(self, nc, param) + !! author: Carlisle A. Wishard, Dana Singh, and David A. Minton + !! + !! Write a frame of output of the central body + implicit none + ! Arguments + class(swiftest_cb), intent(in) :: self !! Swiftest base object + class(base_io_netcdf_parameters), intent(inout) :: nc !! Parameters used to for writing a NetCDF dataset to file + class(base_parameters), intent(inout) :: param !! Current run configuration parameters + ! Internals + integer(I4B) :: i, j, tslot, idslot, old_mode + + tslot = param%ioutput + + call self%write_info(nc, param) + + call netcdf_check( nf90_set_fill(nc%id, nf90_nofill, old_mode), "swiftest_io_netcdf_write_frame_cb nf90_set_fill" ) + + idslot = self%id + 1 + call netcdf_check( nf90_put_var(nc%id, nc%id_varid, self%id, start=[idslot]), "swiftest_io_netcdf_write_frame_cb nf90_put_var cb id_varid" ) + + call netcdf_check( nf90_put_var(nc%id, nc%Gmass_varid, self%Gmass, start=[idslot, tslot]), "swiftest_io_netcdf_write_frame_cb nf90_put_var cb Gmass_varid" ) + if (param%lclose) call netcdf_check( nf90_put_var(nc%id, nc%radius_varid, self%radius, start=[idslot, tslot]), "swiftest_io_netcdf_write_frame_cb nf90_put_var cb radius_varid" ) + call netcdf_check( nf90_put_var(nc%id, nc%j2rp2_varid, self%j2rp2, start=[tslot]), "swiftest_io_netcdf_write_frame_cb nf90_put_var cb j2rp2_varid" ) + call netcdf_check( nf90_put_var(nc%id, nc%j4rp4_varid, self%j4rp4, start=[tslot]), "swiftest_io_netcdf_write_frame_cb nf90_put_var cb j4rp4_varid" ) + if (param%lrotation) then + call netcdf_check( nf90_put_var(nc%id, nc%Ip_varid, self%Ip(:), start=[1, idslot, tslot], count=[NDIM,1,1]), "swiftest_io_netcdf_write_frame_cb nf90_put_var cb Ip_varid" ) + call netcdf_check( nf90_put_var(nc%id, nc%rot_varid, self%rot(:), start=[1, idslot, tslot], count=[NDIM,1,1]), "swiftest_io_netcdf_write_frame_cby nf90_put_var cb rot_varid" ) + end if + + call netcdf_check( nf90_set_fill(nc%id, old_mode, old_mode), "swiftest_io_netcdf_write_frame_cb nf90_set_fill old_mode" ) + + return + end subroutine swiftest_io_netcdf_write_frame_cb + + module subroutine swiftest_io_netcdf_write_frame_system(self, nc, param) !! author: The Purdue Swiftest Team - David A. Minton, Carlisle A. Wishard, Jennifer L.L. Pouplin, and Jacob R. Elliott !! @@ -1087,7 +1108,6 @@ module subroutine swiftest_io_netcdf_write_frame_system(self, nc, param) end subroutine swiftest_io_netcdf_write_frame_system - module subroutine swiftest_io_netcdf_write_hdr_system(self, nc, param) !! author: David A. Minton !! @@ -1107,10 +1127,7 @@ module subroutine swiftest_io_netcdf_write_hdr_system(self, nc, param) call netcdf_check( nf90_put_var(nc%id, nc%time_varid, self%t, start=[tslot]), "swiftest_io_netcdf_write_hdr_system nf90_put_var time_varid" ) call netcdf_check( nf90_put_var(nc%id, nc%npl_varid, self%pl%nbody, start=[tslot]), "swiftest_io_netcdf_write_hdr_system nf90_put_var npl_varid" ) call netcdf_check( nf90_put_var(nc%id, nc%ntp_varid, self%tp%nbody, start=[tslot]), "swiftest_io_netcdf_write_hdr_system nf90_put_var ntp_varid" ) - select type(pl => self%pl) - class is (symba_pl) - call netcdf_check( nf90_put_var(nc%id, nc%nplm_varid, pl%nplm, start=[tslot]), "swiftest_io_netcdf_write_hdr_system nf90_put_var nplm_varid" ) - end select + if (param%integrator == INT_SYMBA) call netcdf_check( nf90_put_var(nc%id, nc%nplm_varid, self%pl%nplm, start=[tslot]), "swiftest_io_netcdf_write_hdr_system nf90_put_var nplm_varid" ) if (param%lenergy) then call netcdf_check( nf90_put_var(nc%id, nc%KE_orb_varid, self%ke_orbit, start=[tslot]), "swiftest_io_netcdf_write_hdr_system nf90_put_var KE_orb_varid" ) @@ -1177,35 +1194,53 @@ module subroutine swiftest_io_netcdf_write_info_body(self, nc, param) end do end associate + end select + + call netcdf_check( nf90_set_fill(nc%id, old_mode, old_mode) ) + return + end subroutine swiftest_io_netcdf_write_info_body + + + module subroutine swiftest_io_netcdf_write_info_cb(self, nc, param) + !! author: Carlisle A. Wishard, Dana Singh, and David A. Minton + !! + !! Write the central body info to file + implicit none + class(swiftest_cb), intent(in) :: self !! Swiftest particle object + class(base_io_netcdf_parameters), intent(inout) :: nc !! Parameters used to identify a particular NetCDF dataset + class(base_parameters), intent(inout) :: param !! Current run configuration parameters + ! Internals + integer(I4B) :: idslot, old_mode + character(len=:), allocatable :: charstring - class is (swiftest_cb) - idslot = self%id + 1 - call netcdf_check( nf90_put_var(nc%id, nc%id_varid, self%id, start=[idslot]), "swiftest_io_netcdf_write_info_body nf90_put_var cb id_varid" ) + ! This string of spaces of length NAMELEN is used to clear out any old data left behind inside the string variables + call netcdf_check( nf90_set_fill(nc%id, nf90_nofill, old_mode), "swiftest_io_netcdf_write_info_body nf90_set_fill nf90_nofill" ) - charstring = trim(adjustl(self%info%name)) - call netcdf_check( nf90_put_var(nc%id, nc%name_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "swiftest_io_netcdf_write_info_body nf90_put_var cb name_varid" ) + idslot = self%id + 1 + call netcdf_check( nf90_put_var(nc%id, nc%id_varid, self%id, start=[idslot]), "swiftest_io_netcdf_write_info_body nf90_put_var cb id_varid" ) - charstring = trim(adjustl(self%info%particle_type)) - call netcdf_check( nf90_put_var(nc%id, nc%ptype_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "swiftest_io_netcdf_write_info_body nf90_put_var cb ptype_varid" ) + charstring = trim(adjustl(self%info%name)) + call netcdf_check( nf90_put_var(nc%id, nc%name_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "swiftest_io_netcdf_write_info_body nf90_put_var cb name_varid" ) - if (param%lclose) then - charstring = trim(adjustl(self%info%origin_type)) - call netcdf_check( nf90_put_var(nc%id, nc%origin_type_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "swiftest_io_netcdf_write_info_body nf90_put_var cb origin_type_varid" ) + charstring = trim(adjustl(self%info%particle_type)) + call netcdf_check( nf90_put_var(nc%id, nc%ptype_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "swiftest_io_netcdf_write_info_body nf90_put_var cb ptype_varid" ) - call netcdf_check( nf90_put_var(nc%id, nc%origin_time_varid, self%info%origin_time, start=[idslot]), "swiftest_io_netcdf_write_info_body nf90_put_var cb origin_time_varid" ) - call netcdf_check( nf90_put_var(nc%id, nc%origin_rh_varid, self%info%origin_rh(:), start=[1, idslot], count=[NDIM,1]), "swiftest_io_netcdf_write_info_body nf90_put_var cb origin_rh_varid" ) - call netcdf_check( nf90_put_var(nc%id, nc%origin_vh_varid, self%info%origin_vh(:), start=[1, idslot], count=[NDIM,1]), "swiftest_io_netcdf_write_info_body nf90_put_var cb origin_vh_varid" ) - - call netcdf_check( nf90_put_var(nc%id, nc%collision_id_varid, self%info%collision_id, start=[idslot]), "swiftest_io_netcdf_write_info_body nf90_put_var cb collision_id_varid" ) - call netcdf_check( nf90_put_var(nc%id, nc%discard_time_varid, self%info%discard_time, start=[idslot]), "swiftest_io_netcdf_write_info_body nf90_put_var cb discard_time_varid" ) - call netcdf_check( nf90_put_var(nc%id, nc%discard_rh_varid, self%info%discard_rh(:), start=[1, idslot], count=[NDIM,1]), "swiftest_io_netcdf_write_info_body nf90_put_var cb discard_rh_varid" ) - call netcdf_check( nf90_put_var(nc%id, nc%discard_vh_varid, self%info%discard_vh(:), start=[1, idslot], count=[NDIM,1]), "swiftest_io_netcdf_write_info_body nf90_put_var cb discard_vh_varid" ) - end if + if (param%lclose) then + charstring = trim(adjustl(self%info%origin_type)) + call netcdf_check( nf90_put_var(nc%id, nc%origin_type_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "swiftest_io_netcdf_write_info_body nf90_put_var cb origin_type_varid" ) - end select + call netcdf_check( nf90_put_var(nc%id, nc%origin_time_varid, self%info%origin_time, start=[idslot]), "swiftest_io_netcdf_write_info_body nf90_put_var cb origin_time_varid" ) + call netcdf_check( nf90_put_var(nc%id, nc%origin_rh_varid, self%info%origin_rh(:), start=[1, idslot], count=[NDIM,1]), "swiftest_io_netcdf_write_info_body nf90_put_var cb origin_rh_varid" ) + call netcdf_check( nf90_put_var(nc%id, nc%origin_vh_varid, self%info%origin_vh(:), start=[1, idslot], count=[NDIM,1]), "swiftest_io_netcdf_write_info_body nf90_put_var cb origin_vh_varid" ) + call netcdf_check( nf90_put_var(nc%id, nc%collision_id_varid, self%info%collision_id, start=[idslot]), "swiftest_io_netcdf_write_info_body nf90_put_var cb collision_id_varid" ) + call netcdf_check( nf90_put_var(nc%id, nc%discard_time_varid, self%info%discard_time, start=[idslot]), "swiftest_io_netcdf_write_info_body nf90_put_var cb discard_time_varid" ) + call netcdf_check( nf90_put_var(nc%id, nc%discard_rh_varid, self%info%discard_rh(:), start=[1, idslot], count=[NDIM,1]), "swiftest_io_netcdf_write_info_body nf90_put_var cb discard_rh_varid" ) + call netcdf_check( nf90_put_var(nc%id, nc%discard_vh_varid, self%info%discard_vh(:), start=[1, idslot], count=[NDIM,1]), "swiftest_io_netcdf_write_info_body nf90_put_var cb discard_vh_varid" ) + end if call netcdf_check( nf90_set_fill(nc%id, old_mode, old_mode) ) + return - end subroutine swiftest_io_netcdf_write_info_body + end subroutine swiftest_io_netcdf_write_info_cb end submodule s_io_netcdf diff --git a/src/swiftest_procedures/swiftest_kick.f90 b/src/swiftest_procedures/swiftest_kick.f90 index b1c9fe20a..584750098 100644 --- a/src/swiftest_procedures/swiftest_kick.f90 +++ b/src/swiftest_procedures/swiftest_kick.f90 @@ -7,7 +7,7 @@ !! You should have received a copy of the GNU General Public License along with Swiftest. !! If not, see: https://www.gnu.org/licenses. -submodule(swiftets) s_kick +submodule(swiftest) s_kick contains module subroutine swiftest_kick_getacch_int_pl(self, param) !! author: David A. Minton @@ -21,41 +21,41 @@ module subroutine swiftest_kick_getacch_int_pl(self, param) class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object class(swiftest_parameters), intent(inout) :: param !! Current swiftest run configuration parameters ! Internals - type(interaction_timer), save :: itimer + ! type(interaction_timer), save :: itimer logical, save :: lfirst = .true. - if (param%ladaptive_interactions) then - if (self%nplpl > 0) then - if (lfirst) then - write(itimer%loopname, *) "kick_getacch_int_pl" - write(itimer%looptype, *) "INTERACTION" - call itimer%time_this_loop(param, self%nplpl, self) - lfirst = .false. - else - if (itimer%io_netcdf_check(param, self%nplpl)) call itimer%time_this_loop(param, self%nplpl, self) - end if - else - param%lflatten_interactions = .false. - end if - end if - - if (param%lflatten_interactions) then - if (param%lclose) then - call 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%rh, self%Gmass, acc=self%ah) - end if - else + ! if (param%ladaptive_interactions) then + ! if (self%nplpl > 0) then + ! if (lfirst) then + ! write(itimer%loopname, *) "kick_getacch_int_pl" + ! write(itimer%looptype, *) "INTERACTION" + ! call itimer%time_this_loop(param, self%nplpl, self) + ! lfirst = .false. + ! else + ! if (itimer%io_netcdf_check(param, self%nplpl)) call itimer%time_this_loop(param, self%nplpl, self) + ! end if + ! else + ! param%lflatten_interactions = .false. + ! end if + ! end if + + ! if (param%lflatten_interactions) then + ! if (param%lclose) then + ! call swiftest_kick_getacch_int_all_flat_pl(self%nbody, self%nplpl, self%k_plpl, self%rh, self%Gmass, self%radius, self%ah) + ! else + ! call swiftest_kick_getacch_int_all_flat_pl(self%nbody, self%nplpl, self%k_plpl, self%rh, self%Gmass, acc=self%ah) + ! end if + ! else if (param%lclose) then - call kick_getacch_int_all_triangular_pl(self%nbody, self%nbody, self%rh, self%Gmass, self%radius, self%ah) + call swiftest_kick_getacch_int_all_triangular_pl(self%nbody, self%nbody, self%rh, self%Gmass, self%radius, self%ah) else - call kick_getacch_int_all_triangular_pl(self%nbody, self%nbody, self%rh, self%Gmass, acc=self%ah) + call swiftest_kick_getacch_int_all_triangular_pl(self%nbody, self%nbody, self%rh, self%Gmass, acc=self%ah) end if - end if + ! end if - if (param%ladaptive_interactions .and. self%nplpl > 0) then - if (itimer%is_on) call itimer%adapt(param, self%nplpl, self) - end if + ! if (param%ladaptive_interactions .and. self%nplpl > 0) then + ! if (itimer%is_on) call itimer%adapt(param, self%nplpl, self) + ! end if return end subroutine swiftest_kick_getacch_int_pl @@ -78,7 +78,7 @@ module subroutine swiftest_kick_getacch_int_tp(self, param, GMpl, rhp, npl) if ((self%nbody == 0) .or. (npl == 0)) return - call kick_getacch_int_all_tp(self%nbody, npl, self%rh, rhp, GMpl, self%lmask, self%ah) + call swiftest_kick_getacch_int_all_tp(self%nbody, npl, self%rh, rhp, GMpl, self%lmask, self%ah) return end subroutine swiftest_kick_getacch_int_tp @@ -124,7 +124,7 @@ module subroutine swiftest_kick_getacch_int_all_flat_pl(npl, nplpl, k_plpl, x, G zr = x(3, j) - x(3, i) rji2 = xr**2 + yr**2 + zr**2 rlim2 = (radius(i) + radius(j))**2 - if (rji2 > rlim2) call kick_getacch_int_one_pl(rji2, xr, yr, zr, Gmass(i), Gmass(j), & + if (rji2 > rlim2) call swiftest_kick_getacch_int_one_pl(rji2, xr, yr, zr, Gmass(i), Gmass(j), & ahi(1,i), ahi(2,i), ahi(3,i), ahj(1,j), ahj(2,j), ahj(3,j)) end do !$omp end parallel do @@ -141,7 +141,7 @@ module subroutine swiftest_kick_getacch_int_all_flat_pl(npl, nplpl, k_plpl, x, G yr = x(2, j) - x(2, i) zr = x(3, j) - x(3, i) rji2 = xr**2 + yr**2 + zr**2 - call kick_getacch_int_one_pl(rji2, xr, yr, zr, Gmass(i), Gmass(j), & + call swiftest_kick_getacch_int_one_pl(rji2, xr, yr, zr, Gmass(i), Gmass(j), & ahi(1,i), ahi(2,i), ahi(3,i), ahj(1,j), ahj(2,j), ahj(3,j)) end do !$omp end parallel do @@ -190,7 +190,7 @@ module subroutine swiftest_kick_getacch_int_all_triangular_pl(npl, nplm, x, Gmas zr = x(3, j) - x(3, i) rji2 = xr**2 + yr**2 + zr**2 rlim2 = (radius(i) + radius(j))**2 - if (rji2 > rlim2) call kick_getacch_int_one_pl(rji2, xr, yr, zr, Gmass(i), Gmass(j), & + if (rji2 > rlim2) call swiftest_kick_getacch_int_one_pl(rji2, xr, yr, zr, Gmass(i), Gmass(j), & ahi(1,i), ahi(2,i), ahi(3,i), ahj(1,j), ahj(2,j), ahj(3,j)) end do end do @@ -207,7 +207,7 @@ module subroutine swiftest_kick_getacch_int_all_triangular_pl(npl, nplm, x, Gmas yr = x(2, j) - x(2, i) zr = x(3, j) - x(3, i) rji2 = xr**2 + yr**2 + zr**2 - call kick_getacch_int_one_pl(rji2, xr, yr, zr, Gmass(i), Gmass(j), & + call swiftest_kick_getacch_int_one_pl(rji2, xr, yr, zr, Gmass(i), Gmass(j), & ahi(1,i), ahi(2,i), ahi(3,i), ahj(1,j), ahj(2,j), ahj(3,j)) end do end do @@ -252,7 +252,7 @@ module subroutine swiftest_kick_getacch_int_all_tp(ntp, npl, xtp, xpl, GMpl, lma yr = xtp(2, i) - xpl(2, j) zr = xtp(3, i) - xpl(3, j) rji2 = xr**2 + yr**2 + zr**2 - call kick_getacch_int_one_tp(rji2, xr, yr, zr, GMpl(j), acc(1,i), acc(2,i), acc(3,i)) + call swiftest_kick_getacch_int_one_tp(rji2, xr, yr, zr, GMpl(j), acc(1,i), acc(2,i), acc(3,i)) end do end if end do diff --git a/src/swiftest_procedures/swiftest_orbel.f90 b/src/swiftest_procedures/swiftest_orbel.f90 index c731c23a4..097034111 100644 --- a/src/swiftest_procedures/swiftest_orbel.f90 +++ b/src/swiftest_procedures/swiftest_orbel.f90 @@ -275,7 +275,7 @@ real(DP) pure function swiftest_orbel_flon(e,icapn) ! normal return here, but check if capn was originally negative if(iflag == 1) then - swiftest_orbel_flon = -orbel_flon + swiftest_orbel_flon = -swiftest_orbel_flon capn = -capn end if @@ -398,7 +398,7 @@ real(DP) pure function swiftest_orbel_zget(iq) end if if(iflag == 1) then - swiftest_orbel_zget = -orbel_zget + swiftest_orbel_zget = -swiftest_orbel_zget q = -q end if diff --git a/src/symba/symba_kick.f90 b/src/symba/symba_kick.f90 index 5fbe3d8f6..03b72c143 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%rh, self%Gmass, self%radius, self%ah) + call swiftest_kick_getacch_int_all_flat_pl(self%nbody, self%nplplm, self%k_plpl, self%rh, self%Gmass, self%radius, self%ah) else - call kick_getacch_int_all_triangular_pl(self%nbody, self%nplm, self%rh, self%Gmass, self%radius, self%ah) + call swiftest_kick_getacch_int_all_triangular_pl(self%nbody, self%nplm, self%rh, self%Gmass, self%radius, self%ah) end if if (param%ladaptive_interactions .and. self%nplplm > 0) then @@ -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) = plpl_encounter%index1(1:nplplenc) k_plpl_enc(2,1:nplplenc) = plpl_encounter%index2(1:nplplenc) - call kick_getacch_int_all_flat_pl(npl, nplplenc, k_plpl_enc, pl%rh, pl%Gmass, pl%radius, ah_enc) + call swiftest_kick_getacch_int_all_flat_pl(npl, nplplenc, k_plpl_enc, pl%rh, pl%Gmass, pl%radius, ah_enc) pl%ah(:,1:npl) = pl%ah(:,1:npl) - ah_enc(:,1:npl) end if From a26e61573b0c9af435dd6b6fbba04cc154c07c16 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Tue, 20 Dec 2022 23:28:54 -0500 Subject: [PATCH 467/569] More cleanup --- src/collision/collision_io.f90 | 2 +- src/collision/collision_resolve.f90 | 2 +- src/collision/collision_util.f90 | 5 +- src/encounter/encounter_check.f90 | 30 +- src/encounter/encounter_io.f90 | 2 +- src/encounter/encounter_setup.f90 | 2 + src/encounter/encounter_util.f90 | 60 +- src/fraggle/fraggle_generate.f90 | 9 +- src/main/swiftest_driver.f90 | 2 +- src/modules/base.f90 | 2 +- src/modules/collision.f90 | 1 + src/modules/encounter.f90 | 3 +- src/modules/swiftest.f90 | 34 +- src/modules/symba.f90 | 103 ++- src/rmvs/rmvs_step.f90 | 8 +- src/rmvs/rmvs_util.f90 | 120 ++-- src/swiftest_procedures/swiftest_io.f90 | 34 +- .../swiftest_io_netcdf.f90 | 12 +- src/swiftest_procedures/swiftest_setup.f90 | 2 +- src/swiftest_procedures/swiftest_util.f90 | 660 +++++++++--------- src/symba/symba_discard.f90 | 35 +- src/symba/symba_encounter_check.f90 | 193 ++--- src/symba/symba_kick.f90 | 332 +++++---- src/symba/symba_setup.f90 | 25 - src/symba/symba_step.f90 | 2 +- src/symba/symba_util.f90 | 402 ++++------- src/tides/tides_spin_step.f90 | 2 +- src/whm/whm_drift.f90 | 2 +- src/whm/whm_setup.f90 | 4 +- src/whm/whm_util.f90 | 78 +-- 30 files changed, 1048 insertions(+), 1120 deletions(-) diff --git a/src/collision/collision_io.f90 b/src/collision/collision_io.f90 index 2c5abd7b9..864fa93f9 100644 --- a/src/collision/collision_io.f90 +++ b/src/collision/collision_io.f90 @@ -191,7 +191,7 @@ module subroutine collision_io_initialize_output(self, param) 667 continue write(*,*) "Error creating fragmentation output file. " // trim(adjustl(errmsg)) - call util_exit(FAILURE) + call swiftest_util_exit(FAILURE) end subroutine collision_io_initialize_output diff --git a/src/collision/collision_resolve.f90 b/src/collision/collision_resolve.f90 index 4ac8bdf16..f08a056ac 100644 --- a/src/collision/collision_resolve.f90 +++ b/src/collision/collision_resolve.f90 @@ -635,7 +635,7 @@ subroutine collision_resolve_list(plpl_collision , system, param, t) plpl_collision%status(i) = collision_resolve_merge(system, param, t) case default write(*,*) "Error in swiftest_collision, unrecognized collision regime" - call util_exit(FAILURE) + call swiftest_util_exit(FAILURE) end select call collision_history%take_snapshot(param,system, t, "after") call impactors%reset() diff --git a/src/collision/collision_util.f90 b/src/collision/collision_util.f90 index 0690adf60..02eaafdd3 100644 --- a/src/collision/collision_util.f90 +++ b/src/collision/collision_util.f90 @@ -291,7 +291,7 @@ module subroutine collision_util_get_energy_momentum(self, system, param, lbefo if (.not.allocated(tmpsys)) then write(*,*) "Error in collision_util_get_energy_momentum. " // & " This must be called with lbefore=.true. at least once before calling it with lbefore=.false." - call util_exit(FAILURE) + call swiftest_util_exit(FAILURE) end if select type(tmpsys) class is (swiftest_nbody_system) @@ -345,7 +345,7 @@ module subroutine collision_util_index_map(self) call self%get_index_values(idvals, tvals) ! Consolidate ids to only unique values - call util_unique(idvals,self%idvals,self%idmap) + call swiftest_util_unique(idvals,self%idvals,self%idmap) self%nid = size(self%idvals) ! Don't consolidate time values (multiple collisions can happen in a single time step) @@ -502,6 +502,7 @@ module subroutine collision_util_set_coordinate_system(self) return end subroutine collision_util_set_coordinate_system + subroutine collision_util_save_snapshot(collision_history, snapshot) !! author: David A. Minton !! diff --git a/src/encounter/encounter_check.f90 b/src/encounter/encounter_check.f90 index f3a5a3f8d..9aad9cfdb 100644 --- a/src/encounter/encounter_check.f90 +++ b/src/encounter/encounter_check.f90 @@ -168,10 +168,10 @@ module subroutine encounter_check_all_plplm(param, nplm, nplt, xplm, vplm, xplt, call move_alloc(ltmp, lvdotr) nenc = nenc + plmplt_nenc - call util_sort(index1, ind) - call util_sort_rearrange(index1, ind, nenc) - call util_sort_rearrange(index2, ind, nenc) - call util_sort_rearrange(lvdotr, ind, nenc) + call swiftest_util_sort(index1, ind) + call swiftest_util_sort_rearrange(index1, ind, nenc) + call swiftest_util_sort_rearrange(index2, ind, nenc) + call swiftest_util_sort_rearrange(lvdotr, ind, nenc) end if @@ -565,7 +565,7 @@ subroutine encounter_check_all_triangular_plpl(npl, x, v, renc, dt, nenc, index1 integer(I4B), dimension(:), allocatable, save :: ind_arr type(collision_list_plpl), dimension(npl) :: lenc - call util_index_array(ind_arr, npl) + call swiftest_util_index_array(ind_arr, npl) !$omp parallel do default(private) schedule(static)& !$omp shared(x, v, renc, lenc, ind_arr) & @@ -612,7 +612,7 @@ subroutine encounter_check_all_triangular_plplm(nplm, nplt, xplm, vplm, xplt, vp integer(I4B), dimension(:), allocatable, save :: ind_arr type(collision_list_plpl), dimension(nplm) :: lenc - call util_index_array(ind_arr, nplt) + call swiftest_util_index_array(ind_arr, nplt) !$omp parallel do default(private) schedule(dynamic)& !$omp shared(xplm, vplm, xplt, vplt, rencm, renct, lenc, ind_arr) & @@ -659,7 +659,7 @@ subroutine encounter_check_all_triangular_pltp(npl, ntp, xpl, vpl, xtp, vtp, ren type(collision_list_pltp), dimension(npl) :: lenc real(DP), dimension(ntp) :: renct - call util_index_array(ind_arr, ntp) + call swiftest_util_index_array(ind_arr, ntp) renct(:) = 0.0_DP !$omp parallel do default(private) schedule(dynamic)& @@ -807,10 +807,10 @@ subroutine encounter_check_remove_duplicates(n, nenc, index1, index2, lvdotr) return end if - call util_sort(index1, ind) - call util_sort_rearrange(index1, ind, nenc) - call util_sort_rearrange(index2, ind, nenc) - call util_sort_rearrange(lvdotr, ind, nenc) + call swiftest_util_sort(index1, ind) + call swiftest_util_sort_rearrange(index1, ind, nenc) + call swiftest_util_sort_rearrange(index2, ind, nenc) + call swiftest_util_sort_rearrange(lvdotr, ind, nenc) ! Get the bounds on the bodies in the first index ibeg(:) = n @@ -836,7 +836,7 @@ subroutine encounter_check_remove_duplicates(n, nenc, index1, index2, lvdotr) khi = iend(i) nenci = khi - klo + 1_I8B if (allocated(ind)) deallocate(ind) - call util_sort(index2(klo:khi), ind) + call swiftest_util_sort(index2(klo:khi), ind) index2(klo:khi) = itmp(klo - 1_I8B + ind(:)) do j = klo + 1_I8B, khi if (index2(j) == index2(j - 1_I8B)) lencounter(j) = .false. @@ -876,7 +876,7 @@ pure module subroutine encounter_check_sort_aabb_1D(self, n, extent_arr) ! Internals integer(I8B) :: i, k - call util_sort(extent_arr, self%ind) + call swiftest_util_sort(extent_arr, self%ind) do concurrent(k = 1_I8B:2_I8B * n) i = self%ind(k) @@ -923,7 +923,7 @@ module subroutine encounter_check_sweep_aabb_double_list(self, n1, n2, r1, v1, r real(DP), dimension(2*(n1+n2)) :: xind, yind, zind, vxind, vyind, vzind, rencind ntot = n1 + n2 - call util_index_array(ind_arr, ntot) + call swiftest_util_index_array(ind_arr, ntot) do concurrent(dim = 1:SWEEPDIM) loverlap_by_dimension(dim,:) = (self%aabb(dim)%ibeg(:) + 1_I8B) < (self%aabb(dim)%iend(:) - 1_I8B) @@ -1035,7 +1035,7 @@ module subroutine encounter_check_sweep_aabb_single_list(self, n, x, v, renc, dt integer(I4B), dimension(:), allocatable, save :: ind_arr integer(I8B) :: ibeg, iend - call util_index_array(ind_arr, n) + call swiftest_util_index_array(ind_arr, n) dim = 1 ! Sweep the intervals for each of the massive bodies along one dimension diff --git a/src/encounter/encounter_io.f90 b/src/encounter/encounter_io.f90 index b92b9a2fd..df82d567e 100644 --- a/src/encounter/encounter_io.f90 +++ b/src/encounter/encounter_io.f90 @@ -146,7 +146,7 @@ module subroutine encounter_io_initialize_output(self, param) 667 continue write(*,*) "Error creating encounter output file. " // trim(adjustl(errmsg)) - call util_exit(FAILURE) + call swiftest_util_exit(FAILURE) end subroutine encounter_io_initialize_output diff --git a/src/encounter/encounter_setup.f90 b/src/encounter/encounter_setup.f90 index aff1bd626..3cf165129 100644 --- a/src/encounter/encounter_setup.f90 +++ b/src/encounter/encounter_setup.f90 @@ -84,6 +84,7 @@ module subroutine encounter_setup_list(self, n) allocate(self%r2(NDIM,n)) allocate(self%v1(NDIM,n)) allocate(self%v2(NDIM,n)) + allocate(self%level(n)) self%tcollision(:) = 0.0_DP self%lvdotr(:) = .false. @@ -97,6 +98,7 @@ module subroutine encounter_setup_list(self, n) self%r2(:,:) = 0.0_DP self%v1(:,:) = 0.0_DP self%v2(:,:) = 0.0_DP + self%level(:) = 0 return end subroutine encounter_setup_list diff --git a/src/encounter/encounter_util.f90 b/src/encounter/encounter_util.f90 index 8dc63201e..b124c5fbf 100644 --- a/src/encounter/encounter_util.f90 +++ b/src/encounter/encounter_util.f90 @@ -26,17 +26,19 @@ module subroutine encounter_util_append_list(self, source, lsource_mask) nold = self%nenc nsrc = source%nenc - call util_append(self%lvdotr, source%lvdotr, nold, nsrc, lsource_mask) - call util_append(self%lclosest, source%lclosest, nold, nsrc, lsource_mask) - call util_append(self%status, source%status, nold, nsrc, lsource_mask) - call util_append(self%index1, source%index1, nold, nsrc, lsource_mask) - call util_append(self%index2, source%index2, nold, nsrc, lsource_mask) - call util_append(self%id1, source%id1, nold, nsrc, lsource_mask) - call util_append(self%id2, source%id2, nold, nsrc, lsource_mask) - call util_append(self%r1, source%r1, nold, nsrc, lsource_mask) - call util_append(self%r2, source%r2, 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 swiftest_util_append(self%tcollision, source%tcollision, nold, nsrc, lsource_mask) + call swiftest_util_append(self%lclosest, source%lclosest, nold, nsrc, lsource_mask) + call swiftest_util_append(self%lvdotr, source%lvdotr, nold, nsrc, lsource_mask) + call swiftest_util_append(self%status, source%status, nold, nsrc, lsource_mask) + call swiftest_util_append(self%index1, source%index1, nold, nsrc, lsource_mask) + call swiftest_util_append(self%index2, source%index2, nold, nsrc, lsource_mask) + call swiftest_util_append(self%id1, source%id1, nold, nsrc, lsource_mask) + call swiftest_util_append(self%id2, source%id2, nold, nsrc, lsource_mask) + call swiftest_util_append(self%r1, source%r1, nold, nsrc, lsource_mask) + call swiftest_util_append(self%r2, source%r2, nold, nsrc, lsource_mask) + call swiftest_util_append(self%v1, source%v1, nold, nsrc, lsource_mask) + call swiftest_util_append(self%v2, source%v2, nold, nsrc, lsource_mask) + call swiftest_util_append(self%level, source%level, nold, nsrc, lsource_mask) self%nenc = nold + count(lsource_mask(1:nsrc)) return @@ -55,8 +57,10 @@ 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%lcollision = source%lcollision + self%tcollision(1:n) = source%tcollision(1:n) self%lclosest(1:n) = source%lclosest(1:n) + self%lvdotr(1:n) = source%lvdotr(1:n) self%status(1:n) = source%status(1:n) self%index1(1:n) = source%index1(1:n) self%index2(1:n) = source%index2(1:n) @@ -66,6 +70,7 @@ module subroutine encounter_util_copy_list(self, source) self%r2(:,1:n) = source%r2(:,1:n) self%v1(:,1:n) = source%v1(:,1:n) self%v2(:,1:n) = source%v2(:,1:n) + self%level(1:n) = source%level(1:n) end associate return @@ -97,8 +102,8 @@ module subroutine encounter_util_dealloc_list(self) class(encounter_list), intent(inout) :: self if (allocated(self%tcollision)) deallocate(self%tcollision) - if (allocated(self%lvdotr)) deallocate(self%lvdotr) if (allocated(self%lclosest)) deallocate(self%lclosest) + if (allocated(self%lvdotr)) deallocate(self%lvdotr) if (allocated(self%status)) deallocate(self%status) if (allocated(self%index1)) deallocate(self%index1) if (allocated(self%index2)) deallocate(self%index2) @@ -108,6 +113,7 @@ module subroutine encounter_util_dealloc_list(self) if (allocated(self%r2)) deallocate(self%r2) if (allocated(self%v1)) deallocate(self%v1) if (allocated(self%v2)) deallocate(self%v2) + if (allocated(self%level)) deallocate(self%level) return end subroutine encounter_util_dealloc_list @@ -276,11 +282,11 @@ module subroutine encounter_util_index_map(self) call encounter_util_get_vals_storage(self, idvals, tvals) ! Consolidate ids to only unique values - call util_unique(idvals,self%idvals,self%idmap) + call swiftest_util_unique(idvals,self%idvals,self%idmap) self%nid = size(self%idvals) ! Consolidate time values to only unique values - call util_unique(tvals,self%tvals,self%tmap) + call swiftest_util_unique(tvals,self%tvals,self%tmap) self%nt = size(self%tvals) return @@ -339,17 +345,19 @@ module subroutine encounter_util_spill_list(self, discards, lspill_list, ldestru integer(I8B) :: nenc_old associate(keeps => self) - call util_spill(keeps%lvdotr, discards%lvdotr, lspill_list, ldestructive) - call util_spill(keeps%lclosest, discards%lclosest, lspill_list, ldestructive) - call util_spill(keeps%status, discards%status, lspill_list, ldestructive) - call util_spill(keeps%index1, discards%index1, lspill_list, ldestructive) - call util_spill(keeps%index2, discards%index2, lspill_list, ldestructive) - call util_spill(keeps%id1, discards%id1, lspill_list, ldestructive) - call util_spill(keeps%id2, discards%id2, lspill_list, ldestructive) - call util_spill(keeps%r1, discards%r1, lspill_list, ldestructive) - call util_spill(keeps%r2, discards%r2, lspill_list, ldestructive) - call util_spill(keeps%v1, discards%v1, lspill_list, ldestructive) - call util_spill(keeps%v2, discards%v2, lspill_list, ldestructive) + call swiftest_util_spill(keeps%tcollision, discards%tcollision, lspill_list, ldestructive) + call swiftest_util_spill(keeps%lvdotr, discards%lvdotr, lspill_list, ldestructive) + call swiftest_util_spill(keeps%lclosest, discards%lclosest, lspill_list, ldestructive) + call swiftest_util_spill(keeps%status, discards%status, lspill_list, ldestructive) + call swiftest_util_spill(keeps%index1, discards%index1, lspill_list, ldestructive) + call swiftest_util_spill(keeps%index2, discards%index2, lspill_list, ldestructive) + call swiftest_util_spill(keeps%id1, discards%id1, lspill_list, ldestructive) + call swiftest_util_spill(keeps%id2, discards%id2, lspill_list, ldestructive) + call swiftest_util_spill(keeps%r1, discards%r1, lspill_list, ldestructive) + call swiftest_util_spill(keeps%r2, discards%r2, lspill_list, ldestructive) + call swiftest_util_spill(keeps%v1, discards%v1, lspill_list, ldestructive) + call swiftest_util_spill(keeps%v2, discards%v2, lspill_list, ldestructive) + call swiftest_util_spill(keeps%level, discards%level, lspill_list, ldestructive) nenc_old = keeps%nenc diff --git a/src/fraggle/fraggle_generate.f90 b/src/fraggle/fraggle_generate.f90 index 5f9eccee8..59397a808 100644 --- a/src/fraggle/fraggle_generate.f90 +++ b/src/fraggle/fraggle_generate.f90 @@ -401,7 +401,7 @@ subroutine fraggle_generate_tan_vel(collision_system, lfailure) tol = TOL_INIT do while(tol < TOL_MIN) - call util_minimize_bfgs(objective_function, nfrag-6, v_t_initial(7:nfrag), tol, MAXLOOP, lfailure, v_t_output) + call swiftest_util_minimize_bfgs(objective_function, nfrag-6, v_t_initial(7:nfrag), tol, MAXLOOP, lfailure, v_t_output) fragments%v_t_mag(7:nfrag) = v_t_output(:) ! Now that the KE-minimized values of the i>6 fragments are found, calculate the momentum-conserving solution for tangential velociteis v_t_initial(7:nfrag) = fragments%v_t_mag(7:nfrag) @@ -495,7 +495,7 @@ function solve_fragment_tan_vel(lfailure, v_t_mag_input) result(v_t_mag_output) b(1:3) = -L_lin_others(:) b(4:6) = fragments%L_budget(:) - fragments%Lspin(:) - L_orb_others(:) allocate(v_t_mag_output(nfrag)) - v_t_mag_output(1:6) = util_solve_linear_system(A, b, 6, lfailure) + v_t_mag_output(1:6) = swiftest_util_solve_linear_system(A, b, 6, lfailure) if (present(v_t_mag_input)) v_t_mag_output(7:nfrag) = v_t_mag_input(:) end associate end select @@ -559,7 +559,7 @@ subroutine fraggle_generate_rad_vel(collision_system, lfailure) integer(I4B), parameter :: MAXLOOP = 100 real(DP) :: ke_radial, tol integer(I4B) :: i - real(DP), dimension(:), allocatable :: v_r_initial + real(DP), dimension(:), allocatable :: v_r_initial, v_r_output real(DP), dimension(collision_system%fragments%nbody) :: vnoise type(lambda_obj) :: objective_function character(len=STRMAX) :: message @@ -584,7 +584,8 @@ subroutine fraggle_generate_rad_vel(collision_system, lfailure) objective_function = lambda_obj(radial_objective_function) tol = TOL_INIT do while(tol < TOL_MIN) - call util_minimize_bfgs(objective_function, nfrag, v_r_initial, tol, MAXLOOP, lfailure, fragments%v_r_mag) + call swiftest_util_minimize_bfgs(objective_function, nfrag, v_r_initial, tol, MAXLOOP, lfailure, v_r_output) + fragments%v_r_mag(1:nfrag) = v_r_output(1:nfrag) if (.not.lfailure) exit tol = tol * 2 ! Keep increasing the tolerance until we converge on a solution v_r_initial(:) = fragments%v_r_mag(:) diff --git a/src/main/swiftest_driver.f90 b/src/main/swiftest_driver.f90 index b7a0b330b..2b2229a3a 100644 --- a/src/main/swiftest_driver.f90 +++ b/src/main/swiftest_driver.f90 @@ -170,5 +170,5 @@ program swiftest_driver end associate end associate - call util_exit(SUCCESS) + call swiftest_util_exit(SUCCESS) end program swiftest_driver diff --git a/src/modules/base.f90 b/src/modules/base.f90 index 83e26eef6..ea28a5e18 100644 --- a/src/modules/base.f90 +++ b/src/modules/base.f90 @@ -387,7 +387,7 @@ subroutine netcdf_check(status, call_identifier) if(status /= nf90_noerr) then if (present(call_identifier)) write(*,*) "NetCDF error in ",trim(call_identifier) write(*,*) trim(nf90_strerror(status)) - call util_exit(FAILURE) + call swiftest_util_exit(FAILURE) end if return diff --git a/src/modules/collision.f90 b/src/modules/collision.f90 index bee281fd3..a4e6cd9bb 100644 --- a/src/modules/collision.f90 +++ b/src/modules/collision.f90 @@ -7,6 +7,7 @@ !! You should have received a copy of the GNU General Public License along with Swiftest. !! If not, see: https://www.gnu.org/licenses. + module collision !! author: The Purdue Swiftest Team - David A. Minton, Carlisle A. Wishard, Jennifer L.L. Pouplin, and Jacob R. Elliott !! diff --git a/src/modules/encounter.f90 b/src/modules/encounter.f90 index d47fca9ee..04e7170c6 100644 --- a/src/modules/encounter.f90 +++ b/src/modules/encounter.f90 @@ -22,7 +22,7 @@ module encounter integer(I8B) :: nenc = 0 !! Total number of encounters real(DP) :: t !! Time of encounter logical :: lcollision !! Indicates if the encounter resulted in at least one collision - real(DP), dimension(:), allocatable :: tcollision!! Time of collision + real(DP), dimension(:), allocatable :: tcollision !! Time of collision logical, dimension(:), allocatable :: lclosest !! indicates that thie pair of bodies is in currently at its closest approach point logical, dimension(:), allocatable :: lvdotr !! relative vdotr flag integer(I4B), dimension(:), allocatable :: status !! status of the interaction @@ -34,6 +34,7 @@ module encounter real(DP), dimension(:,:), allocatable :: r2 !! the position of body 2 in the encounter real(DP), dimension(:,:), allocatable :: v1 !! the velocity of body 1 in the encounter real(DP), dimension(:,:), allocatable :: v2 !! the velocity of body 2 in the encounter + integer(I4B), dimension(:), allocatable :: level !! Recursion level (used in SyMBA) contains procedure :: setup => encounter_setup_list !! A constructor that sets the number of encounters and allocates and initializes all arrays procedure :: append => encounter_util_append_list !! Appends elements from one structure to another diff --git a/src/modules/swiftest.f90 b/src/modules/swiftest.f90 index bd329f0d9..01afd9134 100644 --- a/src/modules/swiftest.f90 +++ b/src/modules/swiftest.f90 @@ -1060,7 +1060,7 @@ module subroutine swiftest_user_kick_getacch_body(self, system, param, t, lbeg) end subroutine swiftest_user_kick_getacch_body end interface - interface util_append + interface swiftest_util_append module subroutine swiftest_util_append_arr_char_string(arr, source, nold, nsrc, lsource_mask) implicit none character(len=STRMAX), dimension(:), allocatable, intent(inout) :: arr !! Destination array @@ -1272,7 +1272,7 @@ module subroutine swiftest_util_fill_tp(self, inserts, lfill_list) end subroutine swiftest_util_fill_tp end interface - interface util_fill + interface swiftest_util_fill module subroutine swiftest_util_fill_arr_char_string(keeps, inserts, lfill_list) implicit none character(len=STRMAX), dimension(:), allocatable, intent(inout) :: keeps !! Array of values to keep @@ -1430,7 +1430,7 @@ end subroutine swiftest_util_reset_storage end interface - interface util_resize + interface swiftest_util_resize module subroutine swiftest_util_resize_arr_char_string(arr, nnew) implicit none character(len=STRMAX), dimension(:), allocatable, intent(inout) :: arr !! Array to resize @@ -1588,28 +1588,28 @@ end subroutine swiftest_util_snapshot_system end interface - interface util_solve_linear_system - module function util_solve_linear_system_d(A,b,n,lerr) result(x) + interface swiftest_util_solve_linear_system + module function swiftest_util_solve_linear_system_d(A,b,n,lerr) result(x) implicit none integer(I4B), intent(in) :: n real(DP), dimension(:,:), intent(in) :: A real(DP), dimension(:), intent(in) :: b logical, intent(out) :: lerr real(DP), dimension(n) :: x - end function util_solve_linear_system_d + end function swiftest_util_solve_linear_system_d - module function util_solve_linear_system_q(A,b,n,lerr) result(x) + module function swiftest_util_solve_linear_system_q(A,b,n,lerr) result(x) implicit none integer(I4B), intent(in) :: n real(QP), dimension(:,:), intent(in) :: A real(QP), dimension(:), intent(in) :: b logical, intent(out) :: lerr real(QP), dimension(n) :: x - end function util_solve_linear_system_q + end function swiftest_util_solve_linear_system_q end interface interface - module function util_solve_rkf45(f, y0in, t1, dt0, tol) result(y1) + module function swiftest_util_solve_rkf45(f, y0in, t1, dt0, tol) result(y1) use lambda_function implicit none class(lambda_obj), intent(inout) :: f !! lambda function object that has been initialized to be a function of derivatives. The object will return with components lastarg and lasteval set @@ -1618,10 +1618,10 @@ module function util_solve_rkf45(f, y0in, t1, dt0, tol) result(y1) real(DP), intent(in) :: dt0 !! Initial step size guess real(DP), intent(in) :: tol !! Tolerance on solution real(DP), dimension(:), allocatable :: y1 !! Final result - end function util_solve_rkf45 + end function swiftest_util_solve_rkf45 end interface - interface util_sort + interface swiftest_util_sort pure module subroutine swiftest_util_sort_i4b(arr) implicit none integer(I4B), dimension(:), intent(inout) :: arr @@ -1666,9 +1666,9 @@ pure module subroutine swiftest_util_sort_index_dp(arr,ind) real(DP), dimension(:), intent(in) :: arr integer(I4B), dimension(:), allocatable, intent(inout) :: ind end subroutine swiftest_util_sort_index_dp - end interface util_sort + end interface swiftest_util_sort - interface util_sort_rearrange + interface swiftest_util_sort_rearrange pure module subroutine swiftest_util_sort_rearrange_arr_char_string(arr, ind, n) implicit none character(len=STRMAX), dimension(:), allocatable, intent(inout) :: arr !! Destination array @@ -1731,7 +1731,7 @@ pure module subroutine swiftest_util_sort_rearrange_arr_logical_I8Bind(arr, ind, integer(I8B), dimension(:), intent(in) :: ind !! Index to rearrange against integer(I8B), intent(in) :: n !! Number of elements in arr and ind to rearrange end subroutine swiftest_util_sort_rearrange_arr_logical_I8Bind - end interface util_sort_rearrange + end interface swiftest_util_sort_rearrange interface module subroutine swiftest_util_sort_rearrange_body(self, ind) @@ -1775,7 +1775,7 @@ end subroutine swiftest_util_sort_tp end interface - interface util_spill + interface swiftest_util_spill module subroutine swiftest_util_spill_arr_char_string(keeps, discards, lspill_list, ldestructive) implicit none character(len=STRMAX), dimension(:), allocatable, intent(inout) :: keeps !! Array of values to keep @@ -1868,7 +1868,7 @@ end subroutine swiftest_util_spill_tp end interface - interface util_unique + interface swiftest_util_unique module subroutine swiftest_util_unique_DP(input_array, output_array, index_map) implicit none real(DP), dimension(:), intent(in) :: input_array !! Unsorted input array @@ -1882,7 +1882,7 @@ module subroutine swiftest_util_unique_I4B(input_array, output_array, index_map) integer(I4B), dimension(:), allocatable, intent(out) :: output_array !! Sorted array of unique values integer(I4B), dimension(:), allocatable, intent(out) :: index_map !! An array of the same size as input_array that such that any for any index i, output_array(index_map(i)) = input_array(i) end subroutine swiftest_util_unique_I4B - end interface util_unique + end interface swiftest_util_unique interface module subroutine swiftest_util_valid_id_system(self, param) diff --git a/src/modules/symba.f90 b/src/modules/symba.f90 index 419a2b711..87359501c 100644 --- a/src/modules/symba.f90 +++ b/src/modules/symba.f90 @@ -76,18 +76,21 @@ module symba !> SyMBA class for tracking close encounters in a step - type, extends(encounter_list) :: symba_encounter - integer(I4B), dimension(:), allocatable :: level !! encounter recursion level + type, extends(collision_list_plpl) :: symba_list_plpl contains - procedure :: encounter_check => symba_encounter_check !! Checks if massive bodies are going through close encounters with each other - procedure :: kick => symba_kick_encounter !! Kick barycentric velocities of active test particles within SyMBA recursion - procedure :: setup => symba_setup_encounter_list !! A constructor that sets the number of encounters and allocates and initializes all arrays - procedure :: copy => symba_util_copy_encounter_list !! Copies elements from the source encounter list into self. - procedure :: dealloc => symba_util_dealloc_encounter_list !! Deallocates all allocatable arrays - procedure :: spill => symba_util_spill_encounter_list !! "Spills" bodies from one object to another depending on the results of a mask (uses the PACK intrinsic) - procedure :: append => symba_util_append_encounter_list !! Appends elements from one structure to another - final :: symba_util_final_encounter_list !! Finalizes the SyMBA test particle object - deallocates all allocatables - end type symba_encounter + procedure :: encounter_check => symba_encounter_check_list_plpl !! Checks if massive bodies are going through close encounters with each other + procedure :: kick => symba_kick_list_plpl !! Kick barycentric velocities of active massive bodies within SyMBA recursion + final :: symba_util_final_list_plpl !! Finalizes the SyMBA test particle object - deallocates all allocatables + end type symba_list_plpl + + + !> SyMBA class for tracking close encounters in a step + type, extends(collision_list_pltp) :: symba_list_pltp + contains + procedure :: encounter_check => symba_encounter_check_list_pltp !! Checks if massive bodies are going through close encounters with test particles + procedure :: kick => symba_kick_list_pltp !! Kick barycentric velocities of active test particles within SyMBA recursion + final :: symba_util_final_list_pltp !! Finalizes the SyMBA test particle object - deallocates all allocatables + end type symba_list_pltp type, extends(helio_nbody_system) :: symba_nbody_system @@ -102,7 +105,6 @@ module symba final :: symba_util_final_system !! Finalizes the SyMBA nbody system object - deallocates all allocatables end type symba_nbody_system - interface module subroutine symba_discard_pl(self, system, param) implicit none @@ -137,15 +139,25 @@ module function symba_encounter_check_pl(self, param, system, dt, irec) result(l logical :: lany_encounter !! Returns true if there is at least one close encounter end function symba_encounter_check_pl - module function symba_encounter_check(self, param, system, dt, irec) result(lany_encounter) + module function symba_encounter_check_list_plpl(self, param, system, dt, irec) result(lany_encounter) + implicit none + class(symba_list_plpl), intent(inout) :: self !! SyMBA pl-pl encounter list object + class(swiftest_parameters), intent(inout) :: param !! Current swiftest run configuration parameters + class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object + real(DP), intent(in) :: dt !! step size + integer(I4B), intent(in) :: irec !! Current recursion level + logical :: lany_encounter !! Returns true if there is at least one close encounter + end function symba_encounter_check_list_plpl + + module function symba_encounter_check_list_pltp(self, param, system, dt, irec) result(lany_encounter) implicit none - class(symba_encounter), intent(inout) :: self !! SyMBA pl-pl encounter list object + class(symba_list_pltp), intent(inout) :: self !! SyMBA pl-tp encounter list object class(swiftest_parameters), intent(inout) :: param !! Current swiftest run configuration parameters class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object real(DP), intent(in) :: dt !! step size integer(I4B), intent(in) :: irec !! Current recursion level logical :: lany_encounter !! Returns true if there is at least one close encounter - end function symba_encounter_check + end function symba_encounter_check_list_pltp module function symba_encounter_check_tp(self, param, system, dt, irec) result(lany_encounter) implicit none @@ -214,14 +226,23 @@ module subroutine symba_kick_getacch_tp(self, system, param, t, lbeg) logical, intent(in) :: lbeg !! Logical flag that determines whether or not this is the beginning or end of the step end subroutine symba_kick_getacch_tp - module subroutine symba_kick_encounter(self, system, dt, irec, sgn) + module subroutine symba_kick_list_plpl(self, system, dt, irec, sgn) implicit none - class(symba_encounter), intent(in) :: self !! SyMBA pl-tp encounter list object + class(symba_list_plpl), intent(in) :: self !! SyMBA pl-tp encounter list object class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object real(DP), intent(in) :: dt !! step size integer(I4B), intent(in) :: irec !! Current recursion level integer(I4B), intent(in) :: sgn !! sign to be applied to acceleration - end subroutine symba_kick_encounter + end subroutine symba_kick_list_plpl + + module subroutine symba_kick_list_pltp(self, system, dt, irec, sgn) + implicit none + class(symba_list_pltp), intent(in) :: self !! SyMBA pl-tp encounter list object + class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object + real(DP), intent(in) :: dt !! step size + integer(I4B), intent(in) :: irec !! Current recursion level + integer(I4B), intent(in) :: sgn !! sign to be applied to acceleration + end subroutine symba_kick_list_pltp module subroutine symba_setup_initialize_system(self, param) implicit none @@ -229,7 +250,6 @@ module subroutine symba_setup_initialize_system(self, param) class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters end subroutine symba_setup_initialize_system - module subroutine symba_setup_pl(self, n, param) implicit none class(symba_pl), intent(inout) :: self !! SyMBA massive body object @@ -237,12 +257,6 @@ module subroutine symba_setup_pl(self, n, param) class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters end subroutine symba_setup_pl - module subroutine symba_setup_encounter_list(self,n) - implicit none - class(symba_encounter), intent(inout) :: self !! SyMBA pl-tp encounter structure - integer(I8B), intent(in) :: n !! Number of encounters to allocate space for - end subroutine symba_setup_encounter_list - module subroutine symba_setup_tp(self, n, param) implicit none class(symba_tp), intent(inout) :: self !! SyMBA test particle object @@ -286,13 +300,6 @@ module subroutine symba_step_reset_system(self, param) class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters with SyMBA additions end subroutine symba_step_reset_system - module subroutine symba_util_append_encounter_list(self, source, lsource_mask) - implicit none - class(symba_encounter), intent(inout) :: self !! SyMBA encounter list object - class(encounter_list), intent(in) :: source !! Source object to append - logical, dimension(:), intent(in) :: lsource_mask !! Logical mask indicating which elements to append to - end subroutine symba_util_append_encounter_list - module subroutine symba_util_append_pl(self, source, lsource_mask) implicit none class(symba_pl), intent(inout) :: self !! SyMBA massive body object @@ -307,18 +314,6 @@ module subroutine symba_util_append_tp(self, source, lsource_mask) logical, dimension(:), intent(in) :: lsource_mask !! Logical mask indicating which elements to append to end subroutine symba_util_append_tp - module subroutine symba_util_copy_encounter_list(self, source) - use encounter, only : encounter_list - implicit none - class(symba_encounter), intent(inout) :: self !! Encounter list - class(encounter_list), intent(in) :: source !! Source object to copy into - end subroutine symba_util_copy_encounter_list - - module subroutine symba_util_dealloc_encounter_list(self) - implicit none - class(symba_encounter), intent(inout) :: self !! SyMBA encounter list - end subroutine symba_util_dealloc_encounter_list - module subroutine symba_util_dealloc_pl(self) implicit none class(symba_pl), intent(inout) :: self !! SyMBA massive body object @@ -352,10 +347,15 @@ module subroutine symba_util_flatten_eucl_plpl(self, param) class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters end subroutine symba_util_flatten_eucl_plpl - module subroutine symba_util_final_encounter_list(self) + module subroutine symba_util_final_list_plpl(self) implicit none - type(symba_encounter), intent(inout) :: self !! SyMBA encounter list object - end subroutine symba_util_final_encounter_list + type(symba_list_plpl), intent(inout) :: self !! SyMBA encounter list object + end subroutine symba_util_final_list_plpl + + module subroutine symba_util_final_list_pltp(self) + implicit none + type(symba_list_pltp), intent(inout) :: self !! SyMBA encounter list object + end subroutine symba_util_final_list_pltp module subroutine symba_util_final_pl(self) implicit none @@ -432,15 +432,6 @@ module subroutine symba_util_spill_pl(self, discards, lspill_list, ldestructive) logical, intent(in) :: ldestructive !! Logical flag indicating whether or not this operation should alter the keeps array or not end subroutine symba_util_spill_pl - module subroutine symba_util_spill_encounter_list(self, discards, lspill_list, ldestructive) - use encounter, only : encounter_list - implicit none - class(symba_encounter), intent(inout) :: self !! SyMBA pl-tp encounter list - class(encounter_list), intent(inout) :: discards !! Discarded object - logical, dimension(:), intent(in) :: lspill_list !! Logical array of bodies to spill into the discards - logical, intent(in) :: ldestructive !! Logical flag indicating whether or not this operation should alter body by removing the discard list - end subroutine symba_util_spill_encounter_list - module subroutine symba_util_spill_tp(self, discards, lspill_list, ldestructive) implicit none class(symba_tp), intent(inout) :: self !! SyMBA test particle object diff --git a/src/rmvs/rmvs_step.f90 b/src/rmvs/rmvs_step.f90 index 7c602a20b..c6f4bbab1 100644 --- a/src/rmvs/rmvs_step.f90 +++ b/src/rmvs/rmvs_step.f90 @@ -117,7 +117,7 @@ subroutine rmvs_interp_out(cb, pl, dt) write(*, *) xtmp(:,i) write(*, *) vtmp(:,i) write(*, *) " STOPPING " - call util_exit(FAILURE) + call swiftest_util_exit(FAILURE) end if end do end if @@ -139,7 +139,7 @@ subroutine rmvs_interp_out(cb, pl, dt) write(*, *) xtmp(:,i) write(*, *) vtmp(:,i) write(*, *) " STOPPING " - call util_exit(FAILURE) + call swiftest_util_exit(FAILURE) end if end do end if @@ -284,7 +284,7 @@ subroutine rmvs_interp_in(cb, pl, system, param, dt, outer_index) write(*, *) xtmp(:,i) write(*, *) vtmp(:,i) write(*, *) " STOPPING " - call util_exit(failure) + call swiftest_util_exit(failure) end if end do end if @@ -308,7 +308,7 @@ subroutine rmvs_interp_in(cb, pl, system, param, dt, outer_index) write(*, *) xtmp(:,i) write(*, *) vtmp(:,i) write(*, *) " STOPPING " - call util_exit(failure) + call swiftest_util_exit(failure) end if end do end if diff --git a/src/rmvs/rmvs_util.f90 b/src/rmvs/rmvs_util.f90 index a844507dc..09159afb5 100644 --- a/src/rmvs/rmvs_util.f90 +++ b/src/rmvs/rmvs_util.f90 @@ -25,21 +25,21 @@ module subroutine rmvs_util_append_pl(self, source, lsource_mask) select type(source) class is (rmvs_pl) associate(nold => self%nbody, nsrc => source%nbody) - call util_append(self%nenc, source%nenc, nold, nsrc, lsource_mask) - call util_append(self%tpenc1P, source%tpenc1P, nold, nsrc, lsource_mask) - call util_append(self%plind, source%plind, nold, nsrc, lsource_mask) + call swiftest_util_append(self%nenc, source%nenc, nold, nsrc, lsource_mask) + call swiftest_util_append(self%tpenc1P, source%tpenc1P, nold, nsrc, lsource_mask) + call swiftest_util_append(self%plind, source%plind, nold, nsrc, lsource_mask) ! The following are not implemented as RMVS doesn't make use of fill operations on pl type ! So they are here as a placeholder in case someone wants to extend the RMVS class for some reason - !call util_append(self%outer, source%outer, nold, nsrc, lsource_mask) - !call util_append(self%inner, source%inner, nold, nsrc, lsource_mask) - !call util_append(self%planetocentric, source%planetocentric, nold, nsrc, lsource_mask) + !call swiftest_util_append(self%outer, source%outer, nold, nsrc, lsource_mask) + !call swiftest_util_append(self%inner, source%inner, nold, nsrc, lsource_mask) + !call swiftest_util_append(self%planetocentric, source%planetocentric, nold, nsrc, lsource_mask) call whm_util_append_pl(self, source, lsource_mask) end associate class default write(*,*) "Invalid object passed to the append method. Source must be of class rmvs_pl or its descendents!" - call util_exit(FAILURE) + call swiftest_util_exit(FAILURE) end select return @@ -60,15 +60,15 @@ module subroutine rmvs_util_append_tp(self, source, lsource_mask) select type(source) class is (rmvs_tp) associate(nold => self%nbody, nsrc => source%nbody) - call util_append(self%lperi, source%lperi, nold, nsrc, lsource_mask) - call util_append(self%plperP, source%plperP, nold, nsrc, lsource_mask) - call util_append(self%plencP, source%plencP, nold, nsrc, lsource_mask) + call swiftest_util_append(self%lperi, source%lperi, nold, nsrc, lsource_mask) + call swiftest_util_append(self%plperP, source%plperP, nold, nsrc, lsource_mask) + call swiftest_util_append(self%plencP, source%plencP, nold, nsrc, lsource_mask) - call util_append_tp(self, source, lsource_mask) ! Note: whm_tp does not have its own append method, so we skip back to the base class + call swiftest_util_append_tp(self, source, lsource_mask) ! Note: whm_tp does not have its own append method, so we skip back to the base class end associate class default write(*,*) "Invalid object passed to the append method. Source must be of class rmvs_tp or its descendents!" - call util_exit(FAILURE) + call swiftest_util_exit(FAILURE) end select return @@ -140,7 +140,7 @@ module subroutine rmvs_util_dealloc_tp(self) if (allocated(self%rheliocentric)) deallocate(self%rheliocentric) call self%cb_heliocentric%dealloc() - call util_dealloc_tp(self) + call swiftest_util_dealloc_tp(self) return end subroutine rmvs_util_dealloc_tp @@ -161,20 +161,20 @@ module subroutine rmvs_util_fill_pl(self, inserts, lfill_list) associate(keeps => self) select type(inserts) class is (rmvs_pl) - call util_fill(keeps%nenc, inserts%nenc, lfill_list) - call util_fill(keeps%tpenc1P, inserts%tpenc1P, lfill_list) - call util_fill(keeps%plind, inserts%plind, lfill_list) + call swiftest_util_fill(keeps%nenc, inserts%nenc, lfill_list) + call swiftest_util_fill(keeps%tpenc1P, inserts%tpenc1P, lfill_list) + call swiftest_util_fill(keeps%plind, inserts%plind, lfill_list) ! The following are not implemented as RMVS doesn't make use of fill operations on pl type ! So they are here as a placeholder in case someone wants to extend the RMVS class for some reason - !call util_fill(keeps%outer, inserts%outer, lfill_list) - !call util_fill(keeps%inner, inserts%inner, lfill_list) - !call util_fill(keeps%planetocentric, inserts%planetocentric, lfill_list) + !call swiftest_util_fill(keeps%outer, inserts%outer, lfill_list) + !call swiftest_util_fill(keeps%inner, inserts%inner, lfill_list) + !call swiftest_util_fill(keeps%planetocentric, inserts%planetocentric, lfill_list) call whm_util_fill_pl(keeps, inserts, lfill_list) class default write(*,*) "Invalid object passed to the fill method. Source must be of class rmvs_pl or its descendents!" - call util_exit(FAILURE) + call swiftest_util_exit(FAILURE) end select end associate @@ -268,14 +268,14 @@ module subroutine rmvs_util_fill_tp(self, inserts, lfill_list) associate(keeps => self) select type(inserts) class is (rmvs_tp) - call util_fill(keeps%lperi, inserts%lperi, lfill_list) - call util_fill(keeps%plperP, inserts%plperP, lfill_list) - call util_fill(keeps%plencP, inserts%plencP, lfill_list) + call swiftest_util_fill(keeps%lperi, inserts%lperi, lfill_list) + call swiftest_util_fill(keeps%plperP, inserts%plperP, lfill_list) + call swiftest_util_fill(keeps%plencP, inserts%plencP, lfill_list) - call util_fill_tp(keeps, inserts, lfill_list) ! Note: whm_tp does not have its own fill method, so we skip back to the base class + call swiftest_util_fill_tp(keeps, inserts, lfill_list) ! Note: whm_tp does not have its own fill method, so we skip back to the base class class default write(*,*) "Invalid object passed to the fill method. Source must be of class rmvs_tp or its descendents!" - call util_exit(FAILURE) + call swiftest_util_exit(FAILURE) end select end associate @@ -292,15 +292,15 @@ module subroutine rmvs_util_resize_pl(self, nnew) class(rmvs_pl), intent(inout) :: self !! RMVS massive body object integer(I4B), intent(in) :: nnew !! New size neded - call util_resize(self%nenc, nnew) - call util_resize(self%tpenc1P, nnew) - call util_resize(self%plind, nnew) + call swiftest_util_resize(self%nenc, nnew) + call swiftest_util_resize(self%tpenc1P, nnew) + call swiftest_util_resize(self%plind, nnew) ! The following are not implemented as RMVS doesn't make use of resize operations on pl type ! So they are here as a placeholder in case someone wants to extend the RMVS class for some reason - !call util_resize(self%outer, nnew) - !call util_resize(self%inner, nnew) - !call util_resize(self%planetocentric, nnew) + !call swiftest_util_resize(self%outer, nnew) + !call swiftest_util_resize(self%inner, nnew) + !call swiftest_util_resize(self%planetocentric, nnew) call whm_util_resize_pl(self, nnew) return @@ -316,12 +316,12 @@ module subroutine rmvs_util_resize_tp(self, nnew) class(rmvs_tp), intent(inout) :: self !! RMVS test particle object integer(I4B), intent(in) :: nnew !! New size neded - call util_resize(self%lperi, nnew) - call util_resize(self%plperP, nnew) - call util_resize(self%plencP, nnew) - call util_resize(self%rheliocentric, nnew) + call swiftest_util_resize(self%lperi, nnew) + call swiftest_util_resize(self%plperP, nnew) + call swiftest_util_resize(self%plencP, nnew) + call swiftest_util_resize(self%rheliocentric, nnew) - call util_resize_tp(self, nnew) + call swiftest_util_resize_tp(self, nnew) return end subroutine rmvs_util_resize_tp @@ -352,11 +352,11 @@ module subroutine rmvs_util_sort_pl(self, sortby, ascending) associate(pl => self, npl => self%nbody) select case(sortby) case("nenc") - call util_sort(direction * pl%nenc(1:npl), ind) + call swiftest_util_sort(direction * pl%nenc(1:npl), ind) case("tpenc1P") - call util_sort(direction * pl%tpenc1P(1:npl), ind) + call swiftest_util_sort(direction * pl%tpenc1P(1:npl), ind) case("plind") - call util_sort(direction * pl%plind(1:npl), ind) + call swiftest_util_sort(direction * pl%plind(1:npl), ind) case("outer", "inner", "planetocentric", "lplanetocentric") write(*,*) 'Cannot sort by ' // trim(adjustl(sortby)) // '. Component not sortable!' case default ! Look for components in the parent class @@ -396,13 +396,13 @@ module subroutine rmvs_util_sort_tp(self, sortby, ascending) associate(tp => self, ntp => self%nbody) select case(sortby) case("plperP") - call util_sort(direction * tp%plperP(1:ntp), ind) + call swiftest_util_sort(direction * tp%plperP(1:ntp), ind) case("plencP") - call util_sort(direction * tp%plencP(1:ntp), ind) + call swiftest_util_sort(direction * tp%plencP(1:ntp), ind) case("lperi", "cb_heliocentric", "rheliocentric", "index", "ipleP", "lplanetocentric") write(*,*) 'Cannot sort by ' // trim(adjustl(sortby)) // '. Component not sortable!' case default ! Look for components in the parent class (*NOTE whm_tp does not need its own sort method, so we go straight to the swiftest_tp method) - call util_sort_tp(tp, sortby, ascending) + call swiftest_util_sort_tp(tp, sortby, ascending) return end select @@ -425,10 +425,10 @@ module subroutine rmvs_util_sort_rearrange_pl(self, ind) if (self%nbody == 0) return associate(pl => self, npl => self%nbody) - call util_sort_rearrange(pl%nenc, ind, npl) - call util_sort_rearrange(pl%tpenc1P, ind, npl) - call util_sort_rearrange(pl%plind, ind, npl) - call util_sort_rearrange_pl(pl,ind) + call swiftest_util_sort_rearrange(pl%nenc, ind, npl) + call swiftest_util_sort_rearrange(pl%tpenc1P, ind, npl) + call swiftest_util_sort_rearrange(pl%plind, ind, npl) + call swiftest_util_sort_rearrange_pl(pl,ind) end associate return @@ -448,11 +448,11 @@ module subroutine rmvs_util_sort_rearrange_tp(self, ind) if (self%nbody == 0) return associate(tp => self, ntp => self%nbody) - call util_sort_rearrange(tp%lperi, ind, ntp) - call util_sort_rearrange(tp%plperP, ind, ntp) - call util_sort_rearrange(tp%plencP, ind, ntp) - call util_sort_rearrange(tp%rheliocentric, ind, ntp) - call util_sort_rearrange_tp(tp,ind) + call swiftest_util_sort_rearrange(tp%lperi, ind, ntp) + call swiftest_util_sort_rearrange(tp%plperP, ind, ntp) + call swiftest_util_sort_rearrange(tp%plencP, ind, ntp) + call swiftest_util_sort_rearrange(tp%rheliocentric, ind, ntp) + call swiftest_util_sort_rearrange_tp(tp,ind) end associate return @@ -475,14 +475,14 @@ module subroutine rmvs_util_spill_pl(self, discards, lspill_list, ldestructive) associate(keeps => self) select type(discards) class is (rmvs_pl) - call util_spill(keeps%nenc, discards%nenc, lspill_list, ldestructive) - call util_spill(keeps%tpenc1P, discards%tpenc1P, lspill_list, ldestructive) - call util_spill(keeps%plind, discards%plind, lspill_list, ldestructive) + call swiftest_util_spill(keeps%nenc, discards%nenc, lspill_list, ldestructive) + call swiftest_util_spill(keeps%tpenc1P, discards%tpenc1P, lspill_list, ldestructive) + call swiftest_util_spill(keeps%plind, discards%plind, lspill_list, ldestructive) call whm_util_spill_pl(keeps, discards, lspill_list, ldestructive) class default write(*,*) "Invalid object passed to the spill method. Source must be of class rmvs_pl or its descendents!" - call util_exit(FAILURE) + call swiftest_util_exit(FAILURE) end select end associate @@ -506,14 +506,14 @@ module subroutine rmvs_util_spill_tp(self, discards, lspill_list, ldestructive) associate(keeps => self) select type(discards) class is (rmvs_tp) - call util_spill(keeps%lperi, discards%lperi, lspill_list, ldestructive) - call util_spill(keeps%plperP, discards%plperP, lspill_list, ldestructive) - call util_spill(keeps%plencP, discards%plencP, lspill_list, ldestructive) + call swiftest_util_spill(keeps%lperi, discards%lperi, lspill_list, ldestructive) + call swiftest_util_spill(keeps%plperP, discards%plperP, lspill_list, ldestructive) + call swiftest_util_spill(keeps%plencP, discards%plencP, lspill_list, ldestructive) - call util_spill_tp(keeps, discards, lspill_list, ldestructive) + call swiftest_util_spill_tp(keeps, discards, lspill_list, ldestructive) class default write(*,*) "Invalid object passed to the spill method. Source must be of class rmvs_tp or its descendents!" - call util_exit(FAILURE) + call swiftest_util_exit(FAILURE) end select end associate diff --git a/src/swiftest_procedures/swiftest_io.f90 b/src/swiftest_procedures/swiftest_io.f90 index 885e77985..581e7e001 100644 --- a/src/swiftest_procedures/swiftest_io.f90 +++ b/src/swiftest_procedures/swiftest_io.f90 @@ -178,7 +178,7 @@ module subroutine swiftest_io_conservation_report(self, param, lterminal) param%ioutput = param%ioutput + 1 call self%write_frame(nc, param) call nc%close() - call util_exit(FAILURE) + call swiftest_util_exit(FAILURE) end if end if end associate @@ -187,7 +187,7 @@ module subroutine swiftest_io_conservation_report(self, param, lterminal) 667 continue write(*,*) "Error writing energy and momentum tracking file: " // trim(adjustl(errmsg)) - call util_exit(FAILURE) + call swiftest_util_exit(FAILURE) end subroutine swiftest_io_conservation_report @@ -218,7 +218,7 @@ module subroutine swiftest_io_dump_param(self, param_file_name) 667 continue write(*,*) "Error opening parameter dump file " // trim(adjustl(errmsg)) - call util_exit(FAILURE) + call swiftest_util_exit(FAILURE) end subroutine swiftest_io_dump_param @@ -331,18 +331,18 @@ module subroutine swiftest_io_get_args(integrator, param_file_name, display_styl do i = 1,narg call get_command_argument(i, arg(i), status = ierr(i)) end do - if (any(ierr /= 0)) call util_exit(USAGE) + if (any(ierr /= 0)) call swiftest_util_exit(USAGE) else - call util_exit(USAGE) + call swiftest_util_exit(USAGE) end if if (narg == 1) then if (arg(1) == '-v' .or. arg(1) == '--version') then - call util_version() + call swiftest_util_version() else if (arg(1) == '-h' .or. arg(1) == '--help') then - call util_exit(HELP) + call swiftest_util_exit(HELP) else - call util_exit(USAGE) + call swiftest_util_exit(USAGE) end if else if (narg >= 2) then call io_toupper(arg(1)) @@ -366,7 +366,7 @@ module subroutine swiftest_io_get_args(integrator, param_file_name, display_styl case default integrator = UNKNOWN_INTEGRATOR write(*,*) trim(adjustl(arg(1))) // ' is not a valid integrator.' - call util_exit(USAGE) + call swiftest_util_exit(USAGE) end select param_file_name = trim(adjustl(arg(2))) end if @@ -377,7 +377,7 @@ module subroutine swiftest_io_get_args(integrator, param_file_name, display_styl call io_toupper(arg(3)) display_style = trim(adjustl(arg(3))) else - call util_exit(USAGE) + call swiftest_util_exit(USAGE) end if return @@ -1328,7 +1328,7 @@ module subroutine swiftest_io_read_in_cb(self, param) 667 continue write(*,*) "Error reading central body file: " // trim(adjustl(errmsg)) - call util_exit(FAILURE) + call swiftest_util_exit(FAILURE) end subroutine swiftest_io_read_in_cb @@ -1367,7 +1367,7 @@ module subroutine swiftest_io_read_in_system(self, param) end if ierr = self%read_frame(tmp_param%system_history%nc, tmp_param) deallocate(tmp_param) - if (ierr /=0) call util_exit(FAILURE) + if (ierr /=0) call swiftest_util_exit(FAILURE) end if param%loblatecb = ((self%cb%j2rp2 /= 0.0_DP) .or. (self%cb%j4rp4 /= 0.0_DP)) @@ -1481,7 +1481,7 @@ module function swiftest_io_read_frame_body(self, iu, param) result(ierr) class default write(*,*) "Error reading body file: " // trim(adjustl(errmsg)) end select - call util_exit(FAILURE) + call swiftest_util_exit(FAILURE) end function swiftest_io_read_frame_body @@ -1513,7 +1513,7 @@ module subroutine swiftest_io_read_in_param(self, param_file_name) 667 continue write(self%display_unit,*) "Error reading parameter file: " // trim(adjustl(errmsg)) - call util_exit(FAILURE) + call swiftest_util_exit(FAILURE) end subroutine swiftest_io_read_in_param @@ -1539,7 +1539,7 @@ module subroutine swiftest_io_set_display_param(self, display_style) self%log_output = .true. case default write(*,*) display_style, " is an unknown display style" - call util_exit(USAGE) + call swiftest_util_exit(USAGE) end select self%display_style = display_style @@ -1548,7 +1548,7 @@ module subroutine swiftest_io_set_display_param(self, display_style) 667 continue write(*,*) "Error opening swiftest log file: " // trim(adjustl(errmsg)) - call util_exit(FAILURE) + call swiftest_util_exit(FAILURE) end subroutine swiftest_io_set_display_param @@ -1650,7 +1650,7 @@ module subroutine swiftest_io_write_frame_system(self, param) 667 continue write(*,*) "Error writing system frame: " // trim(adjustl(errmsg)) - call util_exit(FAILURE) + call swiftest_util_exit(FAILURE) end subroutine swiftest_io_write_frame_system end submodule s_io diff --git a/src/swiftest_procedures/swiftest_io_netcdf.f90 b/src/swiftest_procedures/swiftest_io_netcdf.f90 index f45c29639..04f4b6b56 100644 --- a/src/swiftest_procedures/swiftest_io_netcdf.f90 +++ b/src/swiftest_procedures/swiftest_io_netcdf.f90 @@ -262,7 +262,7 @@ module subroutine swiftest_io_netcdf_initialize_output(self, param) 667 continue write(*,*) "Error creating NetCDF output file. " // trim(adjustl(errmsg)) - call util_exit(FAILURE) + call swiftest_util_exit(FAILURE) end subroutine swiftest_io_netcdf_initialize_output @@ -453,19 +453,19 @@ module function swiftest_io_netcdf_read_frame_system(self, nc, param) result(ier if (npl_check /= npl) then write(*,*) "Error reading in NetCDF file: The recorded value of npl does not match the number of active massive bodies" - call util_exit(failure) + call swiftest_util_exit(failure) end if if (ntp_check /= ntp) then write(*,*) "Error reading in NetCDF file: The recorded value of ntp does not match the number of active test particles" - call util_exit(failure) + call swiftest_util_exit(failure) end if if (param%integrator == INT_SYMBA) then nplm_check = count(pack(rtemp,plmask) > param%GMTINY ) if (nplm_check /= pl%nplm) then write(*,*) "Error reading in NetCDF file: The recorded value of nplm does not match the number of active fully interacting massive bodies" - call util_exit(failure) + call swiftest_util_exit(failure) end if end if @@ -980,7 +980,7 @@ module subroutine swiftest_io_netcdf_write_frame_body(self, nc, param) associate(n => self%nbody) if (n == 0) return - call util_sort(self%id(1:n), ind) + call swiftest_util_sort(self%id(1:n), ind) do i = 1, n j = ind(i) @@ -1166,7 +1166,7 @@ module subroutine swiftest_io_netcdf_write_info_body(self, nc, param) class is (swiftest_body) associate(n => self%nbody) if (n == 0) return - call util_sort(self%id(1:n), ind) + call swiftest_util_sort(self%id(1:n), ind) do i = 1, n j = ind(i) diff --git a/src/swiftest_procedures/swiftest_setup.f90 b/src/swiftest_procedures/swiftest_setup.f90 index 5e20ede68..0f3a274fb 100644 --- a/src/swiftest_procedures/swiftest_setup.f90 +++ b/src/swiftest_procedures/swiftest_setup.f90 @@ -111,7 +111,7 @@ module subroutine swiftest_setup_construct_system(system, param) write(*,*) 'RINGMOONS-SyMBA integrator not yet enabled' case default write(*,*) 'Unkown integrator',param%integrator - call util_exit(FAILURE) + call swiftest_util_exit(FAILURE) end select end select diff --git a/src/swiftest_procedures/swiftest_util.f90 b/src/swiftest_procedures/swiftest_util.f90 index 40f614f42..edc4c6693 100644 --- a/src/swiftest_procedures/swiftest_util.f90 +++ b/src/swiftest_procedures/swiftest_util.f90 @@ -29,7 +29,7 @@ module subroutine swiftest_util_append_arr_char_string(arr, source, nold, nsrc, if (.not.allocated(arr)) then allocate(arr(nold+nnew)) else - call util_resize(arr, nold + nnew) + call swiftest_util_resize(arr, nold + nnew) end if arr(nold + 1:nold + nnew) = pack(source(1:nsrc), lsource_mask(1:nsrc)) @@ -57,7 +57,7 @@ module subroutine swiftest_util_append_arr_DP(arr, source, nold, nsrc, lsource_m if (.not.allocated(arr)) then allocate(arr(nold+nnew)) else - call util_resize(arr, nold + nnew) + call swiftest_util_resize(arr, nold + nnew) end if arr(nold + 1:nold + nnew) = pack(source(1:nsrc), lsource_mask(1:nsrc)) @@ -85,7 +85,7 @@ module subroutine swiftest_util_append_arr_DPvec(arr, source, nold, nsrc, lsourc if (.not.allocated(arr)) then allocate(arr(NDIM,nold+nnew)) else - call util_resize(arr, nold + nnew) + call swiftest_util_resize(arr, nold + nnew) end if arr(1, nold + 1:nold + nnew) = pack(source(1,1:nsrc), lsource_mask(1:nsrc)) @@ -115,7 +115,7 @@ module subroutine swiftest_util_append_arr_I4B(arr, source, nold, nsrc, lsource_ if (.not.allocated(arr)) then allocate(arr(nold+nnew)) else - call util_resize(arr, nold + nnew) + call swiftest_util_resize(arr, nold + nnew) end if arr(nold + 1:nold + nnew) = pack(source(1:nsrc), lsource_mask(1:nsrc)) @@ -144,14 +144,14 @@ module subroutine swiftest_util_append_arr_info(arr, source, nold, nsrc, lsource if (.not.allocated(arr)) then allocate(arr(nold+nnew)) else - call util_resize(arr, nold + nnew) + call swiftest_util_resize(arr, nold + nnew) end if allocate(idx(nnew)) idx = pack([(i, i = 1, nsrc)], lsource_mask(1:nsrc)) - call util_copy_particle_info_arr(source(1:nsrc), arr(nold+1:nold+nnew), idx) + call swiftest_util_copy_particle_info_arr(source(1:nsrc), arr(nold+1:nold+nnew), idx) return end subroutine swiftest_util_append_arr_info @@ -176,7 +176,7 @@ module subroutine swiftest_util_append_arr_logical(arr, source, nold, nsrc, lsou if (.not.allocated(arr)) then allocate(arr(nold+nnew)) else - call util_resize(arr, nold + nnew) + call swiftest_util_resize(arr, nold + nnew) end if arr(nold + 1:nold + nnew) = pack(source(1:nsrc), lsource_mask(1:nsrc)) @@ -202,27 +202,27 @@ module subroutine swiftest_util_append_body(self, source, lsource_mask) nsrc = source%nbody nnew = count(lsource_mask(1:nsrc)) - call util_append(self%info, source%info, nold, nsrc, lsource_mask) - call util_append(self%id, source%id, nold, nsrc, lsource_mask) - call util_append(self%status, source%status, nold, nsrc, lsource_mask) - call util_append(self%ldiscard, source%ldiscard, nold, nsrc, lsource_mask) - call util_append(self%lmask, source%lmask, nold, nsrc, lsource_mask) - call util_append(self%mu, source%mu, nold, nsrc, lsource_mask) - call util_append(self%rh, source%rh, nold, nsrc, lsource_mask) - call util_append(self%vh, source%vh, nold, nsrc, lsource_mask) - call util_append(self%rb, source%rb, nold, nsrc, lsource_mask) - call util_append(self%vb, source%vb, nold, nsrc, lsource_mask) - call util_append(self%ah, source%ah, nold, nsrc, lsource_mask) - call util_append(self%aobl, source%aobl, nold, nsrc, lsource_mask) - call util_append(self%atide, source%atide, nold, nsrc, lsource_mask) - call util_append(self%agr, source%agr, nold, nsrc, lsource_mask) - call util_append(self%ir3h, source%ir3h, nold, nsrc, lsource_mask) - call util_append(self%a, source%a, nold, nsrc, lsource_mask) - call util_append(self%e, source%e, nold, nsrc, lsource_mask) - call util_append(self%inc, source%inc, nold, nsrc, lsource_mask) - call util_append(self%capom, source%capom, nold, nsrc, lsource_mask) - call util_append(self%omega, source%omega, nold, nsrc, lsource_mask) - call util_append(self%capm, source%capm, nold, nsrc, lsource_mask) + call swiftest_util_append(self%info, source%info, nold, nsrc, lsource_mask) + call swiftest_util_append(self%id, source%id, nold, nsrc, lsource_mask) + call swiftest_util_append(self%status, source%status, nold, nsrc, lsource_mask) + call swiftest_util_append(self%ldiscard, source%ldiscard, nold, nsrc, lsource_mask) + call swiftest_util_append(self%lmask, source%lmask, nold, nsrc, lsource_mask) + call swiftest_util_append(self%mu, source%mu, nold, nsrc, lsource_mask) + call swiftest_util_append(self%rh, source%rh, nold, nsrc, lsource_mask) + call swiftest_util_append(self%vh, source%vh, nold, nsrc, lsource_mask) + call swiftest_util_append(self%rb, source%rb, nold, nsrc, lsource_mask) + call swiftest_util_append(self%vb, source%vb, nold, nsrc, lsource_mask) + call swiftest_util_append(self%ah, source%ah, nold, nsrc, lsource_mask) + call swiftest_util_append(self%aobl, source%aobl, nold, nsrc, lsource_mask) + call swiftest_util_append(self%atide, source%atide, nold, nsrc, lsource_mask) + call swiftest_util_append(self%agr, source%agr, nold, nsrc, lsource_mask) + call swiftest_util_append(self%ir3h, source%ir3h, nold, nsrc, lsource_mask) + call swiftest_util_append(self%a, source%a, nold, nsrc, lsource_mask) + call swiftest_util_append(self%e, source%e, nold, nsrc, lsource_mask) + call swiftest_util_append(self%inc, source%inc, nold, nsrc, lsource_mask) + call swiftest_util_append(self%capom, source%capom, nold, nsrc, lsource_mask) + call swiftest_util_append(self%omega, source%omega, nold, nsrc, lsource_mask) + call swiftest_util_append(self%capm, source%capm, nold, nsrc, lsource_mask) self%nbody = nold + nnew @@ -244,28 +244,28 @@ module subroutine swiftest_util_append_pl(self, source, lsource_mask) select type(source) class is (swiftest_pl) associate(nold => self%nbody, nsrc => source%nbody) - call util_append(self%mass, source%mass, nold, nsrc, lsource_mask) - call util_append(self%Gmass, source%Gmass, nold, nsrc, lsource_mask) - call util_append(self%rhill, source%rhill, nold, nsrc, lsource_mask) - call util_append(self%renc, source%renc, nold, nsrc, lsource_mask) - call util_append(self%radius, source%radius, nold, nsrc, lsource_mask) - call util_append(self%rbeg, source%rbeg, nold, nsrc, lsource_mask) - call util_append(self%rend, source%rend, nold, nsrc, lsource_mask) - call util_append(self%vbeg, source%vbeg, nold, nsrc, lsource_mask) - call util_append(self%density, source%density, nold, nsrc, lsource_mask) - call util_append(self%Ip, source%Ip, nold, nsrc, lsource_mask) - call util_append(self%rot, source%rot, nold, nsrc, lsource_mask) - call util_append(self%k2, source%k2, nold, nsrc, lsource_mask) - call util_append(self%Q, source%Q, nold, nsrc, lsource_mask) - call util_append(self%tlag, source%tlag, nold, nsrc, lsource_mask) + call swiftest_util_append(self%mass, source%mass, nold, nsrc, lsource_mask) + call swiftest_util_append(self%Gmass, source%Gmass, nold, nsrc, lsource_mask) + call swiftest_util_append(self%rhill, source%rhill, nold, nsrc, lsource_mask) + call swiftest_util_append(self%renc, source%renc, nold, nsrc, lsource_mask) + call swiftest_util_append(self%radius, source%radius, nold, nsrc, lsource_mask) + call swiftest_util_append(self%rbeg, source%rbeg, nold, nsrc, lsource_mask) + call swiftest_util_append(self%rend, source%rend, nold, nsrc, lsource_mask) + call swiftest_util_append(self%vbeg, source%vbeg, nold, nsrc, lsource_mask) + call swiftest_util_append(self%density, source%density, nold, nsrc, lsource_mask) + call swiftest_util_append(self%Ip, source%Ip, nold, nsrc, lsource_mask) + call swiftest_util_append(self%rot, source%rot, nold, nsrc, lsource_mask) + call swiftest_util_append(self%k2, source%k2, nold, nsrc, lsource_mask) + call swiftest_util_append(self%Q, source%Q, nold, nsrc, lsource_mask) + call swiftest_util_append(self%tlag, source%tlag, nold, nsrc, lsource_mask) if (allocated(self%k_plpl)) deallocate(self%k_plpl) - call util_append_body(self, source, lsource_mask) + call swiftest_util_append_body(self, source, lsource_mask) end associate class default write(*,*) "Invalid object passed to the append method. Source must be of class swiftest_pl or its descendents" - call util_exit(FAILURE) + call swiftest_util_exit(FAILURE) end select return @@ -286,15 +286,15 @@ module subroutine swiftest_util_append_tp(self, source, lsource_mask) select type(source) class is (swiftest_tp) associate(nold => self%nbody, nsrc => source%nbody) - call util_append(self%isperi, source%isperi, nold, nsrc, lsource_mask) - call util_append(self%peri, source%peri, nold, nsrc, lsource_mask) - call util_append(self%atp, source%atp, nold, nsrc, lsource_mask) + call swiftest_util_append(self%isperi, source%isperi, nold, nsrc, lsource_mask) + call swiftest_util_append(self%peri, source%peri, nold, nsrc, lsource_mask) + call swiftest_util_append(self%atp, source%atp, nold, nsrc, lsource_mask) - call util_append_body(self, source, lsource_mask) + call swiftest_util_append_body(self, source, lsource_mask) end associate class default write(*,*) "Invalid object passed to the append method. Source must be of class swiftest_tp or its descendents" - call util_exit(FAILURE) + call swiftest_util_exit(FAILURE) end select return @@ -750,7 +750,7 @@ module subroutine swiftest_util_dealloc_pl(self) deallocate(self%kin) end if - call util_dealloc_body(self) + call swiftest_util_dealloc_body(self) return end subroutine swiftest_util_dealloc_pl @@ -770,7 +770,7 @@ module subroutine swiftest_util_dealloc_tp(self) if (allocated(self%atp)) deallocate(self%atp) if (allocated(self%k_pltp)) deallocate(self%k_pltp) - call util_dealloc_body(self) + call swiftest_util_dealloc_body(self) return end subroutine swiftest_util_dealloc_tp @@ -916,7 +916,7 @@ module subroutine swiftest_util_fill_arr_info(keeps, inserts, lfill_list) allocate(insert_idx(ninsert)) insert_idx(:) = pack([(i, i = 1, nkeep)], lfill_list) - call util_copy_particle_info_arr(inserts, keeps, insert_idx) + call swiftest_util_copy_particle_info_arr(inserts, keeps, insert_idx) return end subroutine swiftest_util_fill_arr_info @@ -956,32 +956,32 @@ module subroutine swiftest_util_fill_body(self, inserts, lfill_list) ! For each component, pack the discarded bodies into the discard object and do the inverse with the keeps !> Fill all the common components associate(keeps => self) - call util_fill(keeps%id, inserts%id, lfill_list) - call util_fill(keeps%info, inserts%info, lfill_list) - call util_fill(keeps%lmask, inserts%lmask, lfill_list) - call util_fill(keeps%status, inserts%status, lfill_list) - call util_fill(keeps%ldiscard, inserts%ldiscard, lfill_list) - call util_fill(keeps%lcollision, inserts%lcollision, lfill_list) - call util_fill(keeps%lencounter, inserts%lencounter, lfill_list) - call util_fill(keeps%mu, inserts%mu, lfill_list) - call util_fill(keeps%rh, inserts%rh, lfill_list) - call util_fill(keeps%vh, inserts%vh, lfill_list) - call util_fill(keeps%rb, inserts%rb, lfill_list) - call util_fill(keeps%vb, inserts%vb, lfill_list) - call util_fill(keeps%ah, inserts%ah, lfill_list) - call util_fill(keeps%aobl, inserts%aobl, lfill_list) - call util_fill(keeps%agr, inserts%agr, lfill_list) - call util_fill(keeps%atide, inserts%atide, lfill_list) - call util_fill(keeps%ir3h, inserts%ir3h, lfill_list) - call util_fill(keeps%isperi, inserts%isperi, lfill_list) - call util_fill(keeps%peri, inserts%peri, lfill_list) - call util_fill(keeps%atp, inserts%atp, lfill_list) - call util_fill(keeps%a, inserts%a, lfill_list) - call util_fill(keeps%e, inserts%e, lfill_list) - call util_fill(keeps%inc, inserts%inc, lfill_list) - call util_fill(keeps%capom, inserts%capom, lfill_list) - call util_fill(keeps%omega, inserts%omega, lfill_list) - call util_fill(keeps%capm, inserts%capm, lfill_list) + call swiftest_util_fill(keeps%id, inserts%id, lfill_list) + call swiftest_util_fill(keeps%info, inserts%info, lfill_list) + call swiftest_util_fill(keeps%lmask, inserts%lmask, lfill_list) + call swiftest_util_fill(keeps%status, inserts%status, lfill_list) + call swiftest_util_fill(keeps%ldiscard, inserts%ldiscard, lfill_list) + call swiftest_util_fill(keeps%lcollision, inserts%lcollision, lfill_list) + call swiftest_util_fill(keeps%lencounter, inserts%lencounter, lfill_list) + call swiftest_util_fill(keeps%mu, inserts%mu, lfill_list) + call swiftest_util_fill(keeps%rh, inserts%rh, lfill_list) + call swiftest_util_fill(keeps%vh, inserts%vh, lfill_list) + call swiftest_util_fill(keeps%rb, inserts%rb, lfill_list) + call swiftest_util_fill(keeps%vb, inserts%vb, lfill_list) + call swiftest_util_fill(keeps%ah, inserts%ah, lfill_list) + call swiftest_util_fill(keeps%aobl, inserts%aobl, lfill_list) + call swiftest_util_fill(keeps%agr, inserts%agr, lfill_list) + call swiftest_util_fill(keeps%atide, inserts%atide, lfill_list) + call swiftest_util_fill(keeps%ir3h, inserts%ir3h, lfill_list) + call swiftest_util_fill(keeps%isperi, inserts%isperi, lfill_list) + call swiftest_util_fill(keeps%peri, inserts%peri, lfill_list) + call swiftest_util_fill(keeps%atp, inserts%atp, lfill_list) + call swiftest_util_fill(keeps%a, inserts%a, lfill_list) + call swiftest_util_fill(keeps%e, inserts%e, lfill_list) + call swiftest_util_fill(keeps%inc, inserts%inc, lfill_list) + call swiftest_util_fill(keeps%capom, inserts%capom, lfill_list) + call swiftest_util_fill(keeps%omega, inserts%omega, lfill_list) + call swiftest_util_fill(keeps%capm, inserts%capm, lfill_list) ! This is the base class, so will be the last to be called in the cascade. keeps%nbody = size(keeps%id(:)) @@ -1007,27 +1007,27 @@ module subroutine swiftest_util_fill_pl(self, inserts, lfill_list) select type (inserts) ! The standard requires us to select the type of both arguments in order to access all the components class is (swiftest_pl) !> Fill components specific to the massive body class - call util_fill(keeps%mass, inserts%mass, lfill_list) - call util_fill(keeps%Gmass, inserts%Gmass, lfill_list) - call util_fill(keeps%rhill, inserts%rhill, lfill_list) - call util_fill(keeps%renc, inserts%renc, lfill_list) - call util_fill(keeps%radius, inserts%radius, lfill_list) - call util_fill(keeps%density, inserts%density, lfill_list) - call util_fill(keeps%rbeg, inserts%rbeg, lfill_list) - call util_fill(keeps%rend, inserts%rend, lfill_list) - call util_fill(keeps%vbeg, inserts%vbeg, lfill_list) - call util_fill(keeps%Ip, inserts%Ip, lfill_list) - call util_fill(keeps%rot, inserts%rot, lfill_list) - call util_fill(keeps%k2, inserts%k2, lfill_list) - call util_fill(keeps%Q, inserts%Q, lfill_list) - call util_fill(keeps%tlag, inserts%tlag, lfill_list) - call util_fill(keeps%kin, inserts%kin, lfill_list) - call util_fill(keeps%nplenc, inserts%nplenc, lfill_list) - call util_fill(keeps%ntpenc, inserts%ntpenc, lfill_list) + call swiftest_util_fill(keeps%mass, inserts%mass, lfill_list) + call swiftest_util_fill(keeps%Gmass, inserts%Gmass, lfill_list) + call swiftest_util_fill(keeps%rhill, inserts%rhill, lfill_list) + call swiftest_util_fill(keeps%renc, inserts%renc, lfill_list) + call swiftest_util_fill(keeps%radius, inserts%radius, lfill_list) + call swiftest_util_fill(keeps%density, inserts%density, lfill_list) + call swiftest_util_fill(keeps%rbeg, inserts%rbeg, lfill_list) + call swiftest_util_fill(keeps%rend, inserts%rend, lfill_list) + call swiftest_util_fill(keeps%vbeg, inserts%vbeg, lfill_list) + call swiftest_util_fill(keeps%Ip, inserts%Ip, lfill_list) + call swiftest_util_fill(keeps%rot, inserts%rot, lfill_list) + call swiftest_util_fill(keeps%k2, inserts%k2, lfill_list) + call swiftest_util_fill(keeps%Q, inserts%Q, lfill_list) + call swiftest_util_fill(keeps%tlag, inserts%tlag, lfill_list) + call swiftest_util_fill(keeps%kin, inserts%kin, lfill_list) + call swiftest_util_fill(keeps%nplenc, inserts%nplenc, lfill_list) + call swiftest_util_fill(keeps%ntpenc, inserts%ntpenc, lfill_list) if (allocated(keeps%k_plpl)) deallocate(keeps%k_plpl) - call util_fill_body(keeps, inserts, lfill_list) + call swiftest_util_fill_body(keeps, inserts, lfill_list) class default write(*,*) 'Error! fill method called for incompatible return type on swiftest_pl' end select @@ -1052,9 +1052,9 @@ module subroutine swiftest_util_fill_tp(self, inserts, lfill_list) select type(inserts) class is (swiftest_tp) !> Spill components specific to the test particle class - call util_fill(keeps%nplenc, inserts%nplenc, lfill_list) + call swiftest_util_fill(keeps%nplenc, inserts%nplenc, lfill_list) - call util_fill_body(keeps, inserts, lfill_list) + call swiftest_util_fill_body(keeps, inserts, lfill_list) class default write(*,*) 'Error! fill method called for incompatible return type on swiftest_tp' end select @@ -1186,7 +1186,7 @@ module subroutine swiftest_util_flatten_eucl_plpl(self, param) param%lflatten_interactions = .false. else do concurrent (i=1:npl, j=1:npl, j>i) - call util_flatten_eucl_ij_to_k(self%nbody, i, j, k) + call swiftest_util_flatten_eucl_ij_to_k(self%nbody, i, j, k) self%k_plpl(1, k) = i self%k_plpl(2, k) = j end do @@ -1312,9 +1312,9 @@ module subroutine swiftest_util_get_energy_momentum_system(self, param) end if if (param%lflatten_interactions) then - call util_get_energy_potential_flat(npl, pl%nplpl, pl%k_plpl, pl%lmask, cb%Gmass, pl%Gmass, pl%mass, pl%rb, system%pe) + call swiftest_util_get_energy_potential_flat(npl, pl%nplpl, pl%k_plpl, pl%lmask, cb%Gmass, pl%Gmass, pl%mass, pl%rb, system%pe) else - call util_get_energy_potential_triangular(npl, pl%lmask, cb%Gmass, pl%Gmass, pl%mass, pl%rb, system%pe) + call swiftest_util_get_energy_potential_triangular(npl, pl%lmask, cb%Gmass, pl%Gmass, pl%mass, pl%rb, system%pe) end if ! Potential energy from the oblateness term @@ -1577,12 +1577,12 @@ module subroutine swiftest_util_index_map_storage(self) integer(I4B), dimension(:), allocatable :: idvals real(DP), dimension(:), allocatable :: tvals - call util_get_vals_storage(self, idvals, tvals) + call swiftest_util_get_vals_storage(self, idvals, tvals) - call util_unique(idvals,self%idvals,self%idmap) + call swiftest_util_unique(idvals,self%idvals,self%idmap) self%nid = size(self%idvals) - call util_unique(tvals,self%tvals,self%tmap) + call swiftest_util_unique(tvals,self%tvals,self%tmap) self%nt = size(self%tvals) return @@ -2111,7 +2111,7 @@ subroutine swiftest_quadfit(f, x0, S, N, eps, lo, hi, lerr) lhs(2, :) = row_2 lhs(3, :) = row_3 ! Solve system of equations - soln(:) = util_solve_linear_system(lhs, rhs, 3, lerr) + soln(:) = swiftest_util_solve_linear_system(lhs, rhs, 3, lerr) call ieee_set_flag(ieee_all, .false.) ! Set all flags back to quiet call ieee_set_halting_mode(ieee_divide_by_zero, .false.) if (lerr) then @@ -2259,7 +2259,7 @@ module subroutine swiftest_util_rearray_pl(self, system, param) integer(I4B), dimension(:), allocatable :: levelg_orig_pl, levelm_orig_pl, levelg_orig_tp, levelm_orig_tp integer(I4B), dimension(:), allocatable :: nplenc_orig_pl, nplenc_orig_tp, ntpenc_orig_pl - associate(pl => self, pl_adds => system%pl_adds) + associate(pl => self, tp => system%tp, pl_adds => system%pl_adds) npl = pl%nbody nadd = pl_adds%nbody @@ -2327,32 +2327,38 @@ module subroutine swiftest_util_rearray_pl(self, system, param) ! Reset the kinship trackers call pl%reset_kinship([(i, i=1, npl)]) - ! Re-build the zero-level encounter list, being sure to save the original level information for all bodies - allocate(nplenc_orig_pl, source=pl%nplenc) + ! Re-build the encounter list + + + ! Be sure to get the level info if this is a SyMBA system + select type(system) + class is (symba_nbody_system) select type(pl) class is (symba_pl) + select type(tp) + class is (symba_tp) allocate(levelg_orig_pl, source=pl%levelg) allocate(levelm_orig_pl, source=pl%levelm) + allocate(nplenc_orig_tp, source=tp%nplenc) call move_alloc(levelg_orig_pl, pl%levelg) call move_alloc(levelm_orig_pl, pl%levelm) - end select - lencounter = pl%encounter_check(param, system, param%dt, system%irec) - if (system%tp%nbody > 0) then - allocate(ntpenc_orig_pl, source=pl%ntpenc) - allocate(nplenc_orig_tp, source=tp%nplenc) - select type(tp => system%tp) - class is (symba_tp) + call move_alloc(nplenc_orig_pl, pl%nplenc) + lencounter = pl%encounter_check(param, system, param%dt, system%irec) + if (tp%nbody > 0) then allocate(levelg_orig_tp, source=tp%levelg) allocate(levelm_orig_tp, source=tp%levelm) + allocate(nplenc_orig_tp, source=tp%nplenc) + allocate(ntpenc_orig_pl, source=pl%ntpenc) lencounter = tp%encounter_check(param, system, param%dt, system%irec) call move_alloc(levelg_orig_tp, tp%levelg) call move_alloc(levelm_orig_tp, tp%levelm) call move_alloc(nplenc_orig_tp, tp%nplenc) call move_alloc(ntpenc_orig_pl, pl%ntpenc) - end select - end if + end if + end select + end select + end select - call move_alloc(nplenc_orig_pl, pl%nplenc) ! Re-index the encounter list as the index values may have changed if (nenc_old > 0) then @@ -2689,9 +2695,9 @@ module subroutine swiftest_util_resize_arr_info(arr, nnew) allocate(tmp(nnew)) if (nnew > nold) then - call util_copy_particle_info_arr(arr(1:nold), tmp(1:nold)) + call swiftest_util_copy_particle_info_arr(arr(1:nold), tmp(1:nold)) else - call util_copy_particle_info_arr(arr(1:nnew), tmp(1:nnew)) + call swiftest_util_copy_particle_info_arr(arr(1:nnew), tmp(1:nnew)) end if call move_alloc(tmp, arr) @@ -2754,29 +2760,29 @@ module subroutine swiftest_util_resize_body(self, nnew) class(swiftest_body), intent(inout) :: self !! Swiftest body object integer(I4B), intent(in) :: nnew !! New size neded - call util_resize(self%info, nnew) - call util_resize(self%id, nnew) - call util_resize(self%status, nnew) - call util_resize(self%lcollision, nnew) - call util_resize(self%lencounter, nnew) - call util_resize(self%ldiscard, nnew) - call util_resize(self%lmask, nnew) - call util_resize(self%mu, nnew) - call util_resize(self%rh, nnew) - call util_resize(self%vh, nnew) - call util_resize(self%rb, nnew) - call util_resize(self%vb, nnew) - call util_resize(self%ah, nnew) - call util_resize(self%aobl, nnew) - call util_resize(self%atide, nnew) - call util_resize(self%agr, nnew) - call util_resize(self%ir3h, nnew) - call util_resize(self%a, nnew) - call util_resize(self%e, nnew) - call util_resize(self%inc, nnew) - call util_resize(self%capom, nnew) - call util_resize(self%omega, nnew) - call util_resize(self%capm, nnew) + call swiftest_util_resize(self%info, nnew) + call swiftest_util_resize(self%id, nnew) + call swiftest_util_resize(self%status, nnew) + call swiftest_util_resize(self%lcollision, nnew) + call swiftest_util_resize(self%lencounter, nnew) + call swiftest_util_resize(self%ldiscard, nnew) + call swiftest_util_resize(self%lmask, nnew) + call swiftest_util_resize(self%mu, nnew) + call swiftest_util_resize(self%rh, nnew) + call swiftest_util_resize(self%vh, nnew) + call swiftest_util_resize(self%rb, nnew) + call swiftest_util_resize(self%vb, nnew) + call swiftest_util_resize(self%ah, nnew) + call swiftest_util_resize(self%aobl, nnew) + call swiftest_util_resize(self%atide, nnew) + call swiftest_util_resize(self%agr, nnew) + call swiftest_util_resize(self%ir3h, nnew) + call swiftest_util_resize(self%a, nnew) + call swiftest_util_resize(self%e, nnew) + call swiftest_util_resize(self%inc, nnew) + call swiftest_util_resize(self%capom, nnew) + call swiftest_util_resize(self%omega, nnew) + call swiftest_util_resize(self%capm, nnew) self%nbody = count(self%status(1:nnew) /= INACTIVE) return @@ -2792,26 +2798,26 @@ module subroutine swiftest_util_resize_pl(self, nnew) class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object integer(I4B), intent(in) :: nnew !! New size neded - call util_resize_body(self, nnew) - - call util_resize(self%mass, nnew) - call util_resize(self%Gmass, nnew) - call util_resize(self%rhill, nnew) - call util_resize(self%renc, nnew) - call util_resize(self%radius, nnew) - call util_resize(self%rbeg, nnew) - call util_resize(self%rend, nnew) - call util_resize(self%vbeg, nnew) - call util_resize(self%density, nnew) - call util_resize(self%Ip, nnew) - call util_resize(self%rot, nnew) - call util_resize(self%k2, nnew) - call util_resize(self%Q, nnew) - call util_resize(self%tlag, nnew) - call util_resize(self%kin, nnew) - call util_resize(self%lmtiny, nnew) - call util_resize(self%nplenc, nnew) - call util_resize(self%ntpenc, nnew) + call swiftest_util_resize_body(self, nnew) + + call swiftest_util_resize(self%mass, nnew) + call swiftest_util_resize(self%Gmass, nnew) + call swiftest_util_resize(self%rhill, nnew) + call swiftest_util_resize(self%renc, nnew) + call swiftest_util_resize(self%radius, nnew) + call swiftest_util_resize(self%rbeg, nnew) + call swiftest_util_resize(self%rend, nnew) + call swiftest_util_resize(self%vbeg, nnew) + call swiftest_util_resize(self%density, nnew) + call swiftest_util_resize(self%Ip, nnew) + call swiftest_util_resize(self%rot, nnew) + call swiftest_util_resize(self%k2, nnew) + call swiftest_util_resize(self%Q, nnew) + call swiftest_util_resize(self%tlag, nnew) + call swiftest_util_resize(self%kin, nnew) + call swiftest_util_resize(self%lmtiny, nnew) + call swiftest_util_resize(self%nplenc, nnew) + call swiftest_util_resize(self%ntpenc, nnew) @@ -2830,12 +2836,12 @@ module subroutine swiftest_util_resize_tp(self, nnew) class(swiftest_tp), intent(inout) :: self !! Swiftest test particle object integer(I4B), intent(in) :: nnew !! New size neded - call util_resize_body(self, nnew) + call swiftest_util_resize_body(self, nnew) - call util_resize(self%nplenc, nnew) - call util_resize(self%isperi, nnew) - call util_resize(self%peri, nnew) - call util_resize(self%atp, nnew) + call swiftest_util_resize(self%nplenc, nnew) + call swiftest_util_resize(self%isperi, nnew) + call swiftest_util_resize(self%peri, nnew) + call swiftest_util_resize(self%atp, nnew) return end subroutine swiftest_util_resize_tp @@ -3139,7 +3145,7 @@ module function swiftest_util_solve_linear_system_d(A,b,n,lerr) result(x) call ieee_set_status(original_fpe_status) return - end function util_solve_linear_system_d + end function swiftest_util_solve_linear_system_d module function swiftest_util_solve_linear_system_q(A,b,n,lerr) result(x) @@ -3175,7 +3181,7 @@ module function swiftest_util_solve_linear_system_q(A,b,n,lerr) result(x) call ieee_set_status(original_fpe_status) return - end function util_solve_linear_system_q + end function swiftest_util_solve_linear_system_q function solve_wbs(u) result(x) ! solve with backward substitution !! Based on code available on Rosetta Code: https://rosettacode.org/wiki/Gaussian_elimination#Fortran @@ -3312,7 +3318,7 @@ module function swiftest_util_solve_rkf45(f, y0in, t1, dt0, tol) result(y1) if (s >= 1.0_DP) exit ! Good step! if (i == MAXREDUX) then write(*,*) "Something has gone wrong in util_solve_rkf45!! Step size reduction has gone too far this time!" - call util_exit(FAILURE) + call swiftest_util_exit(FAILURE) end if end do @@ -3325,7 +3331,7 @@ module function swiftest_util_solve_rkf45(f, y0in, t1, dt0, tol) result(y1) end do return - end function util_solve_rkf45 + end function swiftest_util_solve_rkf45 @@ -3354,21 +3360,21 @@ module subroutine swiftest_util_sort_body(self, sortby, ascending) associate(body => self, n => self%nbody) select case(sortby) case("id") - call util_sort(direction * body%id(1:n), ind) + call swiftest_util_sort(direction * body%id(1:n), ind) case("status") - call util_sort(direction * body%status(1:n), ind) + call swiftest_util_sort(direction * body%status(1:n), ind) case("ir3h") - call util_sort(direction * body%ir3h(1:n), ind) + call swiftest_util_sort(direction * body%ir3h(1:n), ind) case("a") - call util_sort(direction * body%a(1:n), ind) + call swiftest_util_sort(direction * body%a(1:n), ind) case("e") - call util_sort(direction * body%e(1:n), ind) + call swiftest_util_sort(direction * body%e(1:n), ind) case("inc") - call util_sort(direction * body%inc(1:n), ind) + call swiftest_util_sort(direction * body%inc(1:n), ind) case("capom") - call util_sort(direction * body%capom(1:n), ind) + call swiftest_util_sort(direction * body%capom(1:n), ind) case("mu") - call util_sort(direction * body%mu(1:n), ind) + call swiftest_util_sort(direction * body%mu(1:n), ind) case("lfirst", "nbody", "ldiscard", "rh", "vh", "rb", "vb", "ah", "aobl", "atide", "agr") write(*,*) 'Cannot sort by ' // trim(adjustl(sortby)) // '. Component not sortable!' case default @@ -3393,7 +3399,7 @@ pure module subroutine swiftest_util_sort_dp(arr) ! Arguments real(DP), dimension(:), intent(inout) :: arr - call qsort_DP(arr) + call swiftest_qsort_DP(arr) return end subroutine swiftest_util_sort_dp @@ -3422,7 +3428,7 @@ pure module subroutine swiftest_util_sort_index_dp(arr, ind) end if allocate(tmparr, mold=arr) tmparr(:) = arr(ind(:)) - call qsort_DP(tmparr, ind) + call swiftest_qsort_DP(tmparr, ind) return end subroutine swiftest_util_sort_index_dp @@ -3442,13 +3448,13 @@ recursive pure subroutine swiftest_qsort_DP(arr, ind) if (size(arr) > 1) then if (present(ind)) then - call partition_DP(arr, iq, ind) - call qsort_DP(arr(:iq-1),ind(:iq-1)) - call qsort_DP(arr(iq:), ind(iq:)) + call swiftest_partition_DP(arr, iq, ind) + call swiftest_qsort_DP(arr(:iq-1),ind(:iq-1)) + call swiftest_qsort_DP(arr(iq:), ind(iq:)) else - call partition_DP(arr, iq) - call qsort_DP(arr(:iq-1)) - call qsort_DP(arr(iq:)) + call swiftest_partition_DP(arr, iq) + call swiftest_qsort_DP(arr(:iq-1)) + call swiftest_qsort_DP(arr(iq:)) end if end if @@ -3523,7 +3529,7 @@ pure module subroutine swiftest_util_sort_i4b(arr) ! Arguments integer(I4B), dimension(:), intent(inout) :: arr - call qsort_I4B(arr) + call swiftest_qsort_I4B(arr) return end subroutine swiftest_util_sort_i4b @@ -3551,7 +3557,7 @@ pure module subroutine swiftest_util_sort_index_I4B(arr, ind) end if allocate(tmparr, mold=arr) tmparr(:) = arr(ind(:)) - call qsort_I4B(tmparr, ind) + call swiftest_qsort_I4B(tmparr, ind) return end subroutine swiftest_util_sort_index_I4B @@ -3579,7 +3585,7 @@ pure module subroutine swiftest_util_sort_index_I4B_I8Bind(arr, ind) end if allocate(tmparr, mold=arr) tmparr(:) = arr(ind(:)) - call qsort_I4B_I8Bind(tmparr, ind) + call swiftest_qsort_I4B_I8Bind(tmparr, ind) return end subroutine swiftest_util_sort_index_I4B_I8Bind @@ -3599,13 +3605,13 @@ recursive pure subroutine swiftest_qsort_I4B(arr, ind) if (size(arr) > 1) then if (present(ind)) then - call partition_I4B(arr, iq, ind) - call qsort_I4B(arr(:iq-1),ind(:iq-1)) - call qsort_I4B(arr(iq:), ind(iq:)) + call swiftest_partition_I4B(arr, iq, ind) + call swiftest_qsort_I4B(arr(:iq-1),ind(:iq-1)) + call swiftest_qsort_I4B(arr(iq:), ind(iq:)) else - call partition_I4B(arr, iq) - call qsort_I4B(arr(:iq-1)) - call qsort_I4B(arr(iq:)) + call swiftest_partition_I4B(arr, iq) + call swiftest_qsort_I4B(arr(:iq-1)) + call swiftest_qsort_I4B(arr(iq:)) end if end if @@ -3626,13 +3632,13 @@ recursive pure subroutine swiftest_qsort_I4B_I8Bind(arr, ind) if (size(arr) > 1_I8B) then if (present(ind)) then - call partition_I4B_I8Bind(arr, iq, ind) - call qsort_I4B_I8Bind(arr(:iq-1_I8B),ind(:iq-1_I8B)) - call qsort_I4B_I8Bind(arr(iq:), ind(iq:)) + call swiftest_partition_I4B_I8Bind(arr, iq, ind) + call swiftest_qsort_I4B_I8Bind(arr(:iq-1_I8B),ind(:iq-1_I8B)) + call swiftest_qsort_I4B_I8Bind(arr(iq:), ind(iq:)) else - call partition_I4B_I8Bind(arr, iq) - call qsort_I4B_I8Bind(arr(:iq-1_I8B)) - call qsort_I4B_I8Bind(arr(iq:)) + call swiftest_partition_I4B_I8Bind(arr, iq) + call swiftest_qsort_I4B_I8Bind(arr(:iq-1_I8B)) + call swiftest_qsort_I4B_I8Bind(arr(iq:)) end if end if @@ -3654,13 +3660,13 @@ recursive pure subroutine swiftest_qsort_I8B_I8Bind(arr, ind) if (size(arr) > 1_I8B) then if (present(ind)) then - call partition_I8B_I8Bind(arr, iq, ind) - call qsort_I8B_I8Bind(arr(:iq-1_I8B),ind(:iq-1_I8B)) - call qsort_I8B_I8Bind(arr(iq:), ind(iq:)) + call swiftest_partition_I8B_I8Bind(arr, iq, ind) + call swiftest_qsort_I8B_I8Bind(arr(:iq-1_I8B),ind(:iq-1_I8B)) + call swiftest_qsort_I8B_I8Bind(arr(iq:), ind(iq:)) else - call partition_I8B_I8Bind(arr, iq) - call qsort_I8B_I8Bind(arr(:iq-1_I8B)) - call qsort_I8B_I8Bind(arr(iq:)) + call swiftest_partition_I8B_I8Bind(arr, iq) + call swiftest_qsort_I8B_I8Bind(arr(:iq-1_I8B)) + call swiftest_qsort_I8B_I8Bind(arr(iq:)) end if end if @@ -3846,7 +3852,7 @@ pure module subroutine swiftest_util_sort_sp(arr) ! Arguments real(SP), dimension(:), intent(inout) :: arr - call qsort_SP(arr) + call swiftest_qsort_SP(arr) return end subroutine swiftest_util_sort_sp @@ -3874,7 +3880,7 @@ pure module subroutine swiftest_util_sort_index_sp(arr, ind) end if allocate(tmparr, mold=arr) tmparr(:) = arr(ind(:)) - call qsort_SP(tmparr, ind) + call swiftest_qsort_SP(tmparr, ind) return end subroutine swiftest_util_sort_index_sp @@ -3894,13 +3900,13 @@ recursive pure subroutine swiftest_qsort_SP(arr, ind) if (size(arr) > 1) then if (present(ind)) then - call partition_SP(arr, iq, ind) - call qsort_SP(arr(:iq-1),ind(:iq-1)) - call qsort_SP(arr(iq:), ind(iq:)) + call swiftest_partition_SP(arr, iq, ind) + call swiftest_qsort_SP(arr(:iq-1),ind(:iq-1)) + call swiftest_qsort_SP(arr(iq:), ind(iq:)) else - call partition_SP(arr, iq) - call qsort_SP(arr(:iq-1)) - call qsort_SP(arr(iq:)) + call swiftest_partition_SP(arr, iq) + call swiftest_qsort_SP(arr(:iq-1)) + call swiftest_qsort_SP(arr(iq:)) end if end if @@ -3990,25 +3996,25 @@ module subroutine swiftest_util_sort_pl(self, sortby, ascending) associate(pl => self, npl => self%nbody) select case(sortby) case("Gmass","mass") - call util_sort(direction * pl%Gmass(1:npl), ind) + call swiftest_util_sort(direction * pl%Gmass(1:npl), ind) case("rhill") - call util_sort(direction * pl%rhill(1:npl), ind) + call swiftest_util_sort(direction * pl%rhill(1:npl), ind) case("renc") - call util_sort(direction * pl%renc(1:npl), ind) + call swiftest_util_sort(direction * pl%renc(1:npl), ind) case("radius") - call util_sort(direction * pl%radius(1:npl), ind) + call swiftest_util_sort(direction * pl%radius(1:npl), ind) case("density") - call util_sort(direction * pl%density(1:npl), ind) + call swiftest_util_sort(direction * pl%density(1:npl), ind) case("k2") - call util_sort(direction * pl%k2(1:npl), ind) + call swiftest_util_sort(direction * pl%k2(1:npl), ind) case("Q") - call util_sort(direction * pl%Q(1:npl), ind) + call swiftest_util_sort(direction * pl%Q(1:npl), ind) case("tlag") - call util_sort(direction * pl%tlag(1:npl), ind) + call swiftest_util_sort(direction * pl%tlag(1:npl), ind) case("rbeg", "rend", "vbeg", "Ip", "rot", "k_plpl", "nplpl") write(*,*) 'Cannot sort by ' // trim(adjustl(sortby)) // '. Component not sortable!' case default ! Look for components in the parent class - call util_sort_body(pl, sortby, ascending) + call swiftest_util_sort_body(pl, sortby, ascending) return end select @@ -4045,13 +4051,13 @@ module subroutine swiftest_util_sort_tp(self, sortby, ascending) associate(tp => self, ntp => self%nbody) select case(sortby) case("peri") - call util_sort(direction * tp%peri(1:ntp), ind) + call swiftest_util_sort(direction * tp%peri(1:ntp), ind) case("atp") - call util_sort(direction * tp%atp(1:ntp), ind) + call swiftest_util_sort(direction * tp%atp(1:ntp), ind) case("isperi") write(*,*) 'Cannot sort by ' // trim(adjustl(sortby)) // '. Component not sortable!' case default ! Look for components in the parent class - call util_sort_body(tp, sortby, ascending) + call swiftest_util_sort_body(tp, sortby, ascending) return end select @@ -4074,32 +4080,32 @@ module subroutine swiftest_util_sort_rearrange_body(self, ind) integer(I4B), dimension(:), intent(in) :: ind !! Index array used to restructure the body (should contain all 1:n index values in the desired order) associate(n => self%nbody) - call util_sort_rearrange(self%id, ind, n) - call util_sort_rearrange(self%lmask, ind, n) - call util_sort_rearrange(self%info, ind, n) - call util_sort_rearrange(self%status, ind, n) - call util_sort_rearrange(self%ldiscard, ind, n) - call util_sort_rearrange(pl%lcollision, ind, n) - call util_sort_rearrange(pl%lencounter, ind, n) - call util_sort_rearrange(self%rh, ind, n) - call util_sort_rearrange(self%vh, ind, n) - call util_sort_rearrange(self%rb, ind, n) - call util_sort_rearrange(self%vb, ind, n) - call util_sort_rearrange(self%ah, ind, n) - call util_sort_rearrange(self%aobl, ind, n) - call util_sort_rearrange(self%agr, ind, n) - call util_sort_rearrange(self%atide, ind, n) - call util_sort_rearrange(self%ir3h, ind, n) - call util_sort_rearrange(self%isperi, ind, n) - call util_sort_rearrange(self%peri, ind, n) - call util_sort_rearrange(self%atp, ind, n) - call util_sort_rearrange(self%mu, ind, n) - call util_sort_rearrange(self%a, ind, n) - call util_sort_rearrange(self%e, ind, n) - call util_sort_rearrange(self%inc, ind, n) - call util_sort_rearrange(self%capom, ind, n) - call util_sort_rearrange(self%omega, ind, n) - call util_sort_rearrange(self%capm, ind, n) + call swiftest_util_sort_rearrange(self%id, ind, n) + call swiftest_util_sort_rearrange(self%lmask, ind, n) + call swiftest_util_sort_rearrange(self%info, ind, n) + call swiftest_util_sort_rearrange(self%status, ind, n) + call swiftest_util_sort_rearrange(self%ldiscard, ind, n) + call swiftest_util_sort_rearrange(self%lcollision, ind, n) + call swiftest_util_sort_rearrange(self%lencounter, ind, n) + call swiftest_util_sort_rearrange(self%rh, ind, n) + call swiftest_util_sort_rearrange(self%vh, ind, n) + call swiftest_util_sort_rearrange(self%rb, ind, n) + call swiftest_util_sort_rearrange(self%vb, ind, n) + call swiftest_util_sort_rearrange(self%ah, ind, n) + call swiftest_util_sort_rearrange(self%aobl, ind, n) + call swiftest_util_sort_rearrange(self%agr, ind, n) + call swiftest_util_sort_rearrange(self%atide, ind, n) + call swiftest_util_sort_rearrange(self%ir3h, ind, n) + call swiftest_util_sort_rearrange(self%isperi, ind, n) + call swiftest_util_sort_rearrange(self%peri, ind, n) + call swiftest_util_sort_rearrange(self%atp, ind, n) + call swiftest_util_sort_rearrange(self%mu, ind, n) + call swiftest_util_sort_rearrange(self%a, ind, n) + call swiftest_util_sort_rearrange(self%e, ind, n) + call swiftest_util_sort_rearrange(self%inc, ind, n) + call swiftest_util_sort_rearrange(self%capom, ind, n) + call swiftest_util_sort_rearrange(self%omega, ind, n) + call swiftest_util_sort_rearrange(self%capm, ind, n) end associate return @@ -4267,7 +4273,7 @@ module subroutine swiftest_util_sort_rearrange_arr_info(arr, ind, n) if (.not. allocated(arr) .or. n <= 0) return allocate(tmp, mold=arr) - call util_copy_particle_info_arr(arr, tmp, ind) + call swiftest_util_copy_particle_info_arr(arr, tmp, ind) call move_alloc(tmp, arr) return @@ -4284,27 +4290,27 @@ module subroutine swiftest_util_sort_rearrange_pl(self, ind) integer(I4B), dimension(:), intent(in) :: ind !! Index array used to restructure the body (should contain all 1:n index values in the desired order) associate(pl => self, npl => self%nbody) - call util_sort_rearrange(pl%mass, ind, npl) - call util_sort_rearrange(pl%Gmass, ind, npl) - call util_sort_rearrange(pl%rhill, ind, npl) - call util_sort_rearrange(pl%renc, ind, npl) - call util_sort_rearrange(pl%radius, ind, npl) - call util_sort_rearrange(pl%density, ind, npl) - call util_sort_rearrange(pl%rbeg, ind, npl) - call util_sort_rearrange(pl%vbeg, ind, npl) - call util_sort_rearrange(pl%Ip, ind, npl) - call util_sort_rearrange(pl%rot, ind, npl) - call util_sort_rearrange(pl%k2, ind, npl) - call util_sort_rearrange(pl%Q, ind, npl) - call util_sort_rearrange(pl%tlag, ind, npl) - call util_sort_rearrange(pl%kin, ind, npl) - call util_sort_rearrange(pl%lmtiny, ind, npl) - call util_sort_rearrange(pl%nplenc, ind, npl) - call util_sort_rearrange(pl%ntpenc, ind, npl) + call swiftest_util_sort_rearrange(pl%mass, ind, npl) + call swiftest_util_sort_rearrange(pl%Gmass, ind, npl) + call swiftest_util_sort_rearrange(pl%rhill, ind, npl) + call swiftest_util_sort_rearrange(pl%renc, ind, npl) + call swiftest_util_sort_rearrange(pl%radius, ind, npl) + call swiftest_util_sort_rearrange(pl%density, ind, npl) + call swiftest_util_sort_rearrange(pl%rbeg, ind, npl) + call swiftest_util_sort_rearrange(pl%vbeg, ind, npl) + call swiftest_util_sort_rearrange(pl%Ip, ind, npl) + call swiftest_util_sort_rearrange(pl%rot, ind, npl) + call swiftest_util_sort_rearrange(pl%k2, ind, npl) + call swiftest_util_sort_rearrange(pl%Q, ind, npl) + call swiftest_util_sort_rearrange(pl%tlag, ind, npl) + call swiftest_util_sort_rearrange(pl%kin, ind, npl) + call swiftest_util_sort_rearrange(pl%lmtiny, ind, npl) + call swiftest_util_sort_rearrange(pl%nplenc, ind, npl) + call swiftest_util_sort_rearrange(pl%ntpenc, ind, npl) if (allocated(pl%k_plpl)) deallocate(pl%k_plpl) - call util_sort_rearrange_body(pl, ind) + call swiftest_util_sort_rearrange_body(pl, ind) end associate return @@ -4322,11 +4328,11 @@ module subroutine swiftest_util_sort_rearrange_tp(self, ind) integer(I4B), dimension(:), intent(in) :: ind !! Index array used to restructure the body (should contain all 1:n index values in the desired order) associate(tp => self, ntp => self%nbody) - call util_sort_rearrange(tp%nplenc, ind, ntp) + call swiftest_util_sort_rearrange(tp%nplenc, ind, ntp) if (allocated(tp%k_pltp)) deallocate(tp%k_pltp) - call util_sort_rearrange_body(tp, ind) + call swiftest_util_sort_rearrange_body(tp, ind) end associate return @@ -4577,14 +4583,14 @@ module subroutine swiftest_util_spill_arr_info(keeps, discards, lspill_list, lde allocate(idx(nspill)) idx(:) = pack([(i, i = 1, nlist)], lspill_list) - call util_copy_particle_info_arr(keeps, discards, idx) + call swiftest_util_copy_particle_info_arr(keeps, discards, idx) if (ldestructive) then if (nkeep > 0) then deallocate(idx) allocate(idx(nkeep)) allocate(tmp(nkeep)) idx(:) = pack([(i, i = 1, nlist)], .not. lspill_list) - call util_copy_particle_info_arr(keeps, tmp, idx) + call swiftest_util_copy_particle_info_arr(keeps, tmp, idx) call move_alloc(tmp, keeps) else deallocate(keeps) @@ -4655,32 +4661,32 @@ module subroutine swiftest_util_spill_body(self, discards, lspill_list, ldestruc !> Spill all the common components associate(keeps => self) - call util_spill(keeps%id, discards%id, lspill_list, ldestructive) - call util_spill(keeps%info, discards%info, lspill_list, ldestructive) - call util_spill(keeps%lmask, discards%lmask, lspill_list, ldestructive) - call util_spill(keeps%status, discards%status, lspill_list, ldestructive) - call util_spill(keeps%ldiscard, discards%ldiscard, lspill_list, ldestructive) - call util_spill(keeps%lcollision, discards%lcollision, lspill_list, ldestructive) - call util_spill(keeps%lencounter, discards%lencounter, lspill_list, ldestructive) - call util_spill(keeps%mu, discards%mu, 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%rb, discards%rb, lspill_list, ldestructive) - call util_spill(keeps%vb, discards%vb, lspill_list, ldestructive) - call util_spill(keeps%ah, discards%ah, lspill_list, ldestructive) - call util_spill(keeps%aobl, discards%aobl, lspill_list, ldestructive) - call util_spill(keeps%agr, discards%agr, lspill_list, ldestructive) - call util_spill(keeps%atide, discards%atide, lspill_list, ldestructive) - call util_spill(keeps%ir3h, discards%ir3h, lspill_list, ldestructive) - call util_spill(keeps%isperi, discards%isperi, lspill_list, ldestructive) - call util_spill(keeps%peri, discards%peri, lspill_list, ldestructive) - call util_spill(keeps%atp, discards%atp, lspill_list, ldestructive) - call util_spill(keeps%a, discards%a, lspill_list, ldestructive) - call util_spill(keeps%e, discards%e, lspill_list, ldestructive) - call util_spill(keeps%inc, discards%inc, lspill_list, ldestructive) - call util_spill(keeps%capom, discards%capom, lspill_list, ldestructive) - call util_spill(keeps%omega, discards%omega, lspill_list, ldestructive) - call util_spill(keeps%capm, discards%capm, lspill_list, ldestructive) + call swiftest_util_spill(keeps%id, discards%id, lspill_list, ldestructive) + call swiftest_util_spill(keeps%info, discards%info, lspill_list, ldestructive) + call swiftest_util_spill(keeps%lmask, discards%lmask, lspill_list, ldestructive) + call swiftest_util_spill(keeps%status, discards%status, lspill_list, ldestructive) + call swiftest_util_spill(keeps%ldiscard, discards%ldiscard, lspill_list, ldestructive) + call swiftest_util_spill(keeps%lcollision, discards%lcollision, lspill_list, ldestructive) + call swiftest_util_spill(keeps%lencounter, discards%lencounter, lspill_list, ldestructive) + call swiftest_util_spill(keeps%mu, discards%mu, lspill_list, ldestructive) + call swiftest_util_spill(keeps%rh, discards%rh, lspill_list, ldestructive) + call swiftest_util_spill(keeps%vh, discards%vh, lspill_list, ldestructive) + call swiftest_util_spill(keeps%rb, discards%rb, lspill_list, ldestructive) + call swiftest_util_spill(keeps%vb, discards%vb, lspill_list, ldestructive) + call swiftest_util_spill(keeps%ah, discards%ah, lspill_list, ldestructive) + call swiftest_util_spill(keeps%aobl, discards%aobl, lspill_list, ldestructive) + call swiftest_util_spill(keeps%agr, discards%agr, lspill_list, ldestructive) + call swiftest_util_spill(keeps%atide, discards%atide, lspill_list, ldestructive) + call swiftest_util_spill(keeps%ir3h, discards%ir3h, lspill_list, ldestructive) + call swiftest_util_spill(keeps%isperi, discards%isperi, lspill_list, ldestructive) + call swiftest_util_spill(keeps%peri, discards%peri, lspill_list, ldestructive) + call swiftest_util_spill(keeps%atp, discards%atp, lspill_list, ldestructive) + call swiftest_util_spill(keeps%a, discards%a, lspill_list, ldestructive) + call swiftest_util_spill(keeps%e, discards%e, lspill_list, ldestructive) + call swiftest_util_spill(keeps%inc, discards%inc, lspill_list, ldestructive) + call swiftest_util_spill(keeps%capom, discards%capom, lspill_list, ldestructive) + call swiftest_util_spill(keeps%omega, discards%omega, lspill_list, ldestructive) + call swiftest_util_spill(keeps%capm, discards%capm, lspill_list, ldestructive) nbody_old = keeps%nbody @@ -4710,28 +4716,28 @@ module subroutine swiftest_util_spill_pl(self, discards, lspill_list, ldestructi select type (discards) ! The standard requires us to select the type of both arguments in order to access all the components class is (swiftest_pl) !> Spill components specific to the massive body class - call util_spill(keeps%mass, discards%mass, lspill_list, ldestructive) - call util_spill(keeps%Gmass, discards%Gmass, lspill_list, ldestructive) - call util_spill(keeps%rhill, discards%rhill, lspill_list, ldestructive) - call util_spill(keeps%renc, discards%renc, lspill_list, ldestructive) - call util_spill(keeps%radius, discards%radius, lspill_list, ldestructive) - call util_spill(keeps%density, discards%density, lspill_list, ldestructive) - call util_spill(keeps%rbeg, discards%rbeg, lspill_list, ldestructive) - call util_spill(keeps%rend, discards%rend, lspill_list, ldestructive) - call util_spill(keeps%vbeg, discards%vbeg, lspill_list, ldestructive) - call util_spill(keeps%Ip, discards%Ip, lspill_list, ldestructive) - call util_spill(keeps%rot, discards%rot, lspill_list, ldestructive) - call util_spill(keeps%k2, discards%k2, lspill_list, ldestructive) - call util_spill(keeps%Q, discards%Q, lspill_list, ldestructive) - call util_spill(keeps%tlag, discards%tlag, lspill_list, ldestructive) - call util_spill(keeps%kin, discards%kin, lspill_list, ldestructive) - call util_spill(keeps%lmtiny, discards%lmtiny, lspill_list, ldestructive) - call util_spill(keeps%nplenc, discards%nplenc, lspill_list, ldestructive) - call util_spill(keeps%ntpenc, discards%ntpenc, lspill_list, ldestructive) + call swiftest_util_spill(keeps%mass, discards%mass, lspill_list, ldestructive) + call swiftest_util_spill(keeps%Gmass, discards%Gmass, lspill_list, ldestructive) + call swiftest_util_spill(keeps%rhill, discards%rhill, lspill_list, ldestructive) + call swiftest_util_spill(keeps%renc, discards%renc, lspill_list, ldestructive) + call swiftest_util_spill(keeps%radius, discards%radius, lspill_list, ldestructive) + call swiftest_util_spill(keeps%density, discards%density, lspill_list, ldestructive) + call swiftest_util_spill(keeps%rbeg, discards%rbeg, lspill_list, ldestructive) + call swiftest_util_spill(keeps%rend, discards%rend, lspill_list, ldestructive) + call swiftest_util_spill(keeps%vbeg, discards%vbeg, lspill_list, ldestructive) + call swiftest_util_spill(keeps%Ip, discards%Ip, lspill_list, ldestructive) + call swiftest_util_spill(keeps%rot, discards%rot, lspill_list, ldestructive) + call swiftest_util_spill(keeps%k2, discards%k2, lspill_list, ldestructive) + call swiftest_util_spill(keeps%Q, discards%Q, lspill_list, ldestructive) + call swiftest_util_spill(keeps%tlag, discards%tlag, lspill_list, ldestructive) + call swiftest_util_spill(keeps%kin, discards%kin, lspill_list, ldestructive) + call swiftest_util_spill(keeps%lmtiny, discards%lmtiny, lspill_list, ldestructive) + call swiftest_util_spill(keeps%nplenc, discards%nplenc, lspill_list, ldestructive) + call swiftest_util_spill(keeps%ntpenc, discards%ntpenc, lspill_list, ldestructive) if (ldestructive .and. allocated(keeps%k_plpl)) deallocate(keeps%k_plpl) - call util_spill_body(keeps, discards, lspill_list, ldestructive) + call swiftest_util_spill_body(keeps, discards, lspill_list, ldestructive) class default write(*,*) 'Error! spill method called for incompatible return type on swiftest_pl' end select @@ -4757,8 +4763,8 @@ module subroutine swiftest_util_spill_tp(self, discards, lspill_list, ldestructi select type(discards) class is (swiftest_tp) !> Spill components specific to the test particle class - call util_spill(keeps%nplenc, discards%nplenc, lspill_list, ldestructive) - call util_spill_body(keeps, discards, lspill_list, ldestructive) + call swiftest_util_spill(keeps%nplenc, discards%nplenc, lspill_list, ldestructive) + call swiftest_util_spill_body(keeps, discards, lspill_list, ldestructive) class default write(*,*) 'Error! spill method called for incompatible return type on swiftest_tp' end select @@ -4857,12 +4863,12 @@ module subroutine swiftest_util_valid_id_system(self, param) do i = 1, ntp idarr(1+npl+i) = tp%id(i) end do - call util_sort(idarr) + call swiftest_util_sort(idarr) do i = 1, npl + ntp if (idarr(i) == idarr(i+1)) then write(*, *) "Swiftest error:" write(*, *) " more than one body/particle has id = ", idarr(i) - call util_exit(FAILURE) + call swiftest_util_exit(FAILURE) end if end do param%maxid = max(param%maxid, maxval(idarr)) diff --git a/src/symba/symba_discard.f90 b/src/symba/symba_discard.f90 index a14911daa..5cdf5eab5 100644 --- a/src/symba/symba_discard.f90 +++ b/src/symba/symba_discard.f90 @@ -225,26 +225,23 @@ subroutine symba_discard_nonplpl(pl, system, param) class(symba_pl), allocatable :: plsub ! First check for collisions with the central body - associate(npl => pl%nbody, cb => system%cb) + associate(npl => pl%nbody, cb => system%cb, pl_discards => system%pl_discards) if (npl == 0) return - select type(pl_discards => system%pl_discards) - class is (symba_merger) - if ((param%rmin >= 0.0_DP) .or. (param%rmax >= 0.0_DP) .or. (param%rmaxu >= 0.0_DP)) then - call symba_discard_cb_pl(pl, system, param) - end if - if (param%qmin >= 0.0_DP) call symba_discard_peri_pl(pl, system, param) - if (any(pl%ldiscard(1:npl))) then - ldiscard(1:npl) = pl%ldiscard(1:npl) - - allocate(plsub, mold=pl) - call pl%spill(plsub, ldiscard, ldestructive=.false.) - nsub = plsub%nbody - nstart = pl_discards%nbody + 1 - nend = pl_discards%nbody + nsub - call pl_discards%append(plsub, lsource_mask=[(.true., i = 1, nsub)]) - - end if - end select + if ((param%rmin >= 0.0_DP) .or. (param%rmax >= 0.0_DP) .or. (param%rmaxu >= 0.0_DP)) then + call symba_discard_cb_pl(pl, system, param) + end if + if (param%qmin >= 0.0_DP) call symba_discard_peri_pl(pl, system, param) + if (any(pl%ldiscard(1:npl))) then + ldiscard(1:npl) = pl%ldiscard(1:npl) + + allocate(plsub, mold=pl) + call pl%spill(plsub, ldiscard, ldestructive=.false.) + nsub = plsub%nbody + nstart = pl_discards%nbody + 1 + nend = pl_discards%nbody + nsub + call pl_discards%append(plsub, lsource_mask=[(.true., i = 1, nsub)]) + + end if end associate return diff --git a/src/symba/symba_encounter_check.f90 b/src/symba/symba_encounter_check.f90 index eb05f0664..d0fc96990 100644 --- a/src/symba/symba_encounter_check.f90 +++ b/src/symba/symba_encounter_check.f90 @@ -87,16 +87,9 @@ module function symba_encounter_check_pl(self, param, system, dt, irec) result(l end function symba_encounter_check_pl - module function symba_encounter_io_netcdf_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 plplenc and pltpenc list. - !! Note: This method works for the polymorphic pltp_encounter and plpl_encounter types. - !! - !! Adapted from portions of David E. Kaufmann's Swifter routine: symba_step_recur.f90 + module function symba_encounter_check_list_plpl(self, param, system, dt, irec) result(lany_encounter) implicit none - ! Arguments - class(symba_encounter), intent(inout) :: self !! SyMBA pl-pl encounter list object + class(symba_list_plpl), intent(inout) :: self !! SyMBA pl-pl encounter list object class(swiftest_parameters), intent(inout) :: param !! Current swiftest run configuration parameters class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object real(DP), intent(in) :: dt !! step size @@ -105,7 +98,6 @@ module function symba_encounter_io_netcdf_check(self, param, system, dt, irec) r ! Internals integer(I4B) :: i, j, k, lidx, nenc_enc real(DP), dimension(NDIM) :: xr, vr - logical :: isplpl real(DP) :: rlim2, rji2, rcrit12 logical, dimension(:), allocatable :: lencmask, lencounter integer(I4B), dimension(:), allocatable :: eidx @@ -113,84 +105,125 @@ module function symba_encounter_io_netcdf_check(self, param, system, dt, irec) r lany_encounter = .false. if (self%nenc == 0) return - select type(self) - class is (plpl_encounter) - isplpl = .true. - class is (pltp_encounter) - isplpl = .false. + select type(pl => system%pl) + class is (symba_pl) + allocate(lencmask(self%nenc)) + lencmask(:) = (self%status(1:self%nenc) == ACTIVE) .and. (self%level(1:self%nenc) == irec - 1) + nenc_enc = count(lencmask(:)) + if (nenc_enc == 0) return + + call pl%set_renc(irec) + + allocate(eidx(nenc_enc)) + allocate(lencounter(nenc_enc)) + eidx(:) = pack([(k, k = 1, self%nenc)], lencmask(:)) + lencounter(:) = .false. + + do concurrent(lidx = 1:nenc_enc) + k = eidx(lidx) + i = self%index1(k) + j = self%index2(k) + xr(:) = pl%rh(:,j) - pl%rh(:,i) + vr(:) = pl%vb(:,j) - pl%vb(:,i) + rcrit12 = pl%renc(i) + pl%renc(j) + call encounter_check_one(xr(1), xr(2), xr(3), vr(1), vr(2), vr(3), rcrit12, dt, lencounter(lidx), self%lvdotr(k)) + if (lencounter(lidx)) then + rlim2 = (pl%radius(i) + pl%radius(j))**2 + rji2 = dot_product(xr(:), xr(:))! Check to see if these are physically overlapping bodies first, which we should ignore + lencounter(lidx) = rji2 > rlim2 + end if + end do + + lany_encounter = any(lencounter(:)) + if (lany_encounter) then + nenc_enc = count(lencounter(:)) + eidx(1:nenc_enc) = pack(eidx(:), lencounter(:)) + do lidx = 1, nenc_enc + k = eidx(lidx) + i = self%index1(k) + j = self%index2(k) + pl%levelg(i) = irec + pl%levelm(i) = MAX(irec, pl%levelm(i)) + pl%levelg(j) = irec + pl%levelm(j) = MAX(irec, pl%levelm(j)) + self%level(k) = irec + end do + end if end select + return + end function symba_encounter_check_list_plpl + + + module function symba_encounter_check_list_pltp(self, param, system, dt, irec) result(lany_encounter) + implicit none + class(symba_list_pltp), intent(inout) :: self !! SyMBA pl-tp encounter list object + class(swiftest_parameters), intent(inout) :: param !! Current swiftest run configuration parameters + class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object + real(DP), intent(in) :: dt !! step size + integer(I4B), intent(in) :: irec !! Current recursion level + logical :: lany_encounter !! Returns true if there is at least one close encounter + ! Internals + integer(I4B) :: i, j, k, lidx, nenc_enc + real(DP), dimension(NDIM) :: xr, vr + real(DP) :: rlim2, rji2 + logical, dimension(:), allocatable :: lencmask, lencounter + integer(I4B), dimension(:), allocatable :: eidx + + lany_encounter = .false. + if (self%nenc == 0) return + select type(pl => system%pl) class is (symba_pl) - select type(tp => system%tp) - class is (symba_tp) - allocate(lencmask(self%nenc)) - lencmask(:) = (self%status(1:self%nenc) == ACTIVE) .and. (self%level(1:self%nenc) == irec - 1) - nenc_enc = count(lencmask(:)) - if (nenc_enc == 0) return - - call pl%set_renc(irec) - - allocate(eidx(nenc_enc)) - allocate(lencounter(nenc_enc)) - eidx(:) = pack([(k, k = 1, self%nenc)], lencmask(:)) - lencounter(:) = .false. - if (isplpl) then - do concurrent(lidx = 1:nenc_enc) - k = eidx(lidx) - i = self%index1(k) - j = self%index2(k) - xr(:) = pl%rh(:,j) - pl%rh(:,i) - vr(:) = pl%vb(:,j) - pl%vb(:,i) - rcrit12 = pl%renc(i) + pl%renc(j) - call encounter_check_one(xr(1), xr(2), xr(3), vr(1), vr(2), vr(3), rcrit12, dt, lencounter(lidx), self%lvdotr(k)) - if (lencounter(lidx)) then - rlim2 = (pl%radius(i) + pl%radius(j))**2 - rji2 = dot_product(xr(:), xr(:))! Check to see if these are physically overlapping bodies first, which we should ignore - lencounter(lidx) = rji2 > rlim2 - end if - end do - else - do concurrent(lidx = 1:nenc_enc) - k = eidx(lidx) - i = self%index1(k) - j = self%index2(k) - xr(:) = tp%rh(:,j) - pl%rh(:,i) - vr(:) = tp%vb(:,j) - pl%vb(:,i) - call encounter_check_one(xr(1), xr(2), xr(3), vr(1), vr(2), vr(3), pl%renc(i), dt, & - lencounter(lidx), self%lvdotr(k)) - if (lencounter(lidx)) then - rlim2 = (pl%radius(i))**2 - rji2 = dot_product(xr(:), xr(:))! Check to see if these are physically overlapping bodies first, which we should ignore - lencounter(lidx) = rji2 > rlim2 - end if - end do + select type(tp => system%tp) + class is (symba_tp) + allocate(lencmask(self%nenc)) + lencmask(:) = (self%status(1:self%nenc) == ACTIVE) .and. (self%level(1:self%nenc) == irec - 1) + nenc_enc = count(lencmask(:)) + if (nenc_enc == 0) return + + call pl%set_renc(irec) + + allocate(eidx(nenc_enc)) + allocate(lencounter(nenc_enc)) + eidx(:) = pack([(k, k = 1, self%nenc)], lencmask(:)) + lencounter(:) = .false. + + do concurrent(lidx = 1:nenc_enc) + k = eidx(lidx) + i = self%index1(k) + j = self%index2(k) + xr(:) = tp%rh(:,j) - pl%rh(:,i) + vr(:) = tp%vb(:,j) - pl%vb(:,i) + call encounter_check_one(xr(1), xr(2), xr(3), vr(1), vr(2), vr(3), pl%renc(i), dt, & + lencounter(lidx), self%lvdotr(k)) + if (lencounter(lidx)) then + rlim2 = (pl%radius(i))**2 + rji2 = dot_product(xr(:), xr(:))! Check to see if these are physically overlapping bodies first, which we should ignore + lencounter(lidx) = rji2 > rlim2 end if - lany_encounter = any(lencounter(:)) - if (lany_encounter) then - nenc_enc = count(lencounter(:)) - eidx(1:nenc_enc) = pack(eidx(:), lencounter(:)) - do lidx = 1, nenc_enc - k = eidx(lidx) - i = self%index1(k) - j = self%index2(k) - pl%levelg(i) = irec - pl%levelm(i) = MAX(irec, pl%levelm(i)) - if (isplpl) then - pl%levelg(j) = irec - pl%levelm(j) = MAX(irec, pl%levelm(j)) - else - tp%levelg(j) = irec - tp%levelm(j) = MAX(irec, tp%levelm(j)) - end if - self%level(k) = irec - end do - end if - end select + end do + + lany_encounter = any(lencounter(:)) + if (lany_encounter) then + nenc_enc = count(lencounter(:)) + eidx(1:nenc_enc) = pack(eidx(:), lencounter(:)) + do lidx = 1, nenc_enc + k = eidx(lidx) + i = self%index1(k) + j = self%index2(k) + pl%levelg(i) = irec + pl%levelm(i) = MAX(irec, pl%levelm(i)) + tp%levelg(j) = irec + tp%levelm(j) = MAX(irec, tp%levelm(j)) + self%level(k) = irec + end do + end if + end select end select return - end function symba_encounter_check + end function symba_encounter_check_list_pltp module function symba_encounter_check_tp(self, param, system, dt, irec) result(lany_encounter) diff --git a/src/symba/symba_kick.f90 b/src/symba/symba_kick.f90 index 03b72c143..80d3ccbc2 100644 --- a/src/symba/symba_kick.f90 +++ b/src/symba/symba_kick.f90 @@ -23,33 +23,33 @@ module subroutine symba_kick_getacch_int_pl(self, param) class(symba_pl), intent(inout) :: self !! SyMBA massive body object class(swiftest_parameters), intent(inout) :: param !! Current swiftest run configuration parameter ! Internals - type(interaction_timer), save :: itimer - logical, save :: lfirst = .true. - - if (param%ladaptive_interactions) then - if (self%nplplm > 0) then - if (lfirst) then - write(itimer%loopname, *) "symba_kick_getacch_int_pl" - write(itimer%looptype, *) "INTERACTION" - call itimer%time_this_loop(param, self%nplplm, self) - lfirst = .false. - else - if (itimer%io_netcdf_check(param, self%nplplm)) call itimer%time_this_loop(param, self%nplplm, self) - end if - else - param%lflatten_interactions = .false. - end if - end if - - if (param%lflatten_interactions) then - call swiftest_kick_getacch_int_all_flat_pl(self%nbody, self%nplplm, self%k_plpl, self%rh, self%Gmass, self%radius, self%ah) - else + ! type(interaction_timer), save :: itimer + ! logical, save :: lfirst = .true. + + ! if (param%ladaptive_interactions) then + ! if (self%nplplm > 0) then + ! if (lfirst) then + ! write(itimer%loopname, *) "symba_kick_getacch_int_pl" + ! write(itimer%looptype, *) "INTERACTION" + ! call itimer%time_this_loop(param, self%nplplm, self) + ! lfirst = .false. + ! else + ! if (itimer%io_netcdf_check(param, self%nplplm)) call itimer%time_this_loop(param, self%nplplm, self) + ! end if + ! else + ! param%lflatten_interactions = .false. + ! end if + ! end if + + ! if (param%lflatten_interactions) then + ! call swiftest_kick_getacch_int_all_flat_pl(self%nbody, self%nplplm, self%k_plpl, self%rh, self%Gmass, self%radius, self%ah) + ! else call swiftest_kick_getacch_int_all_triangular_pl(self%nbody, self%nplm, self%rh, self%Gmass, self%radius, self%ah) - end if + ! end if - if (param%ladaptive_interactions .and. self%nplplm > 0) then - if (itimer%is_on) call itimer%adapt(param, self%nplplm, self) - end if + ! if (param%ladaptive_interactions .and. self%nplplm > 0) then + ! if (itimer%is_on) call itimer%adapt(param, self%nplplm, self) + ! end if return end subroutine symba_kick_getacch_int_pl @@ -144,17 +144,16 @@ module subroutine symba_kick_getacch_tp(self, system, param, t, lbeg) end subroutine symba_kick_getacch_tp - module subroutine symba_kick_encounter(self, system, dt, irec, sgn) + module subroutine symba_kick_list_plpl(self, system, dt, irec, sgn) !! author: David A. Minton !! - !! Kick barycentric velocities of massive bodies and ACTIVE test particles within SyMBA recursion. - !! Note: This method works for the polymorphic pltp_encounter and plpl_encounter types + !! Kick barycentric velocities of massive bodies within SyMBA recursion. !! !! Adapted from David E. Kaufmann's Swifter routine: symba_kick.f90 !! Adapted from Hal Levison's Swift routine symba5_kick.f implicit none ! Arguments - class(symba_encounter), intent(in) :: self !! SyMBA pl-tp encounter list object + class(symba_list_plpl), intent(in) :: self !! SyMBA pl-tp encounter list object class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object real(DP), intent(in) :: dt !! step size integer(I4B), intent(in) :: irec !! Current recursion level @@ -164,130 +163,195 @@ module subroutine symba_kick_encounter(self, system, dt, irec, sgn) integer(I8B) :: k real(DP) :: r, rr, ri, ris, rim1, r2, ir3, fac, faci, facj real(DP), dimension(NDIM) :: dx - logical :: isplpl logical, dimension(:), allocatable :: lgoodlevel integer(I4B), dimension(:), allocatable :: good_idx if (self%nenc == 0) return - select type(self) - class is (plpl_encounter) - isplpl = .true. - class is (pltp_encounter) - isplpl = .false. - end select select type(pl => system%pl) class is (symba_pl) - select type(tp => system%tp) - class is (symba_tp) - associate(npl => pl%nbody, ntp => tp%nbody, nenc => self%nenc) - if (npl == 0) return - pl%lmask(1:npl) = pl%status(1:npl) /= INACTIVE - if (.not. isplpl) then - if (ntp == 0) return - tp%lmask(1:ntp) = tp%status(1:ntp) /= INACTIVE - end if - allocate(lgoodlevel(nenc)) + associate(npl => pl%nbody, nenc => self%nenc) + if (npl == 0) return + pl%lmask(1:npl) = pl%status(1:npl) /= INACTIVE + allocate(lgoodlevel(nenc)) - irm1 = irec - 1 + irm1 = irec - 1 - if (sgn < 0) then - irecl = irec - 1 - else - irecl = irec - end if + if (sgn < 0) then + irecl = irec - 1 + else + irecl = irec + end if - do k = 1, nenc - i = self%index1(k) - j = self%index2(k) - if (isplpl) then - lgoodlevel(k) = (pl%levelg(i) >= irm1) .and. (pl%levelg(j) >= irm1) + do k = 1, nenc + i = self%index1(k) + j = self%index2(k) + lgoodlevel(k) = (pl%levelg(i) >= irm1) .and. (pl%levelg(j) >= irm1) + lgoodlevel(k) = (self%status(k) == ACTIVE) .and. lgoodlevel(k) + end do + ngood = count(lgoodlevel(:)) + if (ngood > 0_I8B) then + allocate(good_idx(ngood)) + good_idx(:) = pack([(i, i = 1, nenc)], lgoodlevel(:)) + + do concurrent (k = 1:ngood) + i = self%index1(good_idx(k)) + j = self%index2(good_idx(k)) + pl%ah(:,i) = 0.0_DP + pl%ah(:,j) = 0.0_DP + end do + + do k = 1, ngood + i = self%index1(good_idx(k)) + j = self%index2(good_idx(k)) + ri = ((pl%rhill(i) + pl%rhill(j))**2) * (RHSCALE**2) * (RSHELL**(2*irecl)) + rim1 = ri * (RSHELL**2) + dx(:) = pl%rh(:,j) - pl%rh(:,i) + + r2 = dot_product(dx(:), dx(:)) + if (r2 < rim1) then + fac = 0.0_DP + lgoodlevel(good_idx(k)) = .false. + cycle + end if + if (r2 < ri) then + ris = sqrt(ri) + r = sqrt(r2) + rr = (ris - r) / (ris * (1.0_DP - RSHELL)) + fac = (r2**(-1.5_DP)) * (1.0_DP - 3 * (rr**2) + 2 * (rr**3)) else - lgoodlevel(k) = (pl%levelg(i) >= irm1) .and. (tp%levelg(j) >= irm1) + ir3 = 1.0_DP / (r2 * sqrt(r2)) + fac = ir3 end if - lgoodlevel(k) = (self%status(k) == ACTIVE) .and. lgoodlevel(k) + faci = fac * pl%Gmass(i) + facj = fac * pl%Gmass(j) + pl%ah(:, i) = pl%ah(:, i) + facj * dx(:) + pl%ah(:, j) = pl%ah(:, j) - faci * dx(:) end do ngood = count(lgoodlevel(:)) - if (ngood > 0_I8B) then - allocate(good_idx(ngood)) - good_idx(:) = pack([(i, i = 1, nenc)], lgoodlevel(:)) - - if (isplpl) then - do concurrent (k = 1:ngood) - i = self%index1(good_idx(k)) - j = self%index2(good_idx(k)) - pl%ah(:,i) = 0.0_DP - pl%ah(:,j) = 0.0_DP - end do - else - do concurrent (k = 1_I8B:ngood) - j = self%index2(good_idx(k)) - tp%ah(:,j) = 0.0_DP - end do - end if + if (ngood == 0_I8B) return + good_idx(1:ngood) = pack([(i, i = 1, nenc)], lgoodlevel(:)) + + do k = 1, ngood + i = self%index1(good_idx(k)) + j = self%index2(good_idx(k)) + pl%vb(:,i) = pl%vb(:,i) + sgn * dt * pl%ah(:,i) + pl%vb(:,j) = pl%vb(:,j) + sgn * dt * pl%ah(:,j) + pl%ah(:,i) = 0.0_DP + pl%ah(:,j) = 0.0_DP + end do + + end if + end associate + end select + + return + end subroutine symba_kick_list_plpl + + + module subroutine symba_kick_list_pltp(self, system, dt, irec, sgn) + !! author: David A. Minton + !! + !! Kick barycentric velocities of ACTIVE test particles within SyMBA recursion. + !! + !! Adapted from David E. Kaufmann's Swifter routine: symba_kick.f90 + !! Adapted from Hal Levison's Swift routine symba5_kick.f + implicit none + ! Arguments + class(symba_list_pltp), intent(in) :: self !! SyMBA pl-tp encounter list object + class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object + real(DP), intent(in) :: dt !! step size + integer(I4B), intent(in) :: irec !! Current recursion level + integer(I4B), intent(in) :: sgn !! sign to be applied to acceleration + ! Internals + integer(I4B) :: i, j, irm1, irecl, ngood + integer(I8B) :: k + real(DP) :: r, rr, ri, ris, rim1, r2, ir3, fac, faci + real(DP), dimension(NDIM) :: dx + logical, dimension(:), allocatable :: lgoodlevel + integer(I4B), dimension(:), allocatable :: good_idx + + if (self%nenc == 0) return + + select type(pl => system%pl) + class is (symba_pl) + select type(tp => system%tp) + class is (symba_tp) + associate(npl => pl%nbody, ntp => tp%nbody, nenc => self%nenc) + if ((npl == 0) .or. (ntp == 0)) return + pl%lmask(1:npl) = pl%status(1:npl) /= INACTIVE + tp%lmask(1:ntp) = tp%status(1:ntp) /= INACTIVE + allocate(lgoodlevel(nenc)) + + irm1 = irec - 1 + + if (sgn < 0) then + irecl = irec - 1 + else + irecl = irec + end if + + do k = 1, nenc + i = self%index1(k) + j = self%index2(k) + lgoodlevel(k) = (pl%levelg(i) >= irm1) .and. (tp%levelg(j) >= irm1) + lgoodlevel(k) = (self%status(k) == ACTIVE) .and. lgoodlevel(k) + end do + + ngood = count(lgoodlevel(:)) + + if (ngood > 0_I8B) then + allocate(good_idx(ngood)) + good_idx(:) = pack([(i, i = 1, nenc)], lgoodlevel(:)) - do k = 1, ngood - i = self%index1(good_idx(k)) - j = self%index2(good_idx(k)) - if (isplpl) then - ri = ((pl%rhill(i) + pl%rhill(j))**2) * (RHSCALE**2) * (RSHELL**(2*irecl)) - rim1 = ri * (RSHELL**2) - dx(:) = pl%rh(:,j) - pl%rh(:,i) - else - ri = ((pl%rhill(i))**2) * (RHSCALE**2) * (RSHELL**(2*irecl)) - rim1 = ri * (RSHELL**2) - dx(:) = tp%rh(:,j) - pl%rh(:,i) - end if - r2 = dot_product(dx(:), dx(:)) - if (r2 < rim1) then - fac = 0.0_DP - lgoodlevel(good_idx(k)) = .false. - cycle - end if - if (r2 < ri) then - ris = sqrt(ri) - r = sqrt(r2) - rr = (ris - r) / (ris * (1.0_DP - RSHELL)) - fac = (r2**(-1.5_DP)) * (1.0_DP - 3 * (rr**2) + 2 * (rr**3)) - else - ir3 = 1.0_DP / (r2 * sqrt(r2)) - fac = ir3 - end if - faci = fac * pl%Gmass(i) - if (isplpl) then - facj = fac * pl%Gmass(j) - pl%ah(:, i) = pl%ah(:, i) + facj * dx(:) - pl%ah(:, j) = pl%ah(:, j) - faci * dx(:) - else - tp%ah(:, j) = tp%ah(:, j) - faci * dx(:) - end if - end do - ngood = count(lgoodlevel(:)) - if (ngood == 0_I8B) return - good_idx(1:ngood) = pack([(i, i = 1, nenc)], lgoodlevel(:)) - - if (isplpl) then - do k = 1, ngood - i = self%index1(good_idx(k)) - j = self%index2(good_idx(k)) - pl%vb(:,i) = pl%vb(:,i) + sgn * dt * pl%ah(:,i) - pl%vb(:,j) = pl%vb(:,j) + sgn * dt * pl%ah(:,j) - pl%ah(:,i) = 0.0_DP - pl%ah(:,j) = 0.0_DP - end do + + do concurrent (k = 1_I8B:ngood) + j = self%index2(good_idx(k)) + tp%ah(:,j) = 0.0_DP + end do + + do k = 1, ngood + i = self%index1(good_idx(k)) + j = self%index2(good_idx(k)) + + ri = ((pl%rhill(i))**2) * (RHSCALE**2) * (RSHELL**(2*irecl)) + rim1 = ri * (RSHELL**2) + dx(:) = tp%rh(:,j) - pl%rh(:,i) + r2 = dot_product(dx(:), dx(:)) + if (r2 < rim1) then + fac = 0.0_DP + lgoodlevel(good_idx(k)) = .false. + cycle + end if + if (r2 < ri) then + ris = sqrt(ri) + r = sqrt(r2) + rr = (ris - r) / (ris * (1.0_DP - RSHELL)) + fac = (r2**(-1.5_DP)) * (1.0_DP - 3 * (rr**2) + 2 * (rr**3)) else - do k = 1, ngood - j = self%index2(good_idx(k)) - tp%vb(:,j) = tp%vb(:,j) + sgn * dt * tp%ah(:,j) - tp%ah(:,j) = 0.0_DP - end do + ir3 = 1.0_DP / (r2 * sqrt(r2)) + fac = ir3 end if - end if - end associate - end select + faci = fac * pl%Gmass(i) + + tp%ah(:, j) = tp%ah(:, j) - faci * dx(:) + end do + ngood = count(lgoodlevel(:)) + if (ngood == 0_I8B) return + good_idx(1:ngood) = pack([(i, i = 1, nenc)], lgoodlevel(:)) + + do k = 1, ngood + j = self%index2(good_idx(k)) + tp%vb(:,j) = tp%vb(:,j) + sgn * dt * tp%ah(:,j) + tp%ah(:,j) = 0.0_DP + end do + end if + end associate + end select end select return - end subroutine symba_kick_encounter + end subroutine symba_kick_list_pltp + end submodule s_symba_kick \ No newline at end of file diff --git a/src/symba/symba_setup.f90 b/src/symba/symba_setup.f90 index efd60f636..0431da5ef 100644 --- a/src/symba/symba_setup.f90 +++ b/src/symba/symba_setup.f90 @@ -70,31 +70,6 @@ module subroutine symba_setup_pl(self, n, param) end subroutine symba_setup_pl - module subroutine symba_setup_encounter_list(self, n) - !! author: David A. Minton - !! - !! A constructor that sets the number of encounters and allocates and initializes all arrays - !! - implicit none - ! Arguments - class(symba_encounter), intent(inout) :: self !! SyMBA pl-tp encounter structure - integer(I8B), intent(in) :: n !! Number of encounters to allocate space for - - call encounter_setup_list(self, n) - if (n <= 0_I8B) return - - if (allocated(self%level)) deallocate(self%level) - 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 - - module subroutine symba_setup_tp(self, n, param) !! author: David A. Minton !! diff --git a/src/symba/symba_step.f90 b/src/symba/symba_step.f90 index d51f66d89..0c4ff41f2 100644 --- a/src/symba/symba_step.f90 +++ b/src/symba/symba_step.f90 @@ -198,7 +198,7 @@ recursive module subroutine symba_step_recur_system(self, param, t, ireci) write(*, *) "SWIFTEST Warning:" write(*, *) " In symba_step_recur_system, local time step is too small" write(*, *) " Roundoff error will be important!" - call util_exit(FAILURE) + call swiftest_util_exit(FAILURE) END IF irecp = ireci + 1 if (ireci == 0) then diff --git a/src/symba/symba_util.f90 b/src/symba/symba_util.f90 index f4b143c3d..bf749a35e 100644 --- a/src/symba/symba_util.f90 +++ b/src/symba/symba_util.f90 @@ -11,32 +11,6 @@ use swiftest contains - - module subroutine symba_util_append_encounter_list(self, source, lsource_mask) - !! author: David A. Minton - !! - !! Append components from one encounter list (pl-pl or pl-tp) body object to another. - !! This method will automatically resize the destination body if it is too small - implicit none - ! Arguments - class(symba_encounter), intent(inout) :: self !! SyMBA encounter list object - class(encounter_list), intent(in) :: source !! Source object to append - logical, dimension(:), intent(in) :: lsource_mask !! Logical mask indicating which elements to append to - ! Internals - integer(I4B) :: nold, nsrc - - nold = self%nenc - nsrc = source%nenc - select type(source) - class is (symba_encounter) - call util_append(self%level, source%level, nold, nsrc, lsource_mask) - end select - call encounter_util_append_list(self, source, lsource_mask) - - return - end subroutine symba_util_append_encounter_list - - module subroutine symba_util_append_pl(self, source, lsource_mask) !! author: David A. Minton !! @@ -51,68 +25,29 @@ module subroutine symba_util_append_pl(self, source, lsource_mask) select type(source) class is (symba_pl) associate(nold => self%nbody, nsrc => source%nbody) - call util_append(self%lcollision, source%lcollision, nold, nsrc, lsource_mask) - call util_append(self%lencounter, source%lencounter, nold, nsrc, lsource_mask) - call util_append(self%lmtiny, source%lmtiny, nold, nsrc, lsource_mask) - call util_append(self%nplenc, source%nplenc, nold, nsrc, lsource_mask) - call util_append(self%ntpenc, source%ntpenc, nold, nsrc, lsource_mask) - call util_append(self%levelg, source%levelg, nold, nsrc, lsource_mask) - call util_append(self%levelm, source%levelm, nold, nsrc, lsource_mask) - call util_append(self%isperi, source%isperi, nold, nsrc, lsource_mask) - call util_append(self%peri, source%peri, nold, nsrc, lsource_mask) - call util_append(self%atp, source%atp, nold, nsrc, lsource_mask) - call util_append(self%kin, source%kin, nold, nsrc, lsource_mask) - - call util_append_pl(self, source, lsource_mask) ! Note: helio_pl does not have its own append method, so we skip back to the base class + call swiftest_util_append(self%lcollision, source%lcollision, nold, nsrc, lsource_mask) + call swiftest_util_append(self%lencounter, source%lencounter, nold, nsrc, lsource_mask) + call swiftest_util_append(self%lmtiny, source%lmtiny, nold, nsrc, lsource_mask) + call swiftest_util_append(self%nplenc, source%nplenc, nold, nsrc, lsource_mask) + call swiftest_util_append(self%ntpenc, source%ntpenc, nold, nsrc, lsource_mask) + call swiftest_util_append(self%levelg, source%levelg, nold, nsrc, lsource_mask) + call swiftest_util_append(self%levelm, source%levelm, nold, nsrc, lsource_mask) + call swiftest_util_append(self%isperi, source%isperi, nold, nsrc, lsource_mask) + call swiftest_util_append(self%peri, source%peri, nold, nsrc, lsource_mask) + call swiftest_util_append(self%atp, source%atp, nold, nsrc, lsource_mask) + call swiftest_util_append(self%kin, source%kin, nold, nsrc, lsource_mask) + + call swiftest_util_append_pl(self, source, lsource_mask) ! Note: helio_pl does not have its own append method, so we skip back to the base class end associate class default write(*,*) "Invalid object passed to the append method. Source must be of class symba_pl or its descendents!" - call util_exit(FAILURE) + call swiftest_util_exit(FAILURE) end select return end subroutine symba_util_append_pl - module subroutine symba_util_append_merger(self, source, lsource_mask) - !! author: David A. Minton - !! - !! Append components from one massive body object to another. - !! This method will automatically resize the destination body if it is too small - implicit none - ! Arguments - class(symba_merger), intent(inout) :: self !! SyMBA massive body object - class(swiftest_body), intent(in) :: source !! Source object to append - logical, dimension(:), intent(in) :: lsource_mask !! Logical mask indicating which elements to append to - ! Internals - integer(I4B), dimension(:), allocatable :: ncomp_tmp !! Temporary placeholder for ncomp incase we are appending a symba_pl object to a symba_merger - integer(I4B) :: nold, nsrc, nnew - - nold = self%nbody - nsrc = source%nbody - nnew = count(lsource_mask) - - select type(source) - class is (symba_merger) - call util_append(self%ncomp, source%ncomp, nold, nsrc, lsource_mask) - call symba_util_append_pl(self, source, lsource_mask) - class is (symba_pl) - allocate(ncomp_tmp, mold=source%id) - ncomp_tmp(:) = 0 - call util_append(self%ncomp, ncomp_tmp, nold, nsrc, lsource_mask) - call symba_util_append_pl(self, source, lsource_mask) - class default - write(*,*) "Invalid object passed to the append method. Source must be of class symba_pl or its descendents!" - call util_exit(FAILURE) - end select - - ! Save the number of appended bodies - self%ncomp(nold+1:nold+nnew) = nnew - - return - end subroutine symba_util_append_merger - - module subroutine symba_util_append_tp(self, source, lsource_mask) !! author: David A. Minton !! @@ -127,77 +62,20 @@ module subroutine symba_util_append_tp(self, source, lsource_mask) select type(source) class is (symba_tp) associate(nold => self%nbody, nsrc => source%nbody) - call util_append(self%nplenc, source%nplenc, nold, nsrc, lsource_mask) - call util_append(self%levelg, source%levelg, nold, nsrc, lsource_mask) - call util_append(self%levelm, source%levelm, nold, nsrc, lsource_mask) + call swiftest_util_append(self%levelg, source%levelg, nold, nsrc, lsource_mask) + call swiftest_util_append(self%levelm, source%levelm, nold, nsrc, lsource_mask) - call util_append_tp(self, source, lsource_mask) ! Note: helio_tp does not have its own append method, so we skip back to the base class + call swiftest_util_append_tp(self, source, lsource_mask) ! Note: helio_tp does not have its own append method, so we skip back to the base class end associate class default write(*,*) "Invalid object passed to the append method. Source must be of class symba_tp or its descendents!" - call util_exit(FAILURE) + call swiftest_util_exit(FAILURE) end select return end subroutine symba_util_append_tp - module subroutine symba_util_copy_encounter_list(self, source) - !! author: David A. Minton - !! - !! Copies elements from the source encounter list into self. - implicit none - ! Arguments - class(symba_encounter), intent(inout) :: self !! Encounter list - class(encounter_list), intent(in) :: source !! Source object to copy into - - select type(source) - class is (symba_encounter) - associate(n => source%nenc) - self%level(1:n) = source%level(1:n) - self%tcollision(1:n) = source%tcollision(1:n) - end associate - end select - - call encounter_util_copy_list(self, source) - - return - end subroutine symba_util_copy_encounter_list - - - module subroutine symba_util_dealloc_encounter_list(self) - !! author: David A. Minton - !! - !! Deallocates all allocatabale arrays - implicit none - ! Argumentse - class(symba_encounter), intent(inout) :: self !! SyMBA encounter list - - if (allocated(self%level)) deallocate(self%level) - if (allocated(self%tcollision)) deallocate(self%tcollision) - - call self%encounter_list%dealloc() - - return - end subroutine symba_util_dealloc_encounter_list - - - module subroutine symba_util_dealloc_merger(self) - !! author: David A. Minton - !! - !! Deallocates all allocatabale arrays - implicit none - ! Arguments - class(symba_merger), intent(inout) :: self !! SyMBA body merger object - - if (allocated(self%ncomp)) deallocate(self%ncomp) - - call self%symba_pl%dealloc() - - return - end subroutine symba_util_dealloc_merger - - module subroutine symba_util_dealloc_pl(self) !! author: David A. Minton !! @@ -252,22 +130,22 @@ module subroutine symba_util_fill_pl(self, inserts, lfill_list) associate(keeps => self) select type(inserts) class is (symba_pl) - call util_fill(keeps%lcollision, inserts%lcollision, lfill_list) - call util_fill(keeps%lencounter, inserts%lencounter, lfill_list) - call util_fill(keeps%lmtiny, inserts%lmtiny, lfill_list) - call util_fill(keeps%nplenc, inserts%nplenc, lfill_list) - call util_fill(keeps%ntpenc, inserts%ntpenc, lfill_list) - call util_fill(keeps%levelg, inserts%levelg, lfill_list) - call util_fill(keeps%levelm, inserts%levelm, lfill_list) - call util_fill(keeps%isperi, inserts%isperi, lfill_list) - call util_fill(keeps%peri, inserts%peri, lfill_list) - call util_fill(keeps%atp, inserts%atp, lfill_list) - call util_fill(keeps%kin, inserts%kin, lfill_list) + call swiftest_util_fill(keeps%lcollision, inserts%lcollision, lfill_list) + call swiftest_util_fill(keeps%lencounter, inserts%lencounter, lfill_list) + call swiftest_util_fill(keeps%lmtiny, inserts%lmtiny, lfill_list) + call swiftest_util_fill(keeps%nplenc, inserts%nplenc, lfill_list) + call swiftest_util_fill(keeps%ntpenc, inserts%ntpenc, lfill_list) + call swiftest_util_fill(keeps%levelg, inserts%levelg, lfill_list) + call swiftest_util_fill(keeps%levelm, inserts%levelm, lfill_list) + call swiftest_util_fill(keeps%isperi, inserts%isperi, lfill_list) + call swiftest_util_fill(keeps%peri, inserts%peri, lfill_list) + call swiftest_util_fill(keeps%atp, inserts%atp, lfill_list) + call swiftest_util_fill(keeps%kin, inserts%kin, lfill_list) - call util_fill_pl(keeps, inserts, lfill_list) ! Note: helio_pl does not have its own fill method, so we skip back to the base class + call swiftest_util_fill_pl(keeps, inserts, lfill_list) ! Note: helio_pl does not have its own fill method, so we skip back to the base class class default write(*,*) "Invalid object passed to the fill method. Source must be of class symba_pl or its descendents!" - call util_exit(FAILURE) + call swiftest_util_exit(FAILURE) end select end associate @@ -290,14 +168,14 @@ module subroutine symba_util_fill_tp(self, inserts, lfill_list) associate(keeps => self) select type(inserts) class is (symba_tp) - call util_fill(keeps%nplenc, inserts%nplenc, lfill_list) - call util_fill(keeps%levelg, inserts%levelg, lfill_list) - call util_fill(keeps%levelm, inserts%levelm, lfill_list) + call swiftest_util_fill(keeps%nplenc, inserts%nplenc, lfill_list) + call swiftest_util_fill(keeps%levelg, inserts%levelg, lfill_list) + call swiftest_util_fill(keeps%levelm, inserts%levelm, lfill_list) - call util_fill_tp(keeps, inserts, lfill_list) ! Note: helio_tp does not have its own fill method, so we skip back to the base class + call swiftest_util_fill_tp(keeps, inserts, lfill_list) ! Note: helio_tp does not have its own fill method, so we skip back to the base class class default write(*,*) "Invalid object passed to the fill method. Source must be of class symba_tp or its descendents!" - call util_exit(FAILURE) + call swiftest_util_exit(FAILURE) end select end associate @@ -305,67 +183,30 @@ module subroutine symba_util_fill_tp(self, inserts, lfill_list) end subroutine symba_util_fill_tp - module subroutine symba_util_flatten_eucl_plpl(self, param) - !! author: Jacob R. Elliott and David A. Minton - !! - !! Turns i,j indices into k index for use in the Euclidean distance matrix. This also sets the lmtiny flag and computes the - !! number of interactions that excludes semi-interacting bodies with each other (Gmass < GMTINY). - !! This method will also sort the bodies in descending order by Mass - !! - !! Reference: - !! - !! Mélodie Angeletti, Jean-Marie Bonny, Jonas Koko. Parallel Euclidean distance matrix computation on big datasets *. - !! 2019. hal-0204751 - implicit none - ! Arguments - class(symba_pl), intent(inout) :: self !! SyMBA massive body object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - ! Internals - integer(I8B) :: npl, nplm - - associate(pl => self, nplplm => self%nplplm) - npl = int(self%nbody, kind=I8B) - select type(param) - class is (swiftest_parameters) - pl%lmtiny(1:npl) = pl%Gmass(1:npl) < param%GMTINY - end select - nplm = count(.not. pl%lmtiny(1:npl)) - pl%nplm = int(nplm, kind=I4B) - nplplm = nplm * npl - nplm * (nplm + 1_I8B) / 2_I8B ! number of entries in a strict lower triangle, npl x npl, minus first column including only mutually interacting bodies - - call util_flatten_eucl_plpl(pl, param) - end associate - - return - end subroutine symba_util_flatten_eucl_plpl - - - module subroutine symba_util_final_encounter_list(self) + module subroutine symba_util_final_list_plpl(self) !! author: David A. Minton !! - !! Finalize the SyMBA encounter list object - deallocates all allocatables + !! Finalize the pl-tp list - deallocates all allocatables implicit none - ! Argument - type(symba_encounter), intent(inout) :: self !! SyMBA encounter list object + type(symba_list_plpl), intent(inout) :: self !! SyMBA encounter list object call self%dealloc() return - end subroutine symba_util_final_encounter_list + end subroutine symba_util_final_list_plpl - module subroutine symba_util_final_merger(self) + module subroutine symba_util_final_list_pltp(self) !! author: David A. Minton !! - !! Finalize the SyMBA merger object - deallocates all allocatables + !! Finalize the pl-tp list - deallocates all allocatables implicit none - ! Argument - type(symba_merger), intent(inout) :: self !! SyMBA merger object + type(symba_list_pltp), intent(inout) :: self !! SyMBA encounter list object call self%dealloc() return - end subroutine symba_util_final_merger + end subroutine symba_util_final_list_pltp module subroutine symba_util_final_pl(self) @@ -415,6 +256,41 @@ module subroutine symba_util_final_tp(self) end subroutine symba_util_final_tp + module subroutine symba_util_flatten_eucl_plpl(self, param) + !! author: Jacob R. Elliott and David A. Minton + !! + !! Turns i,j indices into k index for use in the Euclidean distance matrix. This also sets the lmtiny flag and computes the + !! number of interactions that excludes semi-interacting bodies with each other (Gmass < GMTINY). + !! This method will also sort the bodies in descending order by Mass + !! + !! Reference: + !! + !! Mélodie Angeletti, Jean-Marie Bonny, Jonas Koko. Parallel Euclidean distance matrix computation on big datasets *. + !! 2019. hal-0204751 + implicit none + ! Arguments + class(symba_pl), intent(inout) :: self !! SyMBA massive body object + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + ! Internals + integer(I8B) :: npl, nplm + + associate(pl => self, nplplm => self%nplplm) + npl = int(self%nbody, kind=I8B) + select type(param) + class is (swiftest_parameters) + pl%lmtiny(1:npl) = pl%Gmass(1:npl) < param%GMTINY + end select + nplm = count(.not. pl%lmtiny(1:npl)) + pl%nplm = int(nplm, kind=I4B) + nplplm = nplm * npl - nplm * (nplm + 1_I8B) / 2_I8B ! number of entries in a strict lower triangle, npl x npl, minus first column including only mutually interacting bodies + + call swiftest_util_flatten_eucl_plpl(pl, param) + end associate + + return + end subroutine symba_util_flatten_eucl_plpl + + module subroutine symba_util_resize_pl(self, nnew) !! author: David A. Minton !! @@ -424,13 +300,13 @@ module subroutine symba_util_resize_pl(self, nnew) class(symba_pl), intent(inout) :: self !! SyMBA massive body object integer(I4B), intent(in) :: nnew !! New size neded - call util_resize(self%levelg, nnew) - call util_resize(self%levelm, nnew) - call util_resize(self%isperi, nnew) - call util_resize(self%peri, nnew) - call util_resize(self%atp, nnew) + call swiftest_util_resize(self%levelg, nnew) + call swiftest_util_resize(self%levelm, nnew) + call swiftest_util_resize(self%isperi, nnew) + call swiftest_util_resize(self%peri, nnew) + call swiftest_util_resize(self%atp, nnew) - call util_resize_pl(self, nnew) + call swiftest_util_resize_pl(self, nnew) return end subroutine symba_util_resize_pl @@ -444,10 +320,10 @@ module subroutine symba_util_resize_tp(self, nnew) class(symba_tp), intent(inout) :: self !! SyMBA test particle object integer(I4B), intent(in) :: nnew !! New size neded - call util_resize(self%levelg, nnew) - call util_resize(self%levelm, nnew) + call swiftest_util_resize(self%levelg, nnew) + call swiftest_util_resize(self%levelm, nnew) - call util_resize_tp(self, nnew) + call swiftest_util_resize_tp(self, nnew) return end subroutine symba_util_resize_tp @@ -503,21 +379,21 @@ module subroutine symba_util_sort_pl(self, sortby, ascending) associate(pl => self, npl => self%nbody) select case(sortby) case("nplenc") - call util_sort(direction * pl%nplenc(1:npl), ind) + call swiftest_util_sort(direction * pl%nplenc(1:npl), ind) case("ntpenc") - call util_sort(direction * pl%ntpenc(1:npl), ind) + call swiftest_util_sort(direction * pl%ntpenc(1:npl), ind) case("levelg") - call util_sort(direction * pl%levelg(1:npl), ind) + call swiftest_util_sort(direction * pl%levelg(1:npl), ind) case("levelm") - call util_sort(direction * pl%levelm(1:npl), ind) + call swiftest_util_sort(direction * pl%levelm(1:npl), ind) case("peri") - call util_sort(direction * pl%peri(1:npl), ind) + call swiftest_util_sort(direction * pl%peri(1:npl), ind) case("atp") - call util_sort(direction * pl%atp(1:npl), ind) + call swiftest_util_sort(direction * pl%atp(1:npl), ind) case("lcollision", "lencounter", "lmtiny", "nplm", "nplplm", "kin", "info") write(*,*) 'Cannot sort by ' // trim(adjustl(sortby)) // '. Component not sortable!' case default ! Look for components in the parent class - call util_sort_pl(pl, sortby, ascending) + call swiftest_util_sort_pl(pl, sortby, ascending) return end select @@ -553,13 +429,13 @@ module subroutine symba_util_sort_tp(self, sortby, ascending) associate(tp => self, ntp => self%nbody) select case(sortby) case("nplenc") - call util_sort(direction * tp%nplenc(1:ntp), ind) + call swiftest_util_sort(direction * tp%nplenc(1:ntp), ind) case("levelg") - call util_sort(direction * tp%levelg(1:ntp), ind) + call swiftest_util_sort(direction * tp%levelg(1:ntp), ind) case("levelm") - call util_sort(direction * tp%levelm(1:ntp), ind) + call swiftest_util_sort(direction * tp%levelm(1:ntp), ind) case default ! Look for components in the parent class - call util_sort_tp(tp, sortby, ascending) + call swiftest_util_sort_tp(tp, sortby, ascending) return end select @@ -581,9 +457,9 @@ module subroutine symba_util_sort_rearrange_pl(self, ind) integer(I4B), dimension(:), intent(in) :: ind !! Index array used to restructure the body (should contain all 1:n index values in the desired order) associate(pl => self, npl => self%nbody) - call util_sort_rearrange(pl%levelg, ind, npl) - call util_sort_rearrange(pl%levelm, ind, npl) - call util_sort_rearrange_pl(pl,ind) + call swiftest_util_sort_rearrange(pl%levelg, ind, npl) + call swiftest_util_sort_rearrange(pl%levelm, ind, npl) + call swiftest_util_sort_rearrange_pl(pl,ind) end associate return @@ -601,19 +477,17 @@ module subroutine symba_util_sort_rearrange_tp(self, ind) integer(I4B), dimension(:), intent(in) :: ind !! Index array used to restructure the body (should contain all 1:n index values in the desired order) associate(tp => self, ntp => self%nbody) - call util_sort_rearrange(tp%nplenc, ind, ntp) - call util_sort_rearrange(tp%levelg, ind, ntp) - call util_sort_rearrange(tp%levelm, ind, ntp) + call swiftest_util_sort_rearrange(tp%nplenc, ind, ntp) + call swiftest_util_sort_rearrange(tp%levelg, ind, ntp) + call swiftest_util_sort_rearrange(tp%levelm, ind, ntp) - call util_sort_rearrange_tp(tp,ind) + call swiftest_util_sort_rearrange_tp(tp,ind) end associate return end subroutine symba_util_sort_rearrange_tp - - module subroutine symba_util_spill_pl(self, discards, lspill_list, ldestructive) !! author: David A. Minton !! @@ -631,22 +505,22 @@ module subroutine symba_util_spill_pl(self, discards, lspill_list, ldestructive) associate(keeps => self) select type(discards) class is (symba_pl) - call util_spill(keeps%lcollision, discards%lcollision, lspill_list, ldestructive) - call util_spill(keeps%lencounter, discards%lencounter, lspill_list, ldestructive) - call util_spill(keeps%lmtiny, discards%lmtiny, lspill_list, ldestructive) - call util_spill(keeps%nplenc, discards%nplenc, lspill_list, ldestructive) - call util_spill(keeps%ntpenc, discards%ntpenc, lspill_list, ldestructive) - call util_spill(keeps%levelg, discards%levelg, lspill_list, ldestructive) - call util_spill(keeps%levelm, discards%levelm, lspill_list, ldestructive) - call util_spill(keeps%isperi, discards%isperi, lspill_list, ldestructive) - call util_spill(keeps%peri, discards%peri, lspill_list, ldestructive) - call util_spill(keeps%atp, discards%atp, lspill_list, ldestructive) - call util_spill(keeps%kin, discards%kin, lspill_list, ldestructive) - - call util_spill_pl(keeps, discards, lspill_list, ldestructive) + call swiftest_util_spill(keeps%lcollision, discards%lcollision, lspill_list, ldestructive) + call swiftest_util_spill(keeps%lencounter, discards%lencounter, lspill_list, ldestructive) + call swiftest_util_spill(keeps%lmtiny, discards%lmtiny, lspill_list, ldestructive) + call swiftest_util_spill(keeps%nplenc, discards%nplenc, lspill_list, ldestructive) + call swiftest_util_spill(keeps%ntpenc, discards%ntpenc, lspill_list, ldestructive) + call swiftest_util_spill(keeps%levelg, discards%levelg, lspill_list, ldestructive) + call swiftest_util_spill(keeps%levelm, discards%levelm, lspill_list, ldestructive) + call swiftest_util_spill(keeps%isperi, discards%isperi, lspill_list, ldestructive) + call swiftest_util_spill(keeps%peri, discards%peri, lspill_list, ldestructive) + call swiftest_util_spill(keeps%atp, discards%atp, lspill_list, ldestructive) + call swiftest_util_spill(keeps%kin, discards%kin, lspill_list, ldestructive) + + call swiftest_util_spill_pl(keeps, discards, lspill_list, ldestructive) class default write(*,*) "Invalid object passed to the spill method. Source must be of class symba_pl or its descendents!" - call util_exit(FAILURE) + call swiftest_util_exit(FAILURE) end select end associate @@ -654,32 +528,6 @@ module subroutine symba_util_spill_pl(self, discards, lspill_list, ldestructive) end subroutine symba_util_spill_pl - module subroutine symba_util_spill_encounter_list(self, discards, lspill_list, ldestructive) - !! author: David A. Minton - !! - !! Move spilled (discarded) SyMBA encounter structure from active list to discard list - !! Note: Because the plpl_encounter currently does not contain any additional variable components, this method can recieve it as an input as well. - implicit none - ! Arguments - class(symba_encounter), intent(inout) :: self !! SyMBA pl-tp encounter list - class(encounter_list), intent(inout) :: discards !! Discarded object - logical, dimension(:), intent(in) :: lspill_list !! Logical array of bodies to spill into the discards - logical, intent(in) :: ldestructive !! Logical flag indicating whether or not this operation should alter body by removing the discard list - - associate(keeps => self) - select type(discards) - class is (symba_encounter) - call util_spill(keeps%level, discards%level, lspill_list, ldestructive) - call encounter_util_spill_list(keeps, discards, lspill_list, ldestructive) - class default - write(*,*) "Invalid object passed to the spill method. Source must be of class symba_encounter or its descendents!" - call util_exit(FAILURE) - end select - end associate - - return - end subroutine symba_util_spill_encounter_list - module subroutine symba_util_spill_tp(self, discards, lspill_list, ldestructive) !! author: David A. Minton @@ -698,14 +546,14 @@ module subroutine symba_util_spill_tp(self, discards, lspill_list, ldestructive) associate(keeps => self) select type(discards) class is (symba_tp) - call util_spill(keeps%nplenc, discards%nplenc, lspill_list, ldestructive) - call util_spill(keeps%levelg, discards%levelg, lspill_list, ldestructive) - call util_spill(keeps%levelm, discards%levelm, lspill_list, ldestructive) + call swiftest_util_spill(keeps%nplenc, discards%nplenc, lspill_list, ldestructive) + call swiftest_util_spill(keeps%levelg, discards%levelg, lspill_list, ldestructive) + call swiftest_util_spill(keeps%levelm, discards%levelm, lspill_list, ldestructive) - call util_spill_tp(keeps, discards, lspill_list, ldestructive) + call swiftest_util_spill_tp(keeps, discards, lspill_list, ldestructive) class default write(*,*) "Invalid object passed to the spill method. Source must be of class symba_tp or its descendents!" - call util_exit(FAILURE) + call swiftest_util_exit(FAILURE) end select end associate diff --git a/src/tides/tides_spin_step.f90 b/src/tides/tides_spin_step.f90 index 3fadfc704..fd74e4a21 100644 --- a/src/tides/tides_spin_step.f90 +++ b/src/tides/tides_spin_step.f90 @@ -51,7 +51,7 @@ module subroutine tides_step_spin_system(self, param, t, dt) rot0 = [pack(pl%rot(:,1:npl),.true.), pack(cb%rot(:),.true.)] ! Use this space call the ode_solver, passing tides_spin_derivs as the function: subdt = dt / 20._DP - !rot1(:) = util_solve_rkf45(lambda_obj(tides_spin_derivs, subdt, pl%rbeg, pl%rend), rot0, dt, subdt tol) + !rot1(:) = swiftest_util_solve_rkf45(lambda_obj(tides_spin_derivs, subdt, pl%rbeg, pl%rend), rot0, dt, subdt tol) ! Recover with unpack !pl%rot(:,1:npl) = unpack(rot1... !cb%rot(:) = unpack(rot1... diff --git a/src/whm/whm_drift.f90 b/src/whm/whm_drift.f90 index 31d041505..5565ea8e8 100644 --- a/src/whm/whm_drift.f90 +++ b/src/whm/whm_drift.f90 @@ -48,7 +48,7 @@ module subroutine whm_drift_pl(self, system, param, dt) WRITE(*, *) " STOPPING " end if end do - call util_exit(FAILURE) + call swiftest_util_exit(FAILURE) end if end associate diff --git a/src/whm/whm_setup.f90 b/src/whm/whm_setup.f90 index ae54fa9e8..c6be76904 100644 --- a/src/whm/whm_setup.f90 +++ b/src/whm/whm_setup.f90 @@ -56,7 +56,7 @@ module subroutine whm_util_set_mu_eta_pl(self, cb) associate(pl => self, npl => self%nbody) if (npl == 0) return - call util_set_mu_pl(pl, cb) + call swiftest_util_set_mu_pl(pl, cb) pl%eta(1) = cb%Gmass + pl%Gmass(1) pl%muj(1) = pl%eta(1) do i = 2, npl @@ -81,7 +81,7 @@ module subroutine whm_setup_initialize_system(self, param) call setup_initialize_system(self, param) ! First we need to make sure that the massive bodies are sorted by heliocentric distance before computing jacobies - call util_set_ir3h(self%pl) + call swiftest_util_set_ir3h(self%pl) call self%pl%sort("ir3h", ascending=.false.) call self%pl%flatten(param) diff --git a/src/whm/whm_util.f90 b/src/whm/whm_util.f90 index f6a16a44c..6d49c818f 100644 --- a/src/whm/whm_util.f90 +++ b/src/whm/whm_util.f90 @@ -25,17 +25,17 @@ module subroutine whm_util_append_pl(self, source, lsource_mask) select type(source) class is (whm_pl) associate(nold => self%nbody, nsrc => source%nbody) - call util_append(self%eta, source%eta, nold, nsrc, lsource_mask) - call util_append(self%muj, source%muj, nold, nsrc, lsource_mask) - call util_append(self%ir3j, source%ir3j, nold, nsrc, lsource_mask) - call util_append(self%xj, source%xj, nold, nsrc, lsource_mask) - call util_append(self%vj, source%vj, nold, nsrc, lsource_mask) + call swiftest_util_append(self%eta, source%eta, nold, nsrc, lsource_mask) + call swiftest_util_append(self%muj, source%muj, nold, nsrc, lsource_mask) + call swiftest_util_append(self%ir3j, source%ir3j, nold, nsrc, lsource_mask) + call swiftest_util_append(self%xj, source%xj, nold, nsrc, lsource_mask) + call swiftest_util_append(self%vj, source%vj, nold, nsrc, lsource_mask) - call util_append_pl(self, source, lsource_mask) + call swiftest_util_append_pl(self, source, lsource_mask) end associate class default write(*,*) "Invalid object passed to the append method. Source must be of class whm_pl or its descendents" - call util_exit(FAILURE) + call swiftest_util_exit(FAILURE) end select return @@ -56,7 +56,7 @@ module subroutine whm_util_dealloc_pl(self) if (allocated(self%vj)) deallocate(self%vj) if (allocated(self%ir3j)) deallocate(self%ir3j) - call util_dealloc_pl(self) + call swiftest_util_dealloc_pl(self) return end subroutine whm_util_dealloc_pl @@ -78,16 +78,16 @@ module subroutine whm_util_fill_pl(self, inserts, lfill_list) associate(keeps => self) select type(inserts) class is (whm_pl) - call util_fill(keeps%eta, inserts%eta, lfill_list) - call util_fill(keeps%muj, inserts%muj, lfill_list) - call util_fill(keeps%ir3j, inserts%ir3j, lfill_list) - call util_fill(keeps%xj, inserts%xj, lfill_list) - call util_fill(keeps%vj, inserts%vj, lfill_list) + call swiftest_util_fill(keeps%eta, inserts%eta, lfill_list) + call swiftest_util_fill(keeps%muj, inserts%muj, lfill_list) + call swiftest_util_fill(keeps%ir3j, inserts%ir3j, lfill_list) + call swiftest_util_fill(keeps%xj, inserts%xj, lfill_list) + call swiftest_util_fill(keeps%vj, inserts%vj, lfill_list) - call util_fill_pl(keeps, inserts, lfill_list) + call swiftest_util_fill_pl(keeps, inserts, lfill_list) class default write(*,*) "Invalid object passed to the fill method. Inserts must be of class whm_pl or its descendents!" - call util_exit(FAILURE) + call swiftest_util_exit(FAILURE) end select end associate @@ -117,7 +117,7 @@ module subroutine whm_util_final_system(self) ! Arguments type(whm_nbody_system), intent(inout) :: self !! WHM nbody system object - call util_final_system(self) + call swiftest_util_final_system(self) return end subroutine whm_util_final_system @@ -146,13 +146,13 @@ module subroutine whm_util_resize_pl(self, nnew) class(whm_pl), intent(inout) :: self !! WHM massive body object integer(I4B), intent(in) :: nnew !! New size neded - call util_resize(self%eta, nnew) - call util_resize(self%xj, nnew) - call util_resize(self%vj, nnew) - call util_resize(self%muj, nnew) - call util_resize(self%ir3j, nnew) + call swiftest_util_resize(self%eta, nnew) + call swiftest_util_resize(self%xj, nnew) + call swiftest_util_resize(self%vj, nnew) + call swiftest_util_resize(self%muj, nnew) + call swiftest_util_resize(self%ir3j, nnew) - call util_resize_pl(self, nnew) + call swiftest_util_resize_pl(self, nnew) return end subroutine whm_util_resize_pl @@ -209,15 +209,15 @@ module subroutine whm_util_sort_pl(self, sortby, ascending) associate(pl => self, npl => self%nbody) select case(sortby) case("eta") - call util_sort(direction * pl%eta(1:npl), ind) + call swiftest_util_sort(direction * pl%eta(1:npl), ind) case("muj") - call util_sort(direction * pl%muj(1:npl), ind) + call swiftest_util_sort(direction * pl%muj(1:npl), ind) case("ir3j") - call util_sort(direction * pl%ir3j(1:npl), ind) + call swiftest_util_sort(direction * pl%ir3j(1:npl), ind) case("xj", "vj") write(*,*) 'Cannot sort by ' // trim(adjustl(sortby)) // '. Component not sortable!' case default - call util_sort_pl(pl, sortby, ascending) + call swiftest_util_sort_pl(pl, sortby, ascending) return end select @@ -241,13 +241,13 @@ module subroutine whm_util_sort_rearrange_pl(self, ind) if (self%nbody == 0) return associate(pl => self, npl => self%nbody) - call util_sort_rearrange(pl%eta, ind, npl) - call util_sort_rearrange(pl%xj, ind, npl) - call util_sort_rearrange(pl%vj, ind, npl) - call util_sort_rearrange(pl%muj, ind, npl) - call util_sort_rearrange(pl%ir3j, ind, npl) + call swiftest_util_sort_rearrange(pl%eta, ind, npl) + call swiftest_util_sort_rearrange(pl%xj, ind, npl) + call swiftest_util_sort_rearrange(pl%vj, ind, npl) + call swiftest_util_sort_rearrange(pl%muj, ind, npl) + call swiftest_util_sort_rearrange(pl%ir3j, ind, npl) - call util_sort_rearrange_pl(pl,ind) + call swiftest_util_sort_rearrange_pl(pl,ind) end associate return @@ -270,16 +270,16 @@ module subroutine whm_util_spill_pl(self, discards, lspill_list, ldestructive) associate(keeps => self) select type(discards) class is (whm_pl) - call util_spill(keeps%eta, discards%eta, lspill_list, ldestructive) - call util_spill(keeps%muj, discards%muj, lspill_list, ldestructive) - call util_spill(keeps%ir3j, discards%ir3j, lspill_list, ldestructive) - call util_spill(keeps%xj, discards%xj, lspill_list, ldestructive) - call util_spill(keeps%vj, discards%vj, lspill_list, ldestructive) + call swiftest_util_spill(keeps%eta, discards%eta, lspill_list, ldestructive) + call swiftest_util_spill(keeps%muj, discards%muj, lspill_list, ldestructive) + call swiftest_util_spill(keeps%ir3j, discards%ir3j, lspill_list, ldestructive) + call swiftest_util_spill(keeps%xj, discards%xj, lspill_list, ldestructive) + call swiftest_util_spill(keeps%vj, discards%vj, lspill_list, ldestructive) - call util_spill_pl(keeps, discards, lspill_list, ldestructive) + call swiftest_util_spill_pl(keeps, discards, lspill_list, ldestructive) class default write(*,*) "Invalid object passed to the spill method. Source must be of class whm_pl or its descendents!" - call util_exit(FAILURE) + call swiftest_util_exit(FAILURE) end select end associate From 5fd08e60e9ea20912eb24e3b349fe1c361199f64 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Wed, 21 Dec 2022 07:13:16 -0500 Subject: [PATCH 468/569] Another round of reorgainzing. This time to modules modules and interfaces in the same folders. Also worked on improving the consistency of file names. --- src/CMakeLists.txt | 71 ++++++++++--------- .../base.f90 => base/base_module.f90} | 0 .../collision_module.f90} | 0 src/encounter/encounter_check.f90 | 18 ++--- .../encounter_module.f90} | 0 .../fraggle_module.f90} | 0 .../globals_module.f90} | 0 .../helio.f90 => helio/helio_module.f90} | 0 .../io_progress_bar_module.f90} | 8 +-- .../lambda_function_module.f90} | 0 .../operator_cross.f90 | 0 src/{operators => operator}/operator_mag.f90 | 0 .../operator_module.f90} | 0 src/{operators => operator}/operator_unit.f90 | 0 .../rmvs.f90 => rmvs/rmvs_module.f90} | 0 .../swiftest_discard.f90 | 0 .../swiftest_drift.f90 | 0 src/{main => swiftest}/swiftest_driver.f90 | 10 +-- .../swiftest_gr.f90 | 0 .../swiftest_io.f90 | 0 .../swiftest_io_netcdf.f90 | 0 .../swiftest_kick.f90 | 0 .../swiftest_module.f90} | 4 +- .../swiftest_obl.f90 | 0 .../swiftest_orbel.f90 | 0 .../swiftest_setup.f90 | 2 + .../swiftest_util.f90 | 0 .../symba.f90 => symba/symba_module.f90} | 0 src/symba/symba_step.f90 | 4 +- .../walltime_module.f90} | 0 src/{modules/whm.f90 => whm/whm_module.f90} | 0 31 files changed, 55 insertions(+), 62 deletions(-) rename src/{modules/base.f90 => base/base_module.f90} (100%) rename src/{modules/collision.f90 => collision/collision_module.f90} (100%) rename src/{modules/encounter.f90 => encounter/encounter_module.f90} (100%) rename src/{modules/fraggle.f90 => fraggle/fraggle_module.f90} (100%) rename src/{modules/globals.f90 => globals/globals_module.f90} (100%) rename src/{modules/helio.f90 => helio/helio_module.f90} (100%) rename src/{modules/io_progress_bar.f90 => misc/io_progress_bar_module.f90} (94%) rename src/{modules/lambda_function.f90 => misc/lambda_function_module.f90} (100%) rename src/{operators => operator}/operator_cross.f90 (100%) rename src/{operators => operator}/operator_mag.f90 (100%) rename src/{modules/operators.f90 => operator/operator_module.f90} (100%) rename src/{operators => operator}/operator_unit.f90 (100%) rename src/{modules/rmvs.f90 => rmvs/rmvs_module.f90} (100%) rename src/{swiftest_procedures => swiftest}/swiftest_discard.f90 (100%) rename src/{swiftest_procedures => swiftest}/swiftest_drift.f90 (100%) rename src/{main => swiftest}/swiftest_driver.f90 (97%) rename src/{swiftest_procedures => swiftest}/swiftest_gr.f90 (100%) rename src/{swiftest_procedures => swiftest}/swiftest_io.f90 (100%) rename src/{swiftest_procedures => swiftest}/swiftest_io_netcdf.f90 (100%) rename src/{swiftest_procedures => swiftest}/swiftest_kick.f90 (100%) rename src/{modules/swiftest.f90 => swiftest/swiftest_module.f90} (99%) rename src/{swiftest_procedures => swiftest}/swiftest_obl.f90 (100%) rename src/{swiftest_procedures => swiftest}/swiftest_orbel.f90 (100%) rename src/{swiftest_procedures => swiftest}/swiftest_setup.f90 (99%) rename src/{swiftest_procedures => swiftest}/swiftest_util.f90 (100%) rename src/{modules/symba.f90 => symba/symba_module.f90} (100%) rename src/{modules/walltime.f90 => walltime/walltime_module.f90} (100%) rename src/{modules/whm.f90 => whm/whm_module.f90} (100%) diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index 92784193d..aaec591d1 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -12,31 +12,39 @@ ######################################## # Add the source files +SET(STRICT_MATH_FILES + ${SRC}/swiftest/swiftest_kick.f90 + ${SRC}/helio/helio_kick.f90 + ${SRC}/rmvs/rmvs_kick.f90 + ${SRC}/symba/symba_kick.f90 + ${SRC}/whm/whm_kick.f90 +) + SET(FAST_MATH_FILES - ${SRC}/modules/globals.f90 - ${SRC}/modules/base.f90 - ${SRC}/modules/encounter.f90 - ${SRC}/modules/collision.f90 - ${SRC}/modules/fraggle.f90 - ${SRC}/modules/lambda_function.f90 - ${SRC}/modules/operators.f90 - ${SRC}/modules/walltime.f90 - ${SRC}/modules/io_progress_bar.f90 - ${SRC}/modules/swiftest.f90 - ${SRC}/modules/whm.f90 - ${SRC}/modules/rmvs.f90 - ${SRC}/modules/helio.f90 - ${SRC}/modules/symba.f90 - ${SRC}/swiftest_procedures/swiftest_discard.f90 - ${SRC}/swiftest_procedures/swiftest_io.f90 - ${SRC}/swiftest_procedures/swiftest_obl.f90 - ${SRC}/swiftest_procedures/swiftest_util.f90 - ${SRC}/swiftest_procedures/swiftest_drift.f90 - ${SRC}/swiftest_procedures/swiftest_io_netcdf.f90 - ${SRC}/swiftest_procedures/swiftest_orbel.f90 - ${SRC}/swiftest_procedures/swiftest_gr.f90 - ${SRC}/swiftest_procedures/swiftest_kick.f90 - ${SRC}/swiftest_procedures/swiftest_setup.f90 + ${SRC}/globals/globals_module.f90 + ${SRC}/base/base_module.f90 + ${SRC}/misc/lambda_function_module.f90 + ${SRC}/misc/io_progress_bar_module.f90 + ${SRC}/encounter/encounter_module.f90 + ${SRC}/collision/collision_module.f90 + ${SRC}/fraggle/fraggle_module.f90 + ${SRC}/operator/operator_module.f90 + ${SRC}/walltime/walltime_module.f90 + ${SRC}/swiftest/swiftest_module.f90 + ${SRC}/whm/whm_module.f90 + ${SRC}/rmvs/rmvs_module.f90 + ${SRC}/helio/helio_module.f90 + ${SRC}/symba/symba_module.f90 + ${SRC}/swiftest/swiftest_discard.f90 + ${SRC}/swiftest/swiftest_io.f90 + ${SRC}/swiftest/swiftest_obl.f90 + ${SRC}/swiftest/swiftest_util.f90 + ${SRC}/swiftest/swiftest_drift.f90 + ${SRC}/swiftest/swiftest_io_netcdf.f90 + ${SRC}/swiftest/swiftest_orbel.f90 + ${SRC}/swiftest/swiftest_gr.f90 + ${SRC}/swiftest/swiftest_kick.f90 + ${SRC}/swiftest/swiftest_setup.f90 ${SRC}/collision/collision_check.f90 ${SRC}/collision/collision_regime.f90 ${SRC}/collision/collision_setup.f90 @@ -58,9 +66,9 @@ SET(FAST_MATH_FILES ${SRC}/helio/helio_setup.f90 ${SRC}/helio/helio_step.f90 ${SRC}/helio/helio_util.f90 - ${SRC}/operators/operator_cross.f90 - ${SRC}/operators/operator_mag.f90 - ${SRC}/operators/operator_unit.f90 + ${SRC}/operator/operator_cross.f90 + ${SRC}/operator/operator_mag.f90 + ${SRC}/operator/operator_unit.f90 ${SRC}/rmvs/rmvs_discard.f90 ${SRC}/rmvs/rmvs_encounter_check.f90 ${SRC}/rmvs/rmvs_setup.f90 @@ -84,16 +92,9 @@ SET(FAST_MATH_FILES ${SRC}/whm/whm_setup.f90 ${SRC}/whm/whm_step.f90 ${SRC}/whm/whm_util.f90 - ${SRC}/main/swiftest_driver.f90 + ${SRC}/swiftest/swiftest_driver.f90 ) -SET(STRICT_MATH_FILES - ${SRC}/swiftest_procedures/swiftest_kick.f90 - ${SRC}/helio/helio_kick.f90 - ${SRC}/rmvs/rmvs_kick.f90 - ${SRC}/symba/symba_kick.f90 - ${SRC}/whm/whm_kick.f90 -) set(SWIFTEST_src ${FAST_MATH_FILES} ${STRICT_MATH_FILES}) diff --git a/src/modules/base.f90 b/src/base/base_module.f90 similarity index 100% rename from src/modules/base.f90 rename to src/base/base_module.f90 diff --git a/src/modules/collision.f90 b/src/collision/collision_module.f90 similarity index 100% rename from src/modules/collision.f90 rename to src/collision/collision_module.f90 diff --git a/src/encounter/encounter_check.f90 b/src/encounter/encounter_check.f90 index 9aad9cfdb..cccb0bfe9 100644 --- a/src/encounter/encounter_check.f90 +++ b/src/encounter/encounter_check.f90 @@ -11,8 +11,7 @@ use swiftest contains - module subroutine encounter_check_all_plpl(param, npl, x, v, renc, dt, & - nenc, index1, index2, lvdotr) + module subroutine encounter_check_all_plpl(param, npl, x, v, renc, dt, nenc, index1, index2, lvdotr) !! author: David A. Minton !! !! Check for encounters between massive bodies. Choose between the standard triangular or the Sort & Sweep method based on user inputs @@ -72,8 +71,7 @@ module subroutine encounter_check_all_plpl(param, npl, x, v, renc, dt, & end subroutine encounter_check_all_plpl - module subroutine encounter_check_all_plplm(param, nplm, nplt, xplm, vplm, xplt, vplt, rencm, renct, dt, & - nenc, index1, index2, lvdotr) + module subroutine encounter_check_all_plplm(param, nplm, nplt, xplm, vplm, xplt, vplt, rencm, renct, dt, nenc, index1, index2, lvdotr) !! author: David A. Minton !! !! Check for encounters between fully interacting massive bodies partially interacting massive bodies. Choose between the standard triangular or the Sort & Sweep method based on user inputs @@ -138,8 +136,7 @@ module subroutine encounter_check_all_plplm(param, nplm, nplt, xplm, vplm, xplt, ! call encounter_check_all_sort_and_sweep_plplm(nplm, nplt, xplm, vplm, xplt, vplt, rencm, renct, dt, & ! plmplt_nenc, plmplt_index1, plmplt_index2, plmplt_lvdotr) ! else - call encounter_check_all_triangular_plplm(nplm, nplt, xplm, vplm, xplt, vplt, rencm, renct, dt, & - plmplt_nenc, plmplt_index1, plmplt_index2, plmplt_lvdotr) + call encounter_check_all_triangular_plplm(nplm, nplt, xplm, vplm, xplt, vplt, rencm, renct, dt, plmplt_nenc, plmplt_index1, plmplt_index2, plmplt_lvdotr) ! end if ! if (skipit) then @@ -179,8 +176,7 @@ module subroutine encounter_check_all_plplm(param, nplm, nplt, xplm, vplm, xplt, end subroutine encounter_check_all_plplm - module subroutine encounter_check_all_pltp(param, npl, ntp, xpl, vpl, xtp, vtp, renc, dt, & - nenc, index1, index2, lvdotr) + module subroutine encounter_check_all_pltp(param, npl, ntp, xpl, vpl, xtp, vtp, renc, dt, nenc, index1, index2, lvdotr) !! author: David A. Minton !! !! Check for encounters between massive bodies and test particles. Choose between the standard triangular or the Sort & Sweep method based on user inputs @@ -297,8 +293,7 @@ subroutine encounter_check_all_sort_and_sweep_plpl(npl, x, v, renc, dt, nenc, in end subroutine encounter_check_all_sort_and_sweep_plpl - subroutine encounter_check_all_sort_and_sweep_plplm(nplm, nplt, xplm, vplm, xplt, vplt, rencm, renct, dt, & - nenc, index1, index2, lvdotr) + subroutine encounter_check_all_sort_and_sweep_plplm(nplm, nplt, xplm, vplm, xplt, vplt, rencm, renct, dt, nenc, index1, index2, lvdotr) !! author: David A. Minton !! !! Check for encounters between massive bodies and test particles. @@ -370,8 +365,7 @@ subroutine encounter_check_all_sort_and_sweep_plplm(nplm, nplt, xplm, vplm, xplt end subroutine encounter_check_all_sort_and_sweep_plplm - subroutine encounter_check_all_sort_and_sweep_pltp(npl, ntp, xpl, vpl, xtp, vtp, rencpl, dt, & - nenc, index1, index2, lvdotr) + subroutine encounter_check_all_sort_and_sweep_pltp(npl, ntp, xpl, vpl, xtp, vtp, rencpl, dt, nenc, index1, index2, lvdotr) !! author: David A. Minton !! !! Check for encounters between massive bodies and test particles. diff --git a/src/modules/encounter.f90 b/src/encounter/encounter_module.f90 similarity index 100% rename from src/modules/encounter.f90 rename to src/encounter/encounter_module.f90 diff --git a/src/modules/fraggle.f90 b/src/fraggle/fraggle_module.f90 similarity index 100% rename from src/modules/fraggle.f90 rename to src/fraggle/fraggle_module.f90 diff --git a/src/modules/globals.f90 b/src/globals/globals_module.f90 similarity index 100% rename from src/modules/globals.f90 rename to src/globals/globals_module.f90 diff --git a/src/modules/helio.f90 b/src/helio/helio_module.f90 similarity index 100% rename from src/modules/helio.f90 rename to src/helio/helio_module.f90 diff --git a/src/modules/io_progress_bar.f90 b/src/misc/io_progress_bar_module.f90 similarity index 94% rename from src/modules/io_progress_bar.f90 rename to src/misc/io_progress_bar_module.f90 index 1e1067da7..470863f31 100644 --- a/src/modules/io_progress_bar.f90 +++ b/src/misc/io_progress_bar_module.f90 @@ -9,7 +9,7 @@ module io_progress_bar character(len=1),parameter, private :: barchar = "#" !! The progress bar character - type :: pbar + type :: progress_bar !! author: David A. Minton !! !! Implements a class for a simple progress bar that can print on the screen. @@ -22,7 +22,7 @@ module io_progress_bar contains procedure :: reset => io_progress_bar_reset !! Resets the progress bar to the beginning procedure :: update => io_progress_bar_update !! Updates the progress bar with new values - end type pbar + end type progress_bar contains @@ -32,7 +32,7 @@ subroutine io_progress_bar_reset(self, loop_length) !! Resets the progress bar to the beginning implicit none ! Arguments - class(pbar),intent(inout) :: self !! The progress bar object + class(progress_bar),intent(inout) :: self !! The progress bar object integer(I8B), intent(in) :: loop_length !! The length of the loop that the progress bar is attached to ! Internals character(len=2) :: numchar @@ -62,7 +62,7 @@ subroutine io_progress_bar_update(self,i,message) !! Updates the progress bar with new values implicit none ! Arguments - class(pbar), intent(inout) :: self !! Progres bar object + class(progress_bar), intent(inout) :: self !! Progres bar object integer(I8B), intent(in) :: i !! The current loop index of the progress loop character(len=*), intent(in), optional :: message !! An optional message to display to the right of the progress bar ! Internals diff --git a/src/modules/lambda_function.f90 b/src/misc/lambda_function_module.f90 similarity index 100% rename from src/modules/lambda_function.f90 rename to src/misc/lambda_function_module.f90 diff --git a/src/operators/operator_cross.f90 b/src/operator/operator_cross.f90 similarity index 100% rename from src/operators/operator_cross.f90 rename to src/operator/operator_cross.f90 diff --git a/src/operators/operator_mag.f90 b/src/operator/operator_mag.f90 similarity index 100% rename from src/operators/operator_mag.f90 rename to src/operator/operator_mag.f90 diff --git a/src/modules/operators.f90 b/src/operator/operator_module.f90 similarity index 100% rename from src/modules/operators.f90 rename to src/operator/operator_module.f90 diff --git a/src/operators/operator_unit.f90 b/src/operator/operator_unit.f90 similarity index 100% rename from src/operators/operator_unit.f90 rename to src/operator/operator_unit.f90 diff --git a/src/modules/rmvs.f90 b/src/rmvs/rmvs_module.f90 similarity index 100% rename from src/modules/rmvs.f90 rename to src/rmvs/rmvs_module.f90 diff --git a/src/swiftest_procedures/swiftest_discard.f90 b/src/swiftest/swiftest_discard.f90 similarity index 100% rename from src/swiftest_procedures/swiftest_discard.f90 rename to src/swiftest/swiftest_discard.f90 diff --git a/src/swiftest_procedures/swiftest_drift.f90 b/src/swiftest/swiftest_drift.f90 similarity index 100% rename from src/swiftest_procedures/swiftest_drift.f90 rename to src/swiftest/swiftest_drift.f90 diff --git a/src/main/swiftest_driver.f90 b/src/swiftest/swiftest_driver.f90 similarity index 97% rename from src/main/swiftest_driver.f90 rename to src/swiftest/swiftest_driver.f90 index 2b2229a3a..6b64fcdb2 100644 --- a/src/main/swiftest_driver.f90 +++ b/src/swiftest/swiftest_driver.f90 @@ -16,6 +16,7 @@ program swiftest_driver !! Adapted from Swifter by David E. Kaufmann's Swifter driver programs swifter_[bs,helio,ra15,rmvs,symba,tu4,whm].f90 !! Adapted from Hal Levison and Martin Duncan's Swift driver programs use swiftest + use symba implicit none class(swiftest_nbody_system), allocatable :: system !! Polymorphic object containing the nbody system to be integrated @@ -29,7 +30,7 @@ program swiftest_driver integer(I4B) :: idump !! Dump cadence counter type(walltimer) :: integration_timer !! Object used for computing elapsed wall time real(DP) :: tfrac !! Fraction of total simulation time completed - type(pbar) :: pbar !! Object used to print out a progress bar + type(progress_bar) :: pbar !! Object used to print out a progress bar character(*), parameter :: statusfmt = '("Time = ", ES12.5, "; fraction done = ", F6.3, ' // & '"; Number of active pl, tp = ", I6, ", ", I6)' character(*), parameter :: symbastatfmt = '("Time = ", ES12.5, "; fraction done = ", F6.3, ' // & @@ -43,12 +44,7 @@ program swiftest_driver call io_get_args(integrator, param_file_name, display_style) !> Read in the user-defined parameters file and the initial conditions of the system - select case(integrator) - case(symba) - allocate(base_parameters :: param) - case default - allocate(base_parameters :: param) - end select + allocate(swiftest_parameters :: param) param%integrator = trim(adjustl(integrator)) call param%set_display(display_style) call param%read_in(param_file_name) diff --git a/src/swiftest_procedures/swiftest_gr.f90 b/src/swiftest/swiftest_gr.f90 similarity index 100% rename from src/swiftest_procedures/swiftest_gr.f90 rename to src/swiftest/swiftest_gr.f90 diff --git a/src/swiftest_procedures/swiftest_io.f90 b/src/swiftest/swiftest_io.f90 similarity index 100% rename from src/swiftest_procedures/swiftest_io.f90 rename to src/swiftest/swiftest_io.f90 diff --git a/src/swiftest_procedures/swiftest_io_netcdf.f90 b/src/swiftest/swiftest_io_netcdf.f90 similarity index 100% rename from src/swiftest_procedures/swiftest_io_netcdf.f90 rename to src/swiftest/swiftest_io_netcdf.f90 diff --git a/src/swiftest_procedures/swiftest_kick.f90 b/src/swiftest/swiftest_kick.f90 similarity index 100% rename from src/swiftest_procedures/swiftest_kick.f90 rename to src/swiftest/swiftest_kick.f90 diff --git a/src/modules/swiftest.f90 b/src/swiftest/swiftest_module.f90 similarity index 99% rename from src/modules/swiftest.f90 rename to src/swiftest/swiftest_module.f90 index 01afd9134..e7925944a 100644 --- a/src/modules/swiftest.f90 +++ b/src/swiftest/swiftest_module.f90 @@ -313,8 +313,8 @@ module swiftest class(swiftest_pl), allocatable :: pl_discards !! Discarded massive body particle data structure class(swiftest_pl), allocatable :: pl_adds !! List of added bodies in mergers or collisions class(swiftest_tp), allocatable :: tp_adds !! List of added bodies in mergers or collisions - class(collision_list_pltp), allocatable :: pltp_encounter !! List of massive body-test particle encounters in a single step - class(collision_list_plpl), allocatable :: plpl_encounter !! List of massive body-massive body encounters in a single step + class(encounter_list), allocatable :: pltp_encounter !! List of massive body-test particle encounters in a single step + class(encounter_list), allocatable :: plpl_encounter !! List of massive body-massive body encounters in a single step class(collision_list_plpl), allocatable :: plpl_collision !! List of massive body-massive body collisions in a single step class(collision_list_plpl), allocatable :: pltp_collision !! List of massive body-massive body collisions in a single step class(collision_system), allocatable :: collision_system !! Collision system object diff --git a/src/swiftest_procedures/swiftest_obl.f90 b/src/swiftest/swiftest_obl.f90 similarity index 100% rename from src/swiftest_procedures/swiftest_obl.f90 rename to src/swiftest/swiftest_obl.f90 diff --git a/src/swiftest_procedures/swiftest_orbel.f90 b/src/swiftest/swiftest_orbel.f90 similarity index 100% rename from src/swiftest_procedures/swiftest_orbel.f90 rename to src/swiftest/swiftest_orbel.f90 diff --git a/src/swiftest_procedures/swiftest_setup.f90 b/src/swiftest/swiftest_setup.f90 similarity index 99% rename from src/swiftest_procedures/swiftest_setup.f90 rename to src/swiftest/swiftest_setup.f90 index 0f3a274fb..a69d62299 100644 --- a/src/swiftest_procedures/swiftest_setup.f90 +++ b/src/swiftest/swiftest_setup.f90 @@ -74,9 +74,11 @@ module subroutine swiftest_setup_construct_system(system, param) allocate(symba_cb :: system%cb) allocate(symba_pl :: system%pl) allocate(symba_tp :: system%tp) + allocate(symba_tp :: system%tp_discards) allocate(symba_pl :: system%pl_adds) allocate(symba_pl :: system%pl_discards) + allocate(collision_list_pltp :: system%pltp_encounter) allocate(collision_list_plpl :: system%plpl_encounter) allocate(collision_list_plpl :: system%plpl_collision) diff --git a/src/swiftest_procedures/swiftest_util.f90 b/src/swiftest/swiftest_util.f90 similarity index 100% rename from src/swiftest_procedures/swiftest_util.f90 rename to src/swiftest/swiftest_util.f90 diff --git a/src/modules/symba.f90 b/src/symba/symba_module.f90 similarity index 100% rename from src/modules/symba.f90 rename to src/symba/symba_module.f90 diff --git a/src/symba/symba_step.f90 b/src/symba/symba_step.f90 index 0c4ff41f2..af010a328 100644 --- a/src/symba/symba_step.f90 +++ b/src/symba/symba_step.f90 @@ -34,7 +34,7 @@ module subroutine symba_step_system(self, param, t, dt) class is (symba_tp) select type(param) class is (swiftest_parameters) - associate(encounter_history => param%encounter_history) + associate(encounter_history => self%encounter_history) call self%reset(param) lencounter = pl%encounter_check(param, self, dt, 0) .or. tp%encounter_check(param, self, dt, 0) if (lencounter) then @@ -190,7 +190,7 @@ recursive module subroutine symba_step_recur_system(self, param, t, ireci) class is (symba_tp) associate(system => self, plpl_encounter => self%plpl_encounter, pltp_encounter => self%pltp_encounter, & lplpl_collision => self%plpl_encounter%lcollision, lpltp_collision => self%pltp_encounter%lcollision, & - encounter_history => param%encounter_history) + encounter_history => self%encounter_history) system%irec = ireci dtl = param%dt / (NTENC**ireci) dth = 0.5_DP * dtl diff --git a/src/modules/walltime.f90 b/src/walltime/walltime_module.f90 similarity index 100% rename from src/modules/walltime.f90 rename to src/walltime/walltime_module.f90 diff --git a/src/modules/whm.f90 b/src/whm/whm_module.f90 similarity index 100% rename from src/modules/whm.f90 rename to src/whm/whm_module.f90 From e0668846f3a8b333be75e5b62e16fe44f0552fd0 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Wed, 21 Dec 2022 07:25:53 -0500 Subject: [PATCH 469/569] Cleanup --- src/swiftest/swiftest_util.f90 | 2 +- src/symba/symba_step.f90 | 412 +++++++++++++++++---------------- 2 files changed, 209 insertions(+), 205 deletions(-) diff --git a/src/swiftest/swiftest_util.f90 b/src/swiftest/swiftest_util.f90 index edc4c6693..64868db02 100644 --- a/src/swiftest/swiftest_util.f90 +++ b/src/swiftest/swiftest_util.f90 @@ -2254,7 +2254,7 @@ module subroutine swiftest_util_rearray_pl(self, system, param) class(swiftest_pl), allocatable :: tmp !! The discarded body list. integer(I4B) :: i, k, npl, nadd, nencmin, nenc_old, idnew1, idnew2, idold1, idold2 logical, dimension(:), allocatable :: lmask, ldump_mask - class(collision_list_plpl), allocatable :: plplenc_old + class(encounter_list), allocatable :: plplenc_old logical :: lencounter integer(I4B), dimension(:), allocatable :: levelg_orig_pl, levelm_orig_pl, levelg_orig_tp, levelm_orig_tp integer(I4B), dimension(:), allocatable :: nplenc_orig_pl, nplenc_orig_tp, ntpenc_orig_pl diff --git a/src/symba/symba_step.f90 b/src/symba/symba_step.f90 index af010a328..68071a8ab 100644 --- a/src/symba/symba_step.f90 +++ b/src/symba/symba_step.f90 @@ -30,25 +30,25 @@ module subroutine symba_step_system(self, param, t, dt) select type(pl => self%pl) class is (symba_pl) - select type(tp => self%tp) - class is (symba_tp) - select type(param) - class is (swiftest_parameters) - associate(encounter_history => self%encounter_history) - call self%reset(param) - lencounter = pl%encounter_check(param, self, dt, 0) .or. tp%encounter_check(param, self, dt, 0) - if (lencounter) then - if (param%lenc_save_trajectory) call encounter_history%take_snapshot(param, self, t, "trajectory") - call self%interp(param, t, dt) - if (param%lenc_save_trajectory) call encounter_history%take_snapshot(param, self, t+dt, "trajectory") - else - self%irec = -1 - call helio_step_system(self, param, t, dt) - end if - param%lfirstkick = pl%lfirst - end associate - end select - end select + select type(tp => self%tp) + class is (symba_tp) + select type(param) + class is (swiftest_parameters) + associate(encounter_history => self%encounter_history) + call self%reset(param) + lencounter = pl%encounter_check(param, self, dt, 0) .or. tp%encounter_check(param, self, dt, 0) + if (lencounter) then + if (param%lenc_save_trajectory) call encounter_history%take_snapshot(param, self, t, "trajectory") + call self%interp(param, t, dt) + if (param%lenc_save_trajectory) call encounter_history%take_snapshot(param, self, t+dt, "trajectory") + else + self%irec = -1 + call helio_step_system(self, param, t, dt) + end if + param%lfirstkick = pl%lfirst + end associate + end select + end select end select return @@ -72,47 +72,47 @@ module subroutine symba_step_interp_system(self, param, t, dt) ! Internals real(DP) :: dth !! Half step size - dth = 0.5_DP * dt - associate(system => self) - select type(pl => system%pl) - class is (symba_pl) - select type(tp => system%tp) - class is (symba_tp) - select type(cb => system%cb) - class is (symba_cb) - system%irec = -1 - if (pl%lfirst) call pl%vh2vb(cb) - call pl%lindrift(cb, dth, lbeg=.true.) - call pl%kick(system, param, t, dth, lbeg=.true.) - if (param%lgr) call pl%gr_pos_kick(system, param, dth) - call pl%drift(system, param, dt) - - if (tp%nbody > 0) then - if (tp%lfirst) call tp%vh2vb(vbcb = -cb%ptbeg) - call tp%lindrift(cb, dth, lbeg=.true.) - call tp%kick(system, param, t, dth, lbeg=.true.) - if (param%lgr) call tp%gr_pos_kick(system, param, dth) - call tp%drift(system, param, dt) - end if - - call system%recursive_step(param, t, 0) - system%irec = -1 - - if (param%lgr) call pl%gr_pos_kick(system, param, dth) - call pl%kick(system, param, t, dth, lbeg=.false.) - call pl%lindrift(cb, dth, lbeg=.false.) - call pl%vb2vh(cb) - - if (tp%nbody > 0) then - if (param%lgr) call tp%gr_pos_kick(system, param, dth) - call tp%kick(system, param, t, dth, lbeg=.false.) - call tp%lindrift(cb, dth, lbeg=.false.) - call tp%vb2vh(vbcb = -cb%ptend) - end if - end select - end select - end select - end associate + select type(pl => selfpl) + class is (symba_pl) + select type(tp => self%tp) + class is (symba_tp) + select type(cb => self%cb) + class is (symba_cb) + associate(system => self) + dth = 0.5_DP * dt + system%irec = -1 + if (pl%lfirst) call pl%vh2vb(cb) + call pl%lindrift(cb, dth, lbeg=.true.) + call pl%kick(system, param, t, dth, lbeg=.true.) + if (param%lgr) call pl%gr_pos_kick(system, param, dth) + call pl%drift(system, param, dt) + + if (tp%nbody > 0) then + if (tp%lfirst) call tp%vh2vb(vbcb = -cb%ptbeg) + call tp%lindrift(cb, dth, lbeg=.true.) + call tp%kick(system, param, t, dth, lbeg=.true.) + if (param%lgr) call tp%gr_pos_kick(system, param, dth) + call tp%drift(system, param, dt) + end if + + call system%recursive_step(param, t, 0) + system%irec = -1 + + if (param%lgr) call pl%gr_pos_kick(system, param, dth) + call pl%kick(system, param, t, dth, lbeg=.false.) + call pl%lindrift(cb, dth, lbeg=.false.) + call pl%vb2vh(cb) + + if (tp%nbody > 0) then + if (param%lgr) call tp%gr_pos_kick(system, param, dth) + call tp%kick(system, param, t, dth, lbeg=.false.) + call tp%lindrift(cb, dth, lbeg=.false.) + call tp%vb2vh(vbcb = -cb%ptend) + end if + end associate + end select + end select + end select return end subroutine symba_step_interp_system @@ -132,32 +132,32 @@ module subroutine symba_step_set_recur_levels_system(self, ireci) ! Internals integer(I4B) :: irecp - associate(system => self, plpl_encounter => self%plpl_encounter, pltp_encounter => self%pltp_encounter, & - npl => self%pl%nbody, ntp => self%tp%nbody) - select type(pl => self%pl) - class is (symba_pl) - select type(tp => self%tp) - class is (symba_tp) - irecp = ireci + 1 - - if (npl >0) where(pl%levelg(1:npl) == irecp) pl%levelg(1:npl) = ireci - if (ntp > 0) where(tp%levelg(1:ntp) == irecp) tp%levelg(1:ntp) = ireci - if (plpl_encounter%nenc > 0) then - where(plpl_encounter%level(1:plpl_encounter%nenc) == irecp) - plpl_encounter%level(1:plpl_encounter%nenc) = ireci - endwhere - end if - if (pltp_encounter%nenc > 0) then - where(pltp_encounter%level(1:pltp_encounter%nenc) == irecp) - pltp_encounter%level(1:pltp_encounter%nenc) = ireci - endwhere - end if - - system%irec = ireci - - end select - end select - end associate + select type(pl => self%pl) + class is (symba_pl) + select type(tp => self%tp) + class is (symba_tp) + associate(system => self, plpl_encounter => self%plpl_encounter, pltp_encounter => self%pltp_encounter, npl => self%pl%nbody, ntp => self%tp%nbody) + + irecp = ireci + 1 + + if (npl >0) where(pl%levelg(1:npl) == irecp) pl%levelg(1:npl) = ireci + if (ntp > 0) where(tp%levelg(1:ntp) == irecp) tp%levelg(1:ntp) = ireci + if (plpl_encounter%nenc > 0) then + where(plpl_encounter%level(1:plpl_encounter%nenc) == irecp) + plpl_encounter%level(1:plpl_encounter%nenc) = ireci + endwhere + end if + if (pltp_encounter%nenc > 0) then + where(pltp_encounter%level(1:pltp_encounter%nenc) == irecp) + pltp_encounter%level(1:pltp_encounter%nenc) = ireci + endwhere + end if + + system%irec = ireci + + end associate + end select + end select return end subroutine symba_step_set_recur_levels_system @@ -184,77 +184,81 @@ recursive module subroutine symba_step_recur_system(self, param, t, ireci) select type(param) class is (swiftest_parameters) - select type(pl => self%pl) - class is (symba_pl) - select type(tp => self%tp) - class is (symba_tp) - associate(system => self, plpl_encounter => self%plpl_encounter, pltp_encounter => self%pltp_encounter, & - lplpl_collision => self%plpl_encounter%lcollision, lpltp_collision => self%pltp_encounter%lcollision, & - encounter_history => self%encounter_history) - system%irec = ireci - dtl = param%dt / (NTENC**ireci) - dth = 0.5_DP * dtl - IF (dtl / param%dt < VSMALL) THEN - write(*, *) "SWIFTEST Warning:" - write(*, *) " In symba_step_recur_system, local time step is too small" - write(*, *) " Roundoff error will be important!" - call swiftest_util_exit(FAILURE) - END IF - irecp = ireci + 1 - if (ireci == 0) then - nloops = 1 - else - nloops = NTENC - end if - do j = 1, nloops - lencounter = plpl_encounter%encounter_check(param, system, dtl, irecp) & - .or. pltp_encounter%encounter_check(param, system, dtl, irecp) - - call plpl_encounter%kick(system, dth, irecp, 1) - call pltp_encounter%kick(system, dth, irecp, 1) - if (ireci /= 0) then - call plpl_encounter%kick(system, dth, irecp, -1) - call pltp_encounter%kick(system, dth, irecp, -1) - end if - - if (param%lgr) then - call pl%gr_pos_kick(system, param, dth) - call tp%gr_pos_kick(system, param, dth) - end if - - call pl%drift(system, param, dtl) - call tp%drift(system, param, dtl) - - if (lencounter) call system%recursive_step(param, t+(j-1)*dtl, irecp) - system%irec = ireci - - if (param%lgr) then - call pl%gr_pos_kick(system, param, dth) - call tp%gr_pos_kick(system, param, dth) - end if - - call plpl_encounter%kick(system, dth, irecp, 1) - call pltp_encounter%kick(system, dth, irecp, 1) - if (ireci /= 0) then - call plpl_encounter%kick(system, dth, irecp, -1) - call pltp_encounter%kick(system, dth, irecp, -1) - end if - - if (param%lclose) then - call plpl_encounter%collision_io_netcdf_check(system, param, t+j*dtl, dtl, ireci, lplpl_collision) - call pltp_encounter%collision_io_netcdf_check(system, param, t+j*dtl, dtl, ireci, lpltp_collision) - - if (lplpl_collision) call plpl_encounter%resolve_collision(system, param, t+j*dtl, dtl, ireci) - if (lpltp_collision) call pltp_encounter%resolve_collision(system, param, t+j*dtl, dtl, ireci) - end if - if (param%lenc_save_trajectory) call encounter_history%take_snapshot(param, self, t+j*dtl, "trajectory") - - call self%set_recur_levels(ireci) - - end do - end associate - end select - end select + select type(pl => self%pl) + class is (symba_pl) + select type(tp => self%tp) + class is (symba_tp) + select type(plpl_encounter => self%plpl_encounter) + class is (symba_list_plpl) + select type(pltp_encounter => self%pltp_encounter) + class is (symba_list_pltp) + associate(system => self, lplpl_collision => plpl_encounter%lcollision, lpltp_collision => pltp_encounter%lcollision, encounter_history => self%encounter_history) + system%irec = ireci + dtl = param%dt / (NTENC**ireci) + dth = 0.5_DP * dtl + IF (dtl / param%dt < VSMALL) THEN + write(*, *) "SWIFTEST Warning:" + write(*, *) " In symba_step_recur_system, local time step is too small" + write(*, *) " Roundoff error will be important!" + call swiftest_util_exit(FAILURE) + END IF + irecp = ireci + 1 + if (ireci == 0) then + nloops = 1 + else + nloops = NTENC + end if + do j = 1, nloops + lencounter = plpl_encounter%encounter_check(param, system, dtl, irecp) & + .or. pltp_encounter%encounter_check(param, system, dtl, irecp) + + call plpl_encounter%kick(system, dth, irecp, 1) + call pltp_encounter%kick(system, dth, irecp, 1) + if (ireci /= 0) then + call plpl_encounter%kick(system, dth, irecp, -1) + call pltp_encounter%kick(system, dth, irecp, -1) + end if + + if (param%lgr) then + call pl%gr_pos_kick(system, param, dth) + call tp%gr_pos_kick(system, param, dth) + end if + + call pl%drift(system, param, dtl) + call tp%drift(system, param, dtl) + + if (lencounter) call system%recursive_step(param, t+(j-1)*dtl, irecp) + system%irec = ireci + + if (param%lgr) then + call pl%gr_pos_kick(system, param, dth) + call tp%gr_pos_kick(system, param, dth) + end if + + call plpl_encounter%kick(system, dth, irecp, 1) + call pltp_encounter%kick(system, dth, irecp, 1) + if (ireci /= 0) then + call plpl_encounter%kick(system, dth, irecp, -1) + call pltp_encounter%kick(system, dth, irecp, -1) + end if + + if (param%lclose) then + call plpl_encounter%collision_check(system, param, t+j*dtl, dtl, ireci, lplpl_collision) + call pltp_encounter%collision_check(system, param, t+j*dtl, dtl, ireci, lpltp_collision) + + if (lplpl_collision) call plpl_encounter%resolve_collision(system, param, t+j*dtl, dtl, ireci) + if (lpltp_collision) call pltp_encounter%resolve_collision(system, param, t+j*dtl, dtl, ireci) + end if + if (param%lenc_save_trajectory) call encounter_history%take_snapshot(param, self, t+j*dtl, "trajectory") + + call self%set_recur_levels(ireci) + + end do + end associate + end select + end select + end select + end select end select return @@ -277,53 +281,53 @@ module subroutine symba_step_reset_system(self, param) integer(I8B) :: nenc_old associate(system => self) - select type(pl => system%pl) - class is (symba_pl) - select type(tp => system%tp) - class is (symba_tp) - associate(npl => pl%nbody, ntp => tp%nbody) - nenc_old = system%plpl_encounter%nenc - call system%plpl_encounter%setup(0_I8B) - call system%plpl_collision%setup(0_I8B) - if (npl > 0) then - pl%lcollision(1:npl) = .false. - call pl%reset_kinship([(i, i=1, npl)]) - pl%nplenc(1:npl) = 0 - pl%ntpenc(1:npl) = 0 - pl%levelg(1:npl) = -1 - pl%levelm(1:npl) = -1 - pl%lencounter(1:npl) = .false. - pl%lcollision(1:npl) = .false. - pl%ldiscard(1:npl) = .false. - pl%lmask(1:npl) = .true. - call pl%set_renc(0) - call system%plpl_encounter%setup(nenc_old) ! This resizes the pl-pl encounter list to be the same size as it was the last step, to decrease the number of potential resize operations that have to be one inside the step - system%plpl_encounter%nenc = 0 ! Sets the true number of encounters back to 0 after resizing - system%plpl_encounter%lcollision = .false. - end if - - nenc_old = system%pltp_encounter%nenc - call system%pltp_encounter%setup(0_I8B) - if (ntp > 0) then - tp%nplenc(1:ntp) = 0 - tp%levelg(1:ntp) = -1 - tp%levelm(1:ntp) = -1 - tp%lmask(1:ntp) = .true. - tp%ldiscard(1:ntp) = .false. - call system%pltp_encounter%setup(nenc_old)! This resizes the pl-tp encounter list to be the same size as it was the last step, to decrease the number of potential resize operations that have to be one inside the step - system%pltp_encounter%nenc = 0 ! Sets the true number of encounters back to 0 after resizing - system%pltp_encounter%lcollision = .false. - end if - - call system%pl_adds%setup(0, param) - call system%pl_discards%setup(0, param) - - tp%lfirst = param%lfirstkick - pl%lfirst = param%lfirstkick - - end associate - end select - end select + select type(pl => system%pl) + class is (symba_pl) + select type(tp => system%tp) + class is (symba_tp) + associate(npl => pl%nbody, ntp => tp%nbody) + nenc_old = system%plpl_encounter%nenc + call system%plpl_encounter%setup(0_I8B) + call system%plpl_collision%setup(0_I8B) + if (npl > 0) then + pl%lcollision(1:npl) = .false. + call pl%reset_kinship([(i, i=1, npl)]) + pl%nplenc(1:npl) = 0 + pl%ntpenc(1:npl) = 0 + pl%levelg(1:npl) = -1 + pl%levelm(1:npl) = -1 + pl%lencounter(1:npl) = .false. + pl%lcollision(1:npl) = .false. + pl%ldiscard(1:npl) = .false. + pl%lmask(1:npl) = .true. + call pl%set_renc(0) + call system%plpl_encounter%setup(nenc_old) ! This resizes the pl-pl encounter list to be the same size as it was the last step, to decrease the number of potential resize operations that have to be one inside the step + system%plpl_encounter%nenc = 0 ! Sets the true number of encounters back to 0 after resizing + system%plpl_encounter%lcollision = .false. + end if + + nenc_old = system%pltp_encounter%nenc + call system%pltp_encounter%setup(0_I8B) + if (ntp > 0) then + tp%nplenc(1:ntp) = 0 + tp%levelg(1:ntp) = -1 + tp%levelm(1:ntp) = -1 + tp%lmask(1:ntp) = .true. + tp%ldiscard(1:ntp) = .false. + call system%pltp_encounter%setup(nenc_old)! This resizes the pl-tp encounter list to be the same size as it was the last step, to decrease the number of potential resize operations that have to be one inside the step + system%pltp_encounter%nenc = 0 ! Sets the true number of encounters back to 0 after resizing + system%pltp_encounter%lcollision = .false. + end if + + call system%pl_adds%setup(0, param) + call system%pl_discards%setup(0, param) + + tp%lfirst = param%lfirstkick + pl%lfirst = param%lfirstkick + + end associate + end select + end select end associate return From e750be037b9430cb42ccc39d198235e9c084063e Mon Sep 17 00:00:00 2001 From: David A Minton Date: Wed, 21 Dec 2022 07:26:32 -0500 Subject: [PATCH 470/569] Fixed typo --- src/symba/symba_step.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/symba/symba_step.f90 b/src/symba/symba_step.f90 index 68071a8ab..accb9659b 100644 --- a/src/symba/symba_step.f90 +++ b/src/symba/symba_step.f90 @@ -72,7 +72,7 @@ module subroutine symba_step_interp_system(self, param, t, dt) ! Internals real(DP) :: dth !! Half step size - select type(pl => selfpl) + select type(pl => self%pl) class is (symba_pl) select type(tp => self%tp) class is (symba_tp) From 1b61f96c23e8a557cb51ff82ec9647efdca0f254 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Wed, 21 Dec 2022 09:49:00 -0500 Subject: [PATCH 471/569] More cleanup --- src/CMakeLists.txt | 4 +- src/base/base_module.f90 | 3 + src/collision/collision_util.f90 | 40 ++++---- src/swiftest/swiftest_driver.f90 | 4 +- src/swiftest/swiftest_io.f90 | 4 +- src/swiftest/swiftest_module.f90 | 23 +---- src/swiftest/swiftest_setup.f90 | 4 +- .../swiftest_user.f90} | 16 ++-- src/swiftest/swiftest_util.f90 | 22 +++++ src/tides/tides_getacch_pl.f90 | 64 +++++++------ src/tides/tides_module.f90 | 92 +++++++++++++++++++ src/tides/tides_spin_step.f90 | 58 ++++-------- 12 files changed, 208 insertions(+), 126 deletions(-) rename src/{user/user_getacch.f90 => swiftest/swiftest_user.f90} (59%) create mode 100644 src/tides/tides_module.f90 diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index aaec591d1..33a8f5536 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -18,6 +18,7 @@ SET(STRICT_MATH_FILES ${SRC}/rmvs/rmvs_kick.f90 ${SRC}/symba/symba_kick.f90 ${SRC}/whm/whm_kick.f90 + ${SRC}/swiftest/swiftest_user.f90 ) SET(FAST_MATH_FILES @@ -82,9 +83,6 @@ SET(FAST_MATH_FILES ${SRC}/symba/symba_setup.f90 ${SRC}/symba/symba_step.f90 ${SRC}/symba/symba_util.f90 - ${SRC}/tides/tides_getacch_pl.f90 - ${SRC}/tides/tides_spin_step.f90 - ${SRC}/user/user_getacch.f90 ${SRC}/walltime/walltime_implementations.f90 ${SRC}/whm/whm_coord.f90 ${SRC}/whm/whm_drift.f90 diff --git a/src/base/base_module.f90 b/src/base/base_module.f90 index ea28a5e18..96e529c9d 100644 --- a/src/base/base_module.f90 +++ b/src/base/base_module.f90 @@ -292,6 +292,7 @@ end subroutine abstract_io_netcdf_initialize_output final :: final_storage_frame end type + type, abstract :: base_storage(nframes) !! An class that establishes the pattern for various storage objects integer(I4B), len :: nframes = 4096 !! Total number of frames that can be stored @@ -321,11 +322,13 @@ end subroutine abstract_io_netcdf_initialize_output type, abstract :: base_object end type base_object + type, abstract :: base_multibody(nbody) integer(I4B), len :: nbody integer(I4B), dimension(nbody) :: id end type base_multibody + !> Class definition for the kinship relationships used in bookkeeping multiple collisions bodies in a single time step. type, abstract :: base_kinship end type base_kinship diff --git a/src/collision/collision_util.f90 b/src/collision/collision_util.f90 index 02eaafdd3..a7506c5db 100644 --- a/src/collision/collision_util.f90 +++ b/src/collision/collision_util.f90 @@ -75,6 +75,9 @@ module subroutine collision_util_construct_temporary_system(self, nbody_system, ! Internals logical, dimension(:), allocatable :: linclude integer(I4B) :: npl_tot + ! The following are needed in order to deal with typing requirements + class(swiftest_nbody_system), allocatable :: tmpsys_local + class(swiftest_parameters), allocatable :: tmpparam_local select type(nbody_system) class is (swiftest_nbody_system) @@ -85,30 +88,27 @@ module subroutine collision_util_construct_temporary_system(self, nbody_system, if (allocated(tmpparam)) deallocate(tmpparam) if (allocated(tmpsys)) deallocate(tmpsys) allocate(tmpparam, source=param) - call swiftest_setup_construct_system(tmpsys, tmpparam) - select type(tmpsys) - class is (swiftest_nbody_system) - select type(tmpparam) - class is (swiftest_parameters) + call swiftest_setup_construct_system(tmpsys_local, tmpparam_local) - ! No test particles necessary for energy/momentum calcs - call tmpsys%tp%setup(0, param) + ! No test particles necessary for energy/momentum calcs + call tmpsys_local%tp%setup(0, tmpparam_local) - ! Replace the empty central body object with a copy of the original - deallocate(tmpsys%cb) - allocate(tmpsys%cb, source=cb) + ! Replace the empty central body object with a copy of the original + deallocate(tmpsys_local%cb) + allocate(tmpsys_local%cb, source=cb) - ! Make space for the fragments - npl_tot = npl + nfrag - call tmpsys%pl%setup(npl_tot, tmpparam) - allocate(linclude(npl_tot)) + ! Make space for the fragments + npl_tot = npl + nfrag + call tmpsys_local%pl%setup(npl_tot, tmpparam_local) + allocate(linclude(npl_tot)) - ! Fill up the temporary system with all of the original bodies, leaving the spaces for fragments empty until we add them in later - linclude(1:npl) = .true. - linclude(npl+1:npl_tot) = .false. - call tmpsys%pl%fill(pl, linclude) - end select - end select + ! Fill up the temporary system with all of the original bodies, leaving the spaces for fragments empty until we add them in later + linclude(1:npl) = .true. + linclude(npl+1:npl_tot) = .false. + call tmpsys_local%pl%fill(pl, linclude) + + call move_alloc(tmpsys_local, tmpsys) + call move_alloc(tmpparam_local, tmpparam) end associate end select diff --git a/src/swiftest/swiftest_driver.f90 b/src/swiftest/swiftest_driver.f90 index 6b64fcdb2..b581cd666 100644 --- a/src/swiftest/swiftest_driver.f90 +++ b/src/swiftest/swiftest_driver.f90 @@ -41,7 +41,7 @@ program swiftest_driver character(*), parameter :: symbacompactfmt = '(";NPLM",ES22.15,$)' !type(base_storage(nframes=:)), allocatable :: system_history - call io_get_args(integrator, param_file_name, display_style) + call swiftest_io_get_args(integrator, param_file_name, display_style) !> Read in the user-defined parameters file and the initial conditions of the system allocate(swiftest_parameters :: param) @@ -71,7 +71,7 @@ program swiftest_driver if (dump_cadence == 0) dump_cadence = ceiling(nloops / (1.0_DP * istep_out), kind=I8B) ! Construct the main n-body system using the user-input integrator to choose the type of system - call setup_construct_system(system, param) + call swiftest_setup_construct_system(system, param) !> Define the maximum number of threads nthreads = 1 ! In the *serial* case diff --git a/src/swiftest/swiftest_io.f90 b/src/swiftest/swiftest_io.f90 index 581e7e001..cf2fe02d6 100644 --- a/src/swiftest/swiftest_io.f90 +++ b/src/swiftest/swiftest_io.f90 @@ -310,7 +310,7 @@ module subroutine swiftest_io_dump_storage(self, param) end subroutine swiftest_io_dump_storage - module subroutine swiftest_io_get_args(integrator, param_file_name, display_style) + module subroutine swiftest_swiftest_io_get_args(integrator, param_file_name, display_style) !! author: David A. Minton !! !! Reads in the name of the parameter file from command line arguments. @@ -381,7 +381,7 @@ module subroutine swiftest_io_get_args(integrator, param_file_name, display_styl end if return - end subroutine swiftest_io_get_args + end subroutine swiftest_swiftest_io_get_args module function swiftest_io_get_token(buffer, ifirst, ilast, ierr) result(token) diff --git a/src/swiftest/swiftest_module.f90 b/src/swiftest/swiftest_module.f90 index e7925944a..a7bae5336 100644 --- a/src/swiftest/swiftest_module.f90 +++ b/src/swiftest/swiftest_module.f90 @@ -585,12 +585,12 @@ module subroutine swiftest_io_dump_storage(self, param) class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters end subroutine swiftest_io_dump_storage - module subroutine swiftest_io_get_args(integrator, param_file_name, display_style) + module subroutine swiftest_swiftest_io_get_args(integrator, param_file_name, display_style) implicit none character(len=:), allocatable, intent(inout) :: integrator !! Symbolic code of the requested integrator character(len=:), allocatable, intent(inout) :: param_file_name !! Name of the input parameters file character(len=:), allocatable, intent(inout) :: display_style !! Style of the output display {"STANDARD", "COMPACT"}). Default is "STANDARD" - end subroutine swiftest_io_get_args + end subroutine swiftest_swiftest_io_get_args module function swiftest_io_get_token(buffer, ifirst, ilast, ierr) result(token) implicit none @@ -1005,8 +1005,8 @@ end subroutine swiftest_setup_body module subroutine swiftest_setup_construct_system(system, param) implicit none - class(base_nbody_system), allocatable, intent(inout) :: system !! Swiftest system object - class(base_parameters), intent(inout) :: param !! Current run configuration parameters + class(swiftest_nbody_system), allocatable, intent(inout) :: system !! Swiftest system object + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters end subroutine swiftest_setup_construct_system module subroutine swiftest_setup_initialize_particle_info_system(self, param) @@ -1035,21 +1035,6 @@ module subroutine swiftest_setup_tp(self, n, param) class(swiftest_parameters), intent(in) :: param !! Current run configuration parametersr end subroutine swiftest_setup_tp - ! TODO: Implement the tides model - module subroutine swiftest_tides_kick_getacch_pl(self, system) - implicit none - class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object - end subroutine swiftest_tides_kick_getacch_pl - - ! module subroutine swiftest_tides_step_spin_system(self, param, t, dt) - ! implicit none - ! class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nbody system object - ! class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters - ! real(DP), intent(in) :: t !! Simulation time - ! real(DP), intent(in) :: dt !! Current stepsize - ! end subroutine swiftest_tides_step_spin_system - module subroutine swiftest_user_kick_getacch_body(self, system, param, t, lbeg) implicit none class(swiftest_body), intent(inout) :: self !! Swiftest massive body particle data structure diff --git a/src/swiftest/swiftest_setup.f90 b/src/swiftest/swiftest_setup.f90 index a69d62299..5429681c6 100644 --- a/src/swiftest/swiftest_setup.f90 +++ b/src/swiftest/swiftest_setup.f90 @@ -21,8 +21,8 @@ module subroutine swiftest_setup_construct_system(system, param) !! implicit none ! Arguments - class(base_nbody_system), allocatable, intent(inout) :: system !! Swiftest system object - class(base_parameters), intent(inout) :: param !! Swiftest parameters + class(swiftest_nbody_system), allocatable, intent(inout) :: system !! Swiftest system object + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters ! Internals type(encounter_storage) :: encounter_history type(collision_storage) :: collision_history diff --git a/src/user/user_getacch.f90 b/src/swiftest/swiftest_user.f90 similarity index 59% rename from src/user/user_getacch.f90 rename to src/swiftest/swiftest_user.f90 index deb54e93f..9d9c30783 100644 --- a/src/user/user_getacch.f90 +++ b/src/swiftest/swiftest_user.f90 @@ -7,10 +7,10 @@ !! You should have received a copy of the GNU General Public License along with Swiftest. !! If not, see: https://www.gnu.org/licenses. -submodule(base) s_user_kick_getacch +submodule(swiftest) s_user_kick_getacch use swiftest contains - module subroutine user_kick_getacch_body(self, system, param, t, lbeg) + module subroutine swiftest_user_kick_getacch_body(self, system, param, t, lbeg) !! author: David A. Minton !! !! Add user-supplied heliocentric accelerations to planets. @@ -18,13 +18,13 @@ module subroutine user_kick_getacch_body(self, system, param, t, lbeg) !! Adapted from David E. Kaufmann's Swifter routine whm_user_kick_getacch.f90 implicit none ! Arguments - class(swiftest_body), intent(inout) :: self !! Swiftest massive body particle data structure - class(swiftest_system), intent(inout) :: system !! Swiftest nbody_system_object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters user parameters - real(DP), intent(in) :: t !! Current time - logical, intent(in) :: lbeg !! Logical flag that determines whether or not this is the beginning or end of the ste + class(swiftest_body), intent(inout) :: self !! Swiftest massive body particle data structure + class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody_system_object + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters user parameters + real(DP), intent(in) :: t !! Current time + logical, intent(in) :: lbeg !! Logical flag that determines whether or not this is the beginning or end of the ste return - end subroutine user_kick_getacch_body + end subroutine swiftest_user_kick_getacch_body end submodule s_user_kick_getacch diff --git a/src/swiftest/swiftest_util.f90 b/src/swiftest/swiftest_util.f90 index 64868db02..7e303b214 100644 --- a/src/swiftest/swiftest_util.f90 +++ b/src/swiftest/swiftest_util.f90 @@ -2480,6 +2480,28 @@ module subroutine swiftest_util_rescale_system(self, param, mscale, dscale, tsca end subroutine swiftest_util_rescale_system + module subroutine swiftest_util_reset_kinship_pl(self, idx) + !! author: David A. Minton + !! + !! Resets the kinship status of bodies. + !! + implicit none + class(swiftest_pl), intent(inout) :: self !! SyMBA massive body object + integer(I4B), dimension(:), intent(in) :: idx !! Index array of bodies to reset + ! Internals + integer(I4B) :: i, j + + self%kin(idx(:))%parent = idx(:) + self%kin(idx(:))%nchild = 0 + do j = 1, size(idx(:)) + i = idx(j) + if (allocated(self%kin(i)%child)) deallocate(self%kin(i)%child) + end do + + return + end subroutine swiftest_util_reset_kinship_pl + + module subroutine swiftest_util_resize_arr_char_string(arr, nnew) !! author: David A. Minton !! diff --git a/src/tides/tides_getacch_pl.f90 b/src/tides/tides_getacch_pl.f90 index aed941e8f..680c22704 100644 --- a/src/tides/tides_getacch_pl.f90 +++ b/src/tides/tides_getacch_pl.f90 @@ -1,4 +1,4 @@ -submodule(base) s_tides_kick_getacch +submodule(tides) s_tides_kick_getacch use swiftest contains @@ -25,39 +25,45 @@ module subroutine tides_kick_getacch_pl(self, system) real(DP), dimension(NDIM) :: r_unit, v_unit, h_unit, theta_unit, theta_dot, F_T real(DP) :: Ftr, Ptopl, Ptocb, r5cbterm, r5plterm - associate(pl => self, npl => self%nbody, cb => system%cb) - pl%atide(:,:) = 0.0_DP - cb%atide(:) = 0.0_DP - do i = 1, npl - rmag = norm2(pl%rh(:,i)) - vmag = norm2(pl%vh(:,i)) - r_unit(:) = pl%rh(:,i) / rmag - v_unit(:) = pl%vh(:,i) / vmag - h_unit(:) = r_unit(:) .cross. v_unit(:) - theta_unit(:) = h_unit(:) .cross. r_unit(:) - theta_dot = dot_product(pl%vh(:,i), theta_unit(:)) + select type(pl => self) + class is (swiftest_pl) + select type(system) + class is (swiftest_nbody_system) + associate(npl => pl%nbody, cb => system%cb) + pl%atide(:,:) = 0.0_DP + cb%atide(:) = 0.0_DP + do i = 1, npl + rmag = norm2(pl%rh(:,i)) + vmag = norm2(pl%vh(:,i)) + r_unit(:) = pl%rh(:,i) / rmag + v_unit(:) = pl%vh(:,i) / vmag + h_unit(:) = r_unit(:) .cross. v_unit(:) + theta_unit(:) = h_unit(:) .cross. r_unit(:) + theta_dot = dot_product(pl%vh(:,i), theta_unit(:)) - ! First calculate the tangential component of the force vector (eq. 5 & 6 of Bolmont et al. 2015) - ! The radial component is already computed in the obl_acc methods - r5cbterm = pl%Gmass(i)**2 * cb%k2 * cb%radius**5 - r5plterm = cb%Gmass**2 * pl%k2(i) * pl%radius(i)**5 + ! First calculate the tangential component of the force vector (eq. 5 & 6 of Bolmont et al. 2015) + ! The radial component is already computed in the obl_acc methods + r5cbterm = pl%Gmass(i)**2 * cb%k2 * cb%radius**5 + r5plterm = cb%Gmass**2 * pl%k2(i) * pl%radius(i)**5 - Ptopl = 3 * r5plterm * pl%tlag(i) / rmag**7 - Ptocb = 3 * r5cbterm * cb%tlag / rmag**7 + Ptopl = 3 * r5plterm * pl%tlag(i) / rmag**7 + Ptocb = 3 * r5cbterm * cb%tlag / rmag**7 - Ftr = -3 / rmag**7 * (r5cbterm + r5plterm) - 3 * vmag / rmag * (Ptocb + Ptopl) + Ftr = -3 / rmag**7 * (r5cbterm + r5plterm) - 3 * vmag / rmag * (Ptocb + Ptopl) - F_T(:) = (Ftr + (Ptocb + Ptopl) * dot_product(v_unit, r_unit) / rmag) * r_unit(:) & - + Ptopl * ((pl%rot(:,i) - theta_dot(:)) .cross. r_unit(:)) & - + Ptocb * ((cb%rot(:) - theta_dot(:)) .cross. r_unit(:)) - cb%atide(:) = cb%atide(:) + F_T(:) / cb%Gmass - pl%atide(:,i) = F_T(:) / pl%Gmass(i) - end do + F_T(:) = (Ftr + (Ptocb + Ptopl) * dot_product(v_unit, r_unit) / rmag) * r_unit(:) & + + Ptopl * ((pl%rot(:,i) - theta_dot(:)) .cross. r_unit(:)) & + + Ptocb * ((cb%rot(:) - theta_dot(:)) .cross. r_unit(:)) + cb%atide(:) = cb%atide(:) + F_T(:) / cb%Gmass + pl%atide(:,i) = F_T(:) / pl%Gmass(i) + end do - do i = 1, npl - pl%ah(:,i) = pl%ah(:,i) + pl%atide(:,i) + cb%atide(:) - end do - end associate + do i = 1, npl + pl%ah(:,i) = pl%ah(:,i) + pl%atide(:,i) + cb%atide(:) + end do + end associate + end select + end select return end subroutine tides_kick_getacch_pl diff --git a/src/tides/tides_module.f90 b/src/tides/tides_module.f90 new file mode 100644 index 000000000..6d9c5f465 --- /dev/null +++ b/src/tides/tides_module.f90 @@ -0,0 +1,92 @@ +!! Copyright 2022 - David Minton, Carlisle Wishard, Jennifer Pouplin, Jake Elliott, & Dana Singh +!! This file is part of Swiftest. +!! Swiftest is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License +!! as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. +!! Swiftest is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty +!! of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. +!! You should have received a copy of the GNU General Public License along with Swiftest. +!! If not, see: https://www.gnu.org/licenses. + +module tides + !! author: The Purdue Swiftest Team - David A. Minton, Carlisle A. Wishard, Jennifer L.L. Pouplin, and Jacob R. Elliott + !! + !! Definition of classes and methods used to determine close encounters + use base + use lambda_function + implicit none + public + + + type, extends(lambda_obj_tvar) :: tides_derivs_func + !! Base class for an lambda function object. This object takes no additional arguments other than the dependent variable x, an array of real numbers + procedure(tidederiv), pointer, nopass :: lambdaptr_tides_deriv + real(DP), dimension(:,:), allocatable :: rbeg + real(DP), dimension(:,:), allocatable :: rend + real(DP) :: dt + contains + generic :: init => tides_derivs_init + procedure :: evalt => tides_derivs_eval + procedure, nopass :: tides_derivs_init + end type + interface lambda_obj + module procedure tides_derivs_init + end interface + + abstract interface + function tidederiv(x, t, dt, rbeg, rend) result(y) + ! Template for a 0 argument function + import DP, base_nbody_system + real(DP), dimension(:), intent(in) :: x + real(DP), intent(in) :: t + real(DP), intent(in) :: dt + real(DP), dimension(:,:), intent(in) :: rbeg + real(DP), dimension(:,:), intent(in) :: rend + real(DP), dimension(:), allocatable :: y + end function + end interface + + + interface + module subroutine tides_kick_getacch_pl(self, system) + implicit none + class(base_object), intent(inout) :: self !! Swiftest massive body object + class(base_nbody_system), intent(inout) :: system !! Swiftest nbody system object + end subroutine tides_kick_getacch_pl + + module function tides_derivs_init(lambda, dt, rbeg, rend) result(f) + implicit none + procedure(tidederiv) :: lambda + real(DP), intent(in) :: dt + real(DP), dimension(:,:), intent(in) :: rbeg + real(DP), dimension(:,:), intent(in) :: rend + type(tides_derivs_func) :: f + end function tides_derivs_init + + module function tides_derivs_eval(self, x, t) result(y) + class(tides_derivs_func), intent(inout) :: self + real(DP), dimension(:), intent(in) :: x + real(DP), intent(in) :: t + real(DP), dimension(:), allocatable :: y + end function tides_derivs_eval + + module function tides_spin_derivs(rot_pl_cb, t, dt, rbeg, rend) result(drot) !! Need to add more arguments so we can pull in mass, radius, Ip, J2, etc... + real(DP), dimension(:,:), intent(in) :: rot_pl_cb !! Array of rotations. The last element is the central body, and all others are massive bodies + real(DP), intent(in) :: t !! Current time, which is used to interpolate the massive body positions + real(DP), intent(in) :: dt !! Total step size + real(DP), dimension(:,:), intent(in) :: rbeg + real(DP), dimension(:,:), intent(in) :: rend + real(DP), dimension(:,:), allocatable :: drot + end function tides_spin_derivs + + module subroutine tides_step_spin_system(self, param, t, dt) + implicit none + class(base_nbody_system), intent(inout) :: self !! Swiftest nbody system object + class(base_parameters), intent(in) :: param !! Current run configuration parameters + real(DP), intent(in) :: t !! Simulation time + real(DP), intent(in) :: dt !! Current stepsize + end subroutine tides_step_spin_system + + end interface + + +end module \ No newline at end of file diff --git a/src/tides/tides_spin_step.f90 b/src/tides/tides_spin_step.f90 index fd74e4a21..adf602b77 100644 --- a/src/tides/tides_spin_step.f90 +++ b/src/tides/tides_spin_step.f90 @@ -1,33 +1,6 @@ -submodule(base) s_tides_step_spin +submodule(tides) s_tides_step_spin use swiftest - type, extends(lambda_obj_tvar) :: tides_derivs_func - !! Base class for an lambda function object. This object takes no additional arguments other than the dependent variable x, an array of real numbers - procedure(tidederiv), pointer, nopass :: lambdaptr_tides_deriv - real(DP), dimension(:,:), allocatable :: rbeg - real(DP), dimension(:,:), allocatable :: rend - real(DP) :: dt - contains - generic :: init => tides_derivs_init - procedure :: evalt => tides_derivs_eval - procedure, nopass :: tides_derivs_init - end type - interface lambda_obj - module procedure tides_derivs_init - end interface - abstract interface - function tidederiv(x, t, dt, rbeg, rend) result(y) - ! Template for a 0 argument function - import DP, base_nbody_system - real(DP), dimension(:), intent(in) :: x - real(DP), intent(in) :: t - real(DP), intent(in) :: dt - real(DP), dimension(:,:), intent(in) :: rbeg - real(DP), dimension(:,:), intent(in) :: rend - real(DP), dimension(:), allocatable :: y - end function - end interface - contains module subroutine tides_step_spin_system(self, param, t, dt) @@ -46,22 +19,25 @@ module subroutine tides_step_spin_system(self, param, t, dt) real(DP), parameter :: tol=1e-6_DP !! Just a guess at the moment real(DP) :: subdt - associate(pl => self%pl, npl => self%pl%nbody, cb => self%cb) - allocate(rot0(NDIM*(npl+1))) - rot0 = [pack(pl%rot(:,1:npl),.true.), pack(cb%rot(:),.true.)] - ! Use this space call the ode_solver, passing tides_spin_derivs as the function: - subdt = dt / 20._DP - !rot1(:) = swiftest_util_solve_rkf45(lambda_obj(tides_spin_derivs, subdt, pl%rbeg, pl%rend), rot0, dt, subdt tol) - ! Recover with unpack - !pl%rot(:,1:npl) = unpack(rot1... - !cb%rot(:) = unpack(rot1... - end associate + select type(self) + class is (swiftest_nbody_system) + associate(pl => self%pl, npl => self%pl%nbody, cb => self%cb) + allocate(rot0(NDIM*(npl+1))) + ! rot0 = [pack(pl%rot(:,1:npl),.true.), pack(cb%rot(:),.true.)] + ! Use this space call the ode_solver, passing tides_spin_derivs as the function: + ! subdt = dt / 20._DP + ! rot1(:) = swiftest_util_solve_rkf45(lambda_obj(tides_spin_derivs, subdt, pl%rbeg, pl%rend), rot0, dt, subdt,tol) + ! ! Recover with unpack + ! pl%rot(:,1:npl) = unpack(rot1... + ! cb%rot(:) = unpack(rot1... + end associate + end select return end subroutine tides_step_spin_system - function tides_spin_derivs(rot_pl_cb, t, dt, rbeg, rend) result(drot) !! Need to add more arguments so we can pull in mass, radius, Ip, J2, etc... + module function tides_spin_derivs(rot_pl_cb, t, dt, rbeg, rend) result(drot) !! Need to add more arguments so we can pull in mass, radius, Ip, J2, etc... !! author: Jennifer L.L. Pouplin and David A. Minton !! !! function used to calculate the derivatives that are fed to the ODE solver @@ -95,7 +71,7 @@ function tides_spin_derivs(rot_pl_cb, t, dt, rbeg, rend) result(drot) !! Need to return end function tides_spin_derivs - function tides_derivs_eval(self, x, t) result(y) + module function tides_derivs_eval(self, x, t) result(y) implicit none ! Arguments class(tides_derivs_func), intent(inout) :: self @@ -112,7 +88,7 @@ function tides_derivs_eval(self, x, t) result(y) return end function tides_derivs_eval - function tides_derivs_init(lambda, dt, rbeg, rend) result(f) + module function tides_derivs_init(lambda, dt, rbeg, rend) result(f) implicit none ! Arguments procedure(tidederiv) :: lambda From da3fe6ffb13264539523c57349003781e920c381 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Wed, 21 Dec 2022 11:17:12 -0500 Subject: [PATCH 472/569] Lots more restructuring, cleaning, refactoring, etc. Rearranged netcdf stuff to make it a bit cleaner --- src/CMakeLists.txt | 21 +- src/base/base_module.f90 | 212 +-- src/collision/collision_io.f90 | 118 +- src/collision/collision_module.f90 | 6 +- src/encounter/encounter_check.f90 | 6 +- src/encounter/encounter_io.f90 | 92 +- src/encounter/encounter_module.f90 | 37 +- src/netcdf_io/netcdf_io_implementations.f90 | 66 + src/netcdf_io/netcdf_io_module.f90 | 159 +++ src/swiftest/swiftest_io.f90 | 1278 ++++++++++++++++++- src/swiftest/swiftest_io_netcdf.f90 | 1246 ------------------ src/swiftest/swiftest_kick.f90 | 2 +- src/swiftest/swiftest_module.f90 | 200 +-- src/swiftest/swiftest_setup.f90 | 19 +- src/swiftest/swiftest_util.f90 | 14 +- src/symba/symba_kick.f90 | 2 +- src/symba/symba_util.f90 | 9 +- 17 files changed, 1756 insertions(+), 1731 deletions(-) create mode 100644 src/netcdf_io/netcdf_io_implementations.f90 create mode 100644 src/netcdf_io/netcdf_io_module.f90 delete mode 100644 src/swiftest/swiftest_io_netcdf.f90 diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index 33a8f5536..b43cf0407 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -24,6 +24,7 @@ SET(STRICT_MATH_FILES SET(FAST_MATH_FILES ${SRC}/globals/globals_module.f90 ${SRC}/base/base_module.f90 + ${SRC}/netcdf_io/netcdf_io_module.f90 ${SRC}/misc/lambda_function_module.f90 ${SRC}/misc/io_progress_bar_module.f90 ${SRC}/encounter/encounter_module.f90 @@ -36,16 +37,6 @@ SET(FAST_MATH_FILES ${SRC}/rmvs/rmvs_module.f90 ${SRC}/helio/helio_module.f90 ${SRC}/symba/symba_module.f90 - ${SRC}/swiftest/swiftest_discard.f90 - ${SRC}/swiftest/swiftest_io.f90 - ${SRC}/swiftest/swiftest_obl.f90 - ${SRC}/swiftest/swiftest_util.f90 - ${SRC}/swiftest/swiftest_drift.f90 - ${SRC}/swiftest/swiftest_io_netcdf.f90 - ${SRC}/swiftest/swiftest_orbel.f90 - ${SRC}/swiftest/swiftest_gr.f90 - ${SRC}/swiftest/swiftest_kick.f90 - ${SRC}/swiftest/swiftest_setup.f90 ${SRC}/collision/collision_check.f90 ${SRC}/collision/collision_regime.f90 ${SRC}/collision/collision_setup.f90 @@ -67,6 +58,7 @@ SET(FAST_MATH_FILES ${SRC}/helio/helio_setup.f90 ${SRC}/helio/helio_step.f90 ${SRC}/helio/helio_util.f90 + ${SRC}/netcdf_io/netcdf_io_implementations.f90 ${SRC}/operator/operator_cross.f90 ${SRC}/operator/operator_mag.f90 ${SRC}/operator/operator_unit.f90 @@ -75,6 +67,15 @@ SET(FAST_MATH_FILES ${SRC}/rmvs/rmvs_setup.f90 ${SRC}/rmvs/rmvs_step.f90 ${SRC}/rmvs/rmvs_util.f90 + ${SRC}/swiftest/swiftest_discard.f90 + ${SRC}/swiftest/swiftest_io.f90 + ${SRC}/swiftest/swiftest_obl.f90 + ${SRC}/swiftest/swiftest_util.f90 + ${SRC}/swiftest/swiftest_drift.f90 + ${SRC}/swiftest/swiftest_orbel.f90 + ${SRC}/swiftest/swiftest_gr.f90 + ${SRC}/swiftest/swiftest_kick.f90 + ${SRC}/swiftest/swiftest_setup.f90 ${SRC}/symba/symba_discard.f90 ${SRC}/symba/symba_drift.f90 ${SRC}/symba/symba_encounter_check.f90 diff --git a/src/base/base_module.f90 b/src/base/base_module.f90 index 96e529c9d..7e19be601 100644 --- a/src/base/base_module.f90 +++ b/src/base/base_module.f90 @@ -57,6 +57,7 @@ module base real(DP) :: GMTINY = -1.0_DP !! Smallest G*mass that is fully gravitating real(DP) :: min_GMfrag = -1.0_DP !! Smallest G*mass that can be produced in a fragmentation event integer(I4B), dimension(:), allocatable :: seed !! Random seeds for fragmentation modeling + logical :: lmtiny_pl = .false. !! Include semi-interacting massive bodies logical :: lfragmentation = .false. !! Do fragmentation modeling instead of simple merger. character(STRMAX) :: encounter_save = "NONE" !! Indicate if and how encounter data should be saved logical :: lenc_save_trajectory = .false. !! Indicates that when encounters are saved, the full trajectory through recursion steps are saved @@ -152,137 +153,6 @@ subroutine abstract_io_read_in_param(self, param_file_name) end subroutine abstract_io_read_in_param end interface - !! This derived datatype stores the NetCDF ID values for each of the variables included in the NetCDF data file. This is used as the base class defined in base - type, abstract :: base_io_netcdf_parameters - character(STRMAX) :: file_name !! Name of the output file - 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) :: name_dimname = "name" !! name of the particle name dimension - integer(I4B) :: name_dimid !! ID for the particle name dimension - integer(I4B) :: name_varid !! ID for the particle name variable - character(NAMELEN) :: space_dimname = "space" !! name of the space dimension - integer(I4B) :: space_dimid !! ID for the space dimension - integer(I4B) :: space_varid !! ID for the space variable - character(len=1), dimension(3) :: space_coords = ["x","y","z"] !! The space dimension coordinate labels - - ! Non-dimension ids and variable names - character(NAMELEN) :: ptype_varname = "particle_type" !! name of the particle type variable - integer(I4B) :: ptype_varid !! ID for the particle type variable - character(NAMELEN) :: id_varname = "id" !! name of the particle id variable - integer(I4B) :: id_varid !! ID for the id variable - character(NAMELEN) :: npl_varname = "npl" !! name of the number of active massive bodies variable - integer(I4B) :: npl_varid !! ID for the number of active massive bodies variable - character(NAMELEN) :: ntp_varname = "ntp" !! name of the number of active test particles variable - integer(I4B) :: ntp_varid !! ID for the number of active test particles variable - character(NAMELEN) :: nplm_varname = "nplm" !! name of the number of active fully interacting massive bodies variable (SyMBA) - integer(I4B) :: nplm_varid !! ID for the number of active fully interacting massive bodies variable (SyMBA) - character(NAMELEN) :: a_varname = "a" !! name of the semimajor axis variable - integer(I4B) :: a_varid !! ID for the semimajor axis variable - character(NAMELEN) :: e_varname = "e" !! name of the eccentricity variable - integer(I4B) :: e_varid !! ID for the eccentricity variable - character(NAMELEN) :: inc_varname = "inc" !! name of the inclination variable - integer(I4B) :: inc_varid !! ID for the inclination variable - character(NAMELEN) :: capom_varname = "capom" !! name of the long. asc. node variable - integer(I4B) :: capom_varid !! ID for the long. asc. node variable - character(NAMELEN) :: omega_varname = "omega" !! name of the arg. of periapsis variable - integer(I4B) :: omega_varid !! ID for the arg. of periapsis variable - character(NAMELEN) :: capm_varname = "capm" !! name of the mean anomaly variable - integer(I4B) :: capm_varid !! ID for the mean anomaly variable - character(NAMELEN) :: varpi_varname = "varpi" !! name of the long. of periapsis variable - integer(I4B) :: varpi_varid !! ID for the long. of periapsis variable - character(NAMELEN) :: lam_varname = "lam" !! name of the mean longitude variable - integer(I4B) :: lam_varid !! ID for the mean longitude variable - character(NAMELEN) :: f_varname = "f" !! name of the true anomaly variable - integer(I4B) :: f_varid !! ID for the true anomaly variable - character(NAMELEN) :: cape_varname = "cape" !! name of the eccentric anomaly variable - integer(I4B) :: cape_varid !! ID for the eccentric anomaly variable - character(NAMELEN) :: rh_varname = "rh" !! name of the heliocentric position vector variable - integer(I4B) :: rh_varid !! ID for the heliocentric position vector variable - character(NAMELEN) :: vh_varname = "vh" !! name of the heliocentric velocity vector variable - integer(I4B) :: vh_varid !! ID for the heliocentric velocity vector variable - character(NAMELEN) :: gr_pseudo_vh_varname = "gr_pseudo_vh" !! name of the heliocentric pseudovelocity vector variable (used in GR only) - integer(I4B) :: gr_pseudo_vh_varid !! ID for the heliocentric pseudovelocity vector variable (used in GR) - character(NAMELEN) :: gmass_varname = "Gmass" !! name of the mass variable - integer(I4B) :: Gmass_varid !! ID for the mass variable - character(NAMELEN) :: rhill_varname = "rhill" !! name of the hill radius variable - integer(I4B) :: rhill_varid !! ID for the hill radius variable - character(NAMELEN) :: radius_varname = "radius" !! name of the radius variable - integer(I4B) :: radius_varid !! ID for the radius variable - character(NAMELEN) :: Ip_varname = "Ip" !! name of the principal moment of inertial variable - integer(I4B) :: Ip_varid !! ID for the axis principal moment of inertia variable - character(NAMELEN) :: rot_varname = "rot" !! name of the rotation vector variable - integer(I4B) :: rot_varid !! ID for the rotation vector variable - character(NAMELEN) :: j2rp2_varname = "j2rp2" !! name of the j2rp2 variable - integer(I4B) :: j2rp2_varid !! ID for the j2 variable - character(NAMELEN) :: j4rp4_varname = "j4rp4" !! name of the j4pr4 variable - integer(I4B) :: j4rp4_varid !! ID for the j4 variable - character(NAMELEN) :: k2_varname = "k2" !! name of the Love number variable - integer(I4B) :: k2_varid !! ID for the Love number variable - character(NAMELEN) :: q_varname = "Q" !! name of the energy dissipation variable - integer(I4B) :: Q_varid !! ID for the energy dissipation variable - character(NAMELEN) :: ke_orb_varname = "KE_orb" !! name of the system orbital kinetic energy variable - integer(I4B) :: KE_orb_varid !! ID for the system orbital kinetic energy variable - character(NAMELEN) :: ke_spin_varname = "KE_spin" !! name of the system spin kinetic energy variable - integer(I4B) :: KE_spin_varid !! ID for the system spin kinetic energy variable - character(NAMELEN) :: pe_varname = "PE" !! name of the system potential energy variable - integer(I4B) :: PE_varid !! ID for the system potential energy variable - character(NAMELEN) :: L_orb_varname = "L_orb" !! name of the orbital angular momentum vector variable - integer(I4B) :: L_orb_varid !! ID for the system orbital angular momentum vector variable - character(NAMELEN) :: Lspin_varname = "Lspin" !! name of the spin angular momentum vector variable - integer(I4B) :: Lspin_varid !! ID for the system spin angular momentum vector variable - character(NAMELEN) :: L_escape_varname = "L_escape" !! name of the escaped angular momentum vector variable - integer(I4B) :: L_escape_varid !! ID for the escaped angular momentum vector variable - character(NAMELEN) :: Ecollisions_varname = "Ecollisions" !! name of the escaped angular momentum y variable - integer(I4B) :: Ecollisions_varid !! ID for the energy lost in collisions variable - character(NAMELEN) :: Euntracked_varname = "Euntracked" !! name of the energy that is untracked due to loss (untracked potential energy due to mergers and body energy for escaped bodies) - integer(I4B) :: Euntracked_varid !! ID for the energy that is untracked due to loss (untracked potential energy due to mergers and body energy for escaped bodies) - character(NAMELEN) :: GMescape_varname = "GMescape" !! name of the G*Mass of bodies that escape the system - integer(I4B) :: GMescape_varid !! ID for the G*Mass of bodies that escape the system - character(NAMELEN) :: origin_type_varname = "origin_type" !! name of the origin type variable (Initial Conditions, Disruption, etc.) - integer(I4B) :: origin_type_varid !! ID for the origin type - character(NAMELEN) :: origin_time_varname = "origin_time" !! name of the time of origin variable - integer(I4B) :: origin_time_varid !! ID for the origin time - character(NAMELEN) :: collision_id_varname = "collision_id" !! name of the collision id variable - integer(I4B) :: collision_id_varid !! Netcdf ID for the origin collision ID - character(NAMELEN) :: origin_rh_varname = "origin_rh" !! name of the heliocentric position vector of the body at the time of origin variable - integer(I4B) :: origin_rh_varid !! ID for the origin position vector variable - character(NAMELEN) :: origin_vh_varname = "origin_vh" !! name of the heliocentric velocity vector of the body at the time of origin variable - integer(I4B) :: origin_vh_varid !! ID for the origin velocity vector component - character(NAMELEN) :: discard_time_varname = "discard_time" !! name of the time of discard variable - integer(I4B) :: discard_time_varid !! ID for the time of discard variable - character(NAMELEN) :: discard_rh_varname = "discard_rh" !! name of the heliocentric position vector of the body at the time of discard variable - integer(I4B) :: discard_rh_varid !! ID for the heliocentric position vector of the body at the time of discard variable - character(NAMELEN) :: discard_vh_varname = "discard_vh" !! name of the heliocentric velocity vector of the body at the time of discard variable - integer(I4B) :: discard_vh_varid !! ID for the heliocentric velocity vector of the body at the time of discard variable - character(NAMELEN) :: discard_body_id_varname = "discard_body_id" !! name of the id of the other body involved in the discard - contains - procedure(abstract_io_netcdf_initialize_output), deferred :: initialize - procedure(abstract_io_netcdf_open), deferred :: open - procedure :: close => base_io_netcdf_close !! Closes an open NetCDF file - procedure :: flush => base_io_netcdf_flush !! Flushes the current buffer to disk by closing and re-opening the file. - procedure :: sync => base_io_netcdf_sync !! Syncrhonize the disk and memory buffer of the NetCDF file (e.g. commit the frame files stored in memory to disk) - end type base_io_netcdf_parameters - - abstract interface - subroutine abstract_io_netcdf_initialize_output(self, param) - import base_io_netcdf_parameters, base_parameters - implicit none - class(base_io_netcdf_parameters), intent(inout) :: self !! Parameters used to for writing a NetCDF dataset to file - class(base_parameters), intent(in) :: param !! Current run configuration parameters - end subroutine abstract_io_netcdf_initialize_output - end interface - type :: base_storage_frame class(*), allocatable :: item @@ -306,7 +176,6 @@ end subroutine abstract_io_netcdf_initialize_output integer(I4B) :: nt !! Number of unique time values in all saved snapshots real(DP), dimension(:), allocatable :: tvals !! The set of unique time values contained in the snapshots integer(I4B), dimension(:), allocatable :: tmap !! The t value -> index map - class(base_io_netcdf_parameters), allocatable :: nc !! NetCDF object attached to this storage object contains procedure :: reset => reset_storage !! Resets a storage object by deallocating all items and resetting the frame counter to 0 end type base_storage @@ -338,16 +207,6 @@ end subroutine abstract_io_netcdf_initialize_output type, abstract :: base_nbody_system end type base_nbody_system - abstract interface - subroutine abstract_io_netcdf_open(self, param, readonly) - import base_io_netcdf_parameters, base_parameters - implicit none - class(base_io_netcdf_parameters), intent(inout) :: self !! Parameters used to identify a particular NetCDF dataset - class(base_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 abstract_io_netcdf_open - end interface - contains subroutine copy_store(self, source) @@ -377,75 +236,6 @@ subroutine final_storage_frame(self) return end subroutine final_storage_frame - subroutine netcdf_check(status, call_identifier) - !! author: Carlisle A. Wishard, Dana Singh, and David A. Minton - !! - !! Checks the status of all NetCDF operations to catch errors - use netcdf - implicit none - ! Arguments - integer, intent (in) :: status !! The status code returned by a NetCDF function - character(len=*), intent(in), optional :: call_identifier !! String that indicates which calling function caused the error for diagnostic purposes - - if(status /= nf90_noerr) then - if (present(call_identifier)) write(*,*) "NetCDF error in ",trim(call_identifier) - write(*,*) trim(nf90_strerror(status)) - call swiftest_util_exit(FAILURE) - end if - - return - end subroutine netcdf_check - - - subroutine base_io_netcdf_close(self) - !! author: Carlisle A. Wishard, Dana Singh, and David A. Minton - !! - !! Closes a NetCDF file - use netcdf - implicit none - ! Arguments - class(base_io_netcdf_parameters), intent(inout) :: self !! Parameters used to identify a particular NetCDF dataset - - call netcdf_check( nf90_close(self%id), "base_io_netcdf_close" ) - - return - end subroutine base_io_netcdf_close - - - subroutine base_io_netcdf_flush(self, param) - !! author: David A. Minton - !! - !! Flushes the current buffer to disk by closing and re-opening the file. - !! - implicit none - ! Arguments - class(base_io_netcdf_parameters), intent(inout) :: self !! Parameters used to identify a particular NetCDF dataset - class(base_parameters), intent(inout) :: param !! Current run configuration parameters - - call self%close() - call self%open(param) - - return - end subroutine base_io_netcdf_flush - - - - subroutine base_io_netcdf_sync(self) - !! author: David A. Minton - !! - !! Syncrhonize the disk and memory buffer of the NetCDF file (e.g. commit the frame files stored in memory to disk) - !! - use netcdf - implicit none - ! Arguments - class(base_io_netcdf_parameters), intent(inout) :: self !! Parameters used to identify a particular NetCDF dataset - - call netcdf_check( nf90_sync(self%id), "base_io_netcdf_sync nf90_sync" ) - - return - end subroutine base_io_netcdf_sync - - subroutine base_util_final_storage(self) !! author: David A. Minton diff --git a/src/collision/collision_io.f90 b/src/collision/collision_io.f90 index 864fa93f9..963d86463 100644 --- a/src/collision/collision_io.f90 +++ b/src/collision/collision_io.f90 @@ -24,7 +24,7 @@ module subroutine collision_io_dump(self, param) integer(I4B) :: i select type(nc => self%nc) - class is (collision_io_parameters) + class is (collision_netcdf_parameters) select type(param) class is (swiftest_parameters) if (self%iframe > 0) then @@ -65,7 +65,7 @@ module subroutine collision_io_initialize_output(self, param) use netcdf implicit none ! Arguments - class(collision_io_parameters), intent(inout) :: self !! Parameters used to identify a particular NetCDF dataset + class(collision_netcdf_parameters), intent(inout) :: self !! Parameters used to identify a particular NetCDF dataset class(base_parameters), intent(in) :: param ! Internals integer(I4B) :: nvar, varid, vartype @@ -96,93 +96,93 @@ module subroutine collision_io_initialize_output(self, param) close(unit=LUN, status="delete") end if - call netcdf_check( nf90_create(nc%file_name, NF90_NETCDF4, nc%id), "collision_io_initialize_output nf90_create" ) + call netcdf_io_check( nf90_create(nc%file_name, NF90_NETCDF4, nc%id), "collision_io_initialize_output nf90_create" ) ! Dimensions - call netcdf_check( nf90_def_dim(nc%id, nc%event_dimname, nc%event_dimsize, nc%event_dimid), "collision_io_initialize_output nf90_def_dim event_dimid" ) ! Dimension to store individual collision events - call netcdf_check( nf90_def_dim(nc%id, nc%space_dimname, NDIM, nc%space_dimid), "collision_io_initialize_output nf90_def_dim space_dimid" ) ! 3D space dimension - call netcdf_check( nf90_def_dim(nc%id, nc%name_dimname, nc%name_dimsize, nc%name_dimid), "collision_io_initialize_output nf90_def_dim name_dimid" ) ! Dimension to store particle id numbers - call netcdf_check( nf90_def_dim(nc%id, nc%str_dimname, NAMELEN, nc%str_dimid), "collision_io_initialize_output nf90_def_dim str_dimid" ) ! Dimension for string variables (aka character arrays) - call netcdf_check( nf90_def_dim(nc%id, nc%stage_dimname, 2, nc%stage_dimid), "collision_io_initialize_output nf90_def_dim stage_dimid" ) ! Dimension for stage variables (aka "before" vs. "after" + call netcdf_io_check( nf90_def_dim(nc%id, nc%event_dimname, nc%event_dimsize, nc%event_dimid), "collision_io_initialize_output nf90_def_dim event_dimid" ) ! Dimension to store individual collision events + call netcdf_io_check( nf90_def_dim(nc%id, nc%space_dimname, NDIM, nc%space_dimid), "collision_io_initialize_output nf90_def_dim space_dimid" ) ! 3D space dimension + call netcdf_io_check( nf90_def_dim(nc%id, nc%name_dimname, nc%name_dimsize, nc%name_dimid), "collision_io_initialize_output nf90_def_dim name_dimid" ) ! Dimension to store particle id numbers + call netcdf_io_check( nf90_def_dim(nc%id, nc%str_dimname, NAMELEN, nc%str_dimid), "collision_io_initialize_output nf90_def_dim str_dimid" ) ! Dimension for string variables (aka character arrays) + call netcdf_io_check( nf90_def_dim(nc%id, nc%stage_dimname, 2, nc%stage_dimid), "collision_io_initialize_output nf90_def_dim stage_dimid" ) ! Dimension for stage variables (aka "before" vs. "after" ! Dimension coordinates - call netcdf_check( nf90_def_var(nc%id, nc%space_dimname, NF90_CHAR, nc%space_dimid, nc%space_varid), "collision_io_initialize_output nf90_def_var space_varid" ) - call netcdf_check( nf90_def_var(nc%id, nc%name_dimname, NF90_CHAR, [nc%str_dimid, nc%name_dimid], nc%name_varid), "collision_io_initialize_output nf90_def_var name_varid") - call netcdf_check( nf90_def_var(nc%id, nc%stage_dimname, NF90_CHAR, [nc%str_dimid, nc%stage_dimid], nc%stage_varid), "collision_io_initialize_output nf90_def_var stage_varid" ) + call netcdf_io_check( nf90_def_var(nc%id, nc%space_dimname, NF90_CHAR, nc%space_dimid, nc%space_varid), "collision_io_initialize_output nf90_def_var space_varid" ) + call netcdf_io_check( nf90_def_var(nc%id, nc%name_dimname, NF90_CHAR, [nc%str_dimid, nc%name_dimid], nc%name_varid), "collision_io_initialize_output nf90_def_var name_varid") + call netcdf_io_check( nf90_def_var(nc%id, nc%stage_dimname, NF90_CHAR, [nc%str_dimid, nc%stage_dimid], nc%stage_varid), "collision_io_initialize_output nf90_def_var stage_varid" ) ! Variables - call netcdf_check( nf90_def_var(nc%id, nc%id_varname, NF90_INT, nc%name_dimid, nc%id_varid), "collision_io_initialize_output nf90_def_var id_varid" ) - call netcdf_check( nf90_def_var(nc%id, nc%time_dimname, nc%out_type, & + call netcdf_io_check( nf90_def_var(nc%id, nc%id_varname, NF90_INT, nc%name_dimid, nc%id_varid), "collision_io_initialize_output nf90_def_var id_varid" ) + call netcdf_io_check( nf90_def_var(nc%id, nc%time_dimname, nc%out_type, & nc%event_dimid, nc%time_varid), "collision_io_initialize_output nf90_def_var time_varid" ) - call netcdf_check( nf90_def_var(nc%id, nc%regime_varname, NF90_CHAR, & + call netcdf_io_check( nf90_def_var(nc%id, nc%regime_varname, NF90_CHAR, & [nc%str_dimid, nc%event_dimid], nc%regime_varid), "collision_io_initialize_output nf90_def_var regime_varid") - call netcdf_check( nf90_def_var(nc%id, nc%Qloss_varname, nc%out_type, & + call netcdf_io_check( nf90_def_var(nc%id, nc%Qloss_varname, nc%out_type, & [ nc%event_dimid], nc%Qloss_varid), "collision_io_initialize_output nf90_def_var Qloss_varid") - call netcdf_check( nf90_def_var(nc%id, nc%ptype_varname, NF90_CHAR, & + call netcdf_io_check( nf90_def_var(nc%id, nc%ptype_varname, NF90_CHAR, & [nc%str_dimid, nc%name_dimid, nc%stage_dimid, nc%event_dimid], nc%ptype_varid), "collision_io_initialize_output nf90_def_var ptype_varid") - call netcdf_check( nf90_def_var(nc%id, nc%loop_varname, NF90_INT, & + call netcdf_io_check( nf90_def_var(nc%id, nc%loop_varname, NF90_INT, & [ nc%event_dimid], nc%loop_varid), "collision_io_initialize_output nf90_def_var loop_varid") - call netcdf_check( nf90_def_var(nc%id, nc%rh_varname, nc%out_type,& + call netcdf_io_check( nf90_def_var(nc%id, nc%rh_varname, nc%out_type,& [ nc%space_dimid, nc%name_dimid, nc%stage_dimid, nc%event_dimid], nc%rh_varid), "collision_io_initialize_output nf90_def_var rh_varid") - call netcdf_check( nf90_def_var(nc%id, nc%vh_varname, nc%out_type,& + call netcdf_io_check( nf90_def_var(nc%id, nc%vh_varname, nc%out_type,& [ nc%space_dimid, nc%name_dimid, nc%stage_dimid, nc%event_dimid], nc%vh_varid), "collision_io_initialize_output nf90_def_var vh_varid") - call netcdf_check( nf90_def_var(nc%id, nc%Gmass_varname, nc%out_type,& + call netcdf_io_check( nf90_def_var(nc%id, nc%Gmass_varname, nc%out_type,& [ nc%name_dimid, nc%stage_dimid, nc%event_dimid], nc%Gmass_varid), "collision_io_initialize_output nf90_def_var Gmass_varid") - call netcdf_check( nf90_def_var(nc%id, nc%radius_varname, nc%out_type,& + call netcdf_io_check( nf90_def_var(nc%id, nc%radius_varname, nc%out_type,& [ nc%name_dimid, nc%stage_dimid, nc%event_dimid], nc%radius_varid), "collision_io_initialize_output nf90_def_var radius_varid") - call netcdf_check( nf90_def_var(nc%id, nc%Ip_varname, nc%out_type,& + call netcdf_io_check( nf90_def_var(nc%id, nc%Ip_varname, nc%out_type,& [ nc%space_dimid, nc%name_dimid, nc%stage_dimid, nc%event_dimid], nc%Ip_varid), "collision_io_initialize_output nf90_def_var Ip_varid") - call netcdf_check( nf90_def_var(nc%id, nc%rot_varname, nc%out_type,& + call netcdf_io_check( nf90_def_var(nc%id, nc%rot_varname, nc%out_type,& [ nc%space_dimid, nc%name_dimid, nc%stage_dimid, nc%event_dimid], nc%rot_varid), "collision_io_initialize_output nf90_def_var rot_varid") if (param%lenergy) then - call netcdf_check( nf90_def_var(nc%id, nc%ke_orb_varname, nc%out_type,& + call netcdf_io_check( nf90_def_var(nc%id, nc%ke_orb_varname, nc%out_type,& [ nc%stage_dimid, nc%event_dimid], nc%KE_orb_varid), "collision_io_initialize_output nf90_def_var KE_orb_varid") - call netcdf_check( nf90_def_var(nc%id, nc%ke_spin_varname, nc%out_type,& + call netcdf_io_check( nf90_def_var(nc%id, nc%ke_spin_varname, nc%out_type,& [ nc%stage_dimid, nc%event_dimid], nc%KE_spin_varid), "collision_io_initialize_output nf90_def_var KE_spin_varid" ) - call netcdf_check( nf90_def_var(nc%id, nc%pe_varname, nc%out_type,& + call netcdf_io_check( nf90_def_var(nc%id, nc%pe_varname, nc%out_type,& [ nc%stage_dimid, nc%event_dimid], nc%PE_varid), "collision_io_initialize_output nf90_def_var PE_varid" ) - call netcdf_check( nf90_def_var(nc%id, nc%L_orb_varname, nc%out_type, & + call netcdf_io_check( nf90_def_var(nc%id, nc%L_orb_varname, nc%out_type, & [ nc%space_dimid, nc%stage_dimid, nc%event_dimid], nc%L_orb_varid), "collision_io_initialize_output nf90_def_var L_orb_varid" ) - call netcdf_check( nf90_def_var(nc%id, nc%Lspin_varname, nc%out_type,& + call netcdf_io_check( nf90_def_var(nc%id, nc%Lspin_varname, nc%out_type,& [ nc%space_dimid, nc%stage_dimid, nc%event_dimid], nc%Lspin_varid), "collision_io_initialize_output nf90_def_var Lspin_varid" ) end if - call netcdf_check( nf90_inquire(nc%id, nVariables=nvar), "collision_io_initialize_output nf90_inquire nVariables" ) + call netcdf_io_check( nf90_inquire(nc%id, nVariables=nvar), "collision_io_initialize_output nf90_inquire nVariables" ) do varid = 1, nvar - call netcdf_check( nf90_inquire_variable(nc%id, varid, xtype=vartype, ndims=ndims), "collision_io_initialize_output nf90_inquire_variable" ) + call netcdf_io_check( nf90_inquire_variable(nc%id, varid, xtype=vartype, ndims=ndims), "collision_io_initialize_output nf90_inquire_variable" ) select case(vartype) case(NF90_INT) - call netcdf_check( nf90_def_var_fill(nc%id, varid, NO_FILL, NF90_FILL_INT), "collision_io_initialize_output nf90_def_var_fill NF90_INT" ) + call netcdf_io_check( nf90_def_var_fill(nc%id, varid, NO_FILL, NF90_FILL_INT), "collision_io_initialize_output nf90_def_var_fill NF90_INT" ) case(NF90_FLOAT) - call netcdf_check( nf90_def_var_fill(nc%id, varid, NO_FILL, sfill), "collision_io_initialize_output nf90_def_var_fill NF90_FLOAT" ) + call netcdf_io_check( nf90_def_var_fill(nc%id, varid, NO_FILL, sfill), "collision_io_initialize_output nf90_def_var_fill NF90_FLOAT" ) case(NF90_DOUBLE) - call netcdf_check( nf90_def_var_fill(nc%id, varid, NO_FILL, dfill), "collision_io_initialize_output nf90_def_var_fill NF90_DOUBLE" ) + call netcdf_io_check( nf90_def_var_fill(nc%id, varid, NO_FILL, dfill), "collision_io_initialize_output nf90_def_var_fill NF90_DOUBLE" ) case(NF90_CHAR) - call netcdf_check( nf90_def_var_fill(nc%id, varid, NO_FILL, 0), "collision_io_initialize_output nf90_def_var_fill NF90_CHAR" ) + call netcdf_io_check( nf90_def_var_fill(nc%id, varid, NO_FILL, 0), "collision_io_initialize_output nf90_def_var_fill NF90_CHAR" ) end select end do ! Take the file out of define mode - call netcdf_check( nf90_enddef(nc%id), "collision_io_initialize_output nf90_enddef" ) + call netcdf_io_check( nf90_enddef(nc%id), "collision_io_initialize_output nf90_enddef" ) ! Add in the space and stage dimension coordinates - call netcdf_check( nf90_put_var(nc%id, nc%space_varid, nc%space_coords, start=[1], count=[NDIM]), "collision_io_initialize_output nf90_put_var space" ) - call netcdf_check( nf90_put_var(nc%id, nc%stage_varid, nc%stage_coords(1), start=[1,1], count=[len(nc%stage_coords(1)),1]), "collision_io_initialize_output nf90_put_var stage 1" ) - call netcdf_check( nf90_put_var(nc%id, nc%stage_varid, nc%stage_coords(2), start=[1,2], count=[len(nc%stage_coords(2)),1]), "collision_io_initialize_output nf90_put_var stage 2" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%space_varid, nc%space_coords, start=[1], count=[NDIM]), "collision_io_initialize_output nf90_put_var space" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%stage_varid, nc%stage_coords(1), start=[1,1], count=[len(nc%stage_coords(1)),1]), "collision_io_initialize_output nf90_put_var stage 1" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%stage_varid, nc%stage_coords(2), start=[1,2], count=[len(nc%stage_coords(2)),1]), "collision_io_initialize_output nf90_put_var stage 2" ) end associate end select @@ -211,16 +211,16 @@ module subroutine collision_io_write_frame_snapshot(self, history, param) class(swiftest_pl), allocatable :: pl select type(nc => history%nc) - class is (collision_io_parameters) + class is (collision_netcdf_parameters) associate(system => self%collision_system, impactors => self%collision_system%impactors, fragments => self%collision_system%fragments, eslot => param%ioutput) - call netcdf_check( nf90_set_fill(nc%id, nf90_nofill, old_mode), "collision_io_write_frame_snapshot nf90_set_fill" ) + call netcdf_io_check( nf90_set_fill(nc%id, nf90_nofill, old_mode), "collision_io_write_frame_snapshot nf90_set_fill" ) - call netcdf_check( nf90_put_var(nc%id, nc%time_varid, self%t, start=[eslot]), "collision_io_write_frame_snapshot nf90_put_var time_varid" ) - call netcdf_check( nf90_put_var(nc%id, nc%loop_varid, int(self%iloop,kind=I4B), start=[eslot]), "collision_io_write_frame_snapshot nf90_put_varloop_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%time_varid, self%t, start=[eslot]), "collision_io_write_frame_snapshot nf90_put_var time_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%loop_varid, int(self%iloop,kind=I4B), start=[eslot]), "collision_io_write_frame_snapshot nf90_put_varloop_varid" ) charstring = trim(adjustl(REGIME_NAMES(impactors%regime))) - call netcdf_check( nf90_put_var(nc%id, nc%regime_varid, charstring, start=[1, eslot], count=[len(charstring), 1]), "collision_io_write_frame_snapshot nf90_put_var regime_varid" ) - call netcdf_check( nf90_put_var(nc%id, nc%Qloss_varid, impactors%Qloss, start=[eslot] ), "collision_io_write_frame_snapshot nf90_put_var Qloss_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%regime_varid, charstring, start=[1, eslot], count=[len(charstring), 1]), "collision_io_write_frame_snapshot nf90_put_var regime_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%Qloss_varid, impactors%Qloss, start=[eslot] ), "collision_io_write_frame_snapshot nf90_put_var Qloss_varid" ) select type(before =>self%collision_system%before) class is (swiftest_nbody_system) @@ -237,30 +237,30 @@ module subroutine collision_io_write_frame_snapshot(self, history, param) npl = pl%nbody do i = 1, npl idslot = findloc(history%idvals,pl%id(i),dim=1) - call netcdf_check( nf90_put_var(nc%id, nc%id_varid, pl%id(i), start=[ idslot ]), "collision_io_write_frame_snapshot nf90_put_var id_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%id_varid, pl%id(i), start=[ idslot ]), "collision_io_write_frame_snapshot nf90_put_var id_varid" ) charstring = trim(adjustl(pl%info(i)%name)) - call netcdf_check( nf90_put_var(nc%id, nc%name_varid, charstring, start=[1, idslot ], count=[len(charstring), 1]), "collision_io_write_frame_snapshot nf90_put_var name_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%name_varid, charstring, start=[1, idslot ], count=[len(charstring), 1]), "collision_io_write_frame_snapshot nf90_put_var name_varid" ) charstring = trim(adjustl(pl%info(i)%particle_type)) - call netcdf_check( nf90_put_var(nc%id, nc%ptype_varid, charstring, start=[1, idslot, stage, eslot], count=[len(charstring), 1, 1]), "collision_io_write_frame_snapshot nf90_put_var particle_type_varid" ) - call netcdf_check( nf90_put_var(nc%id, nc%rh_varid, pl%rh(:,i), start=[1, idslot, stage, eslot], count=[NDIM,1,1,1]), "collision_io_write_frame_snapshot nf90_put_var rh_varid" ) - call netcdf_check( nf90_put_var(nc%id, nc%vh_varid, pl%vh(:,i), start=[1, idslot, stage, eslot], count=[NDIM,1,1,1]), "collision_io_write_frame_snapshot nf90_put_var vh_varid" ) - call netcdf_check( nf90_put_var(nc%id, nc%Gmass_varid, pl%Gmass(i), start=[ idslot, stage, eslot]), "collision_io_write_frame_snapshot nf90_put_var Gmass_varid" ) - call netcdf_check( nf90_put_var(nc%id, nc%radius_varid, pl%radius(i), start=[ idslot, stage, eslot]), "collision_io_write_frame_snapshot nf90_put_var radius_varid" ) - call netcdf_check( nf90_put_var(nc%id, nc%Ip_varid, pl%Ip(:,i), start=[1, idslot, stage, eslot], count=[NDIM,1,1,1]), "collision_io_write_frame_snapshot nf90_put_var Ip_varid" ) - call netcdf_check( nf90_put_var(nc%id, nc%rot_varid, pl%rot(:,i), start=[1, idslot, stage, eslot], count=[NDIM,1,1,1]), "collision_io_write_frame_snapshot nf90_put_var rotx_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%ptype_varid, charstring, start=[1, idslot, stage, eslot], count=[len(charstring), 1, 1]), "collision_io_write_frame_snapshot nf90_put_var particle_type_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%rh_varid, pl%rh(:,i), start=[1, idslot, stage, eslot], count=[NDIM,1,1,1]), "collision_io_write_frame_snapshot nf90_put_var rh_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%vh_varid, pl%vh(:,i), start=[1, idslot, stage, eslot], count=[NDIM,1,1,1]), "collision_io_write_frame_snapshot nf90_put_var vh_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%Gmass_varid, pl%Gmass(i), start=[ idslot, stage, eslot]), "collision_io_write_frame_snapshot nf90_put_var Gmass_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%radius_varid, pl%radius(i), start=[ idslot, stage, eslot]), "collision_io_write_frame_snapshot nf90_put_var radius_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%Ip_varid, pl%Ip(:,i), start=[1, idslot, stage, eslot], count=[NDIM,1,1,1]), "collision_io_write_frame_snapshot nf90_put_var Ip_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%rot_varid, pl%rot(:,i), start=[1, idslot, stage, eslot], count=[NDIM,1,1,1]), "collision_io_write_frame_snapshot nf90_put_var rotx_varid" ) end do end do end select end select if (param%lenergy) then - call netcdf_check( nf90_put_var(nc%id, nc%ke_orb_varid, system%ke_orbit(:), start=[ 1, eslot], count=[ 2, 1]), "collision_io_write_frame_snapshot nf90_put_var ke_orb_varid before" ) - call netcdf_check( nf90_put_var(nc%id, nc%ke_spin_varid, system%ke_spin(:), start=[ 1, eslot], count=[ 2, 1]), "collision_io_write_frame_snapshot nf90_put_var ke_spin_varid before" ) - call netcdf_check( nf90_put_var(nc%id, nc%pe_varid, system%pe(:), start=[ 1, eslot], count=[ 2, 1]), "collision_io_write_frame_snapshot nf90_put_var pe_varid before" ) - call netcdf_check( nf90_put_var(nc%id, nc%L_orb_varid, system%Lorbit(:,:), start=[1, 1, eslot], count=[NDIM, 2, 1]), "collision_io_write_frame_snapshot nf90_put_var L_orb_varid before" ) - call netcdf_check( nf90_put_var(nc%id, nc%Lspin_varid, system%Lspin(:,:), start=[1, 1, eslot], count=[NDIM, 2, 1]), "collision_io_write_frame_snapshot nf90_put_var Lspin_varid before" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%ke_orb_varid, system%ke_orbit(:), start=[ 1, eslot], count=[ 2, 1]), "collision_io_write_frame_snapshot nf90_put_var ke_orb_varid before" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%ke_spin_varid, system%ke_spin(:), start=[ 1, eslot], count=[ 2, 1]), "collision_io_write_frame_snapshot nf90_put_var ke_spin_varid before" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%pe_varid, system%pe(:), start=[ 1, eslot], count=[ 2, 1]), "collision_io_write_frame_snapshot nf90_put_var pe_varid before" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%L_orb_varid, system%Lorbit(:,:), start=[1, 1, eslot], count=[NDIM, 2, 1]), "collision_io_write_frame_snapshot nf90_put_var L_orb_varid before" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%Lspin_varid, system%Lspin(:,:), start=[1, 1, eslot], count=[NDIM, 2, 1]), "collision_io_write_frame_snapshot nf90_put_var Lspin_varid before" ) end if - call netcdf_check( nf90_set_fill(nc%id, old_mode, old_mode) ) + call netcdf_io_check( nf90_set_fill(nc%id, old_mode, old_mode) ) end associate end select return diff --git a/src/collision/collision_module.f90 b/src/collision/collision_module.f90 index a4e6cd9bb..ccde318cc 100644 --- a/src/collision/collision_module.f90 +++ b/src/collision/collision_module.f90 @@ -137,7 +137,7 @@ module collision !! NetCDF dimension and variable names for the enounter save object - type, extends(encounter_io_parameters) :: collision_io_parameters + type, extends(encounter_netcdf_parameters) :: collision_netcdf_parameters integer(I4B) :: stage_dimid !! ID for the stage dimension integer(I4B) :: stage_varid !! ID for the stage variable character(NAMELEN) :: stage_dimname = "stage" !! name of the stage dimension (before/after) @@ -154,7 +154,7 @@ module collision integer(I4B) :: regime_varid !! ID for the collision regime variable contains procedure :: initialize => collision_io_initialize_output !! Initialize a set of parameters used to identify a NetCDF output object - end type collision_io_parameters + end type collision_netcdf_parameters type, extends(encounter_snapshot) :: collision_snapshot @@ -205,7 +205,7 @@ end subroutine collision_io_dump module subroutine collision_io_initialize_output(self, param) implicit none - class(collision_io_parameters), intent(inout) :: self !! Parameters used to identify a particular NetCDF dataset + class(collision_netcdf_parameters), intent(inout) :: self !! Parameters used to identify a particular NetCDF dataset class(base_parameters), intent(in) :: param !! Current run configuration parameters end subroutine collision_io_initialize_output diff --git a/src/encounter/encounter_check.f90 b/src/encounter/encounter_check.f90 index cccb0bfe9..de81b75bc 100644 --- a/src/encounter/encounter_check.f90 +++ b/src/encounter/encounter_check.f90 @@ -43,7 +43,7 @@ module subroutine encounter_check_all_plpl(param, npl, x, v, renc, dt, nenc, ind ! lfirst = .false. ! itimer%step_counter = INTERACTION_TIMER_CADENCE ! else - ! if (itimer%io_netcdf_check(param, nplpl)) call itimer%time_this_loop(param, nplpl) + ! if (itimer%netcdf_io_check(param, nplpl)) call itimer%time_this_loop(param, nplpl) ! end if ! else ! param%lencounter_sas_plpl = .false. @@ -117,7 +117,7 @@ module subroutine encounter_check_all_plplm(param, nplm, nplt, xplm, vplm, xplt, ! lfirst = .false. ! itimer%step_counter = INTERACTION_TIMER_CADENCE ! else - ! if (itimer%io_netcdf_check(param, nplplm)) call itimer%time_this_loop(param, nplplm) + ! if (itimer%netcdf_io_check(param, nplplm)) call itimer%time_this_loop(param, nplplm) ! end if ! else ! param%lencounter_sas_plpl = .false. @@ -214,7 +214,7 @@ module subroutine encounter_check_all_pltp(param, npl, ntp, xpl, vpl, xtp, vtp, ! if (lsecond) then ! This ensures that the encounter check methods are run at least once prior to timing. Sort and sweep improves on the second pass due to the bounding box extents needing to be nearly sorted ! call itimer%time_this_loop(param, npltp) ! lsecond = .false. - ! else if (itimer%io_netcdf_check(param, npltp)) then + ! else if (itimer%netcdf_io_check(param, npltp)) then ! lsecond = .true. ! itimer%is_on = .false. ! end if diff --git a/src/encounter/encounter_io.f90 b/src/encounter/encounter_io.f90 index df82d567e..1529dd955 100644 --- a/src/encounter/encounter_io.f90 +++ b/src/encounter/encounter_io.f90 @@ -23,7 +23,7 @@ module subroutine encounter_io_dump(self, param) integer(I4B) :: i select type(nc => self%nc) - class is (encounter_io_parameters) + class is (encounter_netcdf_parameters) if (self%iframe > 0) then ! Create and save the output files for this encounter and fragmentation nc%file_number = nc%file_number + 1 @@ -62,7 +62,7 @@ module subroutine encounter_io_initialize_output(self, param) use netcdf implicit none ! Arguments - class(encounter_io_parameters), intent(inout) :: self !! Parameters used to identify a particular NetCDF dataset + class(encounter_netcdf_parameters), intent(inout) :: self !! Parameters used to identify a particular NetCDF dataset class(base_parameters), intent(in) :: param !! Current run configuration parameters ! Internals integer(I4B) :: nvar, varid, vartype @@ -91,54 +91,54 @@ module subroutine encounter_io_initialize_output(self, param) close(unit=LUN, status="delete") end if - call netcdf_check( nf90_create(nc%file_name, NF90_NETCDF4, nc%id), "encounter_io_initialize_output nf90_create" ) + call netcdf_io_check( nf90_create(nc%file_name, NF90_NETCDF4, nc%id), "encounter_io_initialize_output nf90_create" ) ! Dimensions - call netcdf_check( nf90_def_dim(nc%id, nc%time_dimname, nc%time_dimsize, nc%time_dimid), "encounter_io_initialize_output nf90_def_dim time_dimid" ) ! Simulation time dimension - call netcdf_check( nf90_def_dim(nc%id, nc%space_dimname, NDIM, nc%space_dimid), "encounter_io_initialize_output nf90_def_dim space_dimid" ) ! 3D space dimension - call netcdf_check( nf90_def_dim(nc%id, nc%name_dimname, nc%name_dimsize, nc%name_dimid), "encounter_io_initialize_output nf90_def_dim name_dimid" ) ! dimension to store particle id numbers - call netcdf_check( nf90_def_dim(nc%id, nc%str_dimname, NAMELEN, nc%str_dimid), "encounter_io_initialize_output nf90_def_dim str_dimid" ) ! Dimension for string variables (aka character arrays) + call netcdf_io_check( nf90_def_dim(nc%id, nc%time_dimname, nc%time_dimsize, nc%time_dimid), "encounter_io_initialize_output nf90_def_dim time_dimid" ) ! Simulation time dimension + call netcdf_io_check( nf90_def_dim(nc%id, nc%space_dimname, NDIM, nc%space_dimid), "encounter_io_initialize_output nf90_def_dim space_dimid" ) ! 3D space dimension + call netcdf_io_check( nf90_def_dim(nc%id, nc%name_dimname, nc%name_dimsize, nc%name_dimid), "encounter_io_initialize_output nf90_def_dim name_dimid" ) ! dimension to store particle id numbers + call netcdf_io_check( nf90_def_dim(nc%id, nc%str_dimname, NAMELEN, nc%str_dimid), "encounter_io_initialize_output nf90_def_dim str_dimid" ) ! Dimension for string variables (aka character arrays) ! Dimension coordinates - call netcdf_check( nf90_def_var(nc%id, nc%time_dimname, nc%out_type, nc%time_dimid, nc%time_varid), "encounter_io_initialize_output nf90_def_var time_varid" ) - call netcdf_check( nf90_def_var(nc%id, nc%space_dimname, NF90_CHAR, nc%space_dimid, nc%space_varid), "encounter_io_initialize_output nf90_def_var space_varid" ) - call netcdf_check( nf90_def_var(nc%id, nc%name_dimname, NF90_CHAR, [nc%str_dimid, nc%name_dimid], nc%name_varid), "encounter_io_initialize_output nf90_def_var id_varid" ) + call netcdf_io_check( nf90_def_var(nc%id, nc%time_dimname, nc%out_type, nc%time_dimid, nc%time_varid), "encounter_io_initialize_output nf90_def_var time_varid" ) + call netcdf_io_check( nf90_def_var(nc%id, nc%space_dimname, NF90_CHAR, nc%space_dimid, nc%space_varid), "encounter_io_initialize_output nf90_def_var space_varid" ) + call netcdf_io_check( nf90_def_var(nc%id, nc%name_dimname, NF90_CHAR, [nc%str_dimid, nc%name_dimid], nc%name_varid), "encounter_io_initialize_output nf90_def_var id_varid" ) ! Variables - call netcdf_check( nf90_def_var(nc%id, nc%id_varname, NF90_INT, nc%name_dimid, nc%id_varid), "encounter_io_initialize_output nf90_def_var id_varid" ) - call netcdf_check( nf90_def_var(nc%id, nc%ptype_varname, NF90_CHAR, [nc%str_dimid, nc%name_dimid], nc%ptype_varid), "encounter_io_initialize_output nf90_def_var ptype_varid" ) - call netcdf_check( nf90_def_var(nc%id, nc%rh_varname, nc%out_type, [nc%space_dimid, nc%name_dimid, nc%time_dimid], nc%rh_varid), "encounter_io_initialize_output nf90_def_var rh_varid" ) - call netcdf_check( nf90_def_var(nc%id, nc%vh_varname, nc%out_type, [nc%space_dimid, nc%name_dimid, nc%time_dimid], nc%vh_varid), "encounter_io_initialize_output nf90_def_var vh_varid" ) - call netcdf_check( nf90_def_var(nc%id, nc%Gmass_varname, nc%out_type, [nc%name_dimid, nc%time_dimid], nc%Gmass_varid), "encounter_io_initialize_output nf90_def_var Gmass_varid" ) - call netcdf_check( nf90_def_var(nc%id, nc%loop_varname, NF90_INT, [nc%time_dimid], nc%loop_varid), "encounter_io_initialize_output nf90_def_var loop_varid" ) + call netcdf_io_check( nf90_def_var(nc%id, nc%id_varname, NF90_INT, nc%name_dimid, nc%id_varid), "encounter_io_initialize_output nf90_def_var id_varid" ) + call netcdf_io_check( nf90_def_var(nc%id, nc%ptype_varname, NF90_CHAR, [nc%str_dimid, nc%name_dimid], nc%ptype_varid), "encounter_io_initialize_output nf90_def_var ptype_varid" ) + call netcdf_io_check( nf90_def_var(nc%id, nc%rh_varname, nc%out_type, [nc%space_dimid, nc%name_dimid, nc%time_dimid], nc%rh_varid), "encounter_io_initialize_output nf90_def_var rh_varid" ) + call netcdf_io_check( nf90_def_var(nc%id, nc%vh_varname, nc%out_type, [nc%space_dimid, nc%name_dimid, nc%time_dimid], nc%vh_varid), "encounter_io_initialize_output nf90_def_var vh_varid" ) + call netcdf_io_check( nf90_def_var(nc%id, nc%Gmass_varname, nc%out_type, [nc%name_dimid, nc%time_dimid], nc%Gmass_varid), "encounter_io_initialize_output nf90_def_var Gmass_varid" ) + call netcdf_io_check( nf90_def_var(nc%id, nc%loop_varname, NF90_INT, [nc%time_dimid], nc%loop_varid), "encounter_io_initialize_output nf90_def_var loop_varid" ) if (param%lclose) then - call netcdf_check( nf90_def_var(nc%id, nc%radius_varname, nc%out_type, [nc%name_dimid, nc%time_dimid], nc%radius_varid), "encounter_io_initialize_output nf90_def_var radius_varid" ) + call netcdf_io_check( nf90_def_var(nc%id, nc%radius_varname, nc%out_type, [nc%name_dimid, nc%time_dimid], nc%radius_varid), "encounter_io_initialize_output nf90_def_var radius_varid" ) end if if (param%lrotation) then - call netcdf_check( nf90_def_var(nc%id, nc%Ip_varname, nc%out_type, [nc%space_dimid, nc%name_dimid, nc%time_dimid], nc%Ip_varid), "encounter_io_initialize_output nf90_def_var Ip_varid" ) - call netcdf_check( nf90_def_var(nc%id, nc%rot_varname, nc%out_type, [nc%space_dimid, nc%name_dimid, nc%time_dimid], nc%rot_varid), "encounter_io_initialize_output nf90_def_var rot_varid" ) + call netcdf_io_check( nf90_def_var(nc%id, nc%Ip_varname, nc%out_type, [nc%space_dimid, nc%name_dimid, nc%time_dimid], nc%Ip_varid), "encounter_io_initialize_output nf90_def_var Ip_varid" ) + call netcdf_io_check( nf90_def_var(nc%id, nc%rot_varname, nc%out_type, [nc%space_dimid, nc%name_dimid, nc%time_dimid], nc%rot_varid), "encounter_io_initialize_output nf90_def_var rot_varid" ) end if - call netcdf_check( nf90_inquire(nc%id, nVariables=nvar), "encounter_io_initialize_output nf90_inquire nVariables" ) + call netcdf_io_check( nf90_inquire(nc%id, nVariables=nvar), "encounter_io_initialize_output nf90_inquire nVariables" ) do varid = 1, nvar - call netcdf_check( nf90_inquire_variable(nc%id, varid, xtype=vartype, ndims=ndims), "encounter_io_initialize_output nf90_inquire_variable" ) + call netcdf_io_check( nf90_inquire_variable(nc%id, varid, xtype=vartype, ndims=ndims), "encounter_io_initialize_output nf90_inquire_variable" ) select case(vartype) case(NF90_INT) - call netcdf_check( nf90_def_var_fill(nc%id, varid, NO_FILL, NF90_FILL_INT), "encounter_io_initialize_output nf90_def_var_fill NF90_INT" ) + call netcdf_io_check( nf90_def_var_fill(nc%id, varid, NO_FILL, NF90_FILL_INT), "encounter_io_initialize_output nf90_def_var_fill NF90_INT" ) case(NF90_FLOAT) - call netcdf_check( nf90_def_var_fill(nc%id, varid, NO_FILL, sfill), "encounter_io_initialize_output nf90_def_var_fill NF90_FLOAT" ) + call netcdf_io_check( nf90_def_var_fill(nc%id, varid, NO_FILL, sfill), "encounter_io_initialize_output nf90_def_var_fill NF90_FLOAT" ) case(NF90_DOUBLE) - call netcdf_check( nf90_def_var_fill(nc%id, varid, NO_FILL, dfill), "encounter_io_initialize_output nf90_def_var_fill NF90_DOUBLE" ) + call netcdf_io_check( nf90_def_var_fill(nc%id, varid, NO_FILL, dfill), "encounter_io_initialize_output nf90_def_var_fill NF90_DOUBLE" ) case(NF90_CHAR) - call netcdf_check( nf90_def_var_fill(nc%id, varid, NO_FILL, 0), "encounter_io_initialize_output nf90_def_var_fill NF90_CHAR" ) + call netcdf_io_check( nf90_def_var_fill(nc%id, varid, NO_FILL, 0), "encounter_io_initialize_output nf90_def_var_fill NF90_CHAR" ) end select end do ! Take the file out of define mode - call netcdf_check( nf90_enddef(nc%id), "encounter_io_initialize_output nf90_enddef" ) + call netcdf_io_check( nf90_enddef(nc%id), "encounter_io_initialize_output nf90_enddef" ) ! Add in the space dimension coordinates - call netcdf_check( nf90_put_var(nc%id, nc%space_varid, nc%space_coords, start=[1], count=[NDIM]), "encounter_io_initialize_output nf90_put_var space" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%space_varid, nc%space_coords, start=[1], count=[NDIM]), "encounter_io_initialize_output nf90_put_var space" ) end associate @@ -172,48 +172,48 @@ module subroutine encounter_io_write_frame_snapshot(self, history, param) select type(tp => self%tp) class is (swiftest_pl) select type (nc => history%nc) - class is (encounter_io_parameters) + class is (encounter_netcdf_parameters) associate(tslot => param%ioutput) - call netcdf_check( nf90_set_fill(nc%id, nf90_nofill, old_mode), "encounter_io_write_frame_snapshot nf90_set_fill" ) + call netcdf_io_check( nf90_set_fill(nc%id, nf90_nofill, old_mode), "encounter_io_write_frame_snapshot nf90_set_fill" ) - call netcdf_check( nf90_put_var(nc%id, nc%time_varid, self%t, start=[tslot]), "encounter_io_write_frame_snapshot nf90_put_var time_varid" ) - call netcdf_check( nf90_put_var(nc%id, nc%loop_varid, int(self%iloop,kind=I4B), start=[tslot]), "encounter_io_write_frame_snapshot nf90_put_var pl loop_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%time_varid, self%t, start=[tslot]), "encounter_io_write_frame_snapshot nf90_put_var time_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%loop_varid, int(self%iloop,kind=I4B), start=[tslot]), "encounter_io_write_frame_snapshot nf90_put_var pl loop_varid" ) npl = pl%nbody do i = 1, npl idslot = findloc(history%idvals,pl%id(i),dim=1) - call netcdf_check( nf90_put_var(nc%id, nc%id_varid, pl%id(i), start=[idslot]), "encounter_io_write_frame_snapshot nf90_put_var pl id_varid" ) - call netcdf_check( nf90_put_var(nc%id, nc%rh_varid, pl%rh(:,i), start=[1,idslot,tslot], count=[NDIM,1,1]), "encounter_io_write_frame_snapshot nf90_put_var pl rh_varid" ) - call netcdf_check( nf90_put_var(nc%id, nc%vh_varid, pl%vh(:,i), start=[1,idslot,tslot], count=[NDIM,1,1]), "encounter_io_write_frame_snapshot nf90_put_var pl vh_varid" ) - call netcdf_check( nf90_put_var(nc%id, nc%Gmass_varid, pl%Gmass(i), start=[idslot, tslot]), "encounter_io_write_frame_snapshot nf90_put_var pl Gmass_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%id_varid, pl%id(i), start=[idslot]), "encounter_io_write_frame_snapshot nf90_put_var pl id_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%rh_varid, pl%rh(:,i), start=[1,idslot,tslot], count=[NDIM,1,1]), "encounter_io_write_frame_snapshot nf90_put_var pl rh_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%vh_varid, pl%vh(:,i), start=[1,idslot,tslot], count=[NDIM,1,1]), "encounter_io_write_frame_snapshot nf90_put_var pl vh_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%Gmass_varid, pl%Gmass(i), start=[idslot, tslot]), "encounter_io_write_frame_snapshot nf90_put_var pl Gmass_varid" ) - if (param%lclose) call netcdf_check( nf90_put_var(nc%id, nc%radius_varid, pl%radius(i), start=[idslot, tslot]), "encounter_io_write_frame_snapshot nf90_put_var pl radius_varid" ) + if (param%lclose) call netcdf_io_check( nf90_put_var(nc%id, nc%radius_varid, pl%radius(i), start=[idslot, tslot]), "encounter_io_write_frame_snapshot nf90_put_var pl radius_varid" ) if (param%lrotation) then - call netcdf_check( nf90_put_var(nc%id, nc%Ip_varid, pl%Ip(:,i), start=[1, idslot, tslot], count=[NDIM,1,1]), "encounter_io_write_frame_snapshot nf90_put_var pl Ip_varid" ) - call netcdf_check( nf90_put_var(nc%id, nc%rot_varid, pl%rot(:,i), start=[1,idslot, tslot], count=[NDIM,1,1]), "encounter_io_write_frame_snapshot nf90_put_var pl rotx_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%Ip_varid, pl%Ip(:,i), start=[1, idslot, tslot], count=[NDIM,1,1]), "encounter_io_write_frame_snapshot nf90_put_var pl Ip_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%rot_varid, pl%rot(:,i), start=[1,idslot, tslot], count=[NDIM,1,1]), "encounter_io_write_frame_snapshot nf90_put_var pl rotx_varid" ) end if charstring = trim(adjustl(pl%info(i)%name)) - call netcdf_check( nf90_put_var(nc%id, nc%name_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "encounter_io_write_frame_snapshot nf90_put_var pl name_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%name_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "encounter_io_write_frame_snapshot nf90_put_var pl name_varid" ) charstring = trim(adjustl(pl%info(i)%particle_type)) - call netcdf_check( nf90_put_var(nc%id, nc%ptype_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "encounter_io_write_frame_snapshot nf90_put_var pl particle_type_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%ptype_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "encounter_io_write_frame_snapshot nf90_put_var pl particle_type_varid" ) end do ntp = tp%nbody do i = 1, ntp idslot = findloc(history%idvals,tp%id(i),dim=1) - call netcdf_check( nf90_put_var(nc%id, nc%id_varid, tp%id(i), start=[idslot]), "encounter_io_write_frame_snapshot nf90_put_var tp id_varid" ) - call netcdf_check( nf90_put_var(nc%id, nc%rh_varid, tp%rh(:,i), start=[1,idslot,tslot], count=[NDIM,1,1]), "encounter_io_write_frame_snapshot nf90_put_var tp rh_varid" ) - call netcdf_check( nf90_put_var(nc%id, nc%vh_varid, tp%vh(:,i), start=[1,idslot,tslot], count=[NDIM,1,1]), "encounter_io_write_frame_snapshot nf90_put_var tp vh_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%id_varid, tp%id(i), start=[idslot]), "encounter_io_write_frame_snapshot nf90_put_var tp id_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%rh_varid, tp%rh(:,i), start=[1,idslot,tslot], count=[NDIM,1,1]), "encounter_io_write_frame_snapshot nf90_put_var tp rh_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%vh_varid, tp%vh(:,i), start=[1,idslot,tslot], count=[NDIM,1,1]), "encounter_io_write_frame_snapshot nf90_put_var tp vh_varid" ) charstring = trim(adjustl(tp%info(i)%name)) - call netcdf_check( nf90_put_var(nc%id, nc%name_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "encounter_io_write_frame_snapshot nf90_put_var tp name_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%name_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "encounter_io_write_frame_snapshot nf90_put_var tp name_varid" ) charstring = trim(adjustl(tp%info(i)%particle_type)) - call netcdf_check( nf90_put_var(nc%id, nc%ptype_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "encounter_io_write_frame_snapshot nf90_put_var tp particle_type_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%ptype_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "encounter_io_write_frame_snapshot nf90_put_var tp particle_type_varid" ) end do - call netcdf_check( nf90_set_fill(nc%id, old_mode, old_mode) ) + call netcdf_io_check( nf90_set_fill(nc%id, old_mode, old_mode) ) end associate end select end select diff --git a/src/encounter/encounter_module.f90 b/src/encounter/encounter_module.f90 index 04e7170c6..5c32a4c97 100644 --- a/src/encounter/encounter_module.f90 +++ b/src/encounter/encounter_module.f90 @@ -13,6 +13,7 @@ module encounter !! Definition of classes and methods used to determine close encounters use globals use base + use netcdf_io implicit none public @@ -57,8 +58,22 @@ module encounter final :: encounter_util_final_snapshot end type encounter_snapshot + !> NetCDF dimension and variable names for the enounter save object + type, extends(netcdf_parameters) :: encounter_netcdf_parameters + character(NAMELEN) :: loop_varname = "loopnum" !! Loop number for encounter + integer(I4B) :: loop_varid !! ID for the recursion level variable + integer(I4B) :: time_dimsize = 0 !! Number of time values in snapshot + integer(I4B) :: name_dimsize = 0 !! Number of potential id values in snapshot + integer(I4B) :: file_number = 1 !! The number to append on the output file + contains + procedure :: initialize => encounter_io_initialize_output !! Initialize a set of parameters used to identify a NetCDF output object + procedure :: open => encounter_netcdf_io_open + end type encounter_netcdf_parameters + + !> A class that that is used to store simulation history data between file output type, extends(base_storage) :: encounter_storage + class(encounter_netcdf_parameters), allocatable :: nc !! NetCDF object attached to this storage object contains procedure :: dump => encounter_io_dump !! Dumps contents of encounter history to file procedure :: get_index_values => encounter_util_get_vals_storage !! Gets the unique values of the indices of a storage object (i.e. body id or time value) @@ -67,17 +82,7 @@ module encounter final :: encounter_util_final_storage end type encounter_storage - !> NetCDF dimension and variable names for the enounter save object - type, extends(base_io_netcdf_parameters) :: encounter_io_parameters - character(NAMELEN) :: loop_varname = "loopnum" !! Loop number for encounter - integer(I4B) :: loop_varid !! ID for the recursion level variable - integer(I4B) :: time_dimsize = 0 !! Number of time values in snapshot - integer(I4B) :: name_dimsize = 0 !! Number of potential id values in snapshot - integer(I4B) :: file_number = 1 !! The number to append on the output file - contains - procedure :: initialize => encounter_io_initialize_output !! Initialize a set of parameters used to identify a NetCDF output object - procedure :: open => encounter_io_netcdf_open - end type encounter_io_parameters + type encounter_bounding_box_1D integer(I4B) :: n !! Number of bodies with extents @@ -90,6 +95,7 @@ module encounter final :: encounter_util_final_aabb !! Finalize the axis-aligned bounding box (1D) - deallocates all allocatables end type + type encounter_bounding_box type(encounter_bounding_box_1D), dimension(SWEEPDIM) :: aabb contains @@ -99,6 +105,7 @@ module encounter generic :: sweep => sweep_single, sweep_double end type + interface module subroutine encounter_check_all_plpl(param, npl, x, v, renc, dt, nenc, index1, index2, lvdotr) use base, only: base_parameters @@ -219,16 +226,16 @@ end subroutine encounter_io_dump 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(encounter_netcdf_parameters), intent(inout) :: self !! Parameters used to identify a particular NetCDF dataset class(base_parameters), intent(in) :: param end subroutine encounter_io_initialize_output - module subroutine encounter_io_netcdf_open(self, param, readonly) + module subroutine encounter_netcdf_io_open(self, param, readonly) implicit none - class(encounter_io_parameters), intent(inout) :: self !! Parameters used to identify a particular NetCDF dataset + class(encounter_netcdf_parameters), intent(inout) :: self !! Parameters used to identify a particular NetCDF dataset class(base_parameters), intent(in) :: param !! Current run configuration parameters logical, optional, intent(in) :: readonly !! Logical flag indicating that this should be open read only - end subroutine encounter_io_netcdf_open + end subroutine encounter_netcdf_io_open module subroutine encounter_io_write_frame_snapshot(self, history, param) implicit none diff --git a/src/netcdf_io/netcdf_io_implementations.f90 b/src/netcdf_io/netcdf_io_implementations.f90 new file mode 100644 index 000000000..d08771203 --- /dev/null +++ b/src/netcdf_io/netcdf_io_implementations.f90 @@ -0,0 +1,66 @@ +!! Copyright 2022 - David Minton, Carlisle Wishard, Jennifer Pouplin, Jake Elliott, & Dana Singh +!! This file is part of Swiftest. +!! Swiftest is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License +!! as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. +!! Swiftest is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty +!! of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. +!! You should have received a copy of the GNU General Public License along with Swiftest. +!! If not, see: https://www.gnu.org/licenses. + +submodule (netcdf_io) s_netcdf_io_implementations + use netcdf +contains + + module subroutine netcdf_io_check(status, call_identifier) + !! author: Carlisle A. Wishard, Dana Singh, and David A. Minton + !! + !! Checks the status of all NetCDF operations to catch errors + use netcdf + implicit none + ! Arguments + integer, intent (in) :: status !! The status code returned by a NetCDF function + character(len=*), intent(in), optional :: call_identifier !! String that indicates which calling function caused the error for diagnostic purposes + + if(status /= nf90_noerr) then + if (present(call_identifier)) write(*,*) "NetCDF error in ",trim(call_identifier) + write(*,*) trim(nf90_strerror(status)) + call swiftest_util_exit(FAILURE) + end if + + return + end subroutine netcdf_io_check + + + module subroutine netcdf_io_close(self) + !! author: Carlisle A. Wishard, Dana Singh, and David A. Minton + !! + !! Closes a NetCDF file + use netcdf + implicit none + ! Arguments + class(netcdf_parameters), intent(inout) :: self !! Parameters used to identify a particular NetCDF dataset + + call netcdf_io_check( nf90_close(self%id), "netcdf_io_close" ) + + return + end subroutine netcdf_io_close + + + module subroutine netcdf_io_sync(self) + !! author: David A. Minton + !! + !! Syncrhonize the disk and memory buffer of the NetCDF file (e.g. commit the frame files stored in memory to disk) + !! + use netcdf + implicit none + ! Arguments + class(netcdf_parameters), intent(inout) :: self !! Parameters used to identify a particular NetCDF dataset + + call netcdf_io_check( nf90_sync(self%id), "netcdf_io_sync nf90_sync" ) + + return + end subroutine netcdf_io_sync + + + +end submodule s_netcdf_io_implementations diff --git a/src/netcdf_io/netcdf_io_module.f90 b/src/netcdf_io/netcdf_io_module.f90 new file mode 100644 index 000000000..bb3f098b8 --- /dev/null +++ b/src/netcdf_io/netcdf_io_module.f90 @@ -0,0 +1,159 @@ +!! Copyright 2022 - David Minton, Carlisle Wishard, Jennifer Pouplin, Jake Elliott, & Dana Singh +!! This file is part of Swiftest. +!! Swiftest is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License +!! as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. +!! Swiftest is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty +!! of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. +!! You should have received a copy of the GNU General Public License along with Swiftest. +!! If not, see: https://www.gnu.org/licenses. + +module netcdf_io + !! author: The Purdue Swiftest Team - David A. Minton, Carlisle A. Wishard, Jennifer L.L. Pouplin, and Jacob R. Elliott + !! + !! Base type definitions. This allows the collision and encounter modules to be defined before the swiftest module. + !! + use globals + use base + implicit none + public + + + !! This derived datatype stores the NetCDF ID values for each of the variables included in the NetCDF data file. This is used as the base class defined in base + type, abstract :: netcdf_parameters + character(STRMAX) :: file_name !! Name of the output file + integer(I4B) :: out_type !! output type (will be assigned either NF90_DOUBLE or NF90_FLOAT, depending on the user parameter) + integer(I4B) :: id !! ID for the output file + integer(I4B) :: name_chunk !! Chunk size for the id dimension variables + integer(I4B) :: time_chunk !! Chunk size for the time dimension variables + + ! Dimension ids and variable names + character(NAMELEN) :: str_dimname = "string32" !! name of the character string dimension + integer(I4B) :: str_dimid !! ID for the character string dimension + character(NAMELEN) :: time_dimname = "time" !! name of the time dimension + integer(I4B) :: time_dimid !! ID for the time dimension + integer(I4B) :: time_varid !! ID for the time variable + character(NAMELEN) :: name_dimname = "name" !! name of the particle name dimension + integer(I4B) :: name_dimid !! ID for the particle name dimension + integer(I4B) :: name_varid !! ID for the particle name variable + character(NAMELEN) :: space_dimname = "space" !! name of the space dimension + integer(I4B) :: space_dimid !! ID for the space dimension + integer(I4B) :: space_varid !! ID for the space variable + character(len=1), dimension(3) :: space_coords = ["x","y","z"] !! The space dimension coordinate labels + + ! Non-dimension ids and variable names + character(NAMELEN) :: id_varname = "id" !! name of the particle id variable + integer(I4B) :: id_varid !! ID for the id variable + character(NAMELEN) :: ptype_varname = "particle_type" !! name of the particle type variable + integer(I4B) :: ptype_varid !! ID for the particle type variable + character(NAMELEN) :: npl_varname = "npl" !! name of the number of active massive bodies variable + integer(I4B) :: npl_varid !! ID for the number of active massive bodies variable + character(NAMELEN) :: ntp_varname = "ntp" !! name of the number of active test particles variable + integer(I4B) :: ntp_varid !! ID for the number of active test particles variable + character(NAMELEN) :: nplm_varname = "nplm" !! name of the number of active fully interacting massive bodies variable (SyMBA) + integer(I4B) :: nplm_varid !! ID for the number of active fully interacting massive bodies variable (SyMBA) + character(NAMELEN) :: a_varname = "a" !! name of the semimajor axis variable + integer(I4B) :: a_varid !! ID for the semimajor axis variable + character(NAMELEN) :: e_varname = "e" !! name of the eccentricity variable + integer(I4B) :: e_varid !! ID for the eccentricity variable + character(NAMELEN) :: inc_varname = "inc" !! name of the inclination variable + integer(I4B) :: inc_varid !! ID for the inclination variable + character(NAMELEN) :: capom_varname = "capom" !! name of the long. asc. node variable + integer(I4B) :: capom_varid !! ID for the long. asc. node variable + character(NAMELEN) :: omega_varname = "omega" !! name of the arg. of periapsis variable + integer(I4B) :: omega_varid !! ID for the arg. of periapsis variable + character(NAMELEN) :: capm_varname = "capm" !! name of the mean anomaly variable + integer(I4B) :: capm_varid !! ID for the mean anomaly variable + character(NAMELEN) :: varpi_varname = "varpi" !! name of the long. of periapsis variable + integer(I4B) :: varpi_varid !! ID for the long. of periapsis variable + character(NAMELEN) :: lam_varname = "lam" !! name of the mean longitude variable + integer(I4B) :: lam_varid !! ID for the mean longitude variable + character(NAMELEN) :: f_varname = "f" !! name of the true anomaly variable + integer(I4B) :: f_varid !! ID for the true anomaly variable + character(NAMELEN) :: cape_varname = "cape" !! name of the eccentric anomaly variable + integer(I4B) :: cape_varid !! ID for the eccentric anomaly variable + character(NAMELEN) :: rh_varname = "rh" !! name of the heliocentric position vector variable + integer(I4B) :: rh_varid !! ID for the heliocentric position vector variable + character(NAMELEN) :: vh_varname = "vh" !! name of the heliocentric velocity vector variable + integer(I4B) :: vh_varid !! ID for the heliocentric velocity vector variable + character(NAMELEN) :: gr_pseudo_vh_varname = "gr_pseudo_vh" !! name of the heliocentric pseudovelocity vector variable (used in GR only) + integer(I4B) :: gr_pseudo_vh_varid !! ID for the heliocentric pseudovelocity vector variable (used in GR) + character(NAMELEN) :: gmass_varname = "Gmass" !! name of the mass variable + integer(I4B) :: Gmass_varid !! ID for the mass variable + character(NAMELEN) :: rhill_varname = "rhill" !! name of the hill radius variable + integer(I4B) :: rhill_varid !! ID for the hill radius variable + character(NAMELEN) :: radius_varname = "radius" !! name of the radius variable + integer(I4B) :: radius_varid !! ID for the radius variable + character(NAMELEN) :: Ip_varname = "Ip" !! name of the principal moment of inertial variable + integer(I4B) :: Ip_varid !! ID for the axis principal moment of inertia variable + character(NAMELEN) :: rot_varname = "rot" !! name of the rotation vector variable + integer(I4B) :: rot_varid !! ID for the rotation vector variable + character(NAMELEN) :: j2rp2_varname = "j2rp2" !! name of the j2rp2 variable + integer(I4B) :: j2rp2_varid !! ID for the j2 variable + character(NAMELEN) :: j4rp4_varname = "j4rp4" !! name of the j4pr4 variable + integer(I4B) :: j4rp4_varid !! ID for the j4 variable + character(NAMELEN) :: k2_varname = "k2" !! name of the Love number variable + integer(I4B) :: k2_varid !! ID for the Love number variable + character(NAMELEN) :: q_varname = "Q" !! name of the energy dissipation variable + integer(I4B) :: Q_varid !! ID for the energy dissipation variable + character(NAMELEN) :: ke_orb_varname = "KE_orb" !! name of the system orbital kinetic energy variable + integer(I4B) :: KE_orb_varid !! ID for the system orbital kinetic energy variable + character(NAMELEN) :: ke_spin_varname = "KE_spin" !! name of the system spin kinetic energy variable + integer(I4B) :: KE_spin_varid !! ID for the system spin kinetic energy variable + character(NAMELEN) :: pe_varname = "PE" !! name of the system potential energy variable + integer(I4B) :: PE_varid !! ID for the system potential energy variable + character(NAMELEN) :: L_orb_varname = "L_orb" !! name of the orbital angular momentum vector variable + integer(I4B) :: L_orb_varid !! ID for the system orbital angular momentum vector variable + character(NAMELEN) :: Lspin_varname = "Lspin" !! name of the spin angular momentum vector variable + integer(I4B) :: Lspin_varid !! ID for the system spin angular momentum vector variable + character(NAMELEN) :: L_escape_varname = "L_escape" !! name of the escaped angular momentum vector variable + integer(I4B) :: L_escape_varid !! ID for the escaped angular momentum vector variable + character(NAMELEN) :: Ecollisions_varname = "Ecollisions" !! name of the escaped angular momentum y variable + integer(I4B) :: Ecollisions_varid !! ID for the energy lost in collisions variable + character(NAMELEN) :: Euntracked_varname = "Euntracked" !! name of the energy that is untracked due to loss (untracked potential energy due to mergers and body energy for escaped bodies) + integer(I4B) :: Euntracked_varid !! ID for the energy that is untracked due to loss (untracked potential energy due to mergers and body energy for escaped bodies) + character(NAMELEN) :: GMescape_varname = "GMescape" !! name of the G*Mass of bodies that escape the system + integer(I4B) :: GMescape_varid !! ID for the G*Mass of bodies that escape the system + character(NAMELEN) :: origin_type_varname = "origin_type" !! name of the origin type variable (Initial Conditions, Disruption, etc.) + integer(I4B) :: origin_type_varid !! ID for the origin type + character(NAMELEN) :: origin_time_varname = "origin_time" !! name of the time of origin variable + integer(I4B) :: origin_time_varid !! ID for the origin time + character(NAMELEN) :: collision_id_varname = "collision_id" !! name of the collision id variable + integer(I4B) :: collision_id_varid !! Netcdf ID for the origin collision ID + character(NAMELEN) :: origin_rh_varname = "origin_rh" !! name of the heliocentric position vector of the body at the time of origin variable + integer(I4B) :: origin_rh_varid !! ID for the origin position vector variable + character(NAMELEN) :: origin_vh_varname = "origin_vh" !! name of the heliocentric velocity vector of the body at the time of origin variable + integer(I4B) :: origin_vh_varid !! ID for the origin velocity vector component + character(NAMELEN) :: discard_time_varname = "discard_time" !! name of the time of discard variable + integer(I4B) :: discard_time_varid !! ID for the time of discard variable + character(NAMELEN) :: discard_rh_varname = "discard_rh" !! name of the heliocentric position vector of the body at the time of discard variable + integer(I4B) :: discard_rh_varid !! ID for the heliocentric position vector of the body at the time of discard variable + character(NAMELEN) :: discard_vh_varname = "discard_vh" !! name of the heliocentric velocity vector of the body at the time of discard variable + integer(I4B) :: discard_vh_varid !! ID for the heliocentric velocity vector of the body at the time of discard variable + character(NAMELEN) :: discard_body_id_varname = "discard_body_id" !! name of the id of the other body involved in the discard + integer(I4B) :: discard_body_id_varid !! ID for the id of the other body involved in the discard + logical :: lpseudo_vel_exists = .false. !! Logical flag to indicate whether or not the pseudovelocity vectors were present in an old file. + contains + procedure :: close => netcdf_io_close !! Closes an open NetCDF file + procedure :: sync => netcdf_io_sync !! Syncrhonize the disk and memory buffer of the NetCDF file (e.g. commit the frame files stored in memory to disk) + end type netcdf_parameters + + interface + module subroutine netcdf_io_check(status, call_identifier) + implicit none + integer, intent (in) :: status !! The status code returned by a NetCDF function + character(len=*), intent(in), optional :: call_identifier !! String that indicates which calling function caused the error for diagnostic purposes + end subroutine netcdf_io_check + + module subroutine netcdf_io_close(self) + implicit none + class(netcdf_parameters), intent(inout) :: self !! Parameters used to identify a particular NetCDF dataset + end subroutine netcdf_io_close + + module subroutine netcdf_io_sync(self) + implicit none + class(netcdf_parameters), intent(inout) :: self !! Parameters used to identify a particular NetCDF dataset + end subroutine netcdf_io_sync + end interface + + +end module netcdf_io diff --git a/src/swiftest/swiftest_io.f90 b/src/swiftest/swiftest_io.f90 index cf2fe02d6..9c5fa4eb2 100644 --- a/src/swiftest/swiftest_io.f90 +++ b/src/swiftest/swiftest_io.f90 @@ -9,6 +9,7 @@ submodule (swiftest) s_io use symba + use netcdf contains module subroutine swiftest_io_compact_output(self, param, timer) @@ -246,7 +247,7 @@ module subroutine swiftest_io_dump_system(self, param) dump_param%in_type = "NETCDF_DOUBLE" dump_param%in_netcdf = trim(adjustl(DUMP_NC_FILE(idx))) associate(nc => dump_param%system_history%nc) - nc%id_chunk = self%pl%nbody + self%tp%nbody + nc%name_chunk = self%pl%nbody + self%tp%nbody nc%time_chunk = 1 dump_param%tstart = self%t @@ -264,11 +265,8 @@ module subroutine swiftest_io_dump_system(self, param) if (idx > NDUMPFILES) idx = 1 ! Dump the encounter history if necessary - select type(param) - class is (swiftest_parameters) - if (param%lenc_save_trajectory .or. param%lenc_save_closest) call self%encounter_history%dump(param) - call self%collision_history%dump(param) - end select + if (param%lenc_save_trajectory .or. param%lenc_save_closest) call self%encounter_history%dump(param) + call self%collision_history%dump(param) ! Dump the system history to file call param%system_history%dump(param) @@ -481,6 +479,1240 @@ module subroutine swiftest_io_log_start(param, file, header) end subroutine swiftest_io_log_start + module subroutine swiftest_io_netcdf_flush(self, param) + !! author: David A. Minton + !! + !! Flushes the current buffer to disk by closing and re-opening the file. + !! + implicit none + ! Arguments + class(swiftest_netcdf_parameters), intent(inout) :: self !! Parameters used to identify a particular NetCDF dataset + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + + call self%close() + call self%open(param) + + return + end subroutine swiftest_io_netcdf_flush + + + module function swiftest_io_netcdf_get_old_t_final_system(self, param) result(old_t_final) + !! author: David A. Minton + !! + !! Validates the dump file to check whether the dump file initial conditions duplicate the last frame of the netcdf output. + !! + implicit none + ! Arguments + class(swiftest_nbody_system), intent(inout) :: self + class(swiftest_parameters), intent(inout) :: param + ! Result + real(DP) :: old_t_final + ! Internals + integer(I4B) :: itmax, idmax + real(DP), dimension(:), allocatable :: vals + real(DP), dimension(1) :: rtemp + real(DP), dimension(NDIM) :: rot0, Ip0, Lnow + real(DP) :: KE_orb_orig, KE_spin_orig, PE_orig + + associate (nc => param%system_history%nc, cb => self%cb) + call nc%open(param) + call netcdf_io_check( nf90_inquire_dimension(nc%id, nc%time_dimid, len=itmax), "netcdf_io_get_old_t_final_system time_dimid" ) + call netcdf_io_check( nf90_inquire_dimension(nc%id, nc%name_dimid, len=idmax), "netcdf_io_get_old_t_final_system name_dimid" ) + allocate(vals(idmax)) + call netcdf_io_check( nf90_get_var(nc%id, nc%time_varid, rtemp, start=[1], count=[1]), "netcdf_io_get_old_t_final_system time_varid" ) + + !old_t_final = rtemp(1) + old_t_final = param%t0 ! For NetCDF it is safe to overwrite the final t value on a restart + + if (param%lenergy) then + call netcdf_io_check( nf90_get_var(nc%id, nc%KE_orb_varid, rtemp, start=[1], count=[1]), "netcdf_io_get_old_t_final_system KE_orb_varid" ) + KE_orb_orig = rtemp(1) + + call netcdf_io_check( nf90_get_var(nc%id, nc%KE_spin_varid, rtemp, start=[1], count=[1]), "netcdf_io_get_old_t_final_system KE_spin_varid" ) + KE_spin_orig = rtemp(1) + + call netcdf_io_check( nf90_get_var(nc%id, nc%PE_varid, rtemp, start=[1], count=[1]), "netcdf_io_get_old_t_final_system PE_varid" ) + PE_orig = rtemp(1) + + call netcdf_io_check( nf90_get_var(nc%id, nc%Ecollisions_varid, self%Ecollisions, start=[1]), "netcdf_io_get_old_t_final_system Ecollisions_varid" ) + call netcdf_io_check( nf90_get_var(nc%id, nc%Euntracked_varid, self%Euntracked, start=[1]), "netcdf_io_get_old_t_final_system Euntracked_varid" ) + + self%Eorbit_orig = KE_orb_orig + KE_spin_orig + PE_orig + self%Ecollisions + self%Euntracked + + call netcdf_io_check( nf90_get_var(nc%id, nc%L_orb_varid, self%Lorbit_orig(:), start=[1,1], count=[NDIM,1]), "netcdf_io_get_old_t_final_system L_orb_varid" ) + call netcdf_io_check( nf90_get_var(nc%id, nc%Lspin_varid, self%Lspin_orig(:), start=[1,1], count=[NDIM,1]), "netcdf_io_get_old_t_final_system Lspin_varid" ) + call netcdf_io_check( nf90_get_var(nc%id, nc%L_escape_varid, self%Lescape(:), start=[1,1], count=[NDIM,1]), "netcdf_io_get_old_t_final_system L_escape_varid" ) + + self%Ltot_orig(:) = self%Lorbit_orig(:) + self%Lspin_orig(:) + self%Lescape(:) + + call netcdf_io_check( nf90_get_var(nc%id, nc%Gmass_varid, vals, start=[1,1], count=[idmax,1]), "netcdf_io_get_old_t_final_system Gmass_varid" ) + call netcdf_io_check( nf90_get_var(nc%id, nc%GMescape_varid, self%GMescape, start=[1]), "netcdf_io_get_old_t_final_system GMescape_varid" ) + self%GMtot_orig = vals(1) + sum(vals(2:idmax), vals(2:idmax) == vals(2:idmax)) + self%GMescape + + cb%GM0 = vals(1) + cb%dGM = cb%Gmass - cb%GM0 + + call netcdf_io_check( nf90_get_var(nc%id, nc%radius_varid, rtemp, start=[1,1], count=[1,1]), "netcdf_io_get_old_t_final_system radius_varid" ) + cb%R0 = rtemp(1) + + if (param%lrotation) then + + call netcdf_io_check( nf90_get_var(nc%id, nc%rot_varid, rot0, start=[1,1,1], count=[NDIM,1,1]), "netcdf_io_get_old_t_final_system rot_varid" ) + call netcdf_io_check( nf90_get_var(nc%id, nc%Ip_varid, Ip0, start=[1,1,1], count=[NDIM,1,1]), "netcdf_io_get_old_t_final_system Ip_varid" ) + + cb%L0(:) = Ip0(3) * cb%GM0 * cb%R0**2 * rot0(:) + + Lnow(:) = cb%Ip(3) * cb%Gmass * cb%radius**2 * cb%rot(:) + cb%dL(:) = Lnow(:) - cb%L0(:) + end if + + end if + + deallocate(vals) + end associate + + return + end function swiftest_io_netcdf_get_old_t_final_system + + + module subroutine swiftest_io_netcdf_initialize_output(self, param) + !! author: Carlisle A. Wishard, Dana Singh, and David A. Minton + !! + !! Initialize a NetCDF file system and defines all variables. + use, intrinsic :: ieee_arithmetic + implicit none + ! Arguments + class(swiftest_netcdf_parameters), intent(inout) :: self !! Parameters used to for writing a NetCDF dataset to file + class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters + ! Internals + integer(I4B) :: nvar, varid, vartype + real(DP) :: dfill + real(SP) :: sfill + integer(I4B), parameter :: NO_FILL = 0 + logical :: fileExists + character(len=STRMAX) :: errmsg + integer(I4B) :: ndims + + associate(nc => self) + + dfill = ieee_value(dfill, IEEE_QUIET_NAN) + sfill = ieee_value(sfill, IEEE_QUIET_NAN) + + select case (param%out_type) + case("netcdf_io_FLOAT") + nc%out_type = NF90_FLOAT + case("netcdf_io_DOUBLE") + nc%out_type = NF90_DOUBLE + end select + + ! Check if the file exists, and if it does, delete it + inquire(file=nc%file_name, exist=fileExists) + if (fileExists) then + open(unit=LUN, file=nc%file_name, status="old", err=667, iomsg=errmsg) + close(unit=LUN, status="delete") + end if + + ! Create the file + call netcdf_io_check( nf90_create(nc%file_name, NF90_NETCDF4, nc%id), "netcdf_io_initialize_output nf90_create" ) + + ! Dimensions + call netcdf_io_check( nf90_def_dim(nc%id, nc%time_dimname, NF90_UNLIMITED, nc%time_dimid), "netcdf_io_initialize_output nf90_def_dim time_dimid" ) ! Simulation time dimension + call netcdf_io_check( nf90_def_dim(nc%id, nc%space_dimname, NDIM, nc%space_dimid), "netcdf_io_initialize_output nf90_def_dim space_dimid" ) ! 3D space dimension + call netcdf_io_check( nf90_def_dim(nc%id, nc%name_dimname, NF90_UNLIMITED, nc%name_dimid), "netcdf_io_initialize_output nf90_def_dim name_dimid" ) ! dimension to store particle id numbers + call netcdf_io_check( nf90_def_dim(nc%id, nc%str_dimname, NAMELEN, nc%str_dimid), "netcdf_io_initialize_output nf90_def_dim str_dimid" ) ! Dimension for string variables (aka character arrays) + + ! Dimension coordinates + call netcdf_io_check( nf90_def_var(nc%id, nc%time_dimname, nc%out_type, nc%time_dimid, nc%time_varid), "netcdf_io_initialize_output nf90_def_var time_varid" ) + call netcdf_io_check( nf90_def_var(nc%id, nc%space_dimname, NF90_CHAR, nc%space_dimid, nc%space_varid), "netcdf_io_initialize_output nf90_def_var space_varid" ) + call netcdf_io_check( nf90_def_var(nc%id, nc%name_dimname, NF90_CHAR, [nc%str_dimid, nc%name_dimid], nc%name_varid), "netcdf_io_initialize_output nf90_def_var name_varid" ) + + ! Variables + call netcdf_io_check( nf90_def_var(nc%id, nc%id_varname, NF90_INT, nc%name_dimid, nc%id_varid), "netcdf_io_initialize_output nf90_def_var id_varid" ) + call netcdf_io_check( nf90_def_var(nc%id, nc%npl_varname, NF90_INT, nc%time_dimid, nc%npl_varid), "netcdf_io_initialize_output nf90_def_var npl_varid" ) + call netcdf_io_check( nf90_def_var(nc%id, nc%ntp_varname, NF90_INT, nc%time_dimid, nc%ntp_varid), "netcdf_io_initialize_output nf90_def_var ntp_varid" ) + if (param%lmtiny_pl) call netcdf_io_check( nf90_def_var(nc%id, nc%nplm_varname, NF90_INT, nc%time_dimid, nc%nplm_varid), "netcdf_io_initialize_output nf90_def_var nplm_varid" ) + call netcdf_io_check( nf90_def_var(nc%id, nc%ptype_varname, NF90_CHAR, [nc%str_dimid, nc%name_dimid], nc%ptype_varid), "netcdf_io_initialize_output nf90_def_var ptype_varid" ) + + if ((param%out_form == "XV") .or. (param%out_form == "XVEL")) then + call netcdf_io_check( nf90_def_var(nc%id, nc%rh_varname, nc%out_type, [nc%space_dimid, nc%name_dimid, nc%time_dimid], nc%rh_varid), "netcdf_io_initialize_output nf90_def_var rh_varid" ) + call netcdf_io_check( nf90_def_var(nc%id, nc%vh_varname, nc%out_type, [nc%space_dimid, nc%name_dimid, nc%time_dimid], nc%vh_varid), "netcdf_io_initialize_output nf90_def_var vh_varid" ) + + !! When GR is enabled, we need to save the pseudovelocity vectors in addition to the true heliocentric velocity vectors, otherwise + !! we cannnot expect bit-identical runs from restarted runs with GR enabled due to floating point errors during the conversion. + if (param%lgr) then + call netcdf_io_check( nf90_def_var(nc%id, nc%gr_pseudo_vh_varname, nc%out_type, [nc%space_dimid, nc%name_dimid, nc%time_dimid], nc%gr_pseudo_vh_varid), "netcdf_io_initialize_output nf90_def_var gr_psuedo_vh_varid" ) + nc%lpseudo_vel_exists = .true. + end if + + end if + + if ((param%out_form == "EL") .or. (param%out_form == "XVEL")) then + call netcdf_io_check( nf90_def_var(nc%id, nc%a_varname, nc%out_type, [nc%name_dimid, nc%time_dimid], nc%a_varid), "netcdf_io_initialize_output nf90_def_var a_varid" ) + call netcdf_io_check( nf90_def_var(nc%id, nc%e_varname, nc%out_type, [nc%name_dimid, nc%time_dimid], nc%e_varid), "netcdf_io_initialize_output nf90_def_var e_varid" ) + call netcdf_io_check( nf90_def_var(nc%id, nc%inc_varname, nc%out_type, [nc%name_dimid, nc%time_dimid], nc%inc_varid), "netcdf_io_initialize_output nf90_def_var inc_varid" ) + call netcdf_io_check( nf90_def_var(nc%id, nc%capom_varname, nc%out_type, [nc%name_dimid, nc%time_dimid], nc%capom_varid), "netcdf_io_initialize_output nf90_def_var capom_varid" ) + call netcdf_io_check( nf90_def_var(nc%id, nc%omega_varname, nc%out_type, [nc%name_dimid, nc%time_dimid], nc%omega_varid), "netcdf_io_initialize_output nf90_def_var omega_varid" ) + call netcdf_io_check( nf90_def_var(nc%id, nc%capm_varname, nc%out_type, [nc%name_dimid, nc%time_dimid], nc%capm_varid), "netcdf_io_initialize_output nf90_def_var capm_varid" ) + call netcdf_io_check( nf90_def_var(nc%id, nc%varpi_varname, nc%out_type, [nc%name_dimid, nc%time_dimid], nc%varpi_varid), "netcdf_io_initialize_output nf90_def_var varpi_varid" ) + call netcdf_io_check( nf90_def_var(nc%id, nc%lam_varname, nc%out_type, [nc%name_dimid, nc%time_dimid], nc%lam_varid), "netcdf_io_initialize_output nf90_def_var lam_varid" ) + call netcdf_io_check( nf90_def_var(nc%id, nc%f_varname, nc%out_type, [nc%name_dimid, nc%time_dimid], nc%f_varid), "netcdf_io_initialize_output nf90_def_var f_varid" ) + call netcdf_io_check( nf90_def_var(nc%id, nc%cape_varname, nc%out_type, [nc%name_dimid, nc%time_dimid], nc%cape_varid), "netcdf_io_initialize_output nf90_def_var cape_varid" ) + end if + + call netcdf_io_check( nf90_def_var(nc%id, nc%gmass_varname, nc%out_type, [nc%name_dimid, nc%time_dimid], nc%Gmass_varid), "netcdf_io_initialize_output nf90_def_var Gmass_varid" ) + + if (param%lrhill_present) then + call netcdf_io_check( nf90_def_var(nc%id, nc%rhill_varname, nc%out_type, [nc%name_dimid, nc%time_dimid], nc%rhill_varid), "netcdf_io_initialize_output nf90_def_var rhill_varid" ) + end if + + if (param%lclose) then + call netcdf_io_check( nf90_def_var(nc%id, nc%radius_varname, nc%out_type, [nc%name_dimid, nc%time_dimid], nc%radius_varid), "netcdf_io_initialize_output nf90_def_var radius_varid" ) + + call netcdf_io_check( nf90_def_var(nc%id, nc%origin_time_varname, nc%out_type, nc%name_dimid, nc%origin_time_varid), "netcdf_io_initialize_output nf90_def_var origin_time_varid" ) + call netcdf_io_check( nf90_def_var(nc%id, nc%origin_type_varname, NF90_CHAR, [nc%str_dimid, nc%name_dimid], & + nc%origin_type_varid), "netcdf_io_initialize_output nf90_create" ) + call netcdf_io_check( nf90_def_var(nc%id, nc%origin_rh_varname, nc%out_type, [nc%space_dimid, nc%name_dimid], nc%origin_rh_varid), "netcdf_io_initialize_output nf90_def_var origin_rh_varid" ) + call netcdf_io_check( nf90_def_var(nc%id, nc%origin_vh_varname, nc%out_type, [nc%space_dimid, nc%name_dimid], nc%origin_vh_varid), "netcdf_io_initialize_output nf90_def_var origin_vh_varid" ) + + call netcdf_io_check( nf90_def_var(nc%id, nc%collision_id_varname, NF90_INT, nc%name_dimid, nc%collision_id_varid), "netcdf_io_initialize_output nf90_def_var collision_id_varid" ) + call netcdf_io_check( nf90_def_var(nc%id, nc%discard_time_varname, nc%out_type, nc%name_dimid, nc%discard_time_varid), "netcdf_io_initialize_output nf90_def_var discard_time_varid" ) + call netcdf_io_check( nf90_def_var(nc%id, nc%discard_rh_varname, nc%out_type, [nc%space_dimid, nc%name_dimid], nc%discard_rh_varid), "netcdf_io_initialize_output nf90_def_var discard_rh_varid" ) + call netcdf_io_check( nf90_def_var(nc%id, nc%discard_vh_varname, nc%out_type, [nc%space_dimid, nc%name_dimid], nc%discard_vh_varid), "netcdf_io_initialize_output nf90_def_var discard_vh_varid" ) + call netcdf_io_check( nf90_def_var(nc%id, nc%discard_body_id_varname, NF90_INT, nc%name_dimid, nc%discard_body_id_varid), "netcdf_io_initialize_output nf90_def_var discard_body_id_varid" ) + end if + + if (param%lrotation) then + call netcdf_io_check( nf90_def_var(nc%id, nc%Ip_varname, nc%out_type, [nc%space_dimid, nc%name_dimid, nc%time_dimid], nc%Ip_varid), "netcdf_io_initialize_output nf90_def_var Ip_varid" ) + call netcdf_io_check( nf90_def_var(nc%id, nc%rot_varname, nc%out_type, [nc%space_dimid, nc%name_dimid, nc%time_dimid], nc%rot_varid), "netcdf_io_initialize_output nf90_def_var rot_varid" ) + end if + + ! if (param%ltides) then + ! call netcdf_io_check( nf90_def_var(nc%id, nc%k2_varname, nc%out_type, [nc%name_dimid, nc%time_dimid], nc%k2_varid), "netcdf_io_initialize_output nf90_def_var k2_varid" ) + ! call netcdf_io_check( nf90_def_var(nc%id, nc%q_varname, nc%out_type, [nc%name_dimid, nc%time_dimid], nc%Q_varid), "netcdf_io_initialize_output nf90_def_var Q_varid" ) + ! end if + + if (param%lenergy) then + call netcdf_io_check( nf90_def_var(nc%id, nc%ke_orb_varname, nc%out_type, nc%time_dimid, nc%KE_orb_varid), "netcdf_io_initialize_output nf90_def_var KE_orb_varid" ) + call netcdf_io_check( nf90_def_var(nc%id, nc%ke_spin_varname, nc%out_type, nc%time_dimid, nc%KE_spin_varid), "netcdf_io_initialize_output nf90_def_var KE_spin_varid" ) + call netcdf_io_check( nf90_def_var(nc%id, nc%pe_varname, nc%out_type, nc%time_dimid, nc%PE_varid), "netcdf_io_initialize_output nf90_def_var PE_varid" ) + call netcdf_io_check( nf90_def_var(nc%id, nc%L_orb_varname, nc%out_type, [nc%space_dimid, nc%time_dimid], nc%L_orb_varid), "netcdf_io_initialize_output nf90_def_var L_orb_varid" ) + call netcdf_io_check( nf90_def_var(nc%id, nc%Lspin_varname, nc%out_type, [nc%space_dimid, nc%time_dimid], nc%Lspin_varid), "netcdf_io_initialize_output nf90_def_var Lspin_varid" ) + call netcdf_io_check( nf90_def_var(nc%id, nc%L_escape_varname, nc%out_type, [nc%space_dimid, nc%time_dimid], nc%L_escape_varid), "netcdf_io_initialize_output nf90_def_var L_escape_varid" ) + call netcdf_io_check( nf90_def_var(nc%id, nc%Ecollisions_varname, nc%out_type, nc%time_dimid, nc%Ecollisions_varid), "netcdf_io_initialize_output nf90_def_var Ecollisions_varid" ) + call netcdf_io_check( nf90_def_var(nc%id, nc%Euntracked_varname, nc%out_type, nc%time_dimid, nc%Euntracked_varid), "netcdf_io_initialize_output nf90_def_var Euntracked_varid" ) + call netcdf_io_check( nf90_def_var(nc%id, nc%GMescape_varname, nc%out_type, nc%time_dimid, nc%GMescape_varid), "netcdf_io_initialize_output nf90_def_var GMescape_varid" ) + end if + + call netcdf_io_check( nf90_def_var(nc%id, nc%j2rp2_varname, nc%out_type, nc%time_dimid, nc%j2rp2_varid), "netcdf_io_initialize_output nf90_def_var j2rp2_varid" ) + call netcdf_io_check( nf90_def_var(nc%id, nc%j4rp4_varname, nc%out_type, nc%time_dimid, nc%j4rp4_varid), "netcdf_io_initialize_output nf90_def_var j4rp4_varid" ) + + + ! Set fill mode to NaN for all variables + call netcdf_io_check( nf90_inquire(nc%id, nVariables=nvar), "netcdf_io_initialize_output nf90_inquire nVariables" ) + do varid = 1, nvar + call netcdf_io_check( nf90_inquire_variable(nc%id, varid, xtype=vartype, ndims=ndims), "netcdf_io_initialize_output nf90_inquire_variable" ) + select case(vartype) + case(NF90_INT) + call netcdf_io_check( nf90_def_var_fill(nc%id, varid, NO_FILL, NF90_FILL_INT), "netcdf_io_initialize_output nf90_def_var_fill NF90_INT" ) + case(NF90_FLOAT) + call netcdf_io_check( nf90_def_var_fill(nc%id, varid, NO_FILL, sfill), "netcdf_io_initialize_output nf90_def_var_fill NF90_FLOAT" ) + case(NF90_DOUBLE) + call netcdf_io_check( nf90_def_var_fill(nc%id, varid, NO_FILL, dfill), "netcdf_io_initialize_output nf90_def_var_fill NF90_DOUBLE" ) + case(NF90_CHAR) + call netcdf_io_check( nf90_def_var_fill(nc%id, varid, NO_FILL, 0), "netcdf_io_initialize_output nf90_def_var_fill NF90_CHAR" ) + end select + end do + + ! Set special fill mode for discard time so that we can make use of it for non-discarded bodies. + select case (vartype) + case(NF90_FLOAT) + call netcdf_io_check( nf90_def_var_fill(nc%id, nc%discard_time_varid, NO_FILL, huge(1.0_SP)), "netcdf_io_initialize_output nf90_def_var_fill discard_time NF90_FLOAT" ) + case(NF90_DOUBLE) + call netcdf_io_check( nf90_def_var_fill(nc%id, nc%discard_time_varid, NO_FILL, huge(1.0_DP)), "netcdf_io_initialize_output nf90_def_var_fill discard_time NF90_DOUBLE" ) + end select + + ! Take the file out of define mode + call netcdf_io_check( nf90_enddef(nc%id), "netcdf_io_initialize_output nf90_enddef" ) + + ! Add in the space dimension coordinates + call netcdf_io_check( nf90_put_var(nc%id, nc%space_varid, nc%space_coords, start=[1], count=[NDIM]), "netcdf_io_initialize_output nf90_put_var space" ) + + end associate + return + + 667 continue + write(*,*) "Error creating NetCDF output file. " // trim(adjustl(errmsg)) + call swiftest_util_exit(FAILURE) + end subroutine swiftest_io_netcdf_initialize_output + + + module subroutine swiftest_io_netcdf_open(self, param, readonly) + !! author: Carlisle A. Wishard, Dana Singh, and David A. Minton + !! + !! Opens a NetCDF file and does the variable inquiries to activate variable ids + implicit none + ! Arguments + class(swiftest_netcdf_parameters), intent(inout) :: self !! Parameters used to identify a particular NetCDF dataset + class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters + logical, optional, intent(in) :: readonly !! Logical flag indicating that this should be open read only + ! Internals + integer(I4B) :: mode, status + character(len=STRMAX) :: errmsg + + mode = NF90_WRITE + if (present(readonly)) then + if (readonly) mode = NF90_NOWRITE + end if + + associate(nc => self) + + write(errmsg,*) "netcdf_io_open nf90_open ",trim(adjustl(nc%file_name)) + call netcdf_io_check( nf90_open(nc%file_name, mode, nc%id), errmsg) + + ! Dimensions + call netcdf_io_check( nf90_inq_dimid(nc%id, nc%time_dimname, nc%time_dimid), "netcdf_io_open nf90_inq_dimid time_dimid" ) + call netcdf_io_check( nf90_inq_dimid(nc%id, nc%space_dimname, nc%space_dimid), "netcdf_io_open nf90_inq_dimid space_dimid" ) + call netcdf_io_check( nf90_inq_dimid(nc%id, nc%name_dimname, nc%name_dimid), "netcdf_io_open nf90_inq_dimid name_dimid" ) + call netcdf_io_check( nf90_inq_dimid(nc%id, nc%str_dimname, nc%str_dimid), "netcdf_io_open nf90_inq_dimid str_dimid" ) + + ! Dimension coordinates + call netcdf_io_check( nf90_inq_varid(nc%id, nc%time_dimname, nc%time_varid), "netcdf_io_open nf90_inq_varid time_varid" ) + call netcdf_io_check( nf90_inq_varid(nc%id, nc%space_dimname, nc%space_varid), "netcdf_io_open nf90_inq_varid space_varid" ) + call netcdf_io_check( nf90_inq_varid(nc%id, nc%name_dimname, nc%name_varid), "netcdf_io_open nf90_inq_varid name_varid" ) + + ! Required Variables + call netcdf_io_check( nf90_inq_varid(nc%id, nc%id_varname, nc%id_varid), "netcdf_io_open nf90_inq_varid name_varid" ) + call netcdf_io_check( nf90_inq_varid(nc%id, nc%gmass_varname, nc%Gmass_varid), "netcdf_io_open nf90_inq_varid Gmass_varid" ) + + if ((param%out_form == "XV") .or. (param%out_form == "XVEL")) then + call netcdf_io_check( nf90_inq_varid(nc%id, nc%rh_varname, nc%rh_varid), "netcdf_io_open nf90_inq_varid rh_varid" ) + call netcdf_io_check( nf90_inq_varid(nc%id, nc%vh_varname, nc%vh_varid), "netcdf_io_open nf90_inq_varid vh_varid" ) + + if (param%lgr) then + !! check if pseudovelocity vectors exist in this file. If they are, set the correct flag so we know whe should not do the conversion. + status = nf90_inq_varid(nc%id, nc%gr_pseudo_vh_varname, nc%gr_pseudo_vh_varid) + nc%lpseudo_vel_exists = (status == nf90_noerr) + if (param%lrestart .and. .not.nc%lpseudo_vel_exists) then + write(*,*) "Warning! Pseudovelocity not found in input file for GR enabled run. If this is a restarted run, bit-identical trajectories are not guarunteed!" + end if + + end if + end if + + if ((param%out_form == "EL") .or. (param%out_form == "XVEL")) then + call netcdf_io_check( nf90_inq_varid(nc%id, nc%a_varname, nc%a_varid), "netcdf_io_open nf90_inq_varid a_varid" ) + call netcdf_io_check( nf90_inq_varid(nc%id, nc%e_varname, nc%e_varid), "netcdf_io_open nf90_inq_varid e_varid" ) + call netcdf_io_check( nf90_inq_varid(nc%id, nc%inc_varname, nc%inc_varid), "netcdf_io_open nf90_inq_varid inc_varid" ) + call netcdf_io_check( nf90_inq_varid(nc%id, nc%capom_varname, nc%capom_varid), "netcdf_io_open nf90_inq_varid capom_varid" ) + call netcdf_io_check( nf90_inq_varid(nc%id, nc%omega_varname, nc%omega_varid), "netcdf_io_open nf90_inq_varid omega_varid" ) + call netcdf_io_check( nf90_inq_varid(nc%id, nc%capm_varname, nc%capm_varid), "netcdf_io_open nf90_inq_varid capm_varid" ) + end if + + if (param%lclose) then + call netcdf_io_check( nf90_inq_varid(nc%id, nc%radius_varname, nc%radius_varid), "netcdf_io_open nf90_inq_varid radius_varid" ) + end if + + if (param%lrotation) then + call netcdf_io_check( nf90_inq_varid(nc%id, nc%Ip_varname, nc%Ip_varid), "netcdf_io_open nf90_inq_varid Ip_varid" ) + call netcdf_io_check( nf90_inq_varid(nc%id, nc%rot_varname, nc%rot_varid), "netcdf_io_open nf90_inq_varid rot_varid" ) + end if + + ! if (param%ltides) then + ! call netcdf_io_check( nf90_inq_varid(nc%id, nc%k2_varname, nc%k2_varid), "netcdf_io_open nf90_inq_varid k2_varid" ) + ! call netcdf_io_check( nf90_inq_varid(nc%id, nc%q_varname, nc%Q_varid), "netcdf_io_open nf90_inq_varid Q_varid" ) + ! end if + + ! Optional Variables + if (param%lrhill_present) then + status = nf90_inq_varid(nc%id, nc%rhill_varname, nc%rhill_varid) + if (status /= nf90_noerr) write(*,*) "Warning! RHILL variable not set in input file. Calculating." + end if + + ! Optional variables The User Doesn't Need to Know About + status = nf90_inq_varid(nc%id, nc%npl_varname, nc%npl_varid) + status = nf90_inq_varid(nc%id, nc%ntp_varname, nc%ntp_varid) + status = nf90_inq_varid(nc%id, nc%j2rp2_varname, nc%j2rp2_varid) + status = nf90_inq_varid(nc%id, nc%j4rp4_varname, nc%j4rp4_varid) + status = nf90_inq_varid(nc%id, nc%ptype_varname, nc%ptype_varid) + status = nf90_inq_varid(nc%id, nc%varpi_varname, nc%varpi_varid) + status = nf90_inq_varid(nc%id, nc%lam_varname, nc%lam_varid) + status = nf90_inq_varid(nc%id, nc%f_varname, nc%f_varid) + status = nf90_inq_varid(nc%id, nc%cape_varname, nc%cape_varid) + + if (param%lmtiny_pl) status = nf90_inq_varid(nc%id, nc%nplm_varname, nc%nplm_varid) + + if (param%lclose) then + status = nf90_inq_varid(nc%id, nc%origin_type_varname, nc%origin_type_varid) + status = nf90_inq_varid(nc%id, nc%origin_time_varname, nc%origin_time_varid) + status = nf90_inq_varid(nc%id, nc%origin_rh_varname, nc%origin_rh_varid) + status = nf90_inq_varid(nc%id, nc%origin_vh_varname, nc%origin_vh_varid) + status = nf90_inq_varid(nc%id, nc%collision_id_varname, nc%collision_id_varid) + status = nf90_inq_varid(nc%id, nc%discard_time_varname, nc%discard_time_varid) + status = nf90_inq_varid(nc%id, nc%discard_rh_varname, nc%discard_rh_varid) + status = nf90_inq_varid(nc%id, nc%discard_vh_varname, nc%discard_vh_varid) + status = nf90_inq_varid(nc%id, nc%discard_body_id_varname, nc%discard_body_id_varid) + end if + + if (param%lenergy) then + status = nf90_inq_varid(nc%id, nc%ke_orb_varname, nc%KE_orb_varid) + status = nf90_inq_varid(nc%id, nc%ke_spin_varname, nc%KE_spin_varid) + status = nf90_inq_varid(nc%id, nc%pe_varname, nc%PE_varid) + status = nf90_inq_varid(nc%id, nc%L_orb_varname, nc%L_orb_varid) + status = nf90_inq_varid(nc%id, nc%Lspin_varname, nc%Lspin_varid) + status = nf90_inq_varid(nc%id, nc%L_escape_varname, nc%L_escape_varid) + status = nf90_inq_varid(nc%id, nc%Ecollisions_varname, nc%Ecollisions_varid) + status = nf90_inq_varid(nc%id, nc%Euntracked_varname, nc%Euntracked_varid) + status = nf90_inq_varid(nc%id, nc%GMescape_varname, nc%GMescape_varid) + end if + + end associate + + return + end subroutine swiftest_io_netcdf_open + + + module function swiftest_io_netcdf_read_frame_system(self, nc, param) result(ierr) + !! author: The Purdue Swiftest Team - David A. Minton, Carlisle A. Wishard, Jennifer L.L. Pouplin, and Jacob R. Elliott + !! + !! Read a frame (header plus records for each massive body and active test particle) from an output binary file + implicit none + ! Arguments + class(swiftest_nbody_system), intent(inout) :: self !! Swiftest system object + class(swiftest_netcdf_parameters), intent(inout) :: nc !! Parameters used to identify a particular NetCDF dataset + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + ! Return + integer(I4B) :: ierr !! Error code: returns 0 if the read is successful + ! Internals + integer(I4B) :: i, tslot, idmax, npl_check, ntp_check, nplm_check, t_max, str_max, status + real(DP), dimension(:), allocatable :: rtemp + real(DP), dimension(:,:), allocatable :: vectemp + integer(I4B), dimension(:), allocatable :: itemp + logical, dimension(:), allocatable :: validmask, tpmask, plmask + + tslot = param%ioutput + + call nc%open(param, readonly=.true.) + call self%read_hdr(nc, param) + associate(cb => self%cb, pl => self%pl, tp => self%tp, npl => self%pl%nbody, ntp => self%tp%nbody) + + call pl%setup(npl, param) + call tp%setup(ntp, param) + + call netcdf_io_check( nf90_inquire_dimension(nc%id, nc%name_dimid, len=idmax), "netcdf_io_read_frame_system nf90_inquire_dimension name_dimid" ) + allocate(rtemp(idmax)) + allocate(vectemp(NDIM,idmax)) + allocate(itemp(idmax)) + allocate(validmask(idmax)) + allocate(tpmask(idmax)) + allocate(plmask(idmax)) + call netcdf_io_check( nf90_inquire_dimension(nc%id, nc%time_dimid, len=t_max), "netcdf_io_read_frame_system nf90_inquire_dimension time_dimid" ) + call netcdf_io_check( nf90_inquire_dimension(nc%id, nc%str_dimid, len=str_max), "netcdf_io_read_frame_system nf90_inquire_dimension str_dimid" ) + + ! First filter out only the id slots that contain valid bodies + if (param%in_form == "XV") then + call netcdf_io_check( nf90_get_var(nc%id, nc%rh_varid, vectemp(:,:), start=[1, 1, tslot]), "netcdf_io_read_frame_system filter pass nf90_getvar rh_varid" ) + validmask(:) = vectemp(1,:) == vectemp(1,:) + else + call netcdf_io_check( nf90_get_var(nc%id, nc%a_varid, rtemp(:), start=[1, tslot]), "netcdf_io_read_frame_system filter pass nf90_getvar a_varid" ) + validmask(:) = rtemp(:) == rtemp(:) + end if + + ! Next, filter only bodies that don't have mass (test particles) + call netcdf_io_check( nf90_get_var(nc%id, nc%Gmass_varid, rtemp(:), start=[1, tslot]), "netcdf_io_read_frame_system nf90_getvar tp finder Gmass_varid" ) + plmask(:) = rtemp(:) == rtemp(:) .and. validmask(:) + tpmask(:) = .not. plmask(:) .and. validmask(:) + plmask(1) = .false. ! This is the central body + + ! Check to make sure the number of bodies is correct + npl_check = count(plmask(:)) + ntp_check = count(tpmask(:)) + + if (npl_check /= npl) then + write(*,*) "Error reading in NetCDF file: The recorded value of npl does not match the number of active massive bodies" + call swiftest_util_exit(failure) + end if + + if (ntp_check /= ntp) then + write(*,*) "Error reading in NetCDF file: The recorded value of ntp does not match the number of active test particles" + call swiftest_util_exit(failure) + end if + + if (param%lmtiny_pl) then + nplm_check = count(pack(rtemp,plmask) > param%GMTINY ) + if (nplm_check /= pl%nplm) then + write(*,*) "Error reading in NetCDF file: The recorded value of nplm does not match the number of active fully interacting massive bodies" + call swiftest_util_exit(failure) + end if + end if + + ! Now read in each variable and split the outputs by body type + if ((param%in_form == "XV") .or. (param%in_form == "XVEL")) then + call netcdf_io_check( nf90_get_var(nc%id, nc%rh_varid, vectemp, start=[1, 1, tslot], count=[NDIM,idmax,1]), "netcdf_io_read_frame_system nf90_getvar rh_varid" ) + do i = 1, NDIM + if (npl > 0) pl%rh(i,:) = pack(vectemp(i,:), plmask(:)) + if (ntp > 0) tp%rh(i,:) = pack(vectemp(i,:), tpmask(:)) + end do + + if (param%lgr .and. nc%lpseudo_vel_exists) then + call netcdf_io_check( nf90_get_var(nc%id, nc%gr_pseudo_vh_varid, vectemp, start=[1, 1, tslot], count=[NDIM,idmax,1]), "netcdf_io_read_frame_system nf90_getvar gr_pseudo_vh_varid" ) + do i = 1, NDIM + if (npl > 0) pl%vh(i,:) = pack(vectemp(i,:), plmask(:)) + if (ntp > 0) tp%vh(i,:) = pack(vectemp(i,:), tpmask(:)) + end do + else + call netcdf_io_check( nf90_get_var(nc%id, nc%vh_varid, vectemp, start=[1, 1, tslot], count=[NDIM,idmax,1]), "netcdf_io_read_frame_system nf90_getvar vh_varid" ) + do i = 1, NDIM + if (npl > 0) pl%vh(i,:) = pack(vectemp(i,:), plmask(:)) + if (ntp > 0) tp%vh(i,:) = pack(vectemp(i,:), tpmask(:)) + end do + end if + end if + + if ((param%in_form == "EL") .or. (param%in_form == "XVEL")) then + call netcdf_io_check( nf90_get_var(nc%id, nc%a_varid, rtemp, start=[1, tslot], count=[idmax,1]), "netcdf_io_read_frame_system nf90_getvar a_varid" ) + if (.not.allocated(pl%a)) allocate(pl%a(npl)) + if (.not.allocated(tp%a)) allocate(tp%a(ntp)) + if (npl > 0) pl%a(:) = pack(rtemp, plmask) + if (ntp > 0) tp%a(:) = pack(rtemp, tpmask) + + call netcdf_io_check( nf90_get_var(nc%id, nc%e_varid, rtemp, start=[1, tslot], count=[idmax,1]), "netcdf_io_read_frame_system nf90_getvar e_varid" ) + if (.not.allocated(pl%e)) allocate(pl%e(npl)) + if (.not.allocated(tp%e)) allocate(tp%e(ntp)) + if (npl > 0) pl%e(:) = pack(rtemp, plmask) + if (ntp > 0) tp%e(:) = pack(rtemp, tpmask) + + call netcdf_io_check( nf90_get_var(nc%id, nc%inc_varid, rtemp, start=[1, tslot], count=[idmax,1]), "netcdf_io_read_frame_system nf90_getvar inc_varid" ) + rtemp = rtemp * DEG2RAD + if (.not.allocated(pl%inc)) allocate(pl%inc(npl)) + if (.not.allocated(tp%inc)) allocate(tp%inc(ntp)) + if (npl > 0) pl%inc(:) = pack(rtemp, plmask) + if (ntp > 0) tp%inc(:) = pack(rtemp, tpmask) + + call netcdf_io_check( nf90_get_var(nc%id, nc%capom_varid, rtemp, start=[1, tslot], count=[idmax,1]), "netcdf_io_read_frame_system nf90_getvar capom_varid" ) + rtemp = rtemp * DEG2RAD + if (.not.allocated(pl%capom)) allocate(pl%capom(npl)) + if (.not.allocated(tp%capom)) allocate(tp%capom(ntp)) + if (npl > 0) pl%capom(:) = pack(rtemp, plmask) + if (ntp > 0) tp%capom(:) = pack(rtemp, tpmask) + + call netcdf_io_check( nf90_get_var(nc%id, nc%omega_varid, rtemp, start=[1, tslot], count=[idmax,1]), "netcdf_io_read_frame_system nf90_getvar omega_varid" ) + rtemp = rtemp * DEG2RAD + if (.not.allocated(pl%omega)) allocate(pl%omega(npl)) + if (.not.allocated(tp%omega)) allocate(tp%omega(ntp)) + if (npl > 0) pl%omega(:) = pack(rtemp, plmask) + if (ntp > 0) tp%omega(:) = pack(rtemp, tpmask) + + call netcdf_io_check( nf90_get_var(nc%id, nc%capm_varid, rtemp, start=[1, tslot], count=[idmax,1]), "netcdf_io_read_frame_system nf90_getvar capm_varid" ) + rtemp = rtemp * DEG2RAD + if (.not.allocated(pl%capm)) allocate(pl%capm(npl)) + if (.not.allocated(tp%capm)) allocate(tp%capm(ntp)) + if (npl > 0) pl%capm(:) = pack(rtemp, plmask) + if (ntp > 0) tp%capm(:) = pack(rtemp, tpmask) + + end if + + call netcdf_io_check( nf90_get_var(nc%id, nc%Gmass_varid, rtemp, start=[1, tslot], count=[idmax,1]), "netcdf_io_read_frame_system nf90_getvar Gmass_varid" ) + cb%Gmass = rtemp(1) + cb%mass = cb%Gmass / param%GU + + ! Set initial central body mass for Helio bookkeeping + cb%GM0 = cb%Gmass + + + if (npl > 0) then + pl%Gmass(:) = pack(rtemp, plmask) + pl%mass(:) = pl%Gmass(:) / param%GU + + if (param%lrhill_present) then + call netcdf_io_check( nf90_get_var(nc%id, nc%rhill_varid, rtemp, start=[1, tslot], count=[idmax,1]), "netcdf_io_read_frame_system nf90_getvar rhill_varid" ) + pl%rhill(:) = pack(rtemp, plmask) + end if + end if + + if (param%lclose) then + call netcdf_io_check( nf90_get_var(nc%id, nc%radius_varid, rtemp, start=[1, tslot], count=[idmax,1]), "netcdf_io_read_frame_system nf90_getvar radius_varid" ) + cb%radius = rtemp(1) + + ! Set initial central body radius for SyMBA bookkeeping + cb%R0 = cb%radius + if (npl > 0) pl%radius(:) = pack(rtemp, plmask) + else + cb%radius = param%rmin + if (npl > 0) pl%radius(:) = 0.0_DP + end if + + if (param%lrotation) then + call netcdf_io_check( nf90_get_var(nc%id, nc%Ip_varid, vectemp, start=[1, 1, tslot], count=[NDIM,idmax,1]), "netcdf_io_read_frame_system nf90_getvar Ip_varid" ) + cb%Ip(:) = vectemp(:,1) + do i = 1, NDIM + if (npl > 0) pl%Ip(i,:) = pack(vectemp(i,:), plmask(:)) + end do + + call netcdf_io_check( nf90_get_var(nc%id, nc%rot_varid, vectemp, start=[1, 1, tslot], count=[NDIM,idmax,1]), "netcdf_io_read_frame_system nf90_getvar rot_varid" ) + cb%rot(:) = vectemp(:,1) + do i = 1, NDIM + if (npl > 0) pl%rot(i,:) = pack(vectemp(i,:), plmask(:)) + end do + + ! Set initial central body angular momentum for bookkeeping + cb%L0(:) = cb%Ip(3) * cb%GM0 * cb%R0**2 * cb%rot(:) + end if + + ! if (param%ltides) then + ! call netcdf_io_check( nf90_get_var(nc%id, nc%k2_varid, rtemp, start=[1, tslot]), "netcdf_io_read_frame_system nf90_getvar k2_varid" ) + ! cb%k2 = rtemp(1) + ! if (npl > 0) pl%k2(:) = pack(rtemp, plmask) + + ! call netcdf_io_check( nf90_get_var(nc%id, nc%Q_varid, rtemp, start=[1, tslot]), "netcdf_io_read_frame_system nf90_getvar Q_varid" ) + ! cb%Q = rtemp(1) + ! if (npl > 0) pl%Q(:) = pack(rtemp, plmask) + ! end if + + status = nf90_inq_varid(nc%id, nc%j2rp2_varname, nc%j2rp2_varid) + if (status == nf90_noerr) then + call netcdf_io_check( nf90_get_var(nc%id, nc%j2rp2_varid, cb%j2rp2, start=[tslot]), "netcdf_io_read_frame_system nf90_getvar j2rp2_varid" ) + else + cb%j2rp2 = 0.0_DP + end if + + status = nf90_inq_varid(nc%id, nc%j4rp4_varname, nc%j4rp4_varid) + if (status == nf90_noerr) then + call netcdf_io_check( nf90_get_var(nc%id, nc%j4rp4_varid, cb%j4rp4, start=[tslot]), "netcdf_io_read_frame_system nf90_getvar j4rp4_varid" ) + else + cb%j4rp4 = 0.0_DP + end if + + call self%read_particle_info(nc, param, plmask, tpmask) + + if (param%in_form == "EL") then + call pl%el2xv(cb) + call tp%el2xv(cb) + end if + ! if this is a GR-enabled run, check to see if we got the pseudovelocities in. Otherwise, we'll need to generate them. + if (param%lgr .and. .not.(nc%lpseudo_vel_exists)) then + call pl%set_mu(cb) + call tp%set_mu(cb) + call pl%v2pv(param) + call tp%v2pv(param) + end if + + end associate + + call nc%close() + + ierr = 0 + return + + 667 continue + write(*,*) "Error reading system frame in netcdf_io_read_frame_system" + + end function swiftest_io_netcdf_read_frame_system + + + module subroutine swiftest_io_netcdf_read_hdr_system(self, nc, param) + !! author: David A. Minton + !! + !! Reads header information (variables that change with time, but not particle id). + !! This subroutine swiftest_significantly improves the output over the original binary file, allowing us to track energy, momentum, and other quantities that + !! previously were handled as separate output files. + implicit none + ! Arguments + class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nbody system object + class(swiftest_netcdf_parameters), intent(inout) :: nc !! Parameters used to for reading a NetCDF dataset to file + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + ! Internals + integer(I4B) :: tslot, status, idmax + real(DP), dimension(:), allocatable :: gmtemp + logical, dimension(:), allocatable :: plmask, tpmask, plmmask + + + tslot = param%ioutput + call netcdf_io_check( nf90_inquire_dimension(nc%id, nc%name_dimid, len=idmax), "netcdf_io_read_hdr_system nf90_inquire_dimension name_dimid" ) + call netcdf_io_check( nf90_get_var(nc%id, nc%time_varid, self%t, start=[tslot]), "netcdf_io_read_hdr_system nf90_getvar time_varid" ) + + allocate(gmtemp(idmax)) + allocate(tpmask(idmax)) + allocate(plmask(idmax)) + allocate(plmmask(idmax)) + + call netcdf_io_check( nf90_get_var(nc%id, nc%Gmass_varid, gmtemp, start=[1,1], count=[idmax,1]), "netcdf_io_read_hdr_system nf90_getvar Gmass_varid" ) + + plmask(:) = gmtemp(:) == gmtemp(:) + tpmask(:) = .not. plmask(:) + plmask(1) = .false. ! This is the central body + plmmask(:) = plmask(:) + + if (param%lmtiny_pl) then + where(plmask(:)) + plmmask(:) = gmtemp(:) > param%GMTINY + endwhere + end if + + status = nf90_inq_varid(nc%id, nc%npl_varname, nc%npl_varid) + if (status == nf90_noerr) then + call netcdf_io_check( nf90_get_var(nc%id, nc%npl_varid, self%pl%nbody, start=[tslot]), "netcdf_io_read_hdr_system nf90_getvar npl_varid" ) + else + self%pl%nbody = count(plmask(:)) + end if + + status = nf90_inq_varid(nc%id, nc%ntp_varname, nc%ntp_varid) + if (status == nf90_noerr) then + call netcdf_io_check( nf90_get_var(nc%id, nc%ntp_varid, self%tp%nbody, start=[tslot]), "netcdf_io_read_hdr_system nf90_getvar ntp_varid" ) + else + self%tp%nbody = count(tpmask(:)) + end if + + if (param%lmtiny_pl) then + status = nf90_inq_varid(nc%id, nc%nplm_varname, nc%nplm_varid) + if (status == nf90_noerr) then + call netcdf_io_check( nf90_get_var(nc%id, nc%nplm_varid, self%pl%nplm, start=[tslot]), "netcdf_io_read_hdr_system nf90_getvar nplm_varid" ) + else + self%pl%nplm = count(plmmask(:)) + end if + end if + + if (param%lenergy) then + status = nf90_inq_varid(nc%id, nc%ke_orb_varname, nc%KE_orb_varid) + if (status == nf90_noerr) call netcdf_io_check( nf90_get_var(nc%id, nc%KE_orb_varid, self%ke_orbit, start=[tslot]), "netcdf_io_read_hdr_system nf90_getvar KE_orb_varid" ) + status = nf90_inq_varid(nc%id, nc%ke_spin_varname, nc%KE_spin_varid) + if (status == nf90_noerr) call netcdf_io_check( nf90_get_var(nc%id, nc%KE_spin_varid, self%ke_spin, start=[tslot]), "netcdf_io_read_hdr_system nf90_getvar KE_spin_varid" ) + status = nf90_inq_varid(nc%id, nc%pe_varname, nc%PE_varid) + if (status == nf90_noerr) call netcdf_io_check( nf90_get_var(nc%id, nc%PE_varid, self%pe, start=[tslot]), "netcdf_io_read_hdr_system nf90_getvar PE_varid" ) + status = nf90_inq_varid(nc%id, nc%L_orb_varname, nc%L_orb_varid) + if (status == nf90_noerr) call netcdf_io_check( nf90_get_var(nc%id, nc%L_orb_varid, self%Lorbit(:), start=[1,tslot], count=[NDIM,1]), "netcdf_io_read_hdr_system nf90_getvar L_orb_varid" ) + status = nf90_inq_varid(nc%id, nc%Lspin_varname, nc%Lspin_varid) + if (status == nf90_noerr) call netcdf_io_check( nf90_get_var(nc%id, nc%Lspin_varid, self%Lspin(:), start=[1,tslot], count=[NDIM,1]), "netcdf_io_read_hdr_system nf90_getvar Lspin_varid" ) + status = nf90_inq_varid(nc%id, nc%L_escape_varname, nc%L_escape_varid) + if (status == nf90_noerr) call netcdf_io_check( nf90_get_var(nc%id, nc%L_escape_varid, self%Lescape(:), start=[1, tslot], count=[NDIM,1]), "netcdf_io_read_hdr_system nf90_getvar L_escape_varid" ) + status = nf90_inq_varid(nc%id, nc%Ecollisions_varname, nc%Ecollisions_varid) + if (status == nf90_noerr) call netcdf_io_check( nf90_get_var(nc%id, nc%Ecollisions_varid, self%Ecollisions, start=[tslot]), "netcdf_io_read_hdr_system nf90_getvar Ecollisions_varid" ) + status = nf90_inq_varid(nc%id, nc%Euntracked_varname, nc%Euntracked_varid) + if (status == nf90_noerr) call netcdf_io_check( nf90_get_var(nc%id, nc%Euntracked_varid, self%Euntracked, start=[tslot]), "netcdf_io_read_hdr_system nf90_getvar Euntracked_varid" ) + status = nf90_inq_varid(nc%id, nc%GMescape_varname, nc%GMescape_varid) + if (status == nf90_noerr) call netcdf_io_check( nf90_get_var(nc%id, nc%GMescape_varid, self%GMescape, start=[tslot]), "netcdf_io_read_hdr_system nf90_getvar GMescape_varid" ) + end if + + return + end subroutine swiftest_io_netcdf_read_hdr_system + + + module subroutine swiftest_io_netcdf_read_particle_info_system(self, nc, param, plmask, tpmask) + !! author: Carlisle A. Wishard, Dana Singh, and David A. Minton + !! + !! Reads particle information metadata from file + implicit none + ! Arguments + class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nbody system object + class(swiftest_netcdf_parameters), intent(inout) :: nc !! Parameters used to identify a particular NetCDF dataset + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + logical, dimension(:), intent(in) :: plmask !! Logical array indicating which index values belong to massive bodies + logical, dimension(:), intent(in) :: tpmask !! Logical array indicating which index values belong to test particles + + ! Internals + integer(I4B) :: i, idmax, status + real(DP), dimension(:), allocatable :: rtemp + real(DP), dimension(:,:), allocatable :: vectemp + integer(I4B), dimension(:), allocatable :: itemp + character(len=NAMELEN), dimension(:), allocatable :: ctemp + integer(I4B), dimension(:), allocatable :: plind, tpind + + ! This string of spaces of length NAMELEN is used to clear out any old data left behind inside the string variables + idmax = size(plmask) + allocate(rtemp(idmax)) + allocate(vectemp(NDIM,idmax)) + allocate(itemp(idmax)) + allocate(ctemp(idmax)) + + associate(cb => self%cb, pl => self%pl, tp => self%tp, npl => self%pl%nbody, ntp => self%tp%nbody) + + if (npl > 0) then + pl%status(:) = ACTIVE + pl%lmask(:) = .true. + do i = 1, npl + call pl%info(i)%set_value(status="ACTIVE") + end do + allocate(plind(npl)) + plind(:) = pack([(i, i = 1, idmax)], plmask(:)) + end if + if (ntp > 0) then + tp%status(:) = ACTIVE + tp%lmask(:) = .true. + do i = 1, ntp + call tp%info(i)%set_value(status="ACTIVE") + end do + allocate(tpind(ntp)) + tpind(:) = pack([(i, i = 1, idmax)], tpmask(:)) + end if + + call netcdf_io_check( nf90_get_var(nc%id, nc%id_varid, itemp), "netcdf_io_read_particle_info_system nf90_getvar id_varid" ) + cb%id = itemp(1) + pl%id(:) = pack(itemp, plmask) + tp%id(:) = pack(itemp, tpmask) + cb%id = 0 + pl%id(:) = pack([(i,i=0,idmax-1)],plmask) + tp%id(:) = pack([(i,i=0,idmax-1)],tpmask) + + call netcdf_io_check( nf90_get_var(nc%id, nc%name_varid, ctemp, count=[NAMELEN, idmax]), "netcdf_io_read_particle_info_system nf90_getvar name_varid" ) + call cb%info%set_value(name=ctemp(1)) + do i = 1, npl + call pl%info(i)%set_value(name=ctemp(plind(i))) + end do + do i = 1, ntp + call tp%info(i)%set_value(name=ctemp(tpind(i))) + end do + + status = nf90_get_var(nc%id, nc%ptype_varid, ctemp, count=[NAMELEN, idmax]) + if (status /= nf90_noerr) then ! Set default particle types + call cb%info%set_value(particle_type=CB_TYPE_NAME) + + ! Handle semi-interacting bodies in SyMBA + do i = 1, npl + if (param%lmtiny_pl .and. (pl%Gmass(i) < param%GMTINY)) then + call pl%info(i)%set_value(particle_type=PL_TINY_TYPE_NAME) + else + call pl%info(i)%set_value(particle_type=PL_TYPE_NAME) + end if + end do + do i = 1, ntp + call tp%info(i)%set_value(particle_type=TP_TYPE_NAME) + end do + else ! Use particle types defined in input file + call cb%info%set_value(particle_type=ctemp(1)) + do i = 1, npl + call pl%info(i)%set_value(particle_type=ctemp(plind(i))) + end do + do i = 1, ntp + call tp%info(i)%set_value(particle_type=ctemp(tpind(i))) + end do + end if + + call cb%info%set_value(status="ACTIVE") + + if (param%lclose) then + + status = nf90_inq_varid(nc%id, nc%origin_type_varname, nc%origin_type_varid) + if (status == nf90_noerr) then + call netcdf_io_check( nf90_get_var(nc%id, nc%origin_type_varid, ctemp, count=[NAMELEN, idmax]), "netcdf_io_read_particle_info_system nf90_getvar origin_type_varid" ) + else + ctemp = "Initial Conditions" + end if + + call cb%info%set_value(origin_type=ctemp(1)) + do i = 1, npl + call pl%info(i)%set_value(origin_type=ctemp(plind(i))) + end do + do i = 1, ntp + call tp%info(i)%set_value(origin_type=ctemp(tpind(i))) + end do + + status = nf90_inq_varid(nc%id, nc%origin_time_varname, nc%origin_time_varid) + if (status == nf90_noerr) then + call netcdf_io_check( nf90_get_var(nc%id, nc%origin_time_varid, rtemp), "netcdf_io_read_particle_info_system nf90_getvar origin_time_varid" ) + else + rtemp = param%t0 + end if + + call cb%info%set_value(origin_time=rtemp(1)) + do i = 1, npl + call pl%info(i)%set_value(origin_time=rtemp(plind(i))) + end do + do i = 1, ntp + call tp%info(i)%set_value(origin_time=rtemp(tpind(i))) + end do + + status = nf90_inq_varid(nc%id, nc%origin_rh_varname, nc%origin_rh_varid) + if (status == nf90_noerr) then + call netcdf_io_check( nf90_get_var(nc%id, nc%origin_rh_varid, vectemp(:,:)), "netcdf_io_read_particle_info_system nf90_getvar origin_rh_varid" ) + else if ((param%out_form == "XV") .or. (param%out_form == "XVEL")) then + call netcdf_io_check( nf90_get_var(nc%id, nc%rh_varid, vectemp(:,:)), "netcdf_io_read_particle_info_system nf90_getvar rh_varid" ) + else + vectemp(:,:) = 0._DP + end if + + do i = 1, npl + call pl%info(i)%set_value(origin_rh=vectemp(:,plind(i))) + end do + do i = 1, ntp + call tp%info(i)%set_value(origin_rh=vectemp(:,tpind(i))) + end do + + status = nf90_inq_varid(nc%id, nc%origin_vh_varname, nc%origin_vh_varid) + if (status == nf90_noerr) then + call netcdf_io_check( nf90_get_var(nc%id, nc%origin_vh_varid, vectemp(:,:)), "netcdf_io_read_particle_info_system nf90_getvar origin_vh_varid" ) + else if ((param%out_form == "XV") .or. (param%out_form == "XVEL")) then + call netcdf_io_check( nf90_get_var(nc%id, nc%vh_varid, vectemp(:,:)), "netcdf_io_read_particle_info_system nf90_getvar vh_varid" ) + else + vectemp(:,:) = 0._DP + end if + + do i = 1, npl + call pl%info(i)%set_value(origin_vh=vectemp(:,plind(i))) + end do + do i = 1, ntp + call tp%info(i)%set_value(origin_vh=vectemp(:,tpind(i))) + end do + + status = nf90_inq_varid(nc%id, nc%collision_id_varname, nc%collision_id_varid) + if (status == nf90_noerr) then + call netcdf_io_check( nf90_get_var(nc%id, nc%collision_id_varid, itemp), "netcdf_io_read_particle_info_system nf90_getvar collision_id_varid" ) + else + itemp = 0 + end if + + do i = 1, npl + call pl%info(i)%set_value(collision_id=itemp(plind(i))) + end do + do i = 1, ntp + call tp%info(i)%set_value(collision_id=itemp(tpind(i))) + end do + + status = nf90_inq_varid(nc%id, nc%discard_time_varname, nc%discard_time_varid) + if (status == nf90_noerr) then + call netcdf_io_check( nf90_get_var(nc%id, nc%discard_time_varid, rtemp), "netcdf_io_read_particle_info_system nf90_getvar discard_time_varid" ) + else + select case (param%out_type) + case("netcdf_io_FLOAT") + rtemp(:) = huge(0.0_SP) + case("netcdf_io_DOUBLE") + rtemp(:) = huge(0.0_DP) + end select + end if + + call cb%info%set_value(discard_time=rtemp(1)) + do i = 1, npl + call pl%info(i)%set_value(discard_time=rtemp(plind(i))) + end do + do i = 1, ntp + call tp%info(i)%set_value(discard_time=rtemp(tpind(i))) + end do + + status = nf90_inq_varid(nc%id, nc%discard_rh_varname, nc%discard_rh_varid) + if (status == nf90_noerr) then + call netcdf_io_check( nf90_get_var(nc%id, nc%discard_rh_varid, vectemp(:,:)), "netcdf_io_read_particle_info_system nf90_getvar discard_rh_varid" ) + else + vectemp(:,:) = 0.0_DP + end if + + do i = 1, npl + call pl%info(i)%set_value(discard_rh=vectemp(:,plind(i))) + end do + do i = 1, ntp + call tp%info(i)%set_value(discard_rh=vectemp(:,tpind(i))) + end do + + status = nf90_inq_varid(nc%id, nc%discard_vh_varname, nc%discard_vh_varid) + if (status == nf90_noerr) then + call netcdf_io_check( nf90_get_var(nc%id, nc%discard_vh_varid, vectemp(:,:)), "netcdf_io_read_particle_info_system nf90_getvar discard_vh_varid" ) + else + vectemp(:,:) = 0.0_DP + end if + + do i = 1, npl + call pl%info(i)%set_value(discard_vh=vectemp(:,plind(i))) + end do + do i = 1, ntp + call tp%info(i)%set_value(discard_vh=vectemp(:,tpind(i))) + end do + end if + + end associate + + return + end subroutine swiftest_io_netcdf_read_particle_info_system + + + module subroutine swiftest_io_netcdf_write_frame_body(self, nc, param) + !! author: Carlisle A. Wishard, Dana Singh, and David A. Minton + !! + !! Write a frame of output of either test particle or massive body data to the binary output file + !! Note: If outputting to orbital elements, but sure that the conversion is done prior to calling this method + implicit none + ! Arguments + class(swiftest_body), intent(in) :: self !! Swiftest base object + class(swiftest_netcdf_parameters), intent(inout) :: nc !! Parameters used to for writing a NetCDF dataset to file + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + ! Internals + integer(I4B) :: i, j, tslot, idslot, old_mode + integer(I4B), dimension(:), allocatable :: ind + real(DP), dimension(NDIM) :: vh !! Temporary variable to store heliocentric velocity values when converting from pseudovelocity in GR-enabled runs + real(DP) :: a, e, inc, omega, capom, capm, varpi, lam, f, cape, capf + + tslot = param%ioutput + + call self%write_info(nc, param) + + call netcdf_io_check( nf90_set_fill(nc%id, nf90_nofill, old_mode), "netcdf_io_write_frame_body nf90_set_fill" ) + select type(self) + class is (swiftest_body) + select type (param) + class is (swiftest_parameters) + associate(n => self%nbody) + if (n == 0) return + + call swiftest_util_sort(self%id(1:n), ind) + + do i = 1, n + j = ind(i) + idslot = self%id(j) + 1 + + !! Convert from pseudovelocity to heliocentric without replacing the current value of pseudovelocity + if (param%lgr) call swiftest_gr_pseudovel2vel(param, self%mu(j), self%rh(:, j), self%vh(:, j), vh(:)) + + if ((param%out_form == "XV") .or. (param%out_form == "XVEL")) then + call netcdf_io_check( nf90_put_var(nc%id, nc%rh_varid, self%rh(:, j), start=[1,idslot, tslot], count=[NDIM,1,1]), "netcdf_io_write_frame_body nf90_put_var rh_varid" ) + if (param%lgr) then !! Convert from pseudovelocity to heliocentric without replacing the current value of pseudovelocity + call netcdf_io_check( nf90_put_var(nc%id, nc%vh_varid, vh(:), start=[1,idslot, tslot], count=[NDIM,1,1]), "netcdf_io_write_frame_body nf90_put_var vh_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%gr_pseudo_vh_varid, self%vh(:, j), start=[1,idslot, tslot],count=[NDIM,1,1]), "netcdf_io_write_frame_body nf90_put_var gr_pseudo_vhx_varid" ) + + else + call netcdf_io_check( nf90_put_var(nc%id, nc%vh_varid, self%vh(:, j), start=[1,idslot, tslot], count=[NDIM,1,1]), "netcdf_io_write_frame_body nf90_put_var vh_varid" ) + end if + end if + + if ((param%out_form == "EL") .or. (param%out_form == "XVEL")) then + if (param%lgr) then !! For GR-enabled runs, use the true value of velocity computed above + call swiftest_orbel_xv2el(self%mu(j), self%rh(1,j), self%rh(2,j), self%rh(3,j), & + vh(1), vh(2), vh(3), & + a, e, inc, capom, omega, capm, varpi, lam, f, cape, capf) + else !! For non-GR runs just convert from the velocity we have + call swiftest_orbel_xv2el(self%mu(j), self%rh(1,j), self%rh(2,j), self%rh(3,j), & + self%vh(1,j), self%vh(2,j), self%vh(3,j), & + a, e, inc, capom, omega, capm, varpi, lam, f, cape, capf) + end if + call netcdf_io_check( nf90_put_var(nc%id, nc%a_varid, a, start=[idslot, tslot]), "netcdf_io_write_frame_body nf90_put_var body a_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%e_varid, e, start=[idslot, tslot]), "netcdf_io_write_frame_body nf90_put_var body e_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%inc_varid, inc * RAD2DEG, start=[idslot, tslot]), "netcdf_io_write_frame_body nf90_put_var body inc_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%capom_varid, capom * RAD2DEG, start=[idslot, tslot]), "netcdf_io_write_frame_body nf90_put_var body capom_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%omega_varid, omega * RAD2DEG, start=[idslot, tslot]), "netcdf_io_write_frame_body nf90_put_var body omega_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%capm_varid, capm * RAD2DEG, start=[idslot, tslot]), "netcdf_io_write_frame_body nf90_put_var body capm_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%varpi_varid, varpi * RAD2DEG, start=[idslot, tslot]), "netcdf_io_write_frame_body nf90_put_var body varpi_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%lam_varid, lam * RAD2DEG, start=[idslot, tslot]), "netcdf_io_write_frame_body nf90_put_var body lam_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%f_varid, f * RAD2DEG, start=[idslot, tslot]), "netcdf_io_write_frame_body nf90_put_var body f_varid" ) + if (e < 1.0_DP) then + call netcdf_io_check( nf90_put_var(nc%id, nc%cape_varid, cape * RAD2DEG, start=[idslot, tslot]), "netcdf_io_write_frame_body nf90_put_var body cape_varid" ) + else if (e > 1.0_DP) then + call netcdf_io_check( nf90_put_var(nc%id, nc%cape_varid, capf * RAD2DEG, start=[idslot, tslot]), "netcdf_io_write_frame_body nf90_put_var body (capf) cape_varid" ) + end if + end if + + select type(self) + class is (swiftest_pl) ! Additional output if the passed polymorphic object is a massive body + call netcdf_io_check( nf90_put_var(nc%id, nc%Gmass_varid, self%Gmass(j), start=[idslot, tslot]), "netcdf_io_write_frame_body nf90_put_var body Gmass_varid" ) + if (param%lrhill_present) then + call netcdf_io_check( nf90_put_var(nc%id, nc%rhill_varid, self%rhill(j), start=[idslot, tslot]), "netcdf_io_write_frame_body nf90_put_var body rhill_varid" ) + end if + if (param%lclose) call netcdf_io_check( nf90_put_var(nc%id, nc%radius_varid, self%radius(j), start=[idslot, tslot]), "netcdf_io_write_frame_body nf90_put_var body radius_varid" ) + if (param%lrotation) then + call netcdf_io_check( nf90_put_var(nc%id, nc%Ip_varid, self%Ip(:, j), start=[1,idslot, tslot], count=[NDIM,1,1]), "netcdf_io_write_frame_body nf90_put_var body Ip_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%rot_varid, self%rot(:, j), start=[1,idslot, tslot], count=[NDIM,1,1]), "netcdf_io_write_frame_body nf90_put_var body rotx_varid" ) + end if + ! if (param%ltides) then + ! call netcdf_io_check( nf90_put_var(nc%id, nc%k2_varid, self%k2(j), start=[idslot, tslot]), "netcdf_io_write_frame_body nf90_put_var body k2_varid" ) + ! call netcdf_io_check( nf90_put_var(nc%id, nc%Q_varid, self%Q(j), start=[idslot, tslot]), "netcdf_io_write_frame_body nf90_put_var body Q_varid" ) + ! end if + + end select + end do + end associate + end select + end select + call netcdf_io_check( nf90_set_fill(nc%id, old_mode, old_mode), "netcdf_io_write_frame_body nf90_set_fill old_mode" ) + + return + end subroutine swiftest_io_netcdf_write_frame_body + + + module subroutine swiftest_io_netcdf_write_frame_cb(self, nc, param) + !! author: Carlisle A. Wishard, Dana Singh, and David A. Minton + !! + !! Write a frame of output of the central body + implicit none + ! Arguments + class(swiftest_cb), intent(in) :: self !! Swiftest base object + class(swiftest_netcdf_parameters), intent(inout) :: nc !! Parameters used to for writing a NetCDF dataset to file + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + ! Internals + integer(I4B) :: i, j, tslot, idslot, old_mode + + tslot = param%ioutput + + call self%write_info(nc, param) + + call netcdf_io_check( nf90_set_fill(nc%id, nf90_nofill, old_mode), "netcdf_io_write_frame_cb nf90_set_fill" ) + + idslot = self%id + 1 + call netcdf_io_check( nf90_put_var(nc%id, nc%id_varid, self%id, start=[idslot]), "netcdf_io_write_frame_cb nf90_put_var cb id_varid" ) + + call netcdf_io_check( nf90_put_var(nc%id, nc%Gmass_varid, self%Gmass, start=[idslot, tslot]), "netcdf_io_write_frame_cb nf90_put_var cb Gmass_varid" ) + if (param%lclose) call netcdf_io_check( nf90_put_var(nc%id, nc%radius_varid, self%radius, start=[idslot, tslot]), "netcdf_io_write_frame_cb nf90_put_var cb radius_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%j2rp2_varid, self%j2rp2, start=[tslot]), "netcdf_io_write_frame_cb nf90_put_var cb j2rp2_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%j4rp4_varid, self%j4rp4, start=[tslot]), "netcdf_io_write_frame_cb nf90_put_var cb j4rp4_varid" ) + if (param%lrotation) then + call netcdf_io_check( nf90_put_var(nc%id, nc%Ip_varid, self%Ip(:), start=[1, idslot, tslot], count=[NDIM,1,1]), "netcdf_io_write_frame_cb nf90_put_var cb Ip_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%rot_varid, self%rot(:), start=[1, idslot, tslot], count=[NDIM,1,1]), "netcdf_io_write_frame_cby nf90_put_var cb rot_varid" ) + end if + + call netcdf_io_check( nf90_set_fill(nc%id, old_mode, old_mode), "netcdf_io_write_frame_cb nf90_set_fill old_mode" ) + + return + end subroutine swiftest_io_netcdf_write_frame_cb + + + module subroutine swiftest_io_netcdf_write_frame_system(self, nc, param) + !! author: The Purdue Swiftest Team - David A. Minton, Carlisle A. Wishard, Jennifer L.L. Pouplin, and Jacob R. Elliott + !! + !! Write a frame (header plus records for each massive body and active test particle) to a output binary file + implicit none + ! Arguments + class(swiftest_nbody_system), intent(inout) :: self !! Swiftest system object + class(swiftest_netcdf_parameters), intent(inout) :: nc !! Parameters used to for writing a NetCDF dataset to file + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + + call self%write_hdr(nc, param) + call self%cb%write_frame(nc, param) + call self%pl%write_frame(nc, param) + call self%tp%write_frame(nc, param) + + return + end subroutine swiftest_io_netcdf_write_frame_system + + + module subroutine swiftest_io_netcdf_write_hdr_system(self, nc, param) + !! author: David A. Minton + !! + !! Writes header information (variables that change with time, but not particle id). + !! This subroutine swiftest_significantly improves the output over the original binary file, allowing us to track energy, momentum, and other quantities that + !! previously were handled as separate output files. + implicit none + ! Arguments + class(swiftest_nbody_system), intent(in) :: self !! Swiftest nbody system object + class(swiftest_netcdf_parameters), intent(inout) :: nc !! Parameters used to for writing a NetCDF dataset to file + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + ! Internals + integer(I4B) :: tslot + + tslot = param%ioutput + + call netcdf_io_check( nf90_put_var(nc%id, nc%time_varid, self%t, start=[tslot]), "netcdf_io_write_hdr_system nf90_put_var time_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%npl_varid, self%pl%nbody, start=[tslot]), "netcdf_io_write_hdr_system nf90_put_var npl_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%ntp_varid, self%tp%nbody, start=[tslot]), "netcdf_io_write_hdr_system nf90_put_var ntp_varid" ) + if (param%lmtiny_pl) call netcdf_io_check( nf90_put_var(nc%id, nc%nplm_varid, self%pl%nplm, start=[tslot]), "netcdf_io_write_hdr_system nf90_put_var nplm_varid" ) + + if (param%lenergy) then + call netcdf_io_check( nf90_put_var(nc%id, nc%KE_orb_varid, self%ke_orbit, start=[tslot]), "netcdf_io_write_hdr_system nf90_put_var KE_orb_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%KE_spin_varid, self%ke_spin, start=[tslot]), "netcdf_io_write_hdr_system nf90_put_var KE_spin_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%PE_varid, self%pe, start=[tslot]), "netcdf_io_write_hdr_system nf90_put_var PE_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%L_orb_varid, self%Lorbit(:), start=[1,tslot], count=[NDIM,1]), "netcdf_io_write_hdr_system nf90_put_var L_orb_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%Lspin_varid, self%Lspin(:), start=[1,tslot], count=[NDIM,1]), "netcdf_io_write_hdr_system nf90_put_var Lspin_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%L_escape_varid, self%Lescape(:), start=[1,tslot], count=[NDIM,1]), "netcdf_io_write_hdr_system nf90_put_var L_escape_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%Ecollisions_varid, self%Ecollisions, start=[tslot]), "netcdf_io_write_hdr_system nf90_put_var Ecollisions_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%Euntracked_varid, self%Euntracked, start=[tslot]), "netcdf_io_write_hdr_system nf90_put_var Euntracked_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%GMescape_varid, self%GMescape, start=[tslot]), "netcdf_io_write_hdr_system nf90_put_var GMescape_varid" ) + end if + + return + end subroutine swiftest_io_netcdf_write_hdr_system + + + module subroutine swiftest_io_netcdf_write_info_body(self, nc, param) + !! author: Carlisle A. Wishard, Dana Singh, and David A. Minton + !! + !! Write all current particle to file + implicit none + ! Arguments + class(swiftest_body), intent(in) :: self !! Swiftest particle object + class(swiftest_netcdf_parameters), intent(inout) :: nc !! Parameters used to identify a particular NetCDF dataset + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + ! Internals + integer(I4B) :: i, j, idslot, old_mode + integer(I4B), dimension(:), allocatable :: ind + character(len=:), allocatable :: charstring + + ! This string of spaces of length NAMELEN is used to clear out any old data left behind inside the string variables + call netcdf_io_check( nf90_set_fill(nc%id, nf90_nofill, old_mode), "netcdf_io_write_info_body nf90_set_fill nf90_nofill" ) + + select type(self) + class is (swiftest_body) + associate(n => self%nbody) + if (n == 0) return + call swiftest_util_sort(self%id(1:n), ind) + + do i = 1, n + j = ind(i) + idslot = self%id(j) + 1 + call netcdf_io_check( nf90_put_var(nc%id, nc%id_varid, self%id(j), start=[idslot]), "netcdf_io_write_info_body nf90_put_var id_varid" ) + + charstring = trim(adjustl(self%info(j)%name)) + call netcdf_io_check( nf90_put_var(nc%id, nc%name_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "netcdf_io_write_info_body nf90_put_var name_varid" ) + + charstring = trim(adjustl(self%info(j)%particle_type)) + call netcdf_io_check( nf90_put_var(nc%id, nc%ptype_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "netcdf_io_write_info_body nf90_put_var particle_type_varid" ) + + if (param%lclose) then + charstring = trim(adjustl(self%info(j)%origin_type)) + call netcdf_io_check( nf90_put_var(nc%id, nc%origin_type_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "netcdf_io_write_info_body nf90_put_var origin_type_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%origin_time_varid, self%info(j)%origin_time, start=[idslot]), "netcdf_io_write_info_body nf90_put_var origin_time_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%origin_rh_varid, self%info(j)%origin_rh(:), start=[1,idslot], count=[NDIM,1]), "netcdf_io_write_info_body nf90_put_var origin_rh_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%origin_vh_varid, self%info(j)%origin_vh(:), start=[1,idslot], count=[NDIM,1]), "netcdf_io_write_info_body nf90_put_var origin_vh_varid" ) + + call netcdf_io_check( nf90_put_var(nc%id, nc%collision_id_varid, self%info(j)%collision_id, start=[idslot]), "netcdf_io_write_info_body nf90_put_var collision_id_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%discard_time_varid, self%info(j)%discard_time, start=[idslot]), "netcdf_io_write_info_body nf90_put_var discard_time_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%discard_rh_varid, self%info(j)%discard_rh(:), start=[1,idslot], count=[NDIM,1]), "netcdf_io_write_info_body nf90_put_var discard_rh_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%discard_vh_varid, self%info(j)%discard_vh(:), start=[1,idslot], count=[NDIM,1]), "netcdf_io_write_info_body nf90_put_var discard_vh_varid" ) + end if + + end do + end associate + end select + + call netcdf_io_check( nf90_set_fill(nc%id, old_mode, old_mode) ) + return + end subroutine swiftest_io_netcdf_write_info_body + + + module subroutine swiftest_io_netcdf_write_info_cb(self, nc, param) + !! author: Carlisle A. Wishard, Dana Singh, and David A. Minton + !! + !! Write the central body info to file + implicit none + class(swiftest_cb), intent(in) :: self !! Swiftest particle object + class(swiftest_netcdf_parameters), intent(inout) :: nc !! Parameters used to identify a particular NetCDF dataset + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + ! Internals + integer(I4B) :: idslot, old_mode + character(len=:), allocatable :: charstring + + ! This string of spaces of length NAMELEN is used to clear out any old data left behind inside the string variables + call netcdf_io_check( nf90_set_fill(nc%id, nf90_nofill, old_mode), "netcdf_io_write_info_body nf90_set_fill nf90_nofill" ) + + idslot = self%id + 1 + call netcdf_io_check( nf90_put_var(nc%id, nc%id_varid, self%id, start=[idslot]), "netcdf_io_write_info_body nf90_put_var cb id_varid" ) + + charstring = trim(adjustl(self%info%name)) + call netcdf_io_check( nf90_put_var(nc%id, nc%name_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "netcdf_io_write_info_body nf90_put_var cb name_varid" ) + + charstring = trim(adjustl(self%info%particle_type)) + call netcdf_io_check( nf90_put_var(nc%id, nc%ptype_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "netcdf_io_write_info_body nf90_put_var cb ptype_varid" ) + + if (param%lclose) then + charstring = trim(adjustl(self%info%origin_type)) + call netcdf_io_check( nf90_put_var(nc%id, nc%origin_type_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "netcdf_io_write_info_body nf90_put_var cb origin_type_varid" ) + + call netcdf_io_check( nf90_put_var(nc%id, nc%origin_time_varid, self%info%origin_time, start=[idslot]), "netcdf_io_write_info_body nf90_put_var cb origin_time_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%origin_rh_varid, self%info%origin_rh(:), start=[1, idslot], count=[NDIM,1]), "netcdf_io_write_info_body nf90_put_var cb origin_rh_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%origin_vh_varid, self%info%origin_vh(:), start=[1, idslot], count=[NDIM,1]), "netcdf_io_write_info_body nf90_put_var cb origin_vh_varid" ) + + call netcdf_io_check( nf90_put_var(nc%id, nc%collision_id_varid, self%info%collision_id, start=[idslot]), "netcdf_io_write_info_body nf90_put_var cb collision_id_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%discard_time_varid, self%info%discard_time, start=[idslot]), "netcdf_io_write_info_body nf90_put_var cb discard_time_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%discard_rh_varid, self%info%discard_rh(:), start=[1, idslot], count=[NDIM,1]), "netcdf_io_write_info_body nf90_put_var cb discard_rh_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%discard_vh_varid, self%info%discard_vh(:), start=[1, idslot], count=[NDIM,1]), "netcdf_io_write_info_body nf90_put_var cb discard_vh_varid" ) + end if + call netcdf_io_check( nf90_set_fill(nc%id, old_mode, old_mode) ) + + return + end subroutine swiftest_io_netcdf_write_info_cb + + module subroutine swiftest_io_param_reader(self, unit, iotype, v_list, iostat, iomsg) !! author: The Purdue Swiftest Team - David A. Minton, Carlisle A. Wishard, Jennifer L.L. Pouplin, and Jacob R. Elliott !! @@ -813,21 +2045,6 @@ module subroutine swiftest_io_param_reader(self, unit, iotype, v_list, iostat, i param%GU = GC / (param%DU2M**3 / (param%MU2KG * param%TU2S**2)) - if (self%GMTINY < 0.0_DP) then - write(iomsg,*) "GMTINY invalid or not set: ", self%GMTINY - iostat = -1 - return - end if - - if (param%lfragmentation) then - if (seed_set) then - call random_seed(put = param%seed) - else - call random_seed(get = param%seed) - end if - if (param%min_GMfrag < 0.0_DP) param%min_GMfrag = param%GMTINY - end if - ! All reporting of collision information in SyMBA (including mergers) is now recorded in the Fraggle logfile call io_log_start(param, FRAGGLE_LOG_OUT, "Fraggle logfile") @@ -852,6 +2069,23 @@ module subroutine swiftest_io_param_reader(self, unit, iotype, v_list, iostat, i return end if end if + + param%lmtiny_pl = (integrator == INT_SYMBA) + + if (param%lmtiny_pl .and. self%GMTINY < 0.0_DP) then + write(iomsg,*) "GMTINY invalid or not set: ", self%GMTINY + iostat = -1 + return + end if + + if (param%lfragmentation) then + if (seed_set) then + call random_seed(put = param%seed) + else + call random_seed(get = param%seed) + end if + if (param%min_GMfrag < 0.0_DP) param%min_GMfrag = param%GMTINY + end if ! Determine if the GR flag is set correctly for this integrator select case(integrator) @@ -1618,7 +2852,7 @@ module subroutine swiftest_io_write_frame_system(self, param) logical :: fileExists associate (nc => param%system_history%nc, pl => self%pl, tp => self%tp, npl => self%pl%nbody, ntp => self%tp%nbody) - nc%id_chunk = npl + ntp + nc%name_chunk = npl + ntp nc%time_chunk = max(param%dump_cadence / param%istep_out, 1) nc%file_name = param%outfile if (lfirst) then diff --git a/src/swiftest/swiftest_io_netcdf.f90 b/src/swiftest/swiftest_io_netcdf.f90 deleted file mode 100644 index 04f4b6b56..000000000 --- a/src/swiftest/swiftest_io_netcdf.f90 +++ /dev/null @@ -1,1246 +0,0 @@ -!! Copyright 2022 - David Minton, Carlisle Wishard, Jennifer Pouplin, Jake Elliott, & Dana Singh -!! This file is part of Swiftest. -!! Swiftest is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License -!! as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. -!! Swiftest is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty -!! of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. -!! You should have received a copy of the GNU General Public License along with Swiftest. -!! If not, see: https://www.gnu.org/licenses. - -submodule (swiftest) s_io_netcdf - use netcdf -contains - - - - module function swiftest_io_netcdf_get_old_t_final_system(self, param) result(old_t_final) - !! author: David A. Minton - !! - !! Validates the dump file to check whether the dump file initial conditions duplicate the last frame of the netcdf output. - !! - implicit none - ! Arguments - class(swiftest_nbody_system), intent(inout) :: self - class(base_parameters), intent(inout) :: param - ! Result - real(DP) :: old_t_final - ! Internals - integer(I4B) :: itmax, idmax - real(DP), dimension(:), allocatable :: vals - real(DP), dimension(1) :: rtemp - real(DP), dimension(NDIM) :: rot0, Ip0, Lnow - real(DP) :: KE_orb_orig, KE_spin_orig, PE_orig - - select type(param) - class is (swiftest_parameters) - associate (nc => param%system_history%nc, cb => self%cb) - call nc%open(param) - call netcdf_check( nf90_inquire_dimension(nc%id, nc%time_dimid, len=itmax), "swiftest_io_netcdf_get_old_t_final_system time_dimid" ) - call netcdf_check( nf90_inquire_dimension(nc%id, nc%name_dimid, len=idmax), "swiftest_io_netcdf_get_old_t_final_system name_dimid" ) - allocate(vals(idmax)) - call netcdf_check( nf90_get_var(nc%id, nc%time_varid, rtemp, start=[1], count=[1]), "swiftest_io_netcdf_get_old_t_final_system time_varid" ) - - !old_t_final = rtemp(1) - old_t_final = param%t0 ! For NetCDF it is safe to overwrite the final t value on a restart - - if (param%lenergy) then - call netcdf_check( nf90_get_var(nc%id, nc%KE_orb_varid, rtemp, start=[1], count=[1]), "swiftest_io_netcdf_get_old_t_final_system KE_orb_varid" ) - KE_orb_orig = rtemp(1) - - call netcdf_check( nf90_get_var(nc%id, nc%KE_spin_varid, rtemp, start=[1], count=[1]), "swiftest_io_netcdf_get_old_t_final_system KE_spin_varid" ) - KE_spin_orig = rtemp(1) - - call netcdf_check( nf90_get_var(nc%id, nc%PE_varid, rtemp, start=[1], count=[1]), "swiftest_io_netcdf_get_old_t_final_system PE_varid" ) - PE_orig = rtemp(1) - - call netcdf_check( nf90_get_var(nc%id, nc%Ecollisions_varid, self%Ecollisions, start=[1]), "swiftest_io_netcdf_get_old_t_final_system Ecollisions_varid" ) - call netcdf_check( nf90_get_var(nc%id, nc%Euntracked_varid, self%Euntracked, start=[1]), "swiftest_io_netcdf_get_old_t_final_system Euntracked_varid" ) - - self%Eorbit_orig = KE_orb_orig + KE_spin_orig + PE_orig + self%Ecollisions + self%Euntracked - - call netcdf_check( nf90_get_var(nc%id, nc%L_orb_varid, self%Lorbit_orig(:), start=[1,1], count=[NDIM,1]), "swiftest_io_netcdf_get_old_t_final_system L_orb_varid" ) - call netcdf_check( nf90_get_var(nc%id, nc%Lspin_varid, self%Lspin_orig(:), start=[1,1], count=[NDIM,1]), "swiftest_io_netcdf_get_old_t_final_system Lspin_varid" ) - call netcdf_check( nf90_get_var(nc%id, nc%L_escape_varid, self%Lescape(:), start=[1,1], count=[NDIM,1]), "swiftest_io_netcdf_get_old_t_final_system L_escape_varid" ) - - self%Ltot_orig(:) = self%Lorbit_orig(:) + self%Lspin_orig(:) + self%Lescape(:) - - call netcdf_check( nf90_get_var(nc%id, nc%Gmass_varid, vals, start=[1,1], count=[idmax,1]), "swiftest_io_netcdf_get_old_t_final_system Gmass_varid" ) - call netcdf_check( nf90_get_var(nc%id, nc%GMescape_varid, self%GMescape, start=[1]), "swiftest_io_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 - - cb%GM0 = vals(1) - cb%dGM = cb%Gmass - cb%GM0 - - call netcdf_check( nf90_get_var(nc%id, nc%radius_varid, rtemp, start=[1,1], count=[1,1]), "swiftest_io_netcdf_get_old_t_final_system radius_varid" ) - cb%R0 = rtemp(1) - - if (param%lrotation) then - - call netcdf_check( nf90_get_var(nc%id, nc%rot_varid, rot0, start=[1,1,1], count=[NDIM,1,1]), "swiftest_io_netcdf_get_old_t_final_system rot_varid" ) - call netcdf_check( nf90_get_var(nc%id, nc%Ip_varid, Ip0, start=[1,1,1], count=[NDIM,1,1]), "swiftest_io_netcdf_get_old_t_final_system Ip_varid" ) - - cb%L0(:) = Ip0(3) * cb%GM0 * cb%R0**2 * rot0(:) - - Lnow(:) = cb%Ip(3) * cb%Gmass * cb%radius**2 * cb%rot(:) - cb%dL(:) = Lnow(:) - cb%L0(:) - end if - - end if - - deallocate(vals) - end associate - end select - - return - end function swiftest_io_netcdf_get_old_t_final_system - - - module subroutine swiftest_io_netcdf_initialize_output(self, param) - !! author: Carlisle A. Wishard, Dana Singh, and David A. Minton - !! - !! Initialize a NetCDF file system and defines all variables. - use, intrinsic :: ieee_arithmetic - implicit none - ! Arguments - class(swiftest_io_netcdf_parameters), intent(inout) :: self !! Parameters used to for writing a NetCDF dataset to file - class(base_parameters), intent(in) :: param !! Current run configuration parameters - ! Internals - integer(I4B) :: nvar, varid, vartype - real(DP) :: dfill - real(SP) :: sfill - integer(I4B), parameter :: NO_FILL = 0 - logical :: fileExists - character(len=STRMAX) :: errmsg - integer(I4B) :: ndims - - associate(nc => self) - - dfill = ieee_value(dfill, IEEE_QUIET_NAN) - sfill = ieee_value(sfill, IEEE_QUIET_NAN) - - select case (param%out_type) - case("swiftest_io_netcdf_FLOAT") - nc%out_type = NF90_FLOAT - case("swiftest_io_netcdf_DOUBLE") - nc%out_type = NF90_DOUBLE - end select - - ! Check if the file exists, and if it does, delete it - inquire(file=nc%file_name, exist=fileExists) - if (fileExists) then - open(unit=LUN, file=nc%file_name, status="old", err=667, iomsg=errmsg) - close(unit=LUN, status="delete") - end if - - ! Create the file - call netcdf_check( nf90_create(nc%file_name, NF90_NETCDF4, nc%id), "swiftest_io_netcdf_initialize_output nf90_create" ) - - ! Dimensions - call netcdf_check( nf90_def_dim(nc%id, nc%time_dimname, NF90_UNLIMITED, nc%time_dimid), "swiftest_io_netcdf_initialize_output nf90_def_dim time_dimid" ) ! Simulation time dimension - call netcdf_check( nf90_def_dim(nc%id, nc%space_dimname, NDIM, nc%space_dimid), "swiftest_io_netcdf_initialize_output nf90_def_dim space_dimid" ) ! 3D space dimension - call netcdf_check( nf90_def_dim(nc%id, nc%name_dimname, NF90_UNLIMITED, nc%name_dimid), "swiftest_io_netcdf_initialize_output nf90_def_dim name_dimid" ) ! dimension to store particle id numbers - call netcdf_check( nf90_def_dim(nc%id, nc%str_dimname, NAMELEN, nc%str_dimid), "swiftest_io_netcdf_initialize_output nf90_def_dim str_dimid" ) ! Dimension for string variables (aka character arrays) - - ! Dimension coordinates - call netcdf_check( nf90_def_var(nc%id, nc%time_dimname, nc%out_type, nc%time_dimid, nc%time_varid), "swiftest_io_netcdf_initialize_output nf90_def_var time_varid" ) - call netcdf_check( nf90_def_var(nc%id, nc%space_dimname, NF90_CHAR, nc%space_dimid, nc%space_varid), "swiftest_io_netcdf_initialize_output nf90_def_var space_varid" ) - call netcdf_check( nf90_def_var(nc%id, nc%name_dimname, NF90_CHAR, [nc%str_dimid, nc%name_dimid], nc%name_varid), "swiftest_io_netcdf_initialize_output nf90_def_var name_varid" ) - - ! Variables - call netcdf_check( nf90_def_var(nc%id, nc%id_varname, NF90_INT, nc%name_dimid, nc%id_varid), "swiftest_io_netcdf_initialize_output nf90_def_var id_varid" ) - call netcdf_check( nf90_def_var(nc%id, nc%npl_varname, NF90_INT, nc%time_dimid, nc%npl_varid), "swiftest_io_netcdf_initialize_output nf90_def_var npl_varid" ) - call netcdf_check( nf90_def_var(nc%id, nc%ntp_varname, NF90_INT, nc%time_dimid, nc%ntp_varid), "swiftest_io_netcdf_initialize_output nf90_def_var ntp_varid" ) - if (param%integrator == INT_SYMBA) call netcdf_check( nf90_def_var(nc%id, nc%nplm_varname, NF90_INT, nc%time_dimid, nc%nplm_varid), "swiftest_io_netcdf_initialize_output nf90_def_var nplm_varid" ) - call netcdf_check( nf90_def_var(nc%id, nc%ptype_varname, NF90_CHAR, [nc%str_dimid, nc%name_dimid], nc%ptype_varid), "swiftest_io_netcdf_initialize_output nf90_def_var ptype_varid" ) - - if ((param%out_form == "XV") .or. (param%out_form == "XVEL")) then - call netcdf_check( nf90_def_var(nc%id, nc%rh_varname, nc%out_type, [nc%space_dimid, nc%name_dimid, nc%time_dimid], nc%rh_varid), "swiftest_io_netcdf_initialize_output nf90_def_var rh_varid" ) - call netcdf_check( nf90_def_var(nc%id, nc%vh_varname, nc%out_type, [nc%space_dimid, nc%name_dimid, nc%time_dimid], nc%vh_varid), "swiftest_io_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 netcdf_check( nf90_def_var(nc%id, nc%gr_pseudo_vh_varname, nc%out_type, [nc%space_dimid, nc%name_dimid, nc%time_dimid], nc%gr_pseudo_vh_varid), "swiftest_io_netcdf_initialize_output nf90_def_var gr_psuedo_vh_varid" ) - nc%lpseudo_vel_exists = .true. - end if - - end if - - if ((param%out_form == "EL") .or. (param%out_form == "XVEL")) then - call netcdf_check( nf90_def_var(nc%id, nc%a_varname, nc%out_type, [nc%name_dimid, nc%time_dimid], nc%a_varid), "swiftest_io_netcdf_initialize_output nf90_def_var a_varid" ) - call netcdf_check( nf90_def_var(nc%id, nc%e_varname, nc%out_type, [nc%name_dimid, nc%time_dimid], nc%e_varid), "swiftest_io_netcdf_initialize_output nf90_def_var e_varid" ) - call netcdf_check( nf90_def_var(nc%id, nc%inc_varname, nc%out_type, [nc%name_dimid, nc%time_dimid], nc%inc_varid), "swiftest_io_netcdf_initialize_output nf90_def_var inc_varid" ) - call netcdf_check( nf90_def_var(nc%id, nc%capom_varname, nc%out_type, [nc%name_dimid, nc%time_dimid], nc%capom_varid), "swiftest_io_netcdf_initialize_output nf90_def_var capom_varid" ) - call netcdf_check( nf90_def_var(nc%id, nc%omega_varname, nc%out_type, [nc%name_dimid, nc%time_dimid], nc%omega_varid), "swiftest_io_netcdf_initialize_output nf90_def_var omega_varid" ) - call netcdf_check( nf90_def_var(nc%id, nc%capm_varname, nc%out_type, [nc%name_dimid, nc%time_dimid], nc%capm_varid), "swiftest_io_netcdf_initialize_output nf90_def_var capm_varid" ) - call netcdf_check( nf90_def_var(nc%id, nc%varpi_varname, nc%out_type, [nc%name_dimid, nc%time_dimid], nc%varpi_varid), "swiftest_io_netcdf_initialize_output nf90_def_var varpi_varid" ) - call netcdf_check( nf90_def_var(nc%id, nc%lam_varname, nc%out_type, [nc%name_dimid, nc%time_dimid], nc%lam_varid), "swiftest_io_netcdf_initialize_output nf90_def_var lam_varid" ) - call netcdf_check( nf90_def_var(nc%id, nc%f_varname, nc%out_type, [nc%name_dimid, nc%time_dimid], nc%f_varid), "swiftest_io_netcdf_initialize_output nf90_def_var f_varid" ) - call netcdf_check( nf90_def_var(nc%id, nc%cape_varname, nc%out_type, [nc%name_dimid, nc%time_dimid], nc%cape_varid), "swiftest_io_netcdf_initialize_output nf90_def_var cape_varid" ) - end if - - call netcdf_check( nf90_def_var(nc%id, nc%gmass_varname, nc%out_type, [nc%name_dimid, nc%time_dimid], nc%Gmass_varid), "swiftest_io_netcdf_initialize_output nf90_def_var Gmass_varid" ) - - if (param%lrhill_present) then - call netcdf_check( nf90_def_var(nc%id, nc%rhill_varname, nc%out_type, [nc%name_dimid, nc%time_dimid], nc%rhill_varid), "swiftest_io_netcdf_initialize_output nf90_def_var rhill_varid" ) - end if - - if (param%lclose) then - call netcdf_check( nf90_def_var(nc%id, nc%radius_varname, nc%out_type, [nc%name_dimid, nc%time_dimid], nc%radius_varid), "swiftest_io_netcdf_initialize_output nf90_def_var radius_varid" ) - - call netcdf_check( nf90_def_var(nc%id, nc%origin_time_varname, nc%out_type, nc%name_dimid, nc%origin_time_varid), "swiftest_io_netcdf_initialize_output nf90_def_var origin_time_varid" ) - call netcdf_check( nf90_def_var(nc%id, nc%origin_type_varname, NF90_CHAR, [nc%str_dimid, nc%name_dimid], & - nc%origin_type_varid), "swiftest_io_netcdf_initialize_output nf90_create" ) - call netcdf_check( nf90_def_var(nc%id, nc%origin_rh_varname, nc%out_type, [nc%space_dimid, nc%name_dimid], nc%origin_rh_varid), "swiftest_io_netcdf_initialize_output nf90_def_var origin_rh_varid" ) - call netcdf_check( nf90_def_var(nc%id, nc%origin_vh_varname, nc%out_type, [nc%space_dimid, nc%name_dimid], nc%origin_vh_varid), "swiftest_io_netcdf_initialize_output nf90_def_var origin_vh_varid" ) - - call netcdf_check( nf90_def_var(nc%id, nc%collision_id_varname, NF90_INT, nc%name_dimid, nc%collision_id_varid), "swiftest_io_netcdf_initialize_output nf90_def_var collision_id_varid" ) - call netcdf_check( nf90_def_var(nc%id, nc%discard_time_varname, nc%out_type, nc%name_dimid, nc%discard_time_varid), "swiftest_io_netcdf_initialize_output nf90_def_var discard_time_varid" ) - call netcdf_check( nf90_def_var(nc%id, nc%discard_rh_varname, nc%out_type, [nc%space_dimid, nc%name_dimid], nc%discard_rh_varid), "swiftest_io_netcdf_initialize_output nf90_def_var discard_rh_varid" ) - call netcdf_check( nf90_def_var(nc%id, nc%discard_vh_varname, nc%out_type, [nc%space_dimid, nc%name_dimid], nc%discard_vh_varid), "swiftest_io_netcdf_initialize_output nf90_def_var discard_vh_varid" ) - call netcdf_check( nf90_def_var(nc%id, nc%discard_body_id_varname, NF90_INT, nc%name_dimid, nc%discard_body_id_varid), "swiftest_io_netcdf_initialize_output nf90_def_var discard_body_id_varid" ) - end if - - if (param%lrotation) then - call netcdf_check( nf90_def_var(nc%id, nc%Ip_varname, nc%out_type, [nc%space_dimid, nc%name_dimid, nc%time_dimid], nc%Ip_varid), "swiftest_io_netcdf_initialize_output nf90_def_var Ip_varid" ) - call netcdf_check( nf90_def_var(nc%id, nc%rot_varname, nc%out_type, [nc%space_dimid, nc%name_dimid, nc%time_dimid], nc%rot_varid), "swiftest_io_netcdf_initialize_output nf90_def_var rot_varid" ) - end if - - ! if (param%ltides) then - ! call netcdf_check( nf90_def_var(nc%id, nc%k2_varname, nc%out_type, [nc%name_dimid, nc%time_dimid], nc%k2_varid), "swiftest_io_netcdf_initialize_output nf90_def_var k2_varid" ) - ! call netcdf_check( nf90_def_var(nc%id, nc%q_varname, nc%out_type, [nc%name_dimid, nc%time_dimid], nc%Q_varid), "swiftest_io_netcdf_initialize_output nf90_def_var Q_varid" ) - ! end if - - if (param%lenergy) then - call netcdf_check( nf90_def_var(nc%id, nc%ke_orb_varname, nc%out_type, nc%time_dimid, nc%KE_orb_varid), "swiftest_io_netcdf_initialize_output nf90_def_var KE_orb_varid" ) - call netcdf_check( nf90_def_var(nc%id, nc%ke_spin_varname, nc%out_type, nc%time_dimid, nc%KE_spin_varid), "swiftest_io_netcdf_initialize_output nf90_def_var KE_spin_varid" ) - call netcdf_check( nf90_def_var(nc%id, nc%pe_varname, nc%out_type, nc%time_dimid, nc%PE_varid), "swiftest_io_netcdf_initialize_output nf90_def_var PE_varid" ) - call netcdf_check( nf90_def_var(nc%id, nc%L_orb_varname, nc%out_type, [nc%space_dimid, nc%time_dimid], nc%L_orb_varid), "swiftest_io_netcdf_initialize_output nf90_def_var L_orb_varid" ) - call netcdf_check( nf90_def_var(nc%id, nc%Lspin_varname, nc%out_type, [nc%space_dimid, nc%time_dimid], nc%Lspin_varid), "swiftest_io_netcdf_initialize_output nf90_def_var Lspin_varid" ) - call netcdf_check( nf90_def_var(nc%id, nc%L_escape_varname, nc%out_type, [nc%space_dimid, nc%time_dimid], nc%L_escape_varid), "swiftest_io_netcdf_initialize_output nf90_def_var L_escape_varid" ) - call netcdf_check( nf90_def_var(nc%id, nc%Ecollisions_varname, nc%out_type, nc%time_dimid, nc%Ecollisions_varid), "swiftest_io_netcdf_initialize_output nf90_def_var Ecollisions_varid" ) - call netcdf_check( nf90_def_var(nc%id, nc%Euntracked_varname, nc%out_type, nc%time_dimid, nc%Euntracked_varid), "swiftest_io_netcdf_initialize_output nf90_def_var Euntracked_varid" ) - call netcdf_check( nf90_def_var(nc%id, nc%GMescape_varname, nc%out_type, nc%time_dimid, nc%GMescape_varid), "swiftest_io_netcdf_initialize_output nf90_def_var GMescape_varid" ) - end if - - call netcdf_check( nf90_def_var(nc%id, nc%j2rp2_varname, nc%out_type, nc%time_dimid, nc%j2rp2_varid), "swiftest_io_netcdf_initialize_output nf90_def_var j2rp2_varid" ) - call netcdf_check( nf90_def_var(nc%id, nc%j4rp4_varname, nc%out_type, nc%time_dimid, nc%j4rp4_varid), "swiftest_io_netcdf_initialize_output nf90_def_var j4rp4_varid" ) - - - ! Set fill mode to NaN for all variables - call netcdf_check( nf90_inquire(nc%id, nVariables=nvar), "swiftest_io_netcdf_initialize_output nf90_inquire nVariables" ) - do varid = 1, nvar - call netcdf_check( nf90_inquire_variable(nc%id, varid, xtype=vartype, ndims=ndims), "swiftest_io_netcdf_initialize_output nf90_inquire_variable" ) - select case(vartype) - case(NF90_INT) - call netcdf_check( nf90_def_var_fill(nc%id, varid, NO_FILL, NF90_FILL_INT), "swiftest_io_netcdf_initialize_output nf90_def_var_fill NF90_INT" ) - case(NF90_FLOAT) - call netcdf_check( nf90_def_var_fill(nc%id, varid, NO_FILL, sfill), "swiftest_io_netcdf_initialize_output nf90_def_var_fill NF90_FLOAT" ) - case(NF90_DOUBLE) - call netcdf_check( nf90_def_var_fill(nc%id, varid, NO_FILL, dfill), "swiftest_io_netcdf_initialize_output nf90_def_var_fill NF90_DOUBLE" ) - case(NF90_CHAR) - call netcdf_check( nf90_def_var_fill(nc%id, varid, NO_FILL, 0), "swiftest_io_netcdf_initialize_output nf90_def_var_fill NF90_CHAR" ) - end select - end do - - ! Set special fill mode for discard time so that we can make use of it for non-discarded bodies. - select case (vartype) - case(NF90_FLOAT) - call netcdf_check( nf90_def_var_fill(nc%id, nc%discard_time_varid, NO_FILL, huge(1.0_SP)), "swiftest_io_netcdf_initialize_output nf90_def_var_fill discard_time NF90_FLOAT" ) - case(NF90_DOUBLE) - call netcdf_check( nf90_def_var_fill(nc%id, nc%discard_time_varid, NO_FILL, huge(1.0_DP)), "swiftest_io_netcdf_initialize_output nf90_def_var_fill discard_time NF90_DOUBLE" ) - end select - - ! Take the file out of define mode - call netcdf_check( nf90_enddef(nc%id), "swiftest_io_netcdf_initialize_output nf90_enddef" ) - - ! Add in the space dimension coordinates - call netcdf_check( nf90_put_var(nc%id, nc%space_varid, nc%space_coords, start=[1], count=[NDIM]), "swiftest_io_netcdf_initialize_output nf90_put_var space" ) - - end associate - return - - 667 continue - write(*,*) "Error creating NetCDF output file. " // trim(adjustl(errmsg)) - call swiftest_util_exit(FAILURE) - end subroutine swiftest_io_netcdf_initialize_output - - - module subroutine swiftest_io_netcdf_open(self, param, readonly) - !! author: Carlisle A. Wishard, Dana Singh, and David A. Minton - !! - !! Opens a NetCDF file and does the variable inquiries to activate variable ids - implicit none - ! Arguments - class(swiftest_io_netcdf_parameters), intent(inout) :: self !! Parameters used to identify a particular NetCDF dataset - class(base_parameters), intent(in) :: param !! Current run configuration parameters - logical, optional, intent(in) :: readonly !! Logical flag indicating that this should be open read only - ! Internals - integer(I4B) :: mode, status - character(len=STRMAX) :: errmsg - - mode = NF90_WRITE - if (present(readonly)) then - if (readonly) mode = NF90_NOWRITE - end if - - associate(nc => self) - - write(errmsg,*) "swiftest_io_netcdf_open nf90_open ",trim(adjustl(nc%file_name)) - call netcdf_check( nf90_open(nc%file_name, mode, nc%id), errmsg) - - ! Dimensions - call netcdf_check( nf90_inq_dimid(nc%id, nc%time_dimname, nc%time_dimid), "swiftest_io_netcdf_open nf90_inq_dimid time_dimid" ) - call netcdf_check( nf90_inq_dimid(nc%id, nc%space_dimname, nc%space_dimid), "swiftest_io_netcdf_open nf90_inq_dimid space_dimid" ) - call netcdf_check( nf90_inq_dimid(nc%id, nc%name_dimname, nc%name_dimid), "swiftest_io_netcdf_open nf90_inq_dimid name_dimid" ) - call netcdf_check( nf90_inq_dimid(nc%id, nc%str_dimname, nc%str_dimid), "swiftest_io_netcdf_open nf90_inq_dimid str_dimid" ) - - ! Dimension coordinates - call netcdf_check( nf90_inq_varid(nc%id, nc%time_dimname, nc%time_varid), "swiftest_io_netcdf_open nf90_inq_varid time_varid" ) - call netcdf_check( nf90_inq_varid(nc%id, nc%space_dimname, nc%space_varid), "swiftest_io_netcdf_open nf90_inq_varid space_varid" ) - call netcdf_check( nf90_inq_varid(nc%id, nc%name_dimname, nc%name_varid), "swiftest_io_netcdf_open nf90_inq_varid name_varid" ) - - ! Required Variables - call netcdf_check( nf90_inq_varid(nc%id, nc%id_varname, nc%id_varid), "swiftest_io_netcdf_open nf90_inq_varid name_varid" ) - call netcdf_check( nf90_inq_varid(nc%id, nc%gmass_varname, nc%Gmass_varid), "swiftest_io_netcdf_open nf90_inq_varid Gmass_varid" ) - - if ((param%out_form == "XV") .or. (param%out_form == "XVEL")) then - call netcdf_check( nf90_inq_varid(nc%id, nc%rh_varname, nc%rh_varid), "swiftest_io_netcdf_open nf90_inq_varid rh_varid" ) - call netcdf_check( nf90_inq_varid(nc%id, nc%vh_varname, nc%vh_varid), "swiftest_io_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(nc%id, nc%gr_pseudo_vh_varname, nc%gr_pseudo_vh_varid) - nc%lpseudo_vel_exists = (status == nf90_noerr) - if (param%lrestart .and. .not.nc%lpseudo_vel_exists) then - write(*,*) "Warning! Pseudovelocity not found in input file for GR enabled run. If this is a restarted run, bit-identical trajectories are not guarunteed!" - end if - - end if - end if - - if ((param%out_form == "EL") .or. (param%out_form == "XVEL")) then - call netcdf_check( nf90_inq_varid(nc%id, nc%a_varname, nc%a_varid), "swiftest_io_netcdf_open nf90_inq_varid a_varid" ) - call netcdf_check( nf90_inq_varid(nc%id, nc%e_varname, nc%e_varid), "swiftest_io_netcdf_open nf90_inq_varid e_varid" ) - call netcdf_check( nf90_inq_varid(nc%id, nc%inc_varname, nc%inc_varid), "swiftest_io_netcdf_open nf90_inq_varid inc_varid" ) - call netcdf_check( nf90_inq_varid(nc%id, nc%capom_varname, nc%capom_varid), "swiftest_io_netcdf_open nf90_inq_varid capom_varid" ) - call netcdf_check( nf90_inq_varid(nc%id, nc%omega_varname, nc%omega_varid), "swiftest_io_netcdf_open nf90_inq_varid omega_varid" ) - call netcdf_check( nf90_inq_varid(nc%id, nc%capm_varname, nc%capm_varid), "swiftest_io_netcdf_open nf90_inq_varid capm_varid" ) - end if - - if (param%lclose) then - call netcdf_check( nf90_inq_varid(nc%id, nc%radius_varname, nc%radius_varid), "swiftest_io_netcdf_open nf90_inq_varid radius_varid" ) - end if - - if (param%lrotation) then - call netcdf_check( nf90_inq_varid(nc%id, nc%Ip_varname, nc%Ip_varid), "swiftest_io_netcdf_open nf90_inq_varid Ip_varid" ) - call netcdf_check( nf90_inq_varid(nc%id, nc%rot_varname, nc%rot_varid), "swiftest_io_netcdf_open nf90_inq_varid rot_varid" ) - end if - - ! if (param%ltides) then - ! call netcdf_check( nf90_inq_varid(nc%id, nc%k2_varname, nc%k2_varid), "swiftest_io_netcdf_open nf90_inq_varid k2_varid" ) - ! call netcdf_check( nf90_inq_varid(nc%id, nc%q_varname, nc%Q_varid), "swiftest_io_netcdf_open nf90_inq_varid Q_varid" ) - ! end if - - ! Optional Variables - if (param%lrhill_present) then - status = nf90_inq_varid(nc%id, nc%rhill_varname, nc%rhill_varid) - if (status /= nf90_noerr) write(*,*) "Warning! RHILL variable not set in input file. Calculating." - end if - - ! Optional variables The User Doesn't Need to Know About - status = nf90_inq_varid(nc%id, nc%npl_varname, nc%npl_varid) - status = nf90_inq_varid(nc%id, nc%ntp_varname, nc%ntp_varid) - status = nf90_inq_varid(nc%id, nc%j2rp2_varname, nc%j2rp2_varid) - status = nf90_inq_varid(nc%id, nc%j4rp4_varname, nc%j4rp4_varid) - status = nf90_inq_varid(nc%id, nc%ptype_varname, nc%ptype_varid) - status = nf90_inq_varid(nc%id, nc%varpi_varname, nc%varpi_varid) - status = nf90_inq_varid(nc%id, nc%lam_varname, nc%lam_varid) - status = nf90_inq_varid(nc%id, nc%f_varname, nc%f_varid) - status = nf90_inq_varid(nc%id, nc%cape_varname, nc%cape_varid) - - if (param%integrator == INT_SYMBA) then - status = nf90_inq_varid(nc%id, nc%nplm_varname, nc%nplm_varid) - end if - - if (param%lclose) then - status = nf90_inq_varid(nc%id, nc%origin_type_varname, nc%origin_type_varid) - status = nf90_inq_varid(nc%id, nc%origin_time_varname, nc%origin_time_varid) - status = nf90_inq_varid(nc%id, nc%origin_rh_varname, nc%origin_rh_varid) - status = nf90_inq_varid(nc%id, nc%origin_vh_varname, nc%origin_vh_varid) - status = nf90_inq_varid(nc%id, nc%collision_id_varname, nc%collision_id_varid) - status = nf90_inq_varid(nc%id, nc%discard_time_varname, nc%discard_time_varid) - status = nf90_inq_varid(nc%id, nc%discard_rh_varname, nc%discard_rh_varid) - status = nf90_inq_varid(nc%id, nc%discard_vh_varname, nc%discard_vh_varid) - status = nf90_inq_varid(nc%id, nc%discard_body_id_varname, nc%discard_body_id_varid) - end if - - if (param%lenergy) then - status = nf90_inq_varid(nc%id, nc%ke_orb_varname, nc%KE_orb_varid) - status = nf90_inq_varid(nc%id, nc%ke_spin_varname, nc%KE_spin_varid) - status = nf90_inq_varid(nc%id, nc%pe_varname, nc%PE_varid) - status = nf90_inq_varid(nc%id, nc%L_orb_varname, nc%L_orb_varid) - status = nf90_inq_varid(nc%id, nc%Lspin_varname, nc%Lspin_varid) - status = nf90_inq_varid(nc%id, nc%L_escape_varname, nc%L_escape_varid) - status = nf90_inq_varid(nc%id, nc%Ecollisions_varname, nc%Ecollisions_varid) - status = nf90_inq_varid(nc%id, nc%Euntracked_varname, nc%Euntracked_varid) - status = nf90_inq_varid(nc%id, nc%GMescape_varname, nc%GMescape_varid) - end if - - end associate - - return - end subroutine swiftest_io_netcdf_open - - - module function swiftest_io_netcdf_read_frame_system(self, nc, param) result(ierr) - !! author: The Purdue Swiftest Team - David A. Minton, Carlisle A. Wishard, Jennifer L.L. Pouplin, and Jacob R. Elliott - !! - !! Read a frame (header plus records for each massive body and active test particle) from an output binary file - implicit none - ! Arguments - class(swiftest_nbody_system), intent(inout) :: self !! Swiftest system object - class(base_io_netcdf_parameters), intent(inout) :: nc !! Parameters used to identify a particular NetCDF dataset - class(base_parameters), intent(inout) :: param !! Current run configuration parameters - ! Return - integer(I4B) :: ierr !! Error code: returns 0 if the read is successful - ! Internals - integer(I4B) :: i, tslot, idmax, npl_check, ntp_check, nplm_check, t_max, str_max, status - real(DP), dimension(:), allocatable :: rtemp - real(DP), dimension(:,:), allocatable :: vectemp - integer(I4B), dimension(:), allocatable :: itemp - logical, dimension(:), allocatable :: validmask, tpmask, plmask - - tslot = param%ioutput - - call nc%open(param, readonly=.true.) - call self%read_hdr(nc, param) - select type(param) - class is (swiftest_parameters) - associate(cb => self%cb, pl => self%pl, tp => self%tp, npl => self%pl%nbody, ntp => self%tp%nbody) - - call pl%setup(npl, param) - call tp%setup(ntp, param) - - call netcdf_check( nf90_inquire_dimension(nc%id, nc%name_dimid, len=idmax), "swiftest_io_netcdf_read_frame_system nf90_inquire_dimension name_dimid" ) - allocate(rtemp(idmax)) - allocate(vectemp(NDIM,idmax)) - allocate(itemp(idmax)) - allocate(validmask(idmax)) - allocate(tpmask(idmax)) - allocate(plmask(idmax)) - call netcdf_check( nf90_inquire_dimension(nc%id, nc%time_dimid, len=t_max), "swiftest_io_netcdf_read_frame_system nf90_inquire_dimension time_dimid" ) - call netcdf_check( nf90_inquire_dimension(nc%id, nc%str_dimid, len=str_max), "swiftest_io_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 netcdf_check( nf90_get_var(nc%id, nc%rh_varid, vectemp(:,:), start=[1, 1, tslot]), "swiftest_io_netcdf_read_frame_system filter pass nf90_getvar rh_varid" ) - validmask(:) = vectemp(1,:) == vectemp(1,:) - else - call netcdf_check( nf90_get_var(nc%id, nc%a_varid, rtemp(:), start=[1, tslot]), "swiftest_io_netcdf_read_frame_system filter pass nf90_getvar a_varid" ) - validmask(:) = rtemp(:) == rtemp(:) - end if - - ! Next, filter only bodies that don't have mass (test particles) - call netcdf_check( nf90_get_var(nc%id, nc%Gmass_varid, rtemp(:), start=[1, tslot]), "swiftest_io_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 - - ! Check to make sure the number of bodies is correct - npl_check = count(plmask(:)) - ntp_check = count(tpmask(:)) - - if (npl_check /= npl) then - write(*,*) "Error reading in NetCDF file: The recorded value of npl does not match the number of active massive bodies" - call swiftest_util_exit(failure) - end if - - if (ntp_check /= ntp) then - write(*,*) "Error reading in NetCDF file: The recorded value of ntp does not match the number of active test particles" - call swiftest_util_exit(failure) - end if - - if (param%integrator == INT_SYMBA) then - nplm_check = count(pack(rtemp,plmask) > param%GMTINY ) - if (nplm_check /= pl%nplm) then - write(*,*) "Error reading in NetCDF file: The recorded value of nplm does not match the number of active fully interacting massive bodies" - call swiftest_util_exit(failure) - end if - end if - - ! Now read in each variable and split the outputs by body type - if ((param%in_form == "XV") .or. (param%in_form == "XVEL")) then - call netcdf_check( nf90_get_var(nc%id, nc%rh_varid, vectemp, start=[1, 1, tslot], count=[NDIM,idmax,1]), "swiftest_io_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 - - if (param%lgr .and. nc%lpseudo_vel_exists) then - call netcdf_check( nf90_get_var(nc%id, nc%gr_pseudo_vh_varid, vectemp, start=[1, 1, tslot], count=[NDIM,idmax,1]), "swiftest_io_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 netcdf_check( nf90_get_var(nc%id, nc%vh_varid, vectemp, start=[1, 1, tslot], count=[NDIM,idmax,1]), "swiftest_io_netcdf_read_frame_system nf90_getvar vh_varid" ) - do i = 1, NDIM - if (npl > 0) pl%vh(i,:) = pack(vectemp(i,:), plmask(:)) - if (ntp > 0) tp%vh(i,:) = pack(vectemp(i,:), tpmask(:)) - end do - end if - end if - - if ((param%in_form == "EL") .or. (param%in_form == "XVEL")) then - call netcdf_check( nf90_get_var(nc%id, nc%a_varid, rtemp, start=[1, tslot], count=[idmax,1]), "swiftest_io_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 netcdf_check( nf90_get_var(nc%id, nc%e_varid, rtemp, start=[1, tslot], count=[idmax,1]), "swiftest_io_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 netcdf_check( nf90_get_var(nc%id, nc%inc_varid, rtemp, start=[1, tslot], count=[idmax,1]), "swiftest_io_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 netcdf_check( nf90_get_var(nc%id, nc%capom_varid, rtemp, start=[1, tslot], count=[idmax,1]), "swiftest_io_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 netcdf_check( nf90_get_var(nc%id, nc%omega_varid, rtemp, start=[1, tslot], count=[idmax,1]), "swiftest_io_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 netcdf_check( nf90_get_var(nc%id, nc%capm_varid, rtemp, start=[1, tslot], count=[idmax,1]), "swiftest_io_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)) - if (npl > 0) pl%capm(:) = pack(rtemp, plmask) - if (ntp > 0) tp%capm(:) = pack(rtemp, tpmask) - - end if - - call netcdf_check( nf90_get_var(nc%id, nc%Gmass_varid, rtemp, start=[1, tslot], count=[idmax,1]), "swiftest_io_netcdf_read_frame_system nf90_getvar Gmass_varid" ) - cb%Gmass = rtemp(1) - cb%mass = cb%Gmass / param%GU - - ! Set initial central body mass for Helio bookkeeping - cb%GM0 = cb%Gmass - - - if (npl > 0) then - pl%Gmass(:) = pack(rtemp, plmask) - pl%mass(:) = pl%Gmass(:) / param%GU - - if (param%lrhill_present) then - call netcdf_check( nf90_get_var(nc%id, nc%rhill_varid, rtemp, start=[1, tslot], count=[idmax,1]), "swiftest_io_netcdf_read_frame_system nf90_getvar rhill_varid" ) - pl%rhill(:) = pack(rtemp, plmask) - end if - end if - - if (param%lclose) then - call netcdf_check( nf90_get_var(nc%id, nc%radius_varid, rtemp, start=[1, tslot], count=[idmax,1]), "swiftest_io_netcdf_read_frame_system nf90_getvar radius_varid" ) - cb%radius = rtemp(1) - - ! Set initial central body radius for SyMBA bookkeeping - cb%R0 = cb%radius - if (npl > 0) pl%radius(:) = pack(rtemp, plmask) - else - cb%radius = param%rmin - if (npl > 0) pl%radius(:) = 0.0_DP - end if - - if (param%lrotation) then - call netcdf_check( nf90_get_var(nc%id, nc%Ip_varid, vectemp, start=[1, 1, tslot], count=[NDIM,idmax,1]), "swiftest_io_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 netcdf_check( nf90_get_var(nc%id, nc%rot_varid, vectemp, start=[1, 1, tslot], count=[NDIM,idmax,1]), "swiftest_io_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 bookkeeping - cb%L0(:) = cb%Ip(3) * cb%GM0 * cb%R0**2 * cb%rot(:) - end if - - ! if (param%ltides) then - ! call netcdf_check( nf90_get_var(nc%id, nc%k2_varid, rtemp, start=[1, tslot]), "swiftest_io_netcdf_read_frame_system nf90_getvar k2_varid" ) - ! cb%k2 = rtemp(1) - ! if (npl > 0) pl%k2(:) = pack(rtemp, plmask) - - ! call netcdf_check( nf90_get_var(nc%id, nc%Q_varid, rtemp, start=[1, tslot]), "swiftest_io_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(nc%id, nc%j2rp2_varname, nc%j2rp2_varid) - if (status == nf90_noerr) then - call netcdf_check( nf90_get_var(nc%id, nc%j2rp2_varid, cb%j2rp2, start=[tslot]), "swiftest_io_netcdf_read_frame_system nf90_getvar j2rp2_varid" ) - else - cb%j2rp2 = 0.0_DP - end if - - status = nf90_inq_varid(nc%id, nc%j4rp4_varname, nc%j4rp4_varid) - if (status == nf90_noerr) then - call netcdf_check( nf90_get_var(nc%id, nc%j4rp4_varid, cb%j4rp4, start=[tslot]), "swiftest_io_netcdf_read_frame_system nf90_getvar j4rp4_varid" ) - else - cb%j4rp4 = 0.0_DP - end if - - call self%read_particle_info(nc, param, plmask, tpmask) - - if (param%in_form == "EL") then - call pl%el2xv(cb) - call tp%el2xv(cb) - end if - ! if this is a GR-enabled run, check to see if we got the pseudovelocities in. Otherwise, we'll need to generate them. - if (param%lgr .and. .not.(nc%lpseudo_vel_exists)) then - call pl%set_mu(cb) - call tp%set_mu(cb) - call pl%v2pv(param) - call tp%v2pv(param) - end if - - end associate - end select - - call nc%close() - - ierr = 0 - return - - 667 continue - write(*,*) "Error reading system frame in io_netcdf_read_frame_system" - - end function swiftest_io_netcdf_read_frame_system - - - module subroutine swiftest_io_netcdf_read_hdr_system(self, nc, param) - !! author: David A. Minton - !! - !! Reads header information (variables that change with time, but not particle id). - !! This subroutine swiftest_significantly improves the output over the original binary file, allowing us to track energy, momentum, and other quantities that - !! previously were handled as separate output files. - implicit none - ! Arguments - class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nbody system object - class(base_io_netcdf_parameters), intent(inout) :: nc !! Parameters used to for reading a NetCDF dataset to file - class(base_parameters), intent(inout) :: param !! Current run configuration parameters - ! Internals - integer(I4B) :: tslot, status, idmax - real(DP), dimension(:), allocatable :: gmtemp - logical, dimension(:), allocatable :: plmask, tpmask, plmmask - - - tslot = param%ioutput - call netcdf_check( nf90_inquire_dimension(nc%id, nc%name_dimid, len=idmax), "swiftest_io_netcdf_read_hdr_system nf90_inquire_dimension name_dimid" ) - call netcdf_check( nf90_get_var(nc%id, nc%time_varid, self%t, start=[tslot]), "swiftest_io_netcdf_read_hdr_system nf90_getvar time_varid" ) - - allocate(gmtemp(idmax)) - allocate(tpmask(idmax)) - allocate(plmask(idmax)) - allocate(plmmask(idmax)) - - call netcdf_check( nf90_get_var(nc%id, nc%Gmass_varid, gmtemp, start=[1,1], count=[idmax,1]), "swiftest_io_netcdf_read_hdr_system nf90_getvar Gmass_varid" ) - - plmask(:) = gmtemp(:) == gmtemp(:) - tpmask(:) = .not. plmask(:) - plmask(1) = .false. ! This is the central body - plmmask(:) = plmask(:) - where(plmask(:)) - plmmask(:) = gmtemp(:) > param%GMTINY - endwhere - - status = nf90_inq_varid(nc%id, nc%npl_varname, nc%npl_varid) - if (status == nf90_noerr) then - call netcdf_check( nf90_get_var(nc%id, nc%npl_varid, self%pl%nbody, start=[tslot]), "swiftest_io_netcdf_read_hdr_system nf90_getvar npl_varid" ) - else - self%pl%nbody = count(plmask(:)) - end if - - status = nf90_inq_varid(nc%id, nc%ntp_varname, nc%ntp_varid) - if (status == nf90_noerr) then - call netcdf_check( nf90_get_var(nc%id, nc%ntp_varid, self%tp%nbody, start=[tslot]), "swiftest_io_netcdf_read_hdr_system nf90_getvar ntp_varid" ) - else - self%tp%nbody = count(tpmask(:)) - end if - - if (param%integrator == INT_SYMBA) then - status = nf90_inq_varid(nc%id, nc%nplm_varname, nc%nplm_varid) - if (status == nf90_noerr) then - call netcdf_check( nf90_get_var(nc%id, nc%nplm_varid, self%pl%nplm, start=[tslot]), "swiftest_io_netcdf_read_hdr_system nf90_getvar nplm_varid" ) - else - self%pl%nplm = count(plmmask(:)) - end if - end if - - if (param%lenergy) then - status = nf90_inq_varid(nc%id, nc%ke_orb_varname, nc%KE_orb_varid) - if (status == nf90_noerr) call netcdf_check( nf90_get_var(nc%id, nc%KE_orb_varid, self%ke_orbit, start=[tslot]), "swiftest_io_netcdf_read_hdr_system nf90_getvar KE_orb_varid" ) - status = nf90_inq_varid(nc%id, nc%ke_spin_varname, nc%KE_spin_varid) - if (status == nf90_noerr) call netcdf_check( nf90_get_var(nc%id, nc%KE_spin_varid, self%ke_spin, start=[tslot]), "swiftest_io_netcdf_read_hdr_system nf90_getvar KE_spin_varid" ) - status = nf90_inq_varid(nc%id, nc%pe_varname, nc%PE_varid) - if (status == nf90_noerr) call netcdf_check( nf90_get_var(nc%id, nc%PE_varid, self%pe, start=[tslot]), "swiftest_io_netcdf_read_hdr_system nf90_getvar PE_varid" ) - status = nf90_inq_varid(nc%id, nc%L_orb_varname, nc%L_orb_varid) - if (status == nf90_noerr) call netcdf_check( nf90_get_var(nc%id, nc%L_orb_varid, self%Lorbit(:), start=[1,tslot], count=[NDIM,1]), "swiftest_io_netcdf_read_hdr_system nf90_getvar L_orb_varid" ) - status = nf90_inq_varid(nc%id, nc%Lspin_varname, nc%Lspin_varid) - if (status == nf90_noerr) call netcdf_check( nf90_get_var(nc%id, nc%Lspin_varid, self%Lspin(:), start=[1,tslot], count=[NDIM,1]), "swiftest_io_netcdf_read_hdr_system nf90_getvar Lspin_varid" ) - status = nf90_inq_varid(nc%id, nc%L_escape_varname, nc%L_escape_varid) - if (status == nf90_noerr) call netcdf_check( nf90_get_var(nc%id, nc%L_escape_varid, self%Lescape(:), start=[1, tslot], count=[NDIM,1]), "swiftest_io_netcdf_read_hdr_system nf90_getvar L_escape_varid" ) - status = nf90_inq_varid(nc%id, nc%Ecollisions_varname, nc%Ecollisions_varid) - if (status == nf90_noerr) call netcdf_check( nf90_get_var(nc%id, nc%Ecollisions_varid, self%Ecollisions, start=[tslot]), "swiftest_io_netcdf_read_hdr_system nf90_getvar Ecollisions_varid" ) - status = nf90_inq_varid(nc%id, nc%Euntracked_varname, nc%Euntracked_varid) - if (status == nf90_noerr) call netcdf_check( nf90_get_var(nc%id, nc%Euntracked_varid, self%Euntracked, start=[tslot]), "swiftest_io_netcdf_read_hdr_system nf90_getvar Euntracked_varid" ) - status = nf90_inq_varid(nc%id, nc%GMescape_varname, nc%GMescape_varid) - if (status == nf90_noerr) call netcdf_check( nf90_get_var(nc%id, nc%GMescape_varid, self%GMescape, start=[tslot]), "swiftest_io_netcdf_read_hdr_system nf90_getvar GMescape_varid" ) - end if - - return - end subroutine swiftest_io_netcdf_read_hdr_system - - - module subroutine swiftest_io_netcdf_read_particle_info_system(self, nc, param, plmask, tpmask) - !! author: Carlisle A. Wishard, Dana Singh, and David A. Minton - !! - !! Reads particle information metadata from file - implicit none - ! Arguments - class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nbody system object - class(base_io_netcdf_parameters), intent(inout) :: nc !! Parameters used to identify a particular NetCDF dataset - class(base_parameters), intent(inout) :: param !! Current run configuration parameters - logical, dimension(:), intent(in) :: plmask !! Logical array indicating which index values belong to massive bodies - logical, dimension(:), intent(in) :: tpmask !! Logical array indicating which index values belong to test particles - - ! Internals - integer(I4B) :: i, idmax, status - real(DP), dimension(:), allocatable :: rtemp - real(DP), dimension(:,:), allocatable :: vectemp - integer(I4B), dimension(:), allocatable :: itemp - character(len=NAMELEN), dimension(:), allocatable :: ctemp - integer(I4B), dimension(:), allocatable :: plind, tpind - - ! This string of spaces of length NAMELEN is used to clear out any old data left behind inside the string variables - idmax = size(plmask) - allocate(rtemp(idmax)) - allocate(vectemp(NDIM,idmax)) - allocate(itemp(idmax)) - allocate(ctemp(idmax)) - - associate(cb => self%cb, pl => self%pl, tp => self%tp, npl => self%pl%nbody, ntp => self%tp%nbody) - - if (npl > 0) then - pl%status(:) = ACTIVE - pl%lmask(:) = .true. - do i = 1, npl - call pl%info(i)%set_value(status="ACTIVE") - end do - allocate(plind(npl)) - plind(:) = pack([(i, i = 1, idmax)], plmask(:)) - end if - if (ntp > 0) then - tp%status(:) = ACTIVE - tp%lmask(:) = .true. - do i = 1, ntp - call tp%info(i)%set_value(status="ACTIVE") - end do - allocate(tpind(ntp)) - tpind(:) = pack([(i, i = 1, idmax)], tpmask(:)) - end if - - call netcdf_check( nf90_get_var(nc%id, nc%id_varid, itemp), "swiftest_io_netcdf_read_particle_info_system nf90_getvar id_varid" ) - cb%id = itemp(1) - pl%id(:) = pack(itemp, plmask) - tp%id(:) = pack(itemp, tpmask) - cb%id = 0 - pl%id(:) = pack([(i,i=0,idmax-1)],plmask) - tp%id(:) = pack([(i,i=0,idmax-1)],tpmask) - - call netcdf_check( nf90_get_var(nc%id, nc%name_varid, ctemp, count=[NAMELEN, idmax]), "swiftest_io_netcdf_read_particle_info_system nf90_getvar name_varid" ) - call cb%info%set_value(name=ctemp(1)) - do i = 1, npl - call pl%info(i)%set_value(name=ctemp(plind(i))) - end do - do i = 1, ntp - call tp%info(i)%set_value(name=ctemp(tpind(i))) - end do - - status = nf90_get_var(nc%id, nc%ptype_varid, ctemp, count=[NAMELEN, idmax]) - if (status /= nf90_noerr) then ! Set default particle types - call cb%info%set_value(particle_type=CB_TYPE_NAME) - - ! Handle semi-interacting bodies in SyMBA - if (param%integrator == INT_SYMBA) then - select type (param) - class is (swiftest_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 - else ! Non-SyMBA massive bodies - do i = 1, npl - call pl%info(i)%set_value(particle_type=PL_TYPE_NAME) - end do - end if - do i = 1, ntp - call tp%info(i)%set_value(particle_type=TP_TYPE_NAME) - end do - else ! Use particle types defined in input file - call cb%info%set_value(particle_type=ctemp(1)) - do i = 1, npl - call pl%info(i)%set_value(particle_type=ctemp(plind(i))) - end do - do i = 1, ntp - call tp%info(i)%set_value(particle_type=ctemp(tpind(i))) - end do - end if - - call cb%info%set_value(status="ACTIVE") - - if (param%lclose) then - - status = nf90_inq_varid(nc%id, nc%origin_type_varname, nc%origin_type_varid) - if (status == nf90_noerr) then - call netcdf_check( nf90_get_var(nc%id, nc%origin_type_varid, ctemp, count=[NAMELEN, idmax]), "swiftest_io_netcdf_read_particle_info_system nf90_getvar origin_type_varid" ) - else - ctemp = "Initial Conditions" - end if - - call cb%info%set_value(origin_type=ctemp(1)) - do i = 1, npl - call pl%info(i)%set_value(origin_type=ctemp(plind(i))) - end do - do i = 1, ntp - call tp%info(i)%set_value(origin_type=ctemp(tpind(i))) - end do - - status = nf90_inq_varid(nc%id, nc%origin_time_varname, nc%origin_time_varid) - if (status == nf90_noerr) then - call netcdf_check( nf90_get_var(nc%id, nc%origin_time_varid, rtemp), "swiftest_io_netcdf_read_particle_info_system nf90_getvar origin_time_varid" ) - else - rtemp = param%t0 - end if - - call cb%info%set_value(origin_time=rtemp(1)) - do i = 1, npl - call pl%info(i)%set_value(origin_time=rtemp(plind(i))) - end do - do i = 1, ntp - call tp%info(i)%set_value(origin_time=rtemp(tpind(i))) - end do - - status = nf90_inq_varid(nc%id, nc%origin_rh_varname, nc%origin_rh_varid) - if (status == nf90_noerr) then - call netcdf_check( nf90_get_var(nc%id, nc%origin_rh_varid, vectemp(:,:)), "swiftest_io_netcdf_read_particle_info_system nf90_getvar origin_rh_varid" ) - else if ((param%out_form == "XV") .or. (param%out_form == "XVEL")) then - call netcdf_check( nf90_get_var(nc%id, nc%rh_varid, vectemp(:,:)), "swiftest_io_netcdf_read_particle_info_system nf90_getvar rh_varid" ) - else - vectemp(:,:) = 0._DP - end if - - do i = 1, npl - call pl%info(i)%set_value(origin_rh=vectemp(:,plind(i))) - end do - do i = 1, ntp - call tp%info(i)%set_value(origin_rh=vectemp(:,tpind(i))) - end do - - status = nf90_inq_varid(nc%id, nc%origin_vh_varname, nc%origin_vh_varid) - if (status == nf90_noerr) then - call netcdf_check( nf90_get_var(nc%id, nc%origin_vh_varid, vectemp(:,:)), "swiftest_io_netcdf_read_particle_info_system nf90_getvar origin_vh_varid" ) - else if ((param%out_form == "XV") .or. (param%out_form == "XVEL")) then - call netcdf_check( nf90_get_var(nc%id, nc%vh_varid, vectemp(:,:)), "swiftest_io_netcdf_read_particle_info_system nf90_getvar vh_varid" ) - else - vectemp(:,:) = 0._DP - end if - - do i = 1, npl - call pl%info(i)%set_value(origin_vh=vectemp(:,plind(i))) - end do - do i = 1, ntp - call tp%info(i)%set_value(origin_vh=vectemp(:,tpind(i))) - end do - - status = nf90_inq_varid(nc%id, nc%collision_id_varname, nc%collision_id_varid) - if (status == nf90_noerr) then - call netcdf_check( nf90_get_var(nc%id, nc%collision_id_varid, itemp), "swiftest_io_netcdf_read_particle_info_system nf90_getvar collision_id_varid" ) - else - itemp = 0 - end if - - do i = 1, npl - call pl%info(i)%set_value(collision_id=itemp(plind(i))) - end do - do i = 1, ntp - call tp%info(i)%set_value(collision_id=itemp(tpind(i))) - end do - - status = nf90_inq_varid(nc%id, nc%discard_time_varname, nc%discard_time_varid) - if (status == nf90_noerr) then - call netcdf_check( nf90_get_var(nc%id, nc%discard_time_varid, rtemp), "swiftest_io_netcdf_read_particle_info_system nf90_getvar discard_time_varid" ) - else - select case (param%out_type) - case("swiftest_io_netcdf_FLOAT") - rtemp(:) = huge(0.0_SP) - case("swiftest_io_netcdf_DOUBLE") - rtemp(:) = huge(0.0_DP) - end select - end if - - call cb%info%set_value(discard_time=rtemp(1)) - do i = 1, npl - call pl%info(i)%set_value(discard_time=rtemp(plind(i))) - end do - do i = 1, ntp - call tp%info(i)%set_value(discard_time=rtemp(tpind(i))) - end do - - status = nf90_inq_varid(nc%id, nc%discard_rh_varname, nc%discard_rh_varid) - if (status == nf90_noerr) then - call netcdf_check( nf90_get_var(nc%id, nc%discard_rh_varid, vectemp(:,:)), "swiftest_io_netcdf_read_particle_info_system nf90_getvar discard_rh_varid" ) - else - vectemp(:,:) = 0.0_DP - end if - - do i = 1, npl - call pl%info(i)%set_value(discard_rh=vectemp(:,plind(i))) - end do - do i = 1, ntp - call tp%info(i)%set_value(discard_rh=vectemp(:,tpind(i))) - end do - - status = nf90_inq_varid(nc%id, nc%discard_vh_varname, nc%discard_vh_varid) - if (status == nf90_noerr) then - call netcdf_check( nf90_get_var(nc%id, nc%discard_vh_varid, vectemp(:,:)), "swiftest_io_netcdf_read_particle_info_system nf90_getvar discard_vh_varid" ) - else - vectemp(:,:) = 0.0_DP - end if - - do i = 1, npl - call pl%info(i)%set_value(discard_vh=vectemp(:,plind(i))) - end do - do i = 1, ntp - call tp%info(i)%set_value(discard_vh=vectemp(:,tpind(i))) - end do - end if - - end associate - - return - end subroutine swiftest_io_netcdf_read_particle_info_system - - - module subroutine swiftest_io_netcdf_write_frame_body(self, nc, param) - !! author: Carlisle A. Wishard, Dana Singh, and David A. Minton - !! - !! Write a frame of output of either test particle or massive body data to the binary output file - !! Note: If outputting to orbital elements, but sure that the conversion is done prior to calling this method - implicit none - ! Arguments - class(swiftest_body), intent(in) :: self !! Swiftest base object - class(base_io_netcdf_parameters), intent(inout) :: nc !! Parameters used to for writing a NetCDF dataset to file - class(base_parameters), intent(inout) :: param !! Current run configuration parameters - ! Internals - integer(I4B) :: i, j, tslot, idslot, old_mode - integer(I4B), dimension(:), allocatable :: ind - real(DP), dimension(NDIM) :: vh !! Temporary variable to store heliocentric velocity values when converting from pseudovelocity in GR-enabled runs - real(DP) :: a, e, inc, omega, capom, capm, varpi, lam, f, cape, capf - - tslot = param%ioutput - - call self%write_info(nc, param) - - call netcdf_check( nf90_set_fill(nc%id, nf90_nofill, old_mode), "swiftest_io_netcdf_write_frame_body nf90_set_fill" ) - select type(self) - class is (swiftest_body) - select type (param) - class is (swiftest_parameters) - associate(n => self%nbody) - if (n == 0) return - - call swiftest_util_sort(self%id(1:n), ind) - - do i = 1, n - j = ind(i) - idslot = self%id(j) + 1 - - !! Convert from pseudovelocity to heliocentric without replacing the current value of pseudovelocity - if (param%lgr) call swiftest_gr_pseudovel2vel(param, self%mu(j), self%rh(:, j), self%vh(:, j), vh(:)) - - if ((param%out_form == "XV") .or. (param%out_form == "XVEL")) then - call netcdf_check( nf90_put_var(nc%id, nc%rh_varid, self%rh(:, j), start=[1,idslot, tslot], count=[NDIM,1,1]), "swiftest_io_netcdf_write_frame_body nf90_put_var rh_varid" ) - if (param%lgr) then !! Convert from pseudovelocity to heliocentric without replacing the current value of pseudovelocity - call netcdf_check( nf90_put_var(nc%id, nc%vh_varid, vh(:), start=[1,idslot, tslot], count=[NDIM,1,1]), "swiftest_io_netcdf_write_frame_body nf90_put_var vh_varid" ) - call netcdf_check( nf90_put_var(nc%id, nc%gr_pseudo_vh_varid, self%vh(:, j), start=[1,idslot, tslot],count=[NDIM,1,1]), "swiftest_io_netcdf_write_frame_body nf90_put_var gr_pseudo_vhx_varid" ) - - else - call netcdf_check( nf90_put_var(nc%id, nc%vh_varid, self%vh(:, j), start=[1,idslot, tslot], count=[NDIM,1,1]), "swiftest_io_netcdf_write_frame_body nf90_put_var vh_varid" ) - end if - end if - - if ((param%out_form == "EL") .or. (param%out_form == "XVEL")) then - if (param%lgr) then !! For GR-enabled runs, use the true value of velocity computed above - call swiftest_orbel_xv2el(self%mu(j), self%rh(1,j), self%rh(2,j), self%rh(3,j), & - vh(1), vh(2), vh(3), & - a, e, inc, capom, omega, capm, varpi, lam, f, cape, capf) - else !! For non-GR runs just convert from the velocity we have - call swiftest_orbel_xv2el(self%mu(j), self%rh(1,j), self%rh(2,j), self%rh(3,j), & - self%vh(1,j), self%vh(2,j), self%vh(3,j), & - a, e, inc, capom, omega, capm, varpi, lam, f, cape, capf) - end if - call netcdf_check( nf90_put_var(nc%id, nc%a_varid, a, start=[idslot, tslot]), "swiftest_io_netcdf_write_frame_body nf90_put_var body a_varid" ) - call netcdf_check( nf90_put_var(nc%id, nc%e_varid, e, start=[idslot, tslot]), "swiftest_io_netcdf_write_frame_body nf90_put_var body e_varid" ) - call netcdf_check( nf90_put_var(nc%id, nc%inc_varid, inc * RAD2DEG, start=[idslot, tslot]), "swiftest_io_netcdf_write_frame_body nf90_put_var body inc_varid" ) - call netcdf_check( nf90_put_var(nc%id, nc%capom_varid, capom * RAD2DEG, start=[idslot, tslot]), "swiftest_io_netcdf_write_frame_body nf90_put_var body capom_varid" ) - call netcdf_check( nf90_put_var(nc%id, nc%omega_varid, omega * RAD2DEG, start=[idslot, tslot]), "swiftest_io_netcdf_write_frame_body nf90_put_var body omega_varid" ) - call netcdf_check( nf90_put_var(nc%id, nc%capm_varid, capm * RAD2DEG, start=[idslot, tslot]), "swiftest_io_netcdf_write_frame_body nf90_put_var body capm_varid" ) - call netcdf_check( nf90_put_var(nc%id, nc%varpi_varid, varpi * RAD2DEG, start=[idslot, tslot]), "swiftest_io_netcdf_write_frame_body nf90_put_var body varpi_varid" ) - call netcdf_check( nf90_put_var(nc%id, nc%lam_varid, lam * RAD2DEG, start=[idslot, tslot]), "swiftest_io_netcdf_write_frame_body nf90_put_var body lam_varid" ) - call netcdf_check( nf90_put_var(nc%id, nc%f_varid, f * RAD2DEG, start=[idslot, tslot]), "swiftest_io_netcdf_write_frame_body nf90_put_var body f_varid" ) - if (e < 1.0_DP) then - call netcdf_check( nf90_put_var(nc%id, nc%cape_varid, cape * RAD2DEG, start=[idslot, tslot]), "swiftest_io_netcdf_write_frame_body nf90_put_var body cape_varid" ) - else if (e > 1.0_DP) then - call netcdf_check( nf90_put_var(nc%id, nc%cape_varid, capf * RAD2DEG, start=[idslot, tslot]), "swiftest_io_netcdf_write_frame_body nf90_put_var body (capf) cape_varid" ) - end if - end if - - select type(self) - class is (swiftest_pl) ! Additional output if the passed polymorphic object is a massive body - call netcdf_check( nf90_put_var(nc%id, nc%Gmass_varid, self%Gmass(j), start=[idslot, tslot]), "swiftest_io_netcdf_write_frame_body nf90_put_var body Gmass_varid" ) - if (param%lrhill_present) then - call netcdf_check( nf90_put_var(nc%id, nc%rhill_varid, self%rhill(j), start=[idslot, tslot]), "swiftest_io_netcdf_write_frame_body nf90_put_var body rhill_varid" ) - end if - if (param%lclose) call netcdf_check( nf90_put_var(nc%id, nc%radius_varid, self%radius(j), start=[idslot, tslot]), "swiftest_io_netcdf_write_frame_body nf90_put_var body radius_varid" ) - if (param%lrotation) then - call netcdf_check( nf90_put_var(nc%id, nc%Ip_varid, self%Ip(:, j), start=[1,idslot, tslot], count=[NDIM,1,1]), "swiftest_io_netcdf_write_frame_body nf90_put_var body Ip_varid" ) - call netcdf_check( nf90_put_var(nc%id, nc%rot_varid, self%rot(:, j), start=[1,idslot, tslot], count=[NDIM,1,1]), "swiftest_io_netcdf_write_frame_body nf90_put_var body rotx_varid" ) - end if - ! if (param%ltides) then - ! call netcdf_check( nf90_put_var(nc%id, nc%k2_varid, self%k2(j), start=[idslot, tslot]), "swiftest_io_netcdf_write_frame_body nf90_put_var body k2_varid" ) - ! call netcdf_check( nf90_put_var(nc%id, nc%Q_varid, self%Q(j), start=[idslot, tslot]), "swiftest_io_netcdf_write_frame_body nf90_put_var body Q_varid" ) - ! end if - - end select - end do - end associate - end select - end select - call netcdf_check( nf90_set_fill(nc%id, old_mode, old_mode), "swiftest_io_netcdf_write_frame_body nf90_set_fill old_mode" ) - - return - end subroutine swiftest_io_netcdf_write_frame_body - - - module subroutine swiftest_io_netcdf_write_frame_cb(self, nc, param) - !! author: Carlisle A. Wishard, Dana Singh, and David A. Minton - !! - !! Write a frame of output of the central body - implicit none - ! Arguments - class(swiftest_cb), intent(in) :: self !! Swiftest base object - class(base_io_netcdf_parameters), intent(inout) :: nc !! Parameters used to for writing a NetCDF dataset to file - class(base_parameters), intent(inout) :: param !! Current run configuration parameters - ! Internals - integer(I4B) :: i, j, tslot, idslot, old_mode - - tslot = param%ioutput - - call self%write_info(nc, param) - - call netcdf_check( nf90_set_fill(nc%id, nf90_nofill, old_mode), "swiftest_io_netcdf_write_frame_cb nf90_set_fill" ) - - idslot = self%id + 1 - call netcdf_check( nf90_put_var(nc%id, nc%id_varid, self%id, start=[idslot]), "swiftest_io_netcdf_write_frame_cb nf90_put_var cb id_varid" ) - - call netcdf_check( nf90_put_var(nc%id, nc%Gmass_varid, self%Gmass, start=[idslot, tslot]), "swiftest_io_netcdf_write_frame_cb nf90_put_var cb Gmass_varid" ) - if (param%lclose) call netcdf_check( nf90_put_var(nc%id, nc%radius_varid, self%radius, start=[idslot, tslot]), "swiftest_io_netcdf_write_frame_cb nf90_put_var cb radius_varid" ) - call netcdf_check( nf90_put_var(nc%id, nc%j2rp2_varid, self%j2rp2, start=[tslot]), "swiftest_io_netcdf_write_frame_cb nf90_put_var cb j2rp2_varid" ) - call netcdf_check( nf90_put_var(nc%id, nc%j4rp4_varid, self%j4rp4, start=[tslot]), "swiftest_io_netcdf_write_frame_cb nf90_put_var cb j4rp4_varid" ) - if (param%lrotation) then - call netcdf_check( nf90_put_var(nc%id, nc%Ip_varid, self%Ip(:), start=[1, idslot, tslot], count=[NDIM,1,1]), "swiftest_io_netcdf_write_frame_cb nf90_put_var cb Ip_varid" ) - call netcdf_check( nf90_put_var(nc%id, nc%rot_varid, self%rot(:), start=[1, idslot, tslot], count=[NDIM,1,1]), "swiftest_io_netcdf_write_frame_cby nf90_put_var cb rot_varid" ) - end if - - call netcdf_check( nf90_set_fill(nc%id, old_mode, old_mode), "swiftest_io_netcdf_write_frame_cb nf90_set_fill old_mode" ) - - return - end subroutine swiftest_io_netcdf_write_frame_cb - - - module subroutine swiftest_io_netcdf_write_frame_system(self, nc, param) - !! author: The Purdue Swiftest Team - David A. Minton, Carlisle A. Wishard, Jennifer L.L. Pouplin, and Jacob R. Elliott - !! - !! Write a frame (header plus records for each massive body and active test particle) to a output binary file - implicit none - ! Arguments - class(swiftest_nbody_system), intent(inout) :: self !! Swiftest system object - class(base_io_netcdf_parameters), intent(inout) :: nc !! Parameters used to for writing a NetCDF dataset to file - class(base_parameters), intent(inout) :: param !! Current run configuration parameters - - call self%write_hdr(nc, param) - call self%cb%write_frame(nc, param) - call self%pl%write_frame(nc, param) - call self%tp%write_frame(nc, param) - - return - end subroutine swiftest_io_netcdf_write_frame_system - - - module subroutine swiftest_io_netcdf_write_hdr_system(self, nc, param) - !! author: David A. Minton - !! - !! Writes header information (variables that change with time, but not particle id). - !! This subroutine swiftest_significantly improves the output over the original binary file, allowing us to track energy, momentum, and other quantities that - !! previously were handled as separate output files. - implicit none - ! Arguments - class(swiftest_nbody_system), intent(in) :: self !! Swiftest nbody system object - class(base_io_netcdf_parameters), intent(inout) :: nc !! Parameters used to for writing a NetCDF dataset to file - class(base_parameters), intent(inout) :: param !! Current run configuration parameters - ! Internals - integer(I4B) :: tslot - - tslot = param%ioutput - - call netcdf_check( nf90_put_var(nc%id, nc%time_varid, self%t, start=[tslot]), "swiftest_io_netcdf_write_hdr_system nf90_put_var time_varid" ) - call netcdf_check( nf90_put_var(nc%id, nc%npl_varid, self%pl%nbody, start=[tslot]), "swiftest_io_netcdf_write_hdr_system nf90_put_var npl_varid" ) - call netcdf_check( nf90_put_var(nc%id, nc%ntp_varid, self%tp%nbody, start=[tslot]), "swiftest_io_netcdf_write_hdr_system nf90_put_var ntp_varid" ) - if (param%integrator == INT_SYMBA) call netcdf_check( nf90_put_var(nc%id, nc%nplm_varid, self%pl%nplm, start=[tslot]), "swiftest_io_netcdf_write_hdr_system nf90_put_var nplm_varid" ) - - if (param%lenergy) then - call netcdf_check( nf90_put_var(nc%id, nc%KE_orb_varid, self%ke_orbit, start=[tslot]), "swiftest_io_netcdf_write_hdr_system nf90_put_var KE_orb_varid" ) - call netcdf_check( nf90_put_var(nc%id, nc%KE_spin_varid, self%ke_spin, start=[tslot]), "swiftest_io_netcdf_write_hdr_system nf90_put_var KE_spin_varid" ) - call netcdf_check( nf90_put_var(nc%id, nc%PE_varid, self%pe, start=[tslot]), "swiftest_io_netcdf_write_hdr_system nf90_put_var PE_varid" ) - call netcdf_check( nf90_put_var(nc%id, nc%L_orb_varid, self%Lorbit(:), start=[1,tslot], count=[NDIM,1]), "swiftest_io_netcdf_write_hdr_system nf90_put_var L_orb_varid" ) - call netcdf_check( nf90_put_var(nc%id, nc%Lspin_varid, self%Lspin(:), start=[1,tslot], count=[NDIM,1]), "swiftest_io_netcdf_write_hdr_system nf90_put_var Lspin_varid" ) - call netcdf_check( nf90_put_var(nc%id, nc%L_escape_varid, self%Lescape(:), start=[1,tslot], count=[NDIM,1]), "swiftest_io_netcdf_write_hdr_system nf90_put_var L_escape_varid" ) - call netcdf_check( nf90_put_var(nc%id, nc%Ecollisions_varid, self%Ecollisions, start=[tslot]), "swiftest_io_netcdf_write_hdr_system nf90_put_var Ecollisions_varid" ) - call netcdf_check( nf90_put_var(nc%id, nc%Euntracked_varid, self%Euntracked, start=[tslot]), "swiftest_io_netcdf_write_hdr_system nf90_put_var Euntracked_varid" ) - call netcdf_check( nf90_put_var(nc%id, nc%GMescape_varid, self%GMescape, start=[tslot]), "swiftest_io_netcdf_write_hdr_system nf90_put_var GMescape_varid" ) - end if - - return - end subroutine swiftest_io_netcdf_write_hdr_system - - - module subroutine swiftest_io_netcdf_write_info_body(self, nc, param) - !! author: Carlisle A. Wishard, Dana Singh, and David A. Minton - !! - !! Write all current particle to file - implicit none - ! Arguments - class(swiftest_body), intent(in) :: self !! Swiftest particle object - class(base_io_netcdf_parameters), intent(inout) :: nc !! Parameters used to identify a particular NetCDF dataset - class(base_parameters), intent(inout) :: param !! Current run configuration parameters - ! Internals - integer(I4B) :: i, j, idslot, old_mode - integer(I4B), dimension(:), allocatable :: ind - character(len=:), allocatable :: charstring - - ! This string of spaces of length NAMELEN is used to clear out any old data left behind inside the string variables - call netcdf_check( nf90_set_fill(nc%id, nf90_nofill, old_mode), "swiftest_io_netcdf_write_info_body nf90_set_fill nf90_nofill" ) - - select type(self) - class is (swiftest_body) - associate(n => self%nbody) - if (n == 0) return - call swiftest_util_sort(self%id(1:n), ind) - - do i = 1, n - j = ind(i) - idslot = self%id(j) + 1 - call netcdf_check( nf90_put_var(nc%id, nc%id_varid, self%id(j), start=[idslot]), "swiftest_io_netcdf_write_info_body nf90_put_var id_varid" ) - - charstring = trim(adjustl(self%info(j)%name)) - call netcdf_check( nf90_put_var(nc%id, nc%name_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "swiftest_io_netcdf_write_info_body nf90_put_var name_varid" ) - - charstring = trim(adjustl(self%info(j)%particle_type)) - call netcdf_check( nf90_put_var(nc%id, nc%ptype_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "swiftest_io_netcdf_write_info_body nf90_put_var particle_type_varid" ) - - if (param%lclose) then - charstring = trim(adjustl(self%info(j)%origin_type)) - call netcdf_check( nf90_put_var(nc%id, nc%origin_type_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "swiftest_io_netcdf_write_info_body nf90_put_var origin_type_varid" ) - call netcdf_check( nf90_put_var(nc%id, nc%origin_time_varid, self%info(j)%origin_time, start=[idslot]), "swiftest_io_netcdf_write_info_body nf90_put_var origin_time_varid" ) - call netcdf_check( nf90_put_var(nc%id, nc%origin_rh_varid, self%info(j)%origin_rh(:), start=[1,idslot], count=[NDIM,1]), "swiftest_io_netcdf_write_info_body nf90_put_var origin_rh_varid" ) - call netcdf_check( nf90_put_var(nc%id, nc%origin_vh_varid, self%info(j)%origin_vh(:), start=[1,idslot], count=[NDIM,1]), "swiftest_io_netcdf_write_info_body nf90_put_var origin_vh_varid" ) - - call netcdf_check( nf90_put_var(nc%id, nc%collision_id_varid, self%info(j)%collision_id, start=[idslot]), "swiftest_io_netcdf_write_info_body nf90_put_var collision_id_varid" ) - call netcdf_check( nf90_put_var(nc%id, nc%discard_time_varid, self%info(j)%discard_time, start=[idslot]), "swiftest_io_netcdf_write_info_body nf90_put_var discard_time_varid" ) - call netcdf_check( nf90_put_var(nc%id, nc%discard_rh_varid, self%info(j)%discard_rh(:), start=[1,idslot], count=[NDIM,1]), "swiftest_io_netcdf_write_info_body nf90_put_var discard_rh_varid" ) - call netcdf_check( nf90_put_var(nc%id, nc%discard_vh_varid, self%info(j)%discard_vh(:), start=[1,idslot], count=[NDIM,1]), "swiftest_io_netcdf_write_info_body nf90_put_var discard_vh_varid" ) - end if - - end do - end associate - end select - - call netcdf_check( nf90_set_fill(nc%id, old_mode, old_mode) ) - return - end subroutine swiftest_io_netcdf_write_info_body - - - module subroutine swiftest_io_netcdf_write_info_cb(self, nc, param) - !! author: Carlisle A. Wishard, Dana Singh, and David A. Minton - !! - !! Write the central body info to file - implicit none - class(swiftest_cb), intent(in) :: self !! Swiftest particle object - class(base_io_netcdf_parameters), intent(inout) :: nc !! Parameters used to identify a particular NetCDF dataset - class(base_parameters), intent(inout) :: param !! Current run configuration parameters - ! Internals - integer(I4B) :: idslot, old_mode - character(len=:), allocatable :: charstring - - ! This string of spaces of length NAMELEN is used to clear out any old data left behind inside the string variables - call netcdf_check( nf90_set_fill(nc%id, nf90_nofill, old_mode), "swiftest_io_netcdf_write_info_body nf90_set_fill nf90_nofill" ) - - idslot = self%id + 1 - call netcdf_check( nf90_put_var(nc%id, nc%id_varid, self%id, start=[idslot]), "swiftest_io_netcdf_write_info_body nf90_put_var cb id_varid" ) - - charstring = trim(adjustl(self%info%name)) - call netcdf_check( nf90_put_var(nc%id, nc%name_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "swiftest_io_netcdf_write_info_body nf90_put_var cb name_varid" ) - - charstring = trim(adjustl(self%info%particle_type)) - call netcdf_check( nf90_put_var(nc%id, nc%ptype_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "swiftest_io_netcdf_write_info_body nf90_put_var cb ptype_varid" ) - - if (param%lclose) then - charstring = trim(adjustl(self%info%origin_type)) - call netcdf_check( nf90_put_var(nc%id, nc%origin_type_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "swiftest_io_netcdf_write_info_body nf90_put_var cb origin_type_varid" ) - - call netcdf_check( nf90_put_var(nc%id, nc%origin_time_varid, self%info%origin_time, start=[idslot]), "swiftest_io_netcdf_write_info_body nf90_put_var cb origin_time_varid" ) - call netcdf_check( nf90_put_var(nc%id, nc%origin_rh_varid, self%info%origin_rh(:), start=[1, idslot], count=[NDIM,1]), "swiftest_io_netcdf_write_info_body nf90_put_var cb origin_rh_varid" ) - call netcdf_check( nf90_put_var(nc%id, nc%origin_vh_varid, self%info%origin_vh(:), start=[1, idslot], count=[NDIM,1]), "swiftest_io_netcdf_write_info_body nf90_put_var cb origin_vh_varid" ) - - call netcdf_check( nf90_put_var(nc%id, nc%collision_id_varid, self%info%collision_id, start=[idslot]), "swiftest_io_netcdf_write_info_body nf90_put_var cb collision_id_varid" ) - call netcdf_check( nf90_put_var(nc%id, nc%discard_time_varid, self%info%discard_time, start=[idslot]), "swiftest_io_netcdf_write_info_body nf90_put_var cb discard_time_varid" ) - call netcdf_check( nf90_put_var(nc%id, nc%discard_rh_varid, self%info%discard_rh(:), start=[1, idslot], count=[NDIM,1]), "swiftest_io_netcdf_write_info_body nf90_put_var cb discard_rh_varid" ) - call netcdf_check( nf90_put_var(nc%id, nc%discard_vh_varid, self%info%discard_vh(:), start=[1, idslot], count=[NDIM,1]), "swiftest_io_netcdf_write_info_body nf90_put_var cb discard_vh_varid" ) - end if - call netcdf_check( nf90_set_fill(nc%id, old_mode, old_mode) ) - - return - end subroutine swiftest_io_netcdf_write_info_cb - -end submodule s_io_netcdf diff --git a/src/swiftest/swiftest_kick.f90 b/src/swiftest/swiftest_kick.f90 index 584750098..9e9576321 100644 --- a/src/swiftest/swiftest_kick.f90 +++ b/src/swiftest/swiftest_kick.f90 @@ -32,7 +32,7 @@ module subroutine swiftest_kick_getacch_int_pl(self, param) ! call itimer%time_this_loop(param, self%nplpl, self) ! lfirst = .false. ! else - ! if (itimer%io_netcdf_check(param, self%nplpl)) call itimer%time_this_loop(param, self%nplpl, self) + ! if (itimer%netcdf_io_check(param, self%nplpl)) call itimer%time_this_loop(param, self%nplpl, self) ! end if ! else ! param%lflatten_interactions = .false. diff --git a/src/swiftest/swiftest_module.f90 b/src/swiftest/swiftest_module.f90 index a7bae5336..a46f66ce2 100644 --- a/src/swiftest/swiftest_module.f90 +++ b/src/swiftest/swiftest_module.f90 @@ -42,19 +42,22 @@ module swiftest use fraggle use walltime use io_progress_bar + use netcdf_io !use advisor_annotate !$ use omp_lib implicit none public - type, extends(base_io_netcdf_parameters) :: swiftest_io_netcdf_parameters + type, extends(netcdf_parameters) :: swiftest_netcdf_parameters contains procedure :: initialize => swiftest_io_netcdf_initialize_output !! Initialize a set of parameters used to identify a NetCDF output object - procedure :: open => swiftest_io_netcdf_open !! Opens a NetCDF file and does the variable inquiries to activate variable ids - end type swiftest_io_netcdf_parameters + procedure :: open => swiftest_io_netcdf_open !! Opens a NetCDF file and does the variable inquiries to activate variable ids + procedure :: flush => swiftest_io_netcdf_flush !! Flushes a NetCDF file by closing it then opening it again + end type swiftest_netcdf_parameters type, extends(base_storage) :: swiftest_storage + class(swiftest_netcdf_parameters), allocatable :: nc !! NetCDF object attached to this storage object contains procedure :: dump => swiftest_io_dump_storage !! Dumps storage object contents to file procedure :: get_index_values => swiftest_util_get_vals_storage !! Gets the unique values of the indices of a storage object (i.e. body id or time value) @@ -614,6 +617,104 @@ module subroutine swiftest_io_log_start(param, file, header) character(len=*), intent(in) :: header !! Header to print at top of log file end subroutine swiftest_io_log_start + module subroutine swiftest_io_netcdf_flush(self, param) + implicit none + class(swiftest_netcdf_parameters), intent(inout) :: self !! Parameters used to identify a particular NetCDF dataset + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + end subroutine swiftest_io_netcdf_flush + + module function swiftest_io_netcdf_get_old_t_final_system(self, param) result(old_t_final) + implicit none + class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nbody system object + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + real(DP) :: old_t_final !! Final time from last run + end function swiftest_io_netcdf_get_old_t_final_system + + module subroutine swiftest_io_netcdf_initialize_output(self, param) + implicit none + class(swiftest_netcdf_parameters), intent(inout) :: self !! Parameters used to for writing a NetCDF dataset to file + class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters + end subroutine swiftest_io_netcdf_initialize_output + + module subroutine swiftest_io_netcdf_open(self, param, readonly) + implicit none + class(swiftest_netcdf_parameters), intent(inout) :: self !! Parameters used to identify a particular NetCDF dataset + class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters + logical, optional, intent(in) :: readonly !! Logical flag indicating that this should be open read only + end subroutine swiftest_io_netcdf_open + + module function swiftest_io_netcdf_read_frame_system(self, nc, param) result(ierr) + implicit none + class(swiftest_nbody_system), intent(inout) :: self !! Swiftest system object + class(swiftest_netcdf_parameters), intent(inout) :: nc !! Parameters used to for reading a NetCDF dataset to file + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + integer(I4B) :: ierr !! Error code: returns 0 if the read is successful + end function swiftest_io_netcdf_read_frame_system + + module subroutine swiftest_io_netcdf_read_hdr_system(self, nc, param) + implicit none + class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nbody system object + class(swiftest_netcdf_parameters), intent(inout) :: nc !! Parameters used to for reading a NetCDF dataset to file + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + end subroutine swiftest_io_netcdf_read_hdr_system + + module subroutine swiftest_io_netcdf_read_particle_info_system(self, nc, param, plmask, tpmask) + implicit none + class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nbody system object + class(swiftest_netcdf_parameters), intent(inout) :: nc !! Parameters used to identify a particular NetCDF dataset + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + logical, dimension(:), intent(in) :: plmask !! Logical array indicating which index values belong to massive bodies + logical, dimension(:), intent(in) :: tpmask !! Logical array indicating which index values belong to test particles + end subroutine swiftest_io_netcdf_read_particle_info_system + + module subroutine swiftest_io_netcdf_write_frame_body(self, nc, param) + implicit none + class(swiftest_body), intent(in) :: self !! Swiftest base object + class(swiftest_netcdf_parameters), intent(inout) :: nc !! Parameters used to for writing a NetCDF dataset to file + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + end subroutine swiftest_io_netcdf_write_frame_body + + module subroutine swiftest_io_netcdf_write_frame_cb(self, nc, param) + implicit none + class(swiftest_cb), intent(in) :: self !! Swiftest base object + class(swiftest_netcdf_parameters), intent(inout) :: nc !! Parameters used to for writing a NetCDF dataset to file + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + end subroutine swiftest_io_netcdf_write_frame_cb + + module subroutine swiftest_io_netcdf_write_frame_system(self, nc, param) + implicit none + class(swiftest_nbody_system), intent(inout) :: self !! Swiftest system object + class(swiftest_netcdf_parameters), intent(inout) :: nc !! Parameters used to for writing a NetCDF dataset to file + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + end subroutine swiftest_io_netcdf_write_frame_system + + module subroutine swiftest_io_netcdf_write_hdr_system(self, nc, param) + implicit none + class(swiftest_nbody_system), intent(in) :: self !! Swiftest nbody system object + class(swiftest_netcdf_parameters), intent(inout) :: nc !! Parameters used to for writing a NetCDF dataset to file + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + end subroutine swiftest_io_netcdf_write_hdr_system + + module subroutine swiftest_io_netcdf_write_info_body(self, nc, param) + implicit none + class(swiftest_body), intent(in) :: self !! Swiftest particle object + class(swiftest_netcdf_parameters), intent(inout) :: nc !! Parameters used to identify a particular NetCDF dataset + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + end subroutine swiftest_io_netcdf_write_info_body + + module subroutine swiftest_io_netcdf_write_info_cb(self, nc, param) + implicit none + class(swiftest_cb), intent(in) :: self !! Swiftest particle object + class(swiftest_netcdf_parameters), intent(inout) :: nc !! Parameters used to identify a particular NetCDF dataset + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + end subroutine swiftest_io_netcdf_write_info_cb + + module subroutine swiftest_io_write_discard(self, param) + implicit none + class(swiftest_nbody_system), intent(inout) :: self !! SyMBA nbody system object + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + end subroutine swiftest_io_write_discard + module subroutine swiftest_io_param_reader(self, unit, iotype, v_list, iostat, iomsg) implicit none class(swiftest_parameters), intent(inout) :: self !! Collection of parameters @@ -821,98 +922,6 @@ pure module subroutine swiftest_kick_getacch_int_one_tp(rji2, xr, yr, zr, Gmpl, real(DP), intent(inout) :: ax, ay, az !! Acceleration vector components of test particle end subroutine swiftest_kick_getacch_int_one_tp - module function swiftest_io_netcdf_get_old_t_final_system(self, param) result(old_t_final) - implicit none - class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nbody system object - class(base_parameters), intent(inout) :: param !! Current run configuration parameters - real(DP) :: old_t_final !! Final time from last run - end function swiftest_io_netcdf_get_old_t_final_system - - module subroutine swiftest_io_netcdf_initialize_output(self, param) - implicit none - class(swiftest_io_netcdf_parameters), intent(inout) :: self !! Parameters used to for writing a NetCDF dataset to file - class(base_parameters), intent(in) :: param !! Current run configuration parameters - end subroutine swiftest_io_netcdf_initialize_output - - module subroutine swiftest_io_netcdf_open(self, param, readonly) - implicit none - class(swiftest_io_netcdf_parameters), intent(inout) :: self !! Parameters used to identify a particular NetCDF dataset - class(base_parameters), intent(in) :: param !! Current run configuration parameters - logical, optional, intent(in) :: readonly !! Logical flag indicating that this should be open read only - end subroutine swiftest_io_netcdf_open - - module function swiftest_io_netcdf_read_frame_system(self, nc, param) result(ierr) - implicit none - class(swiftest_nbody_system), intent(inout) :: self !! Swiftest system object - class(base_io_netcdf_parameters), intent(inout) :: nc !! Parameters used to for reading a NetCDF dataset to file - class(base_parameters), intent(inout) :: param !! Current run configuration parameters - integer(I4B) :: ierr !! Error code: returns 0 if the read is successful - end function swiftest_io_netcdf_read_frame_system - - module subroutine swiftest_io_netcdf_read_hdr_system(self, nc, param) - implicit none - class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nbody system object - class(base_io_netcdf_parameters), intent(inout) :: nc !! Parameters used to for reading a NetCDF dataset to file - class(base_parameters), intent(inout) :: param !! Current run configuration parameters - end subroutine swiftest_io_netcdf_read_hdr_system - - module subroutine swiftest_io_netcdf_read_particle_info_system(self, nc, param, plmask, tpmask) - implicit none - class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nbody system object - class(base_io_netcdf_parameters), intent(inout) :: nc !! Parameters used to identify a particular NetCDF dataset - class(base_parameters), intent(inout) :: param !! Current run configuration parameters - logical, dimension(:), intent(in) :: plmask !! Logical array indicating which index values belong to massive bodies - logical, dimension(:), intent(in) :: tpmask !! Logical array indicating which index values belong to test particles - end subroutine swiftest_io_netcdf_read_particle_info_system - - module subroutine swiftest_io_netcdf_write_frame_body(self, nc, param) - implicit none - class(swiftest_body), intent(in) :: self !! Swiftest base object - class(base_io_netcdf_parameters), intent(inout) :: nc !! Parameters used to for writing a NetCDF dataset to file - class(base_parameters), intent(inout) :: param !! Current run configuration parameters - end subroutine swiftest_io_netcdf_write_frame_body - - module subroutine swiftest_io_netcdf_write_frame_cb(self, nc, param) - implicit none - class(swiftest_cb), intent(in) :: self !! Swiftest base object - class(base_io_netcdf_parameters), intent(inout) :: nc !! Parameters used to for writing a NetCDF dataset to file - class(base_parameters), intent(inout) :: param !! Current run configuration parameters - end subroutine swiftest_io_netcdf_write_frame_cb - - module subroutine swiftest_io_netcdf_write_frame_system(self, nc, param) - implicit none - class(swiftest_nbody_system), intent(inout) :: self !! Swiftest system object - class(base_io_netcdf_parameters), intent(inout) :: nc !! Parameters used to for writing a NetCDF dataset to file - class(base_parameters), intent(inout) :: param !! Current run configuration parameters - end subroutine swiftest_io_netcdf_write_frame_system - - module subroutine swiftest_io_netcdf_write_hdr_system(self, nc, param) - implicit none - class(swiftest_nbody_system), intent(in) :: self !! Swiftest nbody system object - class(base_io_netcdf_parameters), intent(inout) :: nc !! Parameters used to for writing a NetCDF dataset to file - class(base_parameters), intent(inout) :: param !! Current run configuration parameters - end subroutine swiftest_io_netcdf_write_hdr_system - - module subroutine swiftest_io_netcdf_write_info_body(self, nc, param) - implicit none - class(swiftest_body), intent(in) :: self !! Swiftest particle object - class(base_io_netcdf_parameters), intent(inout) :: nc !! Parameters used to identify a particular NetCDF dataset - class(base_parameters), intent(inout) :: param !! Current run configuration parameters - end subroutine swiftest_io_netcdf_write_info_body - - module subroutine swiftest_io_netcdf_write_info_cb(self, nc, param) - implicit none - class(swiftest_cb), intent(in) :: self !! Swiftest particle object - class(base_io_netcdf_parameters), intent(inout) :: nc !! Parameters used to identify a particular NetCDF dataset - class(base_parameters), intent(inout) :: param !! Current run configuration parameters - end subroutine swiftest_io_netcdf_write_info_cb - - module subroutine swiftest_io_write_discard(self, param) - implicit none - class(swiftest_nbody_system), intent(inout) :: self !! SyMBA nbody system object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - end subroutine swiftest_io_write_discard - module subroutine swiftest_obl_acc_body(self, system) implicit none class(swiftest_body), intent(inout) :: self !! Swiftest body object @@ -1892,4 +1901,5 @@ subroutine make_impactors_pl(self, idx) return end subroutine make_impactors_pl + end module swiftest diff --git a/src/swiftest/swiftest_setup.f90 b/src/swiftest/swiftest_setup.f90 index 5429681c6..f3c604ff8 100644 --- a/src/swiftest/swiftest_setup.f90 +++ b/src/swiftest/swiftest_setup.f90 @@ -30,7 +30,7 @@ module subroutine swiftest_setup_construct_system(system, param) select type(param) class is (swiftest_parameters) allocate(swiftest_storage(param%dump_cadence) :: param%system_history) - allocate(swiftest_io_netcdf_parameters :: param%system_history%nc) + allocate(swiftest_netcdf_parameters :: param%system_history%nc) call param%system_history%reset() select case(param%integrator) @@ -89,25 +89,23 @@ module subroutine swiftest_setup_construct_system(system, param) end if if (param%lenc_save_trajectory .or. param%lenc_save_closest) then - allocate(encounter_io_parameters :: encounter_history%nc) + allocate(encounter_netcdf_parameters :: encounter_history%nc) call encounter_history%reset() select type(nc => encounter_history%nc) - class is (encounter_io_parameters) + class is (encounter_netcdf_parameters) nc%file_number = param%iloop / param%dump_cadence end select allocate(system%encounter_history, source=encounter_history) end if - allocate(collision_io_parameters :: collision_history%nc) + allocate(collision_netcdf_parameters :: collision_history%nc) call collision_history%reset() select type(nc => collision_history%nc) - class is (collision_io_parameters) + class is (collision_netcdf_parameters) nc%file_number = param%iloop / param%dump_cadence end select allocate(system%collision_history, source=collision_history) - - end select case (INT_RINGMOONS) write(*,*) 'RINGMOONS-SyMBA integrator not yet enabled' @@ -304,13 +302,11 @@ module subroutine swiftest_setup_pl(self, n, param) self%nplpl = 0 if (param%lclose) then - allocate(self%lmtiny(n)) allocate(self%nplenc(n)) allocate(self%ntpenc(n)) allocate(self%radius(n)) allocate(self%density(n)) - self%lmtiny(:) = .false. self%nplenc(:) = 0 self%ntpenc(:) = 0 self%radius(:) = 0.0_DP @@ -318,6 +314,11 @@ module subroutine swiftest_setup_pl(self, n, param) end if + if (param%lmtiny_pl) then + allocate(self%lmtiny(n)) + self%lmtiny(:) = .false. + end if + if (param%lrotation) then allocate(self%rot(NDIM, n)) allocate(self%Ip(NDIM, n)) diff --git a/src/swiftest/swiftest_util.f90 b/src/swiftest/swiftest_util.f90 index 7e303b214..045215d87 100644 --- a/src/swiftest/swiftest_util.f90 +++ b/src/swiftest/swiftest_util.f90 @@ -2310,12 +2310,14 @@ module subroutine swiftest_util_rearray_pl(self, system, param) pl%lcollision(1:npl) = .false. pl%lmask(1:npl) = .true. - pl%lmtiny(1:npl) = pl%Gmass(1:npl) < param%GMTINY - where(pl%lmtiny(1:npl)) - pl%info(1:npl)%particle_type = PL_TINY_TYPE_NAME - elsewhere - pl%info(1:npl)%particle_type = PL_TYPE_NAME - end where + if (param%lmtiny_pl) then + pl%lmtiny(1:npl) = pl%Gmass(1:npl) < param%GMTINY + where(pl%lmtiny(1:npl)) + pl%info(1:npl)%particle_type = PL_TINY_TYPE_NAME + elsewhere + pl%info(1:npl)%particle_type = PL_TYPE_NAME + end where + end if call pl%write_info(param%system_history%nc, param) deallocate(ldump_mask) diff --git a/src/symba/symba_kick.f90 b/src/symba/symba_kick.f90 index 80d3ccbc2..4e9cdd1d4 100644 --- a/src/symba/symba_kick.f90 +++ b/src/symba/symba_kick.f90 @@ -34,7 +34,7 @@ module subroutine symba_kick_getacch_int_pl(self, param) ! call itimer%time_this_loop(param, self%nplplm, self) ! lfirst = .false. ! else - ! if (itimer%io_netcdf_check(param, self%nplplm)) call itimer%time_this_loop(param, self%nplplm, self) + ! if (itimer%netcdf_io_check(param, self%nplplm)) call itimer%time_this_loop(param, self%nplplm, self) ! end if ! else ! param%lflatten_interactions = .false. diff --git a/src/symba/symba_util.f90 b/src/symba/symba_util.f90 index bf749a35e..6b91857a5 100644 --- a/src/symba/symba_util.f90 +++ b/src/symba/symba_util.f90 @@ -276,11 +276,12 @@ module subroutine symba_util_flatten_eucl_plpl(self, param) associate(pl => self, nplplm => self%nplplm) npl = int(self%nbody, kind=I8B) - select type(param) - class is (swiftest_parameters) + if (param%lmtiny_pl) then pl%lmtiny(1:npl) = pl%Gmass(1:npl) < param%GMTINY - end select - nplm = count(.not. pl%lmtiny(1:npl)) + nplm = count(.not. pl%lmtiny(1:npl)) + else + nplm = npl + end if pl%nplm = int(nplm, kind=I4B) nplplm = nplm * npl - nplm * (nplm + 1_I8B) / 2_I8B ! number of entries in a strict lower triangle, npl x npl, minus first column including only mutually interacting bodies From 8483f46cf3119294691d73b5d15aafe4eada7dc8 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Wed, 21 Dec 2022 12:14:35 -0500 Subject: [PATCH 473/569] Rearranged the solver and minimizer functions into their own misc modules --- src/CMakeLists.txt | 2 + src/encounter/encounter_module.f90 | 8 - src/fraggle/fraggle_generate.f90 | 6 +- src/misc/minimizer_module.f90 | 611 +++++++++++++++++ src/misc/solver_module.f90 | 262 ++++++++ src/rmvs/rmvs_setup.f90 | 4 +- src/swiftest/swiftest_io.f90 | 4 +- src/swiftest/swiftest_module.f90 | 57 +- src/swiftest/swiftest_setup.f90 | 4 +- src/swiftest/swiftest_util.f90 | 1008 +++++----------------------- src/symba/symba_module.f90 | 8 - src/symba/symba_setup.f90 | 8 +- src/whm/whm_setup.f90 | 4 +- 13 files changed, 1075 insertions(+), 911 deletions(-) create mode 100644 src/misc/minimizer_module.f90 create mode 100644 src/misc/solver_module.f90 diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index b43cf0407..2a2103662 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -27,6 +27,8 @@ SET(FAST_MATH_FILES ${SRC}/netcdf_io/netcdf_io_module.f90 ${SRC}/misc/lambda_function_module.f90 ${SRC}/misc/io_progress_bar_module.f90 + ${SRC}/misc/solver_module.f90 + ${SRC}/misc/minimizer_module.f90 ${SRC}/encounter/encounter_module.f90 ${SRC}/collision/collision_module.f90 ${SRC}/fraggle/fraggle_module.f90 diff --git a/src/encounter/encounter_module.f90 b/src/encounter/encounter_module.f90 index 5c32a4c97..0911b0afb 100644 --- a/src/encounter/encounter_module.f90 +++ b/src/encounter/encounter_module.f90 @@ -67,7 +67,6 @@ module encounter integer(I4B) :: file_number = 1 !! The number to append on the output file contains procedure :: initialize => encounter_io_initialize_output !! Initialize a set of parameters used to identify a NetCDF output object - procedure :: open => encounter_netcdf_io_open end type encounter_netcdf_parameters @@ -230,13 +229,6 @@ module subroutine encounter_io_initialize_output(self, param) class(base_parameters), intent(in) :: param end subroutine encounter_io_initialize_output - module subroutine encounter_netcdf_io_open(self, param, readonly) - implicit none - class(encounter_netcdf_parameters), intent(inout) :: self !! Parameters used to identify a particular NetCDF dataset - class(base_parameters), intent(in) :: param !! Current run configuration parameters - logical, optional, intent(in) :: readonly !! Logical flag indicating that this should be open read only - end subroutine encounter_netcdf_io_open - module subroutine encounter_io_write_frame_snapshot(self, history, param) implicit none class(encounter_snapshot), intent(in) :: self !! Swiftest encounter structure diff --git a/src/fraggle/fraggle_generate.f90 b/src/fraggle/fraggle_generate.f90 index 59397a808..8903c0ae1 100644 --- a/src/fraggle/fraggle_generate.f90 +++ b/src/fraggle/fraggle_generate.f90 @@ -401,7 +401,7 @@ subroutine fraggle_generate_tan_vel(collision_system, lfailure) tol = TOL_INIT do while(tol < TOL_MIN) - call swiftest_util_minimize_bfgs(objective_function, nfrag-6, v_t_initial(7:nfrag), tol, MAXLOOP, lfailure, v_t_output) + call minimize_bfgs(objective_function, nfrag-6, v_t_initial(7:nfrag), tol, MAXLOOP, lfailure, v_t_output) fragments%v_t_mag(7:nfrag) = v_t_output(:) ! Now that the KE-minimized values of the i>6 fragments are found, calculate the momentum-conserving solution for tangential velociteis v_t_initial(7:nfrag) = fragments%v_t_mag(7:nfrag) @@ -495,7 +495,7 @@ function solve_fragment_tan_vel(lfailure, v_t_mag_input) result(v_t_mag_output) b(1:3) = -L_lin_others(:) b(4:6) = fragments%L_budget(:) - fragments%Lspin(:) - L_orb_others(:) allocate(v_t_mag_output(nfrag)) - v_t_mag_output(1:6) = swiftest_util_solve_linear_system(A, b, 6, lfailure) + v_t_mag_output(1:6) = solve_linear_system(A, b, 6, lfailure) if (present(v_t_mag_input)) v_t_mag_output(7:nfrag) = v_t_mag_input(:) end associate end select @@ -584,7 +584,7 @@ subroutine fraggle_generate_rad_vel(collision_system, lfailure) objective_function = lambda_obj(radial_objective_function) tol = TOL_INIT do while(tol < TOL_MIN) - call swiftest_util_minimize_bfgs(objective_function, nfrag, v_r_initial, tol, MAXLOOP, lfailure, v_r_output) + call minimize_bfgs(objective_function, nfrag, v_r_initial, tol, MAXLOOP, lfailure, v_r_output) fragments%v_r_mag(1:nfrag) = v_r_output(1:nfrag) if (.not.lfailure) exit tol = tol * 2 ! Keep increasing the tolerance until we converge on a solution diff --git a/src/misc/minimizer_module.f90 b/src/misc/minimizer_module.f90 new file mode 100644 index 000000000..0e4c37ede --- /dev/null +++ b/src/misc/minimizer_module.f90 @@ -0,0 +1,611 @@ +!! Copyright 2022 - David Minton, Carlisle Wishard, Jennifer Pouplin, Jake Elliott, & Dana Singh +!! This file is part of Swiftest. +!! Swiftest is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License +!! as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. +!! Swiftest is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty +!! of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. +!! You should have received a copy of the GNU General Public License along with Swiftest. +!! If not, see: https://www.gnu.org/licenses. + +module minimizer + !! author: David A. Minton + !! + !! Includes the Broyden-Fletcher-Goldfarb-Shanno minimizer used by Fraggle + use globals + use lambda_function + use solver + use, intrinsic :: ieee_exceptions + private + public :: minimize_bfgs + + type(ieee_status_type) :: original_fpe_status + logical, dimension(:), allocatable :: fpe_flag + + interface + module subroutine minimize_bfgs(f, N, x0, eps, maxloop, lerr, x1) + implicit none + integer(I4B), intent(in) :: N + class(lambda_obj), intent(inout) :: f + real(DP), dimension(:), intent(in) :: x0 + real(DP), intent(in) :: eps + integer(I4B), intent(in) :: maxloop + logical, intent(out) :: lerr + real(DP), dimension(:), intent(out), allocatable :: x1 + end subroutine minimize_bfgs + end interface + + contains + + module subroutine minimize_bfgs(f, N, x0, eps, maxloop, lerr, x1) + !! author: David A. Minton + !! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + !! This function implements the Broyden-Fletcher-Goldfarb-Shanno method to determine the minimum of a function of N variables. + !! It recieves as input: + !! f%eval(x) : lambda function object containing the objective function as the eval metho + !! N : Number of variables of function f + !! x0 : Initial starting value of x + !! eps : Accuracy of 1 - dimensional minimization at each step + !! maxloop : Maximum number of loops to attempt to find a solution + !! The outputs include + !! lerr : Returns .true. if it could not find the minimum + !! Returns + !! x1 : Final minimum (all 0 if none found) + !! 0 = No miniumum found + !! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + implicit none + ! Arguments + integer(I4B), intent(in) :: N + class(lambda_obj), intent(inout) :: f + real(DP), dimension(:), intent(in) :: x0 + real(DP), intent(in) :: eps + integer(I4B), intent(in) :: maxloop + logical, intent(out) :: lerr + ! Result + real(DP), dimension(:), intent(out), allocatable :: x1 + ! Internals + integer(I4B) :: i, j, k, l, conv + real(DP), parameter :: graddelta = 1e-4_DP !! Delta x for gradient calculations + real(DP), dimension(N) :: S !! Direction vectors + real(DP), dimension(N,N) :: H !! Approximated inverse Hessian matrix + real(DP), dimension(N) :: grad1 !! gradient of f + real(DP), dimension(N) :: grad0 !! old value of gradient + real(DP) :: astar !! 1D minimized value + real(DP), dimension(N) :: y, P + real(DP), dimension(N,N) :: PP, PyH, HyP + real(DP), save :: yHy, Py + + call ieee_get_status(original_fpe_status) ! Save the original floating point exception status + call ieee_set_flag(ieee_all, .false.) ! Set all flags to quiet + allocate(fpe_flag(size(ieee_usual))) + + lerr = .false. + allocate(x1, source=x0) + ! Initialize approximate Hessian with the identity matrix (i.e. begin with method of steepest descent) + ! Get initial gradient and initialize arrays for updated values of gradient and x + H(:,:) = reshape([((0._DP, i=1, j-1), 1._DP, (0._DP, i=j+1, N), j=1, N)], [N,N]) + grad0 = gradf(f, N, x0(:), graddelta, lerr) + if (lerr) then + call ieee_set_status(original_fpe_status) + return + end if + grad1(:) = grad0(:) + do i = 1, maxloop + !check for convergence + conv = count(abs(grad1(:)) > eps) + if (conv == 0) exit + S(:) = -matmul(H(:,:), grad1(:)) + astar = minimize1D(f, x1, S, N, graddelta, lerr) + if (lerr) exit + ! Get new x values + P(:) = astar * S(:) + x1(:) = x1(:) + P(:) + ! Calculate new gradient + grad0(:) = grad1(:) + grad1 = gradf(f, N, x1, graddelta, lerr) + y(:) = grad1(:) - grad0(:) + Py = sum(P(:) * y(:)) + ! set up factors for H matrix update + yHy = 0._DP + !$omp do simd schedule(static)& + !$omp firstprivate(N, y, H) & + !$omp reduction(+:yHy) + do k = 1, N + do j = 1, N + yHy = yHy + y(j) * H(j,k) * y(k) + end do + end do + !$omp end do simd + ! prevent divide by zero (convergence) + if (abs(Py) < tiny(Py)) exit + ! set up update + PyH(:,:) = 0._DP + HyP(:,:) = 0._DP + !$omp parallel do default(private) schedule(static)& + !$omp shared(N, PP, P, y, H) & + !$omp reduction(+:PyH, HyP) + do k = 1, N + do j = 1, N + PP(j, k) = P(j) * P(k) + do l = 1, N + PyH(j, k) = PyH(j, k) + P(j) * y(l) * H(l,k) + HyP(j, k) = HyP(j, k) + P(k) * y(l) * H(j,l) + end do + end do + end do + !$omp end parallel do + ! update H matrix + H(:,:) = H(:,:) + ((1._DP - yHy / Py) * PP(:,:) - PyH(:,:) - HyP(:,:)) / Py + ! Normalize to prevent it from blowing up if it takes many iterations to find a solution + H(:,:) = H(:,:) / norm2(H(:,:)) + ! Stop everything if there are any exceptions to allow the routine to fail gracefully + call ieee_get_flag(ieee_usual, fpe_flag) + if (any(fpe_flag)) exit + if (i == maxloop) then + lerr = .true. + end if + end do + call ieee_get_flag(ieee_usual, fpe_flag) + lerr = lerr .or. any(fpe_flag) + call ieee_set_status(original_fpe_status) + + return + + end subroutine minimize_bfgs + + + function gradf(f, N, x1, dx, lerr) result(grad) + !! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + !! Purpose: Estimates the gradient of a function using a central difference + !! approximation + !! Inputs: + !! f%eval(x) : lambda function object containing the objective function as the eval metho + !! N : number of variables N + !! x1 : x value array + !! dx : step size to use when calculating derivatives + !! Outputs: + !! lerr : .true. if an error occurred. Otherwise returns .false. + !! Returns + !! grad : N sized array containing estimated gradient of f at x1 + !! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + implicit none + ! Arguments + integer(I4B), intent(in) :: N + class(lambda_obj), intent(inout) :: f + real(DP), dimension(:), intent(in) :: x1 + real(DP), intent(in) :: dx + logical, intent(out) :: lerr + ! Result + real(DP), dimension(N) :: grad + ! Internals + integer(I4B) :: i, j + real(DP), dimension(N) :: xp, xm + real(DP) :: fp, fm + logical :: lerrp, lerrm + + do i = 1, N + do j = 1, N + if (j == i) then + xp(j) = x1(j) + dx + xm(j) = x1(j) - dx + else + xp(j) = x1(j) + xm(j) = x1(j) + end if + end do + select type (f) + class is (lambda_obj_err) + fp = f%eval(xp) + lerrp = f%lerr + fm = f%eval(xm) + lerrm = f%lerr + lerr = lerrp .or. lerrm + class is (lambda_obj) + fp = f%eval(xp) + fm = f%eval(xm) + lerr = .false. + end select + grad(i) = (fp - fm) / (2 * dx) + if (lerr) return + end do + return + end function gradf + + + function minimize1D(f, x0, S, N, eps, lerr) result(astar) + !! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + !! This program find the minimum of a function of N variables in a single direction + !! S using in sequence: + !! 1. A Bracketing method + !! 2. The golden section method + !! 3. A quadratic polynomial fit + !! Inputs + !! f%eval(x) : lambda function object containing the objective function as the eval metho + !! x0 : Array of size N of initial x values + !! S : Array of size N that determines the direction of minimization + !! N : Number of variables of function f + !! eps : Accuracy of 1 - dimensional minimization at each step + !! Output + !! lerr : .true. if an error occurred. Otherwise returns .false. + !! Returns + !! astar : Final minimum along direction S + !! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + implicit none + ! Arguments + integer(I4B), intent(in) :: N + class(lambda_obj), intent(inout) :: f + real(DP), dimension(:), intent(in) :: x0, S + real(DP), intent(in) :: eps + logical, intent(out) :: lerr + ! Result + real(DP) :: astar + ! Internals + integer(I4B) :: num = 0 + real(DP), parameter :: step = 0.7_DP !! Bracketing method step size + real(DP), parameter :: gam = 1.2_DP !! Bracketing method expansion parameter + real(DP), parameter :: greduce = 0.2_DP !! Golden section method reduction factor + real(DP), parameter :: greduce2 = 0.1_DP ! Secondary golden section method reduction factor + real(DP) :: alo, ahi !! High and low values for 1 - D minimization routines + real(DP), parameter :: a0 = epsilon(1.0_DP) !! Initial guess of alpha + + alo = a0 + call bracket(f, x0, S, N, gam, step, alo, ahi, lerr) + if (lerr) then + !write(*,*) "BFGS bracketing step failed!" + !write(*,*) "alo: ",alo, "ahi: ", ahi + return + end if + if (abs(alo - ahi) < eps) then + astar = alo + lerr = .false. + return + end if + call golden(f, x0, S, N, greduce, alo, ahi, lerr) + if (lerr) then + !write(*,*) "BFGS golden section step failed!" + return + end if + if (abs(alo - ahi) < eps) then + astar = alo + lerr = .false. + return + end if + call quadfit(f, x0, S, N, eps, alo, ahi, lerr) + if (lerr) then + !write(*,*) "BFGS quadfit failed!" + return + end if + if (abs(alo - ahi) < eps) then + astar = alo + lerr = .false. + return + end if + ! Quadratic fit method won't converge, so finish off with another golden section + call golden(f, x0, S, N, greduce2, alo, ahi, lerr) + if (.not. lerr) astar = (alo + ahi) / 2.0_DP + return + end function minimize1D + + + function n2one(f, x0, S, N, a, lerr) result(fnew) + implicit none + ! Arguments + integer(I4B), intent(in) :: N + class(lambda_obj), intent(inout) :: f + real(DP), dimension(:), intent(in) :: x0, S + real(DP), intent(in) :: a + logical, intent(out) :: lerr + + ! Return + real(DP) :: fnew + ! Internals + real(DP), dimension(N) :: xnew + integer(I4B) :: i + + xnew(:) = x0(:) + a * S(:) + fnew = f%eval(xnew(:)) + select type(f) + class is (lambda_obj_err) + lerr = f%lerr + class is (lambda_obj) + lerr = .false. + end select + return + end function n2one + + + subroutine bracket(f, x0, S, N, gam, step, lo, hi, lerr) + ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + !! This subroutine brackets the minimum. It recieves as input: + !! f%eval(x) : lambda function object containing the objective function as the eval metho + !! x0 : Array of size N of initial x values + !! S : Array of size N that determines the direction of minimization + !! gam : expansion parameter + !! step : step size + !! lo : initial guess of lo bracket value + !! The outputs include + !! lo : lo bracket + !! hi : hi bracket + !! lerr : .true. if an error occurred. Otherwise returns .false. + !! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + implicit none + ! Arguments + integer(I4B), intent(in) :: N + class(lambda_obj), intent(inout) :: f + real(DP), dimension(:), intent(in) :: x0, S + real(DP), intent(in) :: gam, step + real(DP), intent(inout) :: lo + real(DP), intent(out) :: hi + logical, intent(out) :: lerr + ! Internals + real(DP) :: a0, a1, a2, atmp, da + real(DP) :: f0, f1, f2 + integer(I4B) :: i, j + integer(I4B), parameter :: MAXLOOP = 100 ! maximum number of loops before method is determined to have failed + real(DP), parameter :: eps = epsilon(lo) ! small number precision to test floating point equality + + ! set up initial bracket points + a0 = lo + da = step + a1 = a0 + da + a2 = a0 + 2 * da + f0 = n2one(f, x0, S, N, a0, lerr) + if (lerr) return + f1 = n2one(f, x0, S, N, a1, lerr) + if (lerr) return + f2 = n2one(f, x0, S, N, a2, lerr) + if (lerr) return + ! loop over bracket method until either min is bracketed method fails + do i = 1, MAXLOOP + if ((f0 > f1) .and. (f1 < f2)) then ! Minimum was found + lo = a0 + hi = a2 + return + else if ((f0 >= f1) .and. (f1 > f2)) then ! Function appears to decrease + da = da * gam + atmp = a2 + da + a0 = a1 + a1 = a2 + a2 = atmp + f0 = f1 + f1 = f2 + f2 = n2one(f, x0, S, N, a2, lerr) + else if ((f0 < f1) .and. (f1 <= f2)) then ! Function appears to increase + da = da * gam + atmp = a0 - da + a2 = a1 + a1 = a0 + a0 = atmp + f2 = f1 + f0 = n2one(f, x0, S, N, a0, lerr) + else if ((f0 < f1) .and. (f1 > f2)) then ! We are at a peak. Pick the direction that descends the fastest + da = da * gam + if (f2 > f0) then ! LHS is lower than RHS + atmp = a2 + da + a0 = a1 + a1 = a2 + a2 = atmp + f0 = f1 + f1 = f2 + f2 = n2one(f, x0, S, N, a2, lerr) + else ! RHS is lower than LHS + atmp = a0 - da + a2 = a1 + a1 = a0 + a0 = atmp + f2 = f1 + f1 = f2 + f0 = n2one(f, x0, S, N, a0, lerr) + end if + else if ((f0 > f1) .and. (abs(f2 - f1) <= eps)) then ! Decrasging but RHS equal + da = da * gam + atmp = a2 + da + a2 = atmp + f2 = n2one(f, x0, S, N, a2, lerr) + else if ((abs(f0 - f1) < eps) .and. (f1 < f2)) then ! Increasing but LHS equal + da = da * gam + atmp = a0 - da + a0 = atmp + f0 = n2one(f, x0, S, N, a0, lerr) + else ! all values equal. Expand in either direction and try again + a0 = a0 - da + a2 = a2 + da + f0 = n2one(f, x0, S, N, a0, lerr) + if (lerr) exit ! An error occurred while evaluating the function + f2 = n2one(f, x0, S, N, a2, lerr) + end if + if (lerr) exit ! An error occurred while evaluating the function + end do + lerr = .true. + return ! no minimum found + end subroutine bracket + + + subroutine golden(f, x0, S, N, eps, lo, hi, lerr) + ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + !! This function uses the golden section method to reduce the starting interval lo, hi by some amount sigma. + !! It recieves as input: + !! f%eval(x) : lambda function object containing the objective function as the eval metho + !! x0 : Array of size N of initial x values + !! S : Array of size N that determines the direction of minimization + !! gam : expansion parameter + !! eps : reduction interval in range (0 < sigma < 1) such that: + !! hi(new) - lo(new) = eps * (hi(old) - lo(old)) + !! lo : initial guess of lo bracket value + !! The outputs include + !! lo : lo bracket + !! hi : hi bracket + !! lerr : .true. if an error occurred. Otherwise returns .false. + !! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + implicit none + ! Arguments + integer(I4B), intent(in) :: N + class(lambda_obj), intent(inout) :: f + real(DP), dimension(:), intent(in) :: x0, S + real(DP), intent(in) :: eps + real(DP), intent(inout) :: lo + real(DP), intent(out) :: hi + logical, intent(out) :: lerr + ! Internals + real(DP), parameter :: tau = 0.5_DP * (sqrt(5.0_DP) - 1.0_DP) ! Golden section constant + integer(I4B), parameter :: MAXLOOP = 40 ! maximum number of loops before method is determined to have failed (unlikely, but could occur if no minimum exists between lo and hi) + real(DP) :: i0 ! Initial interval value + real(DP) :: a1, a2 + real(DP) :: f1, f2 + integer(I4B) :: i, j + + i0 = hi - lo + a1 = hi - tau * i0 + a2 = lo + tau * i0 + f1 = n2one(f, x0, S, N, a1, lerr) + if (lerr) return + f2 = n2one(f, x0, S, N, a2, lerr) + if (lerr) return + do i = 1, MAXLOOP + if (abs((hi - lo) / i0) <= eps) return ! interval reduced to input amount + if (f2 > f1) then + hi = a2 + a2 = a1 + f2 = f1 + a1 = hi - tau * (hi - lo) + f1 = n2one(f, x0, S, N, a1, lerr) + else + lo = a1 + a1 = a2 + f2 = f1 + a2 = hi - (1.0_DP - tau) * (hi - lo) + f2 = n2one(f, x0, S, N, a2, lerr) + end if + if (lerr) exit + end do + lerr = .true. + return ! search took too many iterations - no minimum found + end subroutine golden + + + subroutine quadfit(f, x0, S, N, eps, lo, hi, lerr) + ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + !! This function uses a quadratic polynomial fit to locate the minimum of a function + !! to some accuracy eps. It recieves as input: + !! f%eval(x) : lambda function object containing the objective function as the eval metho + !! lo : low bracket value + !! hi : high bracket value + !! eps : desired accuracy of final minimum location + !! The outputs include + !! lo : final minimum location + !! hi : final minimum location + !! Notes: Uses the ieee_exceptions intrinsic module to allow for graceful failure due to floating point exceptions, which won't terminate the run. + !! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + implicit none + ! Arguments + integer(I4B), intent(in) :: N + class(lambda_obj), intent(inout) :: f + real(DP), dimension(:), intent(in) :: x0, S + real(DP), intent(in) :: eps + real(DP), intent(inout) :: lo + real(DP), intent(out) :: hi + logical, intent(out) :: lerr + ! Internals + integer(I4B), parameter :: MAXLOOP = 20 ! maximum number of loops before method is determined to have failed. + real(DP) :: a1, a2, a3, astar ! three points for the polynomial fit and polynomial minimum + real(DP) :: f1, f2, f3, fstar ! three function values for the polynomial and polynomial minimum + real(DP), dimension(3) :: row_1, row_2, row_3, rhs, soln ! matrix for 3 equation solver (gaussian elimination) + real(DP), dimension(3,3) :: lhs + real(DP) :: d1, d2, d3, aold, denom, errval + integer(I4B) :: i + + lerr = .false. + ! Get initial a1, a2, a3 values + a1 = lo + a2 = lo + 0.5_DP * (hi - lo) + a3 = hi + aold = a1 + astar = a2 + f1 = n2one(f, x0, S, N, a1, lerr) + if (lerr) return + f2 = n2one(f, x0, S, N, a2, lerr) + if (lerr) return + f3 = n2one(f, x0, S, N, a3, lerr) + if (lerr) return + do i = 1, MAXLOOP + ! check to see if convergence is reached and exit + errval = abs((astar - aold) / astar) + call ieee_get_flag(ieee_usual, fpe_flag) + if (any(fpe_flag)) then + !write(*,*) 'quadfit fpe' + !write(*,*) 'aold : ',aold + !write(*,*) 'astar: ',astar + lerr = .true. + exit + end if + if (errval < eps) then + lo = astar + hi = astar + exit + end if + ! Set up system for gaussian elimination equation solver + row_1 = [1.0_DP, a1, a1**2] + row_2 = [1.0_DP, a2, a2**2] + row_3 = [1.0_DP, a3, a3**2] + rhs = [f1, f2, f3] + lhs(1, :) = row_1 + lhs(2, :) = row_2 + lhs(3, :) = row_3 + ! Solve system of equations + soln(:) = solve_linear_system(lhs, rhs, 3, lerr) + call ieee_set_flag(ieee_all, .false.) ! Set all flags back to quiet + call ieee_set_halting_mode(ieee_divide_by_zero, .false.) + if (lerr) then + !write(*,*) 'quadfit fpe:' + !write(*,*) 'util_solve_linear_system failed' + exit + end if + aold = astar + if (soln(2) == soln(3)) then ! Handles the case where they are both 0. 0/0 is an unhandled exception + astar = -0.5_DP + else + astar = -soln(2) / (2 * soln(3)) + end if + call ieee_get_flag(ieee_usual, fpe_flag) + if (any(fpe_flag)) then + !write(*,*) 'quadfit fpe' + !write(*,*) 'soln(2:3): ',soln(2:3) + !write(*,*) 'a1, a2, a3' + !write(*,*) a1, a2, a3 + !write(*,*) 'f1, f2, f3' + !write(*,*) f1, f2, f3 + lerr = .true. + exit + end if + fstar = n2one(f, x0, S, N, astar, lerr) + if (lerr) exit + ! keep the three closest a values to astar and discard the fourth + d1 = abs(a1 - astar) + d2 = abs(a2 - astar) + d3 = abs(a3 - astar) + + if (d1 > d2) then + if (d1 > d3) then + f1 = fstar + a1 = astar + else if (d3 > d2) then + f3 = fstar + a3 = astar + end if + else + if (d2 > d3) then + f2 = fstar + a2 = astar + else if (d3 > d1) then + f3 = fstar + a3 = astar + end if + end if + end do + if (lerr) return + lo = a1 + hi = a3 + return + end subroutine quadfit + + +end module minimizer \ No newline at end of file diff --git a/src/misc/solver_module.f90 b/src/misc/solver_module.f90 new file mode 100644 index 000000000..43c5f170b --- /dev/null +++ b/src/misc/solver_module.f90 @@ -0,0 +1,262 @@ +!! Copyright 2022 - David Minton, Carlisle Wishard, Jennifer Pouplin, Jake Elliott, & Dana Singh +!! This file is part of Swiftest. +!! Swiftest is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License +!! as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. +!! Swiftest is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty +!! of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. +!! You should have received a copy of the GNU General Public License along with Swiftest. +!! If not, see: https://www.gnu.org/licenses. + +module solver + !! author: David A. Minton + !! + !! Contains the Broyden-Fletcher-Goldfarb-Shanno minimizer used by Fraggle + use globals + use lambda_function + use, intrinsic :: ieee_exceptions + private + public :: solve_linear_system, solve_rkf45 + + interface solve_linear_system + module procedure solve_linear_system_dp + module procedure solve_linear_system_qp + end interface + + interface + module function solve_rkf45(f, y0in, t1, dt0, tol) result(y1) + implicit none + class(lambda_obj), intent(inout) :: f !! lambda function object that has been initialized to be a function of derivatives. The object will return with components lastarg and lasteval set + real(DP), dimension(:), intent(in) :: y0in !! Initial value at t=0 + real(DP), intent(in) :: t1 !! Final time + real(DP), intent(in) :: dt0 !! Initial step size guess + real(DP), intent(in) :: tol !! Tolerance on solution + real(DP), dimension(:), allocatable :: y1 !! Final result + end function solve_rkf45 + end interface + + + contains + + function solve_linear_system_dp(A,b,n,lerr) result(x) + !! Author: David A. Minton + !! + !! Solves the linear equation of the form A*x = b for x. + !! A is an (n,n) arrays + !! x and b are (n) arrays + !! Uses Gaussian elimination, so will have issues if system is ill-conditioned. + !! Uses quad precision intermidiate values, so works best on small arrays. + implicit none + ! Arguments + integer(I4B), intent(in) :: n + real(DP), dimension(:,:), intent(in) :: A + real(DP), dimension(:), intent(in) :: b + logical, intent(out) :: lerr + ! Result + real(DP), dimension(n) :: x + ! Internals + real(QP), dimension(:), allocatable :: qx + type(ieee_status_type) :: original_fpe_status + logical, dimension(:), allocatable :: fpe_flag + + call ieee_get_status(original_fpe_status) ! Save the original floating point exception status + call ieee_set_flag(ieee_all, .false.) ! Set all flags to quiet + allocate(fpe_flag(size(ieee_usual))) + + qx = solve_wbs(ge_wpp(real(A, kind=QP), real(b, kind=QP))) + + call ieee_get_flag(ieee_usual, fpe_flag) + lerr = any(fpe_flag) + if (lerr .or. (any(abs(qx) > huge(x))) .or. (any(abs(qx) < tiny(x)))) then + x = 0.0_DP + else + x = real(qx, kind=DP) + end if + call ieee_set_status(original_fpe_status) + + return + end function solve_linear_system_dp + + + function solve_linear_system_qp(A,b,n,lerr) result(x) + !! Author: David A. Minton + !! + !! Solves the linear equation of the form A*x = b for x. + !! A is an (n,n) arrays + !! x and b are (n) arrays + !! Uses Gaussian elimination, so will have issues if system is ill-conditioned. + !! Uses quad precision intermidiate values, so works best on small arrays. + implicit none + ! Arguments + integer(I4B), intent(in) :: n + real(QP), dimension(:,:), intent(in) :: A + real(QP), dimension(:), intent(in) :: b + logical, intent(out) :: lerr + ! Result + real(QP), dimension(n) :: x + ! Internals + type(ieee_status_type) :: original_fpe_status + logical, dimension(:), allocatable :: fpe_flag + + call ieee_get_status(original_fpe_status) ! Save the original floating point exception status + call ieee_set_flag(ieee_all, .false.) ! Set all flags to quiet + allocate(fpe_flag(size(ieee_usual))) + + x = solve_wbs(ge_wpp(A, b)) + + call ieee_get_flag(ieee_usual, fpe_flag) + lerr = any(fpe_flag) + if (lerr) x = 0.0_DP + call ieee_set_status(original_fpe_status) + + return + end function solve_linear_system_qp + + + function solve_wbs(u) result(x) ! solve with backward substitution + !! Based on code available on Rosetta Code: https://rosettacode.org/wiki/Gaussian_elimination#Fortran + implicit none + ! Arguments + real(QP), intent(in), dimension(:,:), allocatable :: u + ! Result + real(QP), dimension(:), allocatable :: x + ! Internals + integer(I4B) :: i,n + + n = size(u, 1) + if (allocated(x)) deallocate(x) + if (.not.allocated(x)) allocate(x(n)) + if (any(abs(u) < tiny(1._DP)) .or. any(abs(u) > huge(1._DP))) then + x(:) = 0._DP + return + end if + call ieee_set_halting_mode(ieee_divide_by_zero, .false.) + do i = n, 1, -1 + x(i) = (u(i, n + 1) - sum(u(i, i + 1:n) * x(i + 1:n))) / u(i, i) + end do + return + end function solve_wbs + + + function ge_wpp(A, b) result(u) ! gaussian eliminate with partial pivoting + !! Solve Ax=b using Gaussian elimination then backwards substitution. + !! A being an n by n matrix. + !! x and b are n by 1 vectors. + !! Based on code available on Rosetta Code: https://rosettacode.org/wiki/Gaussian_elimination#Fortran + implicit none + ! Arguments + real(QP), dimension(:,:), intent(in) :: A + real(QP), dimension(:), intent(in) :: b + ! Result + real(QP), dimension(:,:), allocatable :: u + ! Internals + integer(I4B) :: i,j,n,p + real(QP) :: upi + + n = size(a, 1) + allocate(u(n, (n + 1))) + u = reshape([A, b], [n, n + 1]) + call ieee_set_halting_mode(ieee_divide_by_zero, .false.) + do j = 1, n + p = maxloc(abs(u(j:n, j)), 1) + j - 1 ! maxloc returns indices between (1, n - j + 1) + if (p /= j) u([p, j], j) = u([j, p], j) + u(j + 1:, j) = u(j + 1:, j) / u(j, j) + do i = j + 1, n + 1 + upi = u(p, i) + if (p /= j) u([p, j], i) = u([j, p], i) + u(j + 1:n, i) = u(j + 1:n, i) - upi * u(j + 1:n, j) + end do + end do + return + end function ge_wpp + + + module function solve_rkf45(f, y0in, t1, dt0, tol) result(y1) + !! author: David A. Minton + !! + !! Implements the 4th order Runge-Kutta-Fehlberg ODE solver for initial value problems of the form f=dy/dt, y0 = y(t=0), solving for y1 = y(t=t1). Uses a 5th order adaptive step size control. + !! Uses a lambda function object as defined in the lambda_function module + implicit none + ! Arguments + class(lambda_obj), intent(inout) :: f !! lambda function object that has been initialized to be a function of derivatives. The object will return with components lastarg and lasteval set + real(DP), dimension(:), intent(in) :: y0in !! Initial value at t=0 + real(DP), intent(in) :: t1 !! Final time + real(DP), intent(in) :: dt0 !! Initial step size guess + real(DP), intent(in) :: tol !! Tolerance on solution + ! Result + real(DP), dimension(:), allocatable :: y1 !! Final result + ! Internals + integer(I4B), parameter :: MAXREDUX = 1000 !! Maximum number of times step size can be reduced + real(DP), parameter :: DTFAC = 0.95_DP !! Step size reduction safety factor (Value just under 1.0 to prevent adaptive step size control from discarding steps too aggressively) + integer(I4B), parameter :: RKS = 6 !! Number of RK stages + real(DP), dimension(RKS, RKS - 1), parameter :: rkf45_btab = reshape( & !! Butcher tableau for Runge-Kutta-Fehlberg method + (/ 1./4., 1./4., 0., 0., 0., 0.,& + 3./8., 3./32., 9./32., 0., 0., 0.,& + 12./13., 1932./2197., -7200./2197., 7296./2197., 0., 0.,& + 1., 439./216., -8., 3680./513., -845./4104., 0.,& + 1./2., -8./27., 2., -3544./2565., 1859./4104., -11./40./), shape(rkf45_btab)) + real(DP), dimension(RKS), parameter :: rkf4_coeff = (/ 25./216., 0., 1408./2565. , 2197./4104. , -1./5., 0. /) + real(DP), dimension(RKS), parameter :: rkf5_coeff = (/ 16./135., 0., 6656./12825., 28561./56430., -9./50., 2./55. /) + real(DP), dimension(:, :), allocatable :: k !! Runge-Kutta coefficient vector + real(DP), dimension(:), allocatable :: ynorm !! Normalized y value used for adaptive step size control + real(DP), dimension(:), allocatable :: y0 !! Value of y at the beginning of each substep + integer(I4B) :: Nvar !! Number of variables in problem + integer(I4B) :: rkn !! Runge-Kutta loop index + real(DP) :: t, x1, dt, trem !! Current time, step size and total time remaining + real(DP) :: s, yerr, yscale !! Step size reduction factor, error in dependent variable, and error scale factor + integer(I4B) :: i + + allocate(y0, source=y0in) + allocate(y1, mold=y0) + allocate(ynorm, mold=y0) + Nvar = size(y0) + allocate(k(Nvar, RKS)) + + dt = dt0 + + trem = t1 + t = 0._DP + do + yscale = norm2(y0(:)) + do i = 1, MAXREDUX + select type(f) + class is (lambda_obj_tvar) + do rkn = 1, RKS + y1(:) = y0(:) + matmul(k(:, 1:rkn - 1), rkf45_btab(2:rkn, rkn - 1)) + if (rkn == 1) then + x1 = t + else + x1 = t + rkf45_btab(1,rkn-1) + end if + k(:, rkn) = dt * f%evalt(y1(:), t) + end do + class is (lambda_obj) + do rkn = 1, RKS + y1(:) = y0(:) + matmul(k(:, 1:rkn - 1), rkf45_btab(2:rkn, rkn - 1)) + k(:, rkn) = dt * f%eval(y1(:)) + end do + end select + ! Now determine if the step size needs adjusting + ynorm(:) = matmul(k(:,:), (rkf5_coeff(:) - rkf4_coeff(:))) / yscale + yerr = norm2(ynorm(:)) + s = (tol / (2 * yerr))**(0.25_DP) + dt = min(s * DTFAC * dt, trem) ! Alter step size either up or down, but never bigger than the remaining time + if (s >= 1.0_DP) exit ! Good step! + if (i == MAXREDUX) then + write(*,*) "Something has gone wrong in util_solve_rkf45!! Step size reduction has gone too far this time!" + call util_exit(FAILURE) + end if + end do + + ! Compute new value then step ahead in time + y1(:) = y0(:) + matmul(k(:, :), rkf4_coeff(:)) + trem = trem - dt + t = t + dt + if (trem <= 0._DP) exit + y0(:) = y1(:) + end do + + return + end function solve_rkf45 + + +end module solver \ No newline at end of file diff --git a/src/rmvs/rmvs_setup.f90 b/src/rmvs/rmvs_setup.f90 index aeea42dfa..cc8f8839c 100644 --- a/src/rmvs/rmvs_setup.f90 +++ b/src/rmvs/rmvs_setup.f90 @@ -148,8 +148,8 @@ module subroutine rmvs_setup_tp(self, n, param) integer(I4B), intent(in) :: n !! Number of particles to allocate space for class(swiftest_parameters), intent(in) :: param !! Current run configuration parameter - !> Call allocation method for parent class. In this case, whm does not have its own setup method, so we use the base method for swiftest_tp - call setup_tp(self, n, param) + !> Call allocation method for parent class. + call self%whm_tp%setup(n, param) if (n <= 0) return allocate(self%lperi(n)) diff --git a/src/swiftest/swiftest_io.f90 b/src/swiftest/swiftest_io.f90 index 9c5fa4eb2..07dfb4182 100644 --- a/src/swiftest/swiftest_io.f90 +++ b/src/swiftest/swiftest_io.f90 @@ -308,7 +308,7 @@ module subroutine swiftest_io_dump_storage(self, param) end subroutine swiftest_io_dump_storage - module subroutine swiftest_swiftest_io_get_args(integrator, param_file_name, display_style) + module subroutine swiftest_io_get_args(integrator, param_file_name, display_style) !! author: David A. Minton !! !! Reads in the name of the parameter file from command line arguments. @@ -379,7 +379,7 @@ module subroutine swiftest_swiftest_io_get_args(integrator, param_file_name, dis end if return - end subroutine swiftest_swiftest_io_get_args + end subroutine swiftest_io_get_args module function swiftest_io_get_token(buffer, ifirst, ilast, ierr) result(token) diff --git a/src/swiftest/swiftest_module.f90 b/src/swiftest/swiftest_module.f90 index a46f66ce2..6347629b0 100644 --- a/src/swiftest/swiftest_module.f90 +++ b/src/swiftest/swiftest_module.f90 @@ -43,6 +43,8 @@ module swiftest use walltime use io_progress_bar use netcdf_io + use solver + use minimizer !use advisor_annotate !$ use omp_lib implicit none @@ -279,7 +281,7 @@ module swiftest integer(I8B) :: npltp !! Number of pl-tp comparisons in the flattened upper triangular matrix integer(I4B), dimension(:), allocatable :: nplenc !! number of encounters with planets this time step !! Note to developers: If you add components to this class, be sure to update methods and subroutines that traverse the - !! component list, such as setup_tp and util_spill_tp + !! component list, such as swiftest_setup_tp and util_spill_tp contains ! Test particle-specific concrete methods ! These are concrete because they are the same implemenation for all integrators @@ -588,12 +590,12 @@ module subroutine swiftest_io_dump_storage(self, param) class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters end subroutine swiftest_io_dump_storage - module subroutine swiftest_swiftest_io_get_args(integrator, param_file_name, display_style) + module subroutine swiftest_io_get_args(integrator, param_file_name, display_style) implicit none character(len=:), allocatable, intent(inout) :: integrator !! Symbolic code of the requested integrator character(len=:), allocatable, intent(inout) :: param_file_name !! Name of the input parameters file character(len=:), allocatable, intent(inout) :: display_style !! Style of the output display {"STANDARD", "COMPACT"}). Default is "STANDARD" - end subroutine swiftest_swiftest_io_get_args + end subroutine swiftest_io_get_args module function swiftest_io_get_token(buffer, ifirst, ilast, ierr) result(token) implicit none @@ -1371,18 +1373,6 @@ module subroutine swiftest_util_index_map_storage(self) class(swiftest_storage(*)), intent(inout) :: self !! Swiftest storage object end subroutine swiftest_util_index_map_storage - module subroutine swiftest_util_minimize_bfgs(f, N, x0, eps, maxloop, lerr, x1) - use lambda_function - implicit none - integer(I4B), intent(in) :: N - class(lambda_obj), intent(inout) :: f - real(DP), dimension(:), intent(in) :: x0 - real(DP), intent(in) :: eps - logical, intent(out) :: lerr - integer(I4B), intent(in) :: maxloop - real(DP), dimension(:), allocatable, intent(out) :: x1 - end subroutine swiftest_util_minimize_bfgs - module subroutine swiftest_util_peri_body(self, system, param) implicit none class(swiftest_body), intent(inout) :: self !! SyMBA massive body object @@ -1582,39 +1572,6 @@ end subroutine swiftest_util_snapshot_system end interface - interface swiftest_util_solve_linear_system - module function swiftest_util_solve_linear_system_d(A,b,n,lerr) result(x) - implicit none - integer(I4B), intent(in) :: n - real(DP), dimension(:,:), intent(in) :: A - real(DP), dimension(:), intent(in) :: b - logical, intent(out) :: lerr - real(DP), dimension(n) :: x - end function swiftest_util_solve_linear_system_d - - module function swiftest_util_solve_linear_system_q(A,b,n,lerr) result(x) - implicit none - integer(I4B), intent(in) :: n - real(QP), dimension(:,:), intent(in) :: A - real(QP), dimension(:), intent(in) :: b - logical, intent(out) :: lerr - real(QP), dimension(n) :: x - end function swiftest_util_solve_linear_system_q - end interface - - interface - module function swiftest_util_solve_rkf45(f, y0in, t1, dt0, tol) result(y1) - use lambda_function - implicit none - class(lambda_obj), intent(inout) :: f !! lambda function object that has been initialized to be a function of derivatives. The object will return with components lastarg and lasteval set - real(DP), dimension(:), intent(in) :: y0in !! Initial value at t=0 - real(DP), intent(in) :: t1 !! Final time - real(DP), intent(in) :: dt0 !! Initial step size guess - real(DP), intent(in) :: tol !! Tolerance on solution - real(DP), dimension(:), allocatable :: y1 !! Final result - end function swiftest_util_solve_rkf45 - end interface - interface swiftest_util_sort pure module subroutine swiftest_util_sort_i4b(arr) implicit none @@ -1822,8 +1779,8 @@ module subroutine swiftest_util_spill_arr_kin(keeps, discards, lspill_list, ldes implicit none type(swiftest_kinship), dimension(:), allocatable, intent(inout) :: keeps !! Array of values to keep type(swiftest_kinship), dimension(:), allocatable, intent(inout) :: discards !! Array of discards - logical, dimension(:), intent(in) :: lspill_list !! Logical array of bodies to spill into the discardss - logical, intent(in) :: ldestructive !! Logical flag indicating whether or not this operation should alter the keeps array or not + logical, dimension(:), intent(in) :: lspill_list !! Logical array of bodies to spill into the discardss + logical, intent(in) :: ldestructive !! Logical flag indicating whether or not this operation should alter the keeps array or not end subroutine swiftest_util_spill_arr_kin module subroutine swiftest_util_spill_arr_logical(keeps, discards, lspill_list, ldestructive) diff --git a/src/swiftest/swiftest_setup.f90 b/src/swiftest/swiftest_setup.f90 index f3c604ff8..6a6439a0e 100644 --- a/src/swiftest/swiftest_setup.f90 +++ b/src/swiftest/swiftest_setup.f90 @@ -286,7 +286,7 @@ module subroutine swiftest_setup_pl(self, n, param) !> Call allocation method for parent class !> The parent class here is the abstract swiftest_body class, so we can't use the type-bound procedure - call setup_body(self, n, param) + call swiftest_setup_body(self, n, param) if (n == 0) return allocate(self%mass(n)) @@ -352,7 +352,7 @@ module subroutine swiftest_setup_tp(self, n, param) !> Call allocation method for parent class !> The parent class here is the abstract swiftest_body class, so we can't use the type-bound procedure - call setup_body(self, n, param) + call swiftest_setup_body(self, n, param) if (n == 0) return allocate(self%isperi(n)) diff --git a/src/swiftest/swiftest_util.f90 b/src/swiftest/swiftest_util.f90 index 045215d87..3326f96c8 100644 --- a/src/swiftest/swiftest_util.f90 +++ b/src/swiftest/swiftest_util.f90 @@ -157,6 +157,34 @@ module subroutine swiftest_util_append_arr_info(arr, source, nold, nsrc, lsource end subroutine swiftest_util_append_arr_info + module subroutine swiftest_util_append_arr_kin(arr, source, nold, nsrc, lsource_mask) + !! author: David A. Minton + !! + !! Append a single array of kinship type onto another. If the destination array is not allocated, or is not big enough, this will allocate space for it. + implicit none + ! Arguments + type(swiftest_kinship), dimension(:), allocatable, intent(inout) :: arr !! Destination array + type(swiftest_kinship), dimension(:), allocatable, intent(in) :: source !! Array to append + integer(I4B), intent(in) :: nold, nsrc !! Extend of the old array and the source array, respectively + logical, dimension(:), intent(in) :: lsource_mask !! Logical mask indicating which elements to append to + ! Internals + integer(I4B) :: nnew + + if (.not. allocated(source)) return + + nnew = count(lsource_mask(1:nsrc)) + if (.not.allocated(arr)) then + allocate(arr(nold+nnew)) + else + call util_resize(arr, nold + nnew) + end if + + arr(nold + 1:nold + nnew) = pack(source(1:nsrc), lsource_mask(1:nsrc)) + + return + end subroutine swiftest_util_append_arr_kin + + module subroutine swiftest_util_append_arr_logical(arr, source, nold, nsrc, lsource_mask) !! author: David A. Minton !! @@ -851,6 +879,7 @@ module subroutine swiftest_util_fill_arr_DP(keeps, inserts, lfill_list) return end subroutine swiftest_util_fill_arr_DP + module subroutine swiftest_util_fill_arr_DPvec(keeps, inserts, lfill_list) !! author: David A. Minton !! @@ -874,6 +903,7 @@ module subroutine swiftest_util_fill_arr_DPvec(keeps, inserts, lfill_list) return end subroutine swiftest_util_fill_arr_DPvec + module subroutine swiftest_util_fill_arr_I4B(keeps, inserts, lfill_list) !! author: David A. Minton !! @@ -942,6 +972,26 @@ module subroutine swiftest_util_fill_arr_logical(keeps, inserts, lfill_list) end subroutine swiftest_util_fill_arr_logical + module subroutine swiftest_util_fill_arr_kin(keeps, inserts, lfill_list) + !! author: David A. Minton + !! + !! Performs a fill operation on a single array of particle kinship types + !! This is the inverse of a spill operation + implicit none + ! Arguments + type(swiftest_kinship), dimension(:), allocatable, intent(inout) :: keeps !! Array of values to keep + type(swiftest_kinship), dimension(:), allocatable, intent(in) :: inserts !! Array of values to insert into keep + logical, dimension(:), intent(in) :: lfill_list !! Logical array of bodies to merge into the keeps + + if (.not.allocated(keeps) .or. .not.allocated(inserts)) return + + keeps(:) = unpack(keeps(:), .not.lfill_list(:), keeps(:)) + keeps(:) = unpack(inserts(:), lfill_list(:), keeps(:)) + + return + end subroutine swiftest_util_fill_arr_kin + + module subroutine swiftest_util_fill_body(self, inserts, lfill_list) !! author: David A. Minton !! @@ -1588,587 +1638,6 @@ module subroutine swiftest_util_index_map_storage(self) return end subroutine swiftest_util_index_map_storage - module subroutine swiftest_util_minimize_bfgs(f, N, x0, eps, maxloop, lerr, x1) - !! author: David A. Minton - !! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - !! This function implements the Broyden-Fletcher-Goldfarb-Shanno method to determine the minimum of a function of N variables. - !! It recieves as input: - !! f%eval(x) : lambda function object containing the objective function as the eval metho - !! N : Number of variables of function f - !! x0 : Initial starting value of x - !! eps : Accuracy of 1 - dimensional minimization at each step - !! maxloop : Maximum number of loops to attempt to find a solution - !! The outputs include - !! lerr : Returns .true. if it could not find the minimum - !! Returns - !! x1 : Final minimum (all 0 if none found) - !! 0 = No miniumum found - !! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - use, intrinsic :: ieee_exceptions - implicit none - ! Arguments - integer(I4B), intent(in) :: N - class(lambda_obj), intent(inout) :: f - real(DP), dimension(:), intent(in) :: x0 - real(DP), intent(in) :: eps - integer(I4B), intent(in) :: maxloop - logical, intent(out) :: lerr - ! Result - real(DP), dimension(:), intent(out), allocatable :: x1 - ! Internals - integer(I4B) :: i, j, k, l, conv - real(DP), parameter :: graddelta = 1e-4_DP !! Delta x for gradient calculations - real(DP), dimension(N) :: S !! Direction vectors - real(DP), dimension(N,N) :: H !! Approximated inverse Hessian matrix - real(DP), dimension(N) :: grad1 !! gradient of f - real(DP), dimension(N) :: grad0 !! old value of gradient - real(DP) :: astar !! 1D minimized value - real(DP), dimension(N) :: y, P - real(DP), dimension(N,N) :: PP, PyH, HyP - real(DP), save :: yHy, Py - type(ieee_status_type) :: original_fpe_status - logical, dimension(:), allocatable :: fpe_flag - - call ieee_get_status(original_fpe_status) ! Save the original floating point exception status - call ieee_set_flag(ieee_all, .false.) ! Set all flags to quiet - allocate(fpe_flag(size(ieee_usual))) - - lerr = .false. - allocate(x1, source=x0) - ! Initialize approximate Hessian with the identity matrix (i.e. begin with method of steepest descent) - ! Get initial gradient and initialize arrays for updated values of gradient and x - H(:,:) = reshape([((0._DP, i=1, j-1), 1._DP, (0._DP, i=j+1, N), j=1, N)], [N,N]) - grad0 = gradf(f, N, x0(:), graddelta, lerr) - if (lerr) then - call ieee_set_status(original_fpe_status) - return - end if - grad1(:) = grad0(:) - do i = 1, maxloop - !check for convergence - conv = count(abs(grad1(:)) > eps) - if (conv == 0) exit - S(:) = -matmul(H(:,:), grad1(:)) - astar = minimize1D(f, x1, S, N, graddelta, lerr) - if (lerr) exit - ! Get new x values - P(:) = astar * S(:) - x1(:) = x1(:) + P(:) - ! Calculate new gradient - grad0(:) = grad1(:) - grad1 = gradf(f, N, x1, graddelta, lerr) - y(:) = grad1(:) - grad0(:) - Py = sum(P(:) * y(:)) - ! set up factors for H matrix update - yHy = 0._DP - !$omp do simd schedule(static)& - !$omp firstprivate(N, y, H) & - !$omp reduction(+:yHy) - do k = 1, N - do j = 1, N - yHy = yHy + y(j) * H(j,k) * y(k) - end do - end do - !$omp end do simd - ! prevent divide by zero (convergence) - if (abs(Py) < tiny(Py)) exit - ! set up update - PyH(:,:) = 0._DP - HyP(:,:) = 0._DP - !$omp parallel do default(private) schedule(static)& - !$omp shared(N, PP, P, y, H) & - !$omp reduction(+:PyH, HyP) - do k = 1, N - do j = 1, N - PP(j, k) = P(j) * P(k) - do l = 1, N - PyH(j, k) = PyH(j, k) + P(j) * y(l) * H(l,k) - HyP(j, k) = HyP(j, k) + P(k) * y(l) * H(j,l) - end do - end do - end do - !$omp end parallel do - ! update H matrix - H(:,:) = H(:,:) + ((1._DP - yHy / Py) * PP(:,:) - PyH(:,:) - HyP(:,:)) / Py - ! Normalize to prevent it from blowing up if it takes many iterations to find a solution - H(:,:) = H(:,:) / norm2(H(:,:)) - ! Stop everything if there are any exceptions to allow the routine to fail gracefully - call ieee_get_flag(ieee_usual, fpe_flag) - if (any(fpe_flag)) exit - if (i == maxloop) then - lerr = .true. - end if - end do - call ieee_get_flag(ieee_usual, fpe_flag) - lerr = lerr .or. any(fpe_flag) - call ieee_set_status(original_fpe_status) - - return - - contains - - function gradf(f, N, x1, dx, lerr) result(grad) - !! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - !! Purpose: Estimates the gradient of a function using a central difference - !! approximation - !! Inputs: - !! f%eval(x) : lambda function object containing the objective function as the eval metho - !! N : number of variables N - !! x1 : x value array - !! dx : step size to use when calculating derivatives - !! Outputs: - !! lerr : .true. if an error occurred. Otherwise returns .false. - !! Returns - !! grad : N sized array containing estimated gradient of f at x1 - !! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - implicit none - ! Arguments - integer(I4B), intent(in) :: N - class(lambda_obj), intent(inout) :: f - real(DP), dimension(:), intent(in) :: x1 - real(DP), intent(in) :: dx - logical, intent(out) :: lerr - ! Result - real(DP), dimension(N) :: grad - ! Internals - integer(I4B) :: i, j - real(DP), dimension(N) :: xp, xm - real(DP) :: fp, fm - logical :: lerrp, lerrm - - do i = 1, N - do j = 1, N - if (j == i) then - xp(j) = x1(j) + dx - xm(j) = x1(j) - dx - else - xp(j) = x1(j) - xm(j) = x1(j) - end if - end do - select type (f) - class is (lambda_obj_err) - fp = f%eval(xp) - lerrp = f%lerr - fm = f%eval(xm) - lerrm = f%lerr - lerr = lerrp .or. lerrm - class is (lambda_obj) - fp = f%eval(xp) - fm = f%eval(xm) - lerr = .false. - end select - grad(i) = (fp - fm) / (2 * dx) - if (lerr) return - end do - return - end function gradf - - - function minimize1D(f, x0, S, N, eps, lerr) result(astar) - !! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - !! This program find the minimum of a function of N variables in a single direction - !! S using in sequence: - !! 1. A Bracketing method - !! 2. The golden section method - !! 3. A quadratic polynomial fit - !! Inputs - !! f%eval(x) : lambda function object containing the objective function as the eval metho - !! x0 : Array of size N of initial x values - !! S : Array of size N that determines the direction of minimization - !! N : Number of variables of function f - !! eps : Accuracy of 1 - dimensional minimization at each step - !! Output - !! lerr : .true. if an error occurred. Otherwise returns .false. - !! Returns - !! astar : Final minimum along direction S - !! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - implicit none - ! Arguments - integer(I4B), intent(in) :: N - class(lambda_obj), intent(inout) :: f - real(DP), dimension(:), intent(in) :: x0, S - real(DP), intent(in) :: eps - logical, intent(out) :: lerr - ! Result - real(DP) :: astar - ! Internals - integer(I4B) :: num = 0 - real(DP), parameter :: step = 0.7_DP !! Bracketing method step size - real(DP), parameter :: gam = 1.2_DP !! Bracketing method expansion parameter - real(DP), parameter :: greduce = 0.2_DP !! Golden section method reduction factor - real(DP), parameter :: greduce2 = 0.1_DP ! Secondary golden section method reduction factor - real(DP) :: alo, ahi !! High and low values for 1 - D minimization routines - real(DP), parameter :: a0 = epsilon(1.0_DP) !! Initial guess of alpha - - alo = a0 - call bracket(f, x0, S, N, gam, step, alo, ahi, lerr) - if (lerr) then - !write(*,*) "BFGS bracketing step failed!" - !write(*,*) "alo: ",alo, "ahi: ", ahi - return - end if - if (abs(alo - ahi) < eps) then - astar = alo - lerr = .false. - return - end if - call golden(f, x0, S, N, greduce, alo, ahi, lerr) - if (lerr) then - !write(*,*) "BFGS golden section step failed!" - return - end if - if (abs(alo - ahi) < eps) then - astar = alo - lerr = .false. - return - end if - call quadfit(f, x0, S, N, eps, alo, ahi, lerr) - if (lerr) then - !write(*,*) "BFGS quadfit failed!" - return - end if - if (abs(alo - ahi) < eps) then - astar = alo - lerr = .false. - return - end if - ! Quadratic fit method won't converge, so finish off with another golden section - call golden(f, x0, S, N, greduce2, alo, ahi, lerr) - if (.not. lerr) astar = (alo + ahi) / 2.0_DP - return - end function minimize1D - - - function n2one(f, x0, S, N, a, lerr) result(fnew) - implicit none - ! Arguments - integer(I4B), intent(in) :: N - class(lambda_obj), intent(inout) :: f - real(DP), dimension(:), intent(in) :: x0, S - real(DP), intent(in) :: a - logical, intent(out) :: lerr - - ! Return - real(DP) :: fnew - ! Internals - real(DP), dimension(N) :: xnew - integer(I4B) :: i - - xnew(:) = x0(:) + a * S(:) - fnew = f%eval(xnew(:)) - select type(f) - class is (lambda_obj_err) - lerr = f%lerr - class is (lambda_obj) - lerr = .false. - end select - return - end function n2one - - ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - subroutine swiftest_bracket(f, x0, S, N, gam, step, lo, hi, lerr) - ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - !! This subroutine swiftest_brackets the minimum. It recieves as input: - !! f%eval(x) : lambda function object containing the objective function as the eval metho - !! x0 : Array of size N of initial x values - !! S : Array of size N that determines the direction of minimization - !! gam : expansion parameter - !! step : step size - !! lo : initial guess of lo bracket value - !! The outputs include - !! lo : lo bracket - !! hi : hi bracket - !! lerr : .true. if an error occurred. Otherwise returns .false. - !! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - implicit none - ! Arguments - integer(I4B), intent(in) :: N - class(lambda_obj), intent(inout) :: f - real(DP), dimension(:), intent(in) :: x0, S - real(DP), intent(in) :: gam, step - real(DP), intent(inout) :: lo - real(DP), intent(out) :: hi - logical, intent(out) :: lerr - ! Internals - real(DP) :: a0, a1, a2, atmp, da - real(DP) :: f0, f1, f2 - integer(I4B) :: i, j - integer(I4B), parameter :: MAXLOOP = 100 ! maximum number of loops before method is determined to have failed - real(DP), parameter :: eps = epsilon(lo) ! small number precision to test floating point equality - - ! set up initial bracket points - a0 = lo - da = step - a1 = a0 + da - a2 = a0 + 2 * da - f0 = n2one(f, x0, S, N, a0, lerr) - if (lerr) return - f1 = n2one(f, x0, S, N, a1, lerr) - if (lerr) return - f2 = n2one(f, x0, S, N, a2, lerr) - if (lerr) return - ! loop over bracket method until either min is bracketed method fails - do i = 1, MAXLOOP - if ((f0 > f1) .and. (f1 < f2)) then ! Minimum was found - lo = a0 - hi = a2 - return - else if ((f0 >= f1) .and. (f1 > f2)) then ! Function appears to decrease - da = da * gam - atmp = a2 + da - a0 = a1 - a1 = a2 - a2 = atmp - f0 = f1 - f1 = f2 - f2 = n2one(f, x0, S, N, a2, lerr) - else if ((f0 < f1) .and. (f1 <= f2)) then ! Function appears to increase - da = da * gam - atmp = a0 - da - a2 = a1 - a1 = a0 - a0 = atmp - f2 = f1 - f0 = n2one(f, x0, S, N, a0, lerr) - else if ((f0 < f1) .and. (f1 > f2)) then ! We are at a peak. Pick the direction that descends the fastest - da = da * gam - if (f2 > f0) then ! LHS is lower than RHS - atmp = a2 + da - a0 = a1 - a1 = a2 - a2 = atmp - f0 = f1 - f1 = f2 - f2 = n2one(f, x0, S, N, a2, lerr) - else ! RHS is lower than LHS - atmp = a0 - da - a2 = a1 - a1 = a0 - a0 = atmp - f2 = f1 - f1 = f2 - f0 = n2one(f, x0, S, N, a0, lerr) - end if - else if ((f0 > f1) .and. (abs(f2 - f1) <= eps)) then ! Decrasging but RHS equal - da = da * gam - atmp = a2 + da - a2 = atmp - f2 = n2one(f, x0, S, N, a2, lerr) - else if ((abs(f0 - f1) < eps) .and. (f1 < f2)) then ! Increasing but LHS equal - da = da * gam - atmp = a0 - da - a0 = atmp - f0 = n2one(f, x0, S, N, a0, lerr) - else ! all values equal. Expand in either direction and try again - a0 = a0 - da - a2 = a2 + da - f0 = n2one(f, x0, S, N, a0, lerr) - if (lerr) exit ! An error occurred while evaluating the function - f2 = n2one(f, x0, S, N, a2, lerr) - end if - if (lerr) exit ! An error occurred while evaluating the function - end do - lerr = .true. - return ! no minimum found - end subroutine swiftest_bracket - - ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - subroutine swiftest_golden(f, x0, S, N, eps, lo, hi, lerr) - ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - !! This function uses the golden section method to reduce the starting interval lo, hi by some amount sigma. - !! It recieves as input: - !! f%eval(x) : lambda function object containing the objective function as the eval metho - !! x0 : Array of size N of initial x values - !! S : Array of size N that determines the direction of minimization - !! gam : expansion parameter - !! eps : reduction interval in range (0 < sigma < 1) such that: - !! hi(new) - lo(new) = eps * (hi(old) - lo(old)) - !! lo : initial guess of lo bracket value - !! The outputs include - !! lo : lo bracket - !! hi : hi bracket - !! lerr : .true. if an error occurred. Otherwise returns .false. - !! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - implicit none - ! Arguments - integer(I4B), intent(in) :: N - class(lambda_obj), intent(inout) :: f - real(DP), dimension(:), intent(in) :: x0, S - real(DP), intent(in) :: eps - real(DP), intent(inout) :: lo - real(DP), intent(out) :: hi - logical, intent(out) :: lerr - ! Internals - real(DP), parameter :: tau = 0.5_DP * (sqrt(5.0_DP) - 1.0_DP) ! Golden section constant - integer(I4B), parameter :: MAXLOOP = 40 ! maximum number of loops before method is determined to have failed (unlikely, but could occur if no minimum exists between lo and hi) - real(DP) :: i0 ! Initial interval value - real(DP) :: a1, a2 - real(DP) :: f1, f2 - integer(I4B) :: i, j - - i0 = hi - lo - a1 = hi - tau * i0 - a2 = lo + tau * i0 - f1 = n2one(f, x0, S, N, a1, lerr) - if (lerr) return - f2 = n2one(f, x0, S, N, a2, lerr) - if (lerr) return - do i = 1, MAXLOOP - if (abs((hi - lo) / i0) <= eps) return ! interval reduced to input amount - if (f2 > f1) then - hi = a2 - a2 = a1 - f2 = f1 - a1 = hi - tau * (hi - lo) - f1 = n2one(f, x0, S, N, a1, lerr) - else - lo = a1 - a1 = a2 - f2 = f1 - a2 = hi - (1.0_DP - tau) * (hi - lo) - f2 = n2one(f, x0, S, N, a2, lerr) - end if - if (lerr) exit - end do - lerr = .true. - return ! search took too many iterations - no minimum found - end subroutine swiftest_golden - - ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - subroutine swiftest_quadfit(f, x0, S, N, eps, lo, hi, lerr) - ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - !! This function uses a quadratic polynomial fit to locate the minimum of a function - !! to some accuracy eps. It recieves as input: - !! f%eval(x) : lambda function object containing the objective function as the eval metho - !! lo : low bracket value - !! hi : high bracket value - !! eps : desired accuracy of final minimum location - !! The outputs include - !! lo : final minimum location - !! hi : final minimum location - !! Notes: Uses the ieee_exceptions intrinsic module to allow for graceful failure due to floating point exceptions, which won't terminate the run. - !! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - implicit none - ! Arguments - integer(I4B), intent(in) :: N - class(lambda_obj), intent(inout) :: f - real(DP), dimension(:), intent(in) :: x0, S - real(DP), intent(in) :: eps - real(DP), intent(inout) :: lo - real(DP), intent(out) :: hi - logical, intent(out) :: lerr - ! Internals - integer(I4B), parameter :: MAXLOOP = 20 ! maximum number of loops before method is determined to have failed. - real(DP) :: a1, a2, a3, astar ! three points for the polynomial fit and polynomial minimum - real(DP) :: f1, f2, f3, fstar ! three function values for the polynomial and polynomial minimum - real(DP), dimension(3) :: row_1, row_2, row_3, rhs, soln ! matrix for 3 equation solver (gaussian elimination) - real(DP), dimension(3,3) :: lhs - real(DP) :: d1, d2, d3, aold, denom, errval - integer(I4B) :: i - - lerr = .false. - ! Get initial a1, a2, a3 values - a1 = lo - a2 = lo + 0.5_DP * (hi - lo) - a3 = hi - aold = a1 - astar = a2 - f1 = n2one(f, x0, S, N, a1, lerr) - if (lerr) return - f2 = n2one(f, x0, S, N, a2, lerr) - if (lerr) return - f3 = n2one(f, x0, S, N, a3, lerr) - if (lerr) return - do i = 1, MAXLOOP - ! check to see if convergence is reached and exit - errval = abs((astar - aold) / astar) - call ieee_get_flag(ieee_usual, fpe_flag) - if (any(fpe_flag)) then - !write(*,*) 'quadfit fpe' - !write(*,*) 'aold : ',aold - !write(*,*) 'astar: ',astar - lerr = .true. - exit - end if - if (errval < eps) then - lo = astar - hi = astar - exit - end if - ! Set up system for gaussian elimination equation solver - row_1 = [1.0_DP, a1, a1**2] - row_2 = [1.0_DP, a2, a2**2] - row_3 = [1.0_DP, a3, a3**2] - rhs = [f1, f2, f3] - lhs(1, :) = row_1 - lhs(2, :) = row_2 - lhs(3, :) = row_3 - ! Solve system of equations - soln(:) = swiftest_util_solve_linear_system(lhs, rhs, 3, lerr) - call ieee_set_flag(ieee_all, .false.) ! Set all flags back to quiet - call ieee_set_halting_mode(ieee_divide_by_zero, .false.) - if (lerr) then - !write(*,*) 'quadfit fpe:' - !write(*,*) 'util_solve_linear_system failed' - exit - end if - aold = astar - if (soln(2) == soln(3)) then ! Handles the case where they are both 0. 0/0 is an unhandled exception - astar = -0.5_DP - else - astar = -soln(2) / (2 * soln(3)) - end if - call ieee_get_flag(ieee_usual, fpe_flag) - if (any(fpe_flag)) then - !write(*,*) 'quadfit fpe' - !write(*,*) 'soln(2:3): ',soln(2:3) - !write(*,*) 'a1, a2, a3' - !write(*,*) a1, a2, a3 - !write(*,*) 'f1, f2, f3' - !write(*,*) f1, f2, f3 - lerr = .true. - exit - end if - fstar = n2one(f, x0, S, N, astar, lerr) - if (lerr) exit - ! keep the three closest a values to astar and discard the fourth - d1 = abs(a1 - astar) - d2 = abs(a2 - astar) - d3 = abs(a3 - astar) - - if (d1 > d2) then - if (d1 > d3) then - f1 = fstar - a1 = astar - else if (d3 > d2) then - f3 = fstar - a3 = astar - end if - else - if (d2 > d3) then - f2 = fstar - a2 = astar - else if (d3 > d1) then - f3 = fstar - a3 = astar - end if - end if - end do - if (lerr) return - lo = a1 - hi = a3 - return - end subroutine swiftest_quadfit - - end subroutine swiftest_util_minimize_bfgs - subroutine swiftest_util_peri(n,m, r, v, atp, q, isperi) !! author: David A. Minton !! @@ -2729,6 +2198,43 @@ module subroutine swiftest_util_resize_arr_info(arr, nnew) return end subroutine swiftest_util_resize_arr_info + + module subroutine swiftest_util_resize_arr_kin(arr, nnew) + !! author: David A. Minton + !! + !! Resizes an array component of type character string. Array will only be resized if has previously been allocated. Passing nnew = 0 will deallocate. + implicit none + ! Arguments + type(swiftest_kinship), dimension(:), allocatable, intent(inout) :: arr !! Array to resize + integer(I4B), intent(in) :: nnew !! New size + ! Internals + type(swiftest_kinship), dimension(:), allocatable :: tmp !! Temporary storage array in case the input array is already allocated + integer(I4B) :: nold !! Old size + + if (nnew < 0) return + + if (nnew == 0) then + if (allocated(arr)) deallocate(arr) + return + end if + + if (allocated(arr)) then + nold = size(arr) + else + nold = 0 + end if + + allocate(tmp(nnew)) + if (nnew > nold) then + tmp(1:nold) = arr(1:nold) + else + tmp(1:nnew) = arr(1:nnew) + end if + call move_alloc(tmp, arr) + + return + end subroutine swiftest_util_resize_arr_kin + module subroutine swiftest_util_resize_arr_logical(arr, nnew) !! author: David A. Minton @@ -3131,234 +2637,6 @@ module subroutine swiftest_util_snapshot_system(self, param, system, t, arg) end subroutine swiftest_util_snapshot_system - module function swiftest_util_solve_linear_system_d(A,b,n,lerr) result(x) - !! Author: David A. Minton - !! - !! Solves the linear equation of the form A*x = b for x. - !! A is an (n,n) arrays - !! x and b are (n) arrays - !! Uses Gaussian elimination, so will have issues if system is ill-conditioned. - !! Uses quad precision intermidiate values, so works best on small arrays. - use, intrinsic :: ieee_exceptions - implicit none - ! Arguments - integer(I4B), intent(in) :: n - real(DP), dimension(:,:), intent(in) :: A - real(DP), dimension(:), intent(in) :: b - logical, intent(out) :: lerr - ! Result - real(DP), dimension(n) :: x - ! Internals - real(QP), dimension(:), allocatable :: qx - type(ieee_status_type) :: original_fpe_status - logical, dimension(:), allocatable :: fpe_flag - - call ieee_get_status(original_fpe_status) ! Save the original floating point exception status - call ieee_set_flag(ieee_all, .false.) ! Set all flags to quiet - allocate(fpe_flag(size(ieee_usual))) - - qx = solve_wbs(ge_wpp(real(A, kind=QP), real(b, kind=QP))) - - call ieee_get_flag(ieee_usual, fpe_flag) - lerr = any(fpe_flag) - if (lerr .or. (any(abs(qx) > huge(x))) .or. (any(abs(qx) < tiny(x)))) then - x = 0.0_DP - else - x = real(qx, kind=DP) - end if - call ieee_set_status(original_fpe_status) - - return - end function swiftest_util_solve_linear_system_d - - - module function swiftest_util_solve_linear_system_q(A,b,n,lerr) result(x) - !! Author: David A. Minton - !! - !! Solves the linear equation of the form A*x = b for x. - !! A is an (n,n) arrays - !! x and b are (n) arrays - !! Uses Gaussian elimination, so will have issues if system is ill-conditioned. - !! Uses quad precision intermidiate values, so works best on small arrays. - use, intrinsic :: ieee_exceptions - implicit none - ! Arguments - integer(I4B), intent(in) :: n - real(QP), dimension(:,:), intent(in) :: A - real(QP), dimension(:), intent(in) :: b - logical, intent(out) :: lerr - ! Result - real(QP), dimension(n) :: x - ! Internals - type(ieee_status_type) :: original_fpe_status - logical, dimension(:), allocatable :: fpe_flag - - call ieee_get_status(original_fpe_status) ! Save the original floating point exception status - call ieee_set_flag(ieee_all, .false.) ! Set all flags to quiet - allocate(fpe_flag(size(ieee_usual))) - - x = solve_wbs(ge_wpp(A, b)) - - call ieee_get_flag(ieee_usual, fpe_flag) - lerr = any(fpe_flag) - if (lerr) x = 0.0_DP - call ieee_set_status(original_fpe_status) - - return - end function swiftest_util_solve_linear_system_q - - function solve_wbs(u) result(x) ! solve with backward substitution - !! Based on code available on Rosetta Code: https://rosettacode.org/wiki/Gaussian_elimination#Fortran - use, intrinsic :: ieee_exceptions - use swiftest - implicit none - ! Arguments - real(QP), intent(in), dimension(:,:), allocatable :: u - ! Result - real(QP), dimension(:), allocatable :: x - ! Internals - integer(I4B) :: i,n - - n = size(u, 1) - if (allocated(x)) deallocate(x) - if (.not.allocated(x)) allocate(x(n)) - if (any(abs(u) < tiny(1._DP)) .or. any(abs(u) > huge(1._DP))) then - x(:) = 0._DP - return - end if - call ieee_set_halting_mode(ieee_divide_by_zero, .false.) - do i = n, 1, -1 - x(i) = (u(i, n + 1) - sum(u(i, i + 1:n) * x(i + 1:n))) / u(i, i) - end do - return - end function solve_wbs - - - function ge_wpp(A, b) result(u) ! gaussian eliminate with partial pivoting - !! Solve Ax=b using Gaussian elimination then backwards substitution. - !! A being an n by n matrix. - !! x and b are n by 1 vectors. - !! Based on code available on Rosetta Code: https://rosettacode.org/wiki/Gaussian_elimination#Fortran - use, intrinsic :: ieee_exceptions - use swiftest - implicit none - ! Arguments - real(QP), dimension(:,:), intent(in) :: A - real(QP), dimension(:), intent(in) :: b - ! Result - real(QP), dimension(:,:), allocatable :: u - ! Internals - integer(I4B) :: i,j,n,p - real(QP) :: upi - - n = size(a, 1) - allocate(u(n, (n + 1))) - u = reshape([A, b], [n, n + 1]) - call ieee_set_halting_mode(ieee_divide_by_zero, .false.) - do j = 1, n - p = maxloc(abs(u(j:n, j)), 1) + j - 1 ! maxloc returns indices between (1, n - j + 1) - if (p /= j) u([p, j], j) = u([j, p], j) - u(j + 1:, j) = u(j + 1:, j) / u(j, j) - do i = j + 1, n + 1 - upi = u(p, i) - if (p /= j) u([p, j], i) = u([j, p], i) - u(j + 1:n, i) = u(j + 1:n, i) - upi * u(j + 1:n, j) - end do - end do - return - end function ge_wpp - - - module function swiftest_util_solve_rkf45(f, y0in, t1, dt0, tol) result(y1) - !! author: David A. Minton - !! - !! Implements the 4th order Runge-Kutta-Fehlberg ODE solver for initial value problems of the form f=dy/dt, y0 = y(t=0), solving for y1 = y(t=t1). Uses a 5th order adaptive step size control. - !! Uses a lambda function object as defined in the lambda_function module - implicit none - ! Arguments - class(lambda_obj), intent(inout) :: f !! lambda function object that has been initialized to be a function of derivatives. The object will return with components lastarg and lasteval set - real(DP), dimension(:), intent(in) :: y0in !! Initial value at t=0 - real(DP), intent(in) :: t1 !! Final time - real(DP), intent(in) :: dt0 !! Initial step size guess - real(DP), intent(in) :: tol !! Tolerance on solution - ! Result - real(DP), dimension(:), allocatable :: y1 !! Final result - ! Internals - integer(I4B), parameter :: MAXREDUX = 1000 !! Maximum number of times step size can be reduced - real(DP), parameter :: DTFAC = 0.95_DP !! Step size reduction safety factor (Value just under 1.0 to prevent adaptive step size control from discarding steps too aggressively) - integer(I4B), parameter :: RKS = 6 !! Number of RK stages - real(DP), dimension(RKS, RKS - 1), parameter :: rkf45_btab = reshape( & !! Butcher tableau for Runge-Kutta-Fehlberg method - (/ 1./4., 1./4., 0., 0., 0., 0.,& - 3./8., 3./32., 9./32., 0., 0., 0.,& - 12./13., 1932./2197., -7200./2197., 7296./2197., 0., 0.,& - 1., 439./216., -8., 3680./513., -845./4104., 0.,& - 1./2., -8./27., 2., -3544./2565., 1859./4104., -11./40./), shape(rkf45_btab)) - real(DP), dimension(RKS), parameter :: rkf4_coeff = (/ 25./216., 0., 1408./2565. , 2197./4104. , -1./5., 0. /) - real(DP), dimension(RKS), parameter :: rkf5_coeff = (/ 16./135., 0., 6656./12825., 28561./56430., -9./50., 2./55. /) - real(DP), dimension(:, :), allocatable :: k !! Runge-Kutta coefficient vector - real(DP), dimension(:), allocatable :: ynorm !! Normalized y value used for adaptive step size control - real(DP), dimension(:), allocatable :: y0 !! Value of y at the beginning of each substep - integer(I4B) :: Nvar !! Number of variables in problem - integer(I4B) :: rkn !! Runge-Kutta loop index - real(DP) :: t, x1, dt, trem !! Current time, step size and total time remaining - real(DP) :: s, yerr, yscale !! Step size reduction factor, error in dependent variable, and error scale factor - integer(I4B) :: i - - allocate(y0, source=y0in) - allocate(y1, mold=y0) - allocate(ynorm, mold=y0) - Nvar = size(y0) - allocate(k(Nvar, RKS)) - - dt = dt0 - - trem = t1 - t = 0._DP - do - yscale = norm2(y0(:)) - do i = 1, MAXREDUX - select type(f) - class is (lambda_obj_tvar) - do rkn = 1, RKS - y1(:) = y0(:) + matmul(k(:, 1:rkn - 1), rkf45_btab(2:rkn, rkn - 1)) - if (rkn == 1) then - x1 = t - else - x1 = t + rkf45_btab(1,rkn-1) - end if - k(:, rkn) = dt * f%evalt(y1(:), t) - end do - class is (lambda_obj) - do rkn = 1, RKS - y1(:) = y0(:) + matmul(k(:, 1:rkn - 1), rkf45_btab(2:rkn, rkn - 1)) - k(:, rkn) = dt * f%eval(y1(:)) - end do - end select - ! Now determine if the step size needs adjusting - ynorm(:) = matmul(k(:,:), (rkf5_coeff(:) - rkf4_coeff(:))) / yscale - yerr = norm2(ynorm(:)) - s = (tol / (2 * yerr))**(0.25_DP) - dt = min(s * DTFAC * dt, trem) ! Alter step size either up or down, but never bigger than the remaining time - if (s >= 1.0_DP) exit ! Good step! - if (i == MAXREDUX) then - write(*,*) "Something has gone wrong in util_solve_rkf45!! Step size reduction has gone too far this time!" - call swiftest_util_exit(FAILURE) - end if - end do - - ! Compute new value then step ahead in time - y1(:) = y0(:) + matmul(k(:, :), rkf4_coeff(:)) - trem = trem - dt - t = t + dt - if (trem <= 0._DP) exit - y0(:) = y1(:) - end do - - return - end function swiftest_util_solve_rkf45 - - - module subroutine swiftest_util_sort_body(self, sortby, ascending) !! author: David A. Minton !! @@ -4240,36 +3518,65 @@ pure module subroutine swiftest_util_sort_rearrange_arr_I4B_I8Bind(arr, ind, n) end subroutine swiftest_util_sort_rearrange_arr_I4B_I8Bind - pure module subroutine swiftest_util_sort_rearrange_arr_logical(arr, ind, n) + module subroutine swiftest_util_sort_rearrange_arr_info(arr, ind, n) !! author: David A. Minton !! - !! Rearrange a single array of logicals in-place from an index list. + !! Rearrange a single array of particle information type in-place from an index list. implicit none ! Arguments - logical, dimension(:), allocatable, intent(inout) :: arr !! Destination array - integer(I4B), dimension(:), intent(in) :: ind !! Index to rearrange against - integer(I4B), intent(in) :: n !! Number of elements in arr and ind to rearrange + type(swiftest_particle_info), dimension(:), allocatable, intent(inout) :: arr !! Destination array + integer(I4B), dimension(:), intent(in) :: ind !! Index to rearrange against + integer(I4B), intent(in) :: n !! Number of elements in arr and ind to rearrange ! Internals - logical, dimension(:), allocatable :: tmp !! Temporary copy of array used during rearrange operation + type(swiftest_particle_info), dimension(:), allocatable :: tmp !! Temporary copy of array used during rearrange operation if (.not. allocated(arr) .or. n <= 0) return allocate(tmp, mold=arr) - tmp(1:n) = arr(ind) + + call swiftest_util_copy_particle_info_arr(arr, tmp, ind) call move_alloc(tmp, arr) return - end subroutine swiftest_util_sort_rearrange_arr_logical + end subroutine swiftest_util_sort_rearrange_arr_info - pure module subroutine swiftest_util_sort_rearrange_arr_logical_I8Bind(arr, ind, n) + pure module subroutine swiftest_util_sort_rearrange_arr_kin(arr, ind, n) + !! author: David A. Minton + !! + !! Rearrange a single array of particle kinship type in-place from an index list. + implicit none + ! Arguments + type(swiftest_kinship), dimension(:), allocatable, intent(inout) :: arr !! Destination array + integer(I4B), dimension(:), intent(in) :: ind !! Index to rearrange against + integer(I4B), intent(in) :: n !! Number of elements in arr and ind to rearrange + ! Internals + type(swiftest_kinship), dimension(:), allocatable :: tmp !! Temporary copy of array used during rearrange operation + integer(I4B) :: i,j + + if (.not. allocated(arr) .or. n <= 0) return + allocate(tmp, source=arr) + tmp(1:n) = arr(ind(1:n)) + + do i = 1, n + do j = 1, tmp(i)%nchild + tmp(i)%child(j) = ind(tmp(i)%child(j)) + end do + end do + + call move_alloc(tmp, arr) + return + end subroutine swiftest_util_sort_rearrange_arr_kin + + + pure module subroutine swiftest_util_sort_rearrange_arr_logical(arr, ind, n) !! author: David A. Minton !! !! Rearrange a single array of logicals in-place from an index list. implicit none ! Arguments logical, dimension(:), allocatable, intent(inout) :: arr !! Destination array - integer(I8B), dimension(:), intent(in) :: ind !! Index to rearrange against - integer(I8B), intent(in) :: n !! Number of elements in arr and ind to rearrange + integer(I4B), dimension(:), intent(in) :: ind !! Index to rearrange against + integer(I4B), intent(in) :: n !! Number of elements in arr and ind to rearrange ! Internals logical, dimension(:), allocatable :: tmp !! Temporary copy of array used during rearrange operation @@ -4279,29 +3586,28 @@ pure module subroutine swiftest_util_sort_rearrange_arr_logical_I8Bind(arr, ind, call move_alloc(tmp, arr) return - end subroutine swiftest_util_sort_rearrange_arr_logical_I8Bind + end subroutine swiftest_util_sort_rearrange_arr_logical - module subroutine swiftest_util_sort_rearrange_arr_info(arr, ind, n) + pure module subroutine swiftest_util_sort_rearrange_arr_logical_I8Bind(arr, ind, n) !! author: David A. Minton !! - !! Rearrange a single array of particle information type in-place from an index list. + !! Rearrange a single array of logicals in-place from an index list. implicit none ! Arguments - type(swiftest_particle_info), dimension(:), allocatable, intent(inout) :: arr !! Destination array - integer(I4B), dimension(:), intent(in) :: ind !! Index to rearrange against - integer(I4B), intent(in) :: n !! Number of elements in arr and ind to rearrange + logical, dimension(:), allocatable, intent(inout) :: arr !! Destination array + integer(I8B), dimension(:), intent(in) :: ind !! Index to rearrange against + integer(I8B), intent(in) :: n !! Number of elements in arr and ind to rearrange ! Internals - type(swiftest_particle_info), dimension(:), allocatable :: tmp !! Temporary copy of array used during rearrange operation + logical, dimension(:), allocatable :: tmp !! Temporary copy of array used during rearrange operation if (.not. allocated(arr) .or. n <= 0) return allocate(tmp, mold=arr) - - call swiftest_util_copy_particle_info_arr(arr, tmp, ind) + tmp(1:n) = arr(ind) call move_alloc(tmp, arr) return - end subroutine swiftest_util_sort_rearrange_arr_info + end subroutine swiftest_util_sort_rearrange_arr_logical_I8Bind module subroutine swiftest_util_sort_rearrange_pl(self, ind) @@ -4625,6 +3931,48 @@ module subroutine swiftest_util_spill_arr_info(keeps, discards, lspill_list, lde end subroutine swiftest_util_spill_arr_info + module subroutine swiftest_util_spill_arr_kin(keeps, discards, lspill_list, ldestructive) + !! author: David A. Minton + !! + !! Performs a spill operation on a single array of particle kinships + !! This is the inverse of a spill operation + implicit none + ! Arguments + type(swiftest_kinship), dimension(:), allocatable, intent(inout) :: keeps !! Array of values to keep + type(swiftest_kinship), dimension(:), allocatable, intent(inout) :: discards !! Array of discards + logical, dimension(:), intent(in) :: lspill_list !! Logical array of bodies to spill into the discardss + logical, intent(in) :: ldestructive !! Logical flag indicating whether or not this operation should alter the keeps array or not + ! Internals + integer(I4B) :: nspill, nkeep, nlist + type(swiftest_kinship), dimension(:), allocatable :: tmp + + nkeep = count(.not.lspill_list(:)) + nspill = count(lspill_list(:)) + nlist = size(lspill_list(:)) + + if (.not.allocated(keeps) .or. nspill == 0) return + if (.not.allocated(discards)) then + allocate(discards(nspill)) + else if (size(discards) /= nspill) then + deallocate(discards) + allocate(discards(nspill)) + end if + + discards(:) = pack(keeps(1:nlist), lspill_list(1:nlist)) + if (ldestructive) then + if (nkeep > 0) then + allocate(tmp(nkeep)) + tmp(:) = pack(keeps(1:nlist), .not. lspill_list(1:nlist)) + call move_alloc(tmp, keeps) + else + deallocate(keeps) + end if + end if + + return + end subroutine swiftest_util_spill_arr_kin + + module subroutine swiftest_util_spill_arr_logical(keeps, discards, lspill_list, ldestructive) !! author: David A. Minton !! diff --git a/src/symba/symba_module.f90 b/src/symba/symba_module.f90 index 87359501c..fcd934c1a 100644 --- a/src/symba/symba_module.f90 +++ b/src/symba/symba_module.f90 @@ -44,7 +44,6 @@ module symba procedure :: append => symba_util_append_pl !! Appends elements from one structure to another procedure :: dealloc => symba_util_dealloc_pl !! Deallocates all allocatable arrays procedure :: fill => symba_util_fill_pl !! "Fills" bodies from one object into another depending on the results of a mask (uses the UNPACK intrinsic) - procedure :: get_peri => symba_util_peri_pl !! Determine system pericenter passages for massive bodies procedure :: resize => symba_util_resize_pl !! Checks the current size of a SyMBA massive body against the requested size and resizes it if it is too small. procedure :: set_renc_I4B => symba_util_set_renc !! Sets the critical radius for encounter given an input recursion depth procedure :: sort => symba_util_sort_pl !! Sorts body arrays by a sortable componen @@ -372,13 +371,6 @@ module subroutine symba_util_final_tp(self) type(symba_tp), intent(inout) :: self !! SyMBA test particle object end subroutine symba_util_final_tp - module subroutine symba_util_peri_pl(self, system, param) - implicit none - class(symba_pl), intent(inout) :: self !! SyMBA massive body object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object - class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters - end subroutine symba_util_peri_pl - end interface interface diff --git a/src/symba/symba_setup.f90 b/src/symba/symba_setup.f90 index 0431da5ef..f6207ac90 100644 --- a/src/symba/symba_setup.f90 +++ b/src/symba/symba_setup.f90 @@ -48,8 +48,8 @@ module subroutine symba_setup_pl(self, n, param) ! Internals integer(I4B) :: i - !> Call allocation method for parent class. In this case, helio_pl does not have its own setup method so we use the base method for swiftest_pl - call setup_pl(self, n, param) + !> Call allocation method for parent class. + call self%helio_pl%setup(n, param) if (n == 0) return allocate(self%levelg(n)) @@ -82,8 +82,8 @@ module subroutine symba_setup_tp(self, n, param) integer(I4B), intent(in) :: n !! Number of particles to allocate space for class(swiftest_parameters), intent(in) :: param !! Current run configuration parameter - !> Call allocation method for parent class. In this case, helio_tp does not have its own setup method so we use the base method for swiftest_tp - call setup_tp(self, n, param) + !> Call allocation method for parent class. + call self%helio_tp%setup(n, param) if (n == 0) return allocate(self%levelg(n)) diff --git a/src/whm/whm_setup.f90 b/src/whm/whm_setup.f90 index c6be76904..6a150d7b9 100644 --- a/src/whm/whm_setup.f90 +++ b/src/whm/whm_setup.f90 @@ -24,7 +24,7 @@ module subroutine whm_setup_pl(self, n, param) class(swiftest_parameters), intent(in) :: param !! Current run configuration parameter !> Call allocation method for parent class - call setup_pl(self, n, param) + call swiftest_setup_pl(self, n, param) if (n == 0) return allocate(self%eta(n)) @@ -79,7 +79,7 @@ module subroutine whm_setup_initialize_system(self, param) class(whm_nbody_system), intent(inout) :: self !! WHM nbody system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - call setup_initialize_system(self, param) + call swiftest_setup_initialize_system(self, param) ! First we need to make sure that the massive bodies are sorted by heliocentric distance before computing jacobies call swiftest_util_set_ir3h(self%pl) call self%pl%sort("ir3h", ascending=.false.) From f62578f41cfc320e083b15d481a981a113f2fb44 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Wed, 21 Dec 2022 13:05:25 -0500 Subject: [PATCH 474/569] More cleanup and rearranging --- src/CMakeLists.txt | 1 - src/base/base_module.f90 | 4 +- src/collision/collision_check.f90 | 27 +++-- src/collision/collision_io.f90 | 126 ++++++++++----------- src/collision/collision_module.f90 | 174 ++++++++++++++++++++++------- src/collision/collision_util.f90 | 76 ------------- src/encounter/encounter_io.f90 | 100 ++++++++--------- src/encounter/encounter_module.f90 | 108 +++++++++++++----- src/encounter/encounter_util.f90 | 50 --------- src/fraggle/fraggle_module.f90 | 52 ++++++--- src/fraggle/fraggle_util.f90 | 30 ----- src/helio/helio_module.f90 | 47 ++++++-- src/helio/helio_util.f90 | 55 --------- src/rmvs/rmvs_module.f90 | 30 ++--- src/rmvs/rmvs_util.f90 | 22 ++-- src/swiftest/swiftest_module.f90 | 85 +++++++++++--- src/swiftest/swiftest_obl.f90 | 4 +- src/swiftest/swiftest_util.f90 | 38 +------ src/symba/symba_module.f90 | 110 +++++++++++++----- src/symba/symba_util.f90 | 83 -------------- src/whm/whm_module.f90 | 66 ++++++++--- src/whm/whm_util.f90 | 42 ------- 22 files changed, 644 insertions(+), 686 deletions(-) delete mode 100644 src/helio/helio_util.f90 diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index 2a2103662..27d4a7bab 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -59,7 +59,6 @@ SET(FAST_MATH_FILES ${SRC}/helio/helio_gr.f90 ${SRC}/helio/helio_setup.f90 ${SRC}/helio/helio_step.f90 - ${SRC}/helio/helio_util.f90 ${SRC}/netcdf_io/netcdf_io_implementations.f90 ${SRC}/operator/operator_cross.f90 ${SRC}/operator/operator_mag.f90 diff --git a/src/base/base_module.f90 b/src/base/base_module.f90 index 7e19be601..dba0e5f68 100644 --- a/src/base/base_module.f90 +++ b/src/base/base_module.f90 @@ -237,7 +237,7 @@ subroutine final_storage_frame(self) end subroutine final_storage_frame - subroutine base_util_final_storage(self) + subroutine base_final_storage(self) !! author: David A. Minton !! !! Finalizer for the storage object @@ -251,7 +251,7 @@ subroutine base_util_final_storage(self) call final_storage_frame(self%frame(i)) end do return - end subroutine base_util_final_storage + end subroutine base_final_storage subroutine reset_storage(self) diff --git a/src/collision/collision_check.f90 b/src/collision/collision_check.f90 index 290773032..772d4a1a7 100644 --- a/src/collision/collision_check.f90 +++ b/src/collision/collision_check.f90 @@ -91,14 +91,12 @@ module subroutine collision_check_plpl(self, system, param, t, dt, irec, lany_co nenc = self%nenc allocate(lmask(nenc)) - ! TODO: Move this to a SyMBA-specific method - ! lmask(:) = ((self%status(1:nenc) == ACTIVE) .and. (pl%levelg(self%index1(1:nenc)) >= irec)) - ! if (isplpl) then - ! lmask(:) = lmask(:) .and. (pl%levelg(self%index2(1:nenc)) >= irec) - ! else - ! lmask(:) = lmask(:) .and. (tp%levelg(self%index2(1:nenc)) >= irec) - ! end if - ! if (.not.any(lmask(:))) return + lmask(:) = (self%status(1:nenc) == ACTIVE) + select type(pl) + class is (symba_pl) + lmask(:) = lmask(:).and. (pl%levelg(self%index1(1:nenc)) >= irec)) + end select + if (.not.any(lmask(:))) return allocate(lcollision(nenc)) lcollision(:) = .false. @@ -195,10 +193,15 @@ module subroutine collision_check_pltp(self, system, param, t, dt, irec, lany_co nenc = self%nenc allocate(lmask(nenc)) - ! TODO: Move this to a SyMBA-specific method - ! lmask(:) = ((self%status(1:nenc) == ACTIVE) .and. (pl%levelg(self%index1(1:nenc)) >= irec)) - ! lmask(:) = lmask(:) .and. (tp%levelg(self%index2(1:nenc)) >= irec) - ! if (.not.any(lmask(:))) return + lmask(:) = (self%status(1:nenc) == ACTIVE) + select type(pl) + class is (symba_pl) + select type(tp) + class is (symba_tp) + lmask(:) = lmask(:) .and. (tp%levelg(self%index2(1:nenc)) >= irec) + end select + end select + if (.not.any(lmask(:))) return allocate(lcollision(nenc)) lcollision(:) = .false. diff --git a/src/collision/collision_io.f90 b/src/collision/collision_io.f90 index 963d86463..c734cb4fa 100644 --- a/src/collision/collision_io.f90 +++ b/src/collision/collision_io.f90 @@ -7,12 +7,12 @@ !! You should have received a copy of the GNU General Public License along with Swiftest. !! If not, see: https://www.gnu.org/licenses. -submodule(collision) s_collision_io +submodule(collision) s_collision_netcdf_io use swiftest contains - module subroutine collision_io_dump(self, param) + module subroutine collision_netcdf_io_dump(self, param) !! author: David A. Minton !! !! Dumps the time history of an encounter to file. @@ -55,9 +55,9 @@ module subroutine collision_io_dump(self, param) end select return - end subroutine collision_io_dump + end subroutine collision_netcdf_io_dump - module subroutine collision_io_initialize_output(self, param) + module subroutine collision_netcdf_io_initialize_output(self, param) !! author: David A. Minton !! !! Initialize a NetCDF fragment history file system. This is a simplified version of the main simulation output NetCDF file, but with fewer variables. @@ -96,93 +96,93 @@ module subroutine collision_io_initialize_output(self, param) close(unit=LUN, status="delete") end if - call netcdf_io_check( nf90_create(nc%file_name, NF90_NETCDF4, nc%id), "collision_io_initialize_output nf90_create" ) + call netcdf_io_check( nf90_create(nc%file_name, NF90_NETCDF4, nc%id), "collision_netcdf_io_initialize_output nf90_create" ) ! Dimensions - call netcdf_io_check( nf90_def_dim(nc%id, nc%event_dimname, nc%event_dimsize, nc%event_dimid), "collision_io_initialize_output nf90_def_dim event_dimid" ) ! Dimension to store individual collision events - call netcdf_io_check( nf90_def_dim(nc%id, nc%space_dimname, NDIM, nc%space_dimid), "collision_io_initialize_output nf90_def_dim space_dimid" ) ! 3D space dimension - call netcdf_io_check( nf90_def_dim(nc%id, nc%name_dimname, nc%name_dimsize, nc%name_dimid), "collision_io_initialize_output nf90_def_dim name_dimid" ) ! Dimension to store particle id numbers - call netcdf_io_check( nf90_def_dim(nc%id, nc%str_dimname, NAMELEN, nc%str_dimid), "collision_io_initialize_output nf90_def_dim str_dimid" ) ! Dimension for string variables (aka character arrays) - call netcdf_io_check( nf90_def_dim(nc%id, nc%stage_dimname, 2, nc%stage_dimid), "collision_io_initialize_output nf90_def_dim stage_dimid" ) ! Dimension for stage variables (aka "before" vs. "after" + call netcdf_io_check( nf90_def_dim(nc%id, nc%event_dimname, nc%event_dimsize, nc%event_dimid), "collision_netcdf_io_initialize_output nf90_def_dim event_dimid" ) ! Dimension to store individual collision events + call netcdf_io_check( nf90_def_dim(nc%id, nc%space_dimname, NDIM, nc%space_dimid), "collision_netcdf_io_initialize_output nf90_def_dim space_dimid" ) ! 3D space dimension + call netcdf_io_check( nf90_def_dim(nc%id, nc%name_dimname, nc%name_dimsize, nc%name_dimid), "collision_netcdf_io_initialize_output nf90_def_dim name_dimid" ) ! Dimension to store particle id numbers + call netcdf_io_check( nf90_def_dim(nc%id, nc%str_dimname, NAMELEN, nc%str_dimid), "collision_netcdf_io_initialize_output nf90_def_dim str_dimid" ) ! Dimension for string variables (aka character arrays) + call netcdf_io_check( nf90_def_dim(nc%id, nc%stage_dimname, 2, nc%stage_dimid), "collision_netcdf_io_initialize_output nf90_def_dim stage_dimid" ) ! Dimension for stage variables (aka "before" vs. "after" ! Dimension coordinates - call netcdf_io_check( nf90_def_var(nc%id, nc%space_dimname, NF90_CHAR, nc%space_dimid, nc%space_varid), "collision_io_initialize_output nf90_def_var space_varid" ) - call netcdf_io_check( nf90_def_var(nc%id, nc%name_dimname, NF90_CHAR, [nc%str_dimid, nc%name_dimid], nc%name_varid), "collision_io_initialize_output nf90_def_var name_varid") - call netcdf_io_check( nf90_def_var(nc%id, nc%stage_dimname, NF90_CHAR, [nc%str_dimid, nc%stage_dimid], nc%stage_varid), "collision_io_initialize_output nf90_def_var stage_varid" ) + call netcdf_io_check( nf90_def_var(nc%id, nc%space_dimname, NF90_CHAR, nc%space_dimid, nc%space_varid), "collision_netcdf_io_initialize_output nf90_def_var space_varid" ) + call netcdf_io_check( nf90_def_var(nc%id, nc%name_dimname, NF90_CHAR, [nc%str_dimid, nc%name_dimid], nc%name_varid), "collision_netcdf_io_initialize_output nf90_def_var name_varid") + call netcdf_io_check( nf90_def_var(nc%id, nc%stage_dimname, NF90_CHAR, [nc%str_dimid, nc%stage_dimid], nc%stage_varid), "collision_netcdf_io_initialize_output nf90_def_var stage_varid" ) ! Variables - call netcdf_io_check( nf90_def_var(nc%id, nc%id_varname, NF90_INT, nc%name_dimid, nc%id_varid), "collision_io_initialize_output nf90_def_var id_varid" ) + call netcdf_io_check( nf90_def_var(nc%id, nc%id_varname, NF90_INT, nc%name_dimid, nc%id_varid), "collision_netcdf_io_initialize_output nf90_def_var id_varid" ) call netcdf_io_check( nf90_def_var(nc%id, nc%time_dimname, nc%out_type, & - nc%event_dimid, nc%time_varid), "collision_io_initialize_output nf90_def_var time_varid" ) + nc%event_dimid, nc%time_varid), "collision_netcdf_io_initialize_output nf90_def_var time_varid" ) call netcdf_io_check( nf90_def_var(nc%id, nc%regime_varname, NF90_CHAR, & - [nc%str_dimid, nc%event_dimid], nc%regime_varid), "collision_io_initialize_output nf90_def_var regime_varid") + [nc%str_dimid, nc%event_dimid], nc%regime_varid), "collision_netcdf_io_initialize_output nf90_def_var regime_varid") call netcdf_io_check( nf90_def_var(nc%id, nc%Qloss_varname, nc%out_type, & - [ nc%event_dimid], nc%Qloss_varid), "collision_io_initialize_output nf90_def_var Qloss_varid") + [ nc%event_dimid], nc%Qloss_varid), "collision_netcdf_io_initialize_output nf90_def_var Qloss_varid") call netcdf_io_check( nf90_def_var(nc%id, nc%ptype_varname, NF90_CHAR, & - [nc%str_dimid, nc%name_dimid, nc%stage_dimid, nc%event_dimid], nc%ptype_varid), "collision_io_initialize_output nf90_def_var ptype_varid") + [nc%str_dimid, nc%name_dimid, nc%stage_dimid, nc%event_dimid], nc%ptype_varid), "collision_netcdf_io_initialize_output nf90_def_var ptype_varid") call netcdf_io_check( nf90_def_var(nc%id, nc%loop_varname, NF90_INT, & - [ nc%event_dimid], nc%loop_varid), "collision_io_initialize_output nf90_def_var loop_varid") + [ nc%event_dimid], nc%loop_varid), "collision_netcdf_io_initialize_output nf90_def_var loop_varid") call netcdf_io_check( nf90_def_var(nc%id, nc%rh_varname, nc%out_type,& - [ nc%space_dimid, nc%name_dimid, nc%stage_dimid, nc%event_dimid], nc%rh_varid), "collision_io_initialize_output nf90_def_var rh_varid") + [ nc%space_dimid, nc%name_dimid, nc%stage_dimid, nc%event_dimid], nc%rh_varid), "collision_netcdf_io_initialize_output nf90_def_var rh_varid") call netcdf_io_check( nf90_def_var(nc%id, nc%vh_varname, nc%out_type,& - [ nc%space_dimid, nc%name_dimid, nc%stage_dimid, nc%event_dimid], nc%vh_varid), "collision_io_initialize_output nf90_def_var vh_varid") + [ nc%space_dimid, nc%name_dimid, nc%stage_dimid, nc%event_dimid], nc%vh_varid), "collision_netcdf_io_initialize_output nf90_def_var vh_varid") call netcdf_io_check( nf90_def_var(nc%id, nc%Gmass_varname, nc%out_type,& - [ nc%name_dimid, nc%stage_dimid, nc%event_dimid], nc%Gmass_varid), "collision_io_initialize_output nf90_def_var Gmass_varid") + [ nc%name_dimid, nc%stage_dimid, nc%event_dimid], nc%Gmass_varid), "collision_netcdf_io_initialize_output nf90_def_var Gmass_varid") call netcdf_io_check( nf90_def_var(nc%id, nc%radius_varname, nc%out_type,& - [ nc%name_dimid, nc%stage_dimid, nc%event_dimid], nc%radius_varid), "collision_io_initialize_output nf90_def_var radius_varid") + [ nc%name_dimid, nc%stage_dimid, nc%event_dimid], nc%radius_varid), "collision_netcdf_io_initialize_output nf90_def_var radius_varid") call netcdf_io_check( nf90_def_var(nc%id, nc%Ip_varname, nc%out_type,& - [ nc%space_dimid, nc%name_dimid, nc%stage_dimid, nc%event_dimid], nc%Ip_varid), "collision_io_initialize_output nf90_def_var Ip_varid") + [ nc%space_dimid, nc%name_dimid, nc%stage_dimid, nc%event_dimid], nc%Ip_varid), "collision_netcdf_io_initialize_output nf90_def_var Ip_varid") call netcdf_io_check( nf90_def_var(nc%id, nc%rot_varname, nc%out_type,& - [ nc%space_dimid, nc%name_dimid, nc%stage_dimid, nc%event_dimid], nc%rot_varid), "collision_io_initialize_output nf90_def_var rot_varid") + [ nc%space_dimid, nc%name_dimid, nc%stage_dimid, nc%event_dimid], nc%rot_varid), "collision_netcdf_io_initialize_output nf90_def_var rot_varid") if (param%lenergy) then call netcdf_io_check( nf90_def_var(nc%id, nc%ke_orb_varname, nc%out_type,& - [ nc%stage_dimid, nc%event_dimid], nc%KE_orb_varid), "collision_io_initialize_output nf90_def_var KE_orb_varid") + [ nc%stage_dimid, nc%event_dimid], nc%KE_orb_varid), "collision_netcdf_io_initialize_output nf90_def_var KE_orb_varid") call netcdf_io_check( nf90_def_var(nc%id, nc%ke_spin_varname, nc%out_type,& - [ nc%stage_dimid, nc%event_dimid], nc%KE_spin_varid), "collision_io_initialize_output nf90_def_var KE_spin_varid" ) + [ nc%stage_dimid, nc%event_dimid], nc%KE_spin_varid), "collision_netcdf_io_initialize_output nf90_def_var KE_spin_varid" ) call netcdf_io_check( nf90_def_var(nc%id, nc%pe_varname, nc%out_type,& - [ nc%stage_dimid, nc%event_dimid], nc%PE_varid), "collision_io_initialize_output nf90_def_var PE_varid" ) + [ nc%stage_dimid, nc%event_dimid], nc%PE_varid), "collision_netcdf_io_initialize_output nf90_def_var PE_varid" ) call netcdf_io_check( nf90_def_var(nc%id, nc%L_orb_varname, nc%out_type, & - [ nc%space_dimid, nc%stage_dimid, nc%event_dimid], nc%L_orb_varid), "collision_io_initialize_output nf90_def_var L_orb_varid" ) + [ nc%space_dimid, nc%stage_dimid, nc%event_dimid], nc%L_orb_varid), "collision_netcdf_io_initialize_output nf90_def_var L_orb_varid" ) call netcdf_io_check( nf90_def_var(nc%id, nc%Lspin_varname, nc%out_type,& - [ nc%space_dimid, nc%stage_dimid, nc%event_dimid], nc%Lspin_varid), "collision_io_initialize_output nf90_def_var Lspin_varid" ) + [ nc%space_dimid, nc%stage_dimid, nc%event_dimid], nc%Lspin_varid), "collision_netcdf_io_initialize_output nf90_def_var Lspin_varid" ) end if - call netcdf_io_check( nf90_inquire(nc%id, nVariables=nvar), "collision_io_initialize_output nf90_inquire nVariables" ) + call netcdf_io_check( nf90_inquire(nc%id, nVariables=nvar), "collision_netcdf_io_initialize_output nf90_inquire nVariables" ) do varid = 1, nvar - call netcdf_io_check( nf90_inquire_variable(nc%id, varid, xtype=vartype, ndims=ndims), "collision_io_initialize_output nf90_inquire_variable" ) + call netcdf_io_check( nf90_inquire_variable(nc%id, varid, xtype=vartype, ndims=ndims), "collision_netcdf_io_initialize_output nf90_inquire_variable" ) select case(vartype) case(NF90_INT) - call netcdf_io_check( nf90_def_var_fill(nc%id, varid, NO_FILL, NF90_FILL_INT), "collision_io_initialize_output nf90_def_var_fill NF90_INT" ) + call netcdf_io_check( nf90_def_var_fill(nc%id, varid, NO_FILL, NF90_FILL_INT), "collision_netcdf_io_initialize_output nf90_def_var_fill NF90_INT" ) case(NF90_FLOAT) - call netcdf_io_check( nf90_def_var_fill(nc%id, varid, NO_FILL, sfill), "collision_io_initialize_output nf90_def_var_fill NF90_FLOAT" ) + call netcdf_io_check( nf90_def_var_fill(nc%id, varid, NO_FILL, sfill), "collision_netcdf_io_initialize_output nf90_def_var_fill NF90_FLOAT" ) case(NF90_DOUBLE) - call netcdf_io_check( nf90_def_var_fill(nc%id, varid, NO_FILL, dfill), "collision_io_initialize_output nf90_def_var_fill NF90_DOUBLE" ) + call netcdf_io_check( nf90_def_var_fill(nc%id, varid, NO_FILL, dfill), "collision_netcdf_io_initialize_output nf90_def_var_fill NF90_DOUBLE" ) case(NF90_CHAR) - call netcdf_io_check( nf90_def_var_fill(nc%id, varid, NO_FILL, 0), "collision_io_initialize_output nf90_def_var_fill NF90_CHAR" ) + call netcdf_io_check( nf90_def_var_fill(nc%id, varid, NO_FILL, 0), "collision_netcdf_io_initialize_output nf90_def_var_fill NF90_CHAR" ) end select end do ! Take the file out of define mode - call netcdf_io_check( nf90_enddef(nc%id), "collision_io_initialize_output nf90_enddef" ) + call netcdf_io_check( nf90_enddef(nc%id), "collision_netcdf_io_initialize_output nf90_enddef" ) ! Add in the space and stage dimension coordinates - call netcdf_io_check( nf90_put_var(nc%id, nc%space_varid, nc%space_coords, start=[1], count=[NDIM]), "collision_io_initialize_output nf90_put_var space" ) - call netcdf_io_check( nf90_put_var(nc%id, nc%stage_varid, nc%stage_coords(1), start=[1,1], count=[len(nc%stage_coords(1)),1]), "collision_io_initialize_output nf90_put_var stage 1" ) - call netcdf_io_check( nf90_put_var(nc%id, nc%stage_varid, nc%stage_coords(2), start=[1,2], count=[len(nc%stage_coords(2)),1]), "collision_io_initialize_output nf90_put_var stage 2" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%space_varid, nc%space_coords, start=[1], count=[NDIM]), "collision_netcdf_io_initialize_output nf90_put_var space" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%stage_varid, nc%stage_coords(1), start=[1,1], count=[len(nc%stage_coords(1)),1]), "collision_netcdf_io_initialize_output nf90_put_var stage 1" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%stage_varid, nc%stage_coords(2), start=[1,2], count=[len(nc%stage_coords(2)),1]), "collision_netcdf_io_initialize_output nf90_put_var stage 2" ) end associate end select @@ -192,10 +192,10 @@ module subroutine collision_io_initialize_output(self, param) 667 continue write(*,*) "Error creating fragmentation output file. " // trim(adjustl(errmsg)) call swiftest_util_exit(FAILURE) - end subroutine collision_io_initialize_output + end subroutine collision_netcdf_io_initialize_output - module subroutine collision_io_write_frame_snapshot(self, history, param) + module subroutine collision_netcdf_io_write_frame_snapshot(self, history, param) !! author: David A. Minton !! !! Write a frame of output of a collision result @@ -213,14 +213,14 @@ module subroutine collision_io_write_frame_snapshot(self, history, param) select type(nc => history%nc) class is (collision_netcdf_parameters) associate(system => self%collision_system, impactors => self%collision_system%impactors, fragments => self%collision_system%fragments, eslot => param%ioutput) - call netcdf_io_check( nf90_set_fill(nc%id, nf90_nofill, old_mode), "collision_io_write_frame_snapshot nf90_set_fill" ) + call netcdf_io_check( nf90_set_fill(nc%id, nf90_nofill, old_mode), "collision_netcdf_io_write_frame_snapshot nf90_set_fill" ) - call netcdf_io_check( nf90_put_var(nc%id, nc%time_varid, self%t, start=[eslot]), "collision_io_write_frame_snapshot nf90_put_var time_varid" ) - call netcdf_io_check( nf90_put_var(nc%id, nc%loop_varid, int(self%iloop,kind=I4B), start=[eslot]), "collision_io_write_frame_snapshot nf90_put_varloop_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%time_varid, self%t, start=[eslot]), "collision_netcdf_io_write_frame_snapshot nf90_put_var time_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%loop_varid, int(self%iloop,kind=I4B), start=[eslot]), "collision_netcdf_io_write_frame_snapshot nf90_put_varloop_varid" ) charstring = trim(adjustl(REGIME_NAMES(impactors%regime))) - call netcdf_io_check( nf90_put_var(nc%id, nc%regime_varid, charstring, start=[1, eslot], count=[len(charstring), 1]), "collision_io_write_frame_snapshot nf90_put_var regime_varid" ) - call netcdf_io_check( nf90_put_var(nc%id, nc%Qloss_varid, impactors%Qloss, start=[eslot] ), "collision_io_write_frame_snapshot nf90_put_var Qloss_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%regime_varid, charstring, start=[1, eslot], count=[len(charstring), 1]), "collision_netcdf_io_write_frame_snapshot nf90_put_var regime_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%Qloss_varid, impactors%Qloss, start=[eslot] ), "collision_netcdf_io_write_frame_snapshot nf90_put_var Qloss_varid" ) select type(before =>self%collision_system%before) class is (swiftest_nbody_system) @@ -237,34 +237,34 @@ module subroutine collision_io_write_frame_snapshot(self, history, param) npl = pl%nbody do i = 1, npl idslot = findloc(history%idvals,pl%id(i),dim=1) - call netcdf_io_check( nf90_put_var(nc%id, nc%id_varid, pl%id(i), start=[ idslot ]), "collision_io_write_frame_snapshot nf90_put_var id_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%id_varid, pl%id(i), start=[ idslot ]), "collision_netcdf_io_write_frame_snapshot nf90_put_var id_varid" ) charstring = trim(adjustl(pl%info(i)%name)) - call netcdf_io_check( nf90_put_var(nc%id, nc%name_varid, charstring, start=[1, idslot ], count=[len(charstring), 1]), "collision_io_write_frame_snapshot nf90_put_var name_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%name_varid, charstring, start=[1, idslot ], count=[len(charstring), 1]), "collision_netcdf_io_write_frame_snapshot nf90_put_var name_varid" ) charstring = trim(adjustl(pl%info(i)%particle_type)) - call netcdf_io_check( nf90_put_var(nc%id, nc%ptype_varid, charstring, start=[1, idslot, stage, eslot], count=[len(charstring), 1, 1]), "collision_io_write_frame_snapshot nf90_put_var particle_type_varid" ) - call netcdf_io_check( nf90_put_var(nc%id, nc%rh_varid, pl%rh(:,i), start=[1, idslot, stage, eslot], count=[NDIM,1,1,1]), "collision_io_write_frame_snapshot nf90_put_var rh_varid" ) - call netcdf_io_check( nf90_put_var(nc%id, nc%vh_varid, pl%vh(:,i), start=[1, idslot, stage, eslot], count=[NDIM,1,1,1]), "collision_io_write_frame_snapshot nf90_put_var vh_varid" ) - call netcdf_io_check( nf90_put_var(nc%id, nc%Gmass_varid, pl%Gmass(i), start=[ idslot, stage, eslot]), "collision_io_write_frame_snapshot nf90_put_var Gmass_varid" ) - call netcdf_io_check( nf90_put_var(nc%id, nc%radius_varid, pl%radius(i), start=[ idslot, stage, eslot]), "collision_io_write_frame_snapshot nf90_put_var radius_varid" ) - call netcdf_io_check( nf90_put_var(nc%id, nc%Ip_varid, pl%Ip(:,i), start=[1, idslot, stage, eslot], count=[NDIM,1,1,1]), "collision_io_write_frame_snapshot nf90_put_var Ip_varid" ) - call netcdf_io_check( nf90_put_var(nc%id, nc%rot_varid, pl%rot(:,i), start=[1, idslot, stage, eslot], count=[NDIM,1,1,1]), "collision_io_write_frame_snapshot nf90_put_var rotx_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%ptype_varid, charstring, start=[1, idslot, stage, eslot], count=[len(charstring), 1, 1]), "collision_netcdf_io_write_frame_snapshot nf90_put_var particle_type_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%rh_varid, pl%rh(:,i), start=[1, idslot, stage, eslot], count=[NDIM,1,1,1]), "collision_netcdf_io_write_frame_snapshot nf90_put_var rh_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%vh_varid, pl%vh(:,i), start=[1, idslot, stage, eslot], count=[NDIM,1,1,1]), "collision_netcdf_io_write_frame_snapshot nf90_put_var vh_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%Gmass_varid, pl%Gmass(i), start=[ idslot, stage, eslot]), "collision_netcdf_io_write_frame_snapshot nf90_put_var Gmass_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%radius_varid, pl%radius(i), start=[ idslot, stage, eslot]), "collision_netcdf_io_write_frame_snapshot nf90_put_var radius_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%Ip_varid, pl%Ip(:,i), start=[1, idslot, stage, eslot], count=[NDIM,1,1,1]), "collision_netcdf_io_write_frame_snapshot nf90_put_var Ip_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%rot_varid, pl%rot(:,i), start=[1, idslot, stage, eslot], count=[NDIM,1,1,1]), "collision_netcdf_io_write_frame_snapshot nf90_put_var rotx_varid" ) end do end do end select end select if (param%lenergy) then - call netcdf_io_check( nf90_put_var(nc%id, nc%ke_orb_varid, system%ke_orbit(:), start=[ 1, eslot], count=[ 2, 1]), "collision_io_write_frame_snapshot nf90_put_var ke_orb_varid before" ) - call netcdf_io_check( nf90_put_var(nc%id, nc%ke_spin_varid, system%ke_spin(:), start=[ 1, eslot], count=[ 2, 1]), "collision_io_write_frame_snapshot nf90_put_var ke_spin_varid before" ) - call netcdf_io_check( nf90_put_var(nc%id, nc%pe_varid, system%pe(:), start=[ 1, eslot], count=[ 2, 1]), "collision_io_write_frame_snapshot nf90_put_var pe_varid before" ) - call netcdf_io_check( nf90_put_var(nc%id, nc%L_orb_varid, system%Lorbit(:,:), start=[1, 1, eslot], count=[NDIM, 2, 1]), "collision_io_write_frame_snapshot nf90_put_var L_orb_varid before" ) - call netcdf_io_check( nf90_put_var(nc%id, nc%Lspin_varid, system%Lspin(:,:), start=[1, 1, eslot], count=[NDIM, 2, 1]), "collision_io_write_frame_snapshot nf90_put_var Lspin_varid before" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%ke_orb_varid, system%ke_orbit(:), start=[ 1, eslot], count=[ 2, 1]), "collision_netcdf_io_write_frame_snapshot nf90_put_var ke_orb_varid before" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%ke_spin_varid, system%ke_spin(:), start=[ 1, eslot], count=[ 2, 1]), "collision_netcdf_io_write_frame_snapshot nf90_put_var ke_spin_varid before" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%pe_varid, system%pe(:), start=[ 1, eslot], count=[ 2, 1]), "collision_netcdf_io_write_frame_snapshot nf90_put_var pe_varid before" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%L_orb_varid, system%Lorbit(:,:), start=[1, 1, eslot], count=[NDIM, 2, 1]), "collision_netcdf_io_write_frame_snapshot nf90_put_var L_orb_varid before" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%Lspin_varid, system%Lspin(:,:), start=[1, 1, eslot], count=[NDIM, 2, 1]), "collision_netcdf_io_write_frame_snapshot nf90_put_var Lspin_varid before" ) end if call netcdf_io_check( nf90_set_fill(nc%id, old_mode, old_mode) ) end associate end select return - end subroutine collision_io_write_frame_snapshot + end subroutine collision_netcdf_io_write_frame_snapshot -end submodule s_collision_io \ No newline at end of file +end submodule s_collision_netcdf_io \ No newline at end of file diff --git a/src/collision/collision_module.f90 b/src/collision/collision_module.f90 index ccde318cc..61c7f0fa2 100644 --- a/src/collision/collision_module.f90 +++ b/src/collision/collision_module.f90 @@ -32,6 +32,7 @@ module collision procedure :: extract_collisions => collision_resolve_extract_plpl !! Processes the pl-pl encounter list remove only those encounters that led to a collision procedure :: collision_check => collision_check_plpl !! Checks if a test particle is going to collide with a massive body procedure :: resolve_collision => collision_resolve_plpl !! Process the pl-pl collision list, then modifiy the massive bodies based on the outcome of the collision + final :: collision_final_plpl end type collision_list_plpl @@ -41,6 +42,7 @@ module collision procedure :: extract_collisions => collision_resolve_extract_pltp !! Processes the pl-tp encounter list remove only those encounters that led to a collision procedure :: collision_check => collision_check_pltp !! Checks if a test particle is going to collide with a massive body procedure :: resolve_collision => collision_resolve_pltp !! Process the pl-tp collision list + final :: collision_final_pltp end type collision_list_pltp @@ -73,7 +75,7 @@ module collision contains procedure :: get_regime => collision_regime_impactors !! Determine which fragmentation regime the set of impactors will be procedure :: reset => collision_util_reset_impactors !! Resets the collider object variables to 0 and deallocates the index and mass distributions - final :: collision_util_final_impactors !! Finalizer will deallocate all allocatables + final :: collision_final_impactors !! Finalizer will deallocate all allocatables end type collision_impactors @@ -101,7 +103,7 @@ module collision real(DP), dimension(NDIM,nbody) :: v_n_unit !! Array of normal direction unit vectors of individual fragments in the collisional coordinate frame contains procedure :: reset => collision_util_reset_fragments !! Deallocates all allocatable arrays and sets everything else to 0 - final :: collision_util_final_fragments !! Finalizer deallocates all allocatables + final :: collision_final_fragments !! Finalizer deallocates all allocatables end type collision_fragments @@ -132,7 +134,7 @@ module collision procedure :: get_energy_and_momentum => collision_util_get_energy_momentum !! Calculates total system energy in either the pre-collision outcome state (lbefore = .true.) or the post-collision outcome state (lbefore = .false.) procedure :: reset => collision_util_reset_system !! Deallocates all allocatables procedure :: set_coordinate_system => collision_util_set_coordinate_system !! Sets the coordinate system of the collisional system - final :: collision_util_final_system !! Finalizer will deallocate all allocatables + final :: collision_final_system !! Finalizer will deallocate all allocatables end type collision_system @@ -153,7 +155,8 @@ module collision character(NAMELEN) :: regime_varname = "regime" !! name of the collision regime variable integer(I4B) :: regime_varid !! ID for the collision regime variable contains - procedure :: initialize => collision_io_initialize_output !! Initialize a set of parameters used to identify a NetCDF output object + procedure :: initialize => collision_netcdf_io_initialize_output !! Initialize a set of parameters used to identify a NetCDF output object + final :: collision_final_netcdf_parameters !! Finalizer closes the NetCDF file end type collision_netcdf_parameters @@ -161,19 +164,19 @@ module collision logical :: lcollision !! Indicates that this snapshot contains at least one collision class(collision_system), allocatable :: collision_system !! impactors object at this snapshot contains - procedure :: write_frame => collision_io_write_frame_snapshot !! Writes a frame of encounter data to file + procedure :: write_frame => collision_netcdf_io_write_frame_snapshot !! Writes a frame of encounter data to file procedure :: get_idvals => collision_util_get_idvalues_snapshot !! Gets an array of all id values saved in this snapshot - final :: collision_util_final_snapshot !! Finalizer deallocates all allocatables + final :: collision_final_snapshot !! Finalizer deallocates all allocatables end type collision_snapshot !> A class that that is used to store simulation history data between file output type, extends(encounter_storage) :: collision_storage contains - procedure :: dump => collision_io_dump !! Dumps contents of encounter history to file + procedure :: dump => collision_netcdf_io_dump !! Dumps contents of encounter history to file procedure :: take_snapshot => collision_util_snapshot !! Take a minimal snapshot of the system through an encounter procedure :: make_index_map => collision_util_index_map !! Maps body id values to storage index values so we don't have to use unlimited dimensions for id - final :: collision_util_final_storage !! Finalizer deallocates all allocatables + final :: collision_final_storage !! Finalizer deallocates all allocatables end type collision_storage @@ -197,24 +200,24 @@ end subroutine abstract_set_mass_dist interface - module subroutine collision_io_dump(self, param) + module subroutine collision_netcdf_io_dump(self, param) implicit none class(collision_storage(*)), intent(inout) :: self !! Collision storage object class(base_parameters), intent(inout) :: param !! Current run configuration parameters - end subroutine collision_io_dump + end subroutine collision_netcdf_io_dump - module subroutine collision_io_initialize_output(self, param) + module subroutine collision_netcdf_io_initialize_output(self, param) implicit none class(collision_netcdf_parameters), intent(inout) :: self !! Parameters used to identify a particular NetCDF dataset class(base_parameters), intent(in) :: param !! Current run configuration parameters - end subroutine collision_io_initialize_output + end subroutine collision_netcdf_io_initialize_output - module subroutine collision_io_write_frame_snapshot(self, history, param) + module subroutine collision_netcdf_io_write_frame_snapshot(self, history, param) implicit none class(collision_snapshot), intent(in) :: self !! Swiftest encounter structure class(encounter_storage(*)), intent(inout) :: history !! Collision history object class(base_parameters), intent(inout) :: param !! Current run configuration parameters - end subroutine collision_io_write_frame_snapshot + end subroutine collision_netcdf_io_write_frame_snapshot module subroutine collision_regime_impactors(self, system, param) implicit none @@ -337,30 +340,6 @@ module subroutine collision_util_reset_fragments(self) class(collision_fragments(*)), intent(inout) :: self end subroutine collision_util_reset_fragments - module subroutine collision_util_final_fragments(self) - implicit none - type(collision_fragments(*)), intent(inout) :: self - end subroutine collision_util_final_fragments - - module subroutine collision_util_final_impactors(self) - implicit none - type(collision_impactors), intent(inout) :: self !! Collision impactors storage object - end subroutine collision_util_final_impactors - - module subroutine collision_util_final_storage(self) - implicit none - type(collision_storage(*)), intent(inout) :: self !! Swiftest nbody system object - end subroutine collision_util_final_storage - - module subroutine collision_util_final_snapshot(self) - implicit none - type(collision_snapshot), intent(inout) :: self !! Fraggle storage snapshot object - end subroutine collision_util_final_snapshot - - module subroutine collision_util_final_system(self) - implicit none - type(collision_system), intent(inout) :: self !! Collision system object - end subroutine collision_util_final_system module subroutine collision_util_get_idvalues_snapshot(self, idvals) implicit none @@ -402,6 +381,125 @@ module subroutine collision_util_snapshot(self, param, system, t, arg) end subroutine collision_util_snapshot end interface + contains + + + subroutine collision_final_fragments(self) + !! author: David A. Minton + !! + !! Finalizer will deallocate all allocatables + implicit none + ! Arguments + type(collision_fragments(*)), intent(inout) :: self + + call self%reset() + + return + end subroutine collision_final_fragments + + + subroutine collision_final_impactors(self) + !! author: David A. Minton + !! + !! Finalizer will deallocate all allocatables + implicit none + ! Arguments + type(collision_impactors), intent(inout) :: self !! Collision impactors storage object + + call self%reset() + + return + end subroutine collision_final_impactors + + subroutine collision_final_netcdf_parameters(self) + !! author: David A. Minton + !! + !! Finalize the NetCDF by closing the file + implicit none + ! Arguments + type(collision_netcdf_parameters), intent(inout) :: self + + call self%close() + + return + end subroutine collision_final_netcdf_parameters + + + subroutine collision_final_plpl(self) + !! author: David A. Minton + !! + !! Finalizer will deallocate all allocatables + implicit none + ! Arguments + type(collision_list_plpl), intent(inout) :: self !! Fraggle encountar storage object + + call self%dealloc() + + return + end subroutine collision_final_plpl + + subroutine collision_final_pltp(self) + !! author: David A. Minton + !! + !! Finalizer will deallocate all allocatables + implicit none + ! Arguments + type(collision_list_pltp), intent(inout) :: self !! Fraggle encountar storage object + + call self%dealloc() + + return + end subroutine collision_final_pltp + + + subroutine collision_final_snapshot(self) + !! author: David A. Minton + !! + !! Finalizer will deallocate all allocatables + implicit none + ! Arguments + type(collision_snapshot), intent(inout) :: self !! Fraggle encountar storage object + + call encounter_final_snapshot(self%encounter_snapshot) + + return + end subroutine collision_final_snapshot + + + subroutine collision_final_storage(self) + !! author: David A. Minton + !! + !! Finalizer will deallocate all allocatables + implicit none + ! Arguments + type(collision_storage(*)), intent(inout) :: self !! Collision storage object + ! Internals + integer(I4B) :: i + + do i = 1, self%nframes + if (allocated(self%frame(i)%item)) deallocate(self%frame(i)%item) + end do + + return + end subroutine collision_final_storage + + + subroutine collision_final_system(self) + !! author: David A. Minton + !! + !! Finalizer will deallocate all allocatables + implicit none + ! Arguments + type(collision_system), intent(inout) :: self !! Collision system object + + call self%reset() + if (allocated(self%impactors)) deallocate(self%impactors) + if (allocated(self%fragments)) deallocate(self%fragments) + + return + end subroutine collision_final_system + + end module collision diff --git a/src/collision/collision_util.f90 b/src/collision/collision_util.f90 index a7506c5db..11d99dfc9 100644 --- a/src/collision/collision_util.f90 +++ b/src/collision/collision_util.f90 @@ -118,82 +118,6 @@ module subroutine collision_util_construct_temporary_system(self, nbody_system, end subroutine collision_util_construct_temporary_system - module subroutine collision_util_final_fragments(self) - !! author: David A. Minton - !! - !! Finalizer will deallocate all allocatables - implicit none - ! Arguments - type(collision_fragments(*)), intent(inout) :: self - - call self%reset() - - return - end subroutine collision_util_final_fragments - - - module subroutine collision_util_final_impactors(self) - !! author: David A. Minton - !! - !! Finalizer will deallocate all allocatables - implicit none - ! Arguments - type(collision_impactors), intent(inout) :: self !! Collision impactors storage object - - call self%reset() - - return - end subroutine collision_util_final_impactors - - - module subroutine collision_util_final_snapshot(self) - !! author: David A. Minton - !! - !! Finalizer will deallocate all allocatables - implicit none - ! Arguments - type(collision_snapshot), intent(inout) :: self !! Fraggle encountar storage object - - call encounter_util_final_snapshot(self%encounter_snapshot) - - return - end subroutine collision_util_final_snapshot - - - module subroutine collision_util_final_storage(self) - !! author: David A. Minton - !! - !! Finalizer will deallocate all allocatables - implicit none - ! Arguments - type(collision_storage(*)), intent(inout) :: self !! Collision storage object - ! Internals - integer(I4B) :: i - - do i = 1, self%nframes - if (allocated(self%frame(i)%item)) deallocate(self%frame(i)%item) - end do - - return - end subroutine collision_util_final_storage - - - module subroutine collision_util_final_system(self) - !! author: David A. Minton - !! - !! Finalizer will deallocate all allocatables - implicit none - ! Arguments - type(collision_system), intent(inout) :: self !! Collision system object - - call self%reset() - if (allocated(self%impactors)) deallocate(self%impactors) - if (allocated(self%fragments)) deallocate(self%fragments) - - return - end subroutine collision_util_final_system - - module subroutine collision_util_get_idvalues_snapshot(self, idvals) !! author: David A. Minton !! diff --git a/src/encounter/encounter_io.f90 b/src/encounter/encounter_io.f90 index 1529dd955..1e1baae7c 100644 --- a/src/encounter/encounter_io.f90 +++ b/src/encounter/encounter_io.f90 @@ -7,11 +7,11 @@ !! You should have received a copy of the GNU General Public License along with Swiftest. !! If not, see: https://www.gnu.org/licenses. -submodule (encounter) s_encounter_io +submodule (encounter) s_encounter_netcdf_io use swiftest contains - module subroutine encounter_io_dump(self, param) + module subroutine encounter_netcdf_io_dump(self, param) ! author: David A. Minton !! !! Dumps the time history of an encounter to file. @@ -51,10 +51,10 @@ module subroutine encounter_io_dump(self, param) end select return - end subroutine encounter_io_dump + end subroutine encounter_netcdf_io_dump - module subroutine encounter_io_initialize_output(self, param) + module subroutine encounter_netcdf_io_initialize_output(self, param) !! author: David A. Minton !! !! Initialize a NetCDF encounter file system. This is a simplified version of the main simulation output NetCDF file, but with fewer variables. @@ -91,54 +91,54 @@ module subroutine encounter_io_initialize_output(self, param) close(unit=LUN, status="delete") end if - call netcdf_io_check( nf90_create(nc%file_name, NF90_NETCDF4, nc%id), "encounter_io_initialize_output nf90_create" ) + call netcdf_io_check( nf90_create(nc%file_name, NF90_NETCDF4, nc%id), "encounter_netcdf_io_initialize_output nf90_create" ) ! Dimensions - call netcdf_io_check( nf90_def_dim(nc%id, nc%time_dimname, nc%time_dimsize, nc%time_dimid), "encounter_io_initialize_output nf90_def_dim time_dimid" ) ! Simulation time dimension - call netcdf_io_check( nf90_def_dim(nc%id, nc%space_dimname, NDIM, nc%space_dimid), "encounter_io_initialize_output nf90_def_dim space_dimid" ) ! 3D space dimension - call netcdf_io_check( nf90_def_dim(nc%id, nc%name_dimname, nc%name_dimsize, nc%name_dimid), "encounter_io_initialize_output nf90_def_dim name_dimid" ) ! dimension to store particle id numbers - call netcdf_io_check( nf90_def_dim(nc%id, nc%str_dimname, NAMELEN, nc%str_dimid), "encounter_io_initialize_output nf90_def_dim str_dimid" ) ! Dimension for string variables (aka character arrays) + call netcdf_io_check( nf90_def_dim(nc%id, nc%time_dimname, nc%time_dimsize, nc%time_dimid), "encounter_netcdf_io_initialize_output nf90_def_dim time_dimid" ) ! Simulation time dimension + call netcdf_io_check( nf90_def_dim(nc%id, nc%space_dimname, NDIM, nc%space_dimid), "encounter_netcdf_io_initialize_output nf90_def_dim space_dimid" ) ! 3D space dimension + call netcdf_io_check( nf90_def_dim(nc%id, nc%name_dimname, nc%name_dimsize, nc%name_dimid), "encounter_netcdf_io_initialize_output nf90_def_dim name_dimid" ) ! dimension to store particle id numbers + call netcdf_io_check( nf90_def_dim(nc%id, nc%str_dimname, NAMELEN, nc%str_dimid), "encounter_netcdf_io_initialize_output nf90_def_dim str_dimid" ) ! Dimension for string variables (aka character arrays) ! Dimension coordinates - call netcdf_io_check( nf90_def_var(nc%id, nc%time_dimname, nc%out_type, nc%time_dimid, nc%time_varid), "encounter_io_initialize_output nf90_def_var time_varid" ) - call netcdf_io_check( nf90_def_var(nc%id, nc%space_dimname, NF90_CHAR, nc%space_dimid, nc%space_varid), "encounter_io_initialize_output nf90_def_var space_varid" ) - call netcdf_io_check( nf90_def_var(nc%id, nc%name_dimname, NF90_CHAR, [nc%str_dimid, nc%name_dimid], nc%name_varid), "encounter_io_initialize_output nf90_def_var id_varid" ) + call netcdf_io_check( nf90_def_var(nc%id, nc%time_dimname, nc%out_type, nc%time_dimid, nc%time_varid), "encounter_netcdf_io_initialize_output nf90_def_var time_varid" ) + call netcdf_io_check( nf90_def_var(nc%id, nc%space_dimname, NF90_CHAR, nc%space_dimid, nc%space_varid), "encounter_netcdf_io_initialize_output nf90_def_var space_varid" ) + call netcdf_io_check( nf90_def_var(nc%id, nc%name_dimname, NF90_CHAR, [nc%str_dimid, nc%name_dimid], nc%name_varid), "encounter_netcdf_io_initialize_output nf90_def_var id_varid" ) ! Variables - call netcdf_io_check( nf90_def_var(nc%id, nc%id_varname, NF90_INT, nc%name_dimid, nc%id_varid), "encounter_io_initialize_output nf90_def_var id_varid" ) - call netcdf_io_check( nf90_def_var(nc%id, nc%ptype_varname, NF90_CHAR, [nc%str_dimid, nc%name_dimid], nc%ptype_varid), "encounter_io_initialize_output nf90_def_var ptype_varid" ) - call netcdf_io_check( nf90_def_var(nc%id, nc%rh_varname, nc%out_type, [nc%space_dimid, nc%name_dimid, nc%time_dimid], nc%rh_varid), "encounter_io_initialize_output nf90_def_var rh_varid" ) - call netcdf_io_check( nf90_def_var(nc%id, nc%vh_varname, nc%out_type, [nc%space_dimid, nc%name_dimid, nc%time_dimid], nc%vh_varid), "encounter_io_initialize_output nf90_def_var vh_varid" ) - call netcdf_io_check( nf90_def_var(nc%id, nc%Gmass_varname, nc%out_type, [nc%name_dimid, nc%time_dimid], nc%Gmass_varid), "encounter_io_initialize_output nf90_def_var Gmass_varid" ) - call netcdf_io_check( nf90_def_var(nc%id, nc%loop_varname, NF90_INT, [nc%time_dimid], nc%loop_varid), "encounter_io_initialize_output nf90_def_var loop_varid" ) + call netcdf_io_check( nf90_def_var(nc%id, nc%id_varname, NF90_INT, nc%name_dimid, nc%id_varid), "encounter_netcdf_io_initialize_output nf90_def_var id_varid" ) + call netcdf_io_check( nf90_def_var(nc%id, nc%ptype_varname, NF90_CHAR, [nc%str_dimid, nc%name_dimid], nc%ptype_varid), "encounter_netcdf_io_initialize_output nf90_def_var ptype_varid" ) + call netcdf_io_check( nf90_def_var(nc%id, nc%rh_varname, nc%out_type, [nc%space_dimid, nc%name_dimid, nc%time_dimid], nc%rh_varid), "encounter_netcdf_io_initialize_output nf90_def_var rh_varid" ) + call netcdf_io_check( nf90_def_var(nc%id, nc%vh_varname, nc%out_type, [nc%space_dimid, nc%name_dimid, nc%time_dimid], nc%vh_varid), "encounter_netcdf_io_initialize_output nf90_def_var vh_varid" ) + call netcdf_io_check( nf90_def_var(nc%id, nc%Gmass_varname, nc%out_type, [nc%name_dimid, nc%time_dimid], nc%Gmass_varid), "encounter_netcdf_io_initialize_output nf90_def_var Gmass_varid" ) + call netcdf_io_check( nf90_def_var(nc%id, nc%loop_varname, NF90_INT, [nc%time_dimid], nc%loop_varid), "encounter_netcdf_io_initialize_output nf90_def_var loop_varid" ) if (param%lclose) then - call netcdf_io_check( nf90_def_var(nc%id, nc%radius_varname, nc%out_type, [nc%name_dimid, nc%time_dimid], nc%radius_varid), "encounter_io_initialize_output nf90_def_var radius_varid" ) + call netcdf_io_check( nf90_def_var(nc%id, nc%radius_varname, nc%out_type, [nc%name_dimid, nc%time_dimid], nc%radius_varid), "encounter_netcdf_io_initialize_output nf90_def_var radius_varid" ) end if if (param%lrotation) then - call netcdf_io_check( nf90_def_var(nc%id, nc%Ip_varname, nc%out_type, [nc%space_dimid, nc%name_dimid, nc%time_dimid], nc%Ip_varid), "encounter_io_initialize_output nf90_def_var Ip_varid" ) - call netcdf_io_check( nf90_def_var(nc%id, nc%rot_varname, nc%out_type, [nc%space_dimid, nc%name_dimid, nc%time_dimid], nc%rot_varid), "encounter_io_initialize_output nf90_def_var rot_varid" ) + call netcdf_io_check( nf90_def_var(nc%id, nc%Ip_varname, nc%out_type, [nc%space_dimid, nc%name_dimid, nc%time_dimid], nc%Ip_varid), "encounter_netcdf_io_initialize_output nf90_def_var Ip_varid" ) + call netcdf_io_check( nf90_def_var(nc%id, nc%rot_varname, nc%out_type, [nc%space_dimid, nc%name_dimid, nc%time_dimid], nc%rot_varid), "encounter_netcdf_io_initialize_output nf90_def_var rot_varid" ) end if - call netcdf_io_check( nf90_inquire(nc%id, nVariables=nvar), "encounter_io_initialize_output nf90_inquire nVariables" ) + call netcdf_io_check( nf90_inquire(nc%id, nVariables=nvar), "encounter_netcdf_io_initialize_output nf90_inquire nVariables" ) do varid = 1, nvar - call netcdf_io_check( nf90_inquire_variable(nc%id, varid, xtype=vartype, ndims=ndims), "encounter_io_initialize_output nf90_inquire_variable" ) + call netcdf_io_check( nf90_inquire_variable(nc%id, varid, xtype=vartype, ndims=ndims), "encounter_netcdf_io_initialize_output nf90_inquire_variable" ) select case(vartype) case(NF90_INT) - call netcdf_io_check( nf90_def_var_fill(nc%id, varid, NO_FILL, NF90_FILL_INT), "encounter_io_initialize_output nf90_def_var_fill NF90_INT" ) + call netcdf_io_check( nf90_def_var_fill(nc%id, varid, NO_FILL, NF90_FILL_INT), "encounter_netcdf_io_initialize_output nf90_def_var_fill NF90_INT" ) case(NF90_FLOAT) - call netcdf_io_check( nf90_def_var_fill(nc%id, varid, NO_FILL, sfill), "encounter_io_initialize_output nf90_def_var_fill NF90_FLOAT" ) + call netcdf_io_check( nf90_def_var_fill(nc%id, varid, NO_FILL, sfill), "encounter_netcdf_io_initialize_output nf90_def_var_fill NF90_FLOAT" ) case(NF90_DOUBLE) - call netcdf_io_check( nf90_def_var_fill(nc%id, varid, NO_FILL, dfill), "encounter_io_initialize_output nf90_def_var_fill NF90_DOUBLE" ) + call netcdf_io_check( nf90_def_var_fill(nc%id, varid, NO_FILL, dfill), "encounter_netcdf_io_initialize_output nf90_def_var_fill NF90_DOUBLE" ) case(NF90_CHAR) - call netcdf_io_check( nf90_def_var_fill(nc%id, varid, NO_FILL, 0), "encounter_io_initialize_output nf90_def_var_fill NF90_CHAR" ) + call netcdf_io_check( nf90_def_var_fill(nc%id, varid, NO_FILL, 0), "encounter_netcdf_io_initialize_output nf90_def_var_fill NF90_CHAR" ) end select end do ! Take the file out of define mode - call netcdf_io_check( nf90_enddef(nc%id), "encounter_io_initialize_output nf90_enddef" ) + call netcdf_io_check( nf90_enddef(nc%id), "encounter_netcdf_io_initialize_output nf90_enddef" ) ! Add in the space dimension coordinates - call netcdf_io_check( nf90_put_var(nc%id, nc%space_varid, nc%space_coords, start=[1], count=[NDIM]), "encounter_io_initialize_output nf90_put_var space" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%space_varid, nc%space_coords, start=[1], count=[NDIM]), "encounter_netcdf_io_initialize_output nf90_put_var space" ) end associate @@ -147,10 +147,10 @@ module subroutine encounter_io_initialize_output(self, param) 667 continue write(*,*) "Error creating encounter output file. " // trim(adjustl(errmsg)) call swiftest_util_exit(FAILURE) - end subroutine encounter_io_initialize_output + end subroutine encounter_netcdf_io_initialize_output - module subroutine encounter_io_write_frame_snapshot(self, history, param) + module subroutine encounter_netcdf_io_write_frame_snapshot(self, history, param) !! author: David A. Minton !! !! Write a frame of output of an encounter trajectory. @@ -174,43 +174,43 @@ module subroutine encounter_io_write_frame_snapshot(self, history, param) select type (nc => history%nc) class is (encounter_netcdf_parameters) associate(tslot => param%ioutput) - call netcdf_io_check( nf90_set_fill(nc%id, nf90_nofill, old_mode), "encounter_io_write_frame_snapshot nf90_set_fill" ) + call netcdf_io_check( nf90_set_fill(nc%id, nf90_nofill, old_mode), "encounter_netcdf_io_write_frame_snapshot nf90_set_fill" ) - call netcdf_io_check( nf90_put_var(nc%id, nc%time_varid, self%t, start=[tslot]), "encounter_io_write_frame_snapshot nf90_put_var time_varid" ) - call netcdf_io_check( nf90_put_var(nc%id, nc%loop_varid, int(self%iloop,kind=I4B), start=[tslot]), "encounter_io_write_frame_snapshot nf90_put_var pl loop_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%time_varid, self%t, start=[tslot]), "encounter_netcdf_io_write_frame_snapshot nf90_put_var time_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%loop_varid, int(self%iloop,kind=I4B), start=[tslot]), "encounter_netcdf_io_write_frame_snapshot nf90_put_var pl loop_varid" ) npl = pl%nbody do i = 1, npl idslot = findloc(history%idvals,pl%id(i),dim=1) - call netcdf_io_check( nf90_put_var(nc%id, nc%id_varid, pl%id(i), start=[idslot]), "encounter_io_write_frame_snapshot nf90_put_var pl id_varid" ) - call netcdf_io_check( nf90_put_var(nc%id, nc%rh_varid, pl%rh(:,i), start=[1,idslot,tslot], count=[NDIM,1,1]), "encounter_io_write_frame_snapshot nf90_put_var pl rh_varid" ) - call netcdf_io_check( nf90_put_var(nc%id, nc%vh_varid, pl%vh(:,i), start=[1,idslot,tslot], count=[NDIM,1,1]), "encounter_io_write_frame_snapshot nf90_put_var pl vh_varid" ) - call netcdf_io_check( nf90_put_var(nc%id, nc%Gmass_varid, pl%Gmass(i), start=[idslot, tslot]), "encounter_io_write_frame_snapshot nf90_put_var pl Gmass_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%id_varid, pl%id(i), start=[idslot]), "encounter_netcdf_io_write_frame_snapshot nf90_put_var pl id_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%rh_varid, pl%rh(:,i), start=[1,idslot,tslot], count=[NDIM,1,1]), "encounter_netcdf_io_write_frame_snapshot nf90_put_var pl rh_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%vh_varid, pl%vh(:,i), start=[1,idslot,tslot], count=[NDIM,1,1]), "encounter_netcdf_io_write_frame_snapshot nf90_put_var pl vh_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%Gmass_varid, pl%Gmass(i), start=[idslot, tslot]), "encounter_netcdf_io_write_frame_snapshot nf90_put_var pl Gmass_varid" ) - if (param%lclose) call netcdf_io_check( nf90_put_var(nc%id, nc%radius_varid, pl%radius(i), start=[idslot, tslot]), "encounter_io_write_frame_snapshot nf90_put_var pl radius_varid" ) + if (param%lclose) call netcdf_io_check( nf90_put_var(nc%id, nc%radius_varid, pl%radius(i), start=[idslot, tslot]), "encounter_netcdf_io_write_frame_snapshot nf90_put_var pl radius_varid" ) if (param%lrotation) then - call netcdf_io_check( nf90_put_var(nc%id, nc%Ip_varid, pl%Ip(:,i), start=[1, idslot, tslot], count=[NDIM,1,1]), "encounter_io_write_frame_snapshot nf90_put_var pl Ip_varid" ) - call netcdf_io_check( nf90_put_var(nc%id, nc%rot_varid, pl%rot(:,i), start=[1,idslot, tslot], count=[NDIM,1,1]), "encounter_io_write_frame_snapshot nf90_put_var pl rotx_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%Ip_varid, pl%Ip(:,i), start=[1, idslot, tslot], count=[NDIM,1,1]), "encounter_netcdf_io_write_frame_snapshot nf90_put_var pl Ip_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%rot_varid, pl%rot(:,i), start=[1,idslot, tslot], count=[NDIM,1,1]), "encounter_netcdf_io_write_frame_snapshot nf90_put_var pl rotx_varid" ) end if charstring = trim(adjustl(pl%info(i)%name)) - call netcdf_io_check( nf90_put_var(nc%id, nc%name_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "encounter_io_write_frame_snapshot nf90_put_var pl name_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%name_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "encounter_netcdf_io_write_frame_snapshot nf90_put_var pl name_varid" ) charstring = trim(adjustl(pl%info(i)%particle_type)) - call netcdf_io_check( nf90_put_var(nc%id, nc%ptype_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "encounter_io_write_frame_snapshot nf90_put_var pl particle_type_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%ptype_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "encounter_netcdf_io_write_frame_snapshot nf90_put_var pl particle_type_varid" ) end do ntp = tp%nbody do i = 1, ntp idslot = findloc(history%idvals,tp%id(i),dim=1) - call netcdf_io_check( nf90_put_var(nc%id, nc%id_varid, tp%id(i), start=[idslot]), "encounter_io_write_frame_snapshot nf90_put_var tp id_varid" ) - call netcdf_io_check( nf90_put_var(nc%id, nc%rh_varid, tp%rh(:,i), start=[1,idslot,tslot], count=[NDIM,1,1]), "encounter_io_write_frame_snapshot nf90_put_var tp rh_varid" ) - call netcdf_io_check( nf90_put_var(nc%id, nc%vh_varid, tp%vh(:,i), start=[1,idslot,tslot], count=[NDIM,1,1]), "encounter_io_write_frame_snapshot nf90_put_var tp vh_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%id_varid, tp%id(i), start=[idslot]), "encounter_netcdf_io_write_frame_snapshot nf90_put_var tp id_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%rh_varid, tp%rh(:,i), start=[1,idslot,tslot], count=[NDIM,1,1]), "encounter_netcdf_io_write_frame_snapshot nf90_put_var tp rh_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%vh_varid, tp%vh(:,i), start=[1,idslot,tslot], count=[NDIM,1,1]), "encounter_netcdf_io_write_frame_snapshot nf90_put_var tp vh_varid" ) charstring = trim(adjustl(tp%info(i)%name)) - call netcdf_io_check( nf90_put_var(nc%id, nc%name_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "encounter_io_write_frame_snapshot nf90_put_var tp name_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%name_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "encounter_netcdf_io_write_frame_snapshot nf90_put_var tp name_varid" ) charstring = trim(adjustl(tp%info(i)%particle_type)) - call netcdf_io_check( nf90_put_var(nc%id, nc%ptype_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "encounter_io_write_frame_snapshot nf90_put_var tp particle_type_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%ptype_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "encounter_netcdf_io_write_frame_snapshot nf90_put_var tp particle_type_varid" ) end do call netcdf_io_check( nf90_set_fill(nc%id, old_mode, old_mode) ) @@ -221,9 +221,9 @@ module subroutine encounter_io_write_frame_snapshot(self, history, param) end select return - end subroutine encounter_io_write_frame_snapshot + end subroutine encounter_netcdf_io_write_frame_snapshot -end submodule s_encounter_io \ No newline at end of file +end submodule s_encounter_netcdf_io \ No newline at end of file diff --git a/src/encounter/encounter_module.f90 b/src/encounter/encounter_module.f90 index 0911b0afb..d4d35db92 100644 --- a/src/encounter/encounter_module.f90 +++ b/src/encounter/encounter_module.f90 @@ -53,9 +53,9 @@ module encounter real(DP) :: t !! Simulation time when snapshot was taken integer(I8B) :: iloop !! Loop number at time of snapshot contains - procedure :: write_frame => encounter_io_write_frame_snapshot !! Writes a frame of encounter data to file + procedure :: write_frame => encounter_netcdf_io_write_frame_snapshot !! Writes a frame of encounter data to file procedure :: get_idvals => encounter_util_get_idvalues_snapshot !! Gets an array of all id values saved in this snapshot - final :: encounter_util_final_snapshot + final :: encounter_final_snapshot end type encounter_snapshot !> NetCDF dimension and variable names for the enounter save object @@ -66,7 +66,8 @@ module encounter integer(I4B) :: name_dimsize = 0 !! Number of potential id values in snapshot integer(I4B) :: file_number = 1 !! The number to append on the output file contains - procedure :: initialize => encounter_io_initialize_output !! Initialize a set of parameters used to identify a NetCDF output object + procedure :: initialize => encounter_netcdf_io_initialize_output !! Initialize a set of parameters used to identify a NetCDF output object + final :: encounter_final_netcdf_parameters !! Finalizer will close the NetCDF file end type encounter_netcdf_parameters @@ -74,11 +75,11 @@ module encounter type, extends(base_storage) :: encounter_storage class(encounter_netcdf_parameters), allocatable :: nc !! NetCDF object attached to this storage object contains - procedure :: dump => encounter_io_dump !! Dumps contents of encounter history to file + procedure :: dump => encounter_netcdf_io_dump !! Dumps contents of encounter history to file procedure :: get_index_values => encounter_util_get_vals_storage !! Gets the unique values of the indices of a storage object (i.e. body id or time value) - procedure :: make_index_map => encounter_util_index_map !! Maps body id values to storage index values so we don't have to use unlimited dimensions for id - procedure :: take_snapshot => encounter_util_snapshot !! Take a minimal snapshot of the system through an encounter - final :: encounter_util_final_storage + procedure :: make_index_map => encounter_util_index_map !! Maps body id values to storage index values so we don't have to use unlimited dimensions for id + procedure :: take_snapshot => encounter_util_snapshot !! Take a minimal snapshot of the system through an encounter + final :: encounter_final_storage end type encounter_storage @@ -91,7 +92,7 @@ module encounter contains procedure :: sort => encounter_check_sort_aabb_1D !! Sorts the bounding box extents along a single dimension prior to the sweep phase procedure :: dealloc => encounter_util_dealloc_aabb !! Deallocates all allocatables - final :: encounter_util_final_aabb !! Finalize the axis-aligned bounding box (1D) - deallocates all allocatables + final :: encounter_final_aabb !! Finalize the axis-aligned bounding box (1D) - deallocates all allocatables end type @@ -217,24 +218,24 @@ 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_dump(self, param) + module subroutine encounter_netcdf_io_dump(self, param) implicit none class(encounter_storage(*)), intent(inout) :: self !! Encounter storage object class(base_parameters), intent(inout) :: param !! Current run configuration parameters - end subroutine encounter_io_dump + end subroutine encounter_netcdf_io_dump - module subroutine encounter_io_initialize_output(self, param) + module subroutine encounter_netcdf_io_initialize_output(self, param) implicit none class(encounter_netcdf_parameters), intent(inout) :: self !! Parameters used to identify a particular NetCDF dataset class(base_parameters), intent(in) :: param - end subroutine encounter_io_initialize_output + end subroutine encounter_netcdf_io_initialize_output - module subroutine encounter_io_write_frame_snapshot(self, history, param) + module subroutine encounter_netcdf_io_write_frame_snapshot(self, history, param) implicit none class(encounter_snapshot), intent(in) :: self !! Swiftest encounter structure class(encounter_storage(*)), intent(inout) :: history !! Encounter storage object class(base_parameters), intent(inout) :: param !! Current run configuration parameters - end subroutine encounter_io_write_frame_snapshot + end subroutine encounter_netcdf_io_write_frame_snapshot module subroutine encounter_setup_aabb(self, n, n_last) implicit none @@ -272,20 +273,6 @@ module subroutine encounter_util_dealloc_list(self) class(encounter_list), intent(inout) :: self !! Swiftest encounter list object end subroutine encounter_util_dealloc_list - module subroutine encounter_util_final_aabb(self) - implicit none - type(encounter_bounding_box_1D), intent(inout) :: self !!Bounding box structure along a single dimension - end subroutine encounter_util_final_aabb - - module subroutine encounter_util_final_snapshot(self) - implicit none - type(encounter_snapshot), intent(inout) :: self !! Encounter snapshot object - end subroutine encounter_util_final_snapshot - - module subroutine encounter_util_final_storage(self) - implicit none - type(encounter_storage(*)), intent(inout) :: self !! SyMBA nbody system object - end subroutine encounter_util_final_storage module subroutine encounter_util_get_idvalues_snapshot(self, idvals) implicit none @@ -329,5 +316,70 @@ end subroutine encounter_util_spill_list end interface + contains + + subroutine encounter_final_aabb(self) + !! author: David A. Minton + !! + !! Finalize the axis aligned bounding box (1D) - deallocates all allocatables + implicit none + ! Arguments + type(encounter_bounding_box_1D), intent(inout) :: self + + call self%dealloc() + + return + end subroutine encounter_final_aabb + + + subroutine encounter_final_netcdf_parameters(self) + !! author: David A. Minton + !! + !! Finalize the NetCDF by closing the file + implicit none + ! Arguments + type(encounter_netcdf_parameters), intent(inout) :: self + + call self%close() + + return + end subroutine encounter_final_netcdf_parameters + + + subroutine encounter_final_snapshot(self) + !! author: David A. Minton + !! + !! Deallocates allocatable arrays in an encounter snapshot + implicit none + ! Arguments + type(encounter_snapshot), intent(inout) :: self !! Encounter storage object + + if (allocated(self%pl)) deallocate(self%pl) + if (allocated(self%tp)) deallocate(self%tp) + self%t = 0.0_DP + + return + end subroutine encounter_final_snapshot + + + subroutine encounter_final_storage(self) + !! author: David A. Minton + !! + !! Deallocates allocatable arrays in an encounter snapshot + implicit none + ! Arguments + type(encounter_storage(*)), intent(inout) :: self !! Encounter storage object + ! Internals + integer(I4B) :: i + + do i = 1, self%nframes + if (allocated(self%frame(i)%item)) deallocate(self%frame(i)%item) + end do + + return + + return + end subroutine encounter_final_storage + end module encounter diff --git a/src/encounter/encounter_util.f90 b/src/encounter/encounter_util.f90 index b124c5fbf..5c26771a5 100644 --- a/src/encounter/encounter_util.f90 +++ b/src/encounter/encounter_util.f90 @@ -119,56 +119,6 @@ module subroutine encounter_util_dealloc_list(self) end subroutine encounter_util_dealloc_list - module subroutine encounter_util_final_aabb(self) - !! author: David A. Minton - !! - !! Finalize the axis aligned bounding box (1D) - deallocates all allocatables - implicit none - ! Arguments - type(encounter_bounding_box_1D), intent(inout) :: self - - call self%dealloc() - - return - end subroutine encounter_util_final_aabb - - - module subroutine encounter_util_final_snapshot(self) - !! author: David A. Minton - !! - !! Deallocates allocatable arrays in an encounter snapshot - implicit none - ! Arguments - type(encounter_snapshot), intent(inout) :: self !! Encounter storage object - - if (allocated(self%pl)) deallocate(self%pl) - if (allocated(self%tp)) deallocate(self%tp) - self%t = 0.0_DP - - return - end subroutine encounter_util_final_snapshot - - - module subroutine encounter_util_final_storage(self) - !! author: David A. Minton - !! - !! Deallocates allocatable arrays in an encounter snapshot - implicit none - ! Arguments - type(encounter_storage(*)), intent(inout) :: self !! Encounter storage object - ! Internals - integer(I4B) :: i - - do i = 1, self%nframes - if (allocated(self%frame(i)%item)) deallocate(self%frame(i)%item) - end do - - return - - return - end subroutine encounter_util_final_storage - - module subroutine encounter_util_get_idvalues_snapshot(self, idvals) !! author: David A. Minton !! diff --git a/src/fraggle/fraggle_module.f90 b/src/fraggle/fraggle_module.f90 index 6b336fff4..e77dd44e2 100644 --- a/src/fraggle/fraggle_module.f90 +++ b/src/fraggle/fraggle_module.f90 @@ -21,7 +21,6 @@ module fraggle integer(I4B), parameter :: FRAGGLE_NMASS_DIST = 3 !! Number of mass bins returned by the regime calculation (largest fragment, second largest, and remainder) character(len=*), parameter :: FRAGGLE_LOG_OUT = "fraggle.log" !! Name of log file for Fraggle diagnostic information - !> Class definition for the variables that describe a collection of fragments by Fraggle barycentric coordinates type, extends(collision_fragments) :: fraggle_fragments @@ -39,7 +38,7 @@ module fraggle procedure :: get_angular_momentum => fraggle_util_get_angular_momentum !! Calcualtes the current angular momentum of the fragments procedure :: reset => fraggle_util_reset_fragments !! Resets all position and velocity-dependent fragment quantities in order to do a fresh calculation (does not reset mass, radius, or other values that get set prior to the call to fraggle_generate) procedure :: restructure => fraggle_util_restructure !! Restructure the inputs after a failed attempt failed to find a set of positions and velocities that satisfy the energy and momentum constraints - final :: fraggle_util_final_fragments !! Finalizer will deallocate all allocatables + final :: fraggle_final_fragments !! Finalizer will deallocate all allocatables end type fraggle_fragments @@ -60,7 +59,7 @@ module fraggle procedure :: setup_fragments => fraggle_setup_fragments_system !! Initializer for the fragments of the collision system. procedure :: construct_temporary_system => fraggle_util_construct_temporary_system !! Constructs temporary n-body system in order to compute pre- and post-impact energy and momentum procedure :: reset => fraggle_util_reset_system !! Deallocates all allocatables - final :: fraggle_util_final_system !! Finalizer will deallocate all allocatables + final :: fraggle_final_system !! Finalizer will deallocate all allocatables end type fraggle_system @@ -138,20 +137,10 @@ module subroutine fraggle_util_construct_temporary_system(self, nbody_system, pa class(base_parameters), allocatable, intent(out) :: tmpparam !! Output temporary configuration run parameters end subroutine fraggle_util_construct_temporary_system - module subroutine fraggle_util_final_impactors(self) + module subroutine fraggle_final_impactors(self) implicit none type(collision_impactors), intent(inout) :: self !! Fraggle impactors object - end subroutine fraggle_util_final_impactors - - module subroutine fraggle_util_final_fragments(self) - implicit none - type(fraggle_fragments(*)), intent(inout) :: self !! Fraggle frgments object - end subroutine fraggle_util_final_fragments - - module subroutine fraggle_util_final_system(self) - implicit none - type(fraggle_system), intent(inout) :: self !! Collision system object - end subroutine fraggle_util_final_system + end subroutine fraggle_final_impactors module subroutine fraggle_util_reset_fragments(self) implicit none @@ -189,4 +178,37 @@ module function fraggle_util_vmag_to_vb(v_r_mag, v_r_unit, v_t_mag, v_t_unit, m_ end function fraggle_util_vmag_to_vb end interface + contains + + + + subroutine fraggle_final_fragments(self) + !! author: David A. Minton + !! + !! Finalizer will deallocate all allocatables + implicit none + ! Arguments + type(fraggle_fragments(*)), intent(inout) :: self !! Fraggle encountar storage object + + call self%collision_fragments%reset() + + return + end subroutine fraggle_final_fragments + + + subroutine fraggle_final_system(self) + !! author: David A. Minton + !! + !! Finalizer will deallocate all allocatables + implicit none + ! Arguments + type(fraggle_system), intent(inout) :: self !! Collision impactors storage object + + call self%reset() + if (allocated(self%impactors)) deallocate(self%impactors) + if (allocated(self%fragments)) deallocate(self%fragments) + + return + end subroutine fraggle_final_system + end module fraggle \ No newline at end of file diff --git a/src/fraggle/fraggle_util.f90 b/src/fraggle/fraggle_util.f90 index 62581c0db..e0303f996 100644 --- a/src/fraggle/fraggle_util.f90 +++ b/src/fraggle/fraggle_util.f90 @@ -62,36 +62,6 @@ module subroutine fraggle_util_construct_temporary_system(self, nbody_system, pa end subroutine fraggle_util_construct_temporary_system - module subroutine fraggle_util_final_fragments(self) - !! author: David A. Minton - !! - !! Finalizer will deallocate all allocatables - implicit none - ! Arguments - type(fraggle_fragments(*)), intent(inout) :: self !! Fraggle encountar storage object - - call self%collision_fragments%reset() - - return - end subroutine fraggle_util_final_fragments - - - module subroutine fraggle_util_final_system(self) - !! author: David A. Minton - !! - !! Finalizer will deallocate all allocatables - implicit none - ! Arguments - type(fraggle_system), intent(inout) :: self !! Collision impactors storage object - - call self%reset() - if (allocated(self%impactors)) deallocate(self%impactors) - if (allocated(self%fragments)) deallocate(self%fragments) - - return - end subroutine fraggle_util_final_system - - module subroutine fraggle_util_reset_fragments(self) !! author: David A. Minton !! diff --git a/src/helio/helio_module.f90 b/src/helio/helio_module.f90 index 8a93badae..c33583529 100644 --- a/src/helio/helio_module.f90 +++ b/src/helio/helio_module.f90 @@ -22,7 +22,7 @@ module helio contains procedure :: step => helio_step_system !! Advance the Helio nbody system forward in time by one step procedure :: initialize => helio_setup_initialize_system !! Performs Helio-specific initilization steps, including converting to DH coordinates - final :: helio_util_final_system !! Finalizes the Helio system object - deallocates all allocatables + final :: helio_final_system !! Finalizes the Helio system object - deallocates all allocatables end type helio_nbody_system @@ -44,7 +44,7 @@ module helio procedure :: accel => helio_kick_getacch_pl !! Compute heliocentric accelerations of massive bodies procedure :: kick => helio_kick_vb_pl !! Kicks the barycentric velocities procedure :: step => helio_step_pl !! Steps the body forward one stepsize - final :: helio_util_final_pl !! Finalizes the Helio massive body object - deallocates all allocatables + final :: helio_final_pl !! Finalizes the Helio massive body object - deallocates all allocatables end type helio_pl @@ -58,7 +58,7 @@ module helio procedure :: accel => helio_kick_getacch_tp !! Compute heliocentric accelerations of massive bodies procedure :: kick => helio_kick_vb_tp !! Kicks the barycentric velocities procedure :: step => helio_step_tp !! Steps the body forward one stepsize - final :: helio_util_final_tp !! Finalizes the Helio test particle object - deallocates all allocatables + final :: helio_final_tp !! Finalizes the Helio test particle object - deallocates all allocatables end type helio_tp interface @@ -199,22 +199,49 @@ module subroutine helio_step_tp(self, system, param, t, dt) real(DP), intent(in) :: t !! Current simulation time real(DP), intent(in) :: dt !! Stepsizee end subroutine helio_step_tp + end interface + + contains - module subroutine helio_util_final_pl(self) + subroutine helio_final_pl(self) + !! author: David A. Minton + !! + !! Finalize the Helio massive body object - deallocates all allocatables implicit none + ! Arguments type(helio_pl), intent(inout) :: self !! Helio massive body object - end subroutine helio_util_final_pl - module subroutine helio_util_final_system(self) + call self%dealloc() + + return + end subroutine helio_final_pl + + + subroutine helio_final_system(self) + !! author: David A. Minton + !! + !! Finalize the Helio nbody system object - deallocates all allocatables implicit none + ! Arguments type(helio_nbody_system), intent(inout) :: self !! Helio nbody system object - end subroutine helio_util_final_system - module subroutine helio_util_final_tp(self) + call whm_final_system(self%whm_nbody_system) + + return + end subroutine helio_final_system + + + subroutine helio_final_tp(self) + !! author: David A. Minton + !! + !! Finalize the Helio test particle object - deallocates all allocatables implicit none + ! Arguments type(helio_tp), intent(inout) :: self !! Helio test particle object - end subroutine helio_util_final_tp - end interface + call self%dealloc() + + return + end subroutine helio_final_tp end module helio diff --git a/src/helio/helio_util.f90 b/src/helio/helio_util.f90 deleted file mode 100644 index 3568fa557..000000000 --- a/src/helio/helio_util.f90 +++ /dev/null @@ -1,55 +0,0 @@ -!! Copyright 2022 - David Minton, Carlisle Wishard, Jennifer Pouplin, Jake Elliott, & Dana Singh -!! This file is part of Swiftest. -!! Swiftest is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License -!! as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. -!! Swiftest is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty -!! of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. -!! You should have received a copy of the GNU General Public License along with Swiftest. -!! If not, see: https://www.gnu.org/licenses. - -submodule(helio) s_helio_util - use swiftest -contains - - module subroutine helio_util_final_pl(self) - !! author: David A. Minton - !! - !! Finalize the Helio massive body object - deallocates all allocatables - implicit none - ! Arguments - type(helio_pl), intent(inout) :: self !! Helio massive body object - - call self%dealloc() - - return - end subroutine helio_util_final_pl - - - module subroutine helio_util_final_system(self) - !! author: David A. Minton - !! - !! Finalize the Helio nbody system object - deallocates all allocatables - implicit none - ! Arguments - type(helio_nbody_system), intent(inout) :: self !! Helio nbody system object - - call whm_util_final_system(self%whm_nbody_system) - - return - end subroutine helio_util_final_system - - - module subroutine helio_util_final_tp(self) - !! author: David A. Minton - !! - !! Finalize the Helio test particle object - deallocates all allocatables - implicit none - ! Arguments - type(helio_tp), intent(inout) :: self !! Helio test particle object - - call self%dealloc() - - return - end subroutine helio_util_final_tp - -end submodule s_helio_util \ No newline at end of file diff --git a/src/rmvs/rmvs_module.f90 b/src/rmvs/rmvs_module.f90 index b42e0a937..e6d3c7553 100644 --- a/src/rmvs/rmvs_module.f90 +++ b/src/rmvs/rmvs_module.f90 @@ -34,7 +34,7 @@ module rmvs !> Replace the abstract procedures with concrete ones procedure :: initialize => rmvs_setup_initialize_system !! Performs RMVS-specific initilization steps, including generating the close encounter planetocentric structures procedure :: step => rmvs_step_system !! Advance the RMVS nbody system forward in time by one step - final :: rmvs_util_final_system !! Finalizes the RMVS nbody system object - deallocates all allocatables + final :: rmvs_final_system !! Finalizes the RMVS nbody system object - deallocates all allocatables end type rmvs_nbody_system type, private :: rmvs_interp @@ -44,7 +44,7 @@ module rmvs real(DP), dimension(:, :), allocatable :: atide !! Encountering planet's tidal acceleration value contains procedure :: dealloc => rmvs_util_dealloc_interp !! Deallocates all allocatable arrays - final :: rmvs_util_final_interp !! Finalizes the RMVS interpolated system variables object - deallocates all allocatables + final :: rmvs_final_interp !! Finalizes the RMVS interpolated system variables object - deallocates all allocatables end type rmvs_interp @@ -55,7 +55,7 @@ module rmvs logical :: lplanetocentric = .false. !! Flag that indicates that the object is a planetocentric set of masive bodies used for close encounter calculations contains procedure :: dealloc => rmvs_util_dealloc_cb !! Deallocates all allocatable arrays - final :: rmvs_util_final_cb !! Finalizes the RMVS central body object - deallocates all allocatables + final :: rmvs_final_cb !! Finalizes the RMVS central body object - deallocates all allocatables end type rmvs_cb @@ -87,7 +87,7 @@ module rmvs procedure :: sort => rmvs_util_sort_tp !! Sorts body arrays by a sortable componen procedure :: rearrange => rmvs_util_sort_rearrange_tp !! Rearranges the order of array elements of body based on an input index array. Used in sorting methods procedure :: spill => rmvs_util_spill_tp !! "Spills" bodies from one object to another depending on the results of a mask (uses the PACK intrinsic) - final :: rmvs_util_final_tp !! Finalizes the RMVS test particle object - deallocates all allocatables + final :: rmvs_final_tp !! Finalizes the RMVS test particle object - deallocates all allocatables end type rmvs_tp @@ -109,7 +109,7 @@ module rmvs procedure :: sort => rmvs_util_sort_pl !! Sorts body arrays by a sortable componen procedure :: rearrange => rmvs_util_sort_rearrange_pl !! Rearranges the order of array elements of body based on an input index array. Used in sorting methods procedure :: spill => rmvs_util_spill_pl !! "Spills" bodies from one object to another depending on the results of a mask (uses the PACK intrinsic) - final :: rmvs_util_final_pl !! Finalizes the RMVS massive body object - deallocates all allocatables + final :: rmvs_final_pl !! Finalizes the RMVS massive body object - deallocates all allocatables end type rmvs_pl interface @@ -206,30 +206,30 @@ module subroutine rmvs_util_fill_tp(self, inserts, lfill_list) logical, dimension(:), intent(in) :: lfill_list !! Logical array of bodies to merge into the keeps end subroutine rmvs_util_fill_tp - module subroutine rmvs_util_final_cb(self) + module subroutine rmvs_final_cb(self) implicit none type(rmvs_cb), intent(inout) :: self !! RMVS central body object - end subroutine rmvs_util_final_cb + end subroutine rmvs_final_cb - module subroutine rmvs_util_final_interp(self) + module subroutine rmvs_final_interp(self) implicit none type(rmvs_interp), intent(inout) :: self !! RMVS interpolated system variables object - end subroutine rmvs_util_final_interp + end subroutine rmvs_final_interp - module subroutine rmvs_util_final_pl(self) + module subroutine rmvs_final_pl(self) implicit none type(rmvs_pl), intent(inout) :: self !! RMVS massive body object - end subroutine rmvs_util_final_pl + end subroutine rmvs_final_pl - module subroutine rmvs_util_final_system(self) + module subroutine rmvs_final_system(self) implicit none type(rmvs_nbody_system), intent(inout) :: self !! RMVS nbody system object - end subroutine rmvs_util_final_system + end subroutine rmvs_final_system - module subroutine rmvs_util_final_tp(self) + module subroutine rmvs_final_tp(self) implicit none type(rmvs_tp), intent(inout) :: self !! RMVS test particle object - end subroutine rmvs_util_final_tp + end subroutine rmvs_final_tp module subroutine rmvs_util_resize_pl(self, nnew) implicit none diff --git a/src/rmvs/rmvs_util.f90 b/src/rmvs/rmvs_util.f90 index 09159afb5..d39eeeddc 100644 --- a/src/rmvs/rmvs_util.f90 +++ b/src/rmvs/rmvs_util.f90 @@ -182,7 +182,7 @@ module subroutine rmvs_util_fill_pl(self, inserts, lfill_list) end subroutine rmvs_util_fill_pl - module subroutine rmvs_util_final_cb(self) + module subroutine rmvs_final_cb(self) !! author: David A. Minton !! !! Finalize the RMVS massive body object - deallocates all allocatables @@ -193,10 +193,10 @@ module subroutine rmvs_util_final_cb(self) call self%dealloc() return - end subroutine rmvs_util_final_cb + end subroutine rmvs_final_cb - module subroutine rmvs_util_final_interp(self) + module subroutine rmvs_final_interp(self) !! author: David A. Minton !! !! Finalize the RMVS nbody system object - deallocates all allocatables @@ -207,10 +207,10 @@ module subroutine rmvs_util_final_interp(self) call self%dealloc() return - end subroutine rmvs_util_final_interp + end subroutine rmvs_final_interp - module subroutine rmvs_util_final_pl(self) + module subroutine rmvs_final_pl(self) !! author: David A. Minton !! !! Finalize the RMVS massive body object - deallocates all allocatables @@ -221,10 +221,10 @@ module subroutine rmvs_util_final_pl(self) call self%dealloc() return - end subroutine rmvs_util_final_pl + end subroutine rmvs_final_pl - module subroutine rmvs_util_final_system(self) + module subroutine rmvs_final_system(self) !! author: David A. Minton !! !! Finalize the RMVS nbody system object - deallocates all allocatables @@ -233,13 +233,13 @@ module subroutine rmvs_util_final_system(self) type(rmvs_nbody_system), intent(inout) :: self !! RMVS nbody system object if (allocated(self%vbeg)) deallocate(self%vbeg) - call whm_util_final_system(self%whm_nbody_system) + call whm_final_system(self%whm_nbody_system) return - end subroutine rmvs_util_final_system + end subroutine rmvs_final_system - module subroutine rmvs_util_final_tp(self) + module subroutine rmvs_final_tp(self) !! author: David A. Minton !! !! Finalize the RMVS test particle object - deallocates all allocatables @@ -250,7 +250,7 @@ module subroutine rmvs_util_final_tp(self) call self%dealloc() return - end subroutine rmvs_util_final_tp + end subroutine rmvs_final_tp module subroutine rmvs_util_fill_tp(self, inserts, lfill_list) diff --git a/src/swiftest/swiftest_module.f90 b/src/swiftest/swiftest_module.f90 index 6347629b0..347096476 100644 --- a/src/swiftest/swiftest_module.f90 +++ b/src/swiftest/swiftest_module.f90 @@ -55,6 +55,7 @@ module swiftest procedure :: initialize => swiftest_io_netcdf_initialize_output !! Initialize a set of parameters used to identify a NetCDF output object procedure :: open => swiftest_io_netcdf_open !! Opens a NetCDF file and does the variable inquiries to activate variable ids procedure :: flush => swiftest_io_netcdf_flush !! Flushes a NetCDF file by closing it then opening it again + final :: swiftest_final_netcdf_parameters !! Finalizer will close the NetCDF file end type swiftest_netcdf_parameters @@ -65,7 +66,7 @@ module swiftest procedure :: get_index_values => swiftest_util_get_vals_storage !! Gets the unique values of the indices of a storage object (i.e. body id or time value) procedure :: make_index_map => swiftest_util_index_map_storage !! Maps body id values to storage index values so we don't have to use unlimited dimensions for id procedure :: take_snapshot => swiftest_util_snapshot_system !! Takes a snapshot of the system for later file storage - final :: swiftest_util_final_storage + final :: swiftest_final_storage end type swiftest_storage @@ -88,7 +89,7 @@ module swiftest integer(I4B), dimension(:), allocatable :: child !! Index of children particles contains procedure :: dealloc => swiftest_util_dealloc_kin !! Deallocates all allocatable arrays - final :: swiftest_util_final_kin !! Finalizes the Swiftest kinship object - deallocates all allocatables + final :: swiftest_final_kin !! Finalizes the Swiftest kinship object - deallocates all allocatables end type swiftest_kinship @@ -1225,16 +1226,6 @@ module subroutine swiftest_util_dealloc_pl(self) class(swiftest_pl), intent(inout) :: self end subroutine swiftest_util_dealloc_pl - module subroutine swiftest_util_final_kin(self) - implicit none - type(swiftest_kinship), intent(inout) :: self !! Swiftest kinship object - end subroutine swiftest_util_final_kin - - module subroutine swiftest_util_final_system(self) - implicit none - class(swiftest_nbody_system), intent(inout) :: self - end subroutine swiftest_util_final_system - module subroutine swiftest_util_dealloc_tp(self) implicit none class(swiftest_tp), intent(inout) :: self @@ -1252,7 +1243,6 @@ module subroutine swiftest_util_fill_body(self, inserts, lfill_list) logical, dimension(:), intent(in) :: lfill_list !! Logical array of bodies to merge into the keeps end subroutine swiftest_util_fill_body - module subroutine swiftest_util_fill_pl(self, inserts, lfill_list) implicit none class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object @@ -1321,11 +1311,6 @@ end subroutine swiftest_util_fill_arr_logical interface - module subroutine swiftest_util_final_storage(self) - implicit none - type(swiftest_storage(*)) :: self - end subroutine swiftest_util_final_storage - pure module subroutine swiftest_util_flatten_eucl_ij_to_k(n, i, j, k) !$omp declare simd(swiftest_util_flatten_eucl_ij_to_k) implicit none @@ -1859,4 +1844,68 @@ subroutine make_impactors_pl(self, idx) end subroutine make_impactors_pl + subroutine swiftest_final_kin(self) + !! author: David A. Minton + !! + !! Finalize the swiftest kinship object - deallocates all allocatables + implicit none + ! Argument + type(swiftest_kinship), intent(inout) :: self !! SyMBA kinship object + + call self%dealloc() + + return + end subroutine swiftest_final_kin + + + subroutine swiftest_final_netcdf_parameters(self) + !! author: David A. Minton + !! + !! Finalize the NetCDF by closing the file + implicit none + ! Arguments + type(swiftest_netcdf_parameters), intent(inout) :: self + + call self%close() + + return + end subroutine swiftest_final_netcdf_parameters + + + subroutine swiftest_final_storage(self) + !! author: David A. Minton + !! + !! Finalizer for the storage data type + implicit none + ! Arguments + type(swiftest_storage(*)) :: self + ! Internals + integer(I4B) :: i + + do i = 1, self%nframes + if (allocated(self%frame(i)%item)) deallocate(self%frame(i)%item) + end do + + return + end subroutine swiftest_final_storage + + + subroutine swiftest_final_system(self) + !! author: David A. Minton + !! + !! Finalize the swiftest nbody system object - deallocates all allocatables + implicit none + ! Argument + class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nbody system object + + if (allocated(self%cb)) deallocate(self%cb) + if (allocated(self%pl)) deallocate(self%pl) + if (allocated(self%tp)) deallocate(self%tp) + if (allocated(self%tp_discards)) deallocate(self%tp_discards) + if (allocated(self%pl_discards)) deallocate(self%pl_discards) + + return + end subroutine swiftest_final_system + + end module swiftest diff --git a/src/swiftest/swiftest_obl.f90 b/src/swiftest/swiftest_obl.f90 index 3d3109d8c..bb785232b 100644 --- a/src/swiftest/swiftest_obl.f90 +++ b/src/swiftest/swiftest_obl.f90 @@ -65,7 +65,7 @@ module subroutine swiftest_obl_acc_pl(self, system) if (self%nbody == 0) return associate(pl => self, npl => self%nbody, cb => system%cb) - call obl_acc_body(pl, system) + call swiftest_obl_acc_body(pl, system) cb%aobl(:) = 0.0_DP do i = npl, 1, -1 if (pl%lmask(i)) cb%aobl(:) = cb%aobl(:) - pl%Gmass(i) * pl%aobl(:, i) / cb%Gmass @@ -99,7 +99,7 @@ module subroutine swiftest_obl_acc_tp(self, system) if (self%nbody == 0) return associate(tp => self, ntp => self%nbody, cb => system%cb) - call obl_acc_body(tp, system) + call swiftest_obl_acc_body(tp, system) if (system%lbeg) then aoblcb = cb%aoblbeg else diff --git a/src/swiftest/swiftest_util.f90 b/src/swiftest/swiftest_util.f90 index 3326f96c8..8393b1d70 100644 --- a/src/swiftest/swiftest_util.f90 +++ b/src/swiftest/swiftest_util.f90 @@ -176,7 +176,7 @@ module subroutine swiftest_util_append_arr_kin(arr, source, nold, nsrc, lsource_ if (.not.allocated(arr)) then allocate(arr(nold+nnew)) else - call util_resize(arr, nold + nnew) + call swiftest_util_resize(arr, nold + nnew) end if arr(nold + 1:nold + nnew) = pack(source(1:nsrc), lsource_mask(1:nsrc)) @@ -1114,42 +1114,6 @@ module subroutine swiftest_util_fill_tp(self, inserts, lfill_list) end subroutine swiftest_util_fill_tp - module subroutine swiftest_util_final_storage(self) - !! author: David A. Minton - !! - !! Finalizer for the storage data type - implicit none - ! Arguments - type(swiftest_storage(*)) :: self - ! Internals - integer(I4B) :: i - - do i = 1, self%nframes - if (allocated(self%frame(i)%item)) deallocate(self%frame(i)%item) - end do - - return - end subroutine swiftest_util_final_storage - - - module subroutine swiftest_util_final_system(self) - !! author: David A. Minton - !! - !! Finalize the swiftest nbody system object - deallocates all allocatables - implicit none - ! Argument - class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nbody system object - - if (allocated(self%cb)) deallocate(self%cb) - if (allocated(self%pl)) deallocate(self%pl) - if (allocated(self%tp)) deallocate(self%tp) - if (allocated(self%tp_discards)) deallocate(self%tp_discards) - if (allocated(self%pl_discards)) deallocate(self%pl_discards) - - return - end subroutine swiftest_util_final_system - - pure module subroutine swiftest_util_flatten_eucl_ij_to_k(n, i, j, k) !! author: Jacob R. Elliott and David A. Minton !! diff --git a/src/symba/symba_module.f90 b/src/symba/symba_module.f90 index fcd934c1a..f8d8db5ec 100644 --- a/src/symba/symba_module.f90 +++ b/src/symba/symba_module.f90 @@ -49,7 +49,7 @@ module symba procedure :: sort => symba_util_sort_pl !! Sorts body arrays by a sortable componen procedure :: rearrange => symba_util_sort_rearrange_pl !! Rearranges the order of array elements of body based on an input index array. Used in sorting methods procedure :: spill => symba_util_spill_pl !! "Spills" bodies from one object to another depending on the results of a mask (uses the PACK intrinsic) - final :: symba_util_final_pl !! Finalizes the SyMBA massive body object - deallocates all allocatables + final :: symba_final_pl !! Finalizes the SyMBA massive body object - deallocates all allocatables end type symba_pl @@ -70,7 +70,7 @@ module symba procedure :: sort => symba_util_sort_tp !! Sorts body arrays by a sortable componen procedure :: rearrange => symba_util_sort_rearrange_tp !! Rearranges the order of array elements of body based on an input index array. Used in sorting methods procedure :: spill => symba_util_spill_tp !! "Spills" bodies from one object to another depending on the results of a mask (uses the PACK intrinsic) - final :: symba_util_final_tp !! Finalizes the SyMBA test particle object - deallocates all allocatables + final :: symba_final_tp !! Finalizes the SyMBA test particle object - deallocates all allocatables end type symba_tp @@ -79,7 +79,7 @@ module symba contains procedure :: encounter_check => symba_encounter_check_list_plpl !! Checks if massive bodies are going through close encounters with each other procedure :: kick => symba_kick_list_plpl !! Kick barycentric velocities of active massive bodies within SyMBA recursion - final :: symba_util_final_list_plpl !! Finalizes the SyMBA test particle object - deallocates all allocatables + final :: symba_final_list_plpl !! Finalizes the SyMBA test particle object - deallocates all allocatables end type symba_list_plpl @@ -88,7 +88,7 @@ module symba contains procedure :: encounter_check => symba_encounter_check_list_pltp !! Checks if massive bodies are going through close encounters with test particles procedure :: kick => symba_kick_list_pltp !! Kick barycentric velocities of active test particles within SyMBA recursion - final :: symba_util_final_list_pltp !! Finalizes the SyMBA test particle object - deallocates all allocatables + final :: symba_final_list_pltp !! Finalizes the SyMBA test particle object - deallocates all allocatables end type symba_list_pltp @@ -101,7 +101,7 @@ module symba procedure :: set_recur_levels => symba_step_set_recur_levels_system !! Sets recursion levels of bodies and encounter lists to the current system level procedure :: recursive_step => symba_step_recur_system !! Step interacting planets and active test particles ahead in democratic heliocentric coordinates at the current recursion level, if applicable, and descend to the next deeper level if necessary procedure :: reset => symba_step_reset_system !! Resets pl, tp,and encounter structures at the start of a new step - final :: symba_util_final_system !! Finalizes the SyMBA nbody system object - deallocates all allocatables + final :: symba_final_system !! Finalizes the SyMBA nbody system object - deallocates all allocatables end type symba_nbody_system interface @@ -346,31 +346,6 @@ module subroutine symba_util_flatten_eucl_plpl(self, param) class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters end subroutine symba_util_flatten_eucl_plpl - module subroutine symba_util_final_list_plpl(self) - implicit none - type(symba_list_plpl), intent(inout) :: self !! SyMBA encounter list object - end subroutine symba_util_final_list_plpl - - module subroutine symba_util_final_list_pltp(self) - implicit none - type(symba_list_pltp), intent(inout) :: self !! SyMBA encounter list object - end subroutine symba_util_final_list_pltp - - module subroutine symba_util_final_pl(self) - implicit none - type(symba_pl), intent(inout) :: self !! SyMBA massive body object - end subroutine symba_util_final_pl - - module subroutine symba_util_final_system(self) - implicit none - type(symba_nbody_system), intent(inout) :: self !! SyMBA nbody system object - end subroutine symba_util_final_system - - module subroutine symba_util_final_tp(self) - implicit none - type(symba_tp), intent(inout) :: self !! SyMBA test particle object - end subroutine symba_util_final_tp - end interface interface @@ -433,4 +408,79 @@ module subroutine symba_util_spill_tp(self, discards, lspill_list, ldestructive) end subroutine symba_util_spill_tp end interface + + contains + + + subroutine symba_final_list_plpl(self) + !! author: David A. Minton + !! + !! Finalize the pl-tp list - deallocates all allocatables + implicit none + type(symba_list_plpl), intent(inout) :: self !! SyMBA encounter list object + + call self%dealloc() + + return + end subroutine symba_final_list_plpl + + + subroutine symba_final_list_pltp(self) + !! author: David A. Minton + !! + !! Finalize the pl-tp list - deallocates all allocatables + implicit none + type(symba_list_pltp), intent(inout) :: self !! SyMBA encounter list object + + call self%dealloc() + + return + end subroutine symba_final_list_pltp + + + subroutine symba_final_pl(self) + !! author: David A. Minton + !! + !! Finalize the SyMBA massive body object - deallocates all allocatables + implicit none + ! Argument + type(symba_pl), intent(inout) :: self !! SyMBA massive body object + + call self%dealloc() + + return + end subroutine symba_final_pl + + + subroutine symba_final_system(self) + !! author: David A. Minton + !! + !! Finalize the SyMBA nbody system object - deallocates all allocatables + implicit none + ! Argument + type(symba_nbody_system), intent(inout) :: self !! SyMBA nbody system object + + if (allocated(self%pl_adds)) deallocate(self%pl_adds) + if (allocated(self%pltp_encounter)) deallocate(self%pltp_encounter) + if (allocated(self%plpl_encounter)) deallocate(self%plpl_encounter) + if (allocated(self%plpl_collision)) deallocate(self%plpl_collision) + + call helio_final_system(self%helio_nbody_system) + + return + end subroutine symba_final_system + + + subroutine symba_final_tp(self) + !! author: David A. Minton + !! + !! Finalize the SyMBA test particleobject - deallocates all allocatables + implicit none + ! Argument + type(symba_tp), intent(inout) :: self !! SyMBA test particle object + + call self%dealloc() + + return + end subroutine symba_final_tp end module symba \ No newline at end of file diff --git a/src/symba/symba_util.f90 b/src/symba/symba_util.f90 index 6b91857a5..a374f9540 100644 --- a/src/symba/symba_util.f90 +++ b/src/symba/symba_util.f90 @@ -25,17 +25,8 @@ module subroutine symba_util_append_pl(self, source, lsource_mask) select type(source) class is (symba_pl) associate(nold => self%nbody, nsrc => source%nbody) - call swiftest_util_append(self%lcollision, source%lcollision, nold, nsrc, lsource_mask) - call swiftest_util_append(self%lencounter, source%lencounter, nold, nsrc, lsource_mask) - call swiftest_util_append(self%lmtiny, source%lmtiny, nold, nsrc, lsource_mask) - call swiftest_util_append(self%nplenc, source%nplenc, nold, nsrc, lsource_mask) - call swiftest_util_append(self%ntpenc, source%ntpenc, nold, nsrc, lsource_mask) call swiftest_util_append(self%levelg, source%levelg, nold, nsrc, lsource_mask) call swiftest_util_append(self%levelm, source%levelm, nold, nsrc, lsource_mask) - call swiftest_util_append(self%isperi, source%isperi, nold, nsrc, lsource_mask) - call swiftest_util_append(self%peri, source%peri, nold, nsrc, lsource_mask) - call swiftest_util_append(self%atp, source%atp, nold, nsrc, lsource_mask) - call swiftest_util_append(self%kin, source%kin, nold, nsrc, lsource_mask) call swiftest_util_append_pl(self, source, lsource_mask) ! Note: helio_pl does not have its own append method, so we skip back to the base class end associate @@ -183,79 +174,6 @@ module subroutine symba_util_fill_tp(self, inserts, lfill_list) end subroutine symba_util_fill_tp - module subroutine symba_util_final_list_plpl(self) - !! author: David A. Minton - !! - !! Finalize the pl-tp list - deallocates all allocatables - implicit none - type(symba_list_plpl), intent(inout) :: self !! SyMBA encounter list object - - call self%dealloc() - - return - end subroutine symba_util_final_list_plpl - - - module subroutine symba_util_final_list_pltp(self) - !! author: David A. Minton - !! - !! Finalize the pl-tp list - deallocates all allocatables - implicit none - type(symba_list_pltp), intent(inout) :: self !! SyMBA encounter list object - - call self%dealloc() - - return - end subroutine symba_util_final_list_pltp - - - module subroutine symba_util_final_pl(self) - !! author: David A. Minton - !! - !! Finalize the SyMBA massive body object - deallocates all allocatables - implicit none - ! Argument - type(symba_pl), intent(inout) :: self !! SyMBA massive body object - - call self%dealloc() - - return - end subroutine symba_util_final_pl - - - module subroutine symba_util_final_system(self) - !! author: David A. Minton - !! - !! Finalize the SyMBA nbody system object - deallocates all allocatables - implicit none - ! Argument - type(symba_nbody_system), intent(inout) :: self !! SyMBA nbody system object - - if (allocated(self%pl_adds)) deallocate(self%pl_adds) - if (allocated(self%pltp_encounter)) deallocate(self%pltp_encounter) - if (allocated(self%plpl_encounter)) deallocate(self%plpl_encounter) - if (allocated(self%plpl_collision)) deallocate(self%plpl_collision) - - call helio_util_final_system(self%helio_nbody_system) - - return - end subroutine symba_util_final_system - - - module subroutine symba_util_final_tp(self) - !! author: David A. Minton - !! - !! Finalize the SyMBA test particleobject - deallocates all allocatables - implicit none - ! Argument - type(symba_tp), intent(inout) :: self !! SyMBA test particle object - - call self%dealloc() - - return - end subroutine symba_util_final_tp - - module subroutine symba_util_flatten_eucl_plpl(self, param) !! author: Jacob R. Elliott and David A. Minton !! @@ -529,7 +447,6 @@ module subroutine symba_util_spill_pl(self, discards, lspill_list, ldestructive) end subroutine symba_util_spill_pl - module subroutine symba_util_spill_tp(self, discards, lspill_list, ldestructive) !! author: David A. Minton !! diff --git a/src/whm/whm_module.f90 b/src/whm/whm_module.f90 index 7b09bbfbc..c3f2ce96f 100644 --- a/src/whm/whm_module.f90 +++ b/src/whm/whm_module.f90 @@ -51,7 +51,7 @@ module whm procedure :: spill => whm_util_spill_pl !!"Spills" bodies from one object to another depending on the results of a mask (uses the PACK intrinsic) procedure :: setup => whm_setup_pl !! Constructor method - Allocates space for the input number of bodiess procedure :: step => whm_step_pl !! Steps the body forward one stepsize - final :: whm_util_final_pl !! Finalizes the WHM massive body object - deallocates all allocatables + final :: whm_final_pl !! Finalizes the WHM massive body object - deallocates all allocatables end type whm_pl @@ -65,7 +65,7 @@ module whm procedure :: accel => whm_kick_getacch_tp !! Compute heliocentric accelerations of test particles procedure :: kick => whm_kick_vh_tp !! Kick heliocentric velocities of test particles procedure :: step => whm_step_tp !! Steps the particle forward one stepsize - final :: whm_util_final_tp !! Finalizes the WHM test particle object - deallocates all allocatables + final :: whm_final_tp !! Finalizes the WHM test particle object - deallocates all allocatables end type whm_tp !> An abstract class for the WHM integrator nbody system @@ -74,7 +74,7 @@ module whm !> Replace the abstract procedures with concrete ones procedure :: initialize => whm_setup_initialize_system !! Performs WHM-specific initilization steps, like calculating the Jacobi masses procedure :: step => whm_step_system !! Advance the WHM nbody system forward in time by one step - final :: whm_util_final_system !! Finalizes the WHM system object - deallocates all allocatables + final :: whm_final_system !! Finalizes the WHM system object - deallocates all allocatables end type whm_nbody_system interface @@ -224,21 +224,6 @@ module subroutine whm_util_dealloc_pl(self) class(whm_pl), intent(inout) :: self !! WHM massive body object end subroutine whm_util_dealloc_pl - module subroutine whm_util_final_pl(self) - implicit none - type(whm_pl), intent(inout) :: self !! WHM massive body object - end subroutine whm_util_final_pl - - module subroutine whm_util_final_system(self) - implicit none - type(whm_nbody_system), intent(inout) :: self !! WHM nbody system object - end subroutine whm_util_final_system - - module subroutine whm_util_final_tp(self) - implicit none - type(whm_tp), intent(inout) :: self !! WHM test particle object - end subroutine whm_util_final_tp - module subroutine whm_util_spill_pl(self, discards, lspill_list, ldestructive) implicit none class(whm_pl), intent(inout) :: self !! WHM massive body object @@ -285,4 +270,49 @@ module subroutine whm_util_sort_rearrange_pl(self, ind) end subroutine whm_util_sort_rearrange_pl end interface + contains + + + + subroutine whm_final_pl(self) + !! author: David A. Minton + !! + !! Finalize the WHM massive body object - deallocates all allocatables + implicit none + ! Argument + type(whm_pl), intent(inout) :: self !! WHM massive body object + + call self%dealloc() + + return + end subroutine whm_final_pl + + + subroutine whm_final_system(self) + !! author: David A. Minton + !! + !! Finalize the WHM nbody system object - deallocates all allocatables + implicit none + ! Arguments + type(whm_nbody_system), intent(inout) :: self !! WHM nbody system object + + call swiftest_final_system(self) + + return + end subroutine whm_final_system + + + subroutine whm_final_tp(self) + !! author: David A. Minton + !! + !! Finalize the WHM test particle object - deallocates all allocatables + implicit none + ! Arguments + type(whm_tp), intent(inout) :: self !! WHM test particle object + + call self%dealloc() + + return + end subroutine whm_final_tp + end module whm diff --git a/src/whm/whm_util.f90 b/src/whm/whm_util.f90 index 6d49c818f..28c61f437 100644 --- a/src/whm/whm_util.f90 +++ b/src/whm/whm_util.f90 @@ -95,48 +95,6 @@ module subroutine whm_util_fill_pl(self, inserts, lfill_list) end subroutine whm_util_fill_pl - module subroutine whm_util_final_pl(self) - !! author: David A. Minton - !! - !! Finalize the WHM massive body object - deallocates all allocatables - implicit none - ! Argument - type(whm_pl), intent(inout) :: self !! WHM massive body object - - call self%dealloc() - - return - end subroutine whm_util_final_pl - - - module subroutine whm_util_final_system(self) - !! author: David A. Minton - !! - !! Finalize the WHM nbody system object - deallocates all allocatables - implicit none - ! Arguments - type(whm_nbody_system), intent(inout) :: self !! WHM nbody system object - - call swiftest_util_final_system(self) - - return - end subroutine whm_util_final_system - - - module subroutine whm_util_final_tp(self) - !! author: David A. Minton - !! - !! Finalize the WHM test particle object - deallocates all allocatables - implicit none - ! Arguments - type(whm_tp), intent(inout) :: self !! WHM test particle object - - call self%dealloc() - - return - end subroutine whm_util_final_tp - - module subroutine whm_util_resize_pl(self, nnew) !! author: David A. Minton !! From 82ff8b161100f4bf23bb65c1055afabb9bc38995 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Wed, 21 Dec 2022 13:08:14 -0500 Subject: [PATCH 475/569] fixed typo --- src/collision/collision_check.f90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/collision/collision_check.f90 b/src/collision/collision_check.f90 index 772d4a1a7..2fda012bd 100644 --- a/src/collision/collision_check.f90 +++ b/src/collision/collision_check.f90 @@ -10,6 +10,7 @@ submodule (collision) s_collision_check use swiftest + use symba, only : symba_pl, symba_tp contains pure elemental subroutine collision_check_one(xr, yr, zr, vxr, vyr, vzr, Gmtot, rlim, dt, lvdotr, lcollision, lclosest) @@ -94,7 +95,7 @@ module subroutine collision_check_plpl(self, system, param, t, dt, irec, lany_co lmask(:) = (self%status(1:nenc) == ACTIVE) select type(pl) class is (symba_pl) - lmask(:) = lmask(:).and. (pl%levelg(self%index1(1:nenc)) >= irec)) + lmask(:) = lmask(:).and. (pl%levelg(self%index1(1:nenc)) >= irec) end select if (.not.any(lmask(:))) return From 530b1bd7e9105150432ae352b60a05062747b5ef Mon Sep 17 00:00:00 2001 From: David A Minton Date: Wed, 21 Dec 2022 13:09:52 -0500 Subject: [PATCH 476/569] Cleanup --- src/rmvs/rmvs_discard.f90 | 2 +- src/swiftest/swiftest_discard.f90 | 8 ++++---- src/swiftest/swiftest_io.f90 | 14 +++++++------- 3 files changed, 12 insertions(+), 12 deletions(-) diff --git a/src/rmvs/rmvs_discard.f90 b/src/rmvs/rmvs_discard.f90 index 06086444c..0c7e6230e 100644 --- a/src/rmvs/rmvs_discard.f90 +++ b/src/rmvs/rmvs_discard.f90 @@ -50,7 +50,7 @@ module subroutine rmvs_discard_tp(self, system, param) end associate end do ! Call the base method that this overrides - call discard_tp(tp, system, param) + call swiftest_discard_tp(tp, system, param) end associate end subroutine rmvs_discard_tp diff --git a/src/swiftest/swiftest_discard.f90 b/src/swiftest/swiftest_discard.f90 index 35a8cb755..a3d5d861d 100644 --- a/src/swiftest/swiftest_discard.f90 +++ b/src/swiftest/swiftest_discard.f90 @@ -93,9 +93,9 @@ module subroutine swiftest_discard_tp(self, system, param) call tp%h2b(cb) end if - if ((param%rmin >= 0.0_DP) .or. (param%rmax >= 0.0_DP) .or. (param%rmaxu >= 0.0_DP)) call discard_cb_tp(tp, system, param) - if (param%qmin >= 0.0_DP) call discard_peri_tp(tp, system, param) - if (param%lclose) call discard_pl_tp(tp, system, param) + if ((param%rmin >= 0.0_DP) .or. (param%rmax >= 0.0_DP) .or. (param%rmaxu >= 0.0_DP)) call swiftest_discard_cb_tp(tp, system, param) + if (param%qmin >= 0.0_DP) call swiftest_discard_peri_tp(tp, system, param) + if (param%lclose) call swiftest_discard_pl_tp(tp, system, param) if (any(tp%ldiscard(1:ntp))) then allocate(ldiscard, source=tp%ldiscard) call tp%spill(system%tp_discards, ldiscard(1:ntp), ldestructive=.true.) @@ -252,7 +252,7 @@ subroutine swiftest_discard_pl_tp(tp, system, param) dx(:) = tp%rh(:, i) - pl%rh(:, j) dv(:) = tp%vh(:, i) - pl%vh(:, j) radius = pl%radius(j) - call discard_pl_close(dx(:), dv(:), dt, radius**2, isp, r2min) + call swiftest_discard_pl_close(dx(:), dv(:), dt, radius**2, isp, r2min) if (isp /= 0) then tp%status(i) = DISCARDED_PLR tp%lmask(i) = .false. diff --git a/src/swiftest/swiftest_io.f90 b/src/swiftest/swiftest_io.f90 index 07dfb4182..ac56c5714 100644 --- a/src/swiftest/swiftest_io.f90 +++ b/src/swiftest/swiftest_io.f90 @@ -2046,7 +2046,7 @@ module subroutine swiftest_io_param_reader(self, unit, iotype, v_list, iostat, i ! All reporting of collision information in SyMBA (including mergers) is now recorded in the Fraggle logfile - call io_log_start(param, FRAGGLE_LOG_OUT, "Fraggle logfile") + call swiftest_io_log_start(param, FRAGGLE_LOG_OUT, "Fraggle logfile") if ((param%encounter_save /= "NONE") .and. & (param%encounter_save /= "TRAJECTORY") .and. & @@ -2106,7 +2106,7 @@ module subroutine swiftest_io_param_reader(self, unit, iotype, v_list, iostat, i case("ADAPTIVE") param%ladaptive_interactions = .true. param%lflatten_interactions = .true. - call io_log_start(param, INTERACTION_TIMER_LOG_OUT, "Interaction loop timer logfile") + call swiftest_io_log_start(param, INTERACTION_TIMER_LOG_OUT, "Interaction loop timer logfile") call swiftest_io_log_one_message(INTERACTION_TIMER_LOG_OUT, "Diagnostic values: loop style, time count, nplpl, metric") case("TRIANGULAR") param%ladaptive_interactions = .false. @@ -2121,7 +2121,7 @@ module subroutine swiftest_io_param_reader(self, unit, iotype, v_list, iostat, i param%interaction_loops = "ADAPTIVE" param%ladaptive_interactions = .true. param%lflatten_interactions = .true. - call io_log_start(param, INTERACTION_TIMER_LOG_OUT, "Interaction loop timer logfile") + call swiftest_io_log_start(param, INTERACTION_TIMER_LOG_OUT, "Interaction loop timer logfile") call swiftest_io_log_one_message(INTERACTION_TIMER_LOG_OUT, "Diagnostic values: loop style, time count, nplpl, metric") end select @@ -2129,7 +2129,7 @@ module subroutine swiftest_io_param_reader(self, unit, iotype, v_list, iostat, i case("ADAPTIVE") param%ladaptive_encounters_plpl = .true. param%lencounter_sas_plpl = .true. - call io_log_start(param, ENCOUNTER_PLPL_TIMER_LOG_OUT, "Encounter check loop timer logfile") + call swiftest_io_log_start(param, ENCOUNTER_PLPL_TIMER_LOG_OUT, "Encounter check loop timer logfile") call swiftest_io_log_one_message(ENCOUNTER_PLPL_TIMER_LOG_OUT, "Diagnostic values: loop style, time count, nplpl, metric") case("TRIANGULAR") param%ladaptive_encounters_plpl = .false. @@ -2144,7 +2144,7 @@ module subroutine swiftest_io_param_reader(self, unit, iotype, v_list, iostat, i param%encounter_check_plpl = "ADAPTIVE" param%ladaptive_encounters_plpl = .true. param%lencounter_sas_plpl = .true. - call io_log_start(param, ENCOUNTER_PLPL_TIMER_LOG_OUT, "Encounter check loop timer logfile") + call swiftest_io_log_start(param, ENCOUNTER_PLPL_TIMER_LOG_OUT, "Encounter check loop timer logfile") call swiftest_io_log_one_message(ENCOUNTER_PLPL_TIMER_LOG_OUT, "Diagnostic values: loop style, time count, nplpl, metric") end select @@ -2152,7 +2152,7 @@ module subroutine swiftest_io_param_reader(self, unit, iotype, v_list, iostat, i case("ADAPTIVE") param%ladaptive_encounters_pltp = .true. param%lencounter_sas_pltp = .true. - call io_log_start(param, ENCOUNTER_PLTP_TIMER_LOG_OUT, "Encounter check loop timer logfile") + call swiftest_io_log_start(param, ENCOUNTER_PLTP_TIMER_LOG_OUT, "Encounter check loop timer logfile") call swiftest_io_log_one_message(ENCOUNTER_PLTP_TIMER_LOG_OUT, "Diagnostic values: loop style, time count, npltp, metric") case("TRIANGULAR") param%ladaptive_encounters_pltp = .false. @@ -2167,7 +2167,7 @@ module subroutine swiftest_io_param_reader(self, unit, iotype, v_list, iostat, i param%encounter_check_pltp = "ADAPTIVE" param%ladaptive_encounters_pltp = .true. param%lencounter_sas_pltp = .true. - call io_log_start(param, ENCOUNTER_PLTP_TIMER_LOG_OUT, "Encounter check loop timer logfile") + call swiftest_io_log_start(param, ENCOUNTER_PLTP_TIMER_LOG_OUT, "Encounter check loop timer logfile") call swiftest_io_log_one_message(ENCOUNTER_PLTP_TIMER_LOG_OUT, "Diagnostic values: loop style, time count, npltp, metric") end select From 55f499fea38afbfc7df92c50abcc646c0fed6dcb Mon Sep 17 00:00:00 2001 From: David A Minton Date: Wed, 21 Dec 2022 13:14:03 -0500 Subject: [PATCH 477/569] Cleanup --- src/collision/collision_module.f90 | 9 +++++++++ src/collision/collision_resolve.f90 | 19 +++++++++++-------- 2 files changed, 20 insertions(+), 8 deletions(-) diff --git a/src/collision/collision_module.f90 b/src/collision/collision_module.f90 index 61c7f0fa2..03b26bbef 100644 --- a/src/collision/collision_module.f90 +++ b/src/collision/collision_module.f90 @@ -247,6 +247,13 @@ module subroutine collision_check_pltp(self, system, param, t, dt, irec, lany_co integer(I4B), intent(in) :: irec !! Current recursion level logical, intent(out) :: lany_collision !! Returns true if any pair of encounters resulted in a collision end subroutine collision_check_pltp + + module subroutine collision_resolve_collider_message(pl, collidx, collider_message) + implicit none + class(base_object), intent(in) :: pl !! Swiftest massive body object + integer(I4B), dimension(:), intent(in) :: collidx !! Index of collisional impactors%id members + character(*), intent(inout) :: collider_message !! The message to print to the screen. + end subroutine collision_resolve_collider_message module subroutine collision_resolve_extract_plpl(self, system, param) implicit none @@ -277,6 +284,8 @@ module function collision_resolve_merge(system, param, t) result(status) end function collision_resolve_merge + + module subroutine collision_resolve_plpl(self, system, param, t, dt, irec) implicit none class(collision_list_plpl), intent(inout) :: self !! pl-pl encounter list diff --git a/src/collision/collision_resolve.f90 b/src/collision/collision_resolve.f90 index f08a056ac..56292a586 100644 --- a/src/collision/collision_resolve.f90 +++ b/src/collision/collision_resolve.f90 @@ -98,14 +98,14 @@ module function collision_resolve_merge(system, param, t) result(status) end function collision_resolve_merge - subroutine collision_resolve_collider_message(pl, collidx, collider_message) + module subroutine collision_resolve_collider_message(pl, collidx, collider_message) !! author: David A. Minton !! !! Prints a nicely formatted message about which bodies collided, including their names and ids. !! This subroutine appends the body names and ids to an input message. implicit none ! Arguments - class(swiftest_pl), intent(in) :: pl !! Swiftest massive body object + class(base_object), intent(in) :: pl !! Swiftest massive body object integer(I4B), dimension(:), intent(in) :: collidx !! Index of collisional impactors%id members character(*), intent(inout) :: collider_message !! The message to print to the screen. ! Internals @@ -115,12 +115,15 @@ subroutine collision_resolve_collider_message(pl, collidx, collider_message) n = size(collidx) if (n == 0) return - do i = 1, n - if (i > 1) collider_message = trim(adjustl(collider_message)) // " and " - collider_message = " " // trim(adjustl(collider_message)) // " " // trim(adjustl(pl%info(collidx(i))%name)) - write(idstr, '(I10)') pl%id(collidx(i)) - collider_message = trim(adjustl(collider_message)) // " (" // trim(adjustl(idstr)) // ") " - end do + select type(pl) + class is (swiftest_pl) + do i = 1, n + if (i > 1) collider_message = trim(adjustl(collider_message)) // " and " + collider_message = " " // trim(adjustl(collider_message)) // " " // trim(adjustl(pl%info(collidx(i))%name)) + write(idstr, '(I10)') pl%id(collidx(i)) + collider_message = trim(adjustl(collider_message)) // " (" // trim(adjustl(idstr)) // ") " + end do + end select return end subroutine collision_resolve_collider_message From 3776de29b032b4f85da9f60f4304316e2057c816 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Wed, 21 Dec 2022 13:18:08 -0500 Subject: [PATCH 478/569] cleanup --- src/base/base_module.f90 | 37 +++++++++ src/collision/collision_io.f90 | 2 +- src/collision/collision_module.f90 | 9 ++- src/collision/collision_resolve.f90 | 4 +- src/collision/collision_util.f90 | 2 +- src/encounter/encounter_io.f90 | 2 +- src/netcdf_io/netcdf_io_implementations.f90 | 2 +- src/rmvs/rmvs_step.f90 | 8 +- src/rmvs/rmvs_util.f90 | 12 +-- src/swiftest/swiftest_driver.f90 | 2 +- src/swiftest/swiftest_io.f90 | 90 ++++++++++----------- src/swiftest/swiftest_module.f90 | 4 +- src/swiftest/swiftest_setup.f90 | 2 +- src/swiftest/swiftest_util.f90 | 43 +--------- src/symba/symba_step.f90 | 2 +- src/symba/symba_util.f90 | 12 +-- src/whm/whm_drift.f90 | 2 +- src/whm/whm_util.f90 | 6 +- 18 files changed, 123 insertions(+), 118 deletions(-) diff --git a/src/base/base_module.f90 b/src/base/base_module.f90 index dba0e5f68..b85547cfd 100644 --- a/src/base/base_module.f90 +++ b/src/base/base_module.f90 @@ -277,4 +277,41 @@ subroutine reset_storage(self) return end subroutine reset_storage + + + subroutine util_exit(code) + !! author: David A. Minton + !! + !! Print termination message and exit program + !! + !! Adapted from David E. Kaufmann's Swifter routine: util_exit.f90 + !! Adapted from Hal Levison's Swift routine util_exit.f + implicit none + ! Arguments + integer(I4B), intent(in) :: code + ! Internals + character(*), parameter :: BAR = '("------------------------------------------------")' + character(*), parameter :: SUCCESS_MSG = '(/, "Normal termination of Swiftest (version ", f3.1, ")")' + character(*), parameter :: FAIL_MSG = '(/, "Terminating Swiftest (version ", f3.1, ") due to error!!")' + character(*), parameter :: USAGE_MSG = '("Usage: swiftest [bs|helio|ra15|rmvs|symba|tu4|whm] [standard|compact|progress|NONE]")' + character(*), parameter :: HELP_MSG = USAGE_MSG + + select case(code) + case(SUCCESS) + write(*, SUCCESS_MSG) VERSION_NUMBER + write(*, BAR) + case(USAGE) + write(*, USAGE_MSG) + case(HELP) + write(*, HELP_MSG) + case default + write(*, FAIL_MSG) VERSION_NUMBER + write(*, BAR) + error stop + end select + + stop + + end subroutine util_exit + end module base diff --git a/src/collision/collision_io.f90 b/src/collision/collision_io.f90 index c734cb4fa..04fac5524 100644 --- a/src/collision/collision_io.f90 +++ b/src/collision/collision_io.f90 @@ -191,7 +191,7 @@ module subroutine collision_netcdf_io_initialize_output(self, param) 667 continue write(*,*) "Error creating fragmentation output file. " // trim(adjustl(errmsg)) - call swiftest_util_exit(FAILURE) + call util_exit(FAILURE) end subroutine collision_netcdf_io_initialize_output diff --git a/src/collision/collision_module.f90 b/src/collision/collision_module.f90 index 03b26bbef..d04a07207 100644 --- a/src/collision/collision_module.f90 +++ b/src/collision/collision_module.f90 @@ -283,8 +283,13 @@ module function collision_resolve_merge(system, param, t) result(status) integer(I4B) :: status !! Status flag assigned to this outcome end function collision_resolve_merge - - + module subroutine collision_resolve_mergeaddsub(system, param, t, status) + class(base_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(base_parameters), intent(inout) :: param !! Current run configuration parameters with Swiftest additions + real(DP), intent(in) :: t !! Time of collision + integer(I4B), intent(in) :: status !! Status flag to assign to adds + end subroutine collision_resolve_mergeaddsub + module subroutine collision_resolve_plpl(self, system, param, t, dt, irec) implicit none diff --git a/src/collision/collision_resolve.f90 b/src/collision/collision_resolve.f90 index 56292a586..ec3f8b67a 100644 --- a/src/collision/collision_resolve.f90 +++ b/src/collision/collision_resolve.f90 @@ -411,7 +411,7 @@ module subroutine collision_resolve_make_impactors_pl(pl, idx) end subroutine collision_resolve_make_impactors_pl - subroutine collision_resolve_mergeaddsub(system, param, t, status) + module subroutine collision_resolve_mergeaddsub(system, param, t, status) !! author: David A. Minton !! !! Fills the pl_discards and pl_adds with removed and added bodies @@ -638,7 +638,7 @@ subroutine collision_resolve_list(plpl_collision , system, param, t) plpl_collision%status(i) = collision_resolve_merge(system, param, t) case default write(*,*) "Error in swiftest_collision, unrecognized collision regime" - call swiftest_util_exit(FAILURE) + call util_exit(FAILURE) end select call collision_history%take_snapshot(param,system, t, "after") call impactors%reset() diff --git a/src/collision/collision_util.f90 b/src/collision/collision_util.f90 index 11d99dfc9..47a341f61 100644 --- a/src/collision/collision_util.f90 +++ b/src/collision/collision_util.f90 @@ -215,7 +215,7 @@ module subroutine collision_util_get_energy_momentum(self, system, param, lbefo if (.not.allocated(tmpsys)) then write(*,*) "Error in collision_util_get_energy_momentum. " // & " This must be called with lbefore=.true. at least once before calling it with lbefore=.false." - call swiftest_util_exit(FAILURE) + call util_exit(FAILURE) end if select type(tmpsys) class is (swiftest_nbody_system) diff --git a/src/encounter/encounter_io.f90 b/src/encounter/encounter_io.f90 index 1e1baae7c..2f7534b2e 100644 --- a/src/encounter/encounter_io.f90 +++ b/src/encounter/encounter_io.f90 @@ -146,7 +146,7 @@ module subroutine encounter_netcdf_io_initialize_output(self, param) 667 continue write(*,*) "Error creating encounter output file. " // trim(adjustl(errmsg)) - call swiftest_util_exit(FAILURE) + call util_exit(FAILURE) end subroutine encounter_netcdf_io_initialize_output diff --git a/src/netcdf_io/netcdf_io_implementations.f90 b/src/netcdf_io/netcdf_io_implementations.f90 index d08771203..d93b3dfb6 100644 --- a/src/netcdf_io/netcdf_io_implementations.f90 +++ b/src/netcdf_io/netcdf_io_implementations.f90 @@ -24,7 +24,7 @@ module subroutine netcdf_io_check(status, call_identifier) if(status /= nf90_noerr) then if (present(call_identifier)) write(*,*) "NetCDF error in ",trim(call_identifier) write(*,*) trim(nf90_strerror(status)) - call swiftest_util_exit(FAILURE) + call util_exit(FAILURE) end if return diff --git a/src/rmvs/rmvs_step.f90 b/src/rmvs/rmvs_step.f90 index c6f4bbab1..7c602a20b 100644 --- a/src/rmvs/rmvs_step.f90 +++ b/src/rmvs/rmvs_step.f90 @@ -117,7 +117,7 @@ subroutine rmvs_interp_out(cb, pl, dt) write(*, *) xtmp(:,i) write(*, *) vtmp(:,i) write(*, *) " STOPPING " - call swiftest_util_exit(FAILURE) + call util_exit(FAILURE) end if end do end if @@ -139,7 +139,7 @@ subroutine rmvs_interp_out(cb, pl, dt) write(*, *) xtmp(:,i) write(*, *) vtmp(:,i) write(*, *) " STOPPING " - call swiftest_util_exit(FAILURE) + call util_exit(FAILURE) end if end do end if @@ -284,7 +284,7 @@ subroutine rmvs_interp_in(cb, pl, system, param, dt, outer_index) write(*, *) xtmp(:,i) write(*, *) vtmp(:,i) write(*, *) " STOPPING " - call swiftest_util_exit(failure) + call util_exit(failure) end if end do end if @@ -308,7 +308,7 @@ subroutine rmvs_interp_in(cb, pl, system, param, dt, outer_index) write(*, *) xtmp(:,i) write(*, *) vtmp(:,i) write(*, *) " STOPPING " - call swiftest_util_exit(failure) + call util_exit(failure) end if end do end if diff --git a/src/rmvs/rmvs_util.f90 b/src/rmvs/rmvs_util.f90 index d39eeeddc..79e36e40b 100644 --- a/src/rmvs/rmvs_util.f90 +++ b/src/rmvs/rmvs_util.f90 @@ -39,7 +39,7 @@ module subroutine rmvs_util_append_pl(self, source, lsource_mask) end associate class default write(*,*) "Invalid object passed to the append method. Source must be of class rmvs_pl or its descendents!" - call swiftest_util_exit(FAILURE) + call util_exit(FAILURE) end select return @@ -68,7 +68,7 @@ module subroutine rmvs_util_append_tp(self, source, lsource_mask) end associate class default write(*,*) "Invalid object passed to the append method. Source must be of class rmvs_tp or its descendents!" - call swiftest_util_exit(FAILURE) + call util_exit(FAILURE) end select return @@ -174,7 +174,7 @@ module subroutine rmvs_util_fill_pl(self, inserts, lfill_list) call whm_util_fill_pl(keeps, inserts, lfill_list) class default write(*,*) "Invalid object passed to the fill method. Source must be of class rmvs_pl or its descendents!" - call swiftest_util_exit(FAILURE) + call util_exit(FAILURE) end select end associate @@ -275,7 +275,7 @@ module subroutine rmvs_util_fill_tp(self, inserts, lfill_list) call swiftest_util_fill_tp(keeps, inserts, lfill_list) ! Note: whm_tp does not have its own fill method, so we skip back to the base class class default write(*,*) "Invalid object passed to the fill method. Source must be of class rmvs_tp or its descendents!" - call swiftest_util_exit(FAILURE) + call util_exit(FAILURE) end select end associate @@ -482,7 +482,7 @@ module subroutine rmvs_util_spill_pl(self, discards, lspill_list, ldestructive) call whm_util_spill_pl(keeps, discards, lspill_list, ldestructive) class default write(*,*) "Invalid object passed to the spill method. Source must be of class rmvs_pl or its descendents!" - call swiftest_util_exit(FAILURE) + call util_exit(FAILURE) end select end associate @@ -513,7 +513,7 @@ module subroutine rmvs_util_spill_tp(self, discards, lspill_list, ldestructive) call swiftest_util_spill_tp(keeps, discards, lspill_list, ldestructive) class default write(*,*) "Invalid object passed to the spill method. Source must be of class rmvs_tp or its descendents!" - call swiftest_util_exit(FAILURE) + call util_exit(FAILURE) end select end associate diff --git a/src/swiftest/swiftest_driver.f90 b/src/swiftest/swiftest_driver.f90 index b581cd666..b83583ed4 100644 --- a/src/swiftest/swiftest_driver.f90 +++ b/src/swiftest/swiftest_driver.f90 @@ -166,5 +166,5 @@ program swiftest_driver end associate end associate - call swiftest_util_exit(SUCCESS) + call util_exit(SUCCESS) end program swiftest_driver diff --git a/src/swiftest/swiftest_io.f90 b/src/swiftest/swiftest_io.f90 index ac56c5714..0f6dec806 100644 --- a/src/swiftest/swiftest_io.f90 +++ b/src/swiftest/swiftest_io.f90 @@ -179,7 +179,7 @@ module subroutine swiftest_io_conservation_report(self, param, lterminal) param%ioutput = param%ioutput + 1 call self%write_frame(nc, param) call nc%close() - call swiftest_util_exit(FAILURE) + call util_exit(FAILURE) end if end if end associate @@ -188,7 +188,7 @@ module subroutine swiftest_io_conservation_report(self, param, lterminal) 667 continue write(*,*) "Error writing energy and momentum tracking file: " // trim(adjustl(errmsg)) - call swiftest_util_exit(FAILURE) + call util_exit(FAILURE) end subroutine swiftest_io_conservation_report @@ -219,7 +219,7 @@ module subroutine swiftest_io_dump_param(self, param_file_name) 667 continue write(*,*) "Error opening parameter dump file " // trim(adjustl(errmsg)) - call swiftest_util_exit(FAILURE) + call util_exit(FAILURE) end subroutine swiftest_io_dump_param @@ -329,21 +329,21 @@ module subroutine swiftest_io_get_args(integrator, param_file_name, display_styl do i = 1,narg call get_command_argument(i, arg(i), status = ierr(i)) end do - if (any(ierr /= 0)) call swiftest_util_exit(USAGE) + if (any(ierr /= 0)) call util_exit(USAGE) else - call swiftest_util_exit(USAGE) + call util_exit(USAGE) end if if (narg == 1) then if (arg(1) == '-v' .or. arg(1) == '--version') then call swiftest_util_version() else if (arg(1) == '-h' .or. arg(1) == '--help') then - call swiftest_util_exit(HELP) + call util_exit(HELP) else - call swiftest_util_exit(USAGE) + call util_exit(USAGE) end if else if (narg >= 2) then - call io_toupper(arg(1)) + call swiftest_io_toupper(arg(1)) select case(arg(1)) case('INT_BS') integrator = INT_BS @@ -364,7 +364,7 @@ module subroutine swiftest_io_get_args(integrator, param_file_name, display_styl case default integrator = UNKNOWN_INTEGRATOR write(*,*) trim(adjustl(arg(1))) // ' is not a valid integrator.' - call swiftest_util_exit(USAGE) + call util_exit(USAGE) end select param_file_name = trim(adjustl(arg(2))) end if @@ -372,10 +372,10 @@ module subroutine swiftest_io_get_args(integrator, param_file_name, display_styl if (narg == 2) then display_style = "STANDARD" else if (narg == 3) then - call io_toupper(arg(3)) + call swiftest_io_toupper(arg(3)) display_style = trim(adjustl(arg(3))) else - call swiftest_util_exit(USAGE) + call util_exit(USAGE) end if return @@ -742,7 +742,7 @@ module subroutine swiftest_io_netcdf_initialize_output(self, param) 667 continue write(*,*) "Error creating NetCDF output file. " // trim(adjustl(errmsg)) - call swiftest_util_exit(FAILURE) + call util_exit(FAILURE) end subroutine swiftest_io_netcdf_initialize_output @@ -929,19 +929,19 @@ module function swiftest_io_netcdf_read_frame_system(self, nc, param) result(ier if (npl_check /= npl) then write(*,*) "Error reading in NetCDF file: The recorded value of npl does not match the number of active massive bodies" - call swiftest_util_exit(failure) + call util_exit(failure) end if if (ntp_check /= ntp) then write(*,*) "Error reading in NetCDF file: The recorded value of ntp does not match the number of active test particles" - call swiftest_util_exit(failure) + call util_exit(failure) end if if (param%lmtiny_pl) then nplm_check = count(pack(rtemp,plmask) > param%GMTINY ) if (nplm_check /= pl%nplm) then write(*,*) "Error reading in NetCDF file: The recorded value of nplm does not match the number of active fully interacting massive bodies" - call swiftest_util_exit(failure) + call util_exit(failure) end if end if @@ -1760,7 +1760,7 @@ module subroutine swiftest_io_param_reader(self, unit, iotype, v_list, iostat, i ! Read the pair of tokens. The first one is the parameter name, the second is the value. param_name = swiftest_io_get_token(line_trim, ifirst, ilast, iostat) if (param_name == '') cycle ! No parameter name (usually because this line is commented out) - call io_toupper(param_name) + call swiftest_io_toupper(param_name) ifirst = ilast + 1 param_value = swiftest_io_get_token(line_trim, ifirst, ilast, iostat) select case (param_name) @@ -1784,28 +1784,28 @@ module subroutine swiftest_io_param_reader(self, unit, iotype, v_list, iostat, i case ("NC_IN") param%in_netcdf = param_value case ("IN_TYPE") - call io_toupper(param_value) + call swiftest_io_toupper(param_value) param%in_type = param_value case ("IN_FORM") - call io_toupper(param_value) + call swiftest_io_toupper(param_value) param%in_form = param_value case ("ISTEP_OUT") read(param_value, *) param%istep_out case ("BIN_OUT") param%outfile = param_value case ("OUT_TYPE") - call io_toupper(param_value) + call swiftest_io_toupper(param_value) param%out_type = param_value case ("OUT_FORM") - call io_toupper(param_value) + call swiftest_io_toupper(param_value) param%out_form = param_value case ("OUT_STAT") - call io_toupper(param_value) + call swiftest_io_toupper(param_value) param%out_stat = param_value case ("DUMP_CADENCE") read(param_value, *, err = 667, iomsg = iomsg) param%dump_cadence case ("CHK_CLOSE") - call io_toupper(param_value) + call swiftest_io_toupper(param_value) if (param_value == "YES" .or. param_value == 'T') param%lclose = .true. case ("CHK_RMIN") read(param_value, *, err = 667, iomsg = iomsg) param%rmin @@ -1816,7 +1816,7 @@ module subroutine swiftest_io_param_reader(self, unit, iotype, v_list, iostat, i case ("CHK_QMIN") read(param_value, *, err = 667, iomsg = iomsg) param%qmin case ("CHK_QMIN_COORD") - call io_toupper(param_value) + call swiftest_io_toupper(param_value) param%qmin_coord = param_value case ("CHK_QMIN_RANGE") read(param_value, *, err = 667, iomsg = iomsg) param%qmin_alo @@ -1824,13 +1824,13 @@ module subroutine swiftest_io_param_reader(self, unit, iotype, v_list, iostat, i param_value = swiftest_io_get_token(line, ifirst, ilast, iostat) read(param_value, *, err = 667, iomsg = iomsg) param%qmin_ahi case ("EXTRA_FORCE") - call io_toupper(param_value) + call swiftest_io_toupper(param_value) if (param_value == "YES" .or. param_value == 'T') param%lextra_force = .true. case ("BIG_DISCARD") - call io_toupper(param_value) + call swiftest_io_toupper(param_value) if (param_value == "YES" .or. param_value == 'T' ) param%lbig_discard = .true. case ("RHILL_PRESENT") - call io_toupper(param_value) + call swiftest_io_toupper(param_value) if (param_value == "YES" .or. param_value == 'T' ) param%lrhill_present = .true. case ("MU2KG") read(param_value, *, err = 667, iomsg = iomsg) param%MU2KG @@ -1839,35 +1839,35 @@ module subroutine swiftest_io_param_reader(self, unit, iotype, v_list, iostat, i case ("DU2M") read(param_value, *, err = 667, iomsg = iomsg) param%DU2M case ("ENERGY") - call io_toupper(param_value) + call swiftest_io_toupper(param_value) if (param_value == "YES" .or. param_value == 'T') param%lenergy = .true. case ("GR") - call io_toupper(param_value) + call swiftest_io_toupper(param_value) if (param_value == "YES" .or. param_value == 'T') param%lgr = .true. case ("ROTATION") - call io_toupper(param_value) + call swiftest_io_toupper(param_value) if (param_value == "YES" .or. param_value == 'T') param%lrotation = .true. case ("TIDES") - call io_toupper(param_value) + call swiftest_io_toupper(param_value) if (param_value == "YES" .or. param_value == 'T') param%ltides = .true. case ("INTERACTION_LOOPS") - call io_toupper(param_value) + call swiftest_io_toupper(param_value) param%interaction_loops = param_value case ("ENCOUNTER_CHECK_PLPL") - call io_toupper(param_value) + call swiftest_io_toupper(param_value) param%encounter_check_plpl = param_value case ("ENCOUNTER_CHECK_PLTP") - call io_toupper(param_value) + call swiftest_io_toupper(param_value) param%encounter_check_pltp = param_value case ("ENCOUNTER_CHECK") - call io_toupper(param_value) + call swiftest_io_toupper(param_value) param%encounter_check_plpl = param_value param%encounter_check_pltp = param_value case ("FIRSTKICK") - call io_toupper(param_value) + call swiftest_io_toupper(param_value) if (param_value == "NO" .or. param_value == 'F') param%lfirstkick = .false. case ("FIRSTENERGY") - call io_toupper(param_value) + call swiftest_io_toupper(param_value) if (param_value == "NO" .or. param_value == 'F') param%lfirstenergy = .false. case("EORBIT_ORIG") read(param_value, *, err = 667, iomsg = iomsg) param%Eorbit_orig @@ -1912,14 +1912,14 @@ module subroutine swiftest_io_param_reader(self, unit, iotype, v_list, iostat, i case ("MAXID_COLLISION") read(param_value, *, err = 667, iomsg = iomsg) param%maxid_collision case ("FRAGMENTATION") - call io_toupper(param_value) + call swiftest_io_toupper(param_value) if (param_value == "YES" .or. param_value == "T") self%lfragmentation = .true. case ("GMTINY") read(param_value, *) param%GMTINY case ("MIN_GMFRAG") read(param_value, *) param%min_GMfrag case ("ENCOUNTER_SAVE") - call io_toupper(param_value) + call swiftest_io_toupper(param_value) read(param_value, *) param%encounter_save case("SEED") read(param_value, *) nseeds_from_file @@ -2562,7 +2562,7 @@ module subroutine swiftest_io_read_in_cb(self, param) 667 continue write(*,*) "Error reading central body file: " // trim(adjustl(errmsg)) - call swiftest_util_exit(FAILURE) + call util_exit(FAILURE) end subroutine swiftest_io_read_in_cb @@ -2601,7 +2601,7 @@ module subroutine swiftest_io_read_in_system(self, param) end if ierr = self%read_frame(tmp_param%system_history%nc, tmp_param) deallocate(tmp_param) - if (ierr /=0) call swiftest_util_exit(FAILURE) + if (ierr /=0) call util_exit(FAILURE) end if param%loblatecb = ((self%cb%j2rp2 /= 0.0_DP) .or. (self%cb%j4rp4 /= 0.0_DP)) @@ -2715,7 +2715,7 @@ module function swiftest_io_read_frame_body(self, iu, param) result(ierr) class default write(*,*) "Error reading body file: " // trim(adjustl(errmsg)) end select - call swiftest_util_exit(FAILURE) + call util_exit(FAILURE) end function swiftest_io_read_frame_body @@ -2747,7 +2747,7 @@ module subroutine swiftest_io_read_in_param(self, param_file_name) 667 continue write(self%display_unit,*) "Error reading parameter file: " // trim(adjustl(errmsg)) - call swiftest_util_exit(FAILURE) + call util_exit(FAILURE) end subroutine swiftest_io_read_in_param @@ -2773,7 +2773,7 @@ module subroutine swiftest_io_set_display_param(self, display_style) self%log_output = .true. case default write(*,*) display_style, " is an unknown display style" - call swiftest_util_exit(USAGE) + call util_exit(USAGE) end select self%display_style = display_style @@ -2782,7 +2782,7 @@ module subroutine swiftest_io_set_display_param(self, display_style) 667 continue write(*,*) "Error opening swiftest log file: " // trim(adjustl(errmsg)) - call swiftest_util_exit(FAILURE) + call util_exit(FAILURE) end subroutine swiftest_io_set_display_param @@ -2884,7 +2884,7 @@ module subroutine swiftest_io_write_frame_system(self, param) 667 continue write(*,*) "Error writing system frame: " // trim(adjustl(errmsg)) - call swiftest_util_exit(FAILURE) + call util_exit(FAILURE) end subroutine swiftest_io_write_frame_system end submodule s_io diff --git a/src/swiftest/swiftest_module.f90 b/src/swiftest/swiftest_module.f90 index 347096476..8f5eb039d 100644 --- a/src/swiftest/swiftest_module.f90 +++ b/src/swiftest/swiftest_module.f90 @@ -1231,10 +1231,10 @@ module subroutine swiftest_util_dealloc_tp(self) class(swiftest_tp), intent(inout) :: self end subroutine swiftest_util_dealloc_tp - module subroutine swiftest_util_exit(code) + module subroutine util_exit(code) implicit none integer(I4B), intent(in) :: code !! Failure exit code - end subroutine swiftest_util_exit + end subroutine util_exit module subroutine swiftest_util_fill_body(self, inserts, lfill_list) implicit none diff --git a/src/swiftest/swiftest_setup.f90 b/src/swiftest/swiftest_setup.f90 index 6a6439a0e..2e6ff3851 100644 --- a/src/swiftest/swiftest_setup.f90 +++ b/src/swiftest/swiftest_setup.f90 @@ -111,7 +111,7 @@ module subroutine swiftest_setup_construct_system(system, param) write(*,*) 'RINGMOONS-SyMBA integrator not yet enabled' case default write(*,*) 'Unkown integrator',param%integrator - call swiftest_util_exit(FAILURE) + call util_exit(FAILURE) end select end select diff --git a/src/swiftest/swiftest_util.f90 b/src/swiftest/swiftest_util.f90 index 8393b1d70..ea7a33bb8 100644 --- a/src/swiftest/swiftest_util.f90 +++ b/src/swiftest/swiftest_util.f90 @@ -293,7 +293,7 @@ module subroutine swiftest_util_append_pl(self, source, lsource_mask) end associate class default write(*,*) "Invalid object passed to the append method. Source must be of class swiftest_pl or its descendents" - call swiftest_util_exit(FAILURE) + call util_exit(FAILURE) end select return @@ -322,7 +322,7 @@ module subroutine swiftest_util_append_tp(self, source, lsource_mask) end associate class default write(*,*) "Invalid object passed to the append method. Source must be of class swiftest_tp or its descendents" - call swiftest_util_exit(FAILURE) + call util_exit(FAILURE) end select return @@ -743,7 +743,6 @@ module subroutine swiftest_util_dealloc_kin(self) end subroutine swiftest_util_dealloc_kin - module subroutine swiftest_util_dealloc_pl(self) !! author: David A. Minton !! @@ -804,42 +803,6 @@ module subroutine swiftest_util_dealloc_tp(self) end subroutine swiftest_util_dealloc_tp - module subroutine swiftest_util_exit(code) - !! author: David A. Minton - !! - !! Print termination message and exit program - !! - !! Adapted from David E. Kaufmann's Swifter routine: util_exit.f90 - !! Adapted from Hal Levison's Swift routine util_exit.f - implicit none - ! Arguments - integer(I4B), intent(in) :: code - ! Internals - character(*), parameter :: BAR = '("------------------------------------------------")' - character(*), parameter :: SUCCESS_MSG = '(/, "Normal termination of Swiftest (version ", f3.1, ")")' - character(*), parameter :: FAIL_MSG = '(/, "Terminating Swiftest (version ", f3.1, ") due to error!!")' - character(*), parameter :: USAGE_MSG = '("Usage: swiftest [bs|helio|ra15|rmvs|symba|tu4|whm] [standard|compact|progress|NONE]")' - character(*), parameter :: HELP_MSG = USAGE_MSG - - select case(code) - case(SUCCESS) - write(*, SUCCESS_MSG) VERSION_NUMBER - write(*, BAR) - case(USAGE) - write(*, USAGE_MSG) - case(HELP) - write(*, HELP_MSG) - case default - write(*, FAIL_MSG) VERSION_NUMBER - write(*, BAR) - error stop - end select - - stop - - end subroutine swiftest_util_exit - - module subroutine swiftest_util_fill_arr_char_string(keeps, inserts, lfill_list) !! author: David A. Minton !! @@ -4204,7 +4167,7 @@ module subroutine swiftest_util_valid_id_system(self, param) if (idarr(i) == idarr(i+1)) then write(*, *) "Swiftest error:" write(*, *) " more than one body/particle has id = ", idarr(i) - call swiftest_util_exit(FAILURE) + call util_exit(FAILURE) end if end do param%maxid = max(param%maxid, maxval(idarr)) diff --git a/src/symba/symba_step.f90 b/src/symba/symba_step.f90 index accb9659b..274dc5279 100644 --- a/src/symba/symba_step.f90 +++ b/src/symba/symba_step.f90 @@ -200,7 +200,7 @@ recursive module subroutine symba_step_recur_system(self, param, t, ireci) write(*, *) "SWIFTEST Warning:" write(*, *) " In symba_step_recur_system, local time step is too small" write(*, *) " Roundoff error will be important!" - call swiftest_util_exit(FAILURE) + call util_exit(FAILURE) END IF irecp = ireci + 1 if (ireci == 0) then diff --git a/src/symba/symba_util.f90 b/src/symba/symba_util.f90 index a374f9540..18bbbdfdb 100644 --- a/src/symba/symba_util.f90 +++ b/src/symba/symba_util.f90 @@ -32,7 +32,7 @@ module subroutine symba_util_append_pl(self, source, lsource_mask) end associate class default write(*,*) "Invalid object passed to the append method. Source must be of class symba_pl or its descendents!" - call swiftest_util_exit(FAILURE) + call util_exit(FAILURE) end select return @@ -60,7 +60,7 @@ module subroutine symba_util_append_tp(self, source, lsource_mask) end associate class default write(*,*) "Invalid object passed to the append method. Source must be of class symba_tp or its descendents!" - call swiftest_util_exit(FAILURE) + call util_exit(FAILURE) end select return @@ -136,7 +136,7 @@ module subroutine symba_util_fill_pl(self, inserts, lfill_list) call swiftest_util_fill_pl(keeps, inserts, lfill_list) ! Note: helio_pl does not have its own fill method, so we skip back to the base class class default write(*,*) "Invalid object passed to the fill method. Source must be of class symba_pl or its descendents!" - call swiftest_util_exit(FAILURE) + call util_exit(FAILURE) end select end associate @@ -166,7 +166,7 @@ module subroutine symba_util_fill_tp(self, inserts, lfill_list) call swiftest_util_fill_tp(keeps, inserts, lfill_list) ! Note: helio_tp does not have its own fill method, so we skip back to the base class class default write(*,*) "Invalid object passed to the fill method. Source must be of class symba_tp or its descendents!" - call swiftest_util_exit(FAILURE) + call util_exit(FAILURE) end select end associate @@ -439,7 +439,7 @@ module subroutine symba_util_spill_pl(self, discards, lspill_list, ldestructive) call swiftest_util_spill_pl(keeps, discards, lspill_list, ldestructive) class default write(*,*) "Invalid object passed to the spill method. Source must be of class symba_pl or its descendents!" - call swiftest_util_exit(FAILURE) + call util_exit(FAILURE) end select end associate @@ -471,7 +471,7 @@ module subroutine symba_util_spill_tp(self, discards, lspill_list, ldestructive) call swiftest_util_spill_tp(keeps, discards, lspill_list, ldestructive) class default write(*,*) "Invalid object passed to the spill method. Source must be of class symba_tp or its descendents!" - call swiftest_util_exit(FAILURE) + call util_exit(FAILURE) end select end associate diff --git a/src/whm/whm_drift.f90 b/src/whm/whm_drift.f90 index 5565ea8e8..31d041505 100644 --- a/src/whm/whm_drift.f90 +++ b/src/whm/whm_drift.f90 @@ -48,7 +48,7 @@ module subroutine whm_drift_pl(self, system, param, dt) WRITE(*, *) " STOPPING " end if end do - call swiftest_util_exit(FAILURE) + call util_exit(FAILURE) end if end associate diff --git a/src/whm/whm_util.f90 b/src/whm/whm_util.f90 index 28c61f437..6ce3ce8df 100644 --- a/src/whm/whm_util.f90 +++ b/src/whm/whm_util.f90 @@ -35,7 +35,7 @@ module subroutine whm_util_append_pl(self, source, lsource_mask) end associate class default write(*,*) "Invalid object passed to the append method. Source must be of class whm_pl or its descendents" - call swiftest_util_exit(FAILURE) + call util_exit(FAILURE) end select return @@ -87,7 +87,7 @@ module subroutine whm_util_fill_pl(self, inserts, lfill_list) call swiftest_util_fill_pl(keeps, inserts, lfill_list) class default write(*,*) "Invalid object passed to the fill method. Inserts must be of class whm_pl or its descendents!" - call swiftest_util_exit(FAILURE) + call util_exit(FAILURE) end select end associate @@ -237,7 +237,7 @@ module subroutine whm_util_spill_pl(self, discards, lspill_list, ldestructive) call swiftest_util_spill_pl(keeps, discards, lspill_list, ldestructive) class default write(*,*) "Invalid object passed to the spill method. Source must be of class whm_pl or its descendents!" - call swiftest_util_exit(FAILURE) + call util_exit(FAILURE) end select end associate From e6f283bf6b42f4853671c433e534a4d36e6f9af9 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Wed, 21 Dec 2022 13:18:53 -0500 Subject: [PATCH 479/569] Cleanup --- src/swiftest/swiftest_module.f90 | 5 ----- 1 file changed, 5 deletions(-) diff --git a/src/swiftest/swiftest_module.f90 b/src/swiftest/swiftest_module.f90 index 8f5eb039d..ff58cf9ac 100644 --- a/src/swiftest/swiftest_module.f90 +++ b/src/swiftest/swiftest_module.f90 @@ -1231,11 +1231,6 @@ module subroutine swiftest_util_dealloc_tp(self) class(swiftest_tp), intent(inout) :: self end subroutine swiftest_util_dealloc_tp - module subroutine util_exit(code) - implicit none - integer(I4B), intent(in) :: code !! Failure exit code - end subroutine util_exit - module subroutine swiftest_util_fill_body(self, inserts, lfill_list) implicit none class(swiftest_body), intent(inout) :: self !! Swiftest body object From 845354b89d11590e466362909fcb2dec2c1cb283 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Wed, 21 Dec 2022 13:20:19 -0500 Subject: [PATCH 480/569] Cleanup, and it compiles again! --- src/misc/solver_module.f90 | 1 + 1 file changed, 1 insertion(+) diff --git a/src/misc/solver_module.f90 b/src/misc/solver_module.f90 index 43c5f170b..f71ca46bb 100644 --- a/src/misc/solver_module.f90 +++ b/src/misc/solver_module.f90 @@ -12,6 +12,7 @@ module solver !! !! Contains the Broyden-Fletcher-Goldfarb-Shanno minimizer used by Fraggle use globals + use base use lambda_function use, intrinsic :: ieee_exceptions private From d8be095364841277e184bd8b214a05198122a1c7 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Wed, 21 Dec 2022 14:00:01 -0500 Subject: [PATCH 481/569] Added a flag to indicate whether a NetCDF file is open so that finalizers don't throw errors --- src/collision/collision_io.f90 | 1 + src/encounter/encounter_io.f90 | 1 + src/netcdf_io/netcdf_io_implementations.f90 | 5 ++++- src/netcdf_io/netcdf_io_module.f90 | 1 + src/swiftest/swiftest_io.f90 | 2 ++ 5 files changed, 9 insertions(+), 1 deletion(-) diff --git a/src/collision/collision_io.f90 b/src/collision/collision_io.f90 index 04fac5524..5a7ead8c0 100644 --- a/src/collision/collision_io.f90 +++ b/src/collision/collision_io.f90 @@ -97,6 +97,7 @@ module subroutine collision_netcdf_io_initialize_output(self, param) end if call netcdf_io_check( nf90_create(nc%file_name, NF90_NETCDF4, nc%id), "collision_netcdf_io_initialize_output nf90_create" ) + nc%lfile_is_open = .true. ! Dimensions call netcdf_io_check( nf90_def_dim(nc%id, nc%event_dimname, nc%event_dimsize, nc%event_dimid), "collision_netcdf_io_initialize_output nf90_def_dim event_dimid" ) ! Dimension to store individual collision events diff --git a/src/encounter/encounter_io.f90 b/src/encounter/encounter_io.f90 index 2f7534b2e..46851cf2c 100644 --- a/src/encounter/encounter_io.f90 +++ b/src/encounter/encounter_io.f90 @@ -92,6 +92,7 @@ module subroutine encounter_netcdf_io_initialize_output(self, param) end if call netcdf_io_check( nf90_create(nc%file_name, NF90_NETCDF4, nc%id), "encounter_netcdf_io_initialize_output nf90_create" ) + nc%lfile_is_open = .true. ! Dimensions call netcdf_io_check( nf90_def_dim(nc%id, nc%time_dimname, nc%time_dimsize, nc%time_dimid), "encounter_netcdf_io_initialize_output nf90_def_dim time_dimid" ) ! Simulation time dimension diff --git a/src/netcdf_io/netcdf_io_implementations.f90 b/src/netcdf_io/netcdf_io_implementations.f90 index d93b3dfb6..9614e2a32 100644 --- a/src/netcdf_io/netcdf_io_implementations.f90 +++ b/src/netcdf_io/netcdf_io_implementations.f90 @@ -40,7 +40,10 @@ module subroutine netcdf_io_close(self) ! Arguments class(netcdf_parameters), intent(inout) :: self !! Parameters used to identify a particular NetCDF dataset - call netcdf_io_check( nf90_close(self%id), "netcdf_io_close" ) + if (self%lfile_is_open) then + call netcdf_io_check( nf90_close(self%id), "netcdf_io_close" ) + self%lfile_is_open = .false. + end if return end subroutine netcdf_io_close diff --git a/src/netcdf_io/netcdf_io_module.f90 b/src/netcdf_io/netcdf_io_module.f90 index bb3f098b8..cea8ca147 100644 --- a/src/netcdf_io/netcdf_io_module.f90 +++ b/src/netcdf_io/netcdf_io_module.f90 @@ -21,6 +21,7 @@ module netcdf_io !! This derived datatype stores the NetCDF ID values for each of the variables included in the NetCDF data file. This is used as the base class defined in base type, abstract :: netcdf_parameters character(STRMAX) :: file_name !! Name of the output file + logical :: lfile_is_open = .false. !! Flag indicating that the linked file is currently open integer(I4B) :: out_type !! output type (will be assigned either NF90_DOUBLE or NF90_FLOAT, depending on the user parameter) integer(I4B) :: id !! ID for the output file integer(I4B) :: name_chunk !! Chunk size for the id dimension variables diff --git a/src/swiftest/swiftest_io.f90 b/src/swiftest/swiftest_io.f90 index 0f6dec806..a3fa11e11 100644 --- a/src/swiftest/swiftest_io.f90 +++ b/src/swiftest/swiftest_io.f90 @@ -614,6 +614,7 @@ module subroutine swiftest_io_netcdf_initialize_output(self, param) ! Create the file call netcdf_io_check( nf90_create(nc%file_name, NF90_NETCDF4, nc%id), "netcdf_io_initialize_output nf90_create" ) + nc%lfile_is_open = .true. ! Dimensions call netcdf_io_check( nf90_def_dim(nc%id, nc%time_dimname, NF90_UNLIMITED, nc%time_dimid), "netcdf_io_initialize_output nf90_def_dim time_dimid" ) ! Simulation time dimension @@ -768,6 +769,7 @@ module subroutine swiftest_io_netcdf_open(self, param, readonly) write(errmsg,*) "netcdf_io_open nf90_open ",trim(adjustl(nc%file_name)) call netcdf_io_check( nf90_open(nc%file_name, mode, nc%id), errmsg) + self%lfile_is_open = .true. ! Dimensions call netcdf_io_check( nf90_inq_dimid(nc%id, nc%time_dimname, nc%time_dimid), "netcdf_io_open nf90_inq_dimid time_dimid" ) From 8516873d2b0abdc52d682b66c193386161284bdd Mon Sep 17 00:00:00 2001 From: David A Minton Date: Wed, 21 Dec 2022 14:47:00 -0500 Subject: [PATCH 482/569] Made some changes to file i/o. Code runs again. --- src/collision/collision_io.f90 | 2 ++ src/encounter/encounter_io.f90 | 2 ++ src/swiftest/swiftest_io.f90 | 6 ++++-- src/swiftest/swiftest_setup.f90 | 2 ++ 4 files changed, 10 insertions(+), 2 deletions(-) diff --git a/src/collision/collision_io.f90 b/src/collision/collision_io.f90 index 5a7ead8c0..22de3f27c 100644 --- a/src/collision/collision_io.f90 +++ b/src/collision/collision_io.f90 @@ -87,6 +87,8 @@ module subroutine collision_netcdf_io_initialize_output(self, param) self%out_type = NF90_FLOAT case("NETCDF_DOUBLE") self%out_type = NF90_DOUBLE + case default + write(*,*) trim(adjustl(param%out_type)), " is an invalid OUT_TYPE" end select ! Check if the file exists, and if it does, delete it diff --git a/src/encounter/encounter_io.f90 b/src/encounter/encounter_io.f90 index 46851cf2c..c5b68b98c 100644 --- a/src/encounter/encounter_io.f90 +++ b/src/encounter/encounter_io.f90 @@ -82,6 +82,8 @@ module subroutine encounter_netcdf_io_initialize_output(self, param) self%out_type = NF90_FLOAT case("NETCDF_DOUBLE") self%out_type = NF90_DOUBLE + case default + write(*,*) trim(adjustl(param%out_type)), " is an invalid OUT_TYPE" end select ! Check if the file exists, and if it does, delete it diff --git a/src/swiftest/swiftest_io.f90 b/src/swiftest/swiftest_io.f90 index a3fa11e11..efaf45d1f 100644 --- a/src/swiftest/swiftest_io.f90 +++ b/src/swiftest/swiftest_io.f90 @@ -599,10 +599,12 @@ module subroutine swiftest_io_netcdf_initialize_output(self, param) sfill = ieee_value(sfill, IEEE_QUIET_NAN) select case (param%out_type) - case("netcdf_io_FLOAT") + case("NETCDF_FLOAT") nc%out_type = NF90_FLOAT - case("netcdf_io_DOUBLE") + case("NETCDF_DOUBLE") nc%out_type = NF90_DOUBLE + case default + write(*,*) trim(adjustl(param%out_type)), " is an invalid OUT_TYPE" end select ! Check if the file exists, and if it does, delete it diff --git a/src/swiftest/swiftest_setup.f90 b/src/swiftest/swiftest_setup.f90 index 2e6ff3851..bbeafc6d2 100644 --- a/src/swiftest/swiftest_setup.f90 +++ b/src/swiftest/swiftest_setup.f90 @@ -113,6 +113,8 @@ module subroutine swiftest_setup_construct_system(system, param) write(*,*) 'Unkown integrator',param%integrator call util_exit(FAILURE) end select + + allocate(swiftest_particle_info :: system%cb%info) end select return From c65211daed5a543d6929525548796fb61b5ac778 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Wed, 21 Dec 2022 17:19:45 -0500 Subject: [PATCH 483/569] Started to work on making a variety of collision models other than Fraggle --- examples/Fragmentation/Fragmentation_Movie.py | 2 +- python/swiftest/swiftest/simulation_class.py | 46 ++-- src/CMakeLists.txt | 5 +- src/base/base_module.f90 | 8 +- src/collision/collision_generate.f90 | 39 ++++ src/collision/collision_module.f90 | 93 ++++++++- src/collision/collision_regime.f90 | 197 ++++++++++-------- src/collision/collision_resolve.f90 | 27 +-- src/fraggle/fraggle_generate.f90 | 34 ++- src/fraggle/fraggle_module.f90 | 11 +- src/swiftest/swiftest_io.f90 | 23 +- src/swiftest/swiftest_setup.f90 | 6 +- 12 files changed, 333 insertions(+), 158 deletions(-) create mode 100644 src/collision/collision_generate.f90 diff --git a/examples/Fragmentation/Fragmentation_Movie.py b/examples/Fragmentation/Fragmentation_Movie.py index e8d2b9fce..baff5c002 100644 --- a/examples/Fragmentation/Fragmentation_Movie.py +++ b/examples/Fragmentation/Fragmentation_Movie.py @@ -206,7 +206,7 @@ def data_stream(self, frame=0): # 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, encounter_save="both", gmtiny=gmtiny, minimum_fragment_gmass=minimum_fragment_gmass, verbose=False) + sim.set_parameter(collision_model="merge", encounter_save="both", gmtiny=gmtiny, minimum_fragment_gmass=minimum_fragment_gmass, verbose=False) sim.run(dt=1e-3, tstop=1.0e-3, istep_out=1, dump_cadence=0) print("Generating animation") diff --git a/python/swiftest/swiftest/simulation_class.py b/python/swiftest/swiftest/simulation_class.py index 9666ca298..530d8b034 100644 --- a/python/swiftest/swiftest/simulation_class.py +++ b/python/swiftest/swiftest/simulation_class.py @@ -224,16 +224,18 @@ def __init__(self,read_param: bool = False, read_old_output: bool = False, simdi general_relativity : bool, default True Include the post-Newtonian correction in acceleration calculations. Parameter input file equivalent: `GR` - fragmentation : bool, default True - If set to True, this turns on the Fraggle fragment generation code and `rotation` must also be True. + collision_model: {"MERGE","BOUNCE","SIMPLE","FRAGGLE"}, default "MERGE" + This is used to set the collision/fragmentation model. [TODO: DESCRIBE THESE] This argument only applies to Swiftest-SyMBA simulations. It will be ignored otherwise. - Parameter input file equivalent: `FRAGMENTATION` + Parameter input file equivalent: `COLLISION_MODEL` minimum_fragment_gmass : float, optional - If fragmentation is turned on, this sets the mimimum G*mass of a collisional fragment that can be generated. + If fragmentation is turned on, this sets the mimimum G*mass of a collisional fragment that can be generated if a + fragmentation model is enabled. Ignored otherwise. *Note.* Only set one of minimum_fragment_gmass or minimum_fragment_mass Parameter input file equivalent: None minimum_fragment_mass : float, optional - If fragmentation is turned on, this sets the mimimum mass of a collisional fragment that can be generated. + If fragmentation is turned on, this sets the mimimum mass of a collisional fragment that can be generated. if a + fragmentation model is enabled. Ignored otherwise *Note.* Only set one of minimum_fragment_gmass or minimum_fragment_mass Parameter input file equivalent: `MIN_GMFRAG` rotation : bool, default False @@ -777,7 +779,7 @@ def set_parameter(self, verbose: bool = True, **kwargs): "mtiny": None, "close_encounter_check": True, "general_relativity": True, - "fragmentation": False, + "collision_model": "MERGE", "minimum_fragment_mass": None, "minimum_fragment_gmass": 0.0, "rotation": False, @@ -1013,7 +1015,7 @@ def get_integrator(self,arg_list: str | List[str] | None = None, verbose: bool | def set_feature(self, close_encounter_check: bool | None = None, general_relativity: bool | None = None, - fragmentation: bool | None = None, + collision_model: Literal["MERGE","BOUNCE","SIMPLE","FRAGGLE"] | None = None, minimum_fragment_gmass: float | None = None, minimum_fragment_mass: float | None = None, rotation: bool | None = None, @@ -1046,15 +1048,20 @@ def set_feature(self, *WARNING*: Enabling this feature could lead to very large files. general_relativity : bool, optional Include the post-Newtonian correction in acceleration calculations. - fragmentation : bool, optional - If set to True, this turns on the Fraggle fragment generation code and `rotation` must also be True. + collision_model: {"MERGE","BOUNCE","SIMPLE","FRAGGLE"}, default "MERGE" + This is used to set the collision/fragmentation model. [TODO: DESCRIBE THESE] This argument only applies to Swiftest-SyMBA simulations. It will be ignored otherwise. + Parameter input file equivalent: `COLLISION_MODEL` minimum_fragment_gmass : float, optional - If fragmentation is turned on, this sets the mimimum G*mass of a collisional fragment that can be generated. + If fragmentation is turned on, this sets the mimimum G*mass of a collisional fragment that can be generated if a + fragmentation model is enabled. Ignored otherwise. *Note.* Only set one of minimum_fragment_gmass or minimum_fragment_mass + Parameter input file equivalent: None minimum_fragment_mass : float, optional - If fragmentation is turned on, this sets the mimimum mass of a collisional fragment that can be generated. + If fragmentation is turned on, this sets the mimimum mass of a collisional fragment that can be generated. if a + fragmentation model is enabled. Ignored otherwise *Note.* Only set one of minimum_fragment_gmass or minimum_fragment_mass + Parameter input file equivalent: `MIN_GMFRAG` rotation : bool, optional If set to True, this turns on rotation tracking and radius, rotation vector, and moments of inertia values must be included in the initial conditions. @@ -1122,13 +1129,16 @@ def set_feature(self, self.param["GR"] = general_relativity update_list.append("general_relativity") - if fragmentation is not None: + fragmentation_models = ["FRAGGLE", "SIMPLE"] + if collision_model is not None: + collision_model = collision_model.upper() + fragmentation = collision_model in fragmentation_models if self.codename != "Swiftest" and self.integrator != "symba" and fragmentation: warnings.warn("Fragmentation is only available on Swiftest SyMBA.",stacklevel=2) - self.param['FRAGMENTATION'] = False + self.param['COLLISION_MODEL'] = "MERGE" else: - self.param['FRAGMENTATION'] = fragmentation - update_list.append("fragmentation") + self.param['COLLISION_MODEL'] = collision_model + update_list.append("collision_model") if fragmentation: if "MIN_GMFRAG" not in self.param and minimum_fragment_mass is None and minimum_fragment_gmass is None: warnings.warn("Minimum fragment mass is not set. Set it using minimum_fragment_gmass or minimum_fragment_mass",stacklevel=2) @@ -1151,7 +1161,7 @@ def set_feature(self, self.param['ROTATION'] = rotation update_list.append("rotation") - if self.param['FRAGMENTATION'] and not self.param['ROTATION']: + if self.param['COLLISION_MODEL'] == "FRAGGLE" and not self.param['ROTATION']: self.param['ROTATION'] = True update_list.append("rotation") @@ -1230,7 +1240,7 @@ def get_feature(self, arg_list: str | List[str] | None = None, verbose: bool | N ---------- arg_list: str | List[str], optional A single string or list of strings containing the names of the features to extract. Default is all of: - ["close_encounter_check", "general_relativity", "fragmentation", "rotation", "compute_conservation_values"] + ["close_encounter_check", "general_relativity", "collision_model", "rotation", "compute_conservation_values"] verbose: bool, optional If passed, it will override the Simulation object's verbose flag **kwargs @@ -1245,7 +1255,7 @@ def get_feature(self, arg_list: str | List[str] | None = None, verbose: bool | N """ valid_var = {"close_encounter_check": "CHK_CLOSE", - "fragmentation": "FRAGMENTATION", + "collision_model": "COLLISION_MODEL", "encounter_save": "ENCOUNTER_SAVE", "minimum_fragment_gmass": "MIN_GMFRAG", "rotation": "ROTATION", diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index 27d4a7bab..8cb9f6228 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -40,10 +40,11 @@ SET(FAST_MATH_FILES ${SRC}/helio/helio_module.f90 ${SRC}/symba/symba_module.f90 ${SRC}/collision/collision_check.f90 - ${SRC}/collision/collision_regime.f90 - ${SRC}/collision/collision_setup.f90 ${SRC}/collision/collision_io.f90 + ${SRC}/collision/collision_model.f90 + ${SRC}/collision/collision_regime.f90 ${SRC}/collision/collision_resolve.f90 + ${SRC}/collision/collision_setup.f90 ${SRC}/collision/collision_util.f90 ${SRC}/encounter/encounter_check.f90 ${SRC}/encounter/encounter_io.f90 diff --git a/src/base/base_module.f90 b/src/base/base_module.f90 index b85547cfd..bda2c6406 100644 --- a/src/base/base_module.f90 +++ b/src/base/base_module.f90 @@ -34,8 +34,8 @@ module base character(STRMAX) :: inplfile = PL_INFILE !! Name of input file for massive bodies character(STRMAX) :: intpfile = TP_INFILE !! Name of input file for test particles character(STRMAX) :: in_netcdf = NC_INFILE !! Name of system input file for NetCDF input - character(STRMAX) :: in_type = "ASCII" !! Data representation type of input data files - character(STRMAX) :: in_form = "XV" !! Format of input data files ("EL" or "XV") + character(STRMAX) :: in_type = "NETCDF_DOUBLE" !! Data representation type of input data files + character(STRMAX) :: in_form = "XV" !! Format of input data files ("EL" or ["XV"]) integer(I4B) :: istep_out = -1 !! Number of time steps between saved outputs character(STRMAX) :: outfile = BIN_OUTFILE !! Name of output binary file character(STRMAX) :: out_type = "NETCDF_DOUBLE" !! Binary format of output file @@ -46,7 +46,7 @@ module base real(DP) :: rmax = -1.0_DP !! Maximum heliocentric radius for test particle real(DP) :: rmaxu = -1.0_DP !! Maximum unbound heliocentric radius for test particle real(DP) :: qmin = -1.0_DP !! Minimum pericenter distance for test particle - character(STRMAX) :: qmin_coord = 'HELIO' !! Coordinate frame to use for qmin + character(STRMAX) :: qmin_coord = "HELIO" !! Coordinate frame to use for qmin (["HELIO"] or "BARY") real(DP) :: qmin_alo = -1.0_DP !! Minimum semimajor axis for qmin real(DP) :: qmin_ahi = -1.0_DP !! Maximum semimajor axis for qmin real(QP) :: MU2KG = -1.0_QP !! Converts mass units to grams @@ -58,7 +58,7 @@ module base real(DP) :: min_GMfrag = -1.0_DP !! Smallest G*mass that can be produced in a fragmentation event integer(I4B), dimension(:), allocatable :: seed !! Random seeds for fragmentation modeling logical :: lmtiny_pl = .false. !! Include semi-interacting massive bodies - logical :: lfragmentation = .false. !! Do fragmentation modeling instead of simple merger. + character(STRMAX) :: collision_model = "MERGE" !! The Coll character(STRMAX) :: encounter_save = "NONE" !! Indicate if and how encounter data should be saved logical :: lenc_save_trajectory = .false. !! Indicates that when encounters are saved, the full trajectory through recursion steps are saved logical :: lenc_save_closest = .false. !! Indicates that when encounters are saved, the closest approach distance between pairs of bodies is saved diff --git a/src/collision/collision_generate.f90 b/src/collision/collision_generate.f90 new file mode 100644 index 000000000..578f3ad58 --- /dev/null +++ b/src/collision/collision_generate.f90 @@ -0,0 +1,39 @@ + +!! Copyright 2022 - David Minton, Carlisle Wishard, Jennifer Pouplin, Jake Elliott, & Dana Singh +!! This file is part of Swiftest. +!! Swiftest is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License +!! as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. +!! Swiftest is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty +!! of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. +!! You should have received a copy of the GNU General Public License along with Swiftest. +!! If not, see: https://www.gnu.org/licenses. + +submodule(collision) s_collision_model + use swiftest +contains + + module subroutine collision_generate_merge_system(self, system, param, t) + implicit none + class(collision_merge), intent(inout) :: self !! Fraggle fragment system object + class(base_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(base_parameters), intent(inout) :: param !! Current run configuration parameters + real(DP), intent(in) :: t !! The time of the collision + end subroutine collision_generate_merge_system + + module subroutine collision_generate_bounce_system(self, system, param, t) + implicit none + class(collision_bounce), intent(inout) :: self !! Fraggle fragment system object + class(base_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(base_parameters), intent(inout) :: param !! Current run configuration parameters + real(DP), intent(in) :: t !! The time of the collision + end subroutine collision_generate_bounce_system + + module subroutine collision_generate_simple_system(self, system, param, t) + implicit none + class(collision_simple), intent(inout) :: self !! Fraggle fragment system object + class(base_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(base_parameters), intent(inout) :: param !! Current run configuration parameters + real(DP), intent(in) :: t !! The time of the collision + end subroutine collision_generate_simple_system + +end submodule s_collision_model \ No newline at end of file diff --git a/src/collision/collision_module.f90 b/src/collision/collision_module.f90 index d04a07207..408fdfd7b 100644 --- a/src/collision/collision_module.f90 +++ b/src/collision/collision_module.f90 @@ -107,7 +107,7 @@ module collision end type collision_fragments - type :: collision_system + type, abstract :: collision_system !! This class defines a collisional system that stores impactors and fragments. This is written so that various collision models (i.e. Fraggle) could potentially be used !! to resolve collision by defining extended types of encounters_impactors and/or encounetr_fragments class(collision_fragments(:)), allocatable :: fragments !! Object containing information on the pre-collision system @@ -124,7 +124,7 @@ module collision real(DP), dimension(2) :: pe !! Before/after potential energy real(DP), dimension(2) :: Etot !! Before/after total system energy contains - procedure :: generate_fragments => abstract_generate_fragments !! Generates a system of fragments + procedure(abstract_generate_fragments), deferred :: generate_fragments !! Generates a system of fragments depending on collision model procedure :: set_mass_dist => abstract_set_mass_dist !! Sets the distribution of mass among the fragments depending on the regime type procedure :: setup => collision_setup_system !! Initializer for the encounter collision system and the before/after snapshots procedure :: setup_impactors => collision_setup_impactors_system !! Initializer for the impactors for the encounter collision system. Deallocates old impactors before creating new ones @@ -134,9 +134,26 @@ module collision procedure :: get_energy_and_momentum => collision_util_get_energy_momentum !! Calculates total system energy in either the pre-collision outcome state (lbefore = .true.) or the post-collision outcome state (lbefore = .false.) procedure :: reset => collision_util_reset_system !! Deallocates all allocatables procedure :: set_coordinate_system => collision_util_set_coordinate_system !! Sets the coordinate system of the collisional system - final :: collision_final_system !! Finalizer will deallocate all allocatables end type collision_system + type, extends(collision_system) :: collision_merge + contains + procedure :: generate_fragments => collision_generate_merge_system !! Merges the impactors to make a single final body + final :: collision_final_merge_system !! Finalizer will deallocate all allocatables + end type collision_merge + + type, extends(collision_system) :: collision_bounce + contains + procedure :: generate_fragments => collision_generate_bounce_system !! If a collision would result in a disruption, "bounce" the bodies instead. + final :: collision_final_bounce_system !! Finalizer will deallocate all allocatables + end type collision_bounce + + type, extends(collision_system) :: collision_simple + contains + procedure :: generate_fragments => collision_generate_simple_system !! If a collision would result in a disruption [TODO: SOMETHING LIKE CHAMBERS 2012] + final :: collision_final_simple_system !! Finalizer will deallocate all allocatables + end type collision_simple + !! NetCDF dimension and variable names for the enounter save object type, extends(encounter_netcdf_parameters) :: collision_netcdf_parameters @@ -181,13 +198,13 @@ module collision abstract interface - subroutine abstract_generate_fragments(self, system, param, lfailure) - import collision_system, base_nbody_system, base_parameters + subroutine abstract_generate_fragments(self, system, param, t) + import collision_system, base_nbody_system, base_parameters, DP implicit none class(collision_system), intent(inout) :: self !! Collision system object class(base_nbody_system), intent(inout) :: system !! Swiftest nbody system object class(base_parameters), intent(inout) :: param !! Current run configuration parameters - logical, intent(out) :: lfailure !! Answers the question: Should this have been a merger instead? + real(DP), intent(in) :: t !! The time of the collision end subroutine abstract_generate_fragments subroutine abstract_set_mass_dist(self, param) @@ -200,6 +217,31 @@ end subroutine abstract_set_mass_dist interface + + module subroutine collision_generate_merge_system(self, system, param, t) + implicit none + class(collision_merge), intent(inout) :: self !! Fraggle fragment system object + class(base_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(base_parameters), intent(inout) :: param !! Current run configuration parameters + real(DP), intent(in) :: t !! The time of the collision + end subroutine collision_generate_merge_system + + module subroutine collision_generate_bounce_system(self, system, param, t) + implicit none + class(collision_bounce), intent(inout) :: self !! Fraggle fragment system object + class(base_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(base_parameters), intent(inout) :: param !! Current run configuration parameters + real(DP), intent(in) :: t !! The time of the collision + end subroutine collision_generate_bounce_system + + module subroutine collision_generate_simple_system(self, system, param, t) + implicit none + class(collision_simple), intent(inout) :: self !! Fraggle fragment system object + class(base_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(base_parameters), intent(inout) :: param !! Current run configuration parameters + real(DP), intent(in) :: t !! The time of the collision + end subroutine collision_generate_simple_system + module subroutine collision_netcdf_io_dump(self, param) implicit none class(collision_storage(*)), intent(inout) :: self !! Collision storage object @@ -354,7 +396,6 @@ module subroutine collision_util_reset_fragments(self) class(collision_fragments(*)), intent(inout) :: self end subroutine collision_util_reset_fragments - module subroutine collision_util_get_idvalues_snapshot(self, idvals) implicit none class(collision_snapshot), intent(in) :: self !! Fraggle snapshot object @@ -498,20 +539,52 @@ subroutine collision_final_storage(self) end subroutine collision_final_storage - subroutine collision_final_system(self) + subroutine collision_final_merge_system(self) + !! author: David A. Minton + !! + !! Finalizer will deallocate all allocatables + implicit none + ! Arguments + type(collision_merge), intent(inout) :: self !! Collision system object + + call self%reset() + if (allocated(self%impactors)) deallocate(self%impactors) + if (allocated(self%fragments)) deallocate(self%fragments) + + return + end subroutine collision_final_merge_system + + + subroutine collision_final_bounce_system(self) + !! author: David A. Minton + !! + !! Finalizer will deallocate all allocatables + implicit none + ! Arguments + type(collision_bounce), intent(inout) :: self !! Collision system object + + call self%reset() + if (allocated(self%impactors)) deallocate(self%impactors) + if (allocated(self%fragments)) deallocate(self%fragments) + + return + end subroutine collision_final_bounce_system + + + subroutine collision_final_simple_system(self) !! author: David A. Minton !! !! Finalizer will deallocate all allocatables implicit none ! Arguments - type(collision_system), intent(inout) :: self !! Collision system object + type(collision_simple), intent(inout) :: self !! Collision system object call self%reset() if (allocated(self%impactors)) deallocate(self%impactors) if (allocated(self%fragments)) deallocate(self%fragments) return - end subroutine collision_final_system + end subroutine collision_final_simple_system diff --git a/src/collision/collision_regime.f90 b/src/collision/collision_regime.f90 index b74d76d5f..5aa170863 100644 --- a/src/collision/collision_regime.f90 +++ b/src/collision/collision_regime.f90 @@ -13,8 +13,116 @@ contains - subroutine collision_regime_collresolve(Mcb, m1, m2, rad1, rad2, rh1, rh2, vb1, vb2, den1, den2, min_mfrag, & - regime, Mlr, Mslr, Qloss) + module subroutine collision_regime_impactors(self, system, param) + !! Author: Jennifer L.L. Pouplin, Carlisle A. Wishard, and David A. Minton + !! + !! Determine which fragmentation regime the set of impactors will be. This subroutine is a wrapper for the non-polymorphic raggle_regime_collresolve subroutine. + !! It converts to SI units prior to calling + implicit none + ! Arguments + class(collision_impactors), intent(inout) :: self !! Collision system impactors object + class(base_nbody_system), intent(in) :: system !! Swiftest nbody system object + class(base_parameters), intent(in) :: param !! Current Swiftest run configuration parameters + ! Internals + real (DP) :: mtot + + associate(impactors => self) + select type (system) + class is (swiftest_nbody_system) + select type(param) + class is (swiftest_parameters) + + select case(param%collision_model) + case("MERGE") + impactors%regime = COLLRESOLVE_REGIME_MERGE + mtot = sum(impactors%mass(:)) + impactors%mass_dist(1) = mtot + impactors%mass_dist(2) = 0.0_DP + impactors%mass_dist(3) = 0.0_DP + impactors%rbcom(:) = (impactors%mass(1) * impactors%rb(:,1) + impactors%mass(2) * impactors%rb(:,2)) / mtot + impactors%vbcom(:) = (impactors%mass(1) * impactors%vb(:,1) + impactors%mass(2) * impactors%vb(:,2)) / mtot + case default + call collision_regim_LS12(impactors, system, param) + end select + !call fraggle_io_log_regime(impactors, fragments) + end select + end select + end associate + + return + end subroutine collision_regime_impactors + + + subroutine collision_regime_LS12(impactors, nbody_system, param) + !! Author: Jennifer L.L. Pouplin, Carlisle A. Wishard, and David A. Minton + !! + !! Determine the collisional regime of two colliding bodies based on the model by Leinhard and Stewart (2012) + !! + !! This is a wrapper subroutine that converts quantities to SI units and calls the main LS12 subroutine + implicit none + ! Arguments + class(collision_impactors), intent(inout) :: impactors !! The impactors to determine the regime for + class(swiftest_nbody_system), intent(in) :: nbody_system !! Swiftest n-body system object + class(swiftest_parameters), intent(in) :: param !! The current parameters + ! Internals + integer(I4B) :: jtarg, jproj + real(DP), dimension(2) :: radius_si, mass_si, density_si + real(DP) :: min_mfrag_si, Mcb_si + real(DP), dimension(NDIM) :: x1_si, v1_si, x2_si, v2_si, runit + real(DP) :: mlr, mslr, mtot, dentot + + ! Convert all quantities to SI units and determine which of the pair is the projectile vs. target before sending them to the regime determination subroutine + if (impactors%mass(1) > impactors%mass(2)) then + jtarg = 1 + jproj = 2 + else + jtarg = 2 + jproj = 1 + end if + mass_si(:) = impactors%mass([jtarg, jproj]) * param%MU2KG !! The two-body equivalent masses of the collider system + radius_si(:) = impactors%radius([jtarg, jproj]) * param%DU2M !! The two-body equivalent radii of the collider system + density_si(:) = mass_si(:) / (4.0_DP / 3._DP * PI * radius_si(:)**3) !! The two-body equivalent density of the collider system + x1_si(:) = impactors%rb(:,jtarg) * param%DU2M !! The first body of the two-body equivalent position vector the collider system + v1_si(:) = impactors%vb(:,jtarg) * param%DU2M / param%TU2S !! The first body of the two-body equivalent velocity vector the collider system + x2_si(:) = impactors%rb(:,jproj) * param%DU2M !! The second body of the two-body equivalent position vector the collider system + v2_si(:) = impactors%vb(:,jproj) * param%DU2M / param%TU2S !! The second body of the two-body equivalent velocity vector the collider system + Mcb_si = nbody_system%cb%mass * param%MU2KG !! The central body mass of the system + min_mfrag_si = (param%min_GMfrag / param%GU) * param%MU2KG !! The minimum fragment mass to generate. Collider systems that would otherwise generate less massive fragments than this value will be forced to merge instead + + mtot = sum(mass_si(:)) + dentot = sum(mass_si(:) * density_si(:)) / mtot + + !! Use the positions and velocities of the parents from indside the step (at collision) to calculate the collisional regime + call collision_regime_collresolve(Mcb_si, mass_si(jtarg), mass_si(jproj), radius_si(jtarg), radius_si(jproj), & + x1_si(:), x2_si(:), v1_si(:), v2_si(:), density_si(jtarg), density_si(jproj), & + min_mfrag_si, impactors%regime, mlr, mslr, impactors%Qloss) + + if (allocated(impactors%mass_dist)) deallocate(impactors%mass_dist) + allocate(impactors%mass_dist(3)) + impactors%mass_dist(1) = min(max(mlr, 0.0_DP), mtot) + impactors%mass_dist(2) = min(max(mslr, 0.0_DP), mtot) + impactors%mass_dist(3) = min(max(mtot - mlr - mslr, 0.0_DP), mtot) + + ! Find the center of mass of the collisional system + mtot = sum(impactors%mass(:)) + impactors%rbcom(:) = (impactors%mass(1) * impactors%rb(:,1) + impactors%mass(2) * impactors%rb(:,2)) / mtot + impactors%vbcom(:) = (impactors%mass(1) * impactors%vb(:,1) + impactors%mass(2) * impactors%vb(:,2)) / mtot + + ! Find the point of impact between the two bodies + runit(:) = impactors%rb(:,2) - impactors%rb(:,1) + runit(:) = runit(:) / (.mag. runit(:)) + impactors%rbimp(:) = impactors%rb(:,1) + impactors%radius(1) * runit(:) + + ! Convert quantities back to the system units and save them into the fragment system + impactors%mass_dist(:) = (impactors%mass_dist(:) / param%MU2KG) + impactors%Qloss = impactors%Qloss * (param%TU2S / param%DU2M)**2 / param%MU2KG + + return + end subroutine collision_regime_LS12 + + + subroutine collision_regime_LS12_SI(Mcb, m1, m2, rad1, rad2, rh1, rh2, vb1, vb2, den1, den2, min_mfrag, & + regime, Mlr, Mslr, Qloss) !! Author: Jennifer L.L. Pouplin, Carlisle A. Wishard, and David A. Minton !! !! Determine the collisional regime of two colliding bodies. @@ -182,8 +290,8 @@ subroutine collision_regime_collresolve(Mcb, m1, m2, rad1, rad2, rh1, rh2, vb1, return - ! Internal functions contains + function calc_Qrd_pstar(Mtarg, Mp, alpha, c_star) result(Qrd_pstar) !! author: Jennifer L.L. Pouplin and Carlisle A. Wishard !! @@ -305,89 +413,8 @@ function calc_c_star(Rc1) result(c_star) return end function calc_c_star - end subroutine collision_regime_collresolve - - - module subroutine collision_regime_impactors(self, system, param) - !! Author: Jennifer L.L. Pouplin, Carlisle A. Wishard, and David A. Minton - !! - !! Determine which fragmentation regime the set of impactors will be. This subroutine is a wrapper for the non-polymorphic raggle_regime_collresolve subroutine. - !! It converts to SI units prior to calling - implicit none - ! Arguments - class(collision_impactors), intent(inout) :: self !! Collision system impactors object - class(base_nbody_system), intent(in) :: system !! Swiftest nbody system object - class(base_parameters), intent(in) :: param !! Current Swiftest run configuration parameters - ! Internals - integer(I4B) :: jtarg, jproj - real(DP), dimension(2) :: radius_si, mass_si, density_si - real(DP) :: min_mfrag_si, Mcb_si - real(DP), dimension(NDIM) :: x1_si, v1_si, x2_si, v2_si, runit - real(DP) :: mlr, mslr, mtot, dentot - - associate(impactors => self) - select type (system) - class is (swiftest_nbody_system) - ! Convert all quantities to SI units and determine which of the pair is the projectile vs. target before sending them to the regime determination subroutine - if (impactors%mass(1) > impactors%mass(2)) then - jtarg = 1 - jproj = 2 - else - jtarg = 2 - jproj = 1 - end if - mass_si(:) = impactors%mass([jtarg, jproj]) * param%MU2KG !! The two-body equivalent masses of the collider system - radius_si(:) = impactors%radius([jtarg, jproj]) * param%DU2M !! The two-body equivalent radii of the collider system - density_si(:) = mass_si(:) / (4.0_DP / 3._DP * PI * radius_si(:)**3) !! The two-body equivalent density of the collider system - x1_si(:) = impactors%rb(:,jtarg) * param%DU2M !! The first body of the two-body equivalent position vector the collider system - v1_si(:) = impactors%vb(:,jtarg) * param%DU2M / param%TU2S !! The first body of the two-body equivalent velocity vector the collider system - x2_si(:) = impactors%rb(:,jproj) * param%DU2M !! The second body of the two-body equivalent position vector the collider system - v2_si(:) = impactors%vb(:,jproj) * param%DU2M / param%TU2S !! The second body of the two-body equivalent velocity vector the collider system - Mcb_si = system%cb%mass * param%MU2KG !! The central body mass of the system - select type(param) - class is (base_parameters) - min_mfrag_si = (param%min_GMfrag / param%GU) * param%MU2KG !! The minimum fragment mass to generate. Collider systems that would otherwise generate less massive fragments than this value will be forced to merge instead - class default - min_mfrag_si = 0.0_DP - end select - - mtot = sum(mass_si(:)) - dentot = sum(mass_si(:) * density_si(:)) / mtot - - !! Use the positions and velocities of the parents from indside the step (at collision) to calculate the collisional regime - call collision_regime_collresolve(Mcb_si, mass_si(jtarg), mass_si(jproj), radius_si(jtarg), radius_si(jproj), & - x1_si(:), x2_si(:), v1_si(:), v2_si(:), density_si(jtarg), density_si(jproj), & - min_mfrag_si, impactors%regime, mlr, mslr, impactors%Qloss) - - if (allocated(impactors%mass_dist)) deallocate(impactors%mass_dist) - allocate(impactors%mass_dist(3)) - impactors%mass_dist(1) = min(max(mlr, 0.0_DP), mtot) - impactors%mass_dist(2) = min(max(mslr, 0.0_DP), mtot) - impactors%mass_dist(3) = min(max(mtot - mlr - mslr, 0.0_DP), mtot) - - ! Find the center of mass of the collisional system - mtot = sum(impactors%mass(:)) - impactors%rbcom(:) = (impactors%mass(1) * impactors%rb(:,1) + impactors%mass(2) * impactors%rb(:,2)) / mtot - impactors%vbcom(:) = (impactors%mass(1) * impactors%vb(:,1) + impactors%mass(2) * impactors%vb(:,2)) / mtot - - ! Find the point of impact between the two bodies - runit(:) = impactors%rb(:,2) - impactors%rb(:,1) - runit(:) = runit(:) / (.mag. runit(:)) - impactors%rbimp(:) = impactors%rb(:,1) + impactors%radius(1) * runit(:) - - ! Convert quantities back to the system units and save them into the fragment system - impactors%mass_dist(:) = (impactors%mass_dist(:) / param%MU2KG) - impactors%Qloss = impactors%Qloss * (param%TU2S / param%DU2M)**2 / param%MU2KG - - !call fraggle_io_log_regime(impactors, fragments) - end select - end associate - - return - end subroutine collision_regime_impactors + end subroutine collision_regime_LS12_SI - ! module subroutine collision_regime_resolve(self) - ! end subroutine collision_regime_resolve end submodule s_collision_regime \ No newline at end of file diff --git a/src/collision/collision_resolve.f90 b/src/collision/collision_resolve.f90 index ec3f8b67a..0edde0e3e 100644 --- a/src/collision/collision_resolve.f90 +++ b/src/collision/collision_resolve.f90 @@ -616,30 +616,11 @@ subroutine collision_resolve_list(plpl_collision , system, param, t) lgoodcollision = collision_resolve_consolidate_impactors(pl, cb, param, idx_parent, impactors) if ((.not. lgoodcollision) .or. any(pl%status(idx_parent(:)) /= COLLIDED)) cycle - if (param%lfragmentation) then - call impactors%get_regime(system, param) - else - impactors%regime = COLLRESOLVE_REGIME_MERGE - fragments%mtot = sum(impactors%mass(:)) - impactors%mass_dist(1) = fragments%mtot - impactors%mass_dist(2) = 0.0_DP - impactors%mass_dist(3) = 0.0_DP - impactors%rbcom(:) = (impactors%mass(1) * impactors%rb(:,1) + impactors%mass(2) * impactors%rb(:,2)) / fragments%mtot - impactors%vbcom(:) = (impactors%mass(1) * impactors%vb(:,1) + impactors%mass(2) * impactors%vb(:,2)) / fragments%mtot - end if - + call impactors%get_regime(system, param) call collision_history%take_snapshot(param,system, t, "before") - select case (impactors%regime) - case (COLLRESOLVE_REGIME_DISRUPTION, COLLRESOLVE_REGIME_SUPERCATASTROPHIC) - plpl_collision%status(i) = fraggle_resolve_disruption(system, param, t) - case (COLLRESOLVE_REGIME_HIT_AND_RUN) - plpl_collision%status(i) = fraggle_resolve_hitandrun(system, param, t) - case (COLLRESOLVE_REGIME_MERGE, COLLRESOLVE_REGIME_GRAZE_AND_MERGE) - plpl_collision%status(i) = collision_resolve_merge(system, param, t) - case default - write(*,*) "Error in swiftest_collision, unrecognized collision regime" - call util_exit(FAILURE) - end select + + call collision_system%generate_fragments(system, param, t) + call collision_history%take_snapshot(param,system, t, "after") call impactors%reset() end do diff --git a/src/fraggle/fraggle_generate.f90 b/src/fraggle/fraggle_generate.f90 index 8903c0ae1..16f93b652 100644 --- a/src/fraggle/fraggle_generate.f90 +++ b/src/fraggle/fraggle_generate.f90 @@ -18,7 +18,39 @@ contains - module subroutine fraggle_generate_fragments(self, system, param, lfailure) + module subroutine fraggle_generate_system(self, system, param, t) + implicit none + class(fraggle_system), intent(inout) :: self !! Fraggle fragment system object + class(base_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(base_parameters), intent(inout) :: param !! Current run configuration parameters + real(DP), intent(in) :: t !! The time of the collision + ! Internals + integer(I4B) :: i + + select type(system) + class is (swiftest_nbody_system) + select type(param) + class is (swiftest_parameters) + associate(impactors => self%impactors, plpl_collision => system%plpl_collision) + select case (impactors%regime) + case (COLLRESOLVE_REGIME_DISRUPTION, COLLRESOLVE_REGIME_SUPERCATASTROPHIC) + plpl_collision%status(i) = fraggle_resolve_disruption(system, param, t) + case (COLLRESOLVE_REGIME_HIT_AND_RUN) + plpl_collision%status(i) = fraggle_resolve_hitandrun(system, param, t) + case (COLLRESOLVE_REGIME_MERGE, COLLRESOLVE_REGIME_GRAZE_AND_MERGE) + plpl_collision%status(i) = collision_resolve_merge(system, param, t) + case default + write(*,*) "Error in swiftest_collision, unrecognized collision regime" + call util_exit(FAILURE) + end select + end associate + end select + end select + + end subroutine fraggle_generate_system + + + subroutine fraggle_generate_fragments(self, system, param, lfailure) !! Author: Jennifer L.L. Pouplin, Carlisle A. Wishard, and David A. Minton !! !! Generates a system of fragments in barycentric coordinates that conserves energy and momentum. diff --git a/src/fraggle/fraggle_module.f90 b/src/fraggle/fraggle_module.f90 index e77dd44e2..df4f402cf 100644 --- a/src/fraggle/fraggle_module.f90 +++ b/src/fraggle/fraggle_module.f90 @@ -51,7 +51,7 @@ module fraggle real(DP) :: Escale = 1.0_DP !! Energy scale factor (a convenience unit that is derived from dscale, tscale, and mscale) real(DP) :: Lscale = 1.0_DP !! Angular momentum scale factor (a convenience unit that is derived from dscale, tscale, and mscale) contains - procedure :: generate_fragments => fraggle_generate_fragments !! Generates a system of fragments in barycentric coordinates that conserves energy and momentum. + procedure :: generate_fragments => fraggle_generate_system !! Generates a system of fragments in barycentric coordinates that conserves energy and momentum. procedure :: set_budgets => fraggle_set_budgets !! Sets the energy and momentum budgets of the fragments based on the collider value procedure :: set_mass_dist => fraggle_set_mass_dist !! Sets the distribution of mass among the fragments depending on the regime type procedure :: set_natural_scale => fraggle_set_natural_scale_factors !! Scales dimenional quantities to ~O(1) with respect to the collisional system. @@ -65,14 +65,13 @@ module fraggle interface - module subroutine fraggle_generate_fragments(self, system, param, lfailure) - use base, only : base_nbody_system, base_parameters + module subroutine fraggle_generate_system(self, system, param, t) implicit none - class(fraggle_system), intent(inout) :: self !! Fraggle fragment system object + class(fraggle_system), intent(inout) :: self !! Fraggle fragment system object class(base_nbody_system), intent(inout) :: system !! Swiftest nbody system object class(base_parameters), intent(inout) :: param !! Current run configuration parameters - logical, intent(out) :: lfailure !! Answers the question: Should this have been a merger instead? - end subroutine fraggle_generate_fragments + real(DP), intent(in) :: t !! Time of collision + end subroutine fraggle_generate_system module subroutine fraggle_io_log_regime(collision_system) implicit none diff --git a/src/swiftest/swiftest_io.f90 b/src/swiftest/swiftest_io.f90 index efaf45d1f..456bef4a0 100644 --- a/src/swiftest/swiftest_io.f90 +++ b/src/swiftest/swiftest_io.f90 @@ -583,7 +583,7 @@ module subroutine swiftest_io_netcdf_initialize_output(self, param) implicit none ! Arguments class(swiftest_netcdf_parameters), intent(inout) :: self !! Parameters used to for writing a NetCDF dataset to file - class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters + class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters ! Internals integer(I4B) :: nvar, varid, vartype real(DP) :: dfill @@ -1915,9 +1915,9 @@ module subroutine swiftest_io_param_reader(self, unit, iotype, v_list, iostat, i read(param_value, *, err = 667, iomsg = iomsg) param%maxid case ("MAXID_COLLISION") read(param_value, *, err = 667, iomsg = iomsg) param%maxid_collision - case ("FRAGMENTATION") + case ("COLLISION_MODEL") call swiftest_io_toupper(param_value) - if (param_value == "YES" .or. param_value == "T") self%lfragmentation = .true. + read(param_value, *) param%collision_model case ("GMTINY") read(param_value, *) param%GMTINY case ("MIN_GMFRAG") @@ -2076,13 +2076,24 @@ module subroutine swiftest_io_param_reader(self, unit, iotype, v_list, iostat, i param%lmtiny_pl = (integrator == INT_SYMBA) - if (param%lmtiny_pl .and. self%GMTINY < 0.0_DP) then - write(iomsg,*) "GMTINY invalid or not set: ", self%GMTINY + if (param%lmtiny_pl .and. param%GMTINY < 0.0_DP) then + write(iomsg,*) "GMTINY invalid or not set: ", param%GMTINY iostat = -1 return end if - if (param%lfragmentation) then + + if ((param%collision_model /= "MERGE") .and. & + (param%collision_model /= "SIMPLE") .and. & + (param%collision_model /= "BOUNCE") .and. & + (param%collision_model /= "FRAGGLE")) then + write(iomsg,*) 'Invalid collision_model parameter: ',trim(adjustl(param%out_type)) + write(iomsg,*) 'Valid options are NONE, TRAJECTORY, CLOSEST, or BOTH' + iostat = -1 + return + end if + + if (param%collision_model == "FRAGGLE") then if (seed_set) then call random_seed(put = param%seed) else diff --git a/src/swiftest/swiftest_setup.f90 b/src/swiftest/swiftest_setup.f90 index bbeafc6d2..ede789d7d 100644 --- a/src/swiftest/swiftest_setup.f90 +++ b/src/swiftest/swiftest_setup.f90 @@ -83,10 +83,12 @@ module subroutine swiftest_setup_construct_system(system, param) allocate(collision_list_plpl :: system%plpl_encounter) allocate(collision_list_plpl :: system%plpl_collision) - if (param%lfragmentation) then + if (param%collision_model == "FRAGGLE") then allocate(fraggle_system :: system%collision_system) - call system%collision_system%setup(system) + else + allocate(collision_system :: system%collision_system) end if + call system%collision_system%setup(system) if (param%lenc_save_trajectory .or. param%lenc_save_closest) then allocate(encounter_netcdf_parameters :: encounter_history%nc) From c0955c81d6317790ee885d1bbdfff6a4a522c104 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Wed, 21 Dec 2022 19:46:27 -0500 Subject: [PATCH 484/569] Cleanup --- src/CMakeLists.txt | 2 +- src/collision/collision_generate.f90 | 43 +++++++++++---------- src/collision/collision_module.f90 | 51 ++++++++++++------------ src/collision/collision_resolve.f90 | 2 +- src/fraggle/fraggle_generate.f90 | 58 ++++++++++++++-------------- src/fraggle/fraggle_module.f90 | 39 ++++++++++--------- src/fraggle/fraggle_resolve.f90 | 13 ++++--- src/fraggle/fraggle_set.f90 | 4 +- src/fraggle/fraggle_util.f90 | 6 +-- src/swiftest/swiftest_module.f90 | 1 - 10 files changed, 111 insertions(+), 108 deletions(-) diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index 8cb9f6228..4f7c53667 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -31,7 +31,6 @@ SET(FAST_MATH_FILES ${SRC}/misc/minimizer_module.f90 ${SRC}/encounter/encounter_module.f90 ${SRC}/collision/collision_module.f90 - ${SRC}/fraggle/fraggle_module.f90 ${SRC}/operator/operator_module.f90 ${SRC}/walltime/walltime_module.f90 ${SRC}/swiftest/swiftest_module.f90 @@ -39,6 +38,7 @@ SET(FAST_MATH_FILES ${SRC}/rmvs/rmvs_module.f90 ${SRC}/helio/helio_module.f90 ${SRC}/symba/symba_module.f90 + ${SRC}/fraggle/fraggle_module.f90 ${SRC}/collision/collision_check.f90 ${SRC}/collision/collision_io.f90 ${SRC}/collision/collision_model.f90 diff --git a/src/collision/collision_generate.f90 b/src/collision/collision_generate.f90 index 578f3ad58..a849f69dc 100644 --- a/src/collision/collision_generate.f90 +++ b/src/collision/collision_generate.f90 @@ -12,28 +12,29 @@ use swiftest contains - module subroutine collision_generate_merge_system(self, system, param, t) - implicit none - class(collision_merge), intent(inout) :: self !! Fraggle fragment system object - class(base_nbody_system), intent(inout) :: system !! Swiftest nbody system object - class(base_parameters), intent(inout) :: param !! Current run configuration parameters - real(DP), intent(in) :: t !! The time of the collision - end subroutine collision_generate_merge_system - module subroutine collision_generate_bounce_system(self, system, param, t) - implicit none - class(collision_bounce), intent(inout) :: self !! Fraggle fragment system object - class(base_nbody_system), intent(inout) :: system !! Swiftest nbody system object - class(base_parameters), intent(inout) :: param !! Current run configuration parameters - real(DP), intent(in) :: t !! The time of the collision - end subroutine collision_generate_bounce_system + module subroutine collision_generate_merge_system(self, nbody_system, param, t) + implicit none + class(collision_merge), intent(inout) :: self !! Merge fragment system object + class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object + class(base_parameters), intent(inout) :: param !! Current run configuration parameters + real(DP), intent(in) :: t !! The time of the collision + end subroutine collision_generate_merge_system - module subroutine collision_generate_simple_system(self, system, param, t) - implicit none - class(collision_simple), intent(inout) :: self !! Fraggle fragment system object - class(base_nbody_system), intent(inout) :: system !! Swiftest nbody system object - class(base_parameters), intent(inout) :: param !! Current run configuration parameters - real(DP), intent(in) :: t !! The time of the collision - end subroutine collision_generate_simple_system + module subroutine collision_generate_bounce_system(self, nbody_system, param, t) + implicit none + class(collision_bounce), intent(inout) :: self !! Bounce fragment system object + class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object + class(base_parameters), intent(inout) :: param !! Current run configuration parameters + real(DP), intent(in) :: t !! The time of the collision + end subroutine collision_generate_bounce_system + + module subroutine collision_generate_simple_system(self, nbody_system, param, t) + implicit none + class(collision_simple), intent(inout) :: self !! Simple fragment system object + class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object + class(base_parameters), intent(inout) :: param !! Current run configuration parameters + real(DP), intent(in) :: t !! The time of the collision + end subroutine collision_generate_simple_system end submodule s_collision_model \ No newline at end of file diff --git a/src/collision/collision_module.f90 b/src/collision/collision_module.f90 index 408fdfd7b..77c5552fd 100644 --- a/src/collision/collision_module.f90 +++ b/src/collision/collision_module.f90 @@ -124,8 +124,6 @@ module collision real(DP), dimension(2) :: pe !! Before/after potential energy real(DP), dimension(2) :: Etot !! Before/after total system energy contains - procedure(abstract_generate_fragments), deferred :: generate_fragments !! Generates a system of fragments depending on collision model - procedure :: set_mass_dist => abstract_set_mass_dist !! Sets the distribution of mass among the fragments depending on the regime type procedure :: setup => collision_setup_system !! Initializer for the encounter collision system and the before/after snapshots procedure :: setup_impactors => collision_setup_impactors_system !! Initializer for the impactors for the encounter collision system. Deallocates old impactors before creating new ones procedure :: setup_fragments => collision_setup_fragments_system !! Initializer for the fragments of the collision system. @@ -134,23 +132,24 @@ module collision procedure :: get_energy_and_momentum => collision_util_get_energy_momentum !! Calculates total system energy in either the pre-collision outcome state (lbefore = .true.) or the post-collision outcome state (lbefore = .false.) procedure :: reset => collision_util_reset_system !! Deallocates all allocatables procedure :: set_coordinate_system => collision_util_set_coordinate_system !! Sets the coordinate system of the collisional system + procedure(abstract_generate_system), deferred :: generate !! Generates a system of fragments depending on collision model end type collision_system type, extends(collision_system) :: collision_merge contains - procedure :: generate_fragments => collision_generate_merge_system !! Merges the impactors to make a single final body + procedure :: generate => collision_generate_merge_system !! Merges the impactors to make a single final body final :: collision_final_merge_system !! Finalizer will deallocate all allocatables end type collision_merge type, extends(collision_system) :: collision_bounce contains - procedure :: generate_fragments => collision_generate_bounce_system !! If a collision would result in a disruption, "bounce" the bodies instead. + procedure :: generate => collision_generate_bounce_system !! If a collision would result in a disruption, "bounce" the bodies instead. final :: collision_final_bounce_system !! Finalizer will deallocate all allocatables end type collision_bounce type, extends(collision_system) :: collision_simple contains - procedure :: generate_fragments => collision_generate_simple_system !! If a collision would result in a disruption [TODO: SOMETHING LIKE CHAMBERS 2012] + procedure :: generate => collision_generate_simple_system !! If a collision would result in a disruption [TODO: SOMETHING LIKE CHAMBERS 2012] final :: collision_final_simple_system !! Finalizer will deallocate all allocatables end type collision_simple @@ -198,14 +197,14 @@ module collision abstract interface - subroutine abstract_generate_fragments(self, system, param, t) + subroutine abstract_generate_system(self, nbody_system, param, t) import collision_system, base_nbody_system, base_parameters, DP implicit none - class(collision_system), intent(inout) :: self !! Collision system object - class(base_nbody_system), intent(inout) :: system !! Swiftest nbody system object - class(base_parameters), intent(inout) :: param !! Current run configuration parameters - real(DP), intent(in) :: t !! The time of the collision - end subroutine abstract_generate_fragments + class(collision_system), intent(inout) :: self !! Collision system object + class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object + class(base_parameters), intent(inout) :: param !! Current run configuration parameters + real(DP), intent(in) :: t !! The time of the collision + end subroutine abstract_generate_system subroutine abstract_set_mass_dist(self, param) import collision_system, base_parameters @@ -218,28 +217,28 @@ end subroutine abstract_set_mass_dist interface - module subroutine collision_generate_merge_system(self, system, param, t) + module subroutine collision_generate_merge_system(self, nbody_system, param, t) implicit none - class(collision_merge), intent(inout) :: self !! Fraggle fragment system object - class(base_nbody_system), intent(inout) :: system !! Swiftest nbody system object - class(base_parameters), intent(inout) :: param !! Current run configuration parameters - real(DP), intent(in) :: t !! The time of the collision + class(collision_merge), intent(inout) :: self !! Merge fragment system object + class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object + class(base_parameters), intent(inout) :: param !! Current run configuration parameters + real(DP), intent(in) :: t !! The time of the collision end subroutine collision_generate_merge_system - module subroutine collision_generate_bounce_system(self, system, param, t) + module subroutine collision_generate_bounce_system(self, nbody_system, param, t) implicit none - class(collision_bounce), intent(inout) :: self !! Fraggle fragment system object - class(base_nbody_system), intent(inout) :: system !! Swiftest nbody system object - class(base_parameters), intent(inout) :: param !! Current run configuration parameters - real(DP), intent(in) :: t !! The time of the collision + class(collision_bounce), intent(inout) :: self !! Bounce fragment system object + class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object + class(base_parameters), intent(inout) :: param !! Current run configuration parameters + real(DP), intent(in) :: t !! The time of the collision end subroutine collision_generate_bounce_system - module subroutine collision_generate_simple_system(self, system, param, t) + module subroutine collision_generate_simple_system(self, nbody_system, param, t) implicit none - class(collision_simple), intent(inout) :: self !! Fraggle fragment system object - class(base_nbody_system), intent(inout) :: system !! Swiftest nbody system object - class(base_parameters), intent(inout) :: param !! Current run configuration parameters - real(DP), intent(in) :: t !! The time of the collision + class(collision_simple), intent(inout) :: self !! Simple fragment system object + class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object + class(base_parameters), intent(inout) :: param !! Current run configuration parameters + real(DP), intent(in) :: t !! The time of the collision end subroutine collision_generate_simple_system module subroutine collision_netcdf_io_dump(self, param) diff --git a/src/collision/collision_resolve.f90 b/src/collision/collision_resolve.f90 index 0edde0e3e..51789cc10 100644 --- a/src/collision/collision_resolve.f90 +++ b/src/collision/collision_resolve.f90 @@ -619,7 +619,7 @@ subroutine collision_resolve_list(plpl_collision , system, param, t) call impactors%get_regime(system, param) call collision_history%take_snapshot(param,system, t, "before") - call collision_system%generate_fragments(system, param, t) + call collision_system%generate(system, param, t) call collision_history%take_snapshot(param,system, t, "after") call impactors%reset() diff --git a/src/fraggle/fraggle_generate.f90 b/src/fraggle/fraggle_generate.f90 index 16f93b652..5cad2a3a9 100644 --- a/src/fraggle/fraggle_generate.f90 +++ b/src/fraggle/fraggle_generate.f90 @@ -18,27 +18,27 @@ contains - module subroutine fraggle_generate_system(self, system, param, t) + module subroutine fraggle_generate_system(self, nbody_system, param, t) implicit none - class(fraggle_system), intent(inout) :: self !! Fraggle fragment system object - class(base_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(fraggle_system), intent(inout) :: self !! Fraggle fragment nbody_system object + class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody nbody_system object class(base_parameters), intent(inout) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! The time of the collision ! Internals integer(I4B) :: i - select type(system) + select type(nbody_system) class is (swiftest_nbody_system) select type(param) class is (swiftest_parameters) - associate(impactors => self%impactors, plpl_collision => system%plpl_collision) + associate(impactors => self%impactors, plpl_collision => nbody_system%plpl_collision) select case (impactors%regime) case (COLLRESOLVE_REGIME_DISRUPTION, COLLRESOLVE_REGIME_SUPERCATASTROPHIC) - plpl_collision%status(i) = fraggle_resolve_disruption(system, param, t) + plpl_collision%status(i) = fraggle_resolve_disruption(nbody_system, param, t) case (COLLRESOLVE_REGIME_HIT_AND_RUN) - plpl_collision%status(i) = fraggle_resolve_hitandrun(system, param, t) + plpl_collision%status(i) = fraggle_resolve_hitandrun(nbody_system, param, t) case (COLLRESOLVE_REGIME_MERGE, COLLRESOLVE_REGIME_GRAZE_AND_MERGE) - plpl_collision%status(i) = collision_resolve_merge(system, param, t) + plpl_collision%status(i) = collision_resolve_merge(nbody_system, param, t) case default write(*,*) "Error in swiftest_collision, unrecognized collision regime" call util_exit(FAILURE) @@ -50,17 +50,17 @@ module subroutine fraggle_generate_system(self, system, param, t) end subroutine fraggle_generate_system - subroutine fraggle_generate_fragments(self, system, param, lfailure) + module subroutine fraggle_generate_fragments(collision_system, nbody_system, param, lfailure) !! Author: Jennifer L.L. Pouplin, Carlisle A. Wishard, and David A. Minton !! - !! Generates a system of fragments in barycentric coordinates that conserves energy and momentum. + !! Generates a nbody_system of fragments in barycentric coordinates that conserves energy and momentum. use, intrinsic :: ieee_exceptions implicit none ! Arguments - class(fraggle_system), intent(inout) :: self !! Fraggle system object the outputs will be the fragmentation - class(base_nbody_system), intent(inout) :: system !! Swiftest nbody system object - class(base_parameters), intent(inout) :: param !! Current run configuration parameters - logical, intent(out) :: lfailure !! Answers the question: Should this have been a merger instead? + class(fraggle_system), intent(inout) :: collision_system !! Fraggle nbody_system object the outputs will be the fragmentation + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody nbody_system object + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + logical, intent(out) :: lfailure !! Answers the question: Should this have been a merger instead? ! Internals integer(I4B) :: i integer(I4B) :: try @@ -78,13 +78,13 @@ subroutine fraggle_generate_fragments(self, system, param, lfailure) fpe_quiet_modes(:) = .false. call ieee_set_halting_mode(IEEE_ALL,fpe_quiet_modes) - select type(system) + select type(nbody_system) class is (swiftest_nbody_system) select type(param) class is (swiftest_parameters) - select type(fragments => self%fragments) + select type(fragments => collision_system%fragments) class is (fraggle_fragments(*)) - associate(collision_system => self, impactors => self%impactors, nfrag => fragments%nbody, pl => system%pl) + associate(impactors => collision_system%impactors, nfrag => fragments%nbody, pl => nbody_system%pl) write(message,*) nfrag call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, "Fraggle generating " // trim(adjustl(message)) // " fragments.") @@ -110,8 +110,8 @@ subroutine fraggle_generate_fragments(self, system, param, lfailure) call fragments%reset() - ! Calculate the initial energy of the system without the collisional family - call collision_system%get_energy_and_momentum(system, param, lbefore=.true.) + ! Calculate the initial energy of the nbody_system without the collisional family + call collision_system%get_energy_and_momentum(nbody_system, param, lbefore=.true.) ! Start out the fragments close to the initial separation distance. This will be increased if there is any overlap or we fail to find a solution r_max_start = 1.2_DP * .mag.(impactors%rb(:,2) - impactors%rb(:,1)) @@ -132,12 +132,12 @@ subroutine fraggle_generate_fragments(self, system, param, lfailure) call fraggle_generate_pos_vec(collision_system, r_max_start) call collision_system%set_coordinate_system() - ! Initial velocity guess will be the barycentric velocity of the colliding system so that the budgets are based on the much smaller collisional-frame velocities + ! Initial velocity guess will be the barycentric velocity of the colliding nbody_system so that the budgets are based on the much smaller collisional-frame velocities do concurrent (i = 1:nfrag) fragments%vb(:, i) = impactors%vbcom(:) end do - call collision_system%get_energy_and_momentum(system, param, lbefore=.false.) + call collision_system%get_energy_and_momentum(nbody_system, param, lbefore=.false.) call collision_system%set_budgets() call fraggle_generate_spins(collision_system, f_spin, lfailure) @@ -158,7 +158,7 @@ subroutine fraggle_generate_fragments(self, system, param, lfailure) cycle end if - call collision_system%get_energy_and_momentum(system, param, lbefore=.false.) + call collision_system%get_energy_and_momentum(nbody_system, param, lbefore=.false.) dEtot = collision_system%Etot(2) - collision_system%Etot(1) dLmag = .mag. (collision_system%Ltot(:,2) - collision_system%Ltot(:,1)) exit @@ -218,7 +218,7 @@ subroutine fraggle_generate_pos_vec(collision_system, r_max_start) !! The initial positions do not conserve energy or momentum, so these need to be adjusted later. implicit none ! Arguments - class(fraggle_system), intent(inout) :: collision_system !! Fraggle collision system object + class(fraggle_system), intent(inout) :: collision_system !! Fraggle collision nbody_system object real(DP), intent(in) :: r_max_start !! Initial guess for the starting maximum radial distance of fragments ! Internals real(DP) :: dis, rad, r_max, fdistort @@ -301,7 +301,7 @@ subroutine fraggle_generate_spins(collision_system, f_spin, lfailure) !! A failure will trigger a restructuring of the fragments so we will try new values of the radial position distribution. implicit none ! Arguments - class(fraggle_system), intent(inout) :: collision_system !! Fraggle collision system object + class(fraggle_system), intent(inout) :: collision_system !! Fraggle collision nbody_system object real(DP), intent(in) :: f_spin !! Fraction of energy or momentum that goes into spin (whichever gives the lowest kinetic energy) logical, intent(out) :: lfailure !! Logical flag indicating whether this step fails or succeeds! ! Internals @@ -398,7 +398,7 @@ subroutine fraggle_generate_tan_vel(collision_system, lfailure) !! A failure will trigger a restructuring of the fragments so we will try new values of the radial position distribution. implicit none ! Arguments - class(fraggle_system), intent(inout) :: collision_system !! Fraggle collision system object + class(fraggle_system), intent(inout) :: collision_system !! Fraggle collision nbody_system object logical, intent(out) :: lfailure !! Logical flag indicating whether this step fails or succeeds ! Internals integer(I4B) :: i, try @@ -428,7 +428,7 @@ subroutine fraggle_generate_tan_vel(collision_system, lfailure) end do fragments%v_t_mag(:) = v_t_initial - ! Find the local kinetic energy minimum for the system that conserves linear and angular momentum + ! Find the local kinetic energy minimum for the nbody_system that conserves linear and angular momentum objective_function = lambda_obj(tangential_objective_function, lfailure) tol = TOL_INIT @@ -445,7 +445,7 @@ subroutine fraggle_generate_tan_vel(collision_system, lfailure) end do fragments%v_t_mag(1:nfrag) = solve_fragment_tan_vel(v_t_mag_input=v_t_initial(7:nfrag), lfailure=lfailure) - ! Perform one final shift of the radial velocity vectors to align with the center of mass of the collisional system (the origin) + ! Perform one final shift of the radial velocity vectors to align with the center of mass of the collisional nbody_system (the origin) fragments%vb(:,1:nfrag) = fraggle_util_vmag_to_vb(fragments%v_r_mag(1:nfrag), fragments%v_r_unit(:,1:nfrag), fragments%v_t_mag(1:nfrag), & fragments%v_t_unit(:,1:nfrag), fragments%mass(1:nfrag), impactors%vbcom(:)) do concurrent (i = 1:nfrag) @@ -582,7 +582,7 @@ subroutine fraggle_generate_rad_vel(collision_system, lfailure) !! Adjust the fragment velocities to set the fragment orbital kinetic energy. This will minimize the difference between the fragment kinetic energy and the energy budget implicit none ! Arguments - class(fraggle_system), intent(inout) :: collision_system !! Fraggle collision system object + class(fraggle_system), intent(inout) :: collision_system !! Fraggle collision nbody_system object logical, intent(out) :: lfailure !! Logical flag indicating whether this step fails or succeeds! ! Internals real(DP), parameter :: TOL_MIN = FRAGGLE_ETOL ! This needs to be more accurate than the tangential step, as we are trying to minimize the total residual energy @@ -626,7 +626,7 @@ subroutine fraggle_generate_rad_vel(collision_system, lfailure) v_r_initial(:) = v_r_initial(:) * vnoise(:) end do - ! Shift the radial velocity vectors to align with the center of mass of the collisional system (the origin) + ! Shift the radial velocity vectors to align with the center of mass of the collisional nbody_system (the origin) fragments%ke_orbit = 0.0_DP fragments%ke_spin = 0.0_DP fragments%vb(:,1:nfrag) = fraggle_util_vmag_to_vb(fragments%v_r_mag(1:nfrag), fragments%v_r_unit(:,1:nfrag), & diff --git a/src/fraggle/fraggle_module.f90 b/src/fraggle/fraggle_module.f90 index df4f402cf..da9dcaf6d 100644 --- a/src/fraggle/fraggle_module.f90 +++ b/src/fraggle/fraggle_module.f90 @@ -11,10 +11,7 @@ module fraggle !! author: The Purdue Swiftest Team - David A. Minton, Carlisle A. Wishard, Jennifer L.L. Pouplin, and Jacob R. Elliott !! !! Definition of classes and methods specific to Fraggle: *Fragment* *g*eneration that conserves angular momentum (*L*) and energy (*E*) - use globals - use base - use encounter - use collision + use swiftest implicit none public @@ -51,7 +48,7 @@ module fraggle real(DP) :: Escale = 1.0_DP !! Energy scale factor (a convenience unit that is derived from dscale, tscale, and mscale) real(DP) :: Lscale = 1.0_DP !! Angular momentum scale factor (a convenience unit that is derived from dscale, tscale, and mscale) contains - procedure :: generate_fragments => fraggle_generate_system !! Generates a system of fragments in barycentric coordinates that conserves energy and momentum. + procedure :: generate => fraggle_generate_system !! Generates a system of fragments in barycentric coordinates that conserves energy and momentum. procedure :: set_budgets => fraggle_set_budgets !! Sets the energy and momentum budgets of the fragments based on the collider value procedure :: set_mass_dist => fraggle_set_mass_dist !! Sets the distribution of mass among the fragments depending on the regime type procedure :: set_natural_scale => fraggle_set_natural_scale_factors !! Scales dimenional quantities to ~O(1) with respect to the collisional system. @@ -65,12 +62,20 @@ module fraggle interface - module subroutine fraggle_generate_system(self, system, param, t) + module subroutine fraggle_generate_fragments(collision_system, nbody_system, param, lfailure) implicit none - class(fraggle_system), intent(inout) :: self !! Fraggle fragment system object - class(base_nbody_system), intent(inout) :: system !! Swiftest nbody system object - class(base_parameters), intent(inout) :: param !! Current run configuration parameters - real(DP), intent(in) :: t !! Time of collision + class(fraggle_system), intent(inout) :: collision_system !! Fraggle system object the outputs will be the fragmentation + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + logical, intent(out) :: lfailure !! Answers the question: Should this have been a merger instead? + end subroutine fraggle_generate_fragments + + module subroutine fraggle_generate_system(self, nbody_system, param, t) + implicit none + class(fraggle_system), intent(inout) :: self !! Fraggle fragment system object + class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object + class(base_parameters), intent(inout) :: param !! Current run configuration parameters + real(DP), intent(in) :: t !! Time of collision end subroutine fraggle_generate_system module subroutine fraggle_io_log_regime(collision_system) @@ -86,7 +91,7 @@ end subroutine fraggle_set_budgets module subroutine fraggle_set_mass_dist(self, param) implicit none class(fraggle_system), intent(inout) :: self !! Fraggle collision system object - class(base_parameters), intent(in) :: param !! Current Swiftest run configuration parameters + class(swiftest_parameters), intent(in) :: param !! Current Swiftest run configuration parameters end subroutine fraggle_set_mass_dist module subroutine fraggle_set_natural_scale_factors(self) @@ -96,16 +101,16 @@ end subroutine fraggle_set_natural_scale_factors module function fraggle_resolve_disruption(system, param, t) result(status) implicit none - class(base_nbody_system), intent(inout) :: system !! SyMBA nbody system object - class(base_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions + class(swiftest_nbody_system), intent(inout) :: system !! SyMBA nbody system object + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions real(DP), intent(in) :: t !! Time of collision integer(I4B) :: status !! Status flag assigned to this outcome end function fraggle_resolve_disruption module function fraggle_resolve_hitandrun(system, param, t) result(status) implicit none - class(base_nbody_system), intent(inout) :: system !! SyMBA nbody system object - class(base_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions + class(swiftest_nbody_system), intent(inout) :: system !! SyMBA nbody system object + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions real(DP), intent(in) :: t !! Time of collision integer(I4B) :: status !! Status flag assigned to this outcome end function fraggle_resolve_hitandrun @@ -127,9 +132,8 @@ module subroutine fraggle_util_get_angular_momentum(self) end subroutine fraggle_util_get_angular_momentum module subroutine fraggle_util_construct_temporary_system(self, nbody_system, param, tmpsys, tmpparam) - use base, only : base_nbody_system, base_parameters implicit none - class(fraggle_system), intent(inout) :: self !! Fraggle collision system object + class(fraggle_system), intent(inout) :: self !! Fraggle collision system object class(base_nbody_system), intent(in) :: nbody_system !! Original swiftest nbody system object class(base_parameters), intent(in) :: param !! Current swiftest run configuration parameters class(base_nbody_system), allocatable, intent(out) :: tmpsys !! Output temporary swiftest nbody system object @@ -178,7 +182,6 @@ end function fraggle_util_vmag_to_vb end interface contains - subroutine fraggle_final_fragments(self) diff --git a/src/fraggle/fraggle_resolve.f90 b/src/fraggle/fraggle_resolve.f90 index e2cb6677b..0bf3017a6 100644 --- a/src/fraggle/fraggle_resolve.f90 +++ b/src/fraggle/fraggle_resolve.f90 @@ -19,8 +19,8 @@ module function fraggle_resolve_disruption(system, param, t) result(status) !! implicit none ! Arguments - class(base_nbody_system), intent(inout) :: system !! SyMBA nbody system object - class(base_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions + class(swiftest_nbody_system), intent(inout) :: system !! SyMBA nbody system object + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions real(DP), intent(in) :: t !! Time of collision ! Result integer(I4B) :: status !! Status flag assigned to this outcome @@ -38,6 +38,7 @@ module function fraggle_resolve_disruption(system, param, t) result(status) class is (swiftest_nbody_system) select type(after => system%collision_system%after) class is (swiftest_nbody_system) + associate(collision_system => system%collision_system, impactors => system%collision_system%impactors, fragments => system%collision_system%fragments) select case(impactors%regime) case(COLLRESOLVE_REGIME_DISRUPTION) @@ -52,7 +53,7 @@ module function fraggle_resolve_disruption(system, param, t) result(status) call collision_system%set_mass_dist(param) ! Generate the position and velocity distributions of the fragments - call collision_system%generate_fragments(system, param, lfailure) + call fraggle_generate_fragments(collision_system, nbody_system, param, lfailure) dpe = collision_system%pe(2) - collision_system%pe(1) system%Ecollisions = system%Ecollisions - dpe @@ -106,8 +107,8 @@ module function fraggle_resolve_hitandrun(system, param, t) result(status) !! implicit none ! Arguments - class(base_nbody_system), intent(inout) :: system !! SyMBA nbody system object - class(base_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions + class(swiftest_nbody_system), intent(inout) :: system !! SyMBA nbody system object + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions real(DP), intent(in) :: t !! Time of collision ! Result integer(I4B) :: status !! Status flag assigned to this outcom @@ -147,7 +148,7 @@ module function fraggle_resolve_hitandrun(system, param, t) result(status) call collision_system%set_mass_dist(param) ! Generate the position and velocity distributions of the fragments - call collision_system%generate_fragments(system, param, lpure) + call collision_system%generate(system, param, lpure) dpe = collision_system%pe(2) - collision_system%pe(1) system%Ecollisions = system%Ecollisions - dpe diff --git a/src/fraggle/fraggle_set.f90 b/src/fraggle/fraggle_set.f90 index 42c7e4500..d466db871 100644 --- a/src/fraggle/fraggle_set.f90 +++ b/src/fraggle/fraggle_set.f90 @@ -49,7 +49,7 @@ module subroutine fraggle_set_mass_dist(self, param) implicit none ! Arguments class(fraggle_system), intent(inout) :: self !! Fraggle collision system object - class(base_parameters), intent(in) :: param !! Current Swiftest run configuration parameters + class(swiftest_parameters), intent(in) :: param !! Current Swiftest run configuration parameters ! Internals integer(I4B) :: i, jproj, jtarg, nfrag, istart real(DP), dimension(2) :: volume @@ -85,7 +85,7 @@ module subroutine fraggle_set_mass_dist(self, param) ! Check to see if our size distribution would give us a smaller number of fragments than the maximum number select type(param) - class is (base_parameters) + class is (swiftest_parameters) min_mfrag = (param%min_GMfrag / param%GU) ! The number of fragments we generate is bracked by the minimum required by fraggle_generate (7) and the ! maximum set by the NFRAG_SIZE_MULTIPLIER which limits the total number of fragments to prevent the nbody diff --git a/src/fraggle/fraggle_util.f90 b/src/fraggle/fraggle_util.f90 index e0303f996..b8f6ef57d 100644 --- a/src/fraggle/fraggle_util.f90 +++ b/src/fraggle/fraggle_util.f90 @@ -42,13 +42,13 @@ module subroutine fraggle_util_construct_temporary_system(self, nbody_system, pa !! Constructs a temporary internal system consisting of active bodies and additional fragments. This internal temporary system is used to calculate system energy with and without fragments implicit none ! Arguments - class(fraggle_system), intent(inout) :: self !! Fraggle collision system object + class(fraggle_system), intent(inout) :: self !! Fraggle collision system object class(base_nbody_system), intent(in) :: nbody_system !! Original swiftest nbody system object class(base_parameters), intent(in) :: param !! Current swiftest run configuration parameters class(base_nbody_system), allocatable, intent(out) :: tmpsys !! Output temporary swiftest nbody system object class(base_parameters), allocatable, intent(out) :: tmpparam !! Output temporary configuration run parameters - call self%collision_system%construct_temporary_system(nbody_system, param, tmpsys, tmpparam) + call collision_util_construct_temporary_system(self, nbody_system, param, tmpsys, tmpparam) select type(tmpsys) class is (swiftest_nbody_system) @@ -106,7 +106,7 @@ module subroutine fraggle_util_reset_system(self) self%Escale = 1.0_DP self%Lscale = 1.0_DP - call self%collision_system%reset() + call collision_util_reset_system(self) return end subroutine fraggle_util_reset_system diff --git a/src/swiftest/swiftest_module.f90 b/src/swiftest/swiftest_module.f90 index ff58cf9ac..34ddefcdb 100644 --- a/src/swiftest/swiftest_module.f90 +++ b/src/swiftest/swiftest_module.f90 @@ -39,7 +39,6 @@ module swiftest use base use encounter use collision - use fraggle use walltime use io_progress_bar use netcdf_io From 12f3f53c0b499f2020e749d5cfae069ee612399d Mon Sep 17 00:00:00 2001 From: David A Minton Date: Wed, 21 Dec 2022 23:19:35 -0500 Subject: [PATCH 485/569] cleanup --- src/CMakeLists.txt | 2 +- src/collision/collision_check.f90 | 2 +- src/collision/collision_resolve.f90 | 14 +-- src/fraggle/fraggle_module.f90 | 22 ++-- src/fraggle/fraggle_resolve.f90 | 165 +++++++++++++--------------- 5 files changed, 95 insertions(+), 110 deletions(-) diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index 4f7c53667..7d3eded2a 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -40,8 +40,8 @@ SET(FAST_MATH_FILES ${SRC}/symba/symba_module.f90 ${SRC}/fraggle/fraggle_module.f90 ${SRC}/collision/collision_check.f90 + ${SRC}/collision/collision_generate.f90 ${SRC}/collision/collision_io.f90 - ${SRC}/collision/collision_model.f90 ${SRC}/collision/collision_regime.f90 ${SRC}/collision/collision_resolve.f90 ${SRC}/collision/collision_setup.f90 diff --git a/src/collision/collision_check.f90 b/src/collision/collision_check.f90 index 2fda012bd..7dd35a658 100644 --- a/src/collision/collision_check.f90 +++ b/src/collision/collision_check.f90 @@ -246,7 +246,7 @@ module subroutine collision_check_pltp(self, system, param, t, dt, irec, lany_co write(message, *) "Particle " // trim(adjustl(tp%info(j)%name)) // " (" // trim(adjustl(idstrj)) // ")" & // " collided with massive body " // trim(adjustl(pl%info(i)%name)) // " (" // trim(adjustl(idstri)) // ")" & // " at t = " // trim(adjustl(timestr)) - call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, message) + !call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, message) end if end do diff --git a/src/collision/collision_resolve.f90 b/src/collision/collision_resolve.f90 index 51789cc10..aee398839 100644 --- a/src/collision/collision_resolve.f90 +++ b/src/collision/collision_resolve.f90 @@ -669,13 +669,13 @@ module subroutine collision_resolve_plpl(self, system, param, t, dt, irec) do write(timestr,*) t - call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, "") - call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, "***********************************************************" // & - "***********************************************************") - call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, "Collision between massive bodies detected at time t = " // & - trim(adjustl(timestr))) - call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, "***********************************************************" // & - "***********************************************************") + ! call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, "") + ! call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, "***********************************************************" // & + ! "***********************************************************") + ! call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, "Collision between massive bodies detected at time t = " // & + ! trim(adjustl(timestr))) + ! call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, "***********************************************************" // & + ! "***********************************************************") allocate(tmp_param, source=param) call collision_resolve_list(plpl_collision, system, param, t) diff --git a/src/fraggle/fraggle_module.f90 b/src/fraggle/fraggle_module.f90 index da9dcaf6d..7960a8d44 100644 --- a/src/fraggle/fraggle_module.f90 +++ b/src/fraggle/fraggle_module.f90 @@ -99,20 +99,22 @@ module subroutine fraggle_set_natural_scale_factors(self) class(fraggle_system), intent(inout) :: self !! Fraggle collision system object end subroutine fraggle_set_natural_scale_factors - module function fraggle_resolve_disruption(system, param, t) result(status) + module function fraggle_resolve_disruption(collision_system, nbody_system, param, t) result(status) implicit none - class(swiftest_nbody_system), intent(inout) :: system !! SyMBA nbody system object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions - real(DP), intent(in) :: t !! Time of collision - integer(I4B) :: status !! Status flag assigned to this outcome + class(fraggle_system), intent(inout) :: collision_system !! Fraggle collision system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions + real(DP), intent(in) :: t !! Time of collision + integer(I4B) :: status !! Status flag assigned to this outcome end function fraggle_resolve_disruption - module function fraggle_resolve_hitandrun(system, param, t) result(status) + module function fraggle_resolve_hitandrun(collision_system, nbody_system, param, t) result(status) implicit none - class(swiftest_nbody_system), intent(inout) :: system !! SyMBA nbody system object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions - real(DP), intent(in) :: t !! Time of collision - integer(I4B) :: status !! Status flag assigned to this outcome + class(fraggle_system), intent(inout) :: collision_system !! Fraggle collision system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions + real(DP), intent(in) :: t !! Time of collision + integer(I4B) :: status !! Status flag assigned to this outcome end function fraggle_resolve_hitandrun module subroutine fraggle_set_original_scale_factors(self) diff --git a/src/fraggle/fraggle_resolve.f90 b/src/fraggle/fraggle_resolve.f90 index 0bf3017a6..41f80aa72 100644 --- a/src/fraggle/fraggle_resolve.f90 +++ b/src/fraggle/fraggle_resolve.f90 @@ -12,16 +12,17 @@ use symba contains - module function fraggle_resolve_disruption(system, param, t) result(status) + module function fraggle_resolve_disruption(collision_system, nbody_system, param, t) result(status) !! author: Jennifer L.L. Pouplin, Carlisle A. Wishard, and David A. Minton !! !! Create the fragments resulting from a non-catastrophic disruption collision !! implicit none ! Arguments - class(swiftest_nbody_system), intent(inout) :: system !! SyMBA nbody system object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions - real(DP), intent(in) :: t !! Time of collision + class(fraggle_system), intent(inout) :: collision_system + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions + real(DP), intent(in) :: t !! Time of collision ! Result integer(I4B) :: status !! Status flag assigned to this outcome ! Internals @@ -30,105 +31,92 @@ module function fraggle_resolve_disruption(system, param, t) result(status) character(len=STRMAX) :: message real(DP) :: dpe - select type(system) - class is (swiftest_nbody_system) - select type(param) - class is (swiftest_parameters) - select type(before => system%collision_system%before) - class is (swiftest_nbody_system) - select type(after => system%collision_system%after) - class is (swiftest_nbody_system) - - associate(collision_system => system%collision_system, impactors => system%collision_system%impactors, fragments => system%collision_system%fragments) + associate(impactors => collision_system%impactors, fragments => collision_system%fragments, pl => nbody_system%pl) + select case(impactors%regime) + case(COLLRESOLVE_REGIME_DISRUPTION) + message = "Disruption between" + case(COLLRESOLVE_REGIME_SUPERCATASTROPHIC) + message = "Supercatastrophic disruption between" + end select + call collision_resolve_collider_message(nbody_system%pl, impactors%id, message) + call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, message) + + ! Collisional fragments will be uniformly distributed around the pre-impact barycenter + call collision_system%set_mass_dist(param) + + ! Generate the position and velocity distributions of the fragments + call fraggle_generate_fragments(collision_system, nbody_system, param, lfailure) + + dpe = collision_system%pe(2) - collision_system%pe(1) + nbody_system%Ecollisions = nbody_system%Ecollisions - dpe + nbody_system%Euntracked = nbody_system%Euntracked + dpe + + if (lfailure) then + call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, "No fragment solution found, so treat as a pure hit-and-run") + status = ACTIVE + nfrag = 0 + pl%status(impactors%id(:)) = status + pl%ldiscard(impactors%id(:)) = .false. + pl%lcollision(impactors%id(:)) = .false. + select type(before => collision_system%before) + class is (swiftest_nbody_system) + select type(after => collision_system%after) + class is (swiftest_nbody_system) + allocate(after%pl, source=before%pl) ! Be sure to save the pl so that snapshots still work + end select + end select + else + ! Populate the list of new bodies + nfrag = fragments%nbody + write(message, *) nfrag + call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, "Generating " // trim(adjustl(message)) // " fragments") select case(impactors%regime) case(COLLRESOLVE_REGIME_DISRUPTION) - message = "Disruption between" + status = DISRUPTED + ibiggest = impactors%id(maxloc(pl%Gmass(impactors%id(:)), dim=1)) + fragments%id(1) = pl%id(ibiggest) + fragments%id(2:nfrag) = [(i, i = param%maxid + 1, param%maxid + nfrag - 1)] + param%maxid = fragments%id(nfrag) case(COLLRESOLVE_REGIME_SUPERCATASTROPHIC) - message = "Supercatastrophic disruption between" + status = SUPERCATASTROPHIC + fragments%id(1:nfrag) = [(i, i = param%maxid + 1, param%maxid + nfrag)] + param%maxid = fragments%id(nfrag) end select - call collision_resolve_collider_message(system%pl, impactors%id, message) - call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, message) - ! Collisional fragments will be uniformly distributed around the pre-impact barycenter - call collision_system%set_mass_dist(param) - - ! Generate the position and velocity distributions of the fragments - call fraggle_generate_fragments(collision_system, nbody_system, param, lfailure) - - dpe = collision_system%pe(2) - collision_system%pe(1) - system%Ecollisions = system%Ecollisions - dpe - system%Euntracked = system%Euntracked + dpe - - if (lfailure) then - call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, "No fragment solution found, so treat as a pure hit-and-run") - status = ACTIVE - nfrag = 0 - select type(pl => system%pl) - class is (swiftest_pl) - pl%status(impactors%id(:)) = status - pl%ldiscard(impactors%id(:)) = .false. - pl%lcollision(impactors%id(:)) = .false. - end select - allocate(after%pl, source=before%pl) ! Be sure to save the pl so that snapshots still work - else - ! Populate the list of new bodies - nfrag = fragments%nbody - write(message, *) nfrag - call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, "Generating " // trim(adjustl(message)) // " fragments") - select case(impactors%regime) - case(COLLRESOLVE_REGIME_DISRUPTION) - status = DISRUPTED - ibiggest = impactors%id(maxloc(system%pl%Gmass(impactors%id(:)), dim=1)) - fragments%id(1) = system%pl%id(ibiggest) - fragments%id(2:nfrag) = [(i, i = param%maxid + 1, param%maxid + nfrag - 1)] - param%maxid = fragments%id(nfrag) - case(COLLRESOLVE_REGIME_SUPERCATASTROPHIC) - status = SUPERCATASTROPHIC - fragments%id(1:nfrag) = [(i, i = param%maxid + 1, param%maxid + nfrag)] - param%maxid = fragments%id(nfrag) - end select - - call collision_resolve_mergeaddsub(system, param, t, status) - end if - end associate - end select - end select - end select - end select + call collision_resolve_mergeaddsub(nbody_system, param, t, status) + end if + end associate return end function fraggle_resolve_disruption - module function fraggle_resolve_hitandrun(system, param, t) result(status) + module function fraggle_resolve_hitandrun(collision_system, nbody_system, param, t) result(status) !! author: Jennifer L.L. Pouplin, Carlisle A. Wishard, and David A. Minton !! !! Create the fragments resulting from a non-catastrophic hit-and-run collision !! implicit none ! Arguments - class(swiftest_nbody_system), intent(inout) :: system !! SyMBA nbody system object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions - real(DP), intent(in) :: t !! Time of collision + class(fraggle_system), intent(inout) :: collision_system !! Fraggle collision system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions + real(DP), intent(in) :: t !! Time of collision ! Result - integer(I4B) :: status !! Status flag assigned to this outcom + integer(I4B) :: status !! Status flag assigned to this outcome ! Internals integer(I4B) :: i, ibiggest, nfrag, jtarg, jproj logical :: lpure character(len=STRMAX) :: message real(DP) :: dpe - select type(system) + select type(before => collision_system%before) class is (swiftest_nbody_system) - select type(param) - class is (swiftest_parameters) - select type(before => system%collision_system%before) + select type(after => collision_system%after) class is (swiftest_nbody_system) - select type(after => system%collision_system%after) - class is (swiftest_nbody_system) - associate(collision_system => system%collision_system, impactors => system%collision_system%impactors, fragments => system%collision_system%fragments) + associate(impactors => collision_system%impactors, fragments => collision_system%fragments, pl => nbody_system%pl) message = "Hit and run between" - call collision_resolve_collider_message(system%pl, impactors%id, message) + call collision_resolve_collider_message(nbody_system%pl, impactors%id, message) call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, trim(adjustl(message))) if (impactors%mass(1) > impactors%mass(2)) then @@ -148,11 +136,11 @@ module function fraggle_resolve_hitandrun(system, param, t) result(status) call collision_system%set_mass_dist(param) ! Generate the position and velocity distributions of the fragments - call collision_system%generate(system, param, lpure) + call fraggle_generate_fragments(collision_system, nbody_system, param, lpure) dpe = collision_system%pe(2) - collision_system%pe(1) - system%Ecollisions = system%Ecollisions - dpe - system%Euntracked = system%Euntracked + dpe + nbody_system%Ecollisions = nbody_system%Ecollisions - dpe + nbody_system%Euntracked = nbody_system%Euntracked + dpe if (lpure) then call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, "Should have been a pure hit and run instead") @@ -165,26 +153,21 @@ module function fraggle_resolve_hitandrun(system, param, t) result(status) end if if (lpure) then ! Reset these bodies back to being active so that nothing further is done to them status = HIT_AND_RUN_PURE - select type(pl => system%pl) - class is (symba_pl) - pl%status(impactors%id(:)) = ACTIVE - pl%ldiscard(impactors%id(:)) = .false. - pl%lcollision(impactors%id(:)) = .false. - end select + pl%status(impactors%id(:)) = ACTIVE + pl%ldiscard(impactors%id(:)) = .false. + pl%lcollision(impactors%id(:)) = .false. allocate(after%pl, source=before%pl) ! Be sure to save the pl so that snapshots still work else - ibiggest = impactors%id(maxloc(system%pl%Gmass(impactors%id(:)), dim=1)) - fragments%id(1) = system%pl%id(ibiggest) + ibiggest = impactors%id(maxloc(pl%Gmass(impactors%id(:)), dim=1)) + fragments%id(1) = pl%id(ibiggest) fragments%id(2:nfrag) = [(i, i = param%maxid + 1, param%maxid + nfrag - 1)] param%maxid = fragments%id(nfrag) status = HIT_AND_RUN_DISRUPT - call collision_resolve_mergeaddsub(system, param, t, status) + call collision_resolve_mergeaddsub(nbody_system, param, t, status) end if end associate end select end select - end select - end select return From 0896ffb2faaa5b5935e79f6bcb5f53ef2fa9dcb2 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Thu, 22 Dec 2022 08:17:34 -0500 Subject: [PATCH 486/569] Lots more restructuring, refactoring, and cleanup --- src/collision/collision_check.f90 | 36 ++-- src/collision/collision_generate.f90 | 139 ++++++++++-- src/collision/collision_io.f90 | 208 ++++++++++++------ src/collision/collision_module.f90 | 194 ++++++++--------- src/collision/collision_regime.f90 | 15 +- src/collision/collision_resolve.f90 | 302 +++++++++------------------ src/collision/collision_util.f90 | 68 +++--- src/encounter/encounter_io.f90 | 103 +++++---- src/encounter/encounter_module.f90 | 35 ++-- src/encounter/encounter_util.f90 | 26 +-- src/fraggle/fraggle_generate.f90 | 110 +++++----- src/fraggle/fraggle_io.f90 | 38 ---- src/fraggle/fraggle_module.f90 | 2 - src/fraggle/fraggle_resolve.f90 | 18 +- src/helio/helio_drift.f90 | 18 +- src/helio/helio_gr.f90 | 8 +- src/helio/helio_kick.f90 | 38 ++-- src/helio/helio_module.f90 | 46 ++-- src/helio/helio_step.f90 | 34 +-- src/misc/minimizer_module.f90 | 4 +- src/misc/solver_module.f90 | 4 +- src/netcdf_io/netcdf_io_module.f90 | 20 +- src/rmvs/rmvs_discard.f90 | 8 +- src/rmvs/rmvs_encounter_check.f90 | 6 +- src/rmvs/rmvs_kick.f90 | 16 +- src/rmvs/rmvs_module.f90 | 18 +- src/rmvs/rmvs_setup.f90 | 2 +- src/rmvs/rmvs_step.f90 | 44 ++-- src/rmvs/rmvs_util.f90 | 2 +- src/swiftest/swiftest_discard.f90 | 68 +++--- src/swiftest/swiftest_drift.f90 | 4 +- src/swiftest/swiftest_driver.f90 | 52 ++--- src/swiftest/swiftest_gr.f90 | 6 +- src/swiftest/swiftest_io.f90 | 100 ++++----- src/swiftest/swiftest_module.f90 | 154 +++++++------- src/swiftest/swiftest_obl.f90 | 28 +-- src/swiftest/swiftest_setup.f90 | 108 +++++----- src/swiftest/swiftest_user.f90 | 4 +- src/swiftest/swiftest_util.f90 | 182 ++++++++-------- src/symba/symba_discard.f90 | 138 ++++++------ src/symba/symba_drift.f90 | 20 +- src/symba/symba_encounter_check.f90 | 30 +-- src/symba/symba_gr.f90 | 20 +- src/symba/symba_kick.f90 | 36 ++-- src/symba/symba_module.f90 | 58 ++--- src/symba/symba_setup.f90 | 12 +- src/symba/symba_step.f90 | 112 +++++----- src/tides/tides_getacch_pl.f90 | 8 +- src/tides/tides_module.f90 | 4 +- src/tides/tides_spin_step.f90 | 2 +- src/whm/whm_drift.f90 | 4 +- src/whm/whm_gr.f90 | 8 +- src/whm/whm_kick.f90 | 42 ++-- src/whm/whm_module.f90 | 40 ++-- src/whm/whm_setup.f90 | 2 +- src/whm/whm_step.f90 | 42 ++-- 56 files changed, 1436 insertions(+), 1410 deletions(-) diff --git a/src/collision/collision_check.f90 b/src/collision/collision_check.f90 index 7dd35a658..fcf25f8e0 100644 --- a/src/collision/collision_check.f90 +++ b/src/collision/collision_check.f90 @@ -57,7 +57,7 @@ pure elemental subroutine collision_check_one(xr, yr, zr, vxr, vyr, vzr, Gmtot, end subroutine collision_check_one - module subroutine collision_check_plpl(self, system, param, t, dt, irec, lany_collision) + module subroutine collision_check_plpl(self, nbody_system, param, t, dt, irec, lany_collision) !! author: David A. Minton !! !! Check for merger between massive bodies and test particles in SyMBA @@ -68,7 +68,7 @@ module subroutine collision_check_plpl(self, system, param, t, dt, irec, lany_co implicit none ! Arguments class(collision_list_plpl), intent(inout) :: self !! SyMBA pl-tp encounter list object - class(base_nbody_system), intent(inout) :: system !! SyMBA nbody system object + class(base_nbody_system), intent(inout) :: nbody_system !! SyMBA nbody system object class(base_parameters), intent(inout) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! current time real(DP), intent(in) :: dt !! step size @@ -86,9 +86,9 @@ module subroutine collision_check_plpl(self, system, param, t, dt, irec, lany_co lany_collision = .false. if (self%nenc == 0) return - select type(system) + select type(nbody_system) class is (swiftest_nbody_system) - associate(pl => system%pl) + associate(pl => nbody_system%pl) nenc = self%nenc allocate(lmask(nenc)) @@ -118,18 +118,18 @@ module subroutine collision_check_plpl(self, system, param, t, dt, irec, lany_co if (lany_collision .or. lany_closest) then - call pl%rh2rb(system%cb) ! Update the central body barycenteric position vector to get us out of DH and into bary + call pl%rh2rb(nbody_system%cb) ! Update the central body barycenteric position vector to get us out of DH and into bary do k = 1, nenc if (.not.lcollision(k) .and. .not. self%lclosest(k)) cycle i = self%index1(k) j = self%index2(k) - self%r1(:,k) = pl%rh(:,i) + system%cb%rb(:) + self%r1(:,k) = pl%rh(:,i) + nbody_system%cb%rb(:) self%v1(:,k) = pl%vb(:,i) if (lcollision(k)) then self%status(k) = COLLIDED self%tcollision(k) = t end if - self%r2(:,k) = pl%rh(:,j) + system%cb%rb(:) + self%r2(:,k) = pl%rh(:,j) + nbody_system%cb%rb(:) self%v2(:,k) = pl%vb(:,j) if (lcollision(k)) then ! Check to see if either of these bodies has been involved with a collision before, and if so, make this a collider pair @@ -145,11 +145,11 @@ module subroutine collision_check_plpl(self, system, param, t, dt, irec, lany_co end do ! Extract the pl-pl encounter list and return the pl-pl collision_list - call self%extract_collisions(system, param) + call self%extract_collisions(nbody_system, param) end if ! Take snapshots of pairs of bodies at close approach (but not collision) if requested - if (lany_closest) call system%encounter_history%take_snapshot(param, system, t, "closest") + if (lany_closest) call nbody_system%encounter_history%take_snapshot(param, nbody_system, t, "closest") end associate end select @@ -157,7 +157,7 @@ module subroutine collision_check_plpl(self, system, param, t, dt, irec, lany_co end subroutine collision_check_plpl - module subroutine collision_check_pltp(self, system, param, t, dt, irec, lany_collision) + module subroutine collision_check_pltp(self, nbody_system, param, t, dt, irec, lany_collision) !! author: David A. Minton !! !! Check for merger between massive bodies and test particles in SyMBA @@ -168,7 +168,7 @@ module subroutine collision_check_pltp(self, system, param, t, dt, irec, lany_co implicit none ! Arguments class(collision_list_pltp), intent(inout) :: self !! SyMBA pl-tp encounter list object - class(base_nbody_system), intent(inout) :: system !! SyMBA nbody system object + class(base_nbody_system), intent(inout) :: nbody_system !! SyMBA nbody system object class(base_parameters), intent(inout) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! current time real(DP), intent(in) :: dt !! step size @@ -185,12 +185,12 @@ module subroutine collision_check_pltp(self, system, param, t, dt, irec, lany_co lany_collision = .false. if (self%nenc == 0) return - select type(system) + select type(nbody_system) class is (swiftest_nbody_system) select type(param) class is (swiftest_parameters) - associate(pl => system%pl, tp => system%tp) + associate(pl => nbody_system%pl, tp => nbody_system%tp) nenc = self%nenc allocate(lmask(nenc)) @@ -222,19 +222,19 @@ module subroutine collision_check_pltp(self, system, param, t, dt, irec, lany_co if (lany_collision .or. lany_closest) then - call pl%rh2rb(system%cb) ! Update the central body barycenteric position vector to get us out of DH and into bary + call pl%rh2rb(nbody_system%cb) ! Update the central body barycenteric position vector to get us out of DH and into bary do k = 1, nenc if (.not.lcollision(k) .and. .not. self%lclosest(k)) cycle i = self%index1(k) j = self%index2(k) - self%r1(:,k) = pl%rh(:,i) + system%cb%rb(:) + self%r1(:,k) = pl%rh(:,i) + nbody_system%cb%rb(:) self%v1(:,k) = pl%vb(:,i) if (lcollision(k)) then self%status(k) = COLLIDED self%tcollision(k) = t end if - self%r2(:,k) = tp%rh(:,j) + system%cb%rb(:) + self%r2(:,k) = tp%rh(:,j) + nbody_system%cb%rb(:) self%v2(:,k) = tp%vb(:,j) if (lcollision(k)) then tp%status(j) = DISCARDED_PLR @@ -246,7 +246,7 @@ module subroutine collision_check_pltp(self, system, param, t, dt, irec, lany_co write(message, *) "Particle " // trim(adjustl(tp%info(j)%name)) // " (" // trim(adjustl(idstrj)) // ")" & // " collided with massive body " // trim(adjustl(pl%info(i)%name)) // " (" // trim(adjustl(idstri)) // ")" & // " at t = " // trim(adjustl(timestr)) - !call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, message) + !call swiftest_io_log_one_message(COLLISION_LOG_OUT, message) end if end do @@ -256,7 +256,7 @@ module subroutine collision_check_pltp(self, system, param, t, dt, irec, lany_co end if ! Take snapshots of pairs of bodies at close approach (but not collision) if requested - if (lany_closest) call system%encounter_history%take_snapshot(param, system, t, "closest") + if (lany_closest) call nbody_system%encounter_history%take_snapshot(param, nbody_system, t, "closest") end associate end select end select diff --git a/src/collision/collision_generate.f90 b/src/collision/collision_generate.f90 index a849f69dc..281145797 100644 --- a/src/collision/collision_generate.f90 +++ b/src/collision/collision_generate.f90 @@ -12,29 +12,122 @@ use swiftest contains + module subroutine collision_generate_merge_system(self, nbody_system, param, t) + !! author: Jennifer L.L. Pouplin, Carlisle A. Wishard, and David A. Minton + !! + !! Merge massive bodies in a "MERGE" style collision model (only pure mergers) + implicit none + class(collision_merge), intent(inout) :: self !! Merge fragment system object + class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object + class(base_parameters), intent(inout) :: param !! Current run configuration parameters + real(DP), intent(in) :: t !! The time of the collision - module subroutine collision_generate_merge_system(self, nbody_system, param, t) - implicit none - class(collision_merge), intent(inout) :: self !! Merge fragment system object - class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object - class(base_parameters), intent(inout) :: param !! Current run configuration parameters - real(DP), intent(in) :: t !! The time of the collision - end subroutine collision_generate_merge_system - - module subroutine collision_generate_bounce_system(self, nbody_system, param, t) - implicit none - class(collision_bounce), intent(inout) :: self !! Bounce fragment system object - class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object - class(base_parameters), intent(inout) :: param !! Current run configuration parameters - real(DP), intent(in) :: t !! The time of the collision - end subroutine collision_generate_bounce_system - - module subroutine collision_generate_simple_system(self, nbody_system, param, t) - implicit none - class(collision_simple), intent(inout) :: self !! Simple fragment system object - class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object - class(base_parameters), intent(inout) :: param !! Current run configuration parameters - real(DP), intent(in) :: t !! The time of the collision - end subroutine collision_generate_simple_system + call collision_generate_merge_any(self, nbody_system, param, t) + + return + end subroutine collision_generate_merge_system + + + module subroutine collision_generate_merge_any(self, nbody_system, param, t) + !! author: Jennifer L.L. Pouplin, Carlisle A. Wishard, and David A. Minton + !! + !! Merge massive bodies in any collisionals ystem. + !! + !! Adapted from David E. Kaufmann's Swifter routines symba_merge_pl.f90 and symba_discard_merge_pl.f90 + !! + !! Adapted from Hal Levison's Swift routines symba5_merge.f and discard_mass_merge.f + implicit none + ! Arguments + class(collision_system), intent(inout) :: self !! Merge fragment system object + class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object + class(base_parameters), intent(inout) :: param !! Current run configuration parameters + real(DP), intent(in) :: t !! The time of the collision + ! Internals + integer(I4B) :: i, j, k, ibiggest + real(DP), dimension(NDIM) :: Lspin_new + real(DP) :: dpe + character(len=STRMAX) :: message + + select type(nbody_system) + class is (swiftest_nbody_system) + associate(impactors => nbody_system%collider%impactors, fragments => nbody_system%collider%fragments) + message = "Merging" + call collision_io_collider_message(nbody_system%pl, impactors%id, message) + call swiftest_io_log_one_message(COLLISION_LOG_OUT, message) + + select type(pl => nbody_system%pl) + class is (swiftest_pl) + + !call self%set_mass_dist(param) + + ! Calculate the initial energy of the nbody_system without the collisional family + call self%get_energy_and_momentum(nbody_system, param, lbefore=.true.) + + ibiggest = impactors%id(maxloc(pl%Gmass(impactors%id(:)), dim=1)) + fragments%id(1) = pl%id(ibiggest) + fragments%rb(:,1) = impactors%rbcom(:) + fragments%vb(:,1) = impactors%vbcom(:) + + if (param%lrotation) then + ! Conserve angular momentum by putting pre-impact orbital momentum into spin of the new body + Lspin_new(:) = impactors%Lorbit(:,1) + impactors%Lorbit(:,2) + impactors%Lspin(:,1) + impactors%Lspin(:,2) + + ! Assume prinicpal axis rotation on 3rd Ip axis + fragments%rot(:,1) = Lspin_new(:) / (fragments%Ip(3,1) * fragments%mass(1) * fragments%radius(1)**2) + else ! If spin is not enabled, we will consider the lost pre-collision angular momentum as "escaped" and add it to our bookkeeping variable + nbody_system%Lescape(:) = nbody_system%Lescape(:) + impactors%Lorbit(:,1) + impactors%Lorbit(:,2) + end if + + ! Keep track of the component of potential energy due to the pre-impact impactors%id for book-keeping + ! Get the energy of the system after the collision + call self%get_energy_and_momentum(nbody_system, param, lbefore=.false.) + dpe = self%pe(2) - self%pe(1) + nbody_system%Ecollisions = nbody_system%Ecollisions - dpe + nbody_system%Euntracked = nbody_system%Euntracked + dpe + + + ! Update any encounter lists that have the removed bodies in them so that they instead point to the new body + do k = 1, nbody_system%plpl_encounter%nenc + do j = 1, impactors%ncoll + i = impactors%id(j) + if (i == ibiggest) cycle + if (nbody_system%plpl_encounter%id1(k) == pl%id(i)) then + nbody_system%plpl_encounter%id1(k) = pl%id(ibiggest) + nbody_system%plpl_encounter%index1(k) = i + end if + if (nbody_system%plpl_encounter%id2(k) == pl%id(i)) then + nbody_system%plpl_encounter%id2(k) = pl%id(ibiggest) + nbody_system%plpl_encounter%index2(k) = i + end if + if (nbody_system%plpl_encounter%id1(k) == nbody_system%plpl_encounter%id2(k)) nbody_system%plpl_encounter%status(k) = INACTIVE + end do + end do + + self%status = MERGED + + call collision_resolve_mergeaddsub(nbody_system, param, t, self%status) + + end select + end associate + end select + return + end subroutine collision_generate_merge_any + + + module subroutine collision_generate_bounce_system(self, nbody_system, param, t) + implicit none + class(collision_bounce), intent(inout) :: self !! Bounce fragment system object + class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object + class(base_parameters), intent(inout) :: param !! Current run configuration parameters + real(DP), intent(in) :: t !! The time of the collision + end subroutine collision_generate_bounce_system + + module subroutine collision_generate_simple_system(self, nbody_system, param, t) + implicit none + class(collision_simple), intent(inout) :: self !! Simple fragment system object + class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object + class(base_parameters), intent(inout) :: param !! Current run configuration parameters + real(DP), intent(in) :: t !! The time of the collision + end subroutine collision_generate_simple_system end submodule s_collision_model \ No newline at end of file diff --git a/src/collision/collision_io.f90 b/src/collision/collision_io.f90 index 22de3f27c..0eccda309 100644 --- a/src/collision/collision_io.f90 +++ b/src/collision/collision_io.f90 @@ -7,12 +7,85 @@ !! You should have received a copy of the GNU General Public License along with Swiftest. !! If not, see: https://www.gnu.org/licenses. -submodule(collision) s_collision_netcdf_io +submodule(collision) s_collision_io_netcdf use swiftest contains - module subroutine collision_netcdf_io_dump(self, param) + module subroutine collision_io_collider_message(pl, collidx, collider_message) + !! author: David A. Minton + !! + !! Prints a nicely formatted message about which bodies collided, including their names and ids. + !! This subroutine appends the body names and ids to an input message. + implicit none + ! Arguments + class(base_object), intent(in) :: pl !! Swiftest massive body object + integer(I4B), dimension(:), intent(in) :: collidx !! Index of collisional colliders%idx members + character(*), intent(inout) :: collider_message !! The message to print to the screen. + ! Internals + integer(I4B) :: i, n + character(len=STRMAX) :: idstr + + + n = size(collidx) + if (n == 0) return + + select type(pl) + class is (swiftest_pl) + do i = 1, n + if (i > 1) collider_message = trim(adjustl(collider_message)) // " and " + collider_message = " " // trim(adjustl(collider_message)) // " " // trim(adjustl(pl%info(collidx(i))%name)) + write(idstr, '(I10)') pl%id(collidx(i)) + collider_message = trim(adjustl(collider_message)) // " (" // trim(adjustl(idstr)) // ") " + end do + + end select + + return + end subroutine collision_io_collider_message + + + module subroutine collision_io_log_regime(self) + !! author: David A. Minton + !! + !! Writes a log of the results of the collisional regime determination + implicit none + ! Arguments + class(collision_system), intent(inout) :: self !! Collision system object + ! Internals + character(STRMAX) :: errmsg + + associate(fragments => self%fragments, impactors => self%impactors) + open(unit=LUN, file=COLLISION_LOG_OUT, status = 'OLD', position = 'APPEND', form = 'FORMATTED', err = 667, iomsg = errmsg) + write(LUN, *, err = 667, iomsg = errmsg) + write(LUN, *) "--------------------------------------------------------------------" + write(LUN, *) " Collisional regime determination results" + write(LUN, *) "--------------------------------------------------------------------" + write(LUN, *) "True number of impactors : ",impactors%ncoll + write(LUN, *) "Index list of true impactors : ",impactors%id(1:impactors%ncoll) + select case(impactors%regime) + case(COLLRESOLVE_REGIME_MERGE) + write(LUN, *) "Regime: Merge" + case(COLLRESOLVE_REGIME_DISRUPTION) + write(LUN, *) "Regime: Disruption" + case(COLLRESOLVE_REGIME_SUPERCATASTROPHIC) + write(LUN, *) "Regime: Supercatastrophic disruption" + case(COLLRESOLVE_REGIME_GRAZE_AND_MERGE) + write(LUN, *) "Regime: Graze and merge" + case(COLLRESOLVE_REGIME_HIT_AND_RUN) + write(LUN, *) "Regime: Hit and run" + end select + write(LUN, *) "Energy loss : ", impactors%Qloss + write(LUN, *) "--------------------------------------------------------------------" + close(LUN) + end associate + return + 667 continue + write(*,*) "Error writing collision regime information to log file: " // trim(adjustl(errmsg)) + end subroutine collision_io_log_regime + + + module subroutine collision_io_netcdf_dump(self, param) !! author: David A. Minton !! !! Dumps the time history of an encounter to file. @@ -55,9 +128,10 @@ module subroutine collision_netcdf_io_dump(self, param) end select return - end subroutine collision_netcdf_io_dump + end subroutine collision_io_netcdf_dump - module subroutine collision_netcdf_io_initialize_output(self, param) + + module subroutine collision_io_netcdf_initialize_output(self, param) !! author: David A. Minton !! !! Initialize a NetCDF fragment history file system. This is a simplified version of the main simulation output NetCDF file, but with fewer variables. @@ -98,94 +172,94 @@ module subroutine collision_netcdf_io_initialize_output(self, param) close(unit=LUN, status="delete") end if - call netcdf_io_check( nf90_create(nc%file_name, NF90_NETCDF4, nc%id), "collision_netcdf_io_initialize_output nf90_create" ) + call netcdf_io_check( nf90_create(nc%file_name, NF90_NETCDF4, nc%id), "collision_io_netcdf_initialize_output nf90_create" ) nc%lfile_is_open = .true. ! Dimensions - call netcdf_io_check( nf90_def_dim(nc%id, nc%event_dimname, nc%event_dimsize, nc%event_dimid), "collision_netcdf_io_initialize_output nf90_def_dim event_dimid" ) ! Dimension to store individual collision events - call netcdf_io_check( nf90_def_dim(nc%id, nc%space_dimname, NDIM, nc%space_dimid), "collision_netcdf_io_initialize_output nf90_def_dim space_dimid" ) ! 3D space dimension - call netcdf_io_check( nf90_def_dim(nc%id, nc%name_dimname, nc%name_dimsize, nc%name_dimid), "collision_netcdf_io_initialize_output nf90_def_dim name_dimid" ) ! Dimension to store particle id numbers - call netcdf_io_check( nf90_def_dim(nc%id, nc%str_dimname, NAMELEN, nc%str_dimid), "collision_netcdf_io_initialize_output nf90_def_dim str_dimid" ) ! Dimension for string variables (aka character arrays) - call netcdf_io_check( nf90_def_dim(nc%id, nc%stage_dimname, 2, nc%stage_dimid), "collision_netcdf_io_initialize_output nf90_def_dim stage_dimid" ) ! Dimension for stage variables (aka "before" vs. "after" + call netcdf_io_check( nf90_def_dim(nc%id, nc%event_dimname, nc%event_dimsize, nc%event_dimid), "collision_io_netcdf_initialize_output nf90_def_dim event_dimid" ) ! Dimension to store individual collision events + call netcdf_io_check( nf90_def_dim(nc%id, nc%space_dimname, NDIM, nc%space_dimid), "collision_io_netcdf_initialize_output nf90_def_dim space_dimid" ) ! 3D space dimension + call netcdf_io_check( nf90_def_dim(nc%id, nc%name_dimname, nc%name_dimsize, nc%name_dimid), "collision_io_netcdf_initialize_output nf90_def_dim name_dimid" ) ! Dimension to store particle id numbers + call netcdf_io_check( nf90_def_dim(nc%id, nc%str_dimname, NAMELEN, nc%str_dimid), "collision_io_netcdf_initialize_output nf90_def_dim str_dimid" ) ! Dimension for string variables (aka character arrays) + call netcdf_io_check( nf90_def_dim(nc%id, nc%stage_dimname, 2, nc%stage_dimid), "collision_io_netcdf_initialize_output nf90_def_dim stage_dimid" ) ! Dimension for stage variables (aka "before" vs. "after" ! Dimension coordinates - call netcdf_io_check( nf90_def_var(nc%id, nc%space_dimname, NF90_CHAR, nc%space_dimid, nc%space_varid), "collision_netcdf_io_initialize_output nf90_def_var space_varid" ) - call netcdf_io_check( nf90_def_var(nc%id, nc%name_dimname, NF90_CHAR, [nc%str_dimid, nc%name_dimid], nc%name_varid), "collision_netcdf_io_initialize_output nf90_def_var name_varid") - call netcdf_io_check( nf90_def_var(nc%id, nc%stage_dimname, NF90_CHAR, [nc%str_dimid, nc%stage_dimid], nc%stage_varid), "collision_netcdf_io_initialize_output nf90_def_var stage_varid" ) + call netcdf_io_check( nf90_def_var(nc%id, nc%space_dimname, NF90_CHAR, nc%space_dimid, nc%space_varid), "collision_io_netcdf_initialize_output nf90_def_var space_varid" ) + call netcdf_io_check( nf90_def_var(nc%id, nc%name_dimname, NF90_CHAR, [nc%str_dimid, nc%name_dimid], nc%name_varid), "collision_io_netcdf_initialize_output nf90_def_var name_varid") + call netcdf_io_check( nf90_def_var(nc%id, nc%stage_dimname, NF90_CHAR, [nc%str_dimid, nc%stage_dimid], nc%stage_varid), "collision_io_netcdf_initialize_output nf90_def_var stage_varid" ) ! Variables - call netcdf_io_check( nf90_def_var(nc%id, nc%id_varname, NF90_INT, nc%name_dimid, nc%id_varid), "collision_netcdf_io_initialize_output nf90_def_var id_varid" ) + call netcdf_io_check( nf90_def_var(nc%id, nc%id_varname, NF90_INT, nc%name_dimid, nc%id_varid), "collision_io_netcdf_initialize_output nf90_def_var id_varid" ) call netcdf_io_check( nf90_def_var(nc%id, nc%time_dimname, nc%out_type, & - nc%event_dimid, nc%time_varid), "collision_netcdf_io_initialize_output nf90_def_var time_varid" ) + nc%event_dimid, nc%time_varid), "collision_io_netcdf_initialize_output nf90_def_var time_varid" ) call netcdf_io_check( nf90_def_var(nc%id, nc%regime_varname, NF90_CHAR, & - [nc%str_dimid, nc%event_dimid], nc%regime_varid), "collision_netcdf_io_initialize_output nf90_def_var regime_varid") + [nc%str_dimid, nc%event_dimid], nc%regime_varid), "collision_io_netcdf_initialize_output nf90_def_var regime_varid") call netcdf_io_check( nf90_def_var(nc%id, nc%Qloss_varname, nc%out_type, & - [ nc%event_dimid], nc%Qloss_varid), "collision_netcdf_io_initialize_output nf90_def_var Qloss_varid") + [ nc%event_dimid], nc%Qloss_varid), "collision_io_netcdf_initialize_output nf90_def_var Qloss_varid") call netcdf_io_check( nf90_def_var(nc%id, nc%ptype_varname, NF90_CHAR, & - [nc%str_dimid, nc%name_dimid, nc%stage_dimid, nc%event_dimid], nc%ptype_varid), "collision_netcdf_io_initialize_output nf90_def_var ptype_varid") + [nc%str_dimid, nc%name_dimid, nc%stage_dimid, nc%event_dimid], nc%ptype_varid), "collision_io_netcdf_initialize_output nf90_def_var ptype_varid") call netcdf_io_check( nf90_def_var(nc%id, nc%loop_varname, NF90_INT, & - [ nc%event_dimid], nc%loop_varid), "collision_netcdf_io_initialize_output nf90_def_var loop_varid") + [ nc%event_dimid], nc%loop_varid), "collision_io_netcdf_initialize_output nf90_def_var loop_varid") call netcdf_io_check( nf90_def_var(nc%id, nc%rh_varname, nc%out_type,& - [ nc%space_dimid, nc%name_dimid, nc%stage_dimid, nc%event_dimid], nc%rh_varid), "collision_netcdf_io_initialize_output nf90_def_var rh_varid") + [ nc%space_dimid, nc%name_dimid, nc%stage_dimid, nc%event_dimid], nc%rh_varid), "collision_io_netcdf_initialize_output nf90_def_var rh_varid") call netcdf_io_check( nf90_def_var(nc%id, nc%vh_varname, nc%out_type,& - [ nc%space_dimid, nc%name_dimid, nc%stage_dimid, nc%event_dimid], nc%vh_varid), "collision_netcdf_io_initialize_output nf90_def_var vh_varid") + [ nc%space_dimid, nc%name_dimid, nc%stage_dimid, nc%event_dimid], nc%vh_varid), "collision_io_netcdf_initialize_output nf90_def_var vh_varid") call netcdf_io_check( nf90_def_var(nc%id, nc%Gmass_varname, nc%out_type,& - [ nc%name_dimid, nc%stage_dimid, nc%event_dimid], nc%Gmass_varid), "collision_netcdf_io_initialize_output nf90_def_var Gmass_varid") + [ nc%name_dimid, nc%stage_dimid, nc%event_dimid], nc%Gmass_varid), "collision_io_netcdf_initialize_output nf90_def_var Gmass_varid") call netcdf_io_check( nf90_def_var(nc%id, nc%radius_varname, nc%out_type,& - [ nc%name_dimid, nc%stage_dimid, nc%event_dimid], nc%radius_varid), "collision_netcdf_io_initialize_output nf90_def_var radius_varid") + [ nc%name_dimid, nc%stage_dimid, nc%event_dimid], nc%radius_varid), "collision_io_netcdf_initialize_output nf90_def_var radius_varid") call netcdf_io_check( nf90_def_var(nc%id, nc%Ip_varname, nc%out_type,& - [ nc%space_dimid, nc%name_dimid, nc%stage_dimid, nc%event_dimid], nc%Ip_varid), "collision_netcdf_io_initialize_output nf90_def_var Ip_varid") + [ nc%space_dimid, nc%name_dimid, nc%stage_dimid, nc%event_dimid], nc%Ip_varid), "collision_io_netcdf_initialize_output nf90_def_var Ip_varid") call netcdf_io_check( nf90_def_var(nc%id, nc%rot_varname, nc%out_type,& - [ nc%space_dimid, nc%name_dimid, nc%stage_dimid, nc%event_dimid], nc%rot_varid), "collision_netcdf_io_initialize_output nf90_def_var rot_varid") + [ nc%space_dimid, nc%name_dimid, nc%stage_dimid, nc%event_dimid], nc%rot_varid), "collision_io_netcdf_initialize_output nf90_def_var rot_varid") if (param%lenergy) then call netcdf_io_check( nf90_def_var(nc%id, nc%ke_orb_varname, nc%out_type,& - [ nc%stage_dimid, nc%event_dimid], nc%KE_orb_varid), "collision_netcdf_io_initialize_output nf90_def_var KE_orb_varid") + [ nc%stage_dimid, nc%event_dimid], nc%KE_orb_varid), "collision_io_netcdf_initialize_output nf90_def_var KE_orb_varid") call netcdf_io_check( nf90_def_var(nc%id, nc%ke_spin_varname, nc%out_type,& - [ nc%stage_dimid, nc%event_dimid], nc%KE_spin_varid), "collision_netcdf_io_initialize_output nf90_def_var KE_spin_varid" ) + [ nc%stage_dimid, nc%event_dimid], nc%KE_spin_varid), "collision_io_netcdf_initialize_output nf90_def_var KE_spin_varid" ) call netcdf_io_check( nf90_def_var(nc%id, nc%pe_varname, nc%out_type,& - [ nc%stage_dimid, nc%event_dimid], nc%PE_varid), "collision_netcdf_io_initialize_output nf90_def_var PE_varid" ) + [ nc%stage_dimid, nc%event_dimid], nc%PE_varid), "collision_io_netcdf_initialize_output nf90_def_var PE_varid" ) call netcdf_io_check( nf90_def_var(nc%id, nc%L_orb_varname, nc%out_type, & - [ nc%space_dimid, nc%stage_dimid, nc%event_dimid], nc%L_orb_varid), "collision_netcdf_io_initialize_output nf90_def_var L_orb_varid" ) + [ nc%space_dimid, nc%stage_dimid, nc%event_dimid], nc%L_orb_varid), "collision_io_netcdf_initialize_output nf90_def_var L_orb_varid" ) call netcdf_io_check( nf90_def_var(nc%id, nc%Lspin_varname, nc%out_type,& - [ nc%space_dimid, nc%stage_dimid, nc%event_dimid], nc%Lspin_varid), "collision_netcdf_io_initialize_output nf90_def_var Lspin_varid" ) + [ nc%space_dimid, nc%stage_dimid, nc%event_dimid], nc%Lspin_varid), "collision_io_netcdf_initialize_output nf90_def_var Lspin_varid" ) end if - call netcdf_io_check( nf90_inquire(nc%id, nVariables=nvar), "collision_netcdf_io_initialize_output nf90_inquire nVariables" ) + call netcdf_io_check( nf90_inquire(nc%id, nVariables=nvar), "collision_io_netcdf_initialize_output nf90_inquire nVariables" ) do varid = 1, nvar - call netcdf_io_check( nf90_inquire_variable(nc%id, varid, xtype=vartype, ndims=ndims), "collision_netcdf_io_initialize_output nf90_inquire_variable" ) + call netcdf_io_check( nf90_inquire_variable(nc%id, varid, xtype=vartype, ndims=ndims), "collision_io_netcdf_initialize_output nf90_inquire_variable" ) select case(vartype) case(NF90_INT) - call netcdf_io_check( nf90_def_var_fill(nc%id, varid, NO_FILL, NF90_FILL_INT), "collision_netcdf_io_initialize_output nf90_def_var_fill NF90_INT" ) + call netcdf_io_check( nf90_def_var_fill(nc%id, varid, NO_FILL, NF90_FILL_INT), "collision_io_netcdf_initialize_output nf90_def_var_fill NF90_INT" ) case(NF90_FLOAT) - call netcdf_io_check( nf90_def_var_fill(nc%id, varid, NO_FILL, sfill), "collision_netcdf_io_initialize_output nf90_def_var_fill NF90_FLOAT" ) + call netcdf_io_check( nf90_def_var_fill(nc%id, varid, NO_FILL, sfill), "collision_io_netcdf_initialize_output nf90_def_var_fill NF90_FLOAT" ) case(NF90_DOUBLE) - call netcdf_io_check( nf90_def_var_fill(nc%id, varid, NO_FILL, dfill), "collision_netcdf_io_initialize_output nf90_def_var_fill NF90_DOUBLE" ) + call netcdf_io_check( nf90_def_var_fill(nc%id, varid, NO_FILL, dfill), "collision_io_netcdf_initialize_output nf90_def_var_fill NF90_DOUBLE" ) case(NF90_CHAR) - call netcdf_io_check( nf90_def_var_fill(nc%id, varid, NO_FILL, 0), "collision_netcdf_io_initialize_output nf90_def_var_fill NF90_CHAR" ) + call netcdf_io_check( nf90_def_var_fill(nc%id, varid, NO_FILL, 0), "collision_io_netcdf_initialize_output nf90_def_var_fill NF90_CHAR" ) end select end do ! Take the file out of define mode - call netcdf_io_check( nf90_enddef(nc%id), "collision_netcdf_io_initialize_output nf90_enddef" ) + call netcdf_io_check( nf90_enddef(nc%id), "collision_io_netcdf_initialize_output nf90_enddef" ) ! Add in the space and stage dimension coordinates - call netcdf_io_check( nf90_put_var(nc%id, nc%space_varid, nc%space_coords, start=[1], count=[NDIM]), "collision_netcdf_io_initialize_output nf90_put_var space" ) - call netcdf_io_check( nf90_put_var(nc%id, nc%stage_varid, nc%stage_coords(1), start=[1,1], count=[len(nc%stage_coords(1)),1]), "collision_netcdf_io_initialize_output nf90_put_var stage 1" ) - call netcdf_io_check( nf90_put_var(nc%id, nc%stage_varid, nc%stage_coords(2), start=[1,2], count=[len(nc%stage_coords(2)),1]), "collision_netcdf_io_initialize_output nf90_put_var stage 2" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%space_varid, nc%space_coords, start=[1], count=[NDIM]), "collision_io_netcdf_initialize_output nf90_put_var space" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%stage_varid, nc%stage_coords(1), start=[1,1], count=[len(nc%stage_coords(1)),1]), "collision_io_netcdf_initialize_output nf90_put_var stage 1" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%stage_varid, nc%stage_coords(2), start=[1,2], count=[len(nc%stage_coords(2)),1]), "collision_io_netcdf_initialize_output nf90_put_var stage 2" ) end associate end select @@ -195,10 +269,10 @@ module subroutine collision_netcdf_io_initialize_output(self, param) 667 continue write(*,*) "Error creating fragmentation output file. " // trim(adjustl(errmsg)) call util_exit(FAILURE) - end subroutine collision_netcdf_io_initialize_output + end subroutine collision_io_netcdf_initialize_output - module subroutine collision_netcdf_io_write_frame_snapshot(self, history, param) + module subroutine collision_io_netcdf_write_frame_snapshot(self, history, param) !! author: David A. Minton !! !! Write a frame of output of a collision result @@ -215,19 +289,19 @@ module subroutine collision_netcdf_io_write_frame_snapshot(self, history, param) select type(nc => history%nc) class is (collision_netcdf_parameters) - associate(system => self%collision_system, impactors => self%collision_system%impactors, fragments => self%collision_system%fragments, eslot => param%ioutput) - call netcdf_io_check( nf90_set_fill(nc%id, nf90_nofill, old_mode), "collision_netcdf_io_write_frame_snapshot nf90_set_fill" ) + associate(collider => self%collider, impactors => self%collider%impactors, fragments => self%collider%fragments, eslot => param%ioutput) + call netcdf_io_check( nf90_set_fill(nc%id, nf90_nofill, old_mode), "collision_io_netcdf_write_frame_snapshot nf90_set_fill" ) - call netcdf_io_check( nf90_put_var(nc%id, nc%time_varid, self%t, start=[eslot]), "collision_netcdf_io_write_frame_snapshot nf90_put_var time_varid" ) - call netcdf_io_check( nf90_put_var(nc%id, nc%loop_varid, int(self%iloop,kind=I4B), start=[eslot]), "collision_netcdf_io_write_frame_snapshot nf90_put_varloop_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%time_varid, self%t, start=[eslot]), "collision_io_netcdf_write_frame_snapshot nf90_put_var time_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%loop_varid, int(self%iloop,kind=I4B), start=[eslot]), "collision_io_netcdf_write_frame_snapshot nf90_put_varloop_varid" ) charstring = trim(adjustl(REGIME_NAMES(impactors%regime))) - call netcdf_io_check( nf90_put_var(nc%id, nc%regime_varid, charstring, start=[1, eslot], count=[len(charstring), 1]), "collision_netcdf_io_write_frame_snapshot nf90_put_var regime_varid" ) - call netcdf_io_check( nf90_put_var(nc%id, nc%Qloss_varid, impactors%Qloss, start=[eslot] ), "collision_netcdf_io_write_frame_snapshot nf90_put_var Qloss_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%regime_varid, charstring, start=[1, eslot], count=[len(charstring), 1]), "collision_io_netcdf_write_frame_snapshot nf90_put_var regime_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%Qloss_varid, impactors%Qloss, start=[eslot] ), "collision_io_netcdf_write_frame_snapshot nf90_put_var Qloss_varid" ) - select type(before =>self%collision_system%before) + select type(before =>self%collider%before) class is (swiftest_nbody_system) - select type(after =>self%collision_system%before) + select type(after =>self%collider%before) class is (swiftest_nbody_system) do stage = 1,2 if (allocated(pl)) deallocate(pl) @@ -240,34 +314,36 @@ module subroutine collision_netcdf_io_write_frame_snapshot(self, history, param) npl = pl%nbody do i = 1, npl idslot = findloc(history%idvals,pl%id(i),dim=1) - call netcdf_io_check( nf90_put_var(nc%id, nc%id_varid, pl%id(i), start=[ idslot ]), "collision_netcdf_io_write_frame_snapshot nf90_put_var id_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%id_varid, pl%id(i), start=[ idslot ]), "collision_io_netcdf_write_frame_snapshot nf90_put_var id_varid" ) charstring = trim(adjustl(pl%info(i)%name)) - call netcdf_io_check( nf90_put_var(nc%id, nc%name_varid, charstring, start=[1, idslot ], count=[len(charstring), 1]), "collision_netcdf_io_write_frame_snapshot nf90_put_var name_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%name_varid, charstring, start=[1, idslot ], count=[len(charstring), 1]), "collision_io_netcdf_write_frame_snapshot nf90_put_var name_varid" ) charstring = trim(adjustl(pl%info(i)%particle_type)) - call netcdf_io_check( nf90_put_var(nc%id, nc%ptype_varid, charstring, start=[1, idslot, stage, eslot], count=[len(charstring), 1, 1]), "collision_netcdf_io_write_frame_snapshot nf90_put_var particle_type_varid" ) - call netcdf_io_check( nf90_put_var(nc%id, nc%rh_varid, pl%rh(:,i), start=[1, idslot, stage, eslot], count=[NDIM,1,1,1]), "collision_netcdf_io_write_frame_snapshot nf90_put_var rh_varid" ) - call netcdf_io_check( nf90_put_var(nc%id, nc%vh_varid, pl%vh(:,i), start=[1, idslot, stage, eslot], count=[NDIM,1,1,1]), "collision_netcdf_io_write_frame_snapshot nf90_put_var vh_varid" ) - call netcdf_io_check( nf90_put_var(nc%id, nc%Gmass_varid, pl%Gmass(i), start=[ idslot, stage, eslot]), "collision_netcdf_io_write_frame_snapshot nf90_put_var Gmass_varid" ) - call netcdf_io_check( nf90_put_var(nc%id, nc%radius_varid, pl%radius(i), start=[ idslot, stage, eslot]), "collision_netcdf_io_write_frame_snapshot nf90_put_var radius_varid" ) - call netcdf_io_check( nf90_put_var(nc%id, nc%Ip_varid, pl%Ip(:,i), start=[1, idslot, stage, eslot], count=[NDIM,1,1,1]), "collision_netcdf_io_write_frame_snapshot nf90_put_var Ip_varid" ) - call netcdf_io_check( nf90_put_var(nc%id, nc%rot_varid, pl%rot(:,i), start=[1, idslot, stage, eslot], count=[NDIM,1,1,1]), "collision_netcdf_io_write_frame_snapshot nf90_put_var rotx_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%ptype_varid, charstring, start=[1, idslot, stage, eslot], count=[len(charstring), 1, 1]), "collision_io_netcdf_write_frame_snapshot nf90_put_var particle_type_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%rh_varid, pl%rh(:,i), start=[1, idslot, stage, eslot], count=[NDIM,1,1,1]), "collision_io_netcdf_write_frame_snapshot nf90_put_var rh_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%vh_varid, pl%vh(:,i), start=[1, idslot, stage, eslot], count=[NDIM,1,1,1]), "collision_io_netcdf_write_frame_snapshot nf90_put_var vh_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%Gmass_varid, pl%Gmass(i), start=[ idslot, stage, eslot]), "collision_io_netcdf_write_frame_snapshot nf90_put_var Gmass_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%radius_varid, pl%radius(i), start=[ idslot, stage, eslot]), "collision_io_netcdf_write_frame_snapshot nf90_put_var radius_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%Ip_varid, pl%Ip(:,i), start=[1, idslot, stage, eslot], count=[NDIM,1,1,1]), "collision_io_netcdf_write_frame_snapshot nf90_put_var Ip_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%rot_varid, pl%rot(:,i), start=[1, idslot, stage, eslot], count=[NDIM,1,1,1]), "collision_io_netcdf_write_frame_snapshot nf90_put_var rotx_varid" ) end do end do end select end select if (param%lenergy) then - call netcdf_io_check( nf90_put_var(nc%id, nc%ke_orb_varid, system%ke_orbit(:), start=[ 1, eslot], count=[ 2, 1]), "collision_netcdf_io_write_frame_snapshot nf90_put_var ke_orb_varid before" ) - call netcdf_io_check( nf90_put_var(nc%id, nc%ke_spin_varid, system%ke_spin(:), start=[ 1, eslot], count=[ 2, 1]), "collision_netcdf_io_write_frame_snapshot nf90_put_var ke_spin_varid before" ) - call netcdf_io_check( nf90_put_var(nc%id, nc%pe_varid, system%pe(:), start=[ 1, eslot], count=[ 2, 1]), "collision_netcdf_io_write_frame_snapshot nf90_put_var pe_varid before" ) - call netcdf_io_check( nf90_put_var(nc%id, nc%L_orb_varid, system%Lorbit(:,:), start=[1, 1, eslot], count=[NDIM, 2, 1]), "collision_netcdf_io_write_frame_snapshot nf90_put_var L_orb_varid before" ) - call netcdf_io_check( nf90_put_var(nc%id, nc%Lspin_varid, system%Lspin(:,:), start=[1, 1, eslot], count=[NDIM, 2, 1]), "collision_netcdf_io_write_frame_snapshot nf90_put_var Lspin_varid before" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%ke_orb_varid, collider%ke_orbit(:), start=[ 1, eslot], count=[ 2, 1]), "collision_io_netcdf_write_frame_snapshot nf90_put_var ke_orb_varid before" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%ke_spin_varid, collider%ke_spin(:), start=[ 1, eslot], count=[ 2, 1]), "collision_io_netcdf_write_frame_snapshot nf90_put_var ke_spin_varid before" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%pe_varid, collider%pe(:), start=[ 1, eslot], count=[ 2, 1]), "collision_io_netcdf_write_frame_snapshot nf90_put_var pe_varid before" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%L_orb_varid, collider%Lorbit(:,:), start=[1, 1, eslot], count=[NDIM, 2, 1]), "collision_io_netcdf_write_frame_snapshot nf90_put_var L_orb_varid before" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%Lspin_varid, collider%Lspin(:,:), start=[1, 1, eslot], count=[NDIM, 2, 1]), "collision_io_netcdf_write_frame_snapshot nf90_put_var Lspin_varid before" ) end if call netcdf_io_check( nf90_set_fill(nc%id, old_mode, old_mode) ) end associate end select return - end subroutine collision_netcdf_io_write_frame_snapshot + end subroutine collision_io_netcdf_write_frame_snapshot + + -end submodule s_collision_netcdf_io \ No newline at end of file +end submodule s_collision_io_netcdf \ No newline at end of file diff --git a/src/collision/collision_module.f90 b/src/collision/collision_module.f90 index 77c5552fd..1eee878b0 100644 --- a/src/collision/collision_module.f90 +++ b/src/collision/collision_module.f90 @@ -18,6 +18,8 @@ module collision implicit none public + character(len=*), parameter :: COLLISION_LOG_OUT = "collision.log" !! Name of log file for collision diagnostic information + !>Symbolic names for collisional outcomes from collresolve_resolve: integer(I4B), parameter :: COLLRESOLVE_REGIME_MERGE = 1 integer(I4B), parameter :: COLLRESOLVE_REGIME_DISRUPTION = 2 @@ -63,14 +65,14 @@ module collision real(DP), dimension(:), allocatable :: mass_dist !! Distribution of fragment mass determined by the regime calculation (largest fragment, second largest, and remainder) real(DP) :: Mcb !! Mass of central body (used to compute potential energy in regime determination) - ! Values in a coordinate frame centered on the collider barycenter and collisional system unit vectors - real(DP), dimension(NDIM) :: x_unit !! x-direction unit vector of collisional system - real(DP), dimension(NDIM) :: y_unit !! y-direction unit vector of collisional system - real(DP), dimension(NDIM) :: z_unit !! z-direction unit vector of collisional system - real(DP), dimension(NDIM) :: v_unit !! z-direction unit vector of collisional system - real(DP), dimension(NDIM) :: rbcom !! Center of mass position vector of the collider system in system barycentric coordinates - real(DP), dimension(NDIM) :: vbcom !! Velocity vector of the center of mass of the collider system in system barycentric coordinates - real(DP), dimension(NDIM) :: rbimp !! Impact point position vector of the collider system in system barycentric coordinates + ! Values in a coordinate frame centered on the collider barycenter and collisional nbody_system unit vectors + real(DP), dimension(NDIM) :: x_unit !! x-direction unit vector of collisional nbody_system + real(DP), dimension(NDIM) :: y_unit !! y-direction unit vector of collisional nbody_system + real(DP), dimension(NDIM) :: z_unit !! z-direction unit vector of collisional nbody_system + real(DP), dimension(NDIM) :: v_unit !! z-direction unit vector of collisional nbody_system + real(DP), dimension(NDIM) :: rbcom !! Center of mass position vector of the collider nbody_system in nbody_system barycentric coordinates + real(DP), dimension(NDIM) :: vbcom !! Velocity vector of the center of mass of the collider nbody_system in nbody_system barycentric coordinates + real(DP), dimension(NDIM) :: rbimp !! Impact point position vector of the collider nbody_system in nbody_system barycentric coordinates contains procedure :: get_regime => collision_regime_impactors !! Determine which fragmentation regime the set of impactors will be @@ -108,49 +110,50 @@ module collision type, abstract :: collision_system - !! This class defines a collisional system that stores impactors and fragments. This is written so that various collision models (i.e. Fraggle) could potentially be used + !! This class defines a collisional nbody_system that stores impactors and fragments. This is written so that various collision models (i.e. Fraggle) could potentially be used !! to resolve collision by defining extended types of encounters_impactors and/or encounetr_fragments class(collision_fragments(:)), allocatable :: fragments !! Object containing information on the pre-collision system class(collision_impactors), allocatable :: impactors !! Object containing information on the post-collision system - class(base_nbody_system), allocatable :: before !! A snapshot of the subset of the system involved in the collision - class(base_nbody_system), allocatable :: after !! A snapshot of the subset of the system containing products of the collision + class(base_nbody_system), allocatable :: before !! A snapshot of the subset of the nbody_system involved in the collision + class(base_nbody_system), allocatable :: after !! A snapshot of the subset of the nbody_system containing products of the collision + integer(I4B) :: status !! Status flag to pass to the collision list once the collision has been resolved - ! For the following variables, index 1 refers to the *entire* n-body system in its pre-collisional state and index 2 refers to the system in its post-collisional state + ! For the following variables, index 1 refers to the *entire* n-body nbody_system in its pre-collisional state and index 2 refers to the nbody_system in its post-collisional state real(DP), dimension(NDIM,2) :: Lorbit !! Before/after orbital angular momentum real(DP), dimension(NDIM,2) :: Lspin !! Before/after spin angular momentum - real(DP), dimension(NDIM,2) :: Ltot !! Before/after total system angular momentum + real(DP), dimension(NDIM,2) :: Ltot !! Before/after total nbody_system angular momentum real(DP), dimension(2) :: ke_orbit !! Before/after orbital kinetic energy real(DP), dimension(2) :: ke_spin !! Before/after spin kinetic energy real(DP), dimension(2) :: pe !! Before/after potential energy - real(DP), dimension(2) :: Etot !! Before/after total system energy + real(DP), dimension(2) :: Etot !! Before/after total nbody_system energy contains procedure :: setup => collision_setup_system !! Initializer for the encounter collision system and the before/after snapshots procedure :: setup_impactors => collision_setup_impactors_system !! Initializer for the impactors for the encounter collision system. Deallocates old impactors before creating new ones procedure :: setup_fragments => collision_setup_fragments_system !! Initializer for the fragments of the collision system. - procedure :: add_fragments => collision_util_add_fragments_to_system !! Add fragments to system - procedure :: construct_temporary_system => collision_util_construct_temporary_system !! Constructs temporary n-body system in order to compute pre- and post-impact energy and momentum - procedure :: get_energy_and_momentum => collision_util_get_energy_momentum !! Calculates total system energy in either the pre-collision outcome state (lbefore = .true.) or the post-collision outcome state (lbefore = .false.) + procedure :: add_fragments => collision_util_add_fragments_to_system !! Add fragments to nbody_system + procedure :: construct_temporary_system => collision_util_construct_temporary_system !! Constructs temporary n-body nbody_system in order to compute pre- and post-impact energy and momentum + procedure :: get_energy_and_momentum => collision_util_get_energy_momentum !! Calculates total nbody_system energy in either the pre-collision outcome state (lbefore = .true.) or the post-collision outcome state (lbefore = .false.) procedure :: reset => collision_util_reset_system !! Deallocates all allocatables - procedure :: set_coordinate_system => collision_util_set_coordinate_system !! Sets the coordinate system of the collisional system - procedure(abstract_generate_system), deferred :: generate !! Generates a system of fragments depending on collision model + procedure :: set_coordinate_system => collision_util_set_coordinate_system !! Sets the coordinate nbody_system of the collisional nbody_system + procedure(abstract_generate_system), deferred :: generate !! Generates a nbody_system of fragments depending on collision model end type collision_system type, extends(collision_system) :: collision_merge contains procedure :: generate => collision_generate_merge_system !! Merges the impactors to make a single final body - final :: collision_final_merge_system !! Finalizer will deallocate all allocatables + final :: collision_final_merge_system !! Finalizer will deallocate all allocatables end type collision_merge type, extends(collision_system) :: collision_bounce contains procedure :: generate => collision_generate_bounce_system !! If a collision would result in a disruption, "bounce" the bodies instead. - final :: collision_final_bounce_system !! Finalizer will deallocate all allocatables + final :: collision_final_bounce_system !! Finalizer will deallocate all allocatables end type collision_bounce type, extends(collision_system) :: collision_simple contains procedure :: generate => collision_generate_simple_system !! If a collision would result in a disruption [TODO: SOMETHING LIKE CHAMBERS 2012] - final :: collision_final_simple_system !! Finalizer will deallocate all allocatables + final :: collision_final_simple_system !! Finalizer will deallocate all allocatables end type collision_simple @@ -171,28 +174,28 @@ module collision character(NAMELEN) :: regime_varname = "regime" !! name of the collision regime variable integer(I4B) :: regime_varid !! ID for the collision regime variable contains - procedure :: initialize => collision_netcdf_io_initialize_output !! Initialize a set of parameters used to identify a NetCDF output object + procedure :: initialize => collision_io_netcdf_initialize_output !! Initialize a set of parameters used to identify a NetCDF output object final :: collision_final_netcdf_parameters !! Finalizer closes the NetCDF file end type collision_netcdf_parameters type, extends(encounter_snapshot) :: collision_snapshot - logical :: lcollision !! Indicates that this snapshot contains at least one collision - class(collision_system), allocatable :: collision_system !! impactors object at this snapshot + logical :: lcollision !! Indicates that this snapshot contains at least one collision + class(collision_system), allocatable :: collider !! Collider object at this snapshot contains - procedure :: write_frame => collision_netcdf_io_write_frame_snapshot !! Writes a frame of encounter data to file - procedure :: get_idvals => collision_util_get_idvalues_snapshot !! Gets an array of all id values saved in this snapshot - final :: collision_final_snapshot !! Finalizer deallocates all allocatables + procedure :: write_frame => collision_io_netcdf_write_frame_snapshot !! Writes a frame of encounter data to file + procedure :: get_idvals => collision_util_get_idvalues_snapshot !! Gets an array of all id values saved in this snapshot + final :: collision_final_snapshot !! Finalizer deallocates all allocatables end type collision_snapshot !> A class that that is used to store simulation history data between file output type, extends(encounter_storage) :: collision_storage contains - procedure :: dump => collision_netcdf_io_dump !! Dumps contents of encounter history to file - procedure :: take_snapshot => collision_util_snapshot !! Take a minimal snapshot of the system through an encounter - procedure :: make_index_map => collision_util_index_map !! Maps body id values to storage index values so we don't have to use unlimited dimensions for id - final :: collision_final_storage !! Finalizer deallocates all allocatables + procedure :: dump => collision_io_netcdf_dump !! Dumps contents of encounter history to file + procedure :: take_snapshot => collision_util_snapshot !! Take a minimal snapshot of the nbody_system through an encounter + procedure :: make_index_map => collision_util_index_map !! Maps body id values to storage index values so we don't have to use unlimited dimensions for id + final :: collision_final_storage !! Finalizer deallocates all allocatables end type collision_storage @@ -216,10 +219,17 @@ end subroutine abstract_set_mass_dist interface + module subroutine collision_generate_merge_any(self, nbody_system, param, t) + implicit none + class(collision_system), intent(inout) :: self !! Merge fragment nbody_system object + class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object + class(base_parameters), intent(inout) :: param !! Current run configuration parameters + real(DP), intent(in) :: t !! The time of the collision + end subroutine collision_generate_merge_any module subroutine collision_generate_merge_system(self, nbody_system, param, t) implicit none - class(collision_merge), intent(inout) :: self !! Merge fragment system object + class(collision_merge), intent(inout) :: self !! Merge fragment nbody_system object class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(base_parameters), intent(inout) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! The time of the collision @@ -227,7 +237,7 @@ end subroutine collision_generate_merge_system module subroutine collision_generate_bounce_system(self, nbody_system, param, t) implicit none - class(collision_bounce), intent(inout) :: self !! Bounce fragment system object + class(collision_bounce), intent(inout) :: self !! Bounce fragment nbody_system object class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(base_parameters), intent(inout) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! The time of the collision @@ -235,42 +245,54 @@ end subroutine collision_generate_bounce_system module subroutine collision_generate_simple_system(self, nbody_system, param, t) implicit none - class(collision_simple), intent(inout) :: self !! Simple fragment system object + class(collision_simple), intent(inout) :: self !! Simple fragment nbody_system object class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(base_parameters), intent(inout) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! The time of the collision end subroutine collision_generate_simple_system - module subroutine collision_netcdf_io_dump(self, param) + module subroutine collision_io_collider_message(pl, collidx, collider_message) + implicit none + class(base_object), intent(in) :: pl !! Swiftest massive body object + integer(I4B), dimension(:), intent(in) :: collidx !! Index of collisional colliders%idx members + character(*), intent(inout) :: collider_message !! The message to print to the screen. + end subroutine collision_io_collider_message + + module subroutine collision_io_log_regime(self) + implicit none + class(collision_system), intent(inout) :: self !! Collision system object + end subroutine collision_io_log_regime + + module subroutine collision_io_netcdf_dump(self, param) implicit none class(collision_storage(*)), intent(inout) :: self !! Collision storage object class(base_parameters), intent(inout) :: param !! Current run configuration parameters - end subroutine collision_netcdf_io_dump + end subroutine collision_io_netcdf_dump - module subroutine collision_netcdf_io_initialize_output(self, param) + module subroutine collision_io_netcdf_initialize_output(self, param) implicit none class(collision_netcdf_parameters), intent(inout) :: self !! Parameters used to identify a particular NetCDF dataset class(base_parameters), intent(in) :: param !! Current run configuration parameters - end subroutine collision_netcdf_io_initialize_output + end subroutine collision_io_netcdf_initialize_output - module subroutine collision_netcdf_io_write_frame_snapshot(self, history, param) + module subroutine collision_io_netcdf_write_frame_snapshot(self, history, param) implicit none class(collision_snapshot), intent(in) :: self !! Swiftest encounter structure class(encounter_storage(*)), intent(inout) :: history !! Collision history object class(base_parameters), intent(inout) :: param !! Current run configuration parameters - end subroutine collision_netcdf_io_write_frame_snapshot + end subroutine collision_io_netcdf_write_frame_snapshot - module subroutine collision_regime_impactors(self, system, param) + module subroutine collision_regime_impactors(self, nbody_system, param) implicit none - class(collision_impactors), intent(inout) :: self !! Collision system impactors object - class(base_nbody_system), intent(in) :: system !! Swiftest nbody system object - class(base_parameters), intent(in) :: param !! Current Swiftest run configuration parameters + class(collision_impactors), intent(inout) :: self !! Collision system impactors object + class(base_nbody_system), intent(in) :: nbody_system !! Swiftest nbody system object + class(base_parameters), intent(in) :: param !! Current Swiftest run configuration parameters end subroutine collision_regime_impactors - module subroutine collision_check_plpl(self, system, param, t, dt, irec, lany_collision) + module subroutine collision_check_plpl(self, nbody_system, param, t, dt, irec, lany_collision) implicit none class(collision_list_plpl), intent(inout) :: self !! encounter list object - class(base_nbody_system), intent(inout) :: system !! SyMBA nbody system object + class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(base_parameters), intent(inout) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! current time real(DP), intent(in) :: dt !! step size @@ -278,35 +300,28 @@ module subroutine collision_check_plpl(self, system, param, t, dt, irec, lany_co logical, intent(out) :: lany_collision !! Returns true if any pair of encounters resulted in a collision end subroutine collision_check_plpl - module subroutine collision_check_pltp(self, system, param, t, dt, irec, lany_collision) + module subroutine collision_check_pltp(self, nbody_system, param, t, dt, irec, lany_collision) implicit none class(collision_list_pltp), intent(inout) :: self !! encounter list object - class(base_nbody_system), intent(inout) :: system !! SyMBA nbody system object + class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(base_parameters), intent(inout) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! current time real(DP), intent(in) :: dt !! step size integer(I4B), intent(in) :: irec !! Current recursion level logical, intent(out) :: lany_collision !! Returns true if any pair of encounters resulted in a collision end subroutine collision_check_pltp - - module subroutine collision_resolve_collider_message(pl, collidx, collider_message) - implicit none - class(base_object), intent(in) :: pl !! Swiftest massive body object - integer(I4B), dimension(:), intent(in) :: collidx !! Index of collisional impactors%id members - character(*), intent(inout) :: collider_message !! The message to print to the screen. - end subroutine collision_resolve_collider_message - module subroutine collision_resolve_extract_plpl(self, system, param) + module subroutine collision_resolve_extract_plpl(self, nbody_system, param) implicit none - class(collision_list_plpl), intent(inout) :: self !! pl-pl encounter list - class(base_nbody_system), intent(inout) :: system !! Swiftest nbody system object - class(base_parameters), intent(in) :: param !! Current run configuration parameters + class(collision_list_plpl), intent(inout) :: self !! pl-pl encounter list + class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object + class(base_parameters), intent(in) :: param !! Current run configuration parameters end subroutine collision_resolve_extract_plpl - module subroutine collision_resolve_extract_pltp(self, system, param) + module subroutine collision_resolve_extract_pltp(self, nbody_system, param) implicit none class(collision_list_pltp), intent(inout) :: self !! pl-tp encounter list - class(base_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(base_parameters), intent(in) :: param !! Current run configuration parameters end subroutine collision_resolve_extract_pltp @@ -316,36 +331,27 @@ module subroutine collision_resolve_make_impactors_pl(pl, idx) integer(I4B), dimension(:), intent(in) :: idx !! Array holding the indices of the two bodies involved in the collision end subroutine collision_resolve_make_impactors_pl - module function collision_resolve_merge(system, param, t) result(status) - implicit none - class(base_nbody_system), intent(inout) :: system !! Swiftest nbody system object - class(base_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions - real(DP), intent(in) :: t !! Time of collision - integer(I4B) :: status !! Status flag assigned to this outcome - end function collision_resolve_merge - - module subroutine collision_resolve_mergeaddsub(system, param, t, status) - class(base_nbody_system), intent(inout) :: system !! Swiftest nbody system object + module subroutine collision_resolve_mergeaddsub(nbody_system, param, t, status) + class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(base_parameters), intent(inout) :: param !! Current run configuration parameters with Swiftest additions real(DP), intent(in) :: t !! Time of collision integer(I4B), intent(in) :: status !! Status flag to assign to adds end subroutine collision_resolve_mergeaddsub - - module subroutine collision_resolve_plpl(self, system, param, t, dt, irec) + module subroutine collision_resolve_plpl(self, nbody_system, param, t, dt, irec) implicit none class(collision_list_plpl), intent(inout) :: self !! pl-pl encounter list - class(base_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(base_parameters), intent(inout) :: param !! Current run configuration parameters with Swiftest additions real(DP), intent(in) :: t !! Current simulation time real(DP), intent(in) :: dt !! Current simulation step size integer(I4B), intent(in) :: irec !! Current recursion level end subroutine collision_resolve_plpl - module subroutine collision_resolve_pltp(self, system, param, t, dt, irec) + module subroutine collision_resolve_pltp(self, nbody_system, param, t, dt, irec) implicit none class(collision_list_pltp), intent(inout) :: self !! pl-tp encounter list - class(base_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(base_parameters), intent(inout) :: param !! Current run configuration parameters with Swiftest additions real(DP), intent(in) :: t !! Current simulation time real(DP), intent(in) :: dt !! Current simulation step size @@ -354,7 +360,7 @@ end subroutine collision_resolve_pltp module subroutine collision_util_set_coordinate_system(self) implicit none - class(collision_system), intent(inout) :: self !! Collisional system + class(collision_system), intent(inout) :: self !! Collisional nbody_system end subroutine collision_util_set_coordinate_system module subroutine collision_setup_system(self, nbody_system) @@ -374,11 +380,11 @@ module subroutine collision_setup_fragments_system(self, nfrag) integer(I4B), intent(in) :: nfrag !! Number of fragments to create end subroutine collision_setup_fragments_system - module subroutine collision_util_add_fragments_to_system(self, system, param) + module subroutine collision_util_add_fragments_to_system(self, nbody_system, param) implicit none - class(collision_system), intent(in) :: self !! Collision system system object - class(base_nbody_system), intent(inout) :: system !! Swiftest nbody system object - class(base_parameters), intent(in) :: param !! Current swiftest run configuration parameters + class(collision_system), intent(in) :: self !! Collision system object + class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object + class(base_parameters), intent(in) :: param !! Current swiftest run configuration parameters end subroutine collision_util_add_fragments_to_system module subroutine collision_util_construct_temporary_system(self, nbody_system, param, tmpsys, tmpparam) @@ -397,17 +403,17 @@ end subroutine collision_util_reset_fragments module subroutine collision_util_get_idvalues_snapshot(self, idvals) implicit none - class(collision_snapshot), intent(in) :: self !! Fraggle snapshot object + class(collision_snapshot), intent(in) :: self !! Collision snapshot object integer(I4B), dimension(:), allocatable, intent(out) :: idvals !! Array of all id values saved in this snapshot end subroutine collision_util_get_idvalues_snapshot - module subroutine collision_util_get_energy_momentum(self, system, param, lbefore) + module subroutine collision_util_get_energy_momentum(self, nbody_system, param, lbefore) use base, only : base_nbody_system, base_parameters implicit none - class(collision_system), intent(inout) :: self !! Encounter collision system object - class(base_nbody_system), intent(inout) :: system !! Swiftest nbody system object - class(base_parameters), intent(inout) :: param !! Current swiftest run configuration parameters - logical, intent(in) :: lbefore !! Flag indicating that this the "before" state of the system, with impactors included and fragments excluded or vice versa + class(collision_system), intent(inout) :: self !! Encounter collision system object + class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object + class(base_parameters), intent(inout) :: param !! Current swiftest run configuration parameters + logical, intent(in) :: lbefore !! Flag indicating that this the "before" state of the nbody_system, with impactors included and fragments excluded or vice versa end subroutine collision_util_get_energy_momentum module subroutine collision_util_index_map(self) @@ -425,13 +431,13 @@ module subroutine collision_util_reset_system(self) class(collision_system), intent(inout) :: self !! Collision system object end subroutine collision_util_reset_system - module subroutine collision_util_snapshot(self, param, system, t, arg) + module subroutine collision_util_snapshot(self, param, nbody_system, t, arg) implicit none - class(collision_storage(*)), intent(inout) :: self !! Swiftest storage object - class(base_parameters), intent(inout) :: param !! Current run configuration parameters - class(base_nbody_system), intent(inout) :: system !! Swiftest nbody system object to store - real(DP), intent(in), optional :: t !! Time of snapshot if different from system time - character(*), intent(in), optional :: arg !! "before": takes a snapshot just before the collision. "after" takes the snapshot just after the collision. + class(collision_storage(*)), intent(inout) :: self !! Swiftest storage object + class(base_parameters), intent(inout) :: param !! Current run configuration parameters + class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object to store + real(DP), intent(in), optional :: t !! Time of snapshot if different from nbody_system time + character(*), intent(in), optional :: arg !! "before": takes a snapshot just before the collision. "after" takes the snapshot just after the collision. end subroutine collision_util_snapshot end interface diff --git a/src/collision/collision_regime.f90 b/src/collision/collision_regime.f90 index 5aa170863..50884258b 100644 --- a/src/collision/collision_regime.f90 +++ b/src/collision/collision_regime.f90 @@ -13,7 +13,7 @@ contains - module subroutine collision_regime_impactors(self, system, param) + module subroutine collision_regime_impactors(self, nbody_system, param) !! Author: Jennifer L.L. Pouplin, Carlisle A. Wishard, and David A. Minton !! !! Determine which fragmentation regime the set of impactors will be. This subroutine is a wrapper for the non-polymorphic raggle_regime_collresolve subroutine. @@ -21,13 +21,13 @@ module subroutine collision_regime_impactors(self, system, param) implicit none ! Arguments class(collision_impactors), intent(inout) :: self !! Collision system impactors object - class(base_nbody_system), intent(in) :: system !! Swiftest nbody system object + class(base_nbody_system), intent(in) :: nbody_system !! Swiftest nbody system object class(base_parameters), intent(in) :: param !! Current Swiftest run configuration parameters ! Internals real (DP) :: mtot associate(impactors => self) - select type (system) + select type (nbody_system) class is (swiftest_nbody_system) select type(param) class is (swiftest_parameters) @@ -42,7 +42,7 @@ module subroutine collision_regime_impactors(self, system, param) impactors%rbcom(:) = (impactors%mass(1) * impactors%rb(:,1) + impactors%mass(2) * impactors%rb(:,2)) / mtot impactors%vbcom(:) = (impactors%mass(1) * impactors%vb(:,1) + impactors%mass(2) * impactors%vb(:,2)) / mtot case default - call collision_regim_LS12(impactors, system, param) + call collision_regime_LS12(impactors, nbody_system, param) end select !call fraggle_io_log_regime(impactors, fragments) end select @@ -70,6 +70,7 @@ subroutine collision_regime_LS12(impactors, nbody_system, param) real(DP) :: min_mfrag_si, Mcb_si real(DP), dimension(NDIM) :: x1_si, v1_si, x2_si, v2_si, runit real(DP) :: mlr, mslr, mtot, dentot + integer(I4B), parameter :: NMASS_DIST = 3 !! Number of mass bins returned by the regime calculation (largest fragment, second largest, and remainder) ! Convert all quantities to SI units and determine which of the pair is the projectile vs. target before sending them to the regime determination subroutine if (impactors%mass(1) > impactors%mass(2)) then @@ -93,12 +94,12 @@ subroutine collision_regime_LS12(impactors, nbody_system, param) dentot = sum(mass_si(:) * density_si(:)) / mtot !! Use the positions and velocities of the parents from indside the step (at collision) to calculate the collisional regime - call collision_regime_collresolve(Mcb_si, mass_si(jtarg), mass_si(jproj), radius_si(jtarg), radius_si(jproj), & + call collision_regime_LS12_SI(Mcb_si, mass_si(jtarg), mass_si(jproj), radius_si(jtarg), radius_si(jproj), & x1_si(:), x2_si(:), v1_si(:), v2_si(:), density_si(jtarg), density_si(jproj), & min_mfrag_si, impactors%regime, mlr, mslr, impactors%Qloss) if (allocated(impactors%mass_dist)) deallocate(impactors%mass_dist) - allocate(impactors%mass_dist(3)) + allocate(impactors%mass_dist(NMASS_DIST)) impactors%mass_dist(1) = min(max(mlr, 0.0_DP), mtot) impactors%mass_dist(2) = min(max(mslr, 0.0_DP), mtot) impactors%mass_dist(3) = min(max(mtot - mlr - mslr, 0.0_DP), mtot) @@ -231,7 +232,7 @@ subroutine collision_regime_LS12_SI(Mcb, m1, m2, rad1, rad2, rh1, rh2, vb1, vb2, Mlr = Mtot Mslr = 0.0_DP Qloss = 0.0_DP - call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, & + call swiftest_io_log_one_message(COLLISION_LOG_OUT, & "Fragments would have mass below the minimum. Converting this collision into a merger.") else if( Vimp < Vescp) then diff --git a/src/collision/collision_resolve.f90 b/src/collision/collision_resolve.f90 index aee398839..6cb08a49a 100644 --- a/src/collision/collision_resolve.f90 +++ b/src/collision/collision_resolve.f90 @@ -11,123 +11,6 @@ use swiftest contains - module function collision_resolve_merge(system, param, t) result(status) - !! author: Jennifer L.L. Pouplin, Carlisle A. Wishard, and David A. Minton - !! - !! Merge massive bodies. - !! - !! Adapted from David E. Kaufmann's Swifter routines swiftest_merge_pl.f90 and swiftest_discard_merge_pl.f90 - !! - !! Adapted from Hal Levison's Swift routines symba5_merge.f and discard_mass_merge.f - implicit none - ! Arguments - class(base_nbody_system), intent(inout) :: system !! Swiftest nbody system object - class(base_parameters), intent(inout) :: param !! Current run configuration parameters with Swiftest additions - real(DP), intent(in) :: t !! Time of collision - ! Result - integer(I4B) :: status !! Status flag assigned to this outcome - ! Internals - integer(I4B) :: i, j, k, ibiggest - real(DP), dimension(NDIM) :: Lspin_new - real(DP) :: dpe - character(len=STRMAX) :: message - - select type(system) - class is (swiftest_nbody_system) - associate(collision_system => system%collision_system, impactors => system%collision_system%impactors, fragments => system%collision_system%fragments) - message = "Merging" - call collision_resolve_collider_message(system%pl, impactors%id, message) - ! call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, message) - - select type(pl => system%pl) - class is (swiftest_pl) - - call collision_system%set_mass_dist(param) - - ! Calculate the initial energy of the system without the collisional family - call collision_system%get_energy_and_momentum(system, param, lbefore=.true.) - - ibiggest = impactors%id(maxloc(pl%Gmass(impactors%id(:)), dim=1)) - fragments%id(1) = pl%id(ibiggest) - fragments%rb(:,1) = impactors%rbcom(:) - fragments%vb(:,1) = impactors%vbcom(:) - - if (param%lrotation) then - ! Conserve angular momentum by putting pre-impact orbital momentum into spin of the new body - Lspin_new(:) = impactors%Lorbit(:,1) + impactors%Lorbit(:,2) + impactors%Lspin(:,1) + impactors%Lspin(:,2) - - ! Assume prinicpal axis rotation on 3rd Ip axis - fragments%rot(:,1) = Lspin_new(:) / (fragments%Ip(3,1) * fragments%mass(1) * fragments%radius(1)**2) - else ! If spin is not enabled, we will consider the lost pre-collision angular momentum as "escaped" and add it to our bookkeeping variable - system%Lescape(:) = system%Lescape(:) + impactors%Lorbit(:,1) + impactors%Lorbit(:,2) - end if - - ! Keep track of the component of potential energy due to the pre-impact impactors%id for book-keeping - ! Get the energy of the system after the collision - call collision_system%get_energy_and_momentum(system, param, lbefore=.false.) - dpe = collision_system%pe(2) - collision_system%pe(1) - system%Ecollisions = system%Ecollisions - dpe - system%Euntracked = system%Euntracked + dpe - - - ! Update any encounter lists that have the removed bodies in them so that they instead point to the new - do k = 1, system%plpl_encounter%nenc - do j = 1, impactors%ncoll - i = impactors%id(j) - if (i == ibiggest) cycle - if (system%plpl_encounter%id1(k) == pl%id(i)) then - system%plpl_encounter%id1(k) = pl%id(ibiggest) - system%plpl_encounter%index1(k) = i - end if - if (system%plpl_encounter%id2(k) == pl%id(i)) then - system%plpl_encounter%id2(k) = pl%id(ibiggest) - system%plpl_encounter%index2(k) = i - end if - if (system%plpl_encounter%id1(k) == system%plpl_encounter%id2(k)) system%plpl_encounter%status(k) = INACTIVE - end do - end do - - status = MERGED - - call collision_resolve_mergeaddsub(system, param, t, status) - - end select - end associate - end select - return - end function collision_resolve_merge - - - module subroutine collision_resolve_collider_message(pl, collidx, collider_message) - !! author: David A. Minton - !! - !! Prints a nicely formatted message about which bodies collided, including their names and ids. - !! This subroutine appends the body names and ids to an input message. - implicit none - ! Arguments - class(base_object), intent(in) :: pl !! Swiftest massive body object - integer(I4B), dimension(:), intent(in) :: collidx !! Index of collisional impactors%id members - character(*), intent(inout) :: collider_message !! The message to print to the screen. - ! Internals - integer(I4B) :: i, n - character(len=STRMAX) :: idstr - - n = size(collidx) - if (n == 0) return - - select type(pl) - class is (swiftest_pl) - do i = 1, n - if (i > 1) collider_message = trim(adjustl(collider_message)) // " and " - collider_message = " " // trim(adjustl(collider_message)) // " " // trim(adjustl(pl%info(collidx(i))%name)) - write(idstr, '(I10)') pl%id(collidx(i)) - collider_message = trim(adjustl(collider_message)) // " (" // trim(adjustl(idstr)) // ") " - end do - end select - - return - end subroutine collision_resolve_collider_message - function collision_resolve_consolidate_impactors(pl, cb, param, idx_parent, impactors) result(lflag) !! author: David A. Minton @@ -267,16 +150,16 @@ function collision_resolve_consolidate_impactors(pl, cb, param, idx_parent, impa end function collision_resolve_consolidate_impactors - module subroutine collision_resolve_extract_plpl(self, system, param) + module subroutine collision_resolve_extract_plpl(self, nbody_system, param) !! author: David A. Minton !! !! Processes the pl-pl encounter list remove only those encounters that led to a collision !! implicit none ! Arguments - class(collision_list_plpl), intent(inout) :: self !! pl-pl encounter list - class(base_nbody_system), intent(inout) :: system !! Swiftest nbody system object - class(base_parameters), intent(in) :: param !! Current run configuration parameters + class(collision_list_plpl), intent(inout) :: self !! pl-pl encounter list + class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object + class(base_parameters), intent(in) :: param !! Current run configuration parameters ! Internals logical, dimension(:), allocatable :: lplpl_collision logical, dimension(:), allocatable :: lplpl_unique_parent @@ -284,9 +167,9 @@ module subroutine collision_resolve_extract_plpl(self, system, param) integer(I4B), dimension(:), allocatable :: collision_idx, unique_parent_idx integer(I4B) :: i, index_coll, ncollisions, nunique_parent, nplplenc - select type(system) + select type(nbody_system) class is (swiftest_nbody_system) - select type (pl => system%pl) + select type (pl => nbody_system%pl) class is (swiftest_pl) associate(plpl_encounter => self, idx1 => self%index1, idx2 => self%index2, plparent => pl%kin%parent) nplplenc = plpl_encounter%nenc @@ -330,7 +213,7 @@ module subroutine collision_resolve_extract_plpl(self, system, param) ! Create a mask that contains only the pl-pl encounters that did not result in a collision, and then discard them lplpl_collision(:) = .false. lplpl_collision(collision_idx(:)) = .true. - call plpl_encounter%spill(system%plpl_collision, lplpl_collision, ldestructive=.true.) ! Extract any encounters that are not collisions from the list. + call plpl_encounter%spill(nbody_system%plpl_collision, lplpl_collision, ldestructive=.true.) ! Extract any encounters that are not collisions from the list. end associate end select end select @@ -338,16 +221,59 @@ module subroutine collision_resolve_extract_plpl(self, system, param) return end subroutine collision_resolve_extract_plpl - module subroutine collision_resolve_extract_pltp(self, system, param) + + module subroutine collision_resolve_extract_pltp(self, nbody_system, param) implicit none class(collision_list_pltp), intent(inout) :: self !! pl-tp encounter list - class(base_nbody_system), intent(inout) :: system !! Swiftest nbody system object - class(base_parameters), intent(in) :: param !! Current run configuration parameters + class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object + class(base_parameters), intent(in) :: param !! Current run configuration parameters return end subroutine collision_resolve_extract_pltp + subroutine collision_resolve_list(plpl_collision, nbody_system, param, t) + !! author: David A. Minton + !! + !! Process list of collisions, determine the collisional regime, and then create fragments. + !! + implicit none + ! Arguments + class(collision_list_plpl), intent(inout) :: plpl_collision !! Swiftest pl-pl encounter list + class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object + class(base_parameters), intent(inout) :: param !! Current run configuration parameters with Swiftest additions + real(DP), intent(in) :: t !! Time of collision + ! Internals + ! Internals + integer(I4B), dimension(2) :: idx_parent !! Index of the two bodies considered the "parents" of the collision + logical :: lgoodcollision + integer(I4B) :: i + + select type(nbody_system) + class is (swiftest_nbody_system) + associate(ncollisions => plpl_collision%nenc, idx1 => plpl_collision%index1, idx2 => plpl_collision%index2, & + collision_history => nbody_system%collision_history, impactors => nbody_system%collider%impactors, & + fragments => nbody_system%collider%fragments, & + pl => nbody_system%pl, cb => nbody_system%cb) + do i = 1, ncollisions + idx_parent(1) = pl%kin(idx1(i))%parent + idx_parent(2) = pl%kin(idx2(i))%parent + lgoodcollision = collision_resolve_consolidate_impactors(pl, cb, param, idx_parent, impactors) + if ((.not. lgoodcollision) .or. any(pl%status(idx_parent(:)) /= COLLIDED)) cycle + + call impactors%get_regime(nbody_system, param) + call collision_history%take_snapshot(param,nbody_system, t, "before") + call nbody_system%collider%generate(nbody_system, param, t) + call collision_history%take_snapshot(param,nbody_system, t, "after") + call impactors%reset() + + end do + end associate + end select + return + end subroutine collision_resolve_list + + module subroutine collision_resolve_make_impactors_pl(pl, idx) !! author: Jennifer L.L. Pouplin, Carlisle A. wishard, and David A. Minton !! @@ -411,7 +337,7 @@ module subroutine collision_resolve_make_impactors_pl(pl, idx) end subroutine collision_resolve_make_impactors_pl - module subroutine collision_resolve_mergeaddsub(system, param, t, status) + module subroutine collision_resolve_mergeaddsub(nbody_system, param, t, status) !! author: David A. Minton !! !! Fills the pl_discards and pl_adds with removed and added bodies @@ -419,7 +345,7 @@ module subroutine collision_resolve_mergeaddsub(system, param, t, status) use symba, only : symba_pl implicit none ! Arguments - class(base_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(base_parameters), intent(inout) :: param !! Current run configuration parameters with Swiftest additions real(DP), intent(in) :: t !! Time of collision integer(I4B), intent(in) :: status !! Status flag to assign to adds @@ -430,18 +356,18 @@ module subroutine collision_resolve_mergeaddsub(system, param, t, status) character(*), parameter :: FRAGFMT = '("Newbody",I0.7)' character(len=NAMELEN) :: newname, origin_type - select type(system) + select type(nbody_system) class is (swiftest_nbody_system) select type(param) class is (swiftest_parameters) - associate(pl => system%pl, pl_discards => system%pl_discards, info => system%pl%info, pl_adds => system%pl_adds, cb => system%cb, npl => pl%nbody, & - collision_system => system%collision_system, impactors => system%collision_system%impactors,fragments => system%collision_system%fragments) + associate(pl => nbody_system%pl, pl_discards => nbody_system%pl_discards, info => nbody_system%pl%info, pl_adds => nbody_system%pl_adds, cb => nbody_system%cb, npl => pl%nbody, & + collision_system => nbody_system%collider, impactors => nbody_system%collider%impactors,fragments => nbody_system%collider%fragments) ! Add the impactors%id bodies to the subtraction list nimpactors = impactors%ncoll nfrag = fragments%nbody - param%maxid_collision = max(param%maxid_collision, maxval(system%pl%info(:)%collision_id)) + param%maxid_collision = max(param%maxid_collision, maxval(nbody_system%pl%info(:)%collision_id)) param%maxid_collision = param%maxid_collision + 1 ! Setup new bodies @@ -588,49 +514,7 @@ module subroutine collision_resolve_mergeaddsub(system, param, t, status) end subroutine collision_resolve_mergeaddsub - subroutine collision_resolve_list(plpl_collision , system, param, t) - !! author: David A. Minton - !! - !! Process list of collisions, determine the collisional regime, and then create fragments. - !! - implicit none - ! Arguments - class(collision_list_plpl), intent(inout) :: plpl_collision !! Swiftest pl-pl encounter list - class(base_nbody_system), intent(inout) :: system !! Swiftest nbody system object - class(base_parameters), intent(inout) :: param !! Current run configuration parameters with Swiftest additions - real(DP), intent(in) :: t !! Time of collision - ! Internals - ! Internals - integer(I4B), dimension(2) :: idx_parent !! Index of the two bodies considered the "parents" of the collision - logical :: lgoodcollision - integer(I4B) :: i - - select type(system) - class is (swiftest_nbody_system) - associate(ncollisions => plpl_collision%nenc, idx1 => plpl_collision%index1, idx2 => plpl_collision%index2, collision_history => system%collision_history, & - collision_system => system%collision_system, impactors => system%collision_system%impactors, fragments => system%collision_system%fragments, & - pl => system%pl, cb => system%cb) - do i = 1, ncollisions - idx_parent(1) = pl%kin(idx1(i))%parent - idx_parent(2) = pl%kin(idx2(i))%parent - lgoodcollision = collision_resolve_consolidate_impactors(pl, cb, param, idx_parent, impactors) - if ((.not. lgoodcollision) .or. any(pl%status(idx_parent(:)) /= COLLIDED)) cycle - - call impactors%get_regime(system, param) - call collision_history%take_snapshot(param,system, t, "before") - - call collision_system%generate(system, param, t) - - call collision_history%take_snapshot(param,system, t, "after") - call impactors%reset() - end do - end associate - end select - return - end subroutine collision_resolve_list - - - module subroutine collision_resolve_plpl(self, system, param, t, dt, irec) + module subroutine collision_resolve_plpl(self, nbody_system, param, t, dt, irec) !! author: David A. Minton !! !! Process the pl-pl collision list, then modifiy the massive bodies based on the outcome of the collision @@ -638,7 +522,7 @@ module subroutine collision_resolve_plpl(self, system, param, t, dt, irec) implicit none ! Arguments class(collision_list_plpl), intent(inout) :: self !! Swiftest pl-pl encounter list - class(base_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(base_parameters), intent(inout) :: param !! Current run configuration parameters with Swiftest additions real(DP), intent(in) :: t !! Current simulation time real(DP), intent(in) :: dt !! Current simulation step size @@ -649,63 +533,63 @@ module subroutine collision_resolve_plpl(self, system, param, t, dt, irec) character(len=STRMAX) :: timestr class(swiftest_parameters), allocatable :: tmp_param - select type (system) + select type (nbody_system) class is (swiftest_nbody_system) - select type(pl => system%pl) + select type(pl => nbody_system%pl) class is (swiftest_pl) select type(param) class is (swiftest_parameters) - associate(plpl_encounter => self, plpl_collision => system%plpl_collision) + associate(plpl_encounter => self, plpl_collision => nbody_system%plpl_collision) if (plpl_collision%nenc == 0) return ! No collisions to resolve ! Make sure that the heliocentric and barycentric coordinates are consistent with each other - call pl%vb2vh(system%cb) - call pl%rh2rb(system%cb) + call pl%vb2vh(nbody_system%cb) + call pl%rh2rb(nbody_system%cb) ! Get the energy before the collision is resolved if (param%lenergy) then - call system%get_energy_and_momentum(param) - Eorbit_before = system%te + call nbody_system%get_energy_and_momentum(param) + Eorbit_before = nbody_system%te end if do write(timestr,*) t - ! call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, "") - ! call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, "***********************************************************" // & - ! "***********************************************************") - ! call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, "Collision between massive bodies detected at time t = " // & - ! trim(adjustl(timestr))) - ! call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, "***********************************************************" // & - ! "***********************************************************") + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "") + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "***********************************************************" // & + "***********************************************************") + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Collision between massive bodies detected at time t = " // & + trim(adjustl(timestr))) + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "***********************************************************" // & + "***********************************************************") allocate(tmp_param, source=param) - call collision_resolve_list(plpl_collision, system, param, t) + call collision_resolve_list(plpl_collision, nbody_system, param, t) ! Destroy the collision list now that the collisions are resolved call plpl_collision%setup(0_I8B) - if ((system%pl_adds%nbody == 0) .and. (system%pl_discards%nbody == 0)) exit + if ((nbody_system%pl_adds%nbody == 0) .and. (nbody_system%pl_discards%nbody == 0)) exit ! Save the add/discard information to file - call system%write_discard(tmp_param) + call nbody_system%write_discard(tmp_param) ! Rearrange the arrays: Remove discarded bodies, add any new bodies, resort, and recompute all indices and encounter lists - call pl%rearray(system, tmp_param) + call pl%rearray(nbody_system, tmp_param) ! Destroy the add/discard list so that we don't append the same body multiple times if another collision is detected - call system%pl_discards%setup(0, param) - call system%pl_adds%setup(0, param) + call nbody_system%pl_discards%setup(0, param) + call nbody_system%pl_adds%setup(0, param) deallocate(tmp_param) ! Check whether or not any of the particles that were just added are themselves in a collision state. This will generate a new plpl_collision - call plpl_encounter%collision_check(system, param, t, dt, irec, lplpl_collision) + call plpl_encounter%collision_check(nbody_system, param, t, dt, irec, lplpl_collision) if (.not.lplpl_collision) exit end do if (param%lenergy) then - call system%get_energy_and_momentum(param) - Eorbit_after = system%te - system%Ecollisions = system%Ecollisions + (Eorbit_after - Eorbit_before) + call nbody_system%get_energy_and_momentum(param) + Eorbit_after = nbody_system%te + nbody_system%Ecollisions = nbody_system%Ecollisions + (Eorbit_after - Eorbit_before) end if end associate @@ -717,7 +601,7 @@ module subroutine collision_resolve_plpl(self, system, param, t, dt, irec) end subroutine collision_resolve_plpl - module subroutine collision_resolve_pltp(self, system, param, t, dt, irec) + module subroutine collision_resolve_pltp(self, nbody_system, param, t, dt, irec) !! author: David A. Minton !! !! Process the pl-tp collision list, then modifiy the massive bodies based on the outcome of the collision @@ -725,24 +609,24 @@ module subroutine collision_resolve_pltp(self, system, param, t, dt, irec) implicit none ! Arguments class(collision_list_pltp), intent(inout) :: self !! Swiftest pl-pl encounter list - class(base_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(base_parameters), intent(inout) :: param !! Current run configuration parameters with Swiftest additions real(DP), intent(in) :: t !! Current simulation tim real(DP), intent(in) :: dt !! Current simulation step size integer(I4B), intent(in) :: irec !! Current recursion level ! Make sure coordinate systems are all synced up due to being inside the recursion at this point - select type(system) + select type(nbody_system) class is (swiftest_nbody_system) select type(param) class is (swiftest_parameters) - call system%pl%vb2vh(system%cb) - call system%tp%vb2vh(system%cb%vb) - call system%pl%b2h(system%cb) - call system%tp%b2h(system%cb) + call nbody_system%pl%vb2vh(nbody_system%cb) + call nbody_system%tp%vb2vh(nbody_system%cb%vb) + call nbody_system%pl%b2h(nbody_system%cb) + call nbody_system%tp%b2h(nbody_system%cb) ! Discard the collider - call system%tp%discard(system, param) + call nbody_system%tp%discard(nbody_system, param) end select end select diff --git a/src/collision/collision_util.f90 b/src/collision/collision_util.f90 index 47a341f61..9898e3710 100644 --- a/src/collision/collision_util.f90 +++ b/src/collision/collision_util.f90 @@ -11,22 +11,22 @@ use swiftest contains - module subroutine collision_util_add_fragments_to_system(self, system, param) + module subroutine collision_util_add_fragments_to_system(self, nbody_system, param) !! Author: David A. Minton !! !! Adds fragments to the temporary system pl object implicit none ! Arguments class(collision_system), intent(in) :: self !! Collision system system object - class(base_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(base_parameters), intent(in) :: param !! Current swiftest run configuration parameters ! Internals integer(I4B) :: i, npl_before, npl_after logical, dimension(:), allocatable :: lexclude - select type(system) + select type(nbody_system) class is (swiftest_nbody_system) - associate(fragments => self%fragments, impactors => self%impactors, nfrag => self%fragments%nbody, pl => system%pl, cb => system%cb) + associate(fragments => self%fragments, impactors => self%impactors, nfrag => self%fragments%nbody, pl => nbody_system%pl, cb => nbody_system%cb) npl_after = pl%nbody npl_before = npl_after - nfrag allocate(lexclude(npl_after)) @@ -129,9 +129,9 @@ module subroutine collision_util_get_idvalues_snapshot(self, idvals) ! Internals integer(I4B) :: npl_before, ntp_before, npl_after, ntp_after, ntot, nlo, nhi - select type(before => self%collision_system%before) + select type(before => self%collider%before) class is (swiftest_nbody_system) - select type(after => self%collision_system%after) + select type(after => self%collider%after) class is (swiftest_nbody_system) npl_before = 0; ntp_before = 0; npl_after = 0; ntp_after = 0 if (allocated(before%pl)) then @@ -171,7 +171,7 @@ module subroutine collision_util_get_idvalues_snapshot(self, idvals) end subroutine collision_util_get_idvalues_snapshot - module subroutine collision_util_get_energy_momentum(self, system, param, lbefore) + module subroutine collision_util_get_energy_momentum(self, nbody_system, param, lbefore) !! Author: David A. Minton !! !! Calculates total system energy in either the pre-collision outcome state (lbefore = .true.) or the post-collision outcome state (lbefore = .false.) @@ -181,19 +181,19 @@ module subroutine collision_util_get_energy_momentum(self, system, param, lbefo implicit none ! Arguments class(collision_system), intent(inout) :: self !! Encounter collision system object - class(base_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(base_parameters), intent(inout) :: param !! Current swiftest run configuration parameters - logical, intent(in) :: lbefore !! Flag indicating that this the "before" state of the system, with impactors included and fragments excluded or vice versa + logical, intent(in) :: lbefore !! Flag indicating that this the "before" state of the nbody_system, with impactors included and fragments excluded or vice versa ! Internals class(base_nbody_system), allocatable, save :: tmpsys class(base_parameters), allocatable, save :: tmpparam integer(I4B) :: npl_before, npl_after, stage - select type(system) + select type(nbody_system) class is (swiftest_nbody_system) select type(param) class is (swiftest_parameters) - associate(fragments => self%fragments, impactors => self%impactors, nfrag => self%fragments%nbody, pl => system%pl, cb => system%cb) + associate(fragments => self%fragments, impactors => self%impactors, nfrag => self%fragments%nbody, pl => nbody_system%pl, cb => nbody_system%cb) ! Because we're making a copy of the massive body object with the excludes/fragments appended, we need to deallocate the ! big k_plpl array and recreate it when we're done, otherwise we run the risk of blowing up the memory by @@ -204,7 +204,7 @@ module subroutine collision_util_get_energy_momentum(self, system, param, lbefo npl_after = npl_before + nfrag if (lbefore) then - call self%construct_temporary_system(system, param, tmpsys, tmpparam) + call self%construct_temporary_system(nbody_system, param, tmpsys, tmpparam) select type(tmpsys) class is (swiftest_nbody_system) ! Build the exluded body logical mask for the *before* case: Only the original bodies are used to compute energy and momentum @@ -346,7 +346,7 @@ end subroutine collision_util_reset_fragments module subroutine collision_util_reset_system(self) !! author: David A. Minton !! - !! Resets the collider system and deallocates all allocatables + !! Resets the collider nbody_system and deallocates all allocatables implicit none ! Arguments class(collision_system), intent(inout) :: self !! Collision system object @@ -372,10 +372,10 @@ end subroutine collision_util_reset_system module subroutine collision_util_set_coordinate_system(self) !! author: David A. Minton !! - !! Defines the collisional coordinate system, including the unit vectors of both the system and individual fragments. + !! Defines the collisional coordinate nbody_system, including the unit vectors of both the nbody_system and individual fragments. implicit none ! Arguments - class(collision_system), intent(inout) :: self !! Collisional system + class(collision_system), intent(inout) :: self !! Collisional nbody_system ! Internals integer(I4B) :: i real(DP), dimension(NDIM) :: delta_r, delta_v, Ltot @@ -386,7 +386,7 @@ module subroutine collision_util_set_coordinate_system(self) delta_v(:) = impactors%vb(:, 2) - impactors%vb(:, 1) delta_r(:) = impactors%rb(:, 2) - impactors%rb(:, 1) - ! We will initialize fragments on a plane defined by the pre-impact system, with the z-axis aligned with the angular momentum vector + ! We will initialize fragments on a plane defined by the pre-impact nbody_system, with the z-axis aligned with the angular momentum vector ! and the y-axis aligned with the pre-impact distance vector. ! y-axis is the separation distance @@ -410,7 +410,7 @@ module subroutine collision_util_set_coordinate_system(self) fragments%rmag(:) = .mag. fragments%rc(:,:) ! Randomize the tangential velocity direction. - ! This helps to ensure that the tangential velocity doesn't completely line up with the angular momentum vector, otherwise we can get an ill-conditioned system + ! This helps to ensure that the tangential velocity doesn't completely line up with the angular momentum vector, otherwise we can get an ill-conditioned nbody_system call random_number(L_sigma(:,:)) do concurrent(i = 1:nfrag, fragments%rmag(i) > 0.0_DP) fragments%v_n_unit(:, i) = impactors%z_unit(:) + 2e-1_DP * (L_sigma(:,i) - 0.5_DP) @@ -472,17 +472,17 @@ subroutine collision_util_save_snapshot(collision_history, snapshot) end subroutine collision_util_save_snapshot - module subroutine collision_util_snapshot(self, param, system, t, arg) + module subroutine collision_util_snapshot(self, param, nbody_system, t, arg) !! author: David A. Minton !! - !! Takes a minimal snapshot of the state of the system during an encounter so that the trajectories + !! Takes a minimal snapshot of the state of the nbody_system during an encounter so that the trajectories !! can be played back through the encounter implicit none ! Internals class(collision_storage(*)), intent(inout) :: self !! Swiftest storage object class(base_parameters), intent(inout) :: param !! Current run configuration parameters - class(base_nbody_system), intent(inout) :: system !! Swiftest nbody system object to store - real(DP), intent(in), optional :: t !! Time of snapshot if different from system time + class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object to store + real(DP), intent(in), optional :: t !! Time of snapshot if different from nbody_system time character(*), intent(in), optional :: arg !! "before": takes a snapshot just before the collision. "after" takes the snapshot just after the collision. ! Arguments class(collision_snapshot), allocatable :: snapshot @@ -495,33 +495,33 @@ module subroutine collision_util_snapshot(self, param, system, t, arg) stage = "" end if - select type (system) + select type (nbody_system) class is (swiftest_nbody_system) select type(param) class is (swiftest_parameters) select case(stage) case("before") ! Saves the states of the bodies involved in the collision before the collision is resolved - associate (idx => system%collision_system%impactors%id, ncoll => system%collision_system%impactors%ncoll) + associate (idx => nbody_system%collider%impactors%id, ncoll => nbody_system%collider%impactors%ncoll) call pl%setup(ncoll, param) - pl%id(:) = system%pl%id(idx(:)) - pl%Gmass(:) = system%pl%Gmass(idx(:)) - pl%radius(:) = system%pl%radius(idx(:)) - pl%rot(:,:) = system%pl%rot(:,idx(:)) - pl%Ip(:,:) = system%pl%Ip(:,idx(:)) - pl%rh(:,:) = system%pl%rh(:,idx(:)) - pl%vh(:,:) = system%pl%vh(:,idx(:)) - pl%info(:) = system%pl%info(idx(:)) - select type (before => system%collision_system%before) + pl%id(:) = nbody_system%pl%id(idx(:)) + pl%Gmass(:) = nbody_system%pl%Gmass(idx(:)) + pl%radius(:) = nbody_system%pl%radius(idx(:)) + pl%rot(:,:) = nbody_system%pl%rot(:,idx(:)) + pl%Ip(:,:) = nbody_system%pl%Ip(:,idx(:)) + pl%rh(:,:) = nbody_system%pl%rh(:,idx(:)) + pl%vh(:,:) = nbody_system%pl%vh(:,idx(:)) + pl%info(:) = nbody_system%pl%info(idx(:)) + select type (before => nbody_system%collider%before) class is (swiftest_nbody_system) allocate(before%pl, source=pl) end select end associate case("after") allocate(collision_snapshot :: snapshot) - allocate(snapshot%collision_system, source=system%collision_system) + allocate(snapshot%collider, source=nbody_system%collider) snapshot%t = t - call collision_util_save_snapshot(system%collision_history,snapshot) + call collision_util_save_snapshot(nbody_system%collision_history,snapshot) case default write(*,*) "collision_util_snapshot requies either 'before' or 'after' passed to 'arg'" end select diff --git a/src/encounter/encounter_io.f90 b/src/encounter/encounter_io.f90 index c5b68b98c..4b572af9d 100644 --- a/src/encounter/encounter_io.f90 +++ b/src/encounter/encounter_io.f90 @@ -7,11 +7,11 @@ !! You should have received a copy of the GNU General Public License along with Swiftest. !! If not, see: https://www.gnu.org/licenses. -submodule (encounter) s_encounter_netcdf_io +submodule (encounter) s_encounter_io_netcdf use swiftest contains - module subroutine encounter_netcdf_io_dump(self, param) + module subroutine encounter_io_netcdf_dump(self, param) ! author: David A. Minton !! !! Dumps the time history of an encounter to file. @@ -51,10 +51,10 @@ module subroutine encounter_netcdf_io_dump(self, param) end select return - end subroutine encounter_netcdf_io_dump + end subroutine encounter_io_netcdf_dump - module subroutine encounter_netcdf_io_initialize_output(self, param) + module subroutine encounter_io_netcdf_initialize_output(self, param) !! author: David A. Minton !! !! Initialize a NetCDF encounter file system. This is a simplified version of the main simulation output NetCDF file, but with fewer variables. @@ -93,55 +93,55 @@ module subroutine encounter_netcdf_io_initialize_output(self, param) close(unit=LUN, status="delete") end if - call netcdf_io_check( nf90_create(nc%file_name, NF90_NETCDF4, nc%id), "encounter_netcdf_io_initialize_output nf90_create" ) + call netcdf_io_check( nf90_create(nc%file_name, NF90_NETCDF4, nc%id), "encounter_io_netcdf_initialize_output nf90_create" ) nc%lfile_is_open = .true. ! Dimensions - call netcdf_io_check( nf90_def_dim(nc%id, nc%time_dimname, nc%time_dimsize, nc%time_dimid), "encounter_netcdf_io_initialize_output nf90_def_dim time_dimid" ) ! Simulation time dimension - call netcdf_io_check( nf90_def_dim(nc%id, nc%space_dimname, NDIM, nc%space_dimid), "encounter_netcdf_io_initialize_output nf90_def_dim space_dimid" ) ! 3D space dimension - call netcdf_io_check( nf90_def_dim(nc%id, nc%name_dimname, nc%name_dimsize, nc%name_dimid), "encounter_netcdf_io_initialize_output nf90_def_dim name_dimid" ) ! dimension to store particle id numbers - call netcdf_io_check( nf90_def_dim(nc%id, nc%str_dimname, NAMELEN, nc%str_dimid), "encounter_netcdf_io_initialize_output nf90_def_dim str_dimid" ) ! Dimension for string variables (aka character arrays) + call netcdf_io_check( nf90_def_dim(nc%id, nc%time_dimname, nc%time_dimsize, nc%time_dimid), "encounter_io_netcdf_initialize_output nf90_def_dim time_dimid" ) ! Simulation time dimension + call netcdf_io_check( nf90_def_dim(nc%id, nc%space_dimname, NDIM, nc%space_dimid), "encounter_io_netcdf_initialize_output nf90_def_dim space_dimid" ) ! 3D space dimension + call netcdf_io_check( nf90_def_dim(nc%id, nc%name_dimname, nc%name_dimsize, nc%name_dimid), "encounter_io_netcdf_initialize_output nf90_def_dim name_dimid" ) ! dimension to store particle id numbers + call netcdf_io_check( nf90_def_dim(nc%id, nc%str_dimname, NAMELEN, nc%str_dimid), "encounter_io_netcdf_initialize_output nf90_def_dim str_dimid" ) ! Dimension for string variables (aka character arrays) ! Dimension coordinates - call netcdf_io_check( nf90_def_var(nc%id, nc%time_dimname, nc%out_type, nc%time_dimid, nc%time_varid), "encounter_netcdf_io_initialize_output nf90_def_var time_varid" ) - call netcdf_io_check( nf90_def_var(nc%id, nc%space_dimname, NF90_CHAR, nc%space_dimid, nc%space_varid), "encounter_netcdf_io_initialize_output nf90_def_var space_varid" ) - call netcdf_io_check( nf90_def_var(nc%id, nc%name_dimname, NF90_CHAR, [nc%str_dimid, nc%name_dimid], nc%name_varid), "encounter_netcdf_io_initialize_output nf90_def_var id_varid" ) + call netcdf_io_check( nf90_def_var(nc%id, nc%time_dimname, nc%out_type, nc%time_dimid, nc%time_varid), "encounter_io_netcdf_initialize_output nf90_def_var time_varid" ) + call netcdf_io_check( nf90_def_var(nc%id, nc%space_dimname, NF90_CHAR, nc%space_dimid, nc%space_varid), "encounter_io_netcdf_initialize_output nf90_def_var space_varid" ) + call netcdf_io_check( nf90_def_var(nc%id, nc%name_dimname, NF90_CHAR, [nc%str_dimid, nc%name_dimid], nc%name_varid), "encounter_io_netcdf_initialize_output nf90_def_var id_varid" ) ! Variables - call netcdf_io_check( nf90_def_var(nc%id, nc%id_varname, NF90_INT, nc%name_dimid, nc%id_varid), "encounter_netcdf_io_initialize_output nf90_def_var id_varid" ) - call netcdf_io_check( nf90_def_var(nc%id, nc%ptype_varname, NF90_CHAR, [nc%str_dimid, nc%name_dimid], nc%ptype_varid), "encounter_netcdf_io_initialize_output nf90_def_var ptype_varid" ) - call netcdf_io_check( nf90_def_var(nc%id, nc%rh_varname, nc%out_type, [nc%space_dimid, nc%name_dimid, nc%time_dimid], nc%rh_varid), "encounter_netcdf_io_initialize_output nf90_def_var rh_varid" ) - call netcdf_io_check( nf90_def_var(nc%id, nc%vh_varname, nc%out_type, [nc%space_dimid, nc%name_dimid, nc%time_dimid], nc%vh_varid), "encounter_netcdf_io_initialize_output nf90_def_var vh_varid" ) - call netcdf_io_check( nf90_def_var(nc%id, nc%Gmass_varname, nc%out_type, [nc%name_dimid, nc%time_dimid], nc%Gmass_varid), "encounter_netcdf_io_initialize_output nf90_def_var Gmass_varid" ) - call netcdf_io_check( nf90_def_var(nc%id, nc%loop_varname, NF90_INT, [nc%time_dimid], nc%loop_varid), "encounter_netcdf_io_initialize_output nf90_def_var loop_varid" ) + call netcdf_io_check( nf90_def_var(nc%id, nc%id_varname, NF90_INT, nc%name_dimid, nc%id_varid), "encounter_io_netcdf_initialize_output nf90_def_var id_varid" ) + call netcdf_io_check( nf90_def_var(nc%id, nc%ptype_varname, NF90_CHAR, [nc%str_dimid, nc%name_dimid], nc%ptype_varid), "encounter_io_netcdf_initialize_output nf90_def_var ptype_varid" ) + call netcdf_io_check( nf90_def_var(nc%id, nc%rh_varname, nc%out_type, [nc%space_dimid, nc%name_dimid, nc%time_dimid], nc%rh_varid), "encounter_io_netcdf_initialize_output nf90_def_var rh_varid" ) + call netcdf_io_check( nf90_def_var(nc%id, nc%vh_varname, nc%out_type, [nc%space_dimid, nc%name_dimid, nc%time_dimid], nc%vh_varid), "encounter_io_netcdf_initialize_output nf90_def_var vh_varid" ) + call netcdf_io_check( nf90_def_var(nc%id, nc%Gmass_varname, nc%out_type, [nc%name_dimid, nc%time_dimid], nc%Gmass_varid), "encounter_io_netcdf_initialize_output nf90_def_var Gmass_varid" ) + call netcdf_io_check( nf90_def_var(nc%id, nc%loop_varname, NF90_INT, [nc%time_dimid], nc%loop_varid), "encounter_io_netcdf_initialize_output nf90_def_var loop_varid" ) if (param%lclose) then - call netcdf_io_check( nf90_def_var(nc%id, nc%radius_varname, nc%out_type, [nc%name_dimid, nc%time_dimid], nc%radius_varid), "encounter_netcdf_io_initialize_output nf90_def_var radius_varid" ) + call netcdf_io_check( nf90_def_var(nc%id, nc%radius_varname, nc%out_type, [nc%name_dimid, nc%time_dimid], nc%radius_varid), "encounter_io_netcdf_initialize_output nf90_def_var radius_varid" ) end if if (param%lrotation) then - call netcdf_io_check( nf90_def_var(nc%id, nc%Ip_varname, nc%out_type, [nc%space_dimid, nc%name_dimid, nc%time_dimid], nc%Ip_varid), "encounter_netcdf_io_initialize_output nf90_def_var Ip_varid" ) - call netcdf_io_check( nf90_def_var(nc%id, nc%rot_varname, nc%out_type, [nc%space_dimid, nc%name_dimid, nc%time_dimid], nc%rot_varid), "encounter_netcdf_io_initialize_output nf90_def_var rot_varid" ) + call netcdf_io_check( nf90_def_var(nc%id, nc%Ip_varname, nc%out_type, [nc%space_dimid, nc%name_dimid, nc%time_dimid], nc%Ip_varid), "encounter_io_netcdf_initialize_output nf90_def_var Ip_varid" ) + call netcdf_io_check( nf90_def_var(nc%id, nc%rot_varname, nc%out_type, [nc%space_dimid, nc%name_dimid, nc%time_dimid], nc%rot_varid), "encounter_io_netcdf_initialize_output nf90_def_var rot_varid" ) end if - call netcdf_io_check( nf90_inquire(nc%id, nVariables=nvar), "encounter_netcdf_io_initialize_output nf90_inquire nVariables" ) + call netcdf_io_check( nf90_inquire(nc%id, nVariables=nvar), "encounter_io_netcdf_initialize_output nf90_inquire nVariables" ) do varid = 1, nvar - call netcdf_io_check( nf90_inquire_variable(nc%id, varid, xtype=vartype, ndims=ndims), "encounter_netcdf_io_initialize_output nf90_inquire_variable" ) + call netcdf_io_check( nf90_inquire_variable(nc%id, varid, xtype=vartype, ndims=ndims), "encounter_io_netcdf_initialize_output nf90_inquire_variable" ) select case(vartype) case(NF90_INT) - call netcdf_io_check( nf90_def_var_fill(nc%id, varid, NO_FILL, NF90_FILL_INT), "encounter_netcdf_io_initialize_output nf90_def_var_fill NF90_INT" ) + call netcdf_io_check( nf90_def_var_fill(nc%id, varid, NO_FILL, NF90_FILL_INT), "encounter_io_netcdf_initialize_output nf90_def_var_fill NF90_INT" ) case(NF90_FLOAT) - call netcdf_io_check( nf90_def_var_fill(nc%id, varid, NO_FILL, sfill), "encounter_netcdf_io_initialize_output nf90_def_var_fill NF90_FLOAT" ) + call netcdf_io_check( nf90_def_var_fill(nc%id, varid, NO_FILL, sfill), "encounter_io_netcdf_initialize_output nf90_def_var_fill NF90_FLOAT" ) case(NF90_DOUBLE) - call netcdf_io_check( nf90_def_var_fill(nc%id, varid, NO_FILL, dfill), "encounter_netcdf_io_initialize_output nf90_def_var_fill NF90_DOUBLE" ) + call netcdf_io_check( nf90_def_var_fill(nc%id, varid, NO_FILL, dfill), "encounter_io_netcdf_initialize_output nf90_def_var_fill NF90_DOUBLE" ) case(NF90_CHAR) - call netcdf_io_check( nf90_def_var_fill(nc%id, varid, NO_FILL, 0), "encounter_netcdf_io_initialize_output nf90_def_var_fill NF90_CHAR" ) + call netcdf_io_check( nf90_def_var_fill(nc%id, varid, NO_FILL, 0), "encounter_io_netcdf_initialize_output nf90_def_var_fill NF90_CHAR" ) end select end do ! Take the file out of define mode - call netcdf_io_check( nf90_enddef(nc%id), "encounter_netcdf_io_initialize_output nf90_enddef" ) + call netcdf_io_check( nf90_enddef(nc%id), "encounter_io_netcdf_initialize_output nf90_enddef" ) ! Add in the space dimension coordinates - call netcdf_io_check( nf90_put_var(nc%id, nc%space_varid, nc%space_coords, start=[1], count=[NDIM]), "encounter_netcdf_io_initialize_output nf90_put_var space" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%space_varid, nc%space_coords, start=[1], count=[NDIM]), "encounter_io_netcdf_initialize_output nf90_put_var space" ) end associate @@ -150,10 +150,10 @@ module subroutine encounter_netcdf_io_initialize_output(self, param) 667 continue write(*,*) "Error creating encounter output file. " // trim(adjustl(errmsg)) call util_exit(FAILURE) - end subroutine encounter_netcdf_io_initialize_output + end subroutine encounter_io_netcdf_initialize_output - module subroutine encounter_netcdf_io_write_frame_snapshot(self, history, param) + module subroutine encounter_io_netcdf_write_frame_snapshot(self, history, param) !! author: David A. Minton !! !! Write a frame of output of an encounter trajectory. @@ -177,43 +177,43 @@ module subroutine encounter_netcdf_io_write_frame_snapshot(self, history, param) select type (nc => history%nc) class is (encounter_netcdf_parameters) associate(tslot => param%ioutput) - call netcdf_io_check( nf90_set_fill(nc%id, nf90_nofill, old_mode), "encounter_netcdf_io_write_frame_snapshot nf90_set_fill" ) + call netcdf_io_check( nf90_set_fill(nc%id, nf90_nofill, old_mode), "encounter_io_netcdf_write_frame_snapshot nf90_set_fill" ) - call netcdf_io_check( nf90_put_var(nc%id, nc%time_varid, self%t, start=[tslot]), "encounter_netcdf_io_write_frame_snapshot nf90_put_var time_varid" ) - call netcdf_io_check( nf90_put_var(nc%id, nc%loop_varid, int(self%iloop,kind=I4B), start=[tslot]), "encounter_netcdf_io_write_frame_snapshot nf90_put_var pl loop_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%time_varid, self%t, start=[tslot]), "encounter_io_netcdf_write_frame_snapshot nf90_put_var time_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%loop_varid, int(self%iloop,kind=I4B), start=[tslot]), "encounter_io_netcdf_write_frame_snapshot nf90_put_var pl loop_varid" ) npl = pl%nbody do i = 1, npl idslot = findloc(history%idvals,pl%id(i),dim=1) - call netcdf_io_check( nf90_put_var(nc%id, nc%id_varid, pl%id(i), start=[idslot]), "encounter_netcdf_io_write_frame_snapshot nf90_put_var pl id_varid" ) - call netcdf_io_check( nf90_put_var(nc%id, nc%rh_varid, pl%rh(:,i), start=[1,idslot,tslot], count=[NDIM,1,1]), "encounter_netcdf_io_write_frame_snapshot nf90_put_var pl rh_varid" ) - call netcdf_io_check( nf90_put_var(nc%id, nc%vh_varid, pl%vh(:,i), start=[1,idslot,tslot], count=[NDIM,1,1]), "encounter_netcdf_io_write_frame_snapshot nf90_put_var pl vh_varid" ) - call netcdf_io_check( nf90_put_var(nc%id, nc%Gmass_varid, pl%Gmass(i), start=[idslot, tslot]), "encounter_netcdf_io_write_frame_snapshot nf90_put_var pl Gmass_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%id_varid, pl%id(i), start=[idslot]), "encounter_io_netcdf_write_frame_snapshot nf90_put_var pl id_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%rh_varid, pl%rh(:,i), start=[1,idslot,tslot], count=[NDIM,1,1]), "encounter_io_netcdf_write_frame_snapshot nf90_put_var pl rh_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%vh_varid, pl%vh(:,i), start=[1,idslot,tslot], count=[NDIM,1,1]), "encounter_io_netcdf_write_frame_snapshot nf90_put_var pl vh_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%Gmass_varid, pl%Gmass(i), start=[idslot, tslot]), "encounter_io_netcdf_write_frame_snapshot nf90_put_var pl Gmass_varid" ) - if (param%lclose) call netcdf_io_check( nf90_put_var(nc%id, nc%radius_varid, pl%radius(i), start=[idslot, tslot]), "encounter_netcdf_io_write_frame_snapshot nf90_put_var pl radius_varid" ) + if (param%lclose) call netcdf_io_check( nf90_put_var(nc%id, nc%radius_varid, pl%radius(i), start=[idslot, tslot]), "encounter_io_netcdf_write_frame_snapshot nf90_put_var pl radius_varid" ) if (param%lrotation) then - call netcdf_io_check( nf90_put_var(nc%id, nc%Ip_varid, pl%Ip(:,i), start=[1, idslot, tslot], count=[NDIM,1,1]), "encounter_netcdf_io_write_frame_snapshot nf90_put_var pl Ip_varid" ) - call netcdf_io_check( nf90_put_var(nc%id, nc%rot_varid, pl%rot(:,i), start=[1,idslot, tslot], count=[NDIM,1,1]), "encounter_netcdf_io_write_frame_snapshot nf90_put_var pl rotx_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%Ip_varid, pl%Ip(:,i), start=[1, idslot, tslot], count=[NDIM,1,1]), "encounter_io_netcdf_write_frame_snapshot nf90_put_var pl Ip_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%rot_varid, pl%rot(:,i), start=[1,idslot, tslot], count=[NDIM,1,1]), "encounter_io_netcdf_write_frame_snapshot nf90_put_var pl rotx_varid" ) end if charstring = trim(adjustl(pl%info(i)%name)) - call netcdf_io_check( nf90_put_var(nc%id, nc%name_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "encounter_netcdf_io_write_frame_snapshot nf90_put_var pl name_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%name_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "encounter_io_netcdf_write_frame_snapshot nf90_put_var pl name_varid" ) charstring = trim(adjustl(pl%info(i)%particle_type)) - call netcdf_io_check( nf90_put_var(nc%id, nc%ptype_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "encounter_netcdf_io_write_frame_snapshot nf90_put_var pl particle_type_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%ptype_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "encounter_io_netcdf_write_frame_snapshot nf90_put_var pl particle_type_varid" ) end do ntp = tp%nbody do i = 1, ntp idslot = findloc(history%idvals,tp%id(i),dim=1) - call netcdf_io_check( nf90_put_var(nc%id, nc%id_varid, tp%id(i), start=[idslot]), "encounter_netcdf_io_write_frame_snapshot nf90_put_var tp id_varid" ) - call netcdf_io_check( nf90_put_var(nc%id, nc%rh_varid, tp%rh(:,i), start=[1,idslot,tslot], count=[NDIM,1,1]), "encounter_netcdf_io_write_frame_snapshot nf90_put_var tp rh_varid" ) - call netcdf_io_check( nf90_put_var(nc%id, nc%vh_varid, tp%vh(:,i), start=[1,idslot,tslot], count=[NDIM,1,1]), "encounter_netcdf_io_write_frame_snapshot nf90_put_var tp vh_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%id_varid, tp%id(i), start=[idslot]), "encounter_io_netcdf_write_frame_snapshot nf90_put_var tp id_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%rh_varid, tp%rh(:,i), start=[1,idslot,tslot], count=[NDIM,1,1]), "encounter_io_netcdf_write_frame_snapshot nf90_put_var tp rh_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%vh_varid, tp%vh(:,i), start=[1,idslot,tslot], count=[NDIM,1,1]), "encounter_io_netcdf_write_frame_snapshot nf90_put_var tp vh_varid" ) charstring = trim(adjustl(tp%info(i)%name)) - call netcdf_io_check( nf90_put_var(nc%id, nc%name_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "encounter_netcdf_io_write_frame_snapshot nf90_put_var tp name_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%name_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "encounter_io_netcdf_write_frame_snapshot nf90_put_var tp name_varid" ) charstring = trim(adjustl(tp%info(i)%particle_type)) - call netcdf_io_check( nf90_put_var(nc%id, nc%ptype_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "encounter_netcdf_io_write_frame_snapshot nf90_put_var tp particle_type_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%ptype_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "encounter_io_netcdf_write_frame_snapshot nf90_put_var tp particle_type_varid" ) end do call netcdf_io_check( nf90_set_fill(nc%id, old_mode, old_mode) ) @@ -224,9 +224,6 @@ module subroutine encounter_netcdf_io_write_frame_snapshot(self, history, param) end select return - end subroutine encounter_netcdf_io_write_frame_snapshot + end subroutine encounter_io_netcdf_write_frame_snapshot - - - -end submodule s_encounter_netcdf_io \ No newline at end of file +end submodule s_encounter_io_netcdf \ No newline at end of file diff --git a/src/encounter/encounter_module.f90 b/src/encounter/encounter_module.f90 index d4d35db92..abb3c3422 100644 --- a/src/encounter/encounter_module.f90 +++ b/src/encounter/encounter_module.f90 @@ -53,7 +53,7 @@ module encounter real(DP) :: t !! Simulation time when snapshot was taken integer(I8B) :: iloop !! Loop number at time of snapshot contains - procedure :: write_frame => encounter_netcdf_io_write_frame_snapshot !! Writes a frame of encounter data to file + procedure :: write_frame => encounter_io_netcdf_write_frame_snapshot !! Writes a frame of encounter data to file procedure :: get_idvals => encounter_util_get_idvalues_snapshot !! Gets an array of all id values saved in this snapshot final :: encounter_final_snapshot end type encounter_snapshot @@ -66,7 +66,7 @@ module encounter integer(I4B) :: name_dimsize = 0 !! Number of potential id values in snapshot integer(I4B) :: file_number = 1 !! The number to append on the output file contains - procedure :: initialize => encounter_netcdf_io_initialize_output !! Initialize a set of parameters used to identify a NetCDF output object + procedure :: initialize => encounter_io_netcdf_initialize_output !! Initialize a set of parameters used to identify a NetCDF output object final :: encounter_final_netcdf_parameters !! Finalizer will close the NetCDF file end type encounter_netcdf_parameters @@ -75,7 +75,7 @@ module encounter type, extends(base_storage) :: encounter_storage class(encounter_netcdf_parameters), allocatable :: nc !! NetCDF object attached to this storage object contains - procedure :: dump => encounter_netcdf_io_dump !! Dumps contents of encounter history to file + procedure :: dump => encounter_io_netcdf_dump !! Dumps contents of encounter history to file procedure :: get_index_values => encounter_util_get_vals_storage !! Gets the unique values of the indices of a storage object (i.e. body id or time value) procedure :: make_index_map => encounter_util_index_map !! Maps body id values to storage index values so we don't have to use unlimited dimensions for id procedure :: take_snapshot => encounter_util_snapshot !! Take a minimal snapshot of the system through an encounter @@ -83,7 +83,6 @@ module encounter 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) @@ -110,7 +109,7 @@ module encounter module subroutine encounter_check_all_plpl(param, npl, x, v, renc, dt, nenc, index1, index2, lvdotr) use base, only: base_parameters implicit none - class(base_parameters), intent(inout) :: param !! Current Swiftest run configuration parameter5s + class(base_parameters), intent(inout) :: param !! Current Swiftest run configuration parameter5s integer(I4B), intent(in) :: npl !! Total number of massive bodies real(DP), dimension(:,:), intent(in) :: x !! Position vectors of massive bodies real(DP), dimension(:,:), intent(in) :: v !! Velocity vectors of massive bodies @@ -126,7 +125,7 @@ module subroutine encounter_check_all_plplm(param, nplm, nplt, xplm, vplm, xplt, nenc, index1, index2, lvdotr) use base, only: base_parameters implicit none - class(base_parameters), intent(inout) :: param !! Current Swiftest run configuration parameter5s + class(base_parameters), intent(inout) :: param !! Current Swiftest run configuration parameter5s integer(I4B), intent(in) :: nplm !! Total number of fully interacting massive bodies integer(I4B), intent(in) :: nplt !! Total number of partially interacting masive bodies (GM < GMTINY) real(DP), dimension(:,:), intent(in) :: xplm !! Position vectors of fully interacting massive bodies @@ -218,24 +217,24 @@ 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_netcdf_io_dump(self, param) + module subroutine encounter_io_netcdf_dump(self, param) implicit none class(encounter_storage(*)), intent(inout) :: self !! Encounter storage object class(base_parameters), intent(inout) :: param !! Current run configuration parameters - end subroutine encounter_netcdf_io_dump + end subroutine encounter_io_netcdf_dump - module subroutine encounter_netcdf_io_initialize_output(self, param) + module subroutine encounter_io_netcdf_initialize_output(self, param) implicit none class(encounter_netcdf_parameters), intent(inout) :: self !! Parameters used to identify a particular NetCDF dataset class(base_parameters), intent(in) :: param - end subroutine encounter_netcdf_io_initialize_output + end subroutine encounter_io_netcdf_initialize_output - module subroutine encounter_netcdf_io_write_frame_snapshot(self, history, param) + module subroutine encounter_io_netcdf_write_frame_snapshot(self, history, param) implicit none class(encounter_snapshot), intent(in) :: self !! Swiftest encounter structure class(encounter_storage(*)), intent(inout) :: history !! Encounter storage object class(base_parameters), intent(inout) :: param !! Current run configuration parameters - end subroutine encounter_netcdf_io_write_frame_snapshot + end subroutine encounter_io_netcdf_write_frame_snapshot module subroutine encounter_setup_aabb(self, n, n_last) implicit none @@ -297,13 +296,13 @@ module subroutine encounter_util_resize_list(self, nnew) integer(I8B), intent(in) :: nnew !! New size of list needed end subroutine encounter_util_resize_list - module subroutine encounter_util_snapshot(self, param, system, t, arg) + module subroutine encounter_util_snapshot(self, param, nbody_system, t, arg) implicit none - class(encounter_storage(*)), intent(inout) :: self !! Swiftest storage object - class(base_parameters), intent(inout) :: param !! Current run configuration parameters - class(base_nbody_system), intent(inout) :: system !! Swiftest nbody system object to store - real(DP), intent(in), optional :: t !! Time of snapshot if different from system time - character(*), intent(in), optional :: arg !! Optional argument (needed for extended storage type used in collision snapshots) + class(encounter_storage(*)), intent(inout) :: self !! Swiftest storage object + class(base_parameters), intent(inout) :: param !! Current run configuration parameters + class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object to store + real(DP), intent(in), optional :: t !! Time of snapshot if different from system time + character(*), intent(in), optional :: arg !! Optional argument (needed for extended storage type used in collision snapshots) end subroutine encounter_util_snapshot module subroutine encounter_util_spill_list(self, discards, lspill_list, ldestructive) diff --git a/src/encounter/encounter_util.f90 b/src/encounter/encounter_util.f90 index 5c26771a5..06648ca9f 100644 --- a/src/encounter/encounter_util.f90 +++ b/src/encounter/encounter_util.f90 @@ -368,7 +368,7 @@ subroutine encounter_util_save_snapshot(encounter_history, snapshot) end subroutine encounter_util_save_snapshot - module subroutine encounter_util_snapshot(self, param, system, t, arg) + module subroutine encounter_util_snapshot(self, param, nbody_system, t, arg) !! author: David A. Minton !! !! Takes a minimal snapshot of the state of the system during an encounter so that the trajectories @@ -378,7 +378,7 @@ module subroutine encounter_util_snapshot(self, param, system, t, arg) ! Internals class(encounter_storage(*)), intent(inout) :: self !! Swiftest storage object class(base_parameters), intent(inout) :: param !! Current run configuration parameters - class(base_nbody_system), intent(inout) :: system !! Swiftest nbody system object to store + class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object to store real(DP), intent(in), optional :: t !! Time of snapshot if different from system time character(*), intent(in), optional :: arg !! Optional argument (needed for extended storage type used in collision snapshots) ! Arguments @@ -400,11 +400,11 @@ module subroutine encounter_util_snapshot(self, param, system, t, arg) select type(param) class is (swiftest_parameters) - select type (system) + select type (nbody_system) class is (swiftest_nbody_system) - select type (pl => system%pl) + select type (pl => nbody_system%pl) class is (swiftest_pl) - select type (tp => system%tp) + select type (tp => nbody_system%tp) class is (swiftest_tp) associate(npl => pl%nbody, ntp => tp%nbody) if (npl + ntp == 0) return @@ -429,9 +429,9 @@ module subroutine encounter_util_snapshot(self, param, system, t, arg) pl%lmask(1:npl) = pl%status(1:npl) /= INACTIVE select type(pl) class is (symba_pl) - select type(system) + select type(nbody_system) class is (symba_nbody_system) - pl%lmask(1:npl) = pl%lmask(1:npl) .and. pl%levelg(1:npl) == system%irec + pl%lmask(1:npl) = pl%lmask(1:npl) .and. pl%levelg(1:npl) == nbody_system%irec end select end select npl_snap = count(pl%lmask(1:npl)) @@ -440,9 +440,9 @@ module subroutine encounter_util_snapshot(self, param, system, t, arg) tp%lmask(1:ntp) = tp%status(1:ntp) /= INACTIVE select type(tp) class is (symba_tp) - select type(system) + select type(nbody_system) class is (symba_nbody_system) - tp%lmask(1:ntp) = tp%lmask(1:ntp) .and. tp%levelg(1:ntp) == system%irec + tp%lmask(1:ntp) = tp%lmask(1:ntp) .and. tp%levelg(1:ntp) == nbody_system%irec end select end select ntp_snap = count(tp%lmask(1:ntp)) @@ -496,13 +496,13 @@ module subroutine encounter_util_snapshot(self, param, system, t, arg) end if ! Save the snapshot - select type (encounter_history => system%encounter_history) + select type (encounter_history => nbody_system%encounter_history) class is (encounter_storage(*)) encounter_history%nid = encounter_history%nid + ntp_snap + npl_snap - call encounter_util_save_snapshot(system%encounter_history,snapshot) + call encounter_util_save_snapshot(nbody_system%encounter_history,snapshot) end select case("closest") - associate(plpl_encounter => system%plpl_encounter, pltp_encounter => system%pltp_encounter) + associate(plpl_encounter => nbody_system%plpl_encounter, pltp_encounter => nbody_system%pltp_encounter) if (any(plpl_encounter%lclosest(:))) then call pl_snap%setup(2, param) do k = 1, plpl_encounter%nenc @@ -565,7 +565,7 @@ module subroutine encounter_util_snapshot(self, param, system, t, arg) pl_snap%vh(:,2) = vb(:,2) + vcom(:) call pl_snap%sort("id", ascending=.true.) - call encounter_util_save_snapshot(system%encounter_history,snapshot) + call encounter_util_save_snapshot(nbody_system%encounter_history,snapshot) end if end do diff --git a/src/fraggle/fraggle_generate.f90 b/src/fraggle/fraggle_generate.f90 index 5cad2a3a9..52ba2d914 100644 --- a/src/fraggle/fraggle_generate.f90 +++ b/src/fraggle/fraggle_generate.f90 @@ -21,31 +21,31 @@ module subroutine fraggle_generate_system(self, nbody_system, param, t) implicit none class(fraggle_system), intent(inout) :: self !! Fraggle fragment nbody_system object - class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody nbody_system object + class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(base_parameters), intent(inout) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! The time of the collision ! Internals integer(I4B) :: i - select type(nbody_system) - class is (swiftest_nbody_system) - select type(param) - class is (swiftest_parameters) - associate(impactors => self%impactors, plpl_collision => nbody_system%plpl_collision) - select case (impactors%regime) - case (COLLRESOLVE_REGIME_DISRUPTION, COLLRESOLVE_REGIME_SUPERCATASTROPHIC) - plpl_collision%status(i) = fraggle_resolve_disruption(nbody_system, param, t) - case (COLLRESOLVE_REGIME_HIT_AND_RUN) - plpl_collision%status(i) = fraggle_resolve_hitandrun(nbody_system, param, t) - case (COLLRESOLVE_REGIME_MERGE, COLLRESOLVE_REGIME_GRAZE_AND_MERGE) - plpl_collision%status(i) = collision_resolve_merge(nbody_system, param, t) - case default - write(*,*) "Error in swiftest_collision, unrecognized collision regime" - call util_exit(FAILURE) - end select - end associate - end select - end select + ! select type(nbody_system) + ! class is (swiftest_nbody_system) + ! select type(param) + ! class is (swiftest_parameters) + ! associate(impactors => self%impactors, plpl_collision => nbody_system%plpl_collision) + ! select case (impactors%regime) + ! case (COLLRESOLVE_REGIME_DISRUPTION, COLLRESOLVE_REGIME_SUPERCATASTROPHIC) + ! plpl_collision%status(i) = fraggle_resolve_disruption(nbody_system, param, t) + ! case (COLLRESOLVE_REGIME_HIT_AND_RUN) + ! plpl_collision%status(i) = fraggle_resolve_hitandrun(nbody_system, param, t) + ! case (COLLRESOLVE_REGIME_MERGE, COLLRESOLVE_REGIME_GRAZE_AND_MERGE) + ! plpl_collision%status(i) = collision_resolve_merge(nbody_system, param, t) + ! case default + ! write(*,*) "Error in swiftest_collision, unrecognized collision regime" + ! call util_exit(FAILURE) + ! end select + ! end associate + ! end select + ! end select end subroutine fraggle_generate_system @@ -58,7 +58,7 @@ module subroutine fraggle_generate_fragments(collision_system, nbody_system, par implicit none ! Arguments class(fraggle_system), intent(inout) :: collision_system !! Fraggle nbody_system object the outputs will be the fragmentation - class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody nbody_system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters logical, intent(out) :: lfailure !! Answers the question: Should this have been a merger instead? ! Internals @@ -87,10 +87,10 @@ module subroutine fraggle_generate_fragments(collision_system, nbody_system, par associate(impactors => collision_system%impactors, nfrag => fragments%nbody, pl => nbody_system%pl) write(message,*) nfrag - call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, "Fraggle generating " // trim(adjustl(message)) // " fragments.") + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Fraggle generating " // trim(adjustl(message)) // " fragments.") if (nfrag < NFRAG_MIN) then write(message,*) "Fraggle needs at least ",NFRAG_MIN," fragments, but only ",nfrag," were given." - call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, message) + call swiftest_io_log_one_message(COLLISION_LOG_OUT, message) lfailure = .true. return end if @@ -119,7 +119,7 @@ module subroutine fraggle_generate_fragments(collision_system, nbody_system, par try = 1 do while (try < MAXTRY) write(message,*) try - call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, "Fraggle try " // trim(adjustl(message))) + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Fraggle try " // trim(adjustl(message))) if (lfailure) then call fragments%restructure(impactors, try, f_spin, r_max_start) call fragments%reset() @@ -142,19 +142,19 @@ module subroutine fraggle_generate_fragments(collision_system, nbody_system, par call fraggle_generate_spins(collision_system, f_spin, lfailure) if (lfailure) then - call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, "Fraggle failed to find spins") + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Fraggle failed to find spins") cycle end if call fraggle_generate_tan_vel(collision_system, lfailure) if (lfailure) then - call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, "Fraggle failed to find tangential velocities") + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Fraggle failed to find tangential velocities") cycle end if call fraggle_generate_rad_vel(collision_system, lfailure) if (lfailure) then - call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, "Fraggle failed to find radial velocities") + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Fraggle failed to find radial velocities") cycle end if @@ -166,7 +166,7 @@ module subroutine fraggle_generate_fragments(collision_system, nbody_system, par lfailure = ((abs(dEtot + impactors%Qloss) > FRAGGLE_ETOL) .or. (dEtot > 0.0_DP)) if (lfailure) then write(message, *) dEtot, abs(dEtot + impactors%Qloss) / FRAGGLE_ETOL - call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, "Fraggle failed due to high energy error: " // & + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Fraggle failed due to high energy error: " // & trim(adjustl(message))) cycle end if @@ -174,7 +174,7 @@ module subroutine fraggle_generate_fragments(collision_system, nbody_system, par lfailure = ((abs(dLmag) / (.mag.collision_system%Ltot(:,1))) > FRAGGLE_LTOL) if (lfailure) then write(message,*) dLmag / (.mag.collision_system%Ltot(:,1)) - call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, "Fraggle failed due to high angular momentum error: " // & + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Fraggle failed due to high angular momentum error: " // & trim(adjustl(message))) cycle end if @@ -184,15 +184,15 @@ module subroutine fraggle_generate_fragments(collision_system, nbody_system, par lfailure = any(fpe_flag) if (.not.lfailure) exit write(message,*) "Fraggle failed due to a floating point exception: ", fpe_flag - call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, message) + call swiftest_io_log_one_message(COLLISION_LOG_OUT, message) end do write(message,*) try if (lfailure) then - call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, "Fraggle fragment generation failed after " // & + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Fraggle fragment generation failed after " // & trim(adjustl(message)) // " tries") else - call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, "Fraggle fragment generation succeeded after " // & + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Fraggle fragment generation succeeded after " // & trim(adjustl(message)) // " tries") end if @@ -218,7 +218,7 @@ subroutine fraggle_generate_pos_vec(collision_system, r_max_start) !! The initial positions do not conserve energy or momentum, so these need to be adjusted later. implicit none ! Arguments - class(fraggle_system), intent(inout) :: collision_system !! Fraggle collision nbody_system object + class(fraggle_system), intent(inout) :: collision_system !! Fraggle collision system object real(DP), intent(in) :: r_max_start !! Initial guess for the starting maximum radial distance of fragments ! Internals real(DP) :: dis, rad, r_max, fdistort @@ -301,7 +301,7 @@ subroutine fraggle_generate_spins(collision_system, f_spin, lfailure) !! A failure will trigger a restructuring of the fragments so we will try new values of the radial position distribution. implicit none ! Arguments - class(fraggle_system), intent(inout) :: collision_system !! Fraggle collision nbody_system object + class(fraggle_system), intent(inout) :: collision_system !! Fraggle collision system object real(DP), intent(in) :: f_spin !! Fraction of energy or momentum that goes into spin (whichever gives the lowest kinetic energy) logical, intent(out) :: lfailure !! Logical flag indicating whether this step fails or succeeds! ! Internals @@ -364,16 +364,16 @@ subroutine fraggle_generate_spins(collision_system, f_spin, lfailure) lfailure = ((fragments%ke_budget - fragments%ke_spin - fragments%ke_orbit) < 0.0_DP) if (lfailure) then - call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, " ") - call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, "Spin failure diagnostics") + call swiftest_io_log_one_message(COLLISION_LOG_OUT, " ") + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Spin failure diagnostics") write(message, *) fragments%ke_budget - call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, "ke_budget : " // trim(adjustl(message))) + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "ke_budget : " // trim(adjustl(message))) write(message, *) fragments%ke_spin - call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, "ke_spin : " // trim(adjustl(message))) + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "ke_spin : " // trim(adjustl(message))) write(message, *) fragments%ke_orbit - call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, "ke_orbit : " // trim(adjustl(message))) + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "ke_orbit : " // trim(adjustl(message))) write(message, *) fragments%ke_budget - fragments%ke_spin - fragments%ke_orbit - call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, "ke_remainder : " // trim(adjustl(message))) + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "ke_remainder : " // trim(adjustl(message))) end if end select @@ -398,7 +398,7 @@ subroutine fraggle_generate_tan_vel(collision_system, lfailure) !! A failure will trigger a restructuring of the fragments so we will try new values of the radial position distribution. implicit none ! Arguments - class(fraggle_system), intent(inout) :: collision_system !! Fraggle collision nbody_system object + class(fraggle_system), intent(inout) :: collision_system !! Fraggle collision system object logical, intent(out) :: lfailure !! Logical flag indicating whether this step fails or succeeds ! Internals integer(I4B) :: i, try @@ -466,20 +466,20 @@ subroutine fraggle_generate_tan_vel(collision_system, lfailure) fragments%rc(:,:) = fragments%rc(:,:) * 1.1_DP end do if (lfailure) then - call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, " ") - call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, "Tangential velocity failure diagnostics") + call swiftest_io_log_one_message(COLLISION_LOG_OUT, " ") + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Tangential velocity failure diagnostics") call fragments%get_angular_momentum() L_frag_tot = fragments%Lspin(:) + fragments%Lorbit(:) write(message, *) .mag.(fragments%L_budget(:) - L_frag_tot(:)) / (.mag.collision_system%Ltot(:,1)) - call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, "|L_remainder| : " // trim(adjustl(message))) + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "|L_remainder| : " // trim(adjustl(message))) write(message, *) fragments%ke_budget - call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, "ke_budget : " // trim(adjustl(message))) + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "ke_budget : " // trim(adjustl(message))) write(message, *) fragments%ke_spin - call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, "ke_spin : " // trim(adjustl(message))) + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "ke_spin : " // trim(adjustl(message))) write(message, *) fragments%ke_orbit - call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, "ke_tangential : " // trim(adjustl(message))) + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "ke_tangential : " // trim(adjustl(message))) write(message, *) fragments%ke_budget - fragments%ke_spin - fragments%ke_orbit - call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, "ke_radial : " // trim(adjustl(message))) + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "ke_radial : " // trim(adjustl(message))) end if end select end associate @@ -582,7 +582,7 @@ subroutine fraggle_generate_rad_vel(collision_system, lfailure) !! Adjust the fragment velocities to set the fragment orbital kinetic energy. This will minimize the difference between the fragment kinetic energy and the energy budget implicit none ! Arguments - class(fraggle_system), intent(inout) :: collision_system !! Fraggle collision nbody_system object + class(fraggle_system), intent(inout) :: collision_system !! Fraggle collision system object logical, intent(out) :: lfailure !! Logical flag indicating whether this step fails or succeeds! ! Internals real(DP), parameter :: TOL_MIN = FRAGGLE_ETOL ! This needs to be more accurate than the tangential step, as we are trying to minimize the total residual energy @@ -641,16 +641,16 @@ subroutine fraggle_generate_rad_vel(collision_system, lfailure) lfailure = abs((fragments%ke_budget - (fragments%ke_orbit + fragments%ke_spin)) / fragments%ke_budget) > FRAGGLE_ETOL if (lfailure) then - call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, " ") - call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, "Radial velocity failure diagnostics") + call swiftest_io_log_one_message(COLLISION_LOG_OUT, " ") + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Radial velocity failure diagnostics") write(message, *) fragments%ke_budget - call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, "ke_budget : " // trim(adjustl(message))) + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "ke_budget : " // trim(adjustl(message))) write(message, *) fragments%ke_spin - call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, "ke_spin : " // trim(adjustl(message))) + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "ke_spin : " // trim(adjustl(message))) write(message, *) fragments%ke_orbit - call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, "ke_orbit : " // trim(adjustl(message))) + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "ke_orbit : " // trim(adjustl(message))) write(message, *) fragments%ke_budget - (fragments%ke_orbit + fragments%ke_spin) - call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, "ke_remainder : " // trim(adjustl(message))) + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "ke_remainder : " // trim(adjustl(message))) end if end select diff --git a/src/fraggle/fraggle_io.f90 b/src/fraggle/fraggle_io.f90 index 7c943b5d6..c2e479dbb 100644 --- a/src/fraggle/fraggle_io.f90 +++ b/src/fraggle/fraggle_io.f90 @@ -12,43 +12,5 @@ contains - module subroutine fraggle_io_log_regime(collision_system) - !! author: David A. Minton - !! - !! Writes a log of the results of the collisional regime determination - implicit none - ! Arguments - class(fraggle_system), intent(inout) :: collision_system !! Fraggle collision system object - ! Internals - character(STRMAX) :: errmsg - - associate(fragments => collision_system%fragments, impactors => collision_system%impactors) - open(unit=LUN, file=FRAGGLE_LOG_OUT, status = 'OLD', position = 'APPEND', form = 'FORMATTED', err = 667, iomsg = errmsg) - write(LUN, *, err = 667, iomsg = errmsg) - write(LUN, *) "--------------------------------------------------------------------" - write(LUN, *) " Fraggle collisional regime determination results" - write(LUN, *) "--------------------------------------------------------------------" - write(LUN, *) "True number of impactors : ",impactors%ncoll - write(LUN, *) "Index list of true impactors : ",impactors%id(1:impactors%ncoll) - select case(impactors%regime) - case(COLLRESOLVE_REGIME_MERGE) - write(LUN, *) "Regime: Merge" - case(COLLRESOLVE_REGIME_DISRUPTION) - write(LUN, *) "Regime: Disruption" - case(COLLRESOLVE_REGIME_SUPERCATASTROPHIC) - write(LUN, *) "Regime: Supercatastrophic disruption" - case(COLLRESOLVE_REGIME_GRAZE_AND_MERGE) - write(LUN, *) "Regime: Graze and merge" - case(COLLRESOLVE_REGIME_HIT_AND_RUN) - write(LUN, *) "Regime: Hit and run" - end select - write(LUN, *) "Energy loss : ", impactors%Qloss - write(LUN, *) "--------------------------------------------------------------------" - close(LUN) - end associate - return - 667 continue - write(*,*) "Error writing Fraggle regime information to log file: " // trim(adjustl(errmsg)) - end subroutine fraggle_io_log_regime end submodule s_fraggle_io \ No newline at end of file diff --git a/src/fraggle/fraggle_module.f90 b/src/fraggle/fraggle_module.f90 index 7960a8d44..89c5ab5f7 100644 --- a/src/fraggle/fraggle_module.f90 +++ b/src/fraggle/fraggle_module.f90 @@ -15,8 +15,6 @@ module fraggle implicit none public - integer(I4B), parameter :: FRAGGLE_NMASS_DIST = 3 !! Number of mass bins returned by the regime calculation (largest fragment, second largest, and remainder) - character(len=*), parameter :: FRAGGLE_LOG_OUT = "fraggle.log" !! Name of log file for Fraggle diagnostic information !> Class definition for the variables that describe a collection of fragments by Fraggle barycentric coordinates type, extends(collision_fragments) :: fraggle_fragments diff --git a/src/fraggle/fraggle_resolve.f90 b/src/fraggle/fraggle_resolve.f90 index 41f80aa72..10c7bf3e2 100644 --- a/src/fraggle/fraggle_resolve.f90 +++ b/src/fraggle/fraggle_resolve.f90 @@ -38,8 +38,8 @@ module function fraggle_resolve_disruption(collision_system, nbody_system, param case(COLLRESOLVE_REGIME_SUPERCATASTROPHIC) message = "Supercatastrophic disruption between" end select - call collision_resolve_collider_message(nbody_system%pl, impactors%id, message) - call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, message) + call collision_io_collider_message(nbody_system%pl, impactors%id, message) + call swiftest_io_log_one_message(COLLISION_LOG_OUT, message) ! Collisional fragments will be uniformly distributed around the pre-impact barycenter call collision_system%set_mass_dist(param) @@ -52,7 +52,7 @@ module function fraggle_resolve_disruption(collision_system, nbody_system, param nbody_system%Euntracked = nbody_system%Euntracked + dpe if (lfailure) then - call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, "No fragment solution found, so treat as a pure hit-and-run") + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "No fragment solution found, so treat as a pure hit-and-run") status = ACTIVE nfrag = 0 pl%status(impactors%id(:)) = status @@ -69,7 +69,7 @@ module function fraggle_resolve_disruption(collision_system, nbody_system, param ! Populate the list of new bodies nfrag = fragments%nbody write(message, *) nfrag - call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, "Generating " // trim(adjustl(message)) // " fragments") + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Generating " // trim(adjustl(message)) // " fragments") select case(impactors%regime) case(COLLRESOLVE_REGIME_DISRUPTION) status = DISRUPTED @@ -116,8 +116,8 @@ module function fraggle_resolve_hitandrun(collision_system, nbody_system, param, class is (swiftest_nbody_system) associate(impactors => collision_system%impactors, fragments => collision_system%fragments, pl => nbody_system%pl) message = "Hit and run between" - call collision_resolve_collider_message(nbody_system%pl, impactors%id, message) - call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, trim(adjustl(message))) + call collision_io_collider_message(nbody_system%pl, impactors%id, message) + call swiftest_io_log_one_message(COLLISION_LOG_OUT, trim(adjustl(message))) if (impactors%mass(1) > impactors%mass(2)) then jtarg = 1 @@ -128,7 +128,7 @@ module function fraggle_resolve_hitandrun(collision_system, nbody_system, param, end if if (impactors%mass_dist(2) > 0.9_DP * impactors%mass(jproj)) then ! Pure hit and run, so we'll just keep the two bodies untouched - call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, "Pure hit and run. No new fragments generated.") + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Pure hit and run. No new fragments generated.") nfrag = 0 lpure = .true. else ! Imperfect hit and run, so we'll keep the largest body and destroy the other @@ -143,12 +143,12 @@ module function fraggle_resolve_hitandrun(collision_system, nbody_system, param, nbody_system%Euntracked = nbody_system%Euntracked + dpe if (lpure) then - call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, "Should have been a pure hit and run instead") + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Should have been a pure hit and run instead") nfrag = 0 else nfrag = fragments%nbody write(message, *) nfrag - call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, "Generating " // trim(adjustl(message)) // " fragments") + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Generating " // trim(adjustl(message)) // " fragments") end if end if if (lpure) then ! Reset these bodies back to being active so that nothing further is done to them diff --git a/src/helio/helio_drift.f90 b/src/helio/helio_drift.f90 index d61eb6450..ad476a2b2 100644 --- a/src/helio/helio_drift.f90 +++ b/src/helio/helio_drift.f90 @@ -11,7 +11,7 @@ use swiftest contains - module subroutine helio_drift_body(self, system, param, dt) + module subroutine helio_drift_body(self, nbody_system, param, dt) !! author: David A. Minton !! !! Loop through bodies and call Danby drift routine on democratic heliocentric coordinates @@ -21,7 +21,7 @@ module subroutine helio_drift_body(self, system, param, dt) implicit none ! Arguments class(swiftest_body), intent(inout) :: self !! Swiftest body object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters real(DP), intent(in) :: dt !! Stepsize ! Internals @@ -35,7 +35,7 @@ module subroutine helio_drift_body(self, system, param, dt) allocate(iflag(n)) iflag(:) = 0 allocate(mu(n)) - mu(:) = system%cb%Gmass + mu(:) = nbody_system%cb%Gmass call swiftest_drift_all(mu, self%rh, self%vb, self%nbody, param, dt, self%lmask, iflag) if (any(iflag(1:n) /= 0)) then where(iflag(1:n) /= 0) self%status(1:n) = DISCARDED_DRIFTERR @@ -50,35 +50,35 @@ module subroutine helio_drift_body(self, system, param, dt) end subroutine helio_drift_body - module subroutine helio_drift_pl(self, system, param, dt) + module subroutine helio_drift_pl(self, nbody_system, param, dt) !! author: David A. Minton !! !! Wrapper function used to call the body drift routine from a helio_pl structure implicit none ! Arguments class(helio_pl), intent(inout) :: self !! Helio massive body object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters real(DP), intent(in) :: dt !! Stepsize - call helio_drift_body(self, system, param, dt) + call helio_drift_body(self, nbody_system, param, dt) return end subroutine helio_drift_pl - module subroutine helio_drift_tp(self, system, param, dt) + module subroutine helio_drift_tp(self, nbody_system, param, dt) !! author: David A. Minton !! !! Wrapper function used to call the body drift routine from a helio_pl structure implicit none ! Arguments class(helio_tp), intent(inout) :: self !! Helio massive body object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters real(DP), intent(in) :: dt !! Stepsize - call helio_drift_body(self, system, param, dt) + call helio_drift_body(self, nbody_system, param, dt) return end subroutine helio_drift_tp diff --git a/src/helio/helio_gr.f90 b/src/helio/helio_gr.f90 index 7a5ac9525..2092fca6a 100644 --- a/src/helio/helio_gr.f90 +++ b/src/helio/helio_gr.f90 @@ -57,7 +57,7 @@ pure module subroutine helio_gr_kick_getacch_tp(self, param) end subroutine helio_gr_kick_getacch_tp - pure module subroutine helio_gr_p4_pl(self, system, param, dt) + pure module subroutine helio_gr_p4_pl(self, nbody_system, param, dt) !! author: David A. Minton !! !! Position kick to massive bodies due to p**4 term in the post-Newtonian correction @@ -67,7 +67,7 @@ pure module subroutine helio_gr_p4_pl(self, system, param, dt) implicit none ! Arguments class(helio_pl), intent(inout) :: self !! Swiftest particle object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters real(DP), intent(in) :: dt !! Step size ! Internals @@ -85,7 +85,7 @@ pure module subroutine helio_gr_p4_pl(self, system, param, dt) end subroutine helio_gr_p4_pl - pure module subroutine helio_gr_p4_tp(self, system, param, dt) + pure module subroutine helio_gr_p4_tp(self, nbody_system, param, dt) !! author: David A. Minton !! !! Position kick to test particles due to p**4 term in the post-Newtonian correction @@ -95,7 +95,7 @@ pure module subroutine helio_gr_p4_tp(self, system, param, dt) implicit none ! Arguments class(helio_tp), intent(inout) :: self !! Swiftest particle object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters real(DP), intent(in) :: dt !! Step size ! Internals diff --git a/src/helio/helio_kick.f90 b/src/helio/helio_kick.f90 index 525990d12..6fb4fad43 100644 --- a/src/helio/helio_kick.f90 +++ b/src/helio/helio_kick.f90 @@ -11,7 +11,7 @@ use swiftest contains - module subroutine helio_kick_getacch_pl(self, system, param, t, lbeg) + module subroutine helio_kick_getacch_pl(self, nbody_system, param, t, lbeg) !! author: David A. Minton !! !! Compute heliocentric accelerations of massive bodies @@ -21,17 +21,17 @@ module subroutine helio_kick_getacch_pl(self, system, param, t, lbeg) implicit none ! Arguments class(helio_pl), intent(inout) :: self !! Helio massive body particle data structure - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! Current simulation time logical, intent(in) :: lbeg !! Logical flag that determines whether or not this is the beginning or end of the step if (self%nbody == 0) return - associate(cb => system%cb, pl => self, npl => self%nbody) + associate(cb => nbody_system%cb, pl => self, npl => self%nbody) call pl%accel_int(param) if (param%loblatecb) then - call pl%accel_obl(system) + call pl%accel_obl(nbody_system) if (lbeg) then cb%aoblbeg = cb%aobl else @@ -39,7 +39,7 @@ module subroutine helio_kick_getacch_pl(self, system, param, t, lbeg) end if ! TODO: Implement tides ! if (param%ltides) then - ! call pl%accel_tides(system) + ! call pl%accel_tides(nbody_system) ! if (lbeg) then ! cb%atidebeg = cb%atide ! else @@ -47,7 +47,7 @@ module subroutine helio_kick_getacch_pl(self, system, param, t, lbeg) ! end if ! end if end if - if (param%lextra_force) call pl%accel_user(system, param, t, lbeg) + if (param%lextra_force) call pl%accel_user(nbody_system, param, t, lbeg) if (param%lgr) call pl%accel_gr(param) end associate @@ -55,7 +55,7 @@ module subroutine helio_kick_getacch_pl(self, system, param, t, lbeg) end subroutine helio_kick_getacch_pl - module subroutine helio_kick_getacch_tp(self, system, param, t, lbeg) + module subroutine helio_kick_getacch_tp(self, nbody_system, param, t, lbeg) !! author: David A. Minton !! !! Compute heliocentric accelerations of test particles @@ -65,22 +65,22 @@ module subroutine helio_kick_getacch_tp(self, system, param, t, lbeg) implicit none ! Arguments class(helio_tp), intent(inout) :: self !! Helio test particle data structure - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! Current time logical, intent(in) :: lbeg !! Logical flag that determines whether or not this is the beginning or end of the step if (self%nbody == 0) return - associate(tp => self, cb => system%cb, pl => system%pl, npl => system%pl%nbody) - system%lbeg = lbeg - if (system%lbeg) then + associate(tp => self, cb => nbody_system%cb, pl => nbody_system%pl, npl => nbody_system%pl%nbody) + nbody_system%lbeg = lbeg + if (nbody_system%lbeg) then call tp%accel_int(param, pl%Gmass(1:npl), pl%rbeg(:,1:npl), npl) else call tp%accel_int(param, pl%Gmass(1:npl), pl%rend(:,1:npl), npl) end if - if (param%loblatecb) call tp%accel_obl(system) - if (param%lextra_force) call tp%accel_user(system, param, t, lbeg) + if (param%loblatecb) call tp%accel_obl(nbody_system) + if (param%lextra_force) call tp%accel_user(nbody_system, param, t, lbeg) if (param%lgr) call tp%accel_gr(param) end associate @@ -88,7 +88,7 @@ module subroutine helio_kick_getacch_tp(self, system, param, t, lbeg) end subroutine helio_kick_getacch_tp - module subroutine helio_kick_vb_pl(self, system, param, t, dt, lbeg) + module subroutine helio_kick_vb_pl(self, nbody_system, param, t, dt, lbeg) !! author: David A. Minton !! !! Kick barycentric velocities of bodies @@ -98,7 +98,7 @@ module subroutine helio_kick_vb_pl(self, system, param, t, dt, lbeg) implicit none ! Arguments class(helio_pl), intent(inout) :: self !! Swiftest generic body object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! Current time real(DP), intent(in) :: dt !! Stepsize @@ -110,7 +110,7 @@ module subroutine helio_kick_vb_pl(self, system, param, t, dt, lbeg) associate(pl => self, npl => self%nbody) pl%ah(:, 1:npl) = 0.0_DP - call pl%accel(system, param, t, lbeg) + call pl%accel(nbody_system, param, t, lbeg) if (lbeg) then call pl%set_beg_end(rbeg = pl%rh) else @@ -127,7 +127,7 @@ module subroutine helio_kick_vb_pl(self, system, param, t, dt, lbeg) end subroutine helio_kick_vb_pl - module subroutine helio_kick_vb_tp(self, system, param, t, dt, lbeg) + module subroutine helio_kick_vb_tp(self, nbody_system, param, t, dt, lbeg) !! author: David A. Minton !! !! Kick barycentric velocities of bodies @@ -137,7 +137,7 @@ module subroutine helio_kick_vb_tp(self, system, param, t, dt, lbeg) implicit none ! Arguments class(helio_tp), intent(inout) :: self !! Swiftest generic body object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! Current time real(DP), intent(in) :: dt !! Stepsize @@ -149,7 +149,7 @@ module subroutine helio_kick_vb_tp(self, system, param, t, dt, lbeg) associate(tp => self, ntp => self%nbody) tp%ah(:, 1:ntp) = 0.0_DP - call tp%accel(system, param, t, lbeg) + call tp%accel(nbody_system, param, t, lbeg) do concurrent(i = 1:ntp, tp%lmask(i)) tp%vb(:, i) = tp%vb(:, i) + tp%ah(:, i) * dt end do diff --git a/src/helio/helio_module.f90 b/src/helio/helio_module.f90 index c33583529..b8d9d8b26 100644 --- a/src/helio/helio_module.f90 +++ b/src/helio/helio_module.f90 @@ -22,7 +22,7 @@ module helio contains procedure :: step => helio_step_system !! Advance the Helio nbody system forward in time by one step procedure :: initialize => helio_setup_initialize_system !! Performs Helio-specific initilization steps, including converting to DH coordinates - final :: helio_final_system !! Finalizes the Helio system object - deallocates all allocatables + final :: helio_final_system !! Finalizes the Helio nbody_system object - deallocates all allocatables end type helio_nbody_system @@ -62,26 +62,26 @@ module helio end type helio_tp interface - module subroutine helio_drift_body(self, system, param, dt) + module subroutine helio_drift_body(self, nbody_system, param, dt) implicit none class(swiftest_body), intent(inout) :: self !! Swiftest massive body object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters real(DP), intent(in) :: dt !! Stepsize end subroutine helio_drift_body - module subroutine helio_drift_pl(self, system, param, dt) + module subroutine helio_drift_pl(self, nbody_system, param, dt) implicit none class(helio_pl), intent(inout) :: self !! Helio massive body object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters real(DP), intent(in) :: dt !! Stepsize end subroutine helio_drift_pl - module subroutine helio_drift_tp(self, system, param, dt) + module subroutine helio_drift_tp(self, nbody_system, param, dt) implicit none class(helio_tp), intent(inout) :: self !! Helio massive body object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters real(DP), intent(in) :: dt !! Stepsize end subroutine helio_drift_tp @@ -114,54 +114,54 @@ pure module subroutine helio_gr_kick_getacch_tp(self, param) class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters end subroutine helio_gr_kick_getacch_tp - pure module subroutine helio_gr_p4_pl(self, system, param, dt) + pure module subroutine helio_gr_p4_pl(self, nbody_system, param, dt) implicit none class(helio_pl), intent(inout) :: self !! Swiftest particle object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters real(DP), intent(in) :: dt !! Step size end subroutine helio_gr_p4_pl - pure module subroutine helio_gr_p4_tp(self, system, param, dt) + pure module subroutine helio_gr_p4_tp(self, nbody_system, param, dt) implicit none class(helio_tp), intent(inout) :: self !! Swiftest particle object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters real(DP), intent(in) :: dt !! Step size end subroutine helio_gr_p4_tp - module subroutine helio_kick_getacch_pl(self, system, param, t, lbeg) + module subroutine helio_kick_getacch_pl(self, nbody_system, param, t, lbeg) implicit none class(helio_pl), intent(inout) :: self !! Helio massive body object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! Current simulation time logical, intent(in) :: lbeg !! Logical flag that determines whether or not this is the beginning or end of the step end subroutine helio_kick_getacch_pl - module subroutine helio_kick_getacch_tp(self, system, param, t, lbeg) + module subroutine helio_kick_getacch_tp(self, nbody_system, param, t, lbeg) implicit none class(helio_tp), intent(inout) :: self !! Helio test particle object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! Current time logical, intent(in) :: lbeg !! Logical flag that determines whether or not this is the beginning or end of the step end subroutine helio_kick_getacch_tp - module subroutine helio_kick_vb_pl(self, system, param, t, dt, lbeg) + module subroutine helio_kick_vb_pl(self, nbody_system, param, t, dt, lbeg) implicit none class(helio_pl), intent(inout) :: self !! Helio massive body object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! Current time real(DP), intent(in) :: dt !! Stepsize logical, intent(in) :: lbeg !! Logical flag indicating whether this is the beginning of the half step or not. end subroutine helio_kick_vb_pl - module subroutine helio_kick_vb_tp(self, system, param, t, dt, lbeg) + module subroutine helio_kick_vb_tp(self, nbody_system, param, t, dt, lbeg) implicit none class(helio_tp), intent(inout) :: self !! Helio test particle object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! Current time real(DP), intent(in) :: dt !! Stepsize @@ -174,10 +174,10 @@ module subroutine helio_setup_initialize_system(self, param) class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters end subroutine helio_setup_initialize_system - module subroutine helio_step_pl(self, system, param, t, dt) + module subroutine helio_step_pl(self, nbody_system, param, t, dt) implicit none class(helio_pl), intent(inout) :: self !! Helio massive body particle object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! Current simulation time real(DP), intent(in) :: dt !! Stepsize @@ -191,10 +191,10 @@ module subroutine helio_step_system(self, param, t, dt) real(DP), intent(in) :: dt !! Current stepsize end subroutine helio_step_system - module subroutine helio_step_tp(self, system, param, t, dt) + module subroutine helio_step_tp(self, nbody_system, param, t, dt) implicit none class(helio_tp), intent(inout) :: self !! Helio test particle object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! Current simulation time real(DP), intent(in) :: dt !! Stepsizee diff --git a/src/helio/helio_step.f90 b/src/helio/helio_step.f90 index ddcfe0bd5..dd2463246 100644 --- a/src/helio/helio_step.f90 +++ b/src/helio/helio_step.f90 @@ -16,7 +16,7 @@ module subroutine helio_step_system(self, param, t, dt) !! !! Step massive bodies and and active test particles ahead in heliocentric coordinates. !! - !! Currently there's no difference between this and the WHM system stepper, so this is just + !! Currently there's no difference between this and the WHM nbody_system stepper, so this is just !! a wrapper function to keep the method calls consistent for inherited types. !! !! Adapted from Hal Levison's Swift routine step_kdk.f @@ -34,7 +34,7 @@ module subroutine helio_step_system(self, param, t, dt) end subroutine helio_step_system - module subroutine helio_step_pl(self, system, param, t, dt) + module subroutine helio_step_pl(self, nbody_system, param, t, dt) !! author: David A. Minton !! !! Step massive bodies ahead Democratic Heliocentric method @@ -44,7 +44,7 @@ module subroutine helio_step_pl(self, system, param, t, dt) implicit none ! Arguments class(helio_pl), intent(inout) :: self !! Helio massive body particle data structure - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! Current simulation time real(DP), intent(in) :: dt !! Stepsize @@ -54,7 +54,7 @@ module subroutine helio_step_pl(self, system, param, t, dt) if (self%nbody == 0) return associate(pl => self) - select type(cb => system%cb) + select type(cb => nbody_system%cb) class is (helio_cb) dth = 0.5_DP * dt if (pl%lfirst) then @@ -62,11 +62,11 @@ module subroutine helio_step_pl(self, system, param, t, dt) pl%lfirst = .false. end if call pl%lindrift(cb, dth, lbeg=.true.) - call pl%kick(system, param, t, dth, lbeg=.true.) - if (param%lgr) call pl%gr_pos_kick(system, param, dth) - call pl%drift(system, param, dt) - if (param%lgr) call pl%gr_pos_kick(system, param, dth) - call pl%kick(system, param, t + dt, dth, lbeg=.false.) + call pl%kick(nbody_system, param, t, dth, lbeg=.true.) + if (param%lgr) call pl%gr_pos_kick(nbody_system, param, dth) + call pl%drift(nbody_system, param, dt) + if (param%lgr) call pl%gr_pos_kick(nbody_system, param, dth) + call pl%kick(nbody_system, param, t + dt, dth, lbeg=.false.) call pl%lindrift(cb, dth, lbeg=.false.) call pl%vb2vh(cb) end select @@ -76,7 +76,7 @@ module subroutine helio_step_pl(self, system, param, t, dt) end subroutine helio_step_pl - module subroutine helio_step_tp(self, system, param, t, dt) + module subroutine helio_step_tp(self, nbody_system, param, t, dt) !! author: David A. Minton !! @@ -87,7 +87,7 @@ module subroutine helio_step_tp(self, system, param, t, dt) implicit none ! Arguments class(helio_tp), intent(inout) :: self !! Helio test particle data structure - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! Current simulation time real(DP), intent(in) :: dt !! Stepsize @@ -97,7 +97,7 @@ module subroutine helio_step_tp(self, system, param, t, dt) if (self%nbody == 0) return associate(tp => self) - select type(cb => system%cb) + select type(cb => nbody_system%cb) class is (helio_cb) dth = 0.5_DP * dt if (tp%lfirst) then @@ -105,11 +105,11 @@ module subroutine helio_step_tp(self, system, param, t, dt) tp%lfirst = .false. end if call tp%lindrift(cb, dth, lbeg=.true.) - call tp%kick(system, param, t, dth, lbeg=.true.) - if (param%lgr) call tp%gr_pos_kick(system, param, dth) - call tp%drift(system, param, dt) - if (param%lgr) call tp%gr_pos_kick(system, param, dth) - call tp%kick(system, param, t + dt, dth, lbeg=.false.) + call tp%kick(nbody_system, param, t, dth, lbeg=.true.) + if (param%lgr) call tp%gr_pos_kick(nbody_system, param, dth) + call tp%drift(nbody_system, param, dt) + if (param%lgr) call tp%gr_pos_kick(nbody_system, param, dth) + call tp%kick(nbody_system, param, t + dt, dth, lbeg=.false.) call tp%lindrift(cb, dth, lbeg=.false.) call tp%vb2vh(vbcb = -cb%ptend) end select diff --git a/src/misc/minimizer_module.f90 b/src/misc/minimizer_module.f90 index 0e4c37ede..a52fe2b00 100644 --- a/src/misc/minimizer_module.f90 +++ b/src/misc/minimizer_module.f90 @@ -542,7 +542,7 @@ subroutine quadfit(f, x0, S, N, eps, lo, hi, lerr) hi = astar exit end if - ! Set up system for gaussian elimination equation solver + ! Set up nbody_system for gaussian elimination equation solver row_1 = [1.0_DP, a1, a1**2] row_2 = [1.0_DP, a2, a2**2] row_3 = [1.0_DP, a3, a3**2] @@ -550,7 +550,7 @@ subroutine quadfit(f, x0, S, N, eps, lo, hi, lerr) lhs(1, :) = row_1 lhs(2, :) = row_2 lhs(3, :) = row_3 - ! Solve system of equations + ! Solve nbody_system of equations soln(:) = solve_linear_system(lhs, rhs, 3, lerr) call ieee_set_flag(ieee_all, .false.) ! Set all flags back to quiet call ieee_set_halting_mode(ieee_divide_by_zero, .false.) diff --git a/src/misc/solver_module.f90 b/src/misc/solver_module.f90 index f71ca46bb..6462fa57c 100644 --- a/src/misc/solver_module.f90 +++ b/src/misc/solver_module.f90 @@ -44,7 +44,7 @@ function solve_linear_system_dp(A,b,n,lerr) result(x) !! Solves the linear equation of the form A*x = b for x. !! A is an (n,n) arrays !! x and b are (n) arrays - !! Uses Gaussian elimination, so will have issues if system is ill-conditioned. + !! Uses Gaussian elimination, so will have issues if nbody_system is ill-conditioned. !! Uses quad precision intermidiate values, so works best on small arrays. implicit none ! Arguments @@ -84,7 +84,7 @@ function solve_linear_system_qp(A,b,n,lerr) result(x) !! Solves the linear equation of the form A*x = b for x. !! A is an (n,n) arrays !! x and b are (n) arrays - !! Uses Gaussian elimination, so will have issues if system is ill-conditioned. + !! Uses Gaussian elimination, so will have issues if nbody_system is ill-conditioned. !! Uses quad precision intermidiate values, so works best on small arrays. implicit none ! Arguments diff --git a/src/netcdf_io/netcdf_io_module.f90 b/src/netcdf_io/netcdf_io_module.f90 index cea8ca147..7199451b0 100644 --- a/src/netcdf_io/netcdf_io_module.f90 +++ b/src/netcdf_io/netcdf_io_module.f90 @@ -96,24 +96,24 @@ module netcdf_io 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) :: ke_orb_varname = "KE_orb" !! name of the nbody_system orbital kinetic energy variable + integer(I4B) :: KE_orb_varid !! ID for the nbody_system orbital kinetic energy variable + character(NAMELEN) :: ke_spin_varname = "KE_spin" !! name of the nbody_system spin kinetic energy variable + integer(I4B) :: KE_spin_varid !! ID for the nbody_system spin kinetic energy variable + character(NAMELEN) :: pe_varname = "PE" !! name of the nbody_system potential energy variable + integer(I4B) :: PE_varid !! ID for the nbody_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 + integer(I4B) :: L_orb_varid !! ID for the nbody_system orbital angular momentum vector variable character(NAMELEN) :: Lspin_varname = "Lspin" !! name of the spin angular momentum vector variable - integer(I4B) :: Lspin_varid !! ID for the system spin angular momentum vector variable + integer(I4B) :: Lspin_varid !! ID for the nbody_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) :: GMescape_varname = "GMescape" !! name of the G*Mass of bodies that escape the nbody_system + integer(I4B) :: GMescape_varid !! ID for the G*Mass of bodies that escape the nbody_system character(NAMELEN) :: origin_type_varname = "origin_type" !! name of the origin type variable (Initial Conditions, Disruption, etc.) integer(I4B) :: origin_type_varid !! ID for the origin type character(NAMELEN) :: origin_time_varname = "origin_time" !! name of the time of origin variable diff --git a/src/rmvs/rmvs_discard.f90 b/src/rmvs/rmvs_discard.f90 index 0c7e6230e..5a8fd94f5 100644 --- a/src/rmvs/rmvs_discard.f90 +++ b/src/rmvs/rmvs_discard.f90 @@ -11,7 +11,7 @@ use swiftest contains - module subroutine rmvs_discard_tp(self, system, param) + module subroutine rmvs_discard_tp(self, nbody_system, param) !! author: David A. Minton !! !! Check to see if test particles should be discarded based on pericenter passage distances with respect to planets encountered @@ -21,7 +21,7 @@ module subroutine rmvs_discard_tp(self, system, param) implicit none ! Arguments class(rmvs_tp), intent(inout) :: self !! RMVS test particle object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters ! Internals integer(I4B) :: i @@ -29,7 +29,7 @@ module subroutine rmvs_discard_tp(self, system, param) if (self%nbody == 0) return - associate(tp => self, ntp => self%nbody, pl => system%pl, t => system%t) + associate(tp => self, ntp => self%nbody, pl => nbody_system%pl, t => nbody_system%t) do i = 1, ntp associate(iplperP => tp%plperP(i)) if ((tp%status(i) == ACTIVE) .and. (tp%lperi(i))) then @@ -50,7 +50,7 @@ module subroutine rmvs_discard_tp(self, system, param) end associate end do ! Call the base method that this overrides - call swiftest_discard_tp(tp, system, param) + call swiftest_discard_tp(tp, nbody_system, param) end associate end subroutine rmvs_discard_tp diff --git a/src/rmvs/rmvs_encounter_check.f90 b/src/rmvs/rmvs_encounter_check.f90 index 664821272..68e052a6f 100644 --- a/src/rmvs/rmvs_encounter_check.f90 +++ b/src/rmvs/rmvs_encounter_check.f90 @@ -11,7 +11,7 @@ use swiftest contains - module function rmvs_encounter_check_tp(self, param, system, dt) result(lencounter) + module function rmvs_encounter_check_tp(self, param, nbody_system, dt) result(lencounter) !! author: David A. Minton !! !! Determine whether a test particle and planet are having or will have an encounter within the next time step @@ -22,7 +22,7 @@ module function rmvs_encounter_check_tp(self, param, system, dt) result(lencount ! Arguments class(rmvs_tp), intent(inout) :: self !! RMVS test particle object class(swiftest_parameters), intent(inout) :: param !! Current swiftest run configuration parameters - class(rmvs_nbody_system), intent(inout) :: system !! RMVS nbody system object + class(rmvs_nbody_system), intent(inout) :: nbody_system !! RMVS nbody system object real(DP), intent(in) :: dt !! step size ! Result logical :: lencounter !! Returns true if there is at least one close encounter @@ -38,7 +38,7 @@ module function rmvs_encounter_check_tp(self, param, system, dt) result(lencount lencounter = .false. if (self%nbody == 0) return - select type(pl => system%pl) + select type(pl => nbody_system%pl) class is (rmvs_pl) associate(tp => self, ntp => self%nbody, npl => pl%nbody) tp%plencP(1:ntp) = 0 diff --git a/src/rmvs/rmvs_kick.f90 b/src/rmvs/rmvs_kick.f90 index 2f36bbb81..7d113f863 100644 --- a/src/rmvs/rmvs_kick.f90 +++ b/src/rmvs/rmvs_kick.f90 @@ -11,7 +11,7 @@ use swiftest contains - module subroutine rmvs_kick_getacch_tp(self, system, param, t, lbeg) + module subroutine rmvs_kick_getacch_tp(self, nbody_system, param, t, lbeg) !! author: David A. Minton !! !! Compute the oblateness acceleration in the inner encounter region with planets @@ -21,7 +21,7 @@ module subroutine rmvs_kick_getacch_tp(self, system, param, t, lbeg) implicit none ! Arguments class(rmvs_tp), intent(inout) :: self !! RMVS test particle data structure - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest central body particle data structuree + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest central body particle data structuree class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! Current time logical, intent(in) :: lbeg !! Logical flag that determines whether or not this is the beginning or end of the step @@ -34,15 +34,15 @@ module subroutine rmvs_kick_getacch_tp(self, system, param, t, lbeg) if (self%nbody == 0) return associate(tp => self, ntp => self%nbody, ipleP => self%ipleP, inner_index => self%index) - select type(system) + select type(nbody_system) class is (rmvs_nbody_system) - if (system%lplanetocentric) then ! This is a close encounter step, so any accelerations requiring heliocentric position values + if (nbody_system%lplanetocentric) then ! This is a close encounter step, so any accelerations requiring heliocentric position values ! must be handeled outside the normal WHM method call - select type(pl => system%pl) + select type(pl => nbody_system%pl) class is (rmvs_pl) - select type (cb => system%cb) + select type (cb => nbody_system%cb) class is (rmvs_cb) - associate(xpc => pl%rh, xpct => self%rh, apct => self%ah, system_planetocen => system) + associate(xpc => pl%rh, xpct => self%rh, apct => self%ah, system_planetocen => nbody_system) system_planetocen%lbeg = lbeg ! Save the original heliocentric position for later @@ -88,7 +88,7 @@ module subroutine rmvs_kick_getacch_tp(self, system, param, t, lbeg) end select end select else ! Not a close encounter, so just proceded with the standard WHM method - call whm_kick_getacch_tp(tp, system, param, t, lbeg) + call whm_kick_getacch_tp(tp, nbody_system, param, t, lbeg) end if end select end associate diff --git a/src/rmvs/rmvs_module.f90 b/src/rmvs/rmvs_module.f90 index e6d3c7553..51e824b8d 100644 --- a/src/rmvs/rmvs_module.f90 +++ b/src/rmvs/rmvs_module.f90 @@ -44,7 +44,7 @@ module rmvs real(DP), dimension(:, :), allocatable :: atide !! Encountering planet's tidal acceleration value contains procedure :: dealloc => rmvs_util_dealloc_interp !! Deallocates all allocatable arrays - final :: rmvs_final_interp !! Finalizes the RMVS interpolated system variables object - deallocates all allocatables + final :: rmvs_final_interp !! Finalizes the RMVS interpolated nbody_system variables object - deallocates all allocatables end type rmvs_interp @@ -113,26 +113,26 @@ module rmvs end type rmvs_pl interface - module subroutine rmvs_discard_tp(self, system, param) + module subroutine rmvs_discard_tp(self, nbody_system, param) implicit none class(rmvs_tp), intent(inout) :: self !! RMVS test particle object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters end subroutine rmvs_discard_tp - module function rmvs_encounter_check_tp(self, param, system, dt) result(lencounter) + module function rmvs_encounter_check_tp(self, param, nbody_system, dt) result(lencounter) implicit none class(rmvs_tp), intent(inout) :: self !! RMVS test particle object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - class(rmvs_nbody_system), intent(inout) :: system !! RMVS nbody system object + class(rmvs_nbody_system), intent(inout) :: nbody_system !! RMVS nbody system object real(DP), intent(in) :: dt !! step size logical :: lencounter !! Returns true if there is at least one close encounter end function rmvs_encounter_check_tp - module subroutine rmvs_kick_getacch_tp(self, system, param, t, lbeg) + module subroutine rmvs_kick_getacch_tp(self, nbody_system, param, t, lbeg) implicit none class(rmvs_tp), intent(inout) :: self !! RMVS test particle data structure - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest central body particle data structuree + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest central body particle data structuree class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! Current time logical, intent(in) :: lbeg !! Logical flag that determines whether or not this is the beginning or end of the step @@ -179,7 +179,7 @@ end subroutine rmvs_util_dealloc_cb module subroutine rmvs_util_dealloc_interp(self) implicit none - class(rmvs_interp), intent(inout) :: self !! RMVS interpolated system variables object + class(rmvs_interp), intent(inout) :: self !! RMVS interpolated nbody_system variables object end subroutine rmvs_util_dealloc_interp module subroutine rmvs_util_dealloc_pl(self) @@ -213,7 +213,7 @@ end subroutine rmvs_final_cb module subroutine rmvs_final_interp(self) implicit none - type(rmvs_interp), intent(inout) :: self !! RMVS interpolated system variables object + type(rmvs_interp), intent(inout) :: self !! RMVS interpolated nbody_system variables object end subroutine rmvs_final_interp module subroutine rmvs_final_pl(self) diff --git a/src/rmvs/rmvs_setup.f90 b/src/rmvs/rmvs_setup.f90 index cc8f8839c..fe7d15b6d 100644 --- a/src/rmvs/rmvs_setup.f90 +++ b/src/rmvs/rmvs_setup.f90 @@ -70,7 +70,7 @@ module subroutine rmvs_setup_initialize_system(self, param) !! We currently rearrange the pl order to keep it consistent with the way Swifter does it !! In Swifter, the central body occupies the first position in the pl list, and during !! encounters, the encountering planet is skipped in loops. In Swiftest, we instantiate an - !! RMVS nbody system object attached to each pl to store planetocentric versions of the system + !! RMVS nbody system object attached to each pl to store planetocentric versions of the nbody_system !! to use during close encounters. implicit none ! Arguments diff --git a/src/rmvs/rmvs_step.f90 b/src/rmvs/rmvs_step.f90 index 7c602a20b..1bc313336 100644 --- a/src/rmvs/rmvs_step.f90 +++ b/src/rmvs/rmvs_step.f90 @@ -37,32 +37,32 @@ module subroutine rmvs_step_system(self, param, t, dt) class is (rmvs_pl) select type(tp => self%tp) class is (rmvs_tp) - associate(system => self, ntp => tp%nbody, npl => pl%nbody) + associate(nbody_system => self, ntp => tp%nbody, npl => pl%nbody) allocate(rbeg, source=pl%rh) allocate(vbeg, source=pl%vh) call pl%set_beg_end(rbeg = rbeg, vbeg = vbeg) ! ****** Check for close encounters ***** ! call pl%set_renc(RHSCALE) - lencounter = tp%encounter_check(param, system, dt) + lencounter = tp%encounter_check(param, nbody_system, dt) if (lencounter) then lfirstpl = pl%lfirst pl%outer(0)%x(:, 1:npl) = rbeg(:, 1:npl) pl%outer(0)%v(:, 1:npl) = vbeg(:, 1:npl) - call pl%step(system, param, t, dt) + call pl%step(nbody_system, param, t, dt) pl%outer(NTENC)%x(:, 1:npl) = pl%rh(:, 1:npl) pl%outer(NTENC)%v(:, 1:npl) = pl%vh(:, 1:npl) call rmvs_interp_out(cb, pl, dt) - call rmvs_step_out(cb, pl, tp, system, param, t, dt) + call rmvs_step_out(cb, pl, tp, nbody_system, param, t, dt) tp%lmask(1:ntp) = .not. tp%lmask(1:ntp) call pl%set_beg_end(rbeg = rbeg, rend = rend) tp%lfirst = .true. - call tp%step(system, param, t, dt) + call tp%step(nbody_system, param, t, dt) tp%lmask(1:ntp) = .true. pl%lfirst = lfirstpl tp%lfirst = .true. - ! if (param%ltides) call system%step_spin(param, t, dt) + ! if (param%ltides) call nbody_system%step_spin(param, t, dt) else - call whm_step_system(system, param, t, dt) + call whm_step_system(nbody_system, param, t, dt) end if end associate end select @@ -153,7 +153,7 @@ subroutine rmvs_interp_out(cb, pl, dt) end subroutine rmvs_interp_out - subroutine rmvs_step_out(cb, pl, tp, system, param, t, dt) + subroutine rmvs_step_out(cb, pl, tp, nbody_system, param, t, dt) !! author: David A. Minton !! !! Step ACTIVE test particles ahead in the outer encounter region, setting up and calling the inner region @@ -166,7 +166,7 @@ subroutine rmvs_step_out(cb, pl, tp, system, param, t, dt) class(rmvs_cb), intent(inout) :: cb !! RMVS central body object class(rmvs_pl), intent(inout) :: pl !! RMVS massive body object class(rmvs_tp), intent(inout) :: tp !! RMVS test particle object - class(rmvs_nbody_system), intent(inout) :: system !! RMVS nbody system object + class(rmvs_nbody_system), intent(inout) :: nbody_system !! RMVS nbody system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! Current simulation time real(DP), intent(in) :: dt !! Current stepsiz @@ -188,18 +188,18 @@ subroutine rmvs_step_out(cb, pl, tp, system, param, t, dt) call pl%set_beg_end(rbeg = pl%outer(outer_index - 1)%x(:, 1:npl), & vbeg = pl%outer(outer_index - 1)%v(:, 1:npl), & rend = pl%outer(outer_index )%x(:, 1:npl)) - lencounter = tp%encounter_check(param, system, dto) + lencounter = tp%encounter_check(param, nbody_system, dto) if (lencounter) then ! Interpolate planets in inner encounter region - call rmvs_interp_in(cb, pl, system, param, dto, outer_index) + call rmvs_interp_in(cb, pl, nbody_system, param, dto, outer_index) ! Step through the inner region call rmvs_step_in(cb, pl, tp, param, outer_time, dto) lfirsttp = tp%lfirst tp%lfirst = .true. - call tp%step(system, param, outer_time, dto) + call tp%step(nbody_system, param, outer_time, dto) tp%lfirst = lfirsttp else - call tp%step(system, param, outer_time, dto) + call tp%step(nbody_system, param, outer_time, dto) end if do j = 1, npl if (pl%nenc(j) == 0) cycle @@ -215,7 +215,7 @@ subroutine rmvs_step_out(cb, pl, tp, system, param, t, dt) end subroutine rmvs_step_out - subroutine rmvs_interp_in(cb, pl, system, param, dt, outer_index) + subroutine rmvs_interp_in(cb, pl, nbody_system, param, dt, outer_index) !! author: David A. Minton !! !! Interpolate planet positions between two Keplerian orbits in inner encounter regio @@ -227,7 +227,7 @@ subroutine rmvs_interp_in(cb, pl, system, param, dt, outer_index) ! Arguments class(rmvs_cb), intent(inout) :: cb !! RMVS cenral body object class(rmvs_pl), intent(inout) :: pl !! RMVS massive body object - class(rmvs_nbody_system), intent(inout) :: system !! RMVS nbody system object + class(rmvs_nbody_system), intent(inout) :: nbody_system !! RMVS nbody system object class(swiftest_parameters), intent(in) :: param !! Swiftest parameters file real(DP), intent(in) :: dt !! Step size integer(I4B), intent(in) :: outer_index !! Outer substep number within current set @@ -238,7 +238,7 @@ subroutine rmvs_interp_in(cb, pl, system, param, dt, outer_index) real(DP), dimension(:), allocatable :: GMcb, dti integer(I4B), dimension(:), allocatable :: iflag - associate (npl => system%pl%nbody) + associate (npl => nbody_system%pl%nbody) dntphenc = real(NTPHENC, kind=DP) ! Set the endpoints of the inner region from the outer region values in the current outer step index @@ -263,12 +263,12 @@ subroutine rmvs_interp_in(cb, pl, system, param, dt, outer_index) pl%rh(:, 1:npl) = xtmp(:, 1:npl) ! Temporarily replace heliocentric position with inner substep values to calculate the oblateness terms end if if (param%loblatecb) then - call pl%accel_obl(system) + call pl%accel_obl(nbody_system) pl%inner(0)%aobl(:, 1:npl) = pl%aobl(:, 1:npl) ! Save the oblateness acceleration on the planet for this substep end if ! TODO: Implement tides ! if (param%ltides) then - ! call pl%accel_tides(system) + ! call pl%accel_tides(nbody_system) ! pl%inner(0)%atide(:, 1:npl) = pl%atide(:, 1:npl) ! Save the oblateness acceleration on the planet for this substep ! end if @@ -318,24 +318,24 @@ subroutine rmvs_interp_in(cb, pl, system, param, dt, outer_index) if (param%loblatecb) then pl%rh(:,1:npl) = pl%inner(inner_index)%x(:, 1:npl) - call pl%accel_obl(system) + call pl%accel_obl(nbody_system) pl%inner(inner_index)%aobl(:, 1:npl) = pl%aobl(:, 1:npl) end if ! TODO: Implement tides ! if (param%ltides) then - ! call pl%accel_tides(system) + ! call pl%accel_tides(nbody_system) ! pl%inner(inner_index)%atide(:, 1:npl) = pl%atide(:, 1:npl) ! end if end do if (param%loblatecb) then ! Calculate the final value of oblateness accelerations at the final inner substep pl%rh(:, 1:npl) = pl%inner(NTPHENC)%x(:, 1:npl) - call pl%accel_obl(system) + call pl%accel_obl(nbody_system) pl%inner(NTPHENC)%aobl(:, 1:npl) = pl%aobl(:, 1:npl) end if ! TODO: Implement tides ! if (param%ltides) then - ! call pl%accel_tides(system) + ! call pl%accel_tides(nbody_system) ! pl%inner(NTPHENC)%atide(:, 1:npl) = pl%atide(:, 1:npl) ! end if ! Put the planet positions and accelerations back into place diff --git a/src/rmvs/rmvs_util.f90 b/src/rmvs/rmvs_util.f90 index 79e36e40b..26306f064 100644 --- a/src/rmvs/rmvs_util.f90 +++ b/src/rmvs/rmvs_util.f90 @@ -96,7 +96,7 @@ module subroutine rmvs_util_dealloc_interp(self) !! Deallocates all allocatabale arrays implicit none ! Argument - class(rmvs_interp), intent(inout) :: self !! RMVS interpolated system variables object + class(rmvs_interp), intent(inout) :: self !! RMVS interpolated nbody_system variables object if (allocated(self%x)) deallocate(self%x) if (allocated(self%v)) deallocate(self%v) diff --git a/src/swiftest/swiftest_discard.f90 b/src/swiftest/swiftest_discard.f90 index a3d5d861d..5f2f5d331 100644 --- a/src/swiftest/swiftest_discard.f90 +++ b/src/swiftest/swiftest_discard.f90 @@ -17,7 +17,7 @@ module subroutine swiftest_discard_system(self, param) !! implicit none ! Arguments - class(swiftest_nbody_system), intent(inout) :: self !! Swiftest system object + class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nbody_system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters ! Internals logical :: lpl_discards, ltp_discards, lpl_check, ltp_check @@ -25,16 +25,16 @@ module subroutine swiftest_discard_system(self, param) lpl_check = allocated(self%pl_discards) ltp_check = allocated(self%tp_discards) - associate(system => self, tp => self%tp, pl => self%pl, tp_discards => self%tp_discards, pl_discards => self%pl_discards) + associate(nbody_system => self, tp => self%tp, pl => self%pl, tp_discards => self%tp_discards, pl_discards => self%pl_discards) lpl_discards = .false. ltp_discards = .false. if (lpl_check) then - call pl%discard(system, param) + call pl%discard(nbody_system, param) lpl_discards = (pl_discards%nbody > 0) end if if (ltp_check) then - call tp%discard(system, param) + call tp%discard(nbody_system, param) ltp_discards = (tp_discards%nbody > 0) end if if (ltp_discards) call tp_discards%write_info(param%system_history%nc, param) @@ -49,7 +49,7 @@ module subroutine swiftest_discard_system(self, param) end subroutine swiftest_discard_system - module subroutine swiftest_discard_pl(self, system, param) + module subroutine swiftest_discard_pl(self, nbody_system, param) !! author: David A. Minton !! !! Placeholder method for discarding massive bodies. This method does nothing except to ensure that the discard flag is set to false. @@ -57,7 +57,7 @@ module subroutine swiftest_discard_pl(self, system, param) implicit none ! Arguments class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameter if (self%nbody == 0) return @@ -67,7 +67,7 @@ module subroutine swiftest_discard_pl(self, system, param) end subroutine swiftest_discard_pl - module subroutine swiftest_discard_tp(self, system, param) + module subroutine swiftest_discard_tp(self, nbody_system, param) !! author: David A. Minton !! !! Check to see if particles should be discarded based on their positions relative to the massive bodies @@ -77,13 +77,13 @@ module subroutine swiftest_discard_tp(self, system, param) implicit none ! Arguments class(swiftest_tp), intent(inout) :: self !! Swiftest test particle object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameter ! Internals logical, dimension(:), allocatable :: ldiscard integer(I4B) :: npl, ntp - associate(tp => self, cb => system%cb, pl => system%pl) + associate(tp => self, cb => nbody_system%cb, pl => nbody_system%pl) ntp = tp%nbody npl = pl%nbody @@ -93,12 +93,12 @@ module subroutine swiftest_discard_tp(self, system, param) call tp%h2b(cb) end if - if ((param%rmin >= 0.0_DP) .or. (param%rmax >= 0.0_DP) .or. (param%rmaxu >= 0.0_DP)) call swiftest_discard_cb_tp(tp, system, param) - if (param%qmin >= 0.0_DP) call swiftest_discard_peri_tp(tp, system, param) - if (param%lclose) call swiftest_discard_pl_tp(tp, system, param) + if ((param%rmin >= 0.0_DP) .or. (param%rmax >= 0.0_DP) .or. (param%rmaxu >= 0.0_DP)) call swiftest_discard_cb_tp(tp, nbody_system, param) + if (param%qmin >= 0.0_DP) call swiftest_discard_peri_tp(tp, nbody_system, param) + if (param%lclose) call swiftest_discard_pl_tp(tp, nbody_system, param) if (any(tp%ldiscard(1:ntp))) then allocate(ldiscard, source=tp%ldiscard) - call tp%spill(system%tp_discards, ldiscard(1:ntp), ldestructive=.true.) + call tp%spill(nbody_system%tp_discards, ldiscard(1:ntp), ldestructive=.true.) end if end associate @@ -106,25 +106,25 @@ module subroutine swiftest_discard_tp(self, system, param) end subroutine swiftest_discard_tp - subroutine swiftest_discard_cb_tp(tp, system, param) + subroutine swiftest_discard_cb_tp(tp, nbody_system, param) !! author: David A. Minton !! !! Check to see if test particles should be discarded based on their positions relative to the Sun - !! or because they are unbound from the system + !! or because they are unbound from the nbody_system !! !! Adapted from David E. Kaufmann's Swifter routine: discard_sun.f90 !! Adapted from Hal Levison's Swift routine discard_sun.f implicit none ! Arguments class(swiftest_tp), intent(inout) :: tp !! Swiftest test particle object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters ! Internals integer(I4B) :: i real(DP) :: energy, vb2, rb2, rh2, rmin2, rmax2, rmaxu2 character(len=STRMAX) :: idstr, timestr - associate(ntp => tp%nbody, cb => system%cb, Gmtot => system%Gmtot) + associate(ntp => tp%nbody, cb => nbody_system%cb, Gmtot => nbody_system%Gmtot) rmin2 = max(param%rmin * param%rmin, cb%radius * cb%radius) rmax2 = param%rmax**2 rmaxu2 = param%rmaxu**2 @@ -134,22 +134,22 @@ subroutine swiftest_discard_cb_tp(tp, system, param) if ((param%rmax >= 0.0_DP) .and. (rh2 > rmax2)) then tp%status(i) = DISCARDED_RMAX write(idstr, *) tp%id(i) - write(timestr, *) system%t + write(timestr, *) nbody_system%t write(*, *) "Particle " // trim(adjustl(tp%info(i)%name)) // " (" // trim(adjustl(idstr)) // ")" // & " too far from the central body at t = " // trim(adjustl(timestr)) tp%ldiscard(i) = .true. tp%lmask(i) = .false. - call tp%info(i)%set_value(status="DISCARDED_RMAX", discard_time=system%t, discard_rh=tp%rh(:,i), & + call tp%info(i)%set_value(status="DISCARDED_RMAX", discard_time=nbody_system%t, discard_rh=tp%rh(:,i), & discard_vh=tp%vh(:,i)) else if ((param%rmin >= 0.0_DP) .and. (rh2 < rmin2)) then tp%status(i) = DISCARDED_RMIN write(idstr, *) tp%id(i) - write(timestr, *) system%t + write(timestr, *) nbody_system%t write(*, *) "Particle " // trim(adjustl(tp%info(i)%name)) // " (" // trim(adjustl(idstr)) // ")" // & " too close to the central body at t = " // trim(adjustl(timestr)) tp%ldiscard(i) = .true. tp%lmask(i) = .false. - call tp%info(i)%set_value(status="DISCARDED_RMIN", discard_time=system%t, discard_rh=tp%rh(:,i), & + call tp%info(i)%set_value(status="DISCARDED_RMIN", discard_time=nbody_system%t, discard_rh=tp%rh(:,i), & discard_vh=tp%vh(:,i), discard_body_id=cb%id) else if (param%rmaxu >= 0.0_DP) then rb2 = dot_product(tp%rb(:, i), tp%rb(:, i)) @@ -158,12 +158,12 @@ subroutine swiftest_discard_cb_tp(tp, system, param) if ((energy > 0.0_DP) .and. (rb2 > rmaxu2)) then tp%status(i) = DISCARDED_RMAXU write(idstr, *) tp%id(i) - write(timestr, *) system%t + write(timestr, *) nbody_system%t write(*, *) "Particle " // trim(adjustl(tp%info(i)%name)) // " (" // trim(adjustl(idstr)) // ")" // & " is unbound and too far from barycenter at t = " // trim(adjustl(timestr)) tp%ldiscard(i) = .true. tp%lmask(i) = .false. - call tp%info(i)%set_value(status="DISCARDED_RMAXU", discard_time=system%t, discard_rh=tp%rh(:,i), & + call tp%info(i)%set_value(status="DISCARDED_RMAXU", discard_time=nbody_system%t, discard_rh=tp%rh(:,i), & discard_vh=tp%vh(:,i)) end if end if @@ -175,7 +175,7 @@ subroutine swiftest_discard_cb_tp(tp, system, param) end subroutine swiftest_discard_cb_tp - subroutine swiftest_discard_peri_tp(tp, system, param) + subroutine swiftest_discard_peri_tp(tp, nbody_system, param) !! author: David A. Minton !! !! Check to see if a test particle should be discarded because its perihelion distance becomes too small @@ -185,7 +185,7 @@ subroutine swiftest_discard_peri_tp(tp, system, param) implicit none ! Arguments class(swiftest_tp), intent(inout) :: tp !! Swiftest test particle object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(swiftest_parameters), intent(in) :: param !! Current run configuration parameterss ! Internals integer(I4B) :: i, j, ih @@ -193,8 +193,8 @@ subroutine swiftest_discard_peri_tp(tp, system, param) real(DP), dimension(NDIM) :: dx character(len=STRMAX) :: idstr, timestr - associate(cb => system%cb, ntp => tp%nbody, pl => system%pl, npl => system%pl%nbody, t => system%t) - call tp%get_peri(system, param) + associate(cb => nbody_system%cb, ntp => tp%nbody, pl => nbody_system%pl, npl => nbody_system%pl%nbody, t => nbody_system%t) + call tp%get_peri(nbody_system, param) do i = 1, ntp if (tp%status(i) == ACTIVE) then if (tp%isperi(i) == 0) then @@ -210,11 +210,11 @@ subroutine swiftest_discard_peri_tp(tp, system, param) (tp%peri(i) <= param%qmin)) then tp%status(i) = DISCARDED_PERI write(idstr, *) tp%id(i) - write(timestr, *) system%t + write(timestr, *) nbody_system%t write(*, *) "Particle " // trim(adjustl(tp%info(i)%name)) // " (" // trim(adjustl(idstr)) // ")" // & " perihelion distance too small at t = " // trim(adjustl(timestr)) tp%ldiscard(i) = .true. - call tp%info(i)%set_value(status="DISCARDED_PERI", discard_time=system%t, discard_rh=tp%rh(:,i), & + call tp%info(i)%set_value(status="DISCARDED_PERI", discard_time=nbody_system%t, discard_rh=tp%rh(:,i), & discard_vh=tp%vh(:,i), discard_body_id=pl%id(j)) end if end if @@ -227,7 +227,7 @@ subroutine swiftest_discard_peri_tp(tp, system, param) end subroutine swiftest_discard_peri_tp - subroutine swiftest_discard_pl_tp(tp, system, param) + subroutine swiftest_discard_pl_tp(tp, nbody_system, param) !! author: David A. Minton !! !! Check to see if test particles should be discarded based on their positions relative to the massive bodies @@ -237,7 +237,7 @@ subroutine swiftest_discard_pl_tp(tp, system, param) implicit none ! Arguments class(swiftest_tp), intent(inout) :: tp !! Swiftest test particle object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters ! Internals integer(I4B) :: i, j, isp @@ -245,7 +245,7 @@ subroutine swiftest_discard_pl_tp(tp, system, param) real(DP), dimension(NDIM) :: dx, dv character(len=STRMAX) :: idstri, idstrj, timestr - associate(ntp => tp%nbody, pl => system%pl, npl => system%pl%nbody, t => system%t, dt => param%dt) + associate(ntp => tp%nbody, pl => nbody_system%pl, npl => nbody_system%pl%nbody, t => nbody_system%t, dt => param%dt) do i = 1, ntp if (tp%status(i) == ACTIVE) then do j = 1, npl @@ -259,12 +259,12 @@ subroutine swiftest_discard_pl_tp(tp, system, param) pl%ldiscard(j) = .true. write(idstri, *) tp%id(i) write(idstrj, *) pl%id(j) - write(timestr, *) system%t + write(timestr, *) nbody_system%t write(*, *) "Test particle " // trim(adjustl(tp%info(i)%name)) // " (" // trim(adjustl(idstri)) // ")" & // " too close to massive body " // trim(adjustl(pl%info(j)%name)) // " (" // trim(adjustl(idstrj)) // ")" & // " at t = " // trim(adjustl(timestr)) tp%ldiscard(i) = .true. - call tp%info(i)%set_value(status="DISCARDED_PLR", discard_time=system%t, discard_rh=tp%rh(:,i), & + call tp%info(i)%set_value(status="DISCARDED_PLR", discard_time=nbody_system%t, discard_rh=tp%rh(:,i), & discard_vh=tp%vh(:,i), discard_body_id=pl%id(j)) exit end if diff --git a/src/swiftest/swiftest_drift.f90 b/src/swiftest/swiftest_drift.f90 index 23ea00ee5..8e2273435 100644 --- a/src/swiftest/swiftest_drift.f90 +++ b/src/swiftest/swiftest_drift.f90 @@ -18,7 +18,7 @@ contains - module subroutine swiftest_drift_body(self, system, param, dt) + module subroutine swiftest_drift_body(self, nbody_system, param, dt) !! author: David A. Minton !! !! Loop bodies and call Danby drift routine on the heliocentric position and velocities. @@ -28,7 +28,7 @@ module subroutine swiftest_drift_body(self, system, param, dt) implicit none ! Arguments class(swiftest_body), intent(inout) :: self !! Swiftest test particle data structure - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters real(DP), intent(in) :: dt !! Stepsize ! Internals diff --git a/src/swiftest/swiftest_driver.f90 b/src/swiftest/swiftest_driver.f90 index b83583ed4..4c0b18ce1 100644 --- a/src/swiftest/swiftest_driver.f90 +++ b/src/swiftest/swiftest_driver.f90 @@ -19,7 +19,7 @@ program swiftest_driver use symba implicit none - class(swiftest_nbody_system), allocatable :: system !! Polymorphic object containing the nbody system to be integrated + class(swiftest_nbody_system), allocatable :: nbody_system !! Polymorphic object containing the nbody system to be integrated class(swiftest_parameters), allocatable :: param !! Run configuration parameters character(len=:), allocatable :: integrator !! Integrator type code (see globals for symbolic names) character(len=:), allocatable :: param_file_name !! Name of the file containing user-defined parameters @@ -43,7 +43,7 @@ program swiftest_driver call swiftest_io_get_args(integrator, param_file_name, display_style) - !> Read in the user-defined parameters file and the initial conditions of the system + !> Read in the user-defined parameters file and the initial conditions of the nbody_system allocate(swiftest_parameters :: param) param%integrator = trim(adjustl(integrator)) call param%set_display(display_style) @@ -67,11 +67,11 @@ program swiftest_driver istart = ceiling((tstart - t0) / dt + 1.0_DP, kind=I8B) ioutput = max(int(istart / istep_out, kind=I4B),1) - ! Set up system storage for intermittent file dumps + ! Set up nbody_system storage for intermittent file dumps if (dump_cadence == 0) dump_cadence = ceiling(nloops / (1.0_DP * istep_out), kind=I8B) - ! Construct the main n-body system using the user-input integrator to choose the type of system - call swiftest_setup_construct_system(system, param) + ! Construct the main n-body nbody_system using the user-input integrator to choose the type of nbody_system + call swiftest_setup_construct_system(nbody_system, param) !> Define the maximum number of threads nthreads = 1 ! In the *serial* case @@ -81,19 +81,19 @@ program swiftest_driver !$ write(param%display_unit,'(a,i3,/)') ' Number of threads = ', nthreads !$ if (param%log_output) write(*,'(a,i3)') ' OpenMP: Number of threads = ',nthreads - call system%initialize(param) + call nbody_system%initialize(param) associate (system_history => param%system_history) ! If this is a new run, compute energy initial conditions (if energy tracking is turned on) and write the initial conditions to file. if (param%lenergy) then if (param%lrestart) then - call system%conservation_report(param, lterminal=.true.) + call nbody_system%conservation_report(param, lterminal=.true.) else - call system%conservation_report(param, lterminal=.false.) ! This will save the initial values of energy and momentum + call nbody_system%conservation_report(param, lterminal=.false.) ! This will save the initial values of energy and momentum end if end if - call system_history%take_snapshot(param,system) - call system%dump(param) + call system_history%take_snapshot(param,nbody_system) + call nbody_system%dump(param) write(display_unit, *) " *************** Main Loop *************** " @@ -103,22 +103,22 @@ program swiftest_driver call pbar%update(1,message=pbarmessage) else if (display_style == "COMPACT") then write(*,*) "SWIFTEST START " // param%integrator - call system%compact_output(param,integration_timer) + call nbody_system%compact_output(param,integration_timer) end if iout = 0 idump = 0 - system%t = tstart + nbody_system%t = tstart do iloop = istart, nloops - !> Step the system forward in time + !> Step the nbody_system forward in time call integration_timer%start() - call system%step(param, system%t, dt) + call nbody_system%step(param, nbody_system%t, dt) call integration_timer%stop() - system%t = t0 + iloop * dt + nbody_system%t = t0 + iloop * dt !> Evaluate any discards or collisional outcomes - call system%discard(param) + call nbody_system%discard(param) if (display_style == "PROGRESS") call pbar%update(iloop) !> If the loop counter is at the output cadence value, append the data file with a single frame @@ -127,30 +127,30 @@ program swiftest_driver if (iout == istep_out) then iout = 0 idump = idump + 1 - call system_history%take_snapshot(param,system) + call system_history%take_snapshot(param,nbody_system) if (idump == dump_cadence) then idump = 0 - call system%dump(param) + call nbody_system%dump(param) end if - tfrac = (system%t - t0) / (tstop - t0) + tfrac = (nbody_system%t - t0) / (tstop - t0) - select type(pl => system%pl) + select type(pl => nbody_system%pl) class is (symba_pl) - write(display_unit, symbastatfmt) system%t, tfrac, pl%nplm, pl%nbody, system%tp%nbody + write(display_unit, symbastatfmt) nbody_system%t, tfrac, pl%nplm, pl%nbody, nbody_system%tp%nbody class default - write(display_unit, statusfmt) system%t, tfrac, pl%nbody, system%tp%nbody + write(display_unit, statusfmt) nbody_system%t, tfrac, pl%nbody, nbody_system%tp%nbody end select - if (param%lenergy) call system%conservation_report(param, lterminal=.true.) + if (param%lenergy) call nbody_system%conservation_report(param, lterminal=.true.) call integration_timer%report(message="Integration steps:", unit=display_unit, nsubsteps=istep_out) if (display_style == "PROGRESS") then - write(pbarmessage,fmt=pbarfmt) system%t, tstop + write(pbarmessage,fmt=pbarfmt) nbody_system%t, tstop call pbar%update(1,message=pbarmessage) else if (display_style == "COMPACT") then - call system%compact_output(param,integration_timer) + call nbody_system%compact_output(param,integration_timer) end if call integration_timer%reset() @@ -160,7 +160,7 @@ program swiftest_driver end do ! Dump any remaining history if it exists - call system%dump(param) + call nbody_system%dump(param) call system_history%dump(param) if (display_style == "COMPACT") write(*,*) "SWIFTEST STOP" // param%integrator end associate diff --git a/src/swiftest/swiftest_gr.f90 b/src/swiftest/swiftest_gr.f90 index e3467b8c0..b4cc17c2b 100644 --- a/src/swiftest/swiftest_gr.f90 +++ b/src/swiftest/swiftest_gr.f90 @@ -10,7 +10,7 @@ submodule(swiftest) s_gr contains - pure module subroutine swiftest_gr_kick_getaccb_ns_body(self, system, param) + pure module subroutine swiftest_gr_kick_getaccb_ns_body(self, nbody_system, param) !! author: David A. Minton !! !! Add relativistic correction acceleration for non-symplectic integrators. @@ -24,13 +24,13 @@ pure module subroutine swiftest_gr_kick_getaccb_ns_body(self, system, param) implicit none ! Arguments class(swiftest_body), intent(inout) :: self !! Swiftest generic body object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters ! Internals real(DP) :: rmag, rdotv, vmag2 integer(I4B) :: i - associate(n => self%nbody, cb => system%cb, inv_c2 => param%inv_c2) + associate(n => self%nbody, cb => nbody_system%cb, inv_c2 => param%inv_c2) if (n == 0) return do i = 1, n rmag = norm2(self%rh(:,i)) diff --git a/src/swiftest/swiftest_io.f90 b/src/swiftest/swiftest_io.f90 index 456bef4a0..d3fbb229e 100644 --- a/src/swiftest/swiftest_io.f90 +++ b/src/swiftest/swiftest_io.f90 @@ -130,50 +130,50 @@ module subroutine swiftest_io_conservation_report(self, param, lterminal) "; D(Eorbit+Ecollisions)/|E0| = ", ES12.5, & "; DM/M0 = ", ES12.5)' - associate(system => self, pl => self%pl, cb => self%cb, npl => self%pl%nbody, display_unit => param%display_unit, nc => param%system_history%nc) + associate(nbody_system => self, pl => self%pl, cb => self%cb, npl => self%pl%nbody, display_unit => param%display_unit, nc => param%system_history%nc) call pl%vb2vh(cb) call pl%rh2rb(cb) - call system%get_energy_and_momentum(param) - ke_orbit_now = system%ke_orbit - ke_spin_now = system%ke_spin - pe_now = system%pe - Lorbit_now(:) = system%Lorbit(:) - Lspin_now(:) = system%Lspin(:) + call nbody_system%get_energy_and_momentum(param) + ke_orbit_now = nbody_system%ke_orbit + ke_spin_now = nbody_system%ke_spin + pe_now = nbody_system%pe + Lorbit_now(:) = nbody_system%Lorbit(:) + Lspin_now(:) = nbody_system%Lspin(:) Eorbit_now = ke_orbit_now + ke_spin_now + pe_now - Ltot_now(:) = system%Ltot(:) + system%Lescape(:) - GMtot_now = system%GMtot + system%GMescape + Ltot_now(:) = nbody_system%Ltot(:) + nbody_system%Lescape(:) + GMtot_now = nbody_system%GMtot + nbody_system%GMescape if (param%lfirstenergy) then - system%ke_orbit_orig = ke_orbit_now - system%ke_spin_orig = ke_spin_now - system%pe_orig = pe_now - system%Eorbit_orig = Eorbit_now - system%GMtot_orig = GMtot_now - system%Lorbit_orig(:) = Lorbit_now(:) - system%Lspin_orig(:) = Lspin_now(:) - system%Ltot_orig(:) = Ltot_now(:) + nbody_system%ke_orbit_orig = ke_orbit_now + nbody_system%ke_spin_orig = ke_spin_now + nbody_system%pe_orig = pe_now + nbody_system%Eorbit_orig = Eorbit_now + nbody_system%GMtot_orig = GMtot_now + nbody_system%Lorbit_orig(:) = Lorbit_now(:) + nbody_system%Lspin_orig(:) = Lspin_now(:) + nbody_system%Ltot_orig(:) = Ltot_now(:) param%lfirstenergy = .false. end if if (.not.param%lfirstenergy) then - system%ke_orbit_error = (ke_orbit_now - system%ke_orbit_orig) / abs(system%Eorbit_orig) - system%ke_spin_error = (ke_spin_now - system%ke_spin_orig) / abs(system%Eorbit_orig) - system%pe_error = (pe_now - system%pe_orig) / abs(system%Eorbit_orig) - system%Eorbit_error = (Eorbit_now - system%Eorbit_orig) / abs(system%Eorbit_orig) - system%Ecoll_error = system%Ecollisions / abs(system%Eorbit_orig) - system%Euntracked_error = system%Euntracked / abs(system%Eorbit_orig) - system%Etot_error = (Eorbit_now - system%Ecollisions - system%Eorbit_orig - system%Euntracked) / abs(system%Eorbit_orig) - - system%Lorbit_error = norm2(Lorbit_now(:) - system%Lorbit_orig(:)) / norm2(system%Ltot_orig(:)) - system%Lspin_error = norm2(Lspin_now(:) - system%Lspin_orig(:)) / norm2(system%Ltot_orig(:)) - system%Lescape_error = norm2(system%Lescape(:)) / norm2(system%Ltot_orig(:)) - system%Ltot_error = norm2(Ltot_now(:) - system%Ltot_orig(:)) / norm2(system%Ltot_orig(:)) - system%Mescape_error = system%GMescape / system%GMtot_orig - system%Mtot_error = (GMtot_now - system%GMtot_orig) / system%GMtot_orig - if (lterminal) write(display_unit, EGYTERMFMT) system%Ltot_error, system%Ecoll_error, system%Etot_error,system%Mtot_error - if (abs(system%Mtot_error) > 100 * epsilon(system%Mtot_error)) then + nbody_system%ke_orbit_error = (ke_orbit_now - nbody_system%ke_orbit_orig) / abs(nbody_system%Eorbit_orig) + nbody_system%ke_spin_error = (ke_spin_now - nbody_system%ke_spin_orig) / abs(nbody_system%Eorbit_orig) + nbody_system%pe_error = (pe_now - nbody_system%pe_orig) / abs(nbody_system%Eorbit_orig) + nbody_system%Eorbit_error = (Eorbit_now - nbody_system%Eorbit_orig) / abs(nbody_system%Eorbit_orig) + nbody_system%Ecoll_error = nbody_system%Ecollisions / abs(nbody_system%Eorbit_orig) + nbody_system%Euntracked_error = nbody_system%Euntracked / abs(nbody_system%Eorbit_orig) + nbody_system%Etot_error = (Eorbit_now - nbody_system%Ecollisions - nbody_system%Eorbit_orig - nbody_system%Euntracked) / abs(nbody_system%Eorbit_orig) + + nbody_system%Lorbit_error = norm2(Lorbit_now(:) - nbody_system%Lorbit_orig(:)) / norm2(nbody_system%Ltot_orig(:)) + nbody_system%Lspin_error = norm2(Lspin_now(:) - nbody_system%Lspin_orig(:)) / norm2(nbody_system%Ltot_orig(:)) + nbody_system%Lescape_error = norm2(nbody_system%Lescape(:)) / norm2(nbody_system%Ltot_orig(:)) + nbody_system%Ltot_error = norm2(Ltot_now(:) - nbody_system%Ltot_orig(:)) / norm2(nbody_system%Ltot_orig(:)) + nbody_system%Mescape_error = nbody_system%GMescape / nbody_system%GMtot_orig + nbody_system%Mtot_error = (GMtot_now - nbody_system%GMtot_orig) / nbody_system%GMtot_orig + if (lterminal) write(display_unit, EGYTERMFMT) nbody_system%Ltot_error, nbody_system%Ecoll_error, nbody_system%Etot_error,nbody_system%Mtot_error + if (abs(nbody_system%Mtot_error) > 100 * epsilon(nbody_system%Mtot_error)) then write(*,*) "Severe error! Mass not conserved! Halting!" ! Save the frame of data to the bin file in the slot just after the present one for diagnostics param%ioutput = param%ioutput + 1 @@ -226,12 +226,12 @@ end subroutine swiftest_io_dump_param module subroutine swiftest_io_dump_system(self, param) !! author: David A. Minton !! - !! Dumps the state of the system to files in case the simulation is interrupted. + !! Dumps the state of the nbody_system to files in case the simulation is interrupted. !! As a safety mechanism, there are two dump files that are written in alternating order !! so that if a dump file gets corrupted during writing, the user can restart from the older one. implicit none ! Arguments - class(swiftest_nbody_system), intent(inout) :: self !! Swiftest system object + class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nbody_system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters ! Internals class(swiftest_parameters), allocatable :: dump_param !! Local parameters variable used to parameters change input file names @@ -268,7 +268,7 @@ module subroutine swiftest_io_dump_system(self, param) if (param%lenc_save_trajectory .or. param%lenc_save_closest) call self%encounter_history%dump(param) call self%collision_history%dump(param) - ! Dump the system history to file + ! Dump the nbody_system history to file call param%system_history%dump(param) return @@ -278,7 +278,7 @@ end subroutine swiftest_io_dump_system module subroutine swiftest_io_dump_storage(self, param) !! author: David A. Minton !! - !! Dumps the time history of the simulation to file. Each time it writes a frame to file, it deallocates the system + !! Dumps the time history of the simulation to file. Each time it writes a frame to file, it deallocates the nbody_system !! object from inside. It will only dump frames with systems that are allocated, so this can be called at the end of !! a simulation for cases when the number of saved frames is not equal to the dump cadence (for instance, if the dump !! cadence is not divisible by the total number of loops). @@ -296,9 +296,9 @@ module subroutine swiftest_io_dump_storage(self, param) do i = 1, self%iframe if (allocated(self%frame(i)%item)) then param%ioutput = iloop_start + self%tmap(i) - select type(system => self%frame(i)%item) + select type(nbody_system => self%frame(i)%item) class is (swiftest_nbody_system) - call system%write_frame(param) + call nbody_system%write_frame(param) end select deallocate(self%frame(i)%item) end if @@ -578,7 +578,7 @@ end function swiftest_io_netcdf_get_old_t_final_system module subroutine swiftest_io_netcdf_initialize_output(self, param) !! author: Carlisle A. Wishard, Dana Singh, and David A. Minton !! - !! Initialize a NetCDF file system and defines all variables. + !! Initialize a NetCDF file nbody_system and defines all variables. use, intrinsic :: ieee_arithmetic implicit none ! Arguments @@ -881,7 +881,7 @@ module function swiftest_io_netcdf_read_frame_system(self, nc, param) result(ier !! 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(swiftest_nbody_system), intent(inout) :: self !! Swiftest nbody_system object class(swiftest_netcdf_parameters), intent(inout) :: nc !! Parameters used to identify a particular NetCDF dataset class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters ! Return @@ -1108,7 +1108,7 @@ module function swiftest_io_netcdf_read_frame_system(self, nc, param) result(ier return 667 continue - write(*,*) "Error reading system frame in netcdf_io_read_frame_system" + write(*,*) "Error reading nbody_system frame in netcdf_io_read_frame_system" end function swiftest_io_netcdf_read_frame_system @@ -1568,7 +1568,7 @@ module subroutine swiftest_io_netcdf_write_frame_system(self, nc, param) !! 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(swiftest_nbody_system), intent(inout) :: self !! Swiftest nbody_system object class(swiftest_netcdf_parameters), intent(inout) :: nc !! Parameters used to for writing a NetCDF dataset to file class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters @@ -1928,7 +1928,7 @@ module subroutine swiftest_io_param_reader(self, unit, iotype, v_list, iostat, i case("SEED") read(param_value, *) nseeds_from_file ! Because the number of seeds can vary between compilers/systems, we need to make sure we can handle cases in which the input file has a different - ! number of seeds than the current system. If the number of seeds in the file is smaller than required, we will use them as a source to fill in the missing elements. + ! number of seeds than the current nbody_system. If the number of seeds in the file is smaller than required, we will use them as a source to fill in the missing elements. ! If the number of seeds in the file is larger than required, we will truncate the seed array. if (nseeds_from_file > nseeds) then nseeds = nseeds_from_file @@ -2045,12 +2045,12 @@ module subroutine swiftest_io_param_reader(self, unit, iotype, v_list, iostat, i return end if - ! Calculate the G for the system units + ! Calculate the G for the nbody_system units param%GU = GC / (param%DU2M**3 / (param%MU2KG * param%TU2S**2)) ! All reporting of collision information in SyMBA (including mergers) is now recorded in the Fraggle logfile - call swiftest_io_log_start(param, FRAGGLE_LOG_OUT, "Fraggle logfile") + call swiftest_io_log_start(param, COLLISION_LOG_OUT, "Fraggle logfile") if ((param%encounter_save /= "NONE") .and. & (param%encounter_save /= "TRAJECTORY") .and. & @@ -2111,7 +2111,7 @@ module subroutine swiftest_io_param_reader(self, unit, iotype, v_list, iostat, i end select if (param%lgr) then - ! Calculate the inverse speed of light in the system units + ! Calculate the inverse speed of light in the nbody_system units param%inv_c2 = einsteinC * param%TU2S / param%DU2M param%inv_c2 = (param%inv_c2)**(-2) end if @@ -2584,7 +2584,7 @@ end subroutine swiftest_io_read_in_cb module subroutine swiftest_io_read_in_system(self, param) !! author: David A. Minton and Carlisle A. Wishard !! - !! Reads in the system from input files + !! Reads in the nbody_system from input files implicit none ! Arguments class(swiftest_nbody_system), intent(inout) :: self @@ -2859,7 +2859,7 @@ module subroutine swiftest_io_write_frame_system(self, param) !! Adapted from Hal Levison's Swift routine io_write_frame.f implicit none ! Arguments - class(swiftest_nbody_system), intent(inout) :: self !! Swiftest system object + class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nbody_system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters ! Internals logical, save :: lfirst = .true. !! Flag to determine if this is the first call of this method @@ -2898,7 +2898,7 @@ module subroutine swiftest_io_write_frame_system(self, param) return 667 continue - write(*,*) "Error writing system frame: " // trim(adjustl(errmsg)) + write(*,*) "Error writing nbody_system frame: " // trim(adjustl(errmsg)) call util_exit(FAILURE) end subroutine swiftest_io_write_frame_system diff --git a/src/swiftest/swiftest_module.f90 b/src/swiftest/swiftest_module.f90 index 34ddefcdb..4ce4ac3b5 100644 --- a/src/swiftest/swiftest_module.f90 +++ b/src/swiftest/swiftest_module.f90 @@ -64,7 +64,7 @@ module swiftest procedure :: dump => swiftest_io_dump_storage !! Dumps storage object contents to file procedure :: get_index_values => swiftest_util_get_vals_storage !! Gets the unique values of the indices of a storage object (i.e. body id or time value) procedure :: make_index_map => swiftest_util_index_map_storage !! Maps body id values to storage index values so we don't have to use unlimited dimensions for id - procedure :: take_snapshot => swiftest_util_snapshot_system !! Takes a snapshot of the system for later file storage + procedure :: take_snapshot => swiftest_util_snapshot_system !! Takes a snapshot of the nbody_system for later file storage final :: swiftest_final_storage end type swiftest_storage @@ -139,7 +139,7 @@ module swiftest procedure :: pv2v => swiftest_gr_pv2vh_body !! Converts from psudeovelocity to velocity for GR calculations using symplectic integrators procedure :: read_frame_bin => swiftest_io_read_frame_body !! I/O routine for writing out a single frame of time-series data for the central body procedure :: read_in => swiftest_io_read_in_body !! Read in body initial conditions from an ascii file - procedure :: write_frame => swiftest_io_netcdf_write_frame_body !! I/O routine for writing out a single frame of time-series data for all bodies in the system in NetCDF format + procedure :: write_frame => swiftest_io_netcdf_write_frame_body !! I/O routine for writing out a single frame of time-series data for all bodies in the nbody_system in NetCDF format procedure :: write_info => swiftest_io_netcdf_write_info_body !! Dump contents of particle information metadata to file procedure :: accel_obl => swiftest_obl_acc_body !! Compute the barycentric accelerations of bodies due to the oblateness of the central body procedure :: el2xv => swiftest_orbel_el2xv_vec !! Convert orbital elements to position and velocity vectors @@ -149,7 +149,7 @@ module swiftest procedure :: append => swiftest_util_append_body !! Appends elements from one structure to another procedure :: dealloc => swiftest_util_dealloc_body !! Deallocates all allocatable arrays procedure :: fill => swiftest_util_fill_body !! "Fills" bodies from one object into another depending on the results of a mask (uses the UNPACK intrinsic) - procedure :: get_peri => swiftest_util_peri_body !! Determine system pericenter passages for test particles + procedure :: get_peri => swiftest_util_peri_body !! Determine nbody_system pericenter passages for test particles procedure :: resize => swiftest_util_resize_body !! Checks the current size of a Swiftest body against the requested size and resizes it if it is too small. procedure :: set_ir3 => swiftest_util_set_ir3h !! Sets the inverse heliocentric radius term (1/rh**3) @@ -211,7 +211,7 @@ module swiftest real(DP) :: dR = 0.0_DP !! Change in the radius of the central body contains procedure :: read_in => swiftest_io_read_in_cb !! Read in central body initial conditions from an ASCII file - procedure :: write_frame => swiftest_io_netcdf_write_frame_cb !! I/O routine for writing out a single frame of time-series data for all bodies in the system in NetCDF format + procedure :: write_frame => swiftest_io_netcdf_write_frame_cb !! I/O routine for writing out a single frame of time-series data for all bodies in the nbody_system in NetCDF format procedure :: write_info => swiftest_io_netcdf_write_info_cb !! Dump contents of particle information metadata to file end type swiftest_cb @@ -307,7 +307,7 @@ module swiftest !> An abstract class for a basic Swiftest nbody system type, abstract, extends(base_nbody_system) :: swiftest_nbody_system - !! This superclass contains a minimial system of a set of test particles (tp), massive bodies (pl), and a central body (cb) + !! This superclass contains a minimial nbody_system of a set of test particles (tp), massive bodies (pl), and a central body (cb) !! The full swiftest_nbody_system type that is used as the parent class of all integrators is defined in collision class(swiftest_cb), allocatable :: cb !! Central body data structure @@ -316,38 +316,38 @@ module swiftest class(swiftest_tp), allocatable :: tp_discards !! Discarded test particle data structure class(swiftest_pl), allocatable :: pl_discards !! Discarded massive body particle data structure - class(swiftest_pl), allocatable :: pl_adds !! List of added bodies in mergers or collisions - class(swiftest_tp), allocatable :: tp_adds !! List of added bodies in mergers or collisions - class(encounter_list), allocatable :: pltp_encounter !! List of massive body-test particle encounters in a single step - class(encounter_list), allocatable :: plpl_encounter !! List of massive body-massive body encounters in a single step + class(swiftest_pl), allocatable :: pl_adds !! List of added bodies in mergers or collisions + class(swiftest_tp), allocatable :: tp_adds !! List of added bodies in mergers or collisions + class(encounter_list), allocatable :: pltp_encounter !! List of massive body-test particle encounters in a single step + class(encounter_list), allocatable :: plpl_encounter !! List of massive body-massive body encounters in a single step class(collision_list_plpl), allocatable :: plpl_collision !! List of massive body-massive body collisions in a single step class(collision_list_plpl), allocatable :: pltp_collision !! List of massive body-massive body collisions in a single step - class(collision_system), allocatable :: collision_system !! Collision system object + class(collision_system), allocatable :: collider !! Collision system object class(encounter_storage(nframes=:)), allocatable :: encounter_history !! Stores encounter history for later retrieval and saving to file class(collision_storage(nframes=:)), allocatable :: collision_history !! Stores encounter history for later retrieval and saving to file real(DP) :: t = -1.0_DP !! Integration current time - real(DP) :: GMtot = 0.0_DP !! Total system mass - used for barycentric coordinate conversion - real(DP) :: ke_orbit = 0.0_DP !! System orbital kinetic energy - real(DP) :: ke_spin = 0.0_DP !! System spin kinetic energy - real(DP) :: pe = 0.0_DP !! System potential energy - real(DP) :: te = 0.0_DP !! System total energy - real(DP) :: oblpot = 0.0_DP !! System potential energy due to oblateness of the central body - real(DP), dimension(NDIM) :: Lorbit = 0.0_DP !! System orbital angular momentum vector - real(DP), dimension(NDIM) :: Lspin = 0.0_DP !! System spin angular momentum vector - real(DP), dimension(NDIM) :: Ltot = 0.0_DP !! System angular momentum vector + real(DP) :: GMtot = 0.0_DP !! Total nbody_system mass - used for barycentric coordinate conversion + real(DP) :: ke_orbit = 0.0_DP !! nbody_system orbital kinetic energy + real(DP) :: ke_spin = 0.0_DP !! nbody_system spin kinetic energy + real(DP) :: pe = 0.0_DP !! nbody_system potential energy + real(DP) :: te = 0.0_DP !! nbody_system total energy + real(DP) :: oblpot = 0.0_DP !! nbody_system potential energy due to oblateness of the central body + real(DP), dimension(NDIM) :: Lorbit = 0.0_DP !! nbody_system orbital angular momentum vector + real(DP), dimension(NDIM) :: Lspin = 0.0_DP !! nbody_system spin angular momentum vector + real(DP), dimension(NDIM) :: Ltot = 0.0_DP !! nbody_system angular momentum vector real(DP) :: ke_orbit_orig = 0.0_DP !! Initial orbital kinetic energy real(DP) :: ke_spin_orig = 0.0_DP !! Initial spin kinetic energy real(DP) :: pe_orig = 0.0_DP !! Initial potential energy real(DP) :: Eorbit_orig = 0.0_DP !! Initial orbital energy - real(DP) :: GMtot_orig = 0.0_DP !! Initial system mass + real(DP) :: GMtot_orig = 0.0_DP !! Initial nbody_system mass real(DP), dimension(NDIM) :: Ltot_orig = 0.0_DP !! Initial total angular momentum vector real(DP), dimension(NDIM) :: Lorbit_orig = 0.0_DP !! Initial orbital angular momentum real(DP), dimension(NDIM) :: Lspin_orig = 0.0_DP !! Initial spin angular momentum vector - real(DP), dimension(NDIM) :: Lescape = 0.0_DP !! Angular momentum of bodies that escaped the system (used for bookeeping) - real(DP) :: GMescape = 0.0_DP !! Mass of bodies that escaped the system (used for bookeeping) - real(DP) :: Ecollisions = 0.0_DP !! Energy lost from system due to collisions - real(DP) :: Euntracked = 0.0_DP !! Energy gained from system due to escaped bodies + real(DP), dimension(NDIM) :: Lescape = 0.0_DP !! Angular momentum of bodies that escaped the nbody_system (used for bookeeping) + real(DP) :: GMescape = 0.0_DP !! Mass of bodies that escaped the nbody_system (used for bookeeping) + real(DP) :: Ecollisions = 0.0_DP !! Energy lost from nbody_system due to collisions + real(DP) :: Euntracked = 0.0_DP !! Energy gained from nbody_system due to escaped bodies ! Energy, momentum, and mass errors (used in error reporting) real(DP) :: ke_orbit_error = 0.0_DP @@ -372,10 +372,10 @@ module swiftest procedure(abstract_step_system), deferred :: step ! Concrete classes that are common to the basic integrator (only test particles considered for discard) - procedure :: discard => swiftest_discard_system !! Perform a discard step on the system + procedure :: discard => swiftest_discard_system !! Perform a discard step on the nbody_system procedure :: compact_output => swiftest_io_compact_output !! Prints out out terminal output when display_style is set to COMPACT procedure :: conservation_report => swiftest_io_conservation_report !! Compute energy and momentum and print out the change with time - procedure :: dump => swiftest_io_dump_system !! Dump the state of the system to a file + procedure :: dump => swiftest_io_dump_system !! Dump the state of the nbody_system to a file procedure :: get_old_t_final => swiftest_io_netcdf_get_old_t_final_system !! Validates the dump file to check whether the dump file initial conditions duplicate the last frame of the netcdf output. procedure :: read_frame => swiftest_io_netcdf_read_frame_system !! Read in a frame of input data from file procedure :: write_frame_netcdf => swiftest_io_netcdf_write_frame_system !! Write a frame of input data from file @@ -385,14 +385,14 @@ module swiftest procedure :: read_in => swiftest_io_read_in_system !! Reads the initial conditions for an nbody system procedure :: read_particle_info => swiftest_io_netcdf_read_particle_info_system !! Read in particle metadata from file procedure :: obl_pot => swiftest_obl_pot_system !! Compute the contribution to the total gravitational potential due solely to the oblateness of the central body - procedure :: initialize => swiftest_setup_initialize_system !! Initialize the system from input files - procedure :: init_particle_info => swiftest_setup_initialize_particle_info_system !! Initialize the system from input files + procedure :: initialize => swiftest_setup_initialize_system !! Initialize the nbody_system from input files + procedure :: init_particle_info => swiftest_setup_initialize_particle_info_system !! Initialize the nbody_system from input files ! procedure :: step_spin => tides_step_spin_system !! Steps the spins of the massive & central bodies due to tides. - procedure :: set_msys => swiftest_util_set_msys !! Sets the value of msys from the masses of system bodies. - procedure :: get_energy_and_momentum => swiftest_util_get_energy_momentum_system !! Calculates the total system energy and momentum - procedure :: get_idvals => swiftest_util_get_idvalues_system !! Returns an array of all id values in use in the system - procedure :: rescale => swiftest_util_rescale_system !! Rescales the system into a new set of units - procedure :: validate_ids => swiftest_util_valid_id_system !! Validate the numerical ids passed to the system and save the maximum value + procedure :: set_msys => swiftest_util_set_msys !! Sets the value of msys from the masses of nbody_system bodies. + procedure :: get_energy_and_momentum => swiftest_util_get_energy_momentum_system !! Calculates the total nbody_system energy and momentum + procedure :: get_idvals => swiftest_util_get_idvalues_system !! Returns an array of all id values in use in the nbody_system + procedure :: rescale => swiftest_util_rescale_system !! Rescales the nbody_system into a new set of units + procedure :: validate_ids => swiftest_util_valid_id_system !! Validate the numerical ids passed to the nbody_system and save the maximum value procedure :: write_discard => swiftest_io_write_discard !! Write out information about discarded and merged planets and test particles in SyMBA generic :: write_frame => write_frame_system, write_frame_netcdf !! Generic method call for reading a frame of output data end type swiftest_nbody_system @@ -400,27 +400,27 @@ module swiftest abstract interface - subroutine abstract_accel(self, system, param, t, lbeg) + subroutine abstract_accel(self, nbody_system, param, t, lbeg) import swiftest_body, swiftest_nbody_system, swiftest_parameters, DP class(swiftest_body), intent(inout) :: self !! Swiftest body data structure - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! Current simulation time logical, intent(in) :: lbeg !! Optional argument that determines whether or not this is the beginning or end of the step end subroutine abstract_accel - subroutine abstract_discard_body(self, system, param) + subroutine abstract_discard_body(self, nbody_system, param) import swiftest_body, swiftest_nbody_system, swiftest_parameters class(swiftest_body), intent(inout) :: self !! Swiftest body object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters end subroutine abstract_discard_body - subroutine abstract_kick_body(self, system, param, t, dt, lbeg) + subroutine abstract_kick_body(self, nbody_system, param, t, dt, lbeg) import swiftest_body, swiftest_nbody_system, swiftest_parameters, DP implicit none class(swiftest_body), intent(inout) :: self !! Swiftest generic body object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system objec + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system objec class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! Current time real(DP), intent(in) :: dt !! Stepsize @@ -433,11 +433,11 @@ subroutine abstract_set_mu(self, cb) class(swiftest_cb), intent(inout) :: cb !! Swiftest central body object end subroutine abstract_set_mu - subroutine abstract_step_body(self, system, param, t, dt) + subroutine abstract_step_body(self, nbody_system, param, t, dt) import DP, swiftest_body, swiftest_nbody_system, swiftest_parameters implicit none class(swiftest_body), intent(inout) :: self !! Swiftest body object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody_system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! Simulation time real(DP), intent(in) :: dt !! Current stepsize @@ -446,7 +446,7 @@ end subroutine abstract_step_body subroutine abstract_step_system(self, param, t, dt) import DP, swiftest_nbody_system, swiftest_parameters implicit none - class(swiftest_nbody_system), intent(inout) :: self !! Swiftest system object + class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nbody_system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! Simulation time real(DP), intent(in) :: dt !! Current stepsize @@ -455,23 +455,23 @@ end subroutine abstract_step_system interface - module subroutine swiftest_discard_pl(self, system, param) + module subroutine swiftest_discard_pl(self, nbody_system, param) implicit none class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameter end subroutine swiftest_discard_pl module subroutine swiftest_discard_system(self, param) implicit none - class(swiftest_nbody_system), intent(inout) :: self !! Swiftest system object + class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nbody_system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters end subroutine swiftest_discard_system - module subroutine swiftest_discard_tp(self, system, param) + module subroutine swiftest_discard_tp(self, nbody_system, param) implicit none class(swiftest_tp), intent(inout) :: self !! Swiftest test particle object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters end subroutine swiftest_discard_tp @@ -486,10 +486,10 @@ module subroutine swiftest_drift_all(mu, x, v, n, param, dt, lmask, iflag) integer(I4B), dimension(:), intent(out) :: iflag !! Vector of error flags. 0 means no problem end subroutine swiftest_drift_all - module subroutine swiftest_drift_body(self, system, param, dt) + module subroutine swiftest_drift_body(self, nbody_system, param, dt) implicit none class(swiftest_body), intent(inout) :: self !! Swiftest particle data structure - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters real(DP), intent(in) :: dt !! Stepsize end subroutine swiftest_drift_body @@ -503,10 +503,10 @@ pure elemental module subroutine swiftest_drift_one(mu, px, py, pz, vx, vy, vz, integer(I4B), intent(out) :: iflag !! iflag : error status flag for Danby drift (0 = OK, nonzero = ERROR) end subroutine swiftest_drift_one - pure module subroutine swiftest_gr_kick_getaccb_ns_body(self, system, param) + pure module subroutine swiftest_gr_kick_getaccb_ns_body(self, nbody_system, param) implicit none class(swiftest_body), intent(inout) :: self !! Swiftest generic body object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters end subroutine swiftest_gr_kick_getaccb_ns_body @@ -580,7 +580,7 @@ end subroutine swiftest_io_dump_param module subroutine swiftest_io_dump_system(self, param) implicit none - class(swiftest_nbody_system), intent(inout) :: self !! Swiftest system object + class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nbody_system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters end subroutine swiftest_io_dump_system @@ -647,7 +647,7 @@ end subroutine swiftest_io_netcdf_open module function swiftest_io_netcdf_read_frame_system(self, nc, param) result(ierr) implicit none - class(swiftest_nbody_system), intent(inout) :: self !! Swiftest system object + class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nbody_system object class(swiftest_netcdf_parameters), intent(inout) :: nc !! Parameters used to for reading a NetCDF dataset to file class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters integer(I4B) :: ierr !! Error code: returns 0 if the read is successful @@ -685,7 +685,7 @@ end subroutine swiftest_io_netcdf_write_frame_cb module subroutine swiftest_io_netcdf_write_frame_system(self, nc, param) implicit none - class(swiftest_nbody_system), intent(inout) :: self !! Swiftest system object + class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nbody_system object class(swiftest_netcdf_parameters), intent(inout) :: nc !! Parameters used to for writing a NetCDF dataset to file class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters end subroutine swiftest_io_netcdf_write_frame_system @@ -834,7 +834,7 @@ end function swiftest_io_read_frame_body module function swiftest_io_read_frame_system(self, iu, param) result(ierr) implicit none - class(swiftest_nbody_system),intent(inout) :: self !! Swiftest system object + class(swiftest_nbody_system),intent(inout) :: self !! Swiftest nbody_system object integer(I4B), intent(inout) :: iu !! Unit number for the output file to read frame from class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters integer(I4B) :: ierr !! Error code: returns 0 if the read is successful @@ -853,7 +853,7 @@ end subroutine swiftest_io_toupper module subroutine swiftest_io_write_frame_system(self, param) implicit none - class(swiftest_nbody_system), intent(inout) :: self !! Swiftest system object + class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nbody_system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters end subroutine swiftest_io_write_frame_system @@ -924,22 +924,22 @@ pure module subroutine swiftest_kick_getacch_int_one_tp(rji2, xr, yr, zr, Gmpl, real(DP), intent(inout) :: ax, ay, az !! Acceleration vector components of test particle end subroutine swiftest_kick_getacch_int_one_tp - module subroutine swiftest_obl_acc_body(self, system) + module subroutine swiftest_obl_acc_body(self, nbody_system) implicit none class(swiftest_body), intent(inout) :: self !! Swiftest body object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object end subroutine swiftest_obl_acc_body - module subroutine swiftest_obl_acc_pl(self, system) + module subroutine swiftest_obl_acc_pl(self, nbody_system) implicit none class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object end subroutine swiftest_obl_acc_pl - module subroutine swiftest_obl_acc_tp(self, system) + module subroutine swiftest_obl_acc_tp(self, nbody_system) implicit none class(swiftest_tp), intent(inout) :: self !! Swiftest test particle object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object end subroutine swiftest_obl_acc_tp module subroutine swiftest_obl_pot_system(self) @@ -1014,9 +1014,9 @@ module subroutine swiftest_setup_body(self, n, param) class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters end subroutine swiftest_setup_body - module subroutine swiftest_setup_construct_system(system, param) + module subroutine swiftest_setup_construct_system(nbody_system, param) implicit none - class(swiftest_nbody_system), allocatable, intent(inout) :: system !! Swiftest system object + class(swiftest_nbody_system), allocatable, intent(inout) :: nbody_system !! Swiftest nbody_system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters end subroutine swiftest_setup_construct_system @@ -1028,7 +1028,7 @@ end subroutine swiftest_setup_initialize_particle_info_system module subroutine swiftest_setup_initialize_system(self, param) implicit none - class(swiftest_nbody_system), intent(inout) :: self !! Swiftest system object + class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nbody_system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters end subroutine swiftest_setup_initialize_system @@ -1046,10 +1046,10 @@ module subroutine swiftest_setup_tp(self, n, param) class(swiftest_parameters), intent(in) :: param !! Current run configuration parametersr end subroutine swiftest_setup_tp - module subroutine swiftest_user_kick_getacch_body(self, system, param, t, lbeg) + module subroutine swiftest_user_kick_getacch_body(self, nbody_system, param, t, lbeg) implicit none class(swiftest_body), intent(inout) :: self !! Swiftest massive body particle data structure - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody_system_object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody_system_object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! Current time logical, intent(in) :: lbeg !! Optional argument that determines whether or not this is the beginning or end of the step @@ -1352,24 +1352,24 @@ module subroutine swiftest_util_index_map_storage(self) class(swiftest_storage(*)), intent(inout) :: self !! Swiftest storage object end subroutine swiftest_util_index_map_storage - module subroutine swiftest_util_peri_body(self, system, param) + module subroutine swiftest_util_peri_body(self, nbody_system, param) implicit none class(swiftest_body), intent(inout) :: self !! SyMBA massive body object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters end subroutine swiftest_util_peri_body - module subroutine swiftest_util_peri_tp(self, system, param) + module subroutine swiftest_util_peri_tp(self, nbody_system, param) implicit none class(swiftest_tp), intent(inout) :: self !! Swiftest test particle object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters end subroutine swiftest_util_peri_tp - module subroutine swiftest_util_rearray_pl(self, system, param) + module subroutine swiftest_util_rearray_pl(self, nbody_system, param) implicit none class(swiftest_pl), intent(inout) :: self !! SyMBA massive body object - class(swiftest_nbody_system), intent(inout) :: system !! SyMBA nbody system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! SyMBA nbody system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions end subroutine swiftest_util_rearray_pl @@ -1483,7 +1483,7 @@ end subroutine swiftest_util_set_ir3h module subroutine swiftest_util_set_msys(self) implicit none - class(swiftest_nbody_system), intent(inout) :: self !! Swiftest system object + class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nbody_system object end subroutine swiftest_util_set_msys module subroutine swiftest_util_set_mu_pl(self, cb) @@ -1540,12 +1540,12 @@ module subroutine swiftest_util_set_rhill_approximate(self,cb) class(swiftest_cb), intent(inout) :: cb !! Swiftest central body object end subroutine swiftest_util_set_rhill_approximate - module subroutine swiftest_util_snapshot_system(self, param, system, t, arg) + module subroutine swiftest_util_snapshot_system(self, param, nbody_system, t, arg) implicit none class(swiftest_storage(*)), intent(inout) :: self !! Swiftest storage object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object to store - real(DP), intent(in), optional :: t !! Time of snapshot if different from system time + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object to store + real(DP), intent(in), optional :: t !! Time of snapshot if different from nbody_system time character(*), intent(in), optional :: arg !! Optional argument (needed for extended storage type used in encounter snapshots) end subroutine swiftest_util_snapshot_system end interface diff --git a/src/swiftest/swiftest_obl.f90 b/src/swiftest/swiftest_obl.f90 index bb785232b..3864c9f2d 100644 --- a/src/swiftest/swiftest_obl.f90 +++ b/src/swiftest/swiftest_obl.f90 @@ -9,7 +9,7 @@ submodule (swiftest) s_obl contains - module subroutine swiftest_obl_acc_body(self, system) + module subroutine swiftest_obl_acc_body(self, nbody_system) !! author: David A. Minton !! !! Compute the barycentric accelerations of bodies due to the oblateness of the central body @@ -20,14 +20,14 @@ module subroutine swiftest_obl_acc_body(self, system) implicit none ! Arguments class(swiftest_body), intent(inout) :: self !! Swiftest body object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object ! Internals integer(I4B) :: i real(DP) :: r2, irh, rinv2, t0, t1, t2, t3, fac1, fac2 if (self%nbody == 0) return - associate(n => self%nbody, cb => system%cb) + associate(n => self%nbody, cb => nbody_system%cb) self%aobl(:,:) = 0.0_DP do concurrent(i = 1:n, self%lmask(i)) r2 = dot_product(self%rh(:, i), self%rh(:, i)) @@ -48,7 +48,7 @@ module subroutine swiftest_obl_acc_body(self, system) end subroutine swiftest_obl_acc_body - module subroutine swiftest_obl_acc_pl(self, system) + module subroutine swiftest_obl_acc_pl(self, nbody_system) !! author: David A. Minton !! !! Compute the barycentric accelerations of massive bodies due to the oblateness of the central body @@ -58,14 +58,14 @@ module subroutine swiftest_obl_acc_pl(self, system) implicit none ! Arguments class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object ! Internals integer(I4B) :: i if (self%nbody == 0) return - associate(pl => self, npl => self%nbody, cb => system%cb) - call swiftest_obl_acc_body(pl, system) + associate(pl => self, npl => self%nbody, cb => nbody_system%cb) + call swiftest_obl_acc_body(pl, nbody_system) cb%aobl(:) = 0.0_DP do i = npl, 1, -1 if (pl%lmask(i)) cb%aobl(:) = cb%aobl(:) - pl%Gmass(i) * pl%aobl(:, i) / cb%Gmass @@ -81,7 +81,7 @@ module subroutine swiftest_obl_acc_pl(self, system) end subroutine swiftest_obl_acc_pl - module subroutine swiftest_obl_acc_tp(self, system) + module subroutine swiftest_obl_acc_tp(self, nbody_system) !! author: David A. Minton !! !! Compute the barycentric accelerations of massive bodies due to the oblateness of the central body @@ -91,16 +91,16 @@ module subroutine swiftest_obl_acc_tp(self, system) implicit none ! Arguments class(swiftest_tp), intent(inout) :: self !! Swiftest test particle object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object ! Internals real(DP), dimension(NDIM) :: aoblcb integer(I4B) :: i if (self%nbody == 0) return - associate(tp => self, ntp => self%nbody, cb => system%cb) - call swiftest_obl_acc_body(tp, system) - if (system%lbeg) then + associate(tp => self, ntp => self%nbody, cb => nbody_system%cb) + call swiftest_obl_acc_body(tp, nbody_system) + if (nbody_system%lbeg) then aoblcb = cb%aoblbeg else aoblcb = cb%aoblend @@ -133,12 +133,12 @@ module subroutine swiftest_obl_pot_system(self) integer(I4B) :: i real(DP), dimension(self%pl%nbody) :: oblpot_arr - associate(system => self, pl => self%pl, npl => self%pl%nbody, cb => self%cb) + associate(nbody_system => self, pl => self%pl, npl => self%pl%nbody, cb => self%cb) if (.not. any(pl%lmask(1:npl))) return do concurrent (i = 1:npl, pl%lmask(i)) oblpot_arr(i) = obl_pot_one(cb%Gmass, pl%Gmass(i), cb%j2rp2, cb%j4rp4, pl%rh(3,i), 1.0_DP / norm2(pl%rh(:,i))) end do - system%oblpot = sum(oblpot_arr, pl%lmask(1:npl)) + nbody_system%oblpot = sum(oblpot_arr, pl%lmask(1:npl)) end associate return diff --git a/src/swiftest/swiftest_setup.f90 b/src/swiftest/swiftest_setup.f90 index ede789d7d..85084bfe0 100644 --- a/src/swiftest/swiftest_setup.f90 +++ b/src/swiftest/swiftest_setup.f90 @@ -12,16 +12,17 @@ use rmvs use helio use symba + use fraggle contains - module subroutine swiftest_setup_construct_system(system, param) + module subroutine swiftest_setup_construct_system(nbody_system, param) !! author: David A. Minton !! !! Constructor for a Swiftest nbody system. Creates the nbody system object based on the user-input integrator !! implicit none ! Arguments - class(swiftest_nbody_system), allocatable, intent(inout) :: system !! Swiftest system object + class(swiftest_nbody_system), allocatable, intent(inout) :: nbody_system !! Swiftest nbody_system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters ! Internals type(encounter_storage) :: encounter_history @@ -37,58 +38,54 @@ module subroutine swiftest_setup_construct_system(system, param) case (INT_BS) write(*,*) 'Bulirsch-Stoer integrator not yet enabled' case (INT_HELIO) - allocate(helio_nbody_system :: system) - select type(system) + allocate(helio_nbody_system :: nbody_system) + select type(nbody_system) class is (helio_nbody_system) - allocate(helio_cb :: system%cb) - allocate(helio_pl :: system%pl) - allocate(helio_tp :: system%tp) - allocate(helio_tp :: system%tp_discards) + allocate(helio_cb :: nbody_system%cb) + allocate(helio_pl :: nbody_system%pl) + allocate(helio_tp :: nbody_system%tp) + allocate(helio_tp :: nbody_system%tp_discards) end select + param%collision_model = "MERGE" case (INT_RA15) write(*,*) 'Radau integrator not yet enabled' case (INT_TU4) write(*,*) 'INT_TU4 integrator not yet enabled' case (INT_WHM) - allocate(whm_nbody_system :: system) - select type(system) + allocate(whm_nbody_system :: nbody_system) + select type(nbody_system) class is (whm_nbody_system) - allocate(whm_cb :: system%cb) - allocate(whm_pl :: system%pl) - allocate(whm_tp :: system%tp) - allocate(whm_tp :: system%tp_discards) + allocate(whm_cb :: nbody_system%cb) + allocate(whm_pl :: nbody_system%pl) + allocate(whm_tp :: nbody_system%tp) + allocate(whm_tp :: nbody_system%tp_discards) end select + param%collision_model = "MERGE" case (INT_RMVS) - allocate(rmvs_nbody_system :: system) - select type(system) + allocate(rmvs_nbody_system :: nbody_system) + select type(nbody_system) class is (rmvs_nbody_system) - allocate(rmvs_cb :: system%cb) - allocate(rmvs_pl :: system%pl) - allocate(rmvs_tp :: system%tp) - allocate(rmvs_tp :: system%tp_discards) + allocate(rmvs_cb :: nbody_system%cb) + allocate(rmvs_pl :: nbody_system%pl) + allocate(rmvs_tp :: nbody_system%tp) + allocate(rmvs_tp :: nbody_system%tp_discards) end select + param%collision_model = "MERGE" case (INT_SYMBA) - allocate(symba_nbody_system :: system) - select type(system) + allocate(symba_nbody_system :: nbody_system) + select type(nbody_system) class is (symba_nbody_system) - allocate(symba_cb :: system%cb) - allocate(symba_pl :: system%pl) - allocate(symba_tp :: system%tp) - - allocate(symba_tp :: system%tp_discards) - allocate(symba_pl :: system%pl_adds) - allocate(symba_pl :: system%pl_discards) - - allocate(collision_list_pltp :: system%pltp_encounter) - allocate(collision_list_plpl :: system%plpl_encounter) - allocate(collision_list_plpl :: system%plpl_collision) - - if (param%collision_model == "FRAGGLE") then - allocate(fraggle_system :: system%collision_system) - else - allocate(collision_system :: system%collision_system) - end if - call system%collision_system%setup(system) + allocate(symba_cb :: nbody_system%cb) + allocate(symba_pl :: nbody_system%pl) + allocate(symba_tp :: nbody_system%tp) + + allocate(symba_tp :: nbody_system%tp_discards) + allocate(symba_pl :: nbody_system%pl_adds) + allocate(symba_pl :: nbody_system%pl_discards) + + allocate(collision_list_pltp :: nbody_system%pltp_encounter) + allocate(collision_list_plpl :: nbody_system%plpl_encounter) + allocate(collision_list_plpl :: nbody_system%plpl_collision) if (param%lenc_save_trajectory .or. param%lenc_save_closest) then allocate(encounter_netcdf_parameters :: encounter_history%nc) @@ -97,7 +94,7 @@ module subroutine swiftest_setup_construct_system(system, param) class is (encounter_netcdf_parameters) nc%file_number = param%iloop / param%dump_cadence end select - allocate(system%encounter_history, source=encounter_history) + allocate(nbody_system%encounter_history, source=encounter_history) end if allocate(collision_netcdf_parameters :: collision_history%nc) @@ -106,7 +103,7 @@ module subroutine swiftest_setup_construct_system(system, param) class is (collision_netcdf_parameters) nc%file_number = param%iloop / param%dump_cadence end select - allocate(system%collision_history, source=collision_history) + allocate(nbody_system%collision_history, source=collision_history) end select case (INT_RINGMOONS) @@ -116,7 +113,20 @@ module subroutine swiftest_setup_construct_system(system, param) call util_exit(FAILURE) end select - allocate(swiftest_particle_info :: system%cb%info) + allocate(swiftest_particle_info :: nbody_system%cb%info) + + select case(param%collision_model) + case("MERGE") + allocate(collision_merge :: nbody_system%collider) + case("BOUNCE") + allocate(collision_bounce :: nbody_system%collider) + case("SIMPLE") + allocate(collision_simple :: nbody_system%collider) + case("FRAGGLE") + allocate(fraggle_system :: nbody_system%collider) + end select + call nbody_system%collider%setup(nbody_system) + end select return @@ -163,14 +173,14 @@ module subroutine swiftest_setup_initialize_system(self, param) !! implicit none ! Arguments - class(swiftest_nbody_system), intent(inout) :: self !! Swiftest system object + class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nbody_system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - associate(system => self, cb => self%cb, pl => self%pl, tp => self%tp) + associate(nbody_system => self, cb => self%cb, pl => self%pl, tp => self%tp) - call system%read_in(param) - call system%validate_ids(param) - call system%set_msys() + call nbody_system%read_in(param) + call nbody_system%validate_ids(param) + call nbody_system%set_msys() call pl%set_mu(cb) call tp%set_mu(cb) if (param%in_form == "EL") then @@ -183,7 +193,7 @@ module subroutine swiftest_setup_initialize_system(self, param) tp%lfirst = param%lfirstkick if (.not.param%lrestart) then - call system%init_particle_info(param) + call nbody_system%init_particle_info(param) end if end associate diff --git a/src/swiftest/swiftest_user.f90 b/src/swiftest/swiftest_user.f90 index 9d9c30783..927455729 100644 --- a/src/swiftest/swiftest_user.f90 +++ b/src/swiftest/swiftest_user.f90 @@ -10,7 +10,7 @@ submodule(swiftest) s_user_kick_getacch use swiftest contains - module subroutine swiftest_user_kick_getacch_body(self, system, param, t, lbeg) + module subroutine swiftest_user_kick_getacch_body(self, nbody_system, param, t, lbeg) !! author: David A. Minton !! !! Add user-supplied heliocentric accelerations to planets. @@ -19,7 +19,7 @@ module subroutine swiftest_user_kick_getacch_body(self, system, param, t, lbeg) implicit none ! Arguments class(swiftest_body), intent(inout) :: self !! Swiftest massive body particle data structure - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody_system_object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody_system_object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters user parameters real(DP), intent(in) :: t !! Current time logical, intent(in) :: lbeg !! Logical flag that determines whether or not this is the beginning or end of the ste diff --git a/src/swiftest/swiftest_util.f90 b/src/swiftest/swiftest_util.f90 index ea7a33bb8..b94dbbd07 100644 --- a/src/swiftest/swiftest_util.f90 +++ b/src/swiftest/swiftest_util.f90 @@ -1215,7 +1215,7 @@ end subroutine swiftest_util_flatten_eucl_pltp module subroutine swiftest_util_get_energy_momentum_system(self, param) !! author: David A. Minton !! - !! Compute total system angular momentum vector and kinetic, potential and total system energy + !! Compute total nbody_system angular momentum vector and kinetic, potential and total nbody_system energy !! !! Adapted from David E. Kaufmann Swifter routine symba_energy_eucl.f90 !! @@ -1232,12 +1232,12 @@ module subroutine swiftest_util_get_energy_momentum_system(self, param) real(DP), dimension(NDIM) :: Lcborbit, Lcbspin real(DP) :: hx, hy, hz - associate(system => self, pl => self%pl, npl => self%pl%nbody, cb => self%cb) - system%Lorbit(:) = 0.0_DP - system%Lspin(:) = 0.0_DP - system%Ltot(:) = 0.0_DP - system%ke_orbit = 0.0_DP - system%ke_spin = 0.0_DP + associate(nbody_system => self, pl => self%pl, npl => self%pl%nbody, cb => self%cb) + nbody_system%Lorbit(:) = 0.0_DP + nbody_system%Lspin(:) = 0.0_DP + nbody_system%Ltot(:) = 0.0_DP + nbody_system%ke_orbit = 0.0_DP + nbody_system%ke_spin = 0.0_DP kepl(:) = 0.0_DP Lplorbitx(:) = 0.0_DP @@ -1249,7 +1249,7 @@ module subroutine swiftest_util_get_energy_momentum_system(self, param) pl%lmask(1:npl) = pl%status(1:npl) /= INACTIVE - system%GMtot = cb%Gmass + sum(pl%Gmass(1:npl), pl%lmask(1:npl)) + nbody_system%GMtot = cb%Gmass + sum(pl%Gmass(1:npl), pl%lmask(1:npl)) kecb = cb%mass * dot_product(cb%vb(:), cb%vb(:)) Lcborbit(:) = cb%mass * (cb%rb(:) .cross. cb%vb(:)) @@ -1289,32 +1289,32 @@ module subroutine swiftest_util_get_energy_momentum_system(self, param) end if if (param%lflatten_interactions) then - call swiftest_util_get_energy_potential_flat(npl, pl%nplpl, pl%k_plpl, pl%lmask, cb%Gmass, pl%Gmass, pl%mass, pl%rb, system%pe) + call swiftest_util_get_energy_potential_flat(npl, pl%nplpl, pl%k_plpl, pl%lmask, cb%Gmass, pl%Gmass, pl%mass, pl%rb, nbody_system%pe) else - call swiftest_util_get_energy_potential_triangular(npl, pl%lmask, cb%Gmass, pl%Gmass, pl%mass, pl%rb, system%pe) + call swiftest_util_get_energy_potential_triangular(npl, pl%lmask, cb%Gmass, pl%Gmass, pl%mass, pl%rb, nbody_system%pe) end if ! Potential energy from the oblateness term if (param%loblatecb) then - call system%obl_pot() - system%pe = system%pe + system%oblpot + call nbody_system%obl_pot() + nbody_system%pe = nbody_system%pe + nbody_system%oblpot end if - system%ke_orbit = 0.5_DP * (kecb + sum(kepl(1:npl), pl%lmask(1:npl))) - if (param%lrotation) system%ke_spin = 0.5_DP * (kespincb + sum(kespinpl(1:npl), pl%lmask(1:npl))) + nbody_system%ke_orbit = 0.5_DP * (kecb + sum(kepl(1:npl), pl%lmask(1:npl))) + if (param%lrotation) nbody_system%ke_spin = 0.5_DP * (kespincb + sum(kespinpl(1:npl), pl%lmask(1:npl))) - system%Lorbit(1) = Lcborbit(1) + sum(Lplorbitx(1:npl), pl%lmask(1:npl)) - system%Lorbit(2) = Lcborbit(2) + sum(Lplorbity(1:npl), pl%lmask(1:npl)) - system%Lorbit(3) = Lcborbit(3) + sum(Lplorbitz(1:npl), pl%lmask(1:npl)) + nbody_system%Lorbit(1) = Lcborbit(1) + sum(Lplorbitx(1:npl), pl%lmask(1:npl)) + nbody_system%Lorbit(2) = Lcborbit(2) + sum(Lplorbity(1:npl), pl%lmask(1:npl)) + nbody_system%Lorbit(3) = Lcborbit(3) + sum(Lplorbitz(1:npl), pl%lmask(1:npl)) if (param%lrotation) then - system%Lspin(1) = Lcbspin(1) + sum(Lplspinx(1:npl), pl%lmask(1:npl)) - system%Lspin(2) = Lcbspin(2) + sum(Lplspiny(1:npl), pl%lmask(1:npl)) - system%Lspin(3) = Lcbspin(3) + sum(Lplspinz(1:npl), pl%lmask(1:npl)) + nbody_system%Lspin(1) = Lcbspin(1) + sum(Lplspinx(1:npl), pl%lmask(1:npl)) + nbody_system%Lspin(2) = Lcbspin(2) + sum(Lplspiny(1:npl), pl%lmask(1:npl)) + nbody_system%Lspin(3) = Lcbspin(3) + sum(Lplspinz(1:npl), pl%lmask(1:npl)) end if - system%te = system%ke_orbit + system%ke_spin + system%pe - system%Ltot(:) = system%Lorbit(:) + system%Lspin(:) + nbody_system%te = nbody_system%ke_orbit + nbody_system%ke_spin + nbody_system%pe + nbody_system%Ltot(:) = nbody_system%Lorbit(:) + nbody_system%Lspin(:) end associate return @@ -1324,7 +1324,7 @@ end subroutine swiftest_util_get_energy_momentum_system subroutine swiftest_util_get_energy_potential_flat(npl, nplpl, k_plpl, lmask, GMcb, Gmass, mass, rb, pe) !! author: David A. Minton !! - !! Compute total system potential energy + !! Compute total nbody_system potential energy implicit none ! Arguments integer(I4B), intent(in) :: npl @@ -1376,7 +1376,7 @@ end subroutine swiftest_util_get_energy_potential_flat subroutine swiftest_util_get_energy_potential_triangular(npl, lmask, GMcb, Gmass, mass, rb, pe) !! author: David A. Minton !! - !! Compute total system potential energy + !! Compute total nbody_system potential energy implicit none ! Arguments integer(I4B), intent(in) :: npl @@ -1606,17 +1606,17 @@ subroutine swiftest_util_peri(n,m, r, v, atp, q, isperi) end subroutine swiftest_util_peri - module subroutine swiftest_util_peri_body(self, system, param) + module subroutine swiftest_util_peri_body(self, nbody_system, param) !! author: David A. Minton !! - !! Determine system pericenter passages for bodies + !! Determine nbody_system pericenter passages for bodies !! !! Adapted from David E. Kaufmann's Swifter routine: symba_peri.f90 !! Adapted from Hal Levison's Swift routine util_mass_peri.f implicit none ! Arguments class(swiftest_body), intent(inout) :: self !! SyMBA massive body object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters ! Internals integer(I4B) :: i @@ -1629,14 +1629,14 @@ module subroutine swiftest_util_peri_body(self, system, param) if (param%qmin_coord == "HELIO") then call swiftest_util_peri(self%nbody, self%mu, self%rh, self%vh, self%atp, self%peri, self%isperi) else - call swiftest_util_peri(self%nbody, [(system%Gmtot,i=1,self%nbody)], self%rb, self%vb, self%atp, self%peri, self%isperi) + call swiftest_util_peri(self%nbody, [(nbody_system%Gmtot,i=1,self%nbody)], self%rb, self%vb, self%atp, self%peri, self%isperi) end if return end subroutine swiftest_util_peri_body - module subroutine swiftest_util_rearray_pl(self, system, param) + module subroutine swiftest_util_rearray_pl(self, nbody_system, param) !! Author: the Purdue Swiftest Team - David A. Minton, Carlisle A. Wishard, Jennifer L.L. Pouplin, and Jacob R. Elliott !! !! Clean up the massive body structures to remove discarded bodies and add new bodies @@ -1644,7 +1644,7 @@ module subroutine swiftest_util_rearray_pl(self, system, param) implicit none ! Arguments class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters ! Internals class(swiftest_pl), allocatable :: tmp !! The discarded body list. @@ -1655,7 +1655,7 @@ module subroutine swiftest_util_rearray_pl(self, system, param) integer(I4B), dimension(:), allocatable :: levelg_orig_pl, levelm_orig_pl, levelg_orig_tp, levelm_orig_tp integer(I4B), dimension(:), allocatable :: nplenc_orig_pl, nplenc_orig_tp, ntpenc_orig_pl - associate(pl => self, tp => system%tp, pl_adds => system%pl_adds) + associate(pl => self, tp => nbody_system%tp, pl_adds => nbody_system%pl_adds) npl = pl%nbody nadd = pl_adds%nbody @@ -1664,7 +1664,7 @@ module subroutine swiftest_util_rearray_pl(self, system, param) if (allocated(pl%rbeg)) deallocate(pl%rbeg) if (allocated(pl%rend)) deallocate(pl%rend) - ! Remove the discards and destroy the list, as the system already tracks pl_discards elsewhere + ! Remove the discards and destroy the list, as the nbody_system already tracks pl_discards elsewhere allocate(lmask(npl)) lmask(1:npl) = pl%ldiscard(1:npl) if (count(lmask(:)) > 0) then @@ -1677,10 +1677,10 @@ module subroutine swiftest_util_rearray_pl(self, system, param) end if ! Store the original plplenc list so we don't remove any of the original encounters - nenc_old = system%plpl_encounter%nenc + nenc_old = nbody_system%plpl_encounter%nenc if (nenc_old > 0) then - allocate(plplenc_old, source=system%plpl_encounter) - call plplenc_old%copy(system%plpl_encounter) + allocate(plplenc_old, source=nbody_system%plpl_encounter) + call plplenc_old%copy(nbody_system%plpl_encounter) end if ! Add in any new bodies @@ -1728,8 +1728,8 @@ module subroutine swiftest_util_rearray_pl(self, system, param) ! Re-build the encounter list - ! Be sure to get the level info if this is a SyMBA system - select type(system) + ! Be sure to get the level info if this is a SyMBA nbody_system + select type(nbody_system) class is (symba_nbody_system) select type(pl) class is (symba_pl) @@ -1741,13 +1741,13 @@ module subroutine swiftest_util_rearray_pl(self, system, param) call move_alloc(levelg_orig_pl, pl%levelg) call move_alloc(levelm_orig_pl, pl%levelm) call move_alloc(nplenc_orig_pl, pl%nplenc) - lencounter = pl%encounter_check(param, system, param%dt, system%irec) + lencounter = pl%encounter_check(param, nbody_system, param%dt, nbody_system%irec) if (tp%nbody > 0) then allocate(levelg_orig_tp, source=tp%levelg) allocate(levelm_orig_tp, source=tp%levelm) allocate(nplenc_orig_tp, source=tp%nplenc) allocate(ntpenc_orig_pl, source=pl%ntpenc) - lencounter = tp%encounter_check(param, system, param%dt, system%irec) + lencounter = tp%encounter_check(param, nbody_system, param%dt, nbody_system%irec) call move_alloc(levelg_orig_tp, tp%levelg) call move_alloc(levelm_orig_tp, tp%levelm) call move_alloc(nplenc_orig_tp, tp%nplenc) @@ -1760,64 +1760,64 @@ module subroutine swiftest_util_rearray_pl(self, system, param) ! Re-index the encounter list as the index values may have changed if (nenc_old > 0) then - nencmin = min(system%plpl_encounter%nenc, plplenc_old%nenc) - system%plpl_encounter%nenc = nencmin + nencmin = min(nbody_system%plpl_encounter%nenc, plplenc_old%nenc) + nbody_system%plpl_encounter%nenc = nencmin do k = 1, nencmin - idnew1 = system%plpl_encounter%id1(k) - idnew2 = system%plpl_encounter%id2(k) + idnew1 = nbody_system%plpl_encounter%id1(k) + idnew2 = nbody_system%plpl_encounter%id2(k) idold1 = plplenc_old%id1(k) idold2 = plplenc_old%id2(k) if ((idnew1 == idold1) .and. (idnew2 == idold2)) then ! This is an encounter we already know about, so save the old information - system%plpl_encounter%lvdotr(k) = plplenc_old%lvdotr(k) - system%plpl_encounter%lclosest(k) = plplenc_old%lclosest(k) - system%plpl_encounter%status(k) = plplenc_old%status(k) - system%plpl_encounter%r1(:,k) = plplenc_old%r1(:,k) - system%plpl_encounter%r2(:,k) = plplenc_old%r2(:,k) - system%plpl_encounter%v1(:,k) = plplenc_old%v1(:,k) - system%plpl_encounter%v2(:,k) = plplenc_old%v2(:,k) - system%plpl_encounter%tcollision(k) = plplenc_old%tcollision(k) - system%plpl_encounter%level(k) = plplenc_old%level(k) + nbody_system%plpl_encounter%lvdotr(k) = plplenc_old%lvdotr(k) + nbody_system%plpl_encounter%lclosest(k) = plplenc_old%lclosest(k) + nbody_system%plpl_encounter%status(k) = plplenc_old%status(k) + nbody_system%plpl_encounter%r1(:,k) = plplenc_old%r1(:,k) + nbody_system%plpl_encounter%r2(:,k) = plplenc_old%r2(:,k) + nbody_system%plpl_encounter%v1(:,k) = plplenc_old%v1(:,k) + nbody_system%plpl_encounter%v2(:,k) = plplenc_old%v2(:,k) + nbody_system%plpl_encounter%tcollision(k) = plplenc_old%tcollision(k) + nbody_system%plpl_encounter%level(k) = plplenc_old%level(k) else if (((idnew1 == idold2) .and. (idnew2 == idold1))) then ! This is an encounter we already know about, but with the order reversed, so save the old information - system%plpl_encounter%lvdotr(k) = plplenc_old%lvdotr(k) - system%plpl_encounter%lclosest(k) = plplenc_old%lclosest(k) - system%plpl_encounter%status(k) = plplenc_old%status(k) - system%plpl_encounter%r1(:,k) = plplenc_old%r2(:,k) - system%plpl_encounter%r2(:,k) = plplenc_old%r1(:,k) - system%plpl_encounter%v1(:,k) = plplenc_old%v2(:,k) - system%plpl_encounter%v2(:,k) = plplenc_old%v1(:,k) - system%plpl_encounter%tcollision(k) = plplenc_old%tcollision(k) - system%plpl_encounter%level(k) = plplenc_old%level(k) + nbody_system%plpl_encounter%lvdotr(k) = plplenc_old%lvdotr(k) + nbody_system%plpl_encounter%lclosest(k) = plplenc_old%lclosest(k) + nbody_system%plpl_encounter%status(k) = plplenc_old%status(k) + nbody_system%plpl_encounter%r1(:,k) = plplenc_old%r2(:,k) + nbody_system%plpl_encounter%r2(:,k) = plplenc_old%r1(:,k) + nbody_system%plpl_encounter%v1(:,k) = plplenc_old%v2(:,k) + nbody_system%plpl_encounter%v2(:,k) = plplenc_old%v1(:,k) + nbody_system%plpl_encounter%tcollision(k) = plplenc_old%tcollision(k) + nbody_system%plpl_encounter%level(k) = plplenc_old%level(k) end if - system%plpl_encounter%index1(k) = findloc(pl%id(1:npl), system%plpl_encounter%id1(k), dim=1) - system%plpl_encounter%index2(k) = findloc(pl%id(1:npl), system%plpl_encounter%id2(k), dim=1) + nbody_system%plpl_encounter%index1(k) = findloc(pl%id(1:npl), nbody_system%plpl_encounter%id1(k), dim=1) + nbody_system%plpl_encounter%index2(k) = findloc(pl%id(1:npl), nbody_system%plpl_encounter%id2(k), dim=1) end do if (allocated(lmask)) deallocate(lmask) allocate(lmask(nencmin)) nenc_old = nencmin - if (any(system%plpl_encounter%index1(1:nencmin) == 0) .or. any(system%plpl_encounter%index2(1:nencmin) == 0)) then - lmask(:) = system%plpl_encounter%index1(1:nencmin) /= 0 .and. system%plpl_encounter%index2(1:nencmin) /= 0 + if (any(nbody_system%plpl_encounter%index1(1:nencmin) == 0) .or. any(nbody_system%plpl_encounter%index2(1:nencmin) == 0)) then + lmask(:) = nbody_system%plpl_encounter%index1(1:nencmin) /= 0 .and. nbody_system%plpl_encounter%index2(1:nencmin) /= 0 else return end if nencmin = count(lmask(:)) - system%plpl_encounter%nenc = nencmin + nbody_system%plpl_encounter%nenc = nencmin if (nencmin > 0) then - system%plpl_encounter%index1(1:nencmin) = pack(system%plpl_encounter%index1(1:nenc_old), lmask(1:nenc_old)) - system%plpl_encounter%index2(1:nencmin) = pack(system%plpl_encounter%index2(1:nenc_old), lmask(1:nenc_old)) - system%plpl_encounter%id1(1:nencmin) = pack(system%plpl_encounter%id1(1:nenc_old), lmask(1:nenc_old)) - system%plpl_encounter%id2(1:nencmin) = pack(system%plpl_encounter%id2(1:nenc_old), lmask(1:nenc_old)) - system%plpl_encounter%lvdotr(1:nencmin) = pack(system%plpl_encounter%lvdotr(1:nenc_old), lmask(1:nenc_old)) - system%plpl_encounter%lclosest(1:nencmin) = pack(system%plpl_encounter%lclosest(1:nenc_old), lmask(1:nenc_old)) - system%plpl_encounter%status(1:nencmin) = pack(system%plpl_encounter%status(1:nenc_old), lmask(1:nenc_old)) - system%plpl_encounter%tcollision(1:nencmin) = pack(system%plpl_encounter%tcollision(1:nenc_old), lmask(1:nenc_old)) - system%plpl_encounter%level(1:nencmin) = pack(system%plpl_encounter%level(1:nenc_old), lmask(1:nenc_old)) + nbody_system%plpl_encounter%index1(1:nencmin) = pack(nbody_system%plpl_encounter%index1(1:nenc_old), lmask(1:nenc_old)) + nbody_system%plpl_encounter%index2(1:nencmin) = pack(nbody_system%plpl_encounter%index2(1:nenc_old), lmask(1:nenc_old)) + nbody_system%plpl_encounter%id1(1:nencmin) = pack(nbody_system%plpl_encounter%id1(1:nenc_old), lmask(1:nenc_old)) + nbody_system%plpl_encounter%id2(1:nencmin) = pack(nbody_system%plpl_encounter%id2(1:nenc_old), lmask(1:nenc_old)) + nbody_system%plpl_encounter%lvdotr(1:nencmin) = pack(nbody_system%plpl_encounter%lvdotr(1:nenc_old), lmask(1:nenc_old)) + nbody_system%plpl_encounter%lclosest(1:nencmin) = pack(nbody_system%plpl_encounter%lclosest(1:nenc_old), lmask(1:nenc_old)) + nbody_system%plpl_encounter%status(1:nencmin) = pack(nbody_system%plpl_encounter%status(1:nenc_old), lmask(1:nenc_old)) + nbody_system%plpl_encounter%tcollision(1:nencmin) = pack(nbody_system%plpl_encounter%tcollision(1:nenc_old), lmask(1:nenc_old)) + nbody_system%plpl_encounter%level(1:nencmin) = pack(nbody_system%plpl_encounter%level(1:nenc_old), lmask(1:nenc_old)) do i = 1, NDIM - system%plpl_encounter%r1(i, 1:nencmin) = pack(system%plpl_encounter%r1(i, 1:nenc_old), lmask(1:nenc_old)) - system%plpl_encounter%r2(i, 1:nencmin) = pack(system%plpl_encounter%r2(i, 1:nenc_old), lmask(1:nenc_old)) - system%plpl_encounter%v1(i, 1:nencmin) = pack(system%plpl_encounter%v1(i, 1:nenc_old), lmask(1:nenc_old)) - system%plpl_encounter%v2(i, 1:nencmin) = pack(system%plpl_encounter%v2(i, 1:nenc_old), lmask(1:nenc_old)) + nbody_system%plpl_encounter%r1(i, 1:nencmin) = pack(nbody_system%plpl_encounter%r1(i, 1:nenc_old), lmask(1:nenc_old)) + nbody_system%plpl_encounter%r2(i, 1:nencmin) = pack(nbody_system%plpl_encounter%r2(i, 1:nenc_old), lmask(1:nenc_old)) + nbody_system%plpl_encounter%v1(i, 1:nencmin) = pack(nbody_system%plpl_encounter%v1(i, 1:nenc_old), lmask(1:nenc_old)) + nbody_system%plpl_encounter%v2(i, 1:nencmin) = pack(nbody_system%plpl_encounter%v2(i, 1:nenc_old), lmask(1:nenc_old)) end do end if end if @@ -1831,7 +1831,7 @@ module subroutine swiftest_util_rescale_system(self, param, mscale, dscale, tsca !! author: David A. Minton !! !! Rescales an nbody system to a new set of units. Inputs are the multipliers on the mass (mscale), distance (dscale), and time units (tscale). - !! Rescales all united quantities in the system, as well as the mass conversion factors, gravitational constant, and Einstein's constant in the parameter object. + !! Rescales all united quantities in the nbody_system, as well as the mass conversion factors, gravitational constant, and Einstein's constant in the parameter object. implicit none class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nbody system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters. Returns with new values of the scale vactors and GU @@ -1843,11 +1843,11 @@ module subroutine swiftest_util_rescale_system(self, param, mscale, dscale, tsca param%DU2M = param%DU2M * dscale param%TU2S = param%TU2S * tscale - ! Calculate the G for the system units + ! Calculate the G for the nbody_system units param%GU = GC / (param%DU2M**3 / (param%MU2KG * param%TU2S**2)) if (param%lgr) then - ! Calculate the inverse speed of light in the system units + ! Calculate the inverse speed of light in the nbody_system units param%inv_c2 = einsteinC * param%TU2S / param%DU2M param%inv_c2 = (param%inv_c2)**(-2) end if @@ -2357,10 +2357,10 @@ end subroutine swiftest_util_set_ir3h module subroutine swiftest_util_set_msys(self) !! author: David A. Minton !! - !! Sets the value of msys and the vector mass quantities based on the total mass of the system + !! Sets the value of msys and the vector mass quantities based on the total mass of the nbody_system implicit none ! Arguments - class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nobdy system object + class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nobdy nbody_system object self%Gmtot = self%cb%Gmass + sum(self%pl%Gmass(1:self%pl%nbody), self%pl%status(1:self%pl%nbody) /= INACTIVE) @@ -2541,24 +2541,24 @@ module subroutine swiftest_util_set_rhill_approximate(self,cb) end subroutine swiftest_util_set_rhill_approximate - module subroutine swiftest_util_snapshot_system(self, param, system, t, arg) + module subroutine swiftest_util_snapshot_system(self, param, nbody_system, t, arg) !! author: David A. Minton !! - !! Takes a snapshot of the system for later file storage + !! Takes a snapshot of the nbody_system for later file storage implicit none ! Arguments class(swiftest_storage(*)), intent(inout) :: self !! Swiftest storage object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object to store - real(DP), intent(in), optional :: t !! Time of snapshot if different from system time + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object to store + real(DP), intent(in), optional :: t !! Time of snapshot if different from nbody_system time character(*), intent(in), optional :: arg !! Optional argument (needed for extended storage type used in collision snapshots) self%iframe = self%iframe + 1 self%nt = self%iframe - self%frame(self%iframe) = system ! Store a snapshot of the system for posterity + self%frame(self%iframe) = nbody_system ! Store a snapshot of the nbody_system for posterity self%nid = self%nid + 1 ! Central body - if (allocated(system%pl)) self%nid = self%nid + system%pl%nbody - if (allocated(system%tp)) self%nid = self%nid + system%tp%nbody + if (allocated(nbody_system%pl)) self%nid = self%nid + nbody_system%pl%nbody + if (allocated(nbody_system%tp)) self%nid = self%nid + nbody_system%tp%nbody return end subroutine swiftest_util_snapshot_system diff --git a/src/symba/symba_discard.f90 b/src/symba/symba_discard.f90 index 5cdf5eab5..cdeeeb0fe 100644 --- a/src/symba/symba_discard.f90 +++ b/src/symba/symba_discard.f90 @@ -11,7 +11,7 @@ use swiftest contains - subroutine symba_discard_cb_pl(pl, system, param) + subroutine symba_discard_cb_pl(pl, nbody_system, param) !! author: David A. Minton !! !! Check to see if planets should be discarded based on their positions relative to the central body. @@ -24,15 +24,15 @@ subroutine symba_discard_cb_pl(pl, system, param) implicit none ! Arguments class(symba_pl), intent(inout) :: pl !! SyMBA massive body object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters ! Internals integer(I4B) :: i real(DP) :: energy, vb2, rb2, rh2, rmin2, rmax2, rmaxu2 character(len=STRMAX) :: idstr, timestr, message - associate(npl => pl%nbody, cb => system%cb) - call system%set_msys() + associate(npl => pl%nbody, cb => nbody_system%cb) + call nbody_system%set_msys() rmin2 = param%rmin**2 rmax2 = param%rmax**2 rmaxu2 = param%rmaxu**2 @@ -44,55 +44,55 @@ subroutine symba_discard_cb_pl(pl, system, param) pl%lcollision(i) = .false. pl%status(i) = DISCARDED_RMAX write(idstr, *) pl%id(i) - write(timestr, *) system%t + write(timestr, *) nbody_system%t write(message, *) trim(adjustl(pl%info(i)%name)) // " (" // trim(adjustl(idstr)) // ")" // & " too far from the central body at t = " // trim(adjustl(timestr)) - call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, "") - call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, "***********************************************************" // & + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "") + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "***********************************************************" // & "***********************************************************") - call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, message) - call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, "***********************************************************" // & + call swiftest_io_log_one_message(COLLISION_LOG_OUT, message) + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "***********************************************************" // & "***********************************************************") - call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, "") - call pl%info(i)%set_value(status="DISCARDED_RMAX", discard_time=system%t, discard_rh=pl%rh(:,i), & + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "") + call pl%info(i)%set_value(status="DISCARDED_RMAX", discard_time=nbody_system%t, discard_rh=pl%rh(:,i), & discard_vh=pl%vh(:,i)) else if ((param%rmin >= 0.0_DP) .and. (rh2 < rmin2)) then pl%ldiscard(i) = .true. pl%lcollision(i) = .false. pl%status(i) = DISCARDED_RMIN write(idstr, *) pl%id(i) - write(timestr, *) system%t + write(timestr, *) nbody_system%t write(message, *) trim(adjustl(pl%info(i)%name)) // " (" // trim(adjustl(idstr)) // ")" // & " too close to the central body at t = " // trim(adjustl(timestr)) - call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, "") - call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, "************************************************************" // & + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "") + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "************************************************************" // & "************************************************************") - call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, message) - call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, "************************************************************" // & + call swiftest_io_log_one_message(COLLISION_LOG_OUT, message) + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "************************************************************" // & "************************************************************") - call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, "") - call pl%info(i)%set_value(status="DISCARDED_RMIN", discard_time=system%t, discard_rh=pl%rh(:,i), & + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "") + call pl%info(i)%set_value(status="DISCARDED_RMIN", discard_time=nbody_system%t, discard_rh=pl%rh(:,i), & discard_vh=pl%vh(:,i), discard_body_id=cb%id) else if (param%rmaxu >= 0.0_DP) then rb2 = dot_product(pl%rb(:,i), pl%rb(:,i)) vb2 = dot_product(pl%vb(:,i), pl%vb(:,i)) - energy = 0.5_DP * vb2 - system%Gmtot / sqrt(rb2) + energy = 0.5_DP * vb2 - nbody_system%Gmtot / sqrt(rb2) if ((energy > 0.0_DP) .and. (rb2 > rmaxu2)) then pl%ldiscard(i) = .true. pl%lcollision(i) = .false. pl%status(i) = DISCARDED_RMAXU write(idstr, *) pl%id(i) - write(timestr, *) system%t + write(timestr, *) nbody_system%t write(message, *) trim(adjustl(pl%info(i)%name)) // " (" // trim(adjustl(idstr)) // ")" // & " is unbound and too far from barycenter at t = " // trim(adjustl(timestr)) - call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, "") - call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, "************************************************************" // & + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "") + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "************************************************************" // & "************************************************************") - call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, message) - call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, "************************************************************" // & + call swiftest_io_log_one_message(COLLISION_LOG_OUT, message) + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "************************************************************" // & "************************************************************") - call swiftest_io_log_one_message(FRAGGLE_LOG_OUT, "") - call pl%info(i)%set_value(status="DISCARDED_RMAXU", discard_time=system%t, discard_rh=pl%rh(:,i), & + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "") + call pl%info(i)%set_value(status="DISCARDED_RMAXU", discard_time=nbody_system%t, discard_rh=pl%rh(:,i), & discard_vh=pl%vh(:,i)) end if end if @@ -104,14 +104,14 @@ subroutine symba_discard_cb_pl(pl, system, param) end subroutine symba_discard_cb_pl - subroutine symba_discard_conserve_mtm(pl, system, param, ipl, lescape_body) + subroutine symba_discard_conserve_mtm(pl, nbody_system, param, ipl, lescape_body) !! author: David A. Minton !! - !! Conserves system momentum when a body is lost from the system or collides with central body + !! Conserves nbody_system momentum when a body is lost from the nbody_system or collides with central body implicit none ! Arguments class(symba_pl), intent(inout) :: pl - class(symba_nbody_system), intent(inout) :: system + class(symba_nbody_system), intent(inout) :: nbody_system class(swiftest_parameters), intent(inout) :: param integer(I4B), intent(in) :: ipl logical, intent(in) :: lescape_body @@ -120,7 +120,7 @@ subroutine symba_discard_conserve_mtm(pl, system, param, ipl, lescape_body) real(DP) :: pe, ke_orbit, ke_spin integer(I4B) :: i, oldstat - select type(cb => system%cb) + select type(cb => nbody_system%cb) class is (symba_cb) ! Add the potential and kinetic energy of the lost body to the records @@ -135,7 +135,7 @@ subroutine symba_discard_conserve_mtm(pl, system, param, ipl, lescape_body) ! Add the pre-collision ke of the central body to the records ! Add planet mass to central body accumulator if (lescape_body) then - system%GMescape = system%GMescape + pl%Gmass(ipl) + nbody_system%GMescape = nbody_system%GMescape + pl%Gmass(ipl) do i = 1, pl%nbody if (i == ipl) cycle pe = pe - pl%Gmass(i) * pl%mass(ipl) / norm2(pl%rb(:, ipl) - pl%rb(:, i)) @@ -158,8 +158,8 @@ subroutine symba_discard_conserve_mtm(pl, system, param, ipl, lescape_body) Ltot(:) = Ltot(:) - Lpl(:) end do Ltot(:) = Ltot(:) - cb%mass * (cb%rb(:) .cross. cb%vb(:)) - system%Lescape(:) = system%Lescape(:) + Ltot(:) - if (param%lrotation) system%Lescape(:) = system%Lescape + pl%mass(ipl) * pl%radius(ipl)**2 & + nbody_system%Lescape(:) = nbody_system%Lescape(:) + Ltot(:) + if (param%lrotation) nbody_system%Lescape(:) = nbody_system%Lescape + pl%mass(ipl) * pl%radius(ipl)**2 & * pl%Ip(3, ipl) * pl%rot(:, ipl) else @@ -194,11 +194,11 @@ subroutine symba_discard_conserve_mtm(pl, system, param, ipl, lescape_body) ! We must do this for proper book-keeping, since we can no longer track this body's contribution to energy directly if (lescape_body) then - system%Ecollisions = system%Ecollisions + ke_orbit + ke_spin + pe - system%Euntracked = system%Euntracked - (ke_orbit + ke_spin + pe) + nbody_system%Ecollisions = nbody_system%Ecollisions + ke_orbit + ke_spin + pe + nbody_system%Euntracked = nbody_system%Euntracked - (ke_orbit + ke_spin + pe) else - system%Ecollisions = system%Ecollisions + pe - system%Euntracked = system%Euntracked - pe + nbody_system%Ecollisions = nbody_system%Ecollisions + pe + nbody_system%Euntracked = nbody_system%Euntracked - pe end if end select @@ -206,7 +206,7 @@ subroutine symba_discard_conserve_mtm(pl, system, param, ipl, lescape_body) end subroutine symba_discard_conserve_mtm - subroutine symba_discard_nonplpl(pl, system, param) + subroutine symba_discard_nonplpl(pl, nbody_system, param) !! author: David A. Minton !! !! Check to see if planets should be discarded based on their positions or because they are unbound @@ -217,7 +217,7 @@ subroutine symba_discard_nonplpl(pl, system, param) implicit none ! Arguments class(symba_pl), intent(inout) :: pl !! SyMBA test particle object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters ! Internals logical, dimension(pl%nbody) :: ldiscard @@ -225,12 +225,12 @@ subroutine symba_discard_nonplpl(pl, system, param) class(symba_pl), allocatable :: plsub ! First check for collisions with the central body - associate(npl => pl%nbody, cb => system%cb, pl_discards => system%pl_discards) + associate(npl => pl%nbody, cb => nbody_system%cb, pl_discards => nbody_system%pl_discards) if (npl == 0) return if ((param%rmin >= 0.0_DP) .or. (param%rmax >= 0.0_DP) .or. (param%rmaxu >= 0.0_DP)) then - call symba_discard_cb_pl(pl, system, param) + call symba_discard_cb_pl(pl, nbody_system, param) end if - if (param%qmin >= 0.0_DP) call symba_discard_peri_pl(pl, system, param) + if (param%qmin >= 0.0_DP) call symba_discard_peri_pl(pl, nbody_system, param) if (any(pl%ldiscard(1:npl))) then ldiscard(1:npl) = pl%ldiscard(1:npl) @@ -248,15 +248,15 @@ subroutine symba_discard_nonplpl(pl, system, param) end subroutine symba_discard_nonplpl - subroutine symba_discard_nonplpl_conservation(pl, system, param) + subroutine symba_discard_nonplpl_conservation(pl, nbody_system, param) !! author: David A. Minton !! !! If there are any bodies that are removed due to either colliding with the central body or escaping the systme, - !! we need to track the conserved quantities with the system bookkeeping terms. + !! we need to track the conserved quantities with the nbody_system bookkeeping terms. implicit none ! Arguments class(symba_pl), intent(inout) :: pl !! SyMBA test particle object - class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object + class(symba_nbody_system), intent(inout) :: nbody_system !! SyMBA nbody system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters ! Internals integer(I4B) :: i, ndiscard, dstat @@ -279,7 +279,7 @@ subroutine symba_discard_nonplpl_conservation(pl, system, param) cycle end if ! Conserve all the quantities - call symba_discard_conserve_mtm(pl, system, param, discard_index_list(i), lescape) + call symba_discard_conserve_mtm(pl, nbody_system, param, discard_index_list(i), lescape) end do end associate @@ -287,7 +287,7 @@ subroutine symba_discard_nonplpl_conservation(pl, system, param) end subroutine symba_discard_nonplpl_conservation - subroutine symba_discard_peri_pl(pl, system, param) + subroutine symba_discard_peri_pl(pl, nbody_system, param) !! author: David A. Minton !! !! Check to see if a test particle should be discarded because its perihelion distance becomes too small @@ -297,7 +297,7 @@ subroutine symba_discard_peri_pl(pl, system, param) implicit none ! Arguments class(symba_pl), intent(inout) :: pl !! SyMBA massive body object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters ! Internals logical, save :: lfirst = .true. @@ -309,10 +309,10 @@ subroutine symba_discard_peri_pl(pl, system, param) lfirst_orig = pl%lfirst pl%lfirst = lfirst if (lfirst) then - call pl%get_peri(system, param) + call pl%get_peri(nbody_system, param) lfirst = .false. else - call pl%get_peri(system, param) + call pl%get_peri(nbody_system, param) do i = 1, pl%nbody if (pl%status(i) == ACTIVE) then if ((pl%isperi(i) == 0) .and. (pl%nplenc(i)== 0)) then @@ -320,12 +320,12 @@ subroutine symba_discard_peri_pl(pl, system, param) pl%ldiscard(i) = .true. pl%lcollision(i) = .false. pl%status(i) = DISCARDED_PERI - write(timestr, *) system%t + write(timestr, *) nbody_system%t write(idstr, *) pl%id(i) write(*, *) trim(adjustl(pl%info(i)%name)) // " (" // trim(adjustl(idstr)) // & ") perihelion distance too small at t = " // trim(adjustl(timestr)) - call pl%info(i)%set_value(status="DISCARDED_PERI", discard_time=system%t, & - discard_rh=pl%rh(:,i), discard_vh=pl%vh(:,i), discard_body_id=system%cb%id) + call pl%info(i)%set_value(status="DISCARDED_PERI", discard_time=nbody_system%t, & + discard_rh=pl%rh(:,i), discard_vh=pl%vh(:,i), discard_body_id=nbody_system%cb%id) end if end if end if @@ -337,47 +337,47 @@ subroutine symba_discard_peri_pl(pl, system, param) end subroutine symba_discard_peri_pl - module subroutine symba_discard_pl(self, system, param) + module subroutine symba_discard_pl(self, nbody_system, param) !! author: David A. Minton !! - !! Call the various flavors of discards for massive bodies in SyMBA runs, including discards due to colliding with the central body or escaping the system + !! Call the various flavors of discards for massive bodies in SyMBA runs, including discards due to colliding with the central body or escaping the nbody_system implicit none ! Arguments class(symba_pl), intent(inout) :: self !! SyMBA test particle object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters ! Internals real(DP) :: Eorbit_before, Eorbit_after - select type(system) + select type(nbody_system) class is (symba_nbody_system) select type(param) class is (swiftest_parameters) - associate(pl => self, plpl_encounter => system%plpl_encounter, plpl_collision => system%plpl_collision) - call pl%vb2vh(system%cb) - call pl%rh2rb(system%cb) + associate(pl => self, plpl_encounter => nbody_system%plpl_encounter, plpl_collision => nbody_system%plpl_collision) + call pl%vb2vh(nbody_system%cb) + call pl%rh2rb(nbody_system%cb) !call plpl_encounter%write(pl, pl, param) TODO: write the encounter list writer for NetCDF - call symba_discard_nonplpl(self, system, param) + call symba_discard_nonplpl(self, nbody_system, param) if (.not.any(pl%ldiscard(:))) return if (param%lenergy) then - call system%get_energy_and_momentum(param) - Eorbit_before = system%te + call nbody_system%get_energy_and_momentum(param) + Eorbit_before = nbody_system%te end if - call symba_discard_nonplpl_conservation(self, system, param) + call symba_discard_nonplpl_conservation(self, nbody_system, param) ! Save the add/discard information to file - call system%write_discard(param) + call nbody_system%write_discard(param) - call pl%rearray(system, param) + call pl%rearray(nbody_system, param) if (param%lenergy) then - call system%get_energy_and_momentum(param) - Eorbit_after = system%te - system%Ecollisions = system%Ecollisions + (Eorbit_after - Eorbit_before) + call nbody_system%get_energy_and_momentum(param) + Eorbit_after = nbody_system%te + nbody_system%Ecollisions = nbody_system%Ecollisions + (Eorbit_after - Eorbit_before) end if end associate diff --git a/src/symba/symba_drift.f90 b/src/symba/symba_drift.f90 index 126196c6c..e6cc0e761 100644 --- a/src/symba/symba_drift.f90 +++ b/src/symba/symba_drift.f90 @@ -11,23 +11,23 @@ use swiftest contains - module subroutine symba_drift_pl(self, system, param, dt) + module subroutine symba_drift_pl(self, nbody_system, param, dt) !! author: David A. Minton !! !! Wrapper function used to call the body drift routine from a symba_pl structure implicit none ! Arguments class(symba_pl), intent(inout) :: self !! Helio massive body object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters real(DP), intent(in) :: dt !! Stepsize if (self%nbody == 0) return associate(pl => self, npl => self%nbody) - select type(system) + select type(nbody_system) class is (symba_nbody_system) - pl%lmask(1:npl) = pl%status(1:npl) /= INACTIVE .and. pl%levelg(1:npl) == system%irec - call helio_drift_body(pl, system, param, dt) + pl%lmask(1:npl) = pl%status(1:npl) /= INACTIVE .and. pl%levelg(1:npl) == nbody_system%irec + call helio_drift_body(pl, nbody_system, param, dt) pl%lmask(1:npl) = pl%status(1:npl) /= INACTIVE end select end associate @@ -36,23 +36,23 @@ module subroutine symba_drift_pl(self, system, param, dt) end subroutine symba_drift_pl - module subroutine symba_drift_tp(self, system, param, dt) + module subroutine symba_drift_tp(self, nbody_system, param, dt) !! author: David A. Minton !! !! Wrapper function used to call the body drift routine from a symba_pl structure implicit none ! Arguments class(symba_tp), intent(inout) :: self !! Helio massive body object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters real(DP), intent(in) :: dt !! Stepsize if (self%nbody == 0) return associate (tp => self, ntp => self%nbody) - select type(system) + select type(nbody_system) class is (symba_nbody_system) - tp%lmask(1:ntp) = tp%status(1:ntp) /= INACTIVE .and. tp%levelg(1:ntp) == system%irec - call helio_drift_body(tp, system, param, dt) + tp%lmask(1:ntp) = tp%status(1:ntp) /= INACTIVE .and. tp%levelg(1:ntp) == nbody_system%irec + call helio_drift_body(tp, nbody_system, param, dt) tp%lmask(1:ntp) = tp%status(1:ntp) /= INACTIVE end select end associate diff --git a/src/symba/symba_encounter_check.f90 b/src/symba/symba_encounter_check.f90 index d0fc96990..c454fffb0 100644 --- a/src/symba/symba_encounter_check.f90 +++ b/src/symba/symba_encounter_check.f90 @@ -11,7 +11,7 @@ use swiftest contains - module function symba_encounter_check_pl(self, param, system, dt, irec) result(lany_encounter) + module function symba_encounter_check_pl(self, param, nbody_system, dt, irec) result(lany_encounter) !! author: David A. Minton !! !! Check for an encounter between massive bodies. @@ -20,7 +20,7 @@ module function symba_encounter_check_pl(self, param, system, dt, irec) result(l ! Arguments class(symba_pl), intent(inout) :: self !! SyMBA test particle object class(swiftest_parameters), intent(inout) :: param !! Current swiftest run configuration parameters - class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object + class(symba_nbody_system), intent(inout) :: nbody_system !! SyMBA nbody system object real(DP), intent(in) :: dt !! step size integer(I4B), intent(in) :: irec !! Current recursion level ! Result @@ -34,7 +34,7 @@ module function symba_encounter_check_pl(self, param, system, dt, irec) result(l lany_encounter = .false. if (self%nbody == 0) return - associate(pl => self, plpl_encounter => system%plpl_encounter, cb => system%cb) + associate(pl => self, plpl_encounter => nbody_system%plpl_encounter, cb => nbody_system%cb) npl = pl%nbody nplm = pl%nplm @@ -59,7 +59,7 @@ module function symba_encounter_check_pl(self, param, system, dt, irec) result(l if (lany_encounter) then do k = 1_I8B, nenc - plpl_encounter%t = system%t + plpl_encounter%t = nbody_system%t i = plpl_encounter%index1(k) j = plpl_encounter%index2(k) plpl_encounter%id1(k) = pl%id(i) @@ -87,11 +87,11 @@ module function symba_encounter_check_pl(self, param, system, dt, irec) result(l end function symba_encounter_check_pl - module function symba_encounter_check_list_plpl(self, param, system, dt, irec) result(lany_encounter) + module function symba_encounter_check_list_plpl(self, param, nbody_system, dt, irec) result(lany_encounter) implicit none class(symba_list_plpl), intent(inout) :: self !! SyMBA pl-pl encounter list object class(swiftest_parameters), intent(inout) :: param !! Current swiftest run configuration parameters - class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object + class(symba_nbody_system), intent(inout) :: nbody_system !! SyMBA nbody system object real(DP), intent(in) :: dt !! step size integer(I4B), intent(in) :: irec !! Current recursion level logical :: lany_encounter !! Returns true if there is at least one close encounter @@ -105,7 +105,7 @@ module function symba_encounter_check_list_plpl(self, param, system, dt, irec) r lany_encounter = .false. if (self%nenc == 0) return - select type(pl => system%pl) + select type(pl => nbody_system%pl) class is (symba_pl) allocate(lencmask(self%nenc)) lencmask(:) = (self%status(1:self%nenc) == ACTIVE) .and. (self%level(1:self%nenc) == irec - 1) @@ -155,11 +155,11 @@ module function symba_encounter_check_list_plpl(self, param, system, dt, irec) r end function symba_encounter_check_list_plpl - module function symba_encounter_check_list_pltp(self, param, system, dt, irec) result(lany_encounter) + module function symba_encounter_check_list_pltp(self, param, nbody_system, dt, irec) result(lany_encounter) implicit none class(symba_list_pltp), intent(inout) :: self !! SyMBA pl-tp encounter list object class(swiftest_parameters), intent(inout) :: param !! Current swiftest run configuration parameters - class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object + class(symba_nbody_system), intent(inout) :: nbody_system !! SyMBA nbody system object real(DP), intent(in) :: dt !! step size integer(I4B), intent(in) :: irec !! Current recursion level logical :: lany_encounter !! Returns true if there is at least one close encounter @@ -173,9 +173,9 @@ module function symba_encounter_check_list_pltp(self, param, system, dt, irec) r lany_encounter = .false. if (self%nenc == 0) return - select type(pl => system%pl) + select type(pl => nbody_system%pl) class is (symba_pl) - select type(tp => system%tp) + select type(tp => nbody_system%tp) class is (symba_tp) allocate(lencmask(self%nenc)) lencmask(:) = (self%status(1:self%nenc) == ACTIVE) .and. (self%level(1:self%nenc) == irec - 1) @@ -226,7 +226,7 @@ module function symba_encounter_check_list_pltp(self, param, system, dt, irec) r end function symba_encounter_check_list_pltp - module function symba_encounter_check_tp(self, param, system, dt, irec) result(lany_encounter) + module function symba_encounter_check_tp(self, param, nbody_system, dt, irec) result(lany_encounter) !! author: David A. Minton !! !! Check for an encounter between test particles and massive bodies. @@ -235,7 +235,7 @@ module function symba_encounter_check_tp(self, param, system, dt, irec) result(l ! Arguments class(symba_tp), intent(inout) :: self !! SyMBA test particle object class(swiftest_parameters), intent(inout) :: param !! Current swiftest run configuration parameters - class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object + class(symba_nbody_system), intent(inout) :: nbody_system !! SyMBA nbody system object real(DP), intent(in) :: dt !! step size integer(I4B), intent(in) :: irec !! Current recursion level ! Result @@ -249,13 +249,13 @@ module function symba_encounter_check_tp(self, param, system, dt, irec) result(l lany_encounter = .false. if (self%nbody == 0) return - associate(tp => self, ntp => self%nbody, pl => system%pl, npl => system%pl%nbody) + associate(tp => self, ntp => self%nbody, pl => nbody_system%pl, npl => nbody_system%pl%nbody) call pl%set_renc(irec) call encounter_check_all_pltp(param, npl, ntp, pl%rh, pl%vb, tp%rh, tp%vb, pl%renc, dt, nenc, index1, index2, lvdotr) lany_encounter = nenc > 0 if (lany_encounter) then - associate(pltp_encounter => system%pltp_encounter) + associate(pltp_encounter => nbody_system%pltp_encounter) call pltp_encounter%resize(nenc) pltp_encounter%status(1:nenc) = ACTIVE pltp_encounter%level(1:nenc) = irec diff --git a/src/symba/symba_gr.f90 b/src/symba/symba_gr.f90 index 5457417e0..65a55c559 100644 --- a/src/symba/symba_gr.f90 +++ b/src/symba/symba_gr.f90 @@ -11,7 +11,7 @@ use swiftest contains - pure module subroutine symba_gr_p4_pl(self, system, param, dt) + pure module subroutine symba_gr_p4_pl(self, nbody_system, param, dt) !! author: David A. Minton !! !! Position kick to massive bodies due to p**4 term in the post-Newtonian correction @@ -21,17 +21,17 @@ pure module subroutine symba_gr_p4_pl(self, system, param, dt) implicit none ! Arguments class(symba_pl), intent(inout) :: self !! SyMBA massive body object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters real(DP), intent(in) :: dt !! Step size if (self%nbody == 0) return associate(pl => self, npl => self%nbody) - select type(system) + select type(nbody_system) class is (symba_nbody_system) - pl%lmask(1:npl) = pl%status(1:npl) /= INACTIVE .and. pl%levelg(1:npl) == system%irec - call helio_gr_p4_pl(pl, system, param, dt) + pl%lmask(1:npl) = pl%status(1:npl) /= INACTIVE .and. pl%levelg(1:npl) == nbody_system%irec + call helio_gr_p4_pl(pl, nbody_system, param, dt) pl%lmask(1:npl) = pl%status(1:npl) /= INACTIVE end select end associate @@ -40,7 +40,7 @@ pure module subroutine symba_gr_p4_pl(self, system, param, dt) end subroutine symba_gr_p4_pl - pure module subroutine symba_gr_p4_tp(self, system, param, dt) + pure module subroutine symba_gr_p4_tp(self, nbody_system, param, dt) !! author: David A. Minton !! !! Position kick to test particles due to p**4 term in the post-Newtonian correction @@ -50,17 +50,17 @@ pure module subroutine symba_gr_p4_tp(self, system, param, dt) implicit none ! Arguments class(symba_tp), intent(inout) :: self !! SyMBA test particle object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters real(DP), intent(in) :: dt !! Step size if (self%nbody == 0) return associate(tp => self, ntp => self%nbody) - select type(system) + select type(nbody_system) class is (symba_nbody_system) - tp%lmask(1:ntp) = tp%status(1:ntp) /= INACTIVE .and. tp%levelg(1:ntp) == system%irec - call helio_gr_p4_tp(tp, system, param, dt) + tp%lmask(1:ntp) = tp%status(1:ntp) /= INACTIVE .and. tp%levelg(1:ntp) == nbody_system%irec + call helio_gr_p4_tp(tp, nbody_system, param, dt) tp%lmask(1:ntp) = tp%status(1:ntp) /= INACTIVE end select end associate diff --git a/src/symba/symba_kick.f90 b/src/symba/symba_kick.f90 index 4e9cdd1d4..5ab8480d1 100644 --- a/src/symba/symba_kick.f90 +++ b/src/symba/symba_kick.f90 @@ -55,7 +55,7 @@ module subroutine symba_kick_getacch_int_pl(self, param) end subroutine symba_kick_getacch_int_pl - module subroutine symba_kick_getacch_pl(self, system, param, t, lbeg) + module subroutine symba_kick_getacch_pl(self, nbody_system, param, t, lbeg) !! author: David A. Minton !! !! Compute heliocentric accelerations of massive bodies @@ -65,7 +65,7 @@ module subroutine symba_kick_getacch_pl(self, system, param, t, lbeg) implicit none ! Arguments class(symba_pl), intent(inout) :: self !! SyMBA massive body particle data structure - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! Current simulation time logical, intent(in) :: lbeg !! Logical flag that determines whether or not this is the beginning or end of the step @@ -75,11 +75,11 @@ module subroutine symba_kick_getacch_pl(self, system, param, t, lbeg) integer(I4B), dimension(:,:), allocatable :: k_plpl_enc if (self%nbody == 0) return - select type(system) + select type(nbody_system) class is (symba_nbody_system) - associate(pl => self, npl => self%nbody, nplm => self%nplm, plpl_encounter => system%plpl_encounter, radius => self%radius) + associate(pl => self, npl => self%nbody, nplm => self%nplm, plpl_encounter => nbody_system%plpl_encounter, radius => self%radius) ! Apply kicks to all bodies (including those in the encounter list) - call helio_kick_getacch_pl(pl, system, param, t, lbeg) + call helio_kick_getacch_pl(pl, nbody_system, param, t, lbeg) if (plpl_encounter%nenc > 0) then ! Remove kicks from bodies involved currently in the encounter list, as these are dealt with separately. ah_enc(:,:) = 0.0_DP @@ -98,7 +98,7 @@ module subroutine symba_kick_getacch_pl(self, system, param, t, lbeg) end subroutine symba_kick_getacch_pl - module subroutine symba_kick_getacch_tp(self, system, param, t, lbeg) + module subroutine symba_kick_getacch_tp(self, nbody_system, param, t, lbeg) !! author: David A. Minton !! !! Compute heliocentric accelerations of test particles @@ -108,7 +108,7 @@ module subroutine symba_kick_getacch_tp(self, system, param, t, lbeg) implicit none ! Arguments class(symba_tp), intent(inout) :: self !! SyMBA test particle data structure - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! Current time logical, intent(in) :: lbeg !! Logical flag that determines whether or not this is the beginning or end of the step @@ -118,11 +118,11 @@ module subroutine symba_kick_getacch_tp(self, system, param, t, lbeg) real(DP), dimension(NDIM) :: dx if (self%nbody == 0) return - select type(system) + select type(nbody_system) class is (symba_nbody_system) - associate(tp => self, cb => system%cb, pl => system%pl, & - pltp_encounter => system%pltp_encounter, npltpenc => system%pltp_encounter%nenc) - call helio_kick_getacch_tp(tp, system, param, t, lbeg) + associate(tp => self, cb => nbody_system%cb, pl => nbody_system%pl, & + pltp_encounter => nbody_system%pltp_encounter, npltpenc => nbody_system%pltp_encounter%nenc) + call helio_kick_getacch_tp(tp, nbody_system, param, t, lbeg) ! Remove accelerations from encountering pairs do k = 1, npltpenc i = pltp_encounter%index1(k) @@ -144,7 +144,7 @@ module subroutine symba_kick_getacch_tp(self, system, param, t, lbeg) end subroutine symba_kick_getacch_tp - module subroutine symba_kick_list_plpl(self, system, dt, irec, sgn) + module subroutine symba_kick_list_plpl(self, nbody_system, dt, irec, sgn) !! author: David A. Minton !! !! Kick barycentric velocities of massive bodies within SyMBA recursion. @@ -154,7 +154,7 @@ module subroutine symba_kick_list_plpl(self, system, dt, irec, sgn) implicit none ! Arguments class(symba_list_plpl), intent(in) :: self !! SyMBA pl-tp encounter list object - class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object + class(symba_nbody_system), intent(inout) :: nbody_system !! SyMBA nbody system object real(DP), intent(in) :: dt !! step size integer(I4B), intent(in) :: irec !! Current recursion level integer(I4B), intent(in) :: sgn !! sign to be applied to acceleration @@ -168,7 +168,7 @@ module subroutine symba_kick_list_plpl(self, system, dt, irec, sgn) if (self%nenc == 0) return - select type(pl => system%pl) + select type(pl => nbody_system%pl) class is (symba_pl) associate(npl => pl%nbody, nenc => self%nenc) if (npl == 0) return @@ -249,7 +249,7 @@ module subroutine symba_kick_list_plpl(self, system, dt, irec, sgn) end subroutine symba_kick_list_plpl - module subroutine symba_kick_list_pltp(self, system, dt, irec, sgn) + module subroutine symba_kick_list_pltp(self, nbody_system, dt, irec, sgn) !! author: David A. Minton !! !! Kick barycentric velocities of ACTIVE test particles within SyMBA recursion. @@ -259,7 +259,7 @@ module subroutine symba_kick_list_pltp(self, system, dt, irec, sgn) implicit none ! Arguments class(symba_list_pltp), intent(in) :: self !! SyMBA pl-tp encounter list object - class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object + class(symba_nbody_system), intent(inout) :: nbody_system !! SyMBA nbody system object real(DP), intent(in) :: dt !! step size integer(I4B), intent(in) :: irec !! Current recursion level integer(I4B), intent(in) :: sgn !! sign to be applied to acceleration @@ -273,9 +273,9 @@ module subroutine symba_kick_list_pltp(self, system, dt, irec, sgn) if (self%nenc == 0) return - select type(pl => system%pl) + select type(pl => nbody_system%pl) class is (symba_pl) - select type(tp => system%tp) + select type(tp => nbody_system%tp) class is (symba_tp) associate(npl => pl%nbody, ntp => tp%nbody, nenc => self%nenc) if ((npl == 0) .or. (ntp == 0)) return diff --git a/src/symba/symba_module.f90 b/src/symba/symba_module.f90 index f8d8db5ec..280fe2af8 100644 --- a/src/symba/symba_module.f90 +++ b/src/symba/symba_module.f90 @@ -93,93 +93,93 @@ module symba type, extends(helio_nbody_system) :: symba_nbody_system - integer(I4B) :: irec !! System recursion level + integer(I4B) :: irec !! nbody_system recursion level contains procedure :: initialize => symba_setup_initialize_system !! Performs SyMBA-specific initilization steps procedure :: step => symba_step_system !! Advance the SyMBA nbody system forward in time by one step procedure :: interp => symba_step_interp_system !! Perform an interpolation step on the SymBA nbody system - procedure :: set_recur_levels => symba_step_set_recur_levels_system !! Sets recursion levels of bodies and encounter lists to the current system level + procedure :: set_recur_levels => symba_step_set_recur_levels_system !! Sets recursion levels of bodies and encounter lists to the current nbody_system level procedure :: recursive_step => symba_step_recur_system !! Step interacting planets and active test particles ahead in democratic heliocentric coordinates at the current recursion level, if applicable, and descend to the next deeper level if necessary procedure :: reset => symba_step_reset_system !! Resets pl, tp,and encounter structures at the start of a new step final :: symba_final_system !! Finalizes the SyMBA nbody system object - deallocates all allocatables end type symba_nbody_system interface - module subroutine symba_discard_pl(self, system, param) + module subroutine symba_discard_pl(self, nbody_system, param) implicit none class(symba_pl), intent(inout) :: self !! SyMBA test particle object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters end subroutine symba_discard_pl - module subroutine symba_drift_pl(self, system, param, dt) + module subroutine symba_drift_pl(self, nbody_system, param, dt) implicit none class(symba_pl), intent(inout) :: self !! Helio massive body object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters real(DP), intent(in) :: dt !! Stepsize end subroutine symba_drift_pl - module subroutine symba_drift_tp(self, system, param, dt) + module subroutine symba_drift_tp(self, nbody_system, param, dt) implicit none class(symba_tp), intent(inout) :: self !! Helio massive body object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters real(DP), intent(in) :: dt !! Stepsize end subroutine symba_drift_tp - module function symba_encounter_check_pl(self, param, system, dt, irec) result(lany_encounter) + module function symba_encounter_check_pl(self, param, nbody_system, dt, irec) result(lany_encounter) implicit none class(symba_pl), intent(inout) :: self !! SyMBA test particle object class(swiftest_parameters), intent(inout) :: param !! Current swiftest run configuration parameters - class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object + class(symba_nbody_system), intent(inout) :: nbody_system !! SyMBA nbody system object real(DP), intent(in) :: dt !! step size integer(I4B), intent(in) :: irec !! Current recursion level logical :: lany_encounter !! Returns true if there is at least one close encounter end function symba_encounter_check_pl - module function symba_encounter_check_list_plpl(self, param, system, dt, irec) result(lany_encounter) + module function symba_encounter_check_list_plpl(self, param, nbody_system, dt, irec) result(lany_encounter) implicit none class(symba_list_plpl), intent(inout) :: self !! SyMBA pl-pl encounter list object class(swiftest_parameters), intent(inout) :: param !! Current swiftest run configuration parameters - class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object + class(symba_nbody_system), intent(inout) :: nbody_system !! SyMBA nbody system object real(DP), intent(in) :: dt !! step size integer(I4B), intent(in) :: irec !! Current recursion level logical :: lany_encounter !! Returns true if there is at least one close encounter end function symba_encounter_check_list_plpl - module function symba_encounter_check_list_pltp(self, param, system, dt, irec) result(lany_encounter) + module function symba_encounter_check_list_pltp(self, param, nbody_system, dt, irec) result(lany_encounter) implicit none class(symba_list_pltp), intent(inout) :: self !! SyMBA pl-tp encounter list object class(swiftest_parameters), intent(inout) :: param !! Current swiftest run configuration parameters - class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object + class(symba_nbody_system), intent(inout) :: nbody_system !! SyMBA nbody system object real(DP), intent(in) :: dt !! step size integer(I4B), intent(in) :: irec !! Current recursion level logical :: lany_encounter !! Returns true if there is at least one close encounter end function symba_encounter_check_list_pltp - module function symba_encounter_check_tp(self, param, system, dt, irec) result(lany_encounter) + module function symba_encounter_check_tp(self, param, nbody_system, dt, irec) result(lany_encounter) implicit none class(symba_tp), intent(inout) :: self !! SyMBA test particle object class(swiftest_parameters), intent(inout) :: param !! Current swiftest run configuration parameters - class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object + class(symba_nbody_system), intent(inout) :: nbody_system !! SyMBA nbody system object real(DP), intent(in) :: dt !! step size integer(I4B), intent(in) :: irec !! Current recursion level logical :: lany_encounter !! Returns true if there is at least one close encounter end function symba_encounter_check_tp - pure module subroutine symba_gr_p4_pl(self, system, param, dt) + pure module subroutine symba_gr_p4_pl(self, nbody_system, param, dt) implicit none class(symba_pl), intent(inout) :: self !! SyMBA massive body object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters real(DP), intent(in) :: dt !! Step size end subroutine symba_gr_p4_pl - pure module subroutine symba_gr_p4_tp(self, system, param, dt) + pure module subroutine symba_gr_p4_tp(self, nbody_system, param, dt) implicit none class(symba_tp), intent(inout) :: self !! SyMBA test particle object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters real(DP), intent(in) :: dt !! Step size end subroutine symba_gr_p4_tp @@ -207,37 +207,37 @@ module subroutine symba_kick_getacch_int_pl(self, param) class(swiftest_parameters), intent(inout) :: param !! Current swiftest run configuration parameters end subroutine symba_kick_getacch_int_pl - module subroutine symba_kick_getacch_pl(self, system, param, t, lbeg) + module subroutine symba_kick_getacch_pl(self, nbody_system, param, t, lbeg) implicit none class(symba_pl), intent(inout) :: self !! SyMBA massive body particle data structure - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! Current simulation time logical, intent(in) :: lbeg !! Logical flag that determines whether or not this is the beginning or end of the step end subroutine symba_kick_getacch_pl - module subroutine symba_kick_getacch_tp(self, system, param, t, lbeg) + module subroutine symba_kick_getacch_tp(self, nbody_system, param, t, lbeg) implicit none class(symba_tp), intent(inout) :: self !! SyMBA test particle data structure - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! Current time logical, intent(in) :: lbeg !! Logical flag that determines whether or not this is the beginning or end of the step end subroutine symba_kick_getacch_tp - module subroutine symba_kick_list_plpl(self, system, dt, irec, sgn) + module subroutine symba_kick_list_plpl(self, nbody_system, dt, irec, sgn) implicit none class(symba_list_plpl), intent(in) :: self !! SyMBA pl-tp encounter list object - class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object + class(symba_nbody_system), intent(inout) :: nbody_system !! SyMBA nbody system object real(DP), intent(in) :: dt !! step size integer(I4B), intent(in) :: irec !! Current recursion level integer(I4B), intent(in) :: sgn !! sign to be applied to acceleration end subroutine symba_kick_list_plpl - module subroutine symba_kick_list_pltp(self, system, dt, irec, sgn) + module subroutine symba_kick_list_pltp(self, nbody_system, dt, irec, sgn) implicit none class(symba_list_pltp), intent(in) :: self !! SyMBA pl-tp encounter list object - class(symba_nbody_system), intent(inout) :: system !! SyMBA nbody system object + class(symba_nbody_system), intent(inout) :: nbody_system !! SyMBA nbody system object real(DP), intent(in) :: dt !! step size integer(I4B), intent(in) :: irec !! Current recursion level integer(I4B), intent(in) :: sgn !! sign to be applied to acceleration @@ -245,7 +245,7 @@ end subroutine symba_kick_list_pltp module subroutine symba_setup_initialize_system(self, param) implicit none - class(symba_nbody_system), intent(inout) :: self !! SyMBA system object + class(symba_nbody_system), intent(inout) :: self !! SyMBA nbody_system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters end subroutine symba_setup_initialize_system diff --git a/src/symba/symba_setup.f90 b/src/symba/symba_setup.f90 index f6207ac90..20e713c5c 100644 --- a/src/symba/symba_setup.f90 +++ b/src/symba/symba_setup.f90 @@ -19,15 +19,15 @@ module subroutine symba_setup_initialize_system(self, param) !! implicit none ! Arguments - class(symba_nbody_system), intent(inout) :: self !! SyMBA system object + class(symba_nbody_system), intent(inout) :: self !! SyMBA nbody_system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters ! Call parent method - associate(system => self) - call helio_setup_initialize_system(system, param) - call system%pltp_encounter%setup(0_I8B) - call system%plpl_encounter%setup(0_I8B) - call system%plpl_collision%setup(0_I8B) + associate(nbody_system => self) + call helio_setup_initialize_system(nbody_system, param) + call nbody_system%pltp_encounter%setup(0_I8B) + call nbody_system%plpl_encounter%setup(0_I8B) + call nbody_system%plpl_collision%setup(0_I8B) end associate return diff --git a/src/symba/symba_step.f90 b/src/symba/symba_step.f90 index 274dc5279..8d641485e 100644 --- a/src/symba/symba_step.f90 +++ b/src/symba/symba_step.f90 @@ -78,34 +78,34 @@ module subroutine symba_step_interp_system(self, param, t, dt) class is (symba_tp) select type(cb => self%cb) class is (symba_cb) - associate(system => self) + associate(nbody_system => self) dth = 0.5_DP * dt - system%irec = -1 + nbody_system%irec = -1 if (pl%lfirst) call pl%vh2vb(cb) call pl%lindrift(cb, dth, lbeg=.true.) - call pl%kick(system, param, t, dth, lbeg=.true.) - if (param%lgr) call pl%gr_pos_kick(system, param, dth) - call pl%drift(system, param, dt) + call pl%kick(nbody_system, param, t, dth, lbeg=.true.) + if (param%lgr) call pl%gr_pos_kick(nbody_system, param, dth) + call pl%drift(nbody_system, param, dt) if (tp%nbody > 0) then if (tp%lfirst) call tp%vh2vb(vbcb = -cb%ptbeg) call tp%lindrift(cb, dth, lbeg=.true.) - call tp%kick(system, param, t, dth, lbeg=.true.) - if (param%lgr) call tp%gr_pos_kick(system, param, dth) - call tp%drift(system, param, dt) + call tp%kick(nbody_system, param, t, dth, lbeg=.true.) + if (param%lgr) call tp%gr_pos_kick(nbody_system, param, dth) + call tp%drift(nbody_system, param, dt) end if - call system%recursive_step(param, t, 0) - system%irec = -1 + call nbody_system%recursive_step(param, t, 0) + nbody_system%irec = -1 - if (param%lgr) call pl%gr_pos_kick(system, param, dth) - call pl%kick(system, param, t, dth, lbeg=.false.) + if (param%lgr) call pl%gr_pos_kick(nbody_system, param, dth) + call pl%kick(nbody_system, param, t, dth, lbeg=.false.) call pl%lindrift(cb, dth, lbeg=.false.) call pl%vb2vh(cb) if (tp%nbody > 0) then - if (param%lgr) call tp%gr_pos_kick(system, param, dth) - call tp%kick(system, param, t, dth, lbeg=.false.) + if (param%lgr) call tp%gr_pos_kick(nbody_system, param, dth) + call tp%kick(nbody_system, param, t, dth, lbeg=.false.) call tp%lindrift(cb, dth, lbeg=.false.) call tp%vb2vh(vbcb = -cb%ptend) end if @@ -136,7 +136,7 @@ module subroutine symba_step_set_recur_levels_system(self, ireci) class is (symba_pl) select type(tp => self%tp) class is (symba_tp) - associate(system => self, plpl_encounter => self%plpl_encounter, pltp_encounter => self%pltp_encounter, npl => self%pl%nbody, ntp => self%tp%nbody) + associate(nbody_system => self, plpl_encounter => self%plpl_encounter, pltp_encounter => self%pltp_encounter, npl => self%pl%nbody, ntp => self%tp%nbody) irecp = ireci + 1 @@ -153,7 +153,7 @@ module subroutine symba_step_set_recur_levels_system(self, ireci) endwhere end if - system%irec = ireci + nbody_system%irec = ireci end associate end select @@ -192,8 +192,8 @@ recursive module subroutine symba_step_recur_system(self, param, t, ireci) class is (symba_list_plpl) select type(pltp_encounter => self%pltp_encounter) class is (symba_list_pltp) - associate(system => self, lplpl_collision => plpl_encounter%lcollision, lpltp_collision => pltp_encounter%lcollision, encounter_history => self%encounter_history) - system%irec = ireci + associate(nbody_system => self, lplpl_collision => plpl_encounter%lcollision, lpltp_collision => pltp_encounter%lcollision, encounter_history => self%encounter_history) + nbody_system%irec = ireci dtl = param%dt / (NTENC**ireci) dth = 0.5_DP * dtl IF (dtl / param%dt < VSMALL) THEN @@ -209,45 +209,45 @@ recursive module subroutine symba_step_recur_system(self, param, t, ireci) nloops = NTENC end if do j = 1, nloops - lencounter = plpl_encounter%encounter_check(param, system, dtl, irecp) & - .or. pltp_encounter%encounter_check(param, system, dtl, irecp) + lencounter = plpl_encounter%encounter_check(param, nbody_system, dtl, irecp) & + .or. pltp_encounter%encounter_check(param, nbody_system, dtl, irecp) - call plpl_encounter%kick(system, dth, irecp, 1) - call pltp_encounter%kick(system, dth, irecp, 1) + call plpl_encounter%kick(nbody_system, dth, irecp, 1) + call pltp_encounter%kick(nbody_system, dth, irecp, 1) if (ireci /= 0) then - call plpl_encounter%kick(system, dth, irecp, -1) - call pltp_encounter%kick(system, dth, irecp, -1) + call plpl_encounter%kick(nbody_system, dth, irecp, -1) + call pltp_encounter%kick(nbody_system, dth, irecp, -1) end if if (param%lgr) then - call pl%gr_pos_kick(system, param, dth) - call tp%gr_pos_kick(system, param, dth) + call pl%gr_pos_kick(nbody_system, param, dth) + call tp%gr_pos_kick(nbody_system, param, dth) end if - call pl%drift(system, param, dtl) - call tp%drift(system, param, dtl) + call pl%drift(nbody_system, param, dtl) + call tp%drift(nbody_system, param, dtl) - if (lencounter) call system%recursive_step(param, t+(j-1)*dtl, irecp) - system%irec = ireci + if (lencounter) call nbody_system%recursive_step(param, t+(j-1)*dtl, irecp) + nbody_system%irec = ireci if (param%lgr) then - call pl%gr_pos_kick(system, param, dth) - call tp%gr_pos_kick(system, param, dth) + call pl%gr_pos_kick(nbody_system, param, dth) + call tp%gr_pos_kick(nbody_system, param, dth) end if - call plpl_encounter%kick(system, dth, irecp, 1) - call pltp_encounter%kick(system, dth, irecp, 1) + call plpl_encounter%kick(nbody_system, dth, irecp, 1) + call pltp_encounter%kick(nbody_system, dth, irecp, 1) if (ireci /= 0) then - call plpl_encounter%kick(system, dth, irecp, -1) - call pltp_encounter%kick(system, dth, irecp, -1) + call plpl_encounter%kick(nbody_system, dth, irecp, -1) + call pltp_encounter%kick(nbody_system, dth, irecp, -1) end if if (param%lclose) then - call plpl_encounter%collision_check(system, param, t+j*dtl, dtl, ireci, lplpl_collision) - call pltp_encounter%collision_check(system, param, t+j*dtl, dtl, ireci, lpltp_collision) + call plpl_encounter%collision_check(nbody_system, param, t+j*dtl, dtl, ireci, lplpl_collision) + call pltp_encounter%collision_check(nbody_system, param, t+j*dtl, dtl, ireci, lpltp_collision) - if (lplpl_collision) call plpl_encounter%resolve_collision(system, param, t+j*dtl, dtl, ireci) - if (lpltp_collision) call pltp_encounter%resolve_collision(system, param, t+j*dtl, dtl, ireci) + if (lplpl_collision) call plpl_encounter%resolve_collision(nbody_system, param, t+j*dtl, dtl, ireci) + if (lpltp_collision) call pltp_encounter%resolve_collision(nbody_system, param, t+j*dtl, dtl, ireci) end if if (param%lenc_save_trajectory) call encounter_history%take_snapshot(param, self, t+j*dtl, "trajectory") @@ -280,15 +280,15 @@ module subroutine symba_step_reset_system(self, param) integer(I4B) :: i integer(I8B) :: nenc_old - associate(system => self) - select type(pl => system%pl) + associate(nbody_system => self) + select type(pl => nbody_system%pl) class is (symba_pl) - select type(tp => system%tp) + select type(tp => nbody_system%tp) class is (symba_tp) associate(npl => pl%nbody, ntp => tp%nbody) - nenc_old = system%plpl_encounter%nenc - call system%plpl_encounter%setup(0_I8B) - call system%plpl_collision%setup(0_I8B) + nenc_old = nbody_system%plpl_encounter%nenc + call nbody_system%plpl_encounter%setup(0_I8B) + call nbody_system%plpl_collision%setup(0_I8B) if (npl > 0) then pl%lcollision(1:npl) = .false. call pl%reset_kinship([(i, i=1, npl)]) @@ -301,26 +301,26 @@ module subroutine symba_step_reset_system(self, param) pl%ldiscard(1:npl) = .false. pl%lmask(1:npl) = .true. call pl%set_renc(0) - call system%plpl_encounter%setup(nenc_old) ! This resizes the pl-pl encounter list to be the same size as it was the last step, to decrease the number of potential resize operations that have to be one inside the step - system%plpl_encounter%nenc = 0 ! Sets the true number of encounters back to 0 after resizing - system%plpl_encounter%lcollision = .false. + call nbody_system%plpl_encounter%setup(nenc_old) ! This resizes the pl-pl encounter list to be the same size as it was the last step, to decrease the number of potential resize operations that have to be one inside the step + nbody_system%plpl_encounter%nenc = 0 ! Sets the true number of encounters back to 0 after resizing + nbody_system%plpl_encounter%lcollision = .false. end if - nenc_old = system%pltp_encounter%nenc - call system%pltp_encounter%setup(0_I8B) + nenc_old = nbody_system%pltp_encounter%nenc + call nbody_system%pltp_encounter%setup(0_I8B) if (ntp > 0) then tp%nplenc(1:ntp) = 0 tp%levelg(1:ntp) = -1 tp%levelm(1:ntp) = -1 tp%lmask(1:ntp) = .true. tp%ldiscard(1:ntp) = .false. - call system%pltp_encounter%setup(nenc_old)! This resizes the pl-tp encounter list to be the same size as it was the last step, to decrease the number of potential resize operations that have to be one inside the step - system%pltp_encounter%nenc = 0 ! Sets the true number of encounters back to 0 after resizing - system%pltp_encounter%lcollision = .false. + call nbody_system%pltp_encounter%setup(nenc_old)! This resizes the pl-tp encounter list to be the same size as it was the last step, to decrease the number of potential resize operations that have to be one inside the step + nbody_system%pltp_encounter%nenc = 0 ! Sets the true number of encounters back to 0 after resizing + nbody_system%pltp_encounter%lcollision = .false. end if - call system%pl_adds%setup(0, param) - call system%pl_discards%setup(0, param) + call nbody_system%pl_adds%setup(0, param) + call nbody_system%pl_discards%setup(0, param) tp%lfirst = param%lfirstkick pl%lfirst = param%lfirstkick diff --git a/src/tides/tides_getacch_pl.f90 b/src/tides/tides_getacch_pl.f90 index 680c22704..f3da3cfc5 100644 --- a/src/tides/tides_getacch_pl.f90 +++ b/src/tides/tides_getacch_pl.f90 @@ -2,7 +2,7 @@ use swiftest contains - module subroutine tides_kick_getacch_pl(self, system) + module subroutine tides_kick_getacch_pl(self, nbody_system) !! author: Jennifer L.L. Pouplin, Carlisle A. wishard, and David A. Minton !! !! Calculated tidal torques from central body to any planet and from any planet to central body @@ -18,7 +18,7 @@ module subroutine tides_kick_getacch_pl(self, system) implicit none ! Arguments class(base_object), intent(inout) :: self !! Swiftest massive body object - class(base_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object ! Internals integer(I4B) :: i real(DP) :: rmag, vmag @@ -27,9 +27,9 @@ module subroutine tides_kick_getacch_pl(self, system) select type(pl => self) class is (swiftest_pl) - select type(system) + select type(nbody_system) class is (swiftest_nbody_system) - associate(npl => pl%nbody, cb => system%cb) + associate(npl => pl%nbody, cb => nbody_system%cb) pl%atide(:,:) = 0.0_DP cb%atide(:) = 0.0_DP do i = 1, npl diff --git a/src/tides/tides_module.f90 b/src/tides/tides_module.f90 index 6d9c5f465..828575f76 100644 --- a/src/tides/tides_module.f90 +++ b/src/tides/tides_module.f90 @@ -47,10 +47,10 @@ function tidederiv(x, t, dt, rbeg, rend) result(y) interface - module subroutine tides_kick_getacch_pl(self, system) + module subroutine tides_kick_getacch_pl(self, nbody_system) implicit none class(base_object), intent(inout) :: self !! Swiftest massive body object - class(base_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object end subroutine tides_kick_getacch_pl module function tides_derivs_init(lambda, dt, rbeg, rend) result(f) diff --git a/src/tides/tides_spin_step.f90 b/src/tides/tides_spin_step.f90 index adf602b77..40a8f1659 100644 --- a/src/tides/tides_spin_step.f90 +++ b/src/tides/tides_spin_step.f90 @@ -6,7 +6,7 @@ module subroutine tides_step_spin_system(self, param, t, dt) !! author: Jennifer L.L. Pouplin and David A. Minton !! - !! Integrates the spin equations for central and massive bodies of the system subjected to tides. + !! Integrates the spin equations for central and massive bodies of the nbody_system subjected to tides. implicit none ! Arguments class(base_nbody_system), intent(inout) :: self !! Swiftest nbody system object diff --git a/src/whm/whm_drift.f90 b/src/whm/whm_drift.f90 index 31d041505..21a092793 100644 --- a/src/whm/whm_drift.f90 +++ b/src/whm/whm_drift.f90 @@ -11,7 +11,7 @@ use swiftest contains - module subroutine whm_drift_pl(self, system, param, dt) + module subroutine whm_drift_pl(self, nbody_system, param, dt) !! author: David A. Minton !! !! Loop through planets and call Danby drift routine @@ -21,7 +21,7 @@ module subroutine whm_drift_pl(self, system, param, dt) implicit none ! Arguments class(whm_pl), intent(inout) :: self !! WHM massive body particle data structure - class(swiftest_nbody_system), intent(inout) :: system !! WHM nbody system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! WHM nbody system object class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters real(DP), intent(in) :: dt !! Stepsize ! Internals diff --git a/src/whm/whm_gr.f90 b/src/whm/whm_gr.f90 index dc694a168..b0891f006 100644 --- a/src/whm/whm_gr.f90 +++ b/src/whm/whm_gr.f90 @@ -70,7 +70,7 @@ pure module subroutine whm_gr_kick_getacch_tp(self, param) end subroutine whm_gr_kick_getacch_tp - pure module subroutine whm_gr_p4_pl(self, system, param, dt) + pure module subroutine whm_gr_p4_pl(self, nbody_system, param, dt) !! author: David A. Minton !! !! Position kick to massive bodies due to p**4 term in the post-Newtonian correction @@ -80,7 +80,7 @@ pure module subroutine whm_gr_p4_pl(self, system, param, dt) implicit none ! Arguments class(whm_pl), intent(inout) :: self !! Swiftest particle object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters real(DP), intent(in) :: dt !! Step size ! Internals @@ -97,7 +97,7 @@ pure module subroutine whm_gr_p4_pl(self, system, param, dt) end subroutine whm_gr_p4_pl - pure module subroutine whm_gr_p4_tp(self, system, param, dt) + pure module subroutine whm_gr_p4_tp(self, nbody_system, param, dt) !! author: David A. Minton !! !! Position kick to test particles due to p**4 term in the post-Newtonian correction @@ -107,7 +107,7 @@ pure module subroutine whm_gr_p4_tp(self, system, param, dt) implicit none ! Arguments class(whm_tp), intent(inout) :: self !! Swiftest particle object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters real(DP), intent(in) :: dt !! Step size ! Internals diff --git a/src/whm/whm_kick.f90 b/src/whm/whm_kick.f90 index 0b0746b87..6469809e5 100644 --- a/src/whm/whm_kick.f90 +++ b/src/whm/whm_kick.f90 @@ -11,7 +11,7 @@ use swiftest contains - module subroutine whm_kick_getacch_pl(self, system, param, t, lbeg) + module subroutine whm_kick_getacch_pl(self, nbody_system, param, t, lbeg) !! author: David A. Minton !! !! Compute heliocentric accelerations of planets @@ -21,7 +21,7 @@ module subroutine whm_kick_getacch_pl(self, system, param, t, lbeg) implicit none ! Arguments class(whm_pl), intent(inout) :: self !! WHM massive body particle data structure - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest central body particle data structure + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest central body particle data structure class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! Current time logical, intent(in) :: lbeg !! Logical flag that determines whether or not this is the beginning or end of the step @@ -31,7 +31,7 @@ module subroutine whm_kick_getacch_pl(self, system, param, t, lbeg) if (self%nbody == 0) return - associate(cb => system%cb, pl => self, npl => self%nbody) + associate(cb => nbody_system%cb, pl => self, npl => self%nbody) call pl%set_ir3() ah0(:) = whm_kick_getacch_ah0(pl%Gmass(2:npl), pl%rh(:,2:npl), npl-1) @@ -44,7 +44,7 @@ module subroutine whm_kick_getacch_pl(self, system, param, t, lbeg) call pl%accel_int(param) if (param%loblatecb) then - call pl%accel_obl(system) + call pl%accel_obl(nbody_system) if (lbeg) then cb%aoblbeg = cb%aobl else @@ -53,21 +53,21 @@ module subroutine whm_kick_getacch_pl(self, system, param, t, lbeg) ! TODO: Implement tides ! if (param%ltides) then ! cb%atidebeg = cb%aobl - ! call pl%accel_tides(system) + ! call pl%accel_tides(nbody_system) ! cb%atideend = cb%atide ! end if end if if (param%lgr) call pl%accel_gr(param) - if (param%lextra_force) call pl%accel_user(system, param, t, lbeg) + if (param%lextra_force) call pl%accel_user(nbody_system, param, t, lbeg) end associate return end subroutine whm_kick_getacch_pl - module subroutine whm_kick_getacch_tp(self, system, param, t, lbeg) + module subroutine whm_kick_getacch_tp(self, nbody_system, param, t, lbeg) !! author: David A. Minton !! !! Compute heliocentric accelerations of test particles @@ -77,7 +77,7 @@ module subroutine whm_kick_getacch_tp(self, system, param, t, lbeg) implicit none ! Arguments class(whm_tp), intent(inout) :: self !! WHM test particle data structure - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest central body particle data structure + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest central body particle data structure class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! Current time logical, intent(in) :: lbeg !! Logical flag that determines whether or not this is the beginning or end of the step @@ -85,9 +85,9 @@ module subroutine whm_kick_getacch_tp(self, system, param, t, lbeg) integer(I4B) :: i real(DP), dimension(NDIM) :: ah0 - associate(tp => self, ntp => self%nbody, pl => system%pl, cb => system%cb, npl => system%pl%nbody) + associate(tp => self, ntp => self%nbody, pl => nbody_system%pl, cb => nbody_system%cb, npl => nbody_system%pl%nbody) if (ntp == 0 .or. npl == 0) return - system%lbeg = lbeg + nbody_system%lbeg = lbeg if (lbeg) then ah0(:) = whm_kick_getacch_ah0(pl%Gmass(1:npl), pl%rbeg(:, 1:npl), npl) @@ -103,8 +103,8 @@ module subroutine whm_kick_getacch_tp(self, system, param, t, lbeg) call tp%accel_int(param, pl%Gmass(1:npl), pl%rend(:, 1:npl), npl) end if - if (param%loblatecb) call tp%accel_obl(system) - if (param%lextra_force) call tp%accel_user(system, param, t, lbeg) + if (param%loblatecb) call tp%accel_obl(nbody_system) + if (param%lextra_force) call tp%accel_user(nbody_system, param, t, lbeg) if (param%lgr) call tp%accel_gr(param) end associate @@ -200,7 +200,7 @@ pure subroutine whm_kick_getacch_ah2(cb, pl) end subroutine whm_kick_getacch_ah2 - module subroutine whm_kick_vh_pl(self, system, param, t, dt, lbeg) + module subroutine whm_kick_vh_pl(self, nbody_system, param, t, dt, lbeg) !! author: David A. Minton !! !! Kick heliocentric velocities of massive bodies @@ -210,7 +210,7 @@ module subroutine whm_kick_vh_pl(self, system, param, t, dt, lbeg) implicit none ! Arguments class(whm_pl), intent(inout) :: self !! WHM massive body object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! Current time real(DP), intent(in) :: dt !! Stepsize @@ -218,19 +218,19 @@ module subroutine whm_kick_vh_pl(self, system, param, t, dt, lbeg) ! Internals integer(I4B) :: i - associate(pl => self, npl => self%nbody, cb => system%cb) + associate(pl => self, npl => self%nbody, cb => nbody_system%cb) if (npl == 0) return if (lbeg) then if (pl%lfirst) then call pl%h2j(cb) pl%ah(:, 1:npl) = 0.0_DP - call pl%accel(system, param, t, lbeg) + call pl%accel(nbody_system, param, t, lbeg) pl%lfirst = .false. end if call pl%set_beg_end(rbeg = pl%rh) else pl%ah(:, 1:npl) = 0.0_DP - call pl%accel(system, param, t, lbeg) + call pl%accel(nbody_system, param, t, lbeg) call pl%set_beg_end(rend = pl%rh) end if do concurrent(i = 1:npl, pl%lmask(i)) @@ -242,7 +242,7 @@ module subroutine whm_kick_vh_pl(self, system, param, t, dt, lbeg) end subroutine whm_kick_vh_pl - module subroutine whm_kick_vh_tp(self, system, param, t, dt, lbeg) + module subroutine whm_kick_vh_tp(self, nbody_system, param, t, dt, lbeg) !! author: David A. Minton !! !! Kick heliocentric velocities of test particles @@ -252,7 +252,7 @@ module subroutine whm_kick_vh_tp(self, system, param, t, dt, lbeg) implicit none ! Arguments class(whm_tp), intent(inout) :: self !! WHM massive body object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! Current time real(DP), intent(in) :: dt !! Stepsize @@ -267,14 +267,14 @@ module subroutine whm_kick_vh_tp(self, system, param, t, dt, lbeg) do concurrent(i = 1:ntp, tp%lmask(i)) tp%ah(:, i) = 0.0_DP end do - call tp%accel(system, param, t, lbeg=.true.) + call tp%accel(nbody_system, param, t, lbeg=.true.) tp%lfirst = .false. end if if (.not.lbeg) then do concurrent(i = 1:ntp, tp%lmask(i)) tp%ah(:, i) = 0.0_DP end do - call tp%accel(system, param, t, lbeg) + call tp%accel(nbody_system, param, t, lbeg) end if do concurrent(i = 1:ntp, tp%lmask(i)) tp%vh(:, i) = tp%vh(:, i) + tp%ah(:, i) * dt diff --git a/src/whm/whm_module.f90 b/src/whm/whm_module.f90 index c3f2ce96f..fad0d8a55 100644 --- a/src/whm/whm_module.f90 +++ b/src/whm/whm_module.f90 @@ -74,7 +74,7 @@ module whm !> Replace the abstract procedures with concrete ones procedure :: initialize => whm_setup_initialize_system !! Performs WHM-specific initilization steps, like calculating the Jacobi masses procedure :: step => whm_step_system !! Advance the WHM nbody system forward in time by one step - final :: whm_final_system !! Finalizes the WHM system object - deallocates all allocatables + final :: whm_final_system !! Finalizes the WHM nbody_system object - deallocates all allocatables end type whm_nbody_system interface @@ -96,48 +96,48 @@ module subroutine whm_coord_vh2vj_pl(self, cb) class(swiftest_cb), intent(inout) :: cb !! Swiftest central body particle data structuree end subroutine whm_coord_vh2vj_pl - module subroutine whm_drift_pl(self, system, param, dt) + module subroutine whm_drift_pl(self, nbody_system, param, dt) implicit none class(whm_pl), intent(inout) :: self !! WHM massive body particle data structure - class(swiftest_nbody_system), intent(inout) :: system !! WHM nbody system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! WHM nbody system object class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters real(DP), intent(in) :: dt !! Stepsize end subroutine whm_drift_pl !> Get heliocentric accelration of massive bodies - module subroutine whm_kick_getacch_pl(self, system, param, t, lbeg) + module subroutine whm_kick_getacch_pl(self, nbody_system, param, t, lbeg) implicit none class(whm_pl), intent(inout) :: self !! WHM massive body particle data structure - class(swiftest_nbody_system), intent(inout) :: system !! WHM nbody system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! WHM nbody system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! Current simulation time logical, intent(in) :: lbeg !! Logical flag that determines whether or not this is the beginning or end of the step end subroutine whm_kick_getacch_pl !> Get heliocentric accelration of the test particle - module subroutine whm_kick_getacch_tp(self, system, param, t, lbeg) + module subroutine whm_kick_getacch_tp(self, nbody_system, param, t, lbeg) implicit none class(whm_tp), intent(inout) :: self !! WHM test particle data structure - class(swiftest_nbody_system), intent(inout) :: system !! WHM nbody system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! WHM nbody system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! Current time logical, intent(in) :: lbeg !! Logical flag that determines whether or not this is the beginning or end of the step end subroutine whm_kick_getacch_tp - module subroutine whm_kick_vh_pl(self, system, param, t, dt, lbeg) + module subroutine whm_kick_vh_pl(self, nbody_system, param, t, dt, lbeg) implicit none class(whm_pl), intent(inout) :: self !! WHM massive body object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! Current time real(DP), intent(in) :: dt !! Stepsize logical, intent(in) :: lbeg !! Logical flag indicating whether this is the beginning of the half step or not. end subroutine whm_kick_vh_pl - module subroutine whm_kick_vh_tp(self, system, param, t, dt, lbeg) + module subroutine whm_kick_vh_tp(self, nbody_system, param, t, dt, lbeg) implicit none class(whm_tp), intent(inout) :: self !! WHM test particle object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! Current time real(DP), intent(in) :: dt !! Stepsize @@ -156,18 +156,18 @@ pure module subroutine whm_gr_kick_getacch_tp(self, param) class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters end subroutine whm_gr_kick_getacch_tp - pure module subroutine whm_gr_p4_pl(self, system, param, dt) + pure module subroutine whm_gr_p4_pl(self, nbody_system, param, dt) implicit none class(whm_pl), intent(inout) :: self !! WHM massive body object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters real(DP), intent(in) :: dt !! Step size end subroutine whm_gr_p4_pl - pure module subroutine whm_gr_p4_tp(self, system, param, dt) + pure module subroutine whm_gr_p4_tp(self, nbody_system, param, dt) implicit none class(whm_tp), intent(inout) :: self !! WHM test particle object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters real(DP), intent(in) :: dt !! Step size end subroutine whm_gr_p4_tp @@ -186,10 +186,10 @@ module subroutine whm_setup_initialize_system(self, param) class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters end subroutine whm_setup_initialize_system - module subroutine whm_step_pl(self, system, param, t, dt) + module subroutine whm_step_pl(self, nbody_system, param, t, dt) implicit none class(whm_pl), intent(inout) :: self !! WHM massive body object - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody_system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! Simulation time real(DP), intent(in) :: dt !! Current stepsize @@ -197,16 +197,16 @@ end subroutine whm_step_pl module subroutine whm_step_system(self, param, t, dt) implicit none - class(whm_nbody_system), intent(inout) :: self !! WHM system object + class(whm_nbody_system), intent(inout) :: self !! WHM nbody_system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! Simulation time real(DP), intent(in) :: dt !! Current stepsize end subroutine whm_step_system - module subroutine whm_step_tp(self, system, param, t, dt) + module subroutine whm_step_tp(self, nbody_system, param, t, dt) implicit none class(whm_tp), intent(inout) :: self !! WHM test particle data structure - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! Current simulation time real(DP), intent(in) :: dt !! Stepsize diff --git a/src/whm/whm_setup.f90 b/src/whm/whm_setup.f90 index 6a150d7b9..fe4745777 100644 --- a/src/whm/whm_setup.f90 +++ b/src/whm/whm_setup.f90 @@ -49,7 +49,7 @@ module subroutine whm_util_set_mu_eta_pl(self, cb) !! Sets the Jacobi mass value eta for all massive bodies implicit none ! Arguments - class(whm_pl), intent(inout) :: self !! WHM system object + class(whm_pl), intent(inout) :: self !! WHM nbody_system object class(swiftest_cb), intent(inout) :: cb !! Swiftest central body object ! Internals integer(I4B) :: i diff --git a/src/whm/whm_step.f90 b/src/whm/whm_step.f90 index f592bdf66..e4ea4262d 100644 --- a/src/whm/whm_step.f90 +++ b/src/whm/whm_step.f90 @@ -25,17 +25,17 @@ module subroutine whm_step_system(self, param, t, dt) real(DP), intent(in) :: t !! Current simulation time real(DP), intent(in) :: dt !! Current stepsize - associate(system => self, cb => self%cb, pl => self%pl, tp => self%tp) + associate(nbody_system => self, cb => self%cb, pl => self%pl, tp => self%tp) tp%lfirst = pl%lfirst - call pl%step(system, param, t, dt) - call tp%step(system, param, t, dt) - ! if (param%ltides) call system%step_spin(param, t, dt) + call pl%step(nbody_system, param, t, dt) + call tp%step(nbody_system, param, t, dt) + ! if (param%ltides) call nbody_system%step_spin(param, t, dt) end associate return end subroutine whm_step_system - module subroutine whm_step_pl(self, system, param, t, dt) + module subroutine whm_step_pl(self, nbody_system, param, t, dt) !! author: David A. Minton !! !! Step planets ahead using kick-drift-kick algorithm @@ -46,7 +46,7 @@ module subroutine whm_step_pl(self, system, param, t, dt) implicit none ! Arguments class(whm_pl), intent(inout) :: self !! WHM massive body particle data structure - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody_system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! Current simulation time real(DP), intent(in) :: dt !! Current stepsize @@ -55,22 +55,22 @@ module subroutine whm_step_pl(self, system, param, t, dt) if (self%nbody == 0) return - associate(pl => self, cb => system%cb) + associate(pl => self, cb => nbody_system%cb) dth = 0.5_DP * dt - call pl%kick(system, param, t, dth,lbeg=.true.) + call pl%kick(nbody_system, param, t, dth,lbeg=.true.) call pl%vh2vj(cb) - if (param%lgr) call pl%gr_pos_kick(system, param, dth) - call pl%drift(system, param, dt) - if (param%lgr) call pl%gr_pos_kick(system, param, dth) + if (param%lgr) call pl%gr_pos_kick(nbody_system, param, dth) + call pl%drift(nbody_system, param, dt) + if (param%lgr) call pl%gr_pos_kick(nbody_system, param, dth) call pl%j2h(cb) - call pl%kick(system, param, t + dt, dth, lbeg=.false.) + call pl%kick(nbody_system, param, t + dt, dth, lbeg=.false.) end associate return end subroutine whm_step_pl - module subroutine whm_step_tp(self, system, param, t, dt) + module subroutine whm_step_tp(self, nbody_system, param, t, dt) !! author: David A. Minton !! !! Step active test particles ahead using kick-drift-kick algorithm @@ -80,7 +80,7 @@ module subroutine whm_step_tp(self, system, param, t, dt) implicit none ! Arguments class(whm_tp), intent(inout) :: self !! WHM test particle data structure - class(swiftest_nbody_system), intent(inout) :: system !! Swiftest system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody_system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! Current simulation time real(DP), intent(in) :: dt !! Current stepsize @@ -89,15 +89,15 @@ module subroutine whm_step_tp(self, system, param, t, dt) if (self%nbody == 0) return - select type(system) + select type(nbody_system) class is (whm_nbody_system) - associate(tp => self, cb => system%cb, pl => system%pl) + associate(tp => self, cb => nbody_system%cb, pl => nbody_system%pl) dth = 0.5_DP * dt - call tp%kick(system, param, t, dth, lbeg=.true.) - if (param%lgr) call tp%gr_pos_kick(system, param, dth) - call tp%drift(system, param, dt) - if (param%lgr) call tp%gr_pos_kick(system, param, dth) - call tp%kick(system, param, t + dt, dth, lbeg=.false.) + call tp%kick(nbody_system, param, t, dth, lbeg=.true.) + if (param%lgr) call tp%gr_pos_kick(nbody_system, param, dth) + call tp%drift(nbody_system, param, dt) + if (param%lgr) call tp%gr_pos_kick(nbody_system, param, dth) + call tp%kick(nbody_system, param, t + dt, dth, lbeg=.false.) end associate end select From d62cec54bded18debdf461da47a0a393757db996 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Thu, 22 Dec 2022 08:19:18 -0500 Subject: [PATCH 487/569] small changes to the collision resolver for mergers --- src/collision/collision_regime.f90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/collision/collision_regime.f90 b/src/collision/collision_regime.f90 index 50884258b..ac571b23c 100644 --- a/src/collision/collision_regime.f90 +++ b/src/collision/collision_regime.f90 @@ -36,9 +36,9 @@ module subroutine collision_regime_impactors(self, nbody_system, param) case("MERGE") impactors%regime = COLLRESOLVE_REGIME_MERGE mtot = sum(impactors%mass(:)) + if (allocated(impactors%mass_dist)) deallocate(impactors%mass_dist) + allocate(impactors%mass_dist(1)) impactors%mass_dist(1) = mtot - impactors%mass_dist(2) = 0.0_DP - impactors%mass_dist(3) = 0.0_DP impactors%rbcom(:) = (impactors%mass(1) * impactors%rb(:,1) + impactors%mass(2) * impactors%rb(:,2)) / mtot impactors%vbcom(:) = (impactors%mass(1) * impactors%vb(:,1) + impactors%mass(2) * impactors%vb(:,2)) / mtot case default From f63621d5e606f75109df7468aed9a058c37e3d8b Mon Sep 17 00:00:00 2001 From: David A Minton Date: Thu, 22 Dec 2022 08:28:08 -0500 Subject: [PATCH 488/569] Cleanup and bugfixes --- src/collision/collision_util.f90 | 1 + src/swiftest/swiftest_setup.f90 | 4 ++-- 2 files changed, 3 insertions(+), 2 deletions(-) diff --git a/src/collision/collision_util.f90 b/src/collision/collision_util.f90 index 9898e3710..c2d3a1924 100644 --- a/src/collision/collision_util.f90 +++ b/src/collision/collision_util.f90 @@ -503,6 +503,7 @@ module subroutine collision_util_snapshot(self, param, nbody_system, t, arg) case("before") ! Saves the states of the bodies involved in the collision before the collision is resolved associate (idx => nbody_system%collider%impactors%id, ncoll => nbody_system%collider%impactors%ncoll) + allocate(pl, mold=nbody_system%pl) call pl%setup(ncoll, param) pl%id(:) = nbody_system%pl%id(idx(:)) pl%Gmass(:) = nbody_system%pl%Gmass(idx(:)) diff --git a/src/swiftest/swiftest_setup.f90 b/src/swiftest/swiftest_setup.f90 index 85084bfe0..a08daf29d 100644 --- a/src/swiftest/swiftest_setup.f90 +++ b/src/swiftest/swiftest_setup.f90 @@ -83,8 +83,8 @@ module subroutine swiftest_setup_construct_system(nbody_system, param) allocate(symba_pl :: nbody_system%pl_adds) allocate(symba_pl :: nbody_system%pl_discards) - allocate(collision_list_pltp :: nbody_system%pltp_encounter) - allocate(collision_list_plpl :: nbody_system%plpl_encounter) + allocate(symba_list_pltp :: nbody_system%pltp_encounter) + allocate(symba_list_plpl :: nbody_system%plpl_encounter) allocate(collision_list_plpl :: nbody_system%plpl_collision) if (param%lenc_save_trajectory .or. param%lenc_save_closest) then From a5ac1c485ef7683436acc8f330172e47018b6885 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Thu, 22 Dec 2022 10:30:39 -0500 Subject: [PATCH 489/569] Restructured to try to simplify the code used to resolve collisions --- src/collision/collision_generate.f90 | 53 ++-- src/collision/collision_module.f90 | 73 ++--- src/collision/collision_resolve.f90 | 388 +++++++++++++-------------- src/swiftest/swiftest_setup.f90 | 2 +- 4 files changed, 233 insertions(+), 283 deletions(-) diff --git a/src/collision/collision_generate.f90 b/src/collision/collision_generate.f90 index 281145797..d89353e44 100644 --- a/src/collision/collision_generate.f90 +++ b/src/collision/collision_generate.f90 @@ -13,22 +13,6 @@ contains module subroutine collision_generate_merge_system(self, nbody_system, param, t) - !! author: Jennifer L.L. Pouplin, Carlisle A. Wishard, and David A. Minton - !! - !! Merge massive bodies in a "MERGE" style collision model (only pure mergers) - implicit none - class(collision_merge), intent(inout) :: self !! Merge fragment system object - class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object - class(base_parameters), intent(inout) :: param !! Current run configuration parameters - real(DP), intent(in) :: t !! The time of the collision - - call collision_generate_merge_any(self, nbody_system, param, t) - - return - end subroutine collision_generate_merge_system - - - module subroutine collision_generate_merge_any(self, nbody_system, param, t) !! author: Jennifer L.L. Pouplin, Carlisle A. Wishard, and David A. Minton !! !! Merge massive bodies in any collisionals ystem. @@ -45,7 +29,7 @@ module subroutine collision_generate_merge_any(self, nbody_system, param, t) ! Internals integer(I4B) :: i, j, k, ibiggest real(DP), dimension(NDIM) :: Lspin_new - real(DP) :: dpe + real(DP) :: volume, dpe character(len=STRMAX) :: message select type(nbody_system) @@ -57,35 +41,46 @@ module subroutine collision_generate_merge_any(self, nbody_system, param, t) select type(pl => nbody_system%pl) class is (swiftest_pl) - - !call self%set_mass_dist(param) + ! Generate the merged body as a single fragment + call self%setup_fragments(1) ! Calculate the initial energy of the nbody_system without the collisional family call self%get_energy_and_momentum(nbody_system, param, lbefore=.true.) + ! The new body's metadata will be taken from the largest of the two impactor bodies, so we need + ! its index in the main pl structure ibiggest = impactors%id(maxloc(pl%Gmass(impactors%id(:)), dim=1)) fragments%id(1) = pl%id(ibiggest) - fragments%rb(:,1) = impactors%rbcom(:) - fragments%vb(:,1) = impactors%vbcom(:) + allocate(fragments%info, source=pl%info(ibiggest:ibiggest)) + ! Compute the physical properties of the new body after the merge. + volume = 4._DP / 3._DP * PI * sum(impactors%radius(:)**3) + fragments%mass(1) = impactors%mass_dist(1) + fragments%density(1) = fragments%mass(1) / volume + fragments%radius(1) = (3._DP * volume / (4._DP * PI))**(THIRD) if (param%lrotation) then - ! Conserve angular momentum by putting pre-impact orbital momentum into spin of the new body - Lspin_new(:) = impactors%Lorbit(:,1) + impactors%Lorbit(:,2) + impactors%Lspin(:,1) + impactors%Lspin(:,2) - - ! Assume prinicpal axis rotation on 3rd Ip axis + do concurrent(i = 1:NDIM) + fragments%Ip(i,1) = sum(impactors%mass(:) * impactors%Ip(i,:)) + Lspin_new(i) = sum(impactors%Lorbit(i,:) + impactors%Lorbit(i,:)) + end do + fragments%Ip(:,1) = fragments%Ip(:,1) / fragments%mass(1) fragments%rot(:,1) = Lspin_new(:) / (fragments%Ip(3,1) * fragments%mass(1) * fragments%radius(1)**2) else ! If spin is not enabled, we will consider the lost pre-collision angular momentum as "escaped" and add it to our bookkeeping variable nbody_system%Lescape(:) = nbody_system%Lescape(:) + impactors%Lorbit(:,1) + impactors%Lorbit(:,2) end if - ! Keep track of the component of potential energy due to the pre-impact impactors%id for book-keeping + ! The fragment trajectory will be the barycentric trajectory + fragments%rb(:,1) = impactors%rbcom(:) + fragments%vb(:,1) = impactors%vbcom(:) + ! Get the energy of the system after the collision call self%get_energy_and_momentum(nbody_system, param, lbefore=.false.) - dpe = self%pe(2) - self%pe(1) + + ! Keep track of the component of potential energy that is now not considered because two bodies became one + dpe = self%pe(2) - self%pe(1) nbody_system%Ecollisions = nbody_system%Ecollisions - dpe nbody_system%Euntracked = nbody_system%Euntracked + dpe - ! Update any encounter lists that have the removed bodies in them so that they instead point to the new body do k = 1, nbody_system%plpl_encounter%nenc do j = 1, impactors%ncoll @@ -111,7 +106,7 @@ module subroutine collision_generate_merge_any(self, nbody_system, param, t) end associate end select return - end subroutine collision_generate_merge_any + end subroutine collision_generate_merge_system module subroutine collision_generate_bounce_system(self, nbody_system, param, t) diff --git a/src/collision/collision_module.f90 b/src/collision/collision_module.f90 index 1eee878b0..5e1166ea3 100644 --- a/src/collision/collision_module.f90 +++ b/src/collision/collision_module.f90 @@ -75,9 +75,10 @@ module collision real(DP), dimension(NDIM) :: rbimp !! Impact point position vector of the collider nbody_system in nbody_system barycentric coordinates contains - procedure :: get_regime => collision_regime_impactors !! Determine which fragmentation regime the set of impactors will be - procedure :: reset => collision_util_reset_impactors !! Resets the collider object variables to 0 and deallocates the index and mass distributions - final :: collision_final_impactors !! Finalizer will deallocate all allocatables + procedure :: consolidate => collision_resolve_consolidate_impactors !! Consolidates a multi-body collision into an equivalent 2-body collision + procedure :: get_regime => collision_regime_impactors !! Determine which fragmentation regime the set of impactors will be + procedure :: reset => collision_util_reset_impactors !! Resets the collider object variables to 0 and deallocates the index and mass distributions + final :: collision_final_impactors !! Finalizer will deallocate all allocatables end type collision_impactors @@ -109,9 +110,11 @@ module collision end type collision_fragments - type, abstract :: collision_system + type :: collision_system !! This class defines a collisional nbody_system that stores impactors and fragments. This is written so that various collision models (i.e. Fraggle) could potentially be used !! to resolve collision by defining extended types of encounters_impactors and/or encounetr_fragments + !! + !! The generate method for this class is the merge model. This allows any extended type to have access to the merge procedure by selecting the collision_system parent class class(collision_fragments(:)), allocatable :: fragments !! Object containing information on the pre-collision system class(collision_impactors), allocatable :: impactors !! Object containing information on the post-collision system class(base_nbody_system), allocatable :: before !! A snapshot of the subset of the nbody_system involved in the collision @@ -135,15 +138,9 @@ module collision procedure :: get_energy_and_momentum => collision_util_get_energy_momentum !! Calculates total nbody_system energy in either the pre-collision outcome state (lbefore = .true.) or the post-collision outcome state (lbefore = .false.) procedure :: reset => collision_util_reset_system !! Deallocates all allocatables procedure :: set_coordinate_system => collision_util_set_coordinate_system !! Sets the coordinate nbody_system of the collisional nbody_system - procedure(abstract_generate_system), deferred :: generate !! Generates a nbody_system of fragments depending on collision model + procedure :: generate => collision_generate_merge_system !! Merges the impactors to make a single final body end type collision_system - type, extends(collision_system) :: collision_merge - contains - procedure :: generate => collision_generate_merge_system !! Merges the impactors to make a single final body - final :: collision_final_merge_system !! Finalizer will deallocate all allocatables - end type collision_merge - type, extends(collision_system) :: collision_bounce contains procedure :: generate => collision_generate_bounce_system !! If a collision would result in a disruption, "bounce" the bodies instead. @@ -199,37 +196,10 @@ module collision end type collision_storage - abstract interface - subroutine abstract_generate_system(self, nbody_system, param, t) - import collision_system, base_nbody_system, base_parameters, DP - implicit none - class(collision_system), intent(inout) :: self !! Collision system object - class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object - class(base_parameters), intent(inout) :: param !! Current run configuration parameters - real(DP), intent(in) :: t !! The time of the collision - end subroutine abstract_generate_system - - subroutine abstract_set_mass_dist(self, param) - import collision_system, base_parameters - implicit none - class(collision_system), intent(inout) :: self !! Collision system object - class(base_parameters), intent(in) :: param !! Current Swiftest run configuration parameters - end subroutine abstract_set_mass_dist - end interface - - interface - module subroutine collision_generate_merge_any(self, nbody_system, param, t) - implicit none - class(collision_system), intent(inout) :: self !! Merge fragment nbody_system object - class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object - class(base_parameters), intent(inout) :: param !! Current run configuration parameters - real(DP), intent(in) :: t !! The time of the collision - end subroutine collision_generate_merge_any - module subroutine collision_generate_merge_system(self, nbody_system, param, t) implicit none - class(collision_merge), intent(inout) :: self !! Merge fragment nbody_system object + class(collision_system), intent(inout) :: self !! Merge fragment nbody_system object class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(base_parameters), intent(inout) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! The time of the collision @@ -310,6 +280,15 @@ module subroutine collision_check_pltp(self, nbody_system, param, t, dt, irec, l integer(I4B), intent(in) :: irec !! Current recursion level logical, intent(out) :: lany_collision !! Returns true if any pair of encounters resulted in a collision end subroutine collision_check_pltp + + module subroutine collision_resolve_consolidate_impactors(self, nbody_system, param, idx_parent, lflag) + implicit none + class(collision_impactors), intent(out) :: self !! Collision impactors object + class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object + class(base_parameters), intent(in) :: param !! Current run configuration parameters with Swiftest additions + integer(I4B), dimension(:), intent(inout) :: idx_parent !! Index of the two bodies considered the "parents" of the collision + logical, intent(out) :: lflag !! Logical flag indicating whether a impactors%id was successfully created or not + end subroutine collision_resolve_consolidate_impactors module subroutine collision_resolve_extract_plpl(self, nbody_system, param) implicit none @@ -544,22 +523,6 @@ subroutine collision_final_storage(self) end subroutine collision_final_storage - subroutine collision_final_merge_system(self) - !! author: David A. Minton - !! - !! Finalizer will deallocate all allocatables - implicit none - ! Arguments - type(collision_merge), intent(inout) :: self !! Collision system object - - call self%reset() - if (allocated(self%impactors)) deallocate(self%impactors) - if (allocated(self%fragments)) deallocate(self%fragments) - - return - end subroutine collision_final_merge_system - - subroutine collision_final_bounce_system(self) !! author: David A. Minton !! diff --git a/src/collision/collision_resolve.f90 b/src/collision/collision_resolve.f90 index 6cb08a49a..c04da8a62 100644 --- a/src/collision/collision_resolve.f90 +++ b/src/collision/collision_resolve.f90 @@ -12,20 +12,18 @@ contains - function collision_resolve_consolidate_impactors(pl, cb, param, idx_parent, impactors) result(lflag) + module subroutine collision_resolve_consolidate_impactors(self, nbody_system, param, idx_parent, lflag) !! author: David A. Minton !! !! Loops through the pl-pl collision list and groups families together by index. Outputs the indices of all impactors%id members, !! and pairs of quantities (x and v vectors, mass, radius, Lspin, and Ip) that can be used to resolve the collisional outcome. implicit none ! Arguments - class(swiftest_pl), intent(inout) :: pl !! Swiftest massive body object - class(swiftest_cb), intent(inout) :: cb !! Swiftest central body object - class(base_parameters), intent(in) :: param !! Current run configuration parameters with Swiftest additions - integer(I4B), dimension(2), intent(inout) :: idx_parent !! Index of the two bodies considered the "parents" of the collision - class(collision_impactors), intent(out) :: impactors - ! Result - logical :: lflag !! Logical flag indicating whether a impactors%id was successfully created or not + class(collision_impactors), intent(out) :: self !! Collision impactors object + class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object + class(base_parameters), intent(in) :: param !! Current run configuration parameters with Swiftest additions + integer(I4B), dimension(:), intent(inout) :: idx_parent !! Index of the two bodies considered the "parents" of the collision + logical, intent(out) :: lflag !! Logical flag indicating whether a impactors%id was successfully created or not ! Internals type collidx_array integer(I4B), dimension(:), allocatable :: id @@ -39,115 +37,121 @@ function collision_resolve_consolidate_impactors(pl, cb, param, idx_parent, impa real(DP), dimension(NDIM) :: xc, vc, xcom, vcom, xchild, vchild, xcrossv real(DP), dimension(NDIM,2) :: mxc, vcc - nchild(:) = pl%kin(idx_parent(:))%nchild - ! If all of these bodies share a parent, but this is still a unique collision, move the last child - ! out of the parent's position and make it the secondary body - if (idx_parent(1) == idx_parent(2)) then - if (nchild(1) == 0) then ! There is only one valid body recorded in this pair (this could happen due to restructuring of the kinship relationships, though it should be rare) - lflag = .false. - call pl%reset_kinship([idx_parent(1)]) - return - end if - idx_parent(2) = pl%kin(idx_parent(1))%child(nchild(1)) - nchild(1) = nchild(1) - 1 - nchild(2) = 0 - pl%kin(idx_parent(:))%nchild = nchild(:) - pl%kin(idx_parent(2))%parent = idx_parent(1) - end if - - impactors%mass(:) = pl%mass(idx_parent(:)) ! Note: This is meant to mass, not G*mass, as the collisional regime determination uses mass values that will be converted to Si - impactors%radius(:) = pl%radius(idx_parent(:)) - volume(:) = (4.0_DP / 3.0_DP) * PI * impactors%radius(:)**3 - - ! Group together the ids and indexes of each collisional parent and its children - do j = 1, 2 - allocate(parent_child_index_array(j)%idx(nchild(j)+ 1)) - allocate(parent_child_index_array(j)%id(nchild(j)+ 1)) - associate(idx_arr => parent_child_index_array(j)%idx, & - id_arr => parent_child_index_array(j)%id, & - ncj => nchild(j), & - plkinj => pl%kin(idx_parent(j))) - idx_arr(1) = idx_parent(j) - if (ncj > 0) idx_arr(2:ncj + 1) = plkinj%child(1:ncj) - id_arr(:) = pl%id(idx_arr(:)) - end associate - end do - - ! Consolidate the groups of collsional parents with any children they may have into a single "impactors%id" index array - nimpactors = 2 + sum(nchild(:)) - allocate(impactors%id(nimpactors)) - impactors%id = [parent_child_index_array(1)%idx(:),parent_child_index_array(2)%idx(:)] - - impactors%ncoll = count(pl%lcollision(impactors%id(:))) - impactors%id = pack(impactors%id(:), pl%lcollision(impactors%id(:))) - impactors%Lspin(:,:) = 0.0_DP - impactors%Ip(:,:) = 0.0_DP - - ! Find the barycenter of each body along with its children, if it has any - do j = 1, 2 - impactors%rb(:, j) = pl%rh(:, idx_parent(j)) + cb%rb(:) - impactors%vb(:, j) = pl%vb(:, idx_parent(j)) - ! Assume principal axis rotation about axis corresponding to highest moment of inertia (3rd Ip) - if (param%lrotation) then - impactors%Ip(:, j) = impactors%mass(j) * pl%Ip(:, idx_parent(j)) - impactors%Lspin(:, j) = impactors%Ip(3, j) * impactors%radius(j)**2 * pl%rot(:, idx_parent(j)) - end if + select type(nbody_system) + class is (swiftest_nbody_system) + associate(impactors => self, pl => nbody_system%pl, cb => nbody_system%cb) + + nchild(:) = pl%kin(idx_parent(:))%nchild + ! If all of these bodies share a parent, but this is still a unique collision, move the last child + ! out of the parent's position and make it the secondary body + if (idx_parent(1) == idx_parent(2)) then + if (nchild(1) == 0) then ! There is only one valid body recorded in this pair (this could happen due to restructuring of the kinship relationships, though it should be rare) + lflag = .false. + call pl%reset_kinship([idx_parent(1)]) + return + end if + idx_parent(2) = pl%kin(idx_parent(1))%child(nchild(1)) + nchild(1) = nchild(1) - 1 + nchild(2) = 0 + pl%kin(idx_parent(:))%nchild = nchild(:) + pl%kin(idx_parent(2))%parent = idx_parent(1) + end if + + impactors%mass(:) = pl%mass(idx_parent(:)) ! Note: This is meant to mass, not G*mass, as the collisional regime determination uses mass values that will be converted to Si + impactors%radius(:) = pl%radius(idx_parent(:)) + volume(:) = (4.0_DP / 3.0_DP) * PI * impactors%radius(:)**3 + + ! Group together the ids and indexes of each collisional parent and its children + do j = 1, 2 + allocate(parent_child_index_array(j)%idx(nchild(j)+ 1)) + allocate(parent_child_index_array(j)%id(nchild(j)+ 1)) + associate(idx_arr => parent_child_index_array(j)%idx, & + id_arr => parent_child_index_array(j)%id, & + ncj => nchild(j), & + plkinj => pl%kin(idx_parent(j))) + idx_arr(1) = idx_parent(j) + if (ncj > 0) idx_arr(2:ncj + 1) = plkinj%child(1:ncj) + id_arr(:) = pl%id(idx_arr(:)) + end associate + end do - if (nchild(j) > 0) then - do i = 1, nchild(j) ! Loop over all children and take the mass weighted mean of the properties - idx_child = parent_child_index_array(j)%idx(i + 1) - if (.not. pl%lcollision(idx_child)) cycle - mchild = pl%mass(idx_child) - xchild(:) = pl%rh(:, idx_child) + cb%rb(:) - vchild(:) = pl%vb(:, idx_child) - volchild = (4.0_DP / 3.0_DP) * PI * pl%radius(idx_child)**3 - volume(j) = volume(j) + volchild - ! Get angular momentum of the child-parent pair and add that to the spin - ! Add the child's spin + ! Consolidate the groups of collsional parents with any children they may have into a single "impactors%id" index array + nimpactors = 2 + sum(nchild(:)) + allocate(impactors%id(nimpactors)) + impactors%id = [parent_child_index_array(1)%idx(:),parent_child_index_array(2)%idx(:)] + + impactors%ncoll = count(pl%lcollision(impactors%id(:))) + impactors%id = pack(impactors%id(:), pl%lcollision(impactors%id(:))) + impactors%Lspin(:,:) = 0.0_DP + impactors%Ip(:,:) = 0.0_DP + + ! Find the barycenter of each body along with its children, if it has any + do j = 1, 2 + impactors%rb(:, j) = pl%rh(:, idx_parent(j)) + cb%rb(:) + impactors%vb(:, j) = pl%vb(:, idx_parent(j)) + ! Assume principal axis rotation about axis corresponding to highest moment of inertia (3rd Ip) if (param%lrotation) then - xcom(:) = (impactors%mass(j) * impactors%rb(:,j) + mchild * xchild(:)) / (impactors%mass(j) + mchild) - vcom(:) = (impactors%mass(j) * impactors%vb(:,j) + mchild * vchild(:)) / (impactors%mass(j) + mchild) - xc(:) = impactors%rb(:, j) - xcom(:) - vc(:) = impactors%vb(:, j) - vcom(:) - xcrossv(:) = xc(:) .cross. vc(:) - impactors%Lspin(:, j) = impactors%Lspin(:, j) + impactors%mass(j) * xcrossv(:) - - xc(:) = xchild(:) - xcom(:) - vc(:) = vchild(:) - vcom(:) - xcrossv(:) = xc(:) .cross. vc(:) - impactors%Lspin(:, j) = impactors%Lspin(:, j) + mchild * xcrossv(:) - - impactors%Lspin(:, j) = impactors%Lspin(:, j) + mchild * pl%Ip(3, idx_child) & - * pl%radius(idx_child)**2 & - * pl%rot(:, idx_child) - impactors%Ip(:, j) = impactors%Ip(:, j) + mchild * pl%Ip(:, idx_child) + impactors%Ip(:, j) = impactors%mass(j) * pl%Ip(:, idx_parent(j)) + impactors%Lspin(:, j) = impactors%Ip(3, j) * impactors%radius(j)**2 * pl%rot(:, idx_parent(j)) end if - ! Merge the child and parent - impactors%mass(j) = impactors%mass(j) + mchild - impactors%rb(:, j) = xcom(:) - impactors%vb(:, j) = vcom(:) + if (nchild(j) > 0) then + do i = 1, nchild(j) ! Loop over all children and take the mass weighted mean of the properties + idx_child = parent_child_index_array(j)%idx(i + 1) + if (.not. pl%lcollision(idx_child)) cycle + mchild = pl%mass(idx_child) + xchild(:) = pl%rh(:, idx_child) + cb%rb(:) + vchild(:) = pl%vb(:, idx_child) + volchild = (4.0_DP / 3.0_DP) * PI * pl%radius(idx_child)**3 + volume(j) = volume(j) + volchild + ! Get angular momentum of the child-parent pair and add that to the spin + ! Add the child's spin + if (param%lrotation) then + xcom(:) = (impactors%mass(j) * impactors%rb(:,j) + mchild * xchild(:)) / (impactors%mass(j) + mchild) + vcom(:) = (impactors%mass(j) * impactors%vb(:,j) + mchild * vchild(:)) / (impactors%mass(j) + mchild) + xc(:) = impactors%rb(:, j) - xcom(:) + vc(:) = impactors%vb(:, j) - vcom(:) + xcrossv(:) = xc(:) .cross. vc(:) + impactors%Lspin(:, j) = impactors%Lspin(:, j) + impactors%mass(j) * xcrossv(:) + + xc(:) = xchild(:) - xcom(:) + vc(:) = vchild(:) - vcom(:) + xcrossv(:) = xc(:) .cross. vc(:) + impactors%Lspin(:, j) = impactors%Lspin(:, j) + mchild * xcrossv(:) + + impactors%Lspin(:, j) = impactors%Lspin(:, j) + mchild * pl%Ip(3, idx_child) & + * pl%radius(idx_child)**2 & + * pl%rot(:, idx_child) + impactors%Ip(:, j) = impactors%Ip(:, j) + mchild * pl%Ip(:, idx_child) + end if + + ! Merge the child and parent + impactors%mass(j) = impactors%mass(j) + mchild + impactors%rb(:, j) = xcom(:) + impactors%vb(:, j) = vcom(:) + end do + end if + density(j) = impactors%mass(j) / volume(j) + impactors%radius(j) = (3 * volume(j) / (4 * PI))**(1.0_DP / 3.0_DP) + if (param%lrotation) impactors%Ip(:, j) = impactors%Ip(:, j) / impactors%mass(j) end do - end if - density(j) = impactors%mass(j) / volume(j) - impactors%radius(j) = (3 * volume(j) / (4 * PI))**(1.0_DP / 3.0_DP) - if (param%lrotation) impactors%Ip(:, j) = impactors%Ip(:, j) / impactors%mass(j) - end do - lflag = .true. - - xcom(:) = (impactors%mass(1) * impactors%rb(:, 1) + impactors%mass(2) * impactors%rb(:, 2)) / sum(impactors%mass(:)) - vcom(:) = (impactors%mass(1) * impactors%vb(:, 1) + impactors%mass(2) * impactors%vb(:, 2)) / sum(impactors%mass(:)) - mxc(:, 1) = impactors%mass(1) * (impactors%rb(:, 1) - xcom(:)) - mxc(:, 2) = impactors%mass(2) * (impactors%rb(:, 2) - xcom(:)) - vcc(:, 1) = impactors%vb(:, 1) - vcom(:) - vcc(:, 2) = impactors%vb(:, 2) - vcom(:) - impactors%Lorbit(:,:) = mxc(:,:) .cross. vcc(:,:) - - ! Destroy the kinship relationships for all members of this impactors%id - call pl%reset_kinship(impactors%id(:)) + lflag = .true. + + xcom(:) = (impactors%mass(1) * impactors%rb(:, 1) + impactors%mass(2) * impactors%rb(:, 2)) / sum(impactors%mass(:)) + vcom(:) = (impactors%mass(1) * impactors%vb(:, 1) + impactors%mass(2) * impactors%vb(:, 2)) / sum(impactors%mass(:)) + mxc(:, 1) = impactors%mass(1) * (impactors%rb(:, 1) - xcom(:)) + mxc(:, 2) = impactors%mass(2) * (impactors%rb(:, 2) - xcom(:)) + vcc(:, 1) = impactors%vb(:, 1) - vcom(:) + vcc(:, 2) = impactors%vb(:, 2) - vcom(:) + impactors%Lorbit(:,:) = mxc(:,:) .cross. vcc(:,:) + + ! Destroy the kinship relationships for all members of this impactors%id + call pl%reset_kinship(impactors%id(:)) + end associate + end select return - end function collision_resolve_consolidate_impactors + end subroutine collision_resolve_consolidate_impactors module subroutine collision_resolve_extract_plpl(self, nbody_system, param) @@ -232,48 +236,6 @@ module subroutine collision_resolve_extract_pltp(self, nbody_system, param) end subroutine collision_resolve_extract_pltp - subroutine collision_resolve_list(plpl_collision, nbody_system, param, t) - !! author: David A. Minton - !! - !! Process list of collisions, determine the collisional regime, and then create fragments. - !! - implicit none - ! Arguments - class(collision_list_plpl), intent(inout) :: plpl_collision !! Swiftest pl-pl encounter list - class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object - class(base_parameters), intent(inout) :: param !! Current run configuration parameters with Swiftest additions - real(DP), intent(in) :: t !! Time of collision - ! Internals - ! Internals - integer(I4B), dimension(2) :: idx_parent !! Index of the two bodies considered the "parents" of the collision - logical :: lgoodcollision - integer(I4B) :: i - - select type(nbody_system) - class is (swiftest_nbody_system) - associate(ncollisions => plpl_collision%nenc, idx1 => plpl_collision%index1, idx2 => plpl_collision%index2, & - collision_history => nbody_system%collision_history, impactors => nbody_system%collider%impactors, & - fragments => nbody_system%collider%fragments, & - pl => nbody_system%pl, cb => nbody_system%cb) - do i = 1, ncollisions - idx_parent(1) = pl%kin(idx1(i))%parent - idx_parent(2) = pl%kin(idx2(i))%parent - lgoodcollision = collision_resolve_consolidate_impactors(pl, cb, param, idx_parent, impactors) - if ((.not. lgoodcollision) .or. any(pl%status(idx_parent(:)) /= COLLIDED)) cycle - - call impactors%get_regime(nbody_system, param) - call collision_history%take_snapshot(param,nbody_system, t, "before") - call nbody_system%collider%generate(nbody_system, param, t) - call collision_history%take_snapshot(param,nbody_system, t, "after") - call impactors%reset() - - end do - end associate - end select - return - end subroutine collision_resolve_list - - module subroutine collision_resolve_make_impactors_pl(pl, idx) !! author: Jennifer L.L. Pouplin, Carlisle A. wishard, and David A. Minton !! @@ -532,6 +494,10 @@ module subroutine collision_resolve_plpl(self, nbody_system, param, t, dt, irec) logical :: lplpl_collision character(len=STRMAX) :: timestr class(swiftest_parameters), allocatable :: tmp_param + integer(I4B), dimension(2) :: idx_parent !! Index of the two bodies considered the "parents" of the collision + logical :: lgoodcollision + integer(I4B) :: i, loop, ncollisions + integer(I4B), parameter :: MAXCASCADE = 1000 select type (nbody_system) class is (swiftest_nbody_system) @@ -539,59 +505,85 @@ module subroutine collision_resolve_plpl(self, nbody_system, param, t, dt, irec) class is (swiftest_pl) select type(param) class is (swiftest_parameters) - associate(plpl_encounter => self, plpl_collision => nbody_system%plpl_collision) - if (plpl_collision%nenc == 0) return ! No collisions to resolve - ! Make sure that the heliocentric and barycentric coordinates are consistent with each other - call pl%vb2vh(nbody_system%cb) - call pl%rh2rb(nbody_system%cb) - - ! Get the energy before the collision is resolved - if (param%lenergy) then - call nbody_system%get_energy_and_momentum(param) - Eorbit_before = nbody_system%te - end if - - do - write(timestr,*) t - call swiftest_io_log_one_message(COLLISION_LOG_OUT, "") - call swiftest_io_log_one_message(COLLISION_LOG_OUT, "***********************************************************" // & - "***********************************************************") - call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Collision between massive bodies detected at time t = " // & - trim(adjustl(timestr))) - call swiftest_io_log_one_message(COLLISION_LOG_OUT, "***********************************************************" // & - "***********************************************************") - allocate(tmp_param, source=param) - - call collision_resolve_list(plpl_collision, nbody_system, param, t) + associate(plpl_encounter => self, plpl_collision => nbody_system%plpl_collision, & + collision_history => nbody_system%collision_history, pl => nbody_system%pl, cb => nbody_system%cb, & + collider => nbody_system%collider, fragments => nbody_system%collider%fragments, impactors => nbody_system%collider%impactors) + associate( idx1 => plpl_collision%index1, idx2 => plpl_collision%index2) - ! Destroy the collision list now that the collisions are resolved - call plpl_collision%setup(0_I8B) + if (plpl_collision%nenc == 0) return ! No collisions to resolve - if ((nbody_system%pl_adds%nbody == 0) .and. (nbody_system%pl_discards%nbody == 0)) exit - ! Save the add/discard information to file - call nbody_system%write_discard(tmp_param) + ! Make sure that the heliocentric and barycentric coordinates are consistent with each other + call pl%vb2vh(nbody_system%cb) + call pl%rh2rb(nbody_system%cb) - ! Rearrange the arrays: Remove discarded bodies, add any new bodies, resort, and recompute all indices and encounter lists - call pl%rearray(nbody_system, tmp_param) - - ! Destroy the add/discard list so that we don't append the same body multiple times if another collision is detected - call nbody_system%pl_discards%setup(0, param) - call nbody_system%pl_adds%setup(0, param) - deallocate(tmp_param) - - ! Check whether or not any of the particles that were just added are themselves in a collision state. This will generate a new plpl_collision - call plpl_encounter%collision_check(nbody_system, param, t, dt, irec, lplpl_collision) + ! Get the energy before the collision is resolved + if (param%lenergy) then + call nbody_system%get_energy_and_momentum(param) + Eorbit_before = nbody_system%te + end if - if (.not.lplpl_collision) exit - end do + do loop = 1, MAXCASCADE + ncollisions = plpl_collision%nenc + write(timestr,*) t + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "") + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "***********************************************************" // & + "***********************************************************") + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Collision between massive bodies detected at time t = " // & + trim(adjustl(timestr))) + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "***********************************************************" // & + "***********************************************************") + allocate(tmp_param, source=param) + + do i = 1, ncollisions + idx_parent(1) = pl%kin(idx1(i))%parent + idx_parent(2) = pl%kin(idx2(i))%parent + call impactors%consolidate(nbody_system, param, idx_parent, lgoodcollision) + if ((.not. lgoodcollision) .or. any(pl%status(idx_parent(:)) /= COLLIDED)) cycle + + call impactors%get_regime(nbody_system, param) + call collision_history%take_snapshot(param,nbody_system, t, "before") + call collider%generate(nbody_system, param, t) + call collision_history%take_snapshot(param,nbody_system, t, "after") + plpl_collision%status(i) = collider%status + call impactors%reset() + end do + + ! Destroy the collision list now that the collisions are resolved + call plpl_collision%setup(0_I8B) + + if ((nbody_system%pl_adds%nbody == 0) .and. (nbody_system%pl_discards%nbody == 0)) exit + + ! Save the add/discard information to file + call nbody_system%write_discard(tmp_param) + + ! Rearrange the arrays: Remove discarded bodies, add any new bodies, resort, and recompute all indices and encounter lists + call pl%rearray(nbody_system, tmp_param) + + ! Destroy the add/discard list so that we don't append the same body multiple times if another collision is detected + call nbody_system%pl_discards%setup(0, param) + call nbody_system%pl_adds%setup(0, param) + deallocate(tmp_param) + + ! Check whether or not any of the particles that were just added are themselves in a collision state. This will generate a new plpl_collision + call plpl_encounter%collision_check(nbody_system, param, t, dt, irec, lplpl_collision) + + if (.not.lplpl_collision) exit + if (loop == MAXCASCADE) then + write(*,*) + write(*,*) "An runaway collisional cascade has been detected in collision_resolve_plpl." + write(*,*) "Consider reducing the step size or changing the parameters in the collisional model to reduce the number of fragments." + call util_exit(FAILURE) + end if + end do - if (param%lenergy) then - call nbody_system%get_energy_and_momentum(param) - Eorbit_after = nbody_system%te - nbody_system%Ecollisions = nbody_system%Ecollisions + (Eorbit_after - Eorbit_before) - end if + if (param%lenergy) then + call nbody_system%get_energy_and_momentum(param) + Eorbit_after = nbody_system%te + nbody_system%Ecollisions = nbody_system%Ecollisions + (Eorbit_after - Eorbit_before) + end if + end associate end associate end select end select diff --git a/src/swiftest/swiftest_setup.f90 b/src/swiftest/swiftest_setup.f90 index a08daf29d..ffa455ac0 100644 --- a/src/swiftest/swiftest_setup.f90 +++ b/src/swiftest/swiftest_setup.f90 @@ -117,7 +117,7 @@ module subroutine swiftest_setup_construct_system(nbody_system, param) select case(param%collision_model) case("MERGE") - allocate(collision_merge :: nbody_system%collider) + allocate(collision_system :: nbody_system%collider) case("BOUNCE") allocate(collision_bounce :: nbody_system%collider) case("SIMPLE") From 65132cd0e5e29519a0bb40dbf8b38d7dd648dde1 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Thu, 22 Dec 2022 11:01:15 -0500 Subject: [PATCH 490/569] Connected the rest of the fraggle collision models to the generator --- src/collision/collision_resolve.f90 | 4 +- src/fraggle/fraggle_generate.f90 | 293 +++++++++++++++++++++------- src/fraggle/fraggle_module.f90 | 14 +- src/fraggle/fraggle_resolve.f90 | 176 ----------------- src/swiftest/swiftest_module.f90 | 9 +- 5 files changed, 240 insertions(+), 256 deletions(-) delete mode 100644 src/fraggle/fraggle_resolve.f90 diff --git a/src/collision/collision_resolve.f90 b/src/collision/collision_resolve.f90 index c04da8a62..f4ade21b7 100644 --- a/src/collision/collision_resolve.f90 +++ b/src/collision/collision_resolve.f90 @@ -239,7 +239,7 @@ end subroutine collision_resolve_extract_pltp module subroutine collision_resolve_make_impactors_pl(pl, idx) !! author: Jennifer L.L. Pouplin, Carlisle A. wishard, and David A. Minton !! - !! When a single body is involved in more than one collision in a single step, it becomes part of a impactors%id. + !! When a single body is involved in more than one collision in a single step, it becomes part of a collision family !! The largest body involved in a multi-body collision is the "parent" and all bodies that collide with it are its "children," !! including those that collide with the children. !! @@ -249,7 +249,7 @@ module subroutine collision_resolve_make_impactors_pl(pl, idx) implicit none ! Arguments class(base_object), intent(inout) :: pl !! Swiftest massive body object - integer(I4B), dimension(:), intent(in) :: idx !! Array holding the indices of the two bodies involved in the collision + integer(I4B), dimension(:), intent(in) :: idx !! Array holding the indices of the two bodies involved in the collision ! Internals integer(I4B) :: i, j, index_parent, index_child, p1, p2 integer(I4B) :: nchild_inherit, nchild_orig, nchild_new diff --git a/src/fraggle/fraggle_generate.f90 b/src/fraggle/fraggle_generate.f90 index 52ba2d914..a85c783aa 100644 --- a/src/fraggle/fraggle_generate.f90 +++ b/src/fraggle/fraggle_generate.f90 @@ -18,6 +18,166 @@ contains + module subroutine fraggle_generate_disruption(collider, nbody_system, param, t) + !! author: Jennifer L.L. Pouplin, Carlisle A. Wishard, and David A. Minton + !! + !! Create the fragments resulting from a non-catastrophic disruption collision + !! + implicit none + ! Arguments + class(fraggle_system), intent(inout) :: collider + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions + real(DP), intent(in) :: t !! Time of collision + ! Internals + integer(I4B) :: i, ibiggest, nfrag + logical :: lfailure + character(len=STRMAX) :: message + real(DP) :: dpe + + associate(impactors => collider%impactors, fragments => collider%fragments, pl => nbody_system%pl, status => collider%status) + select case(impactors%regime) + case(COLLRESOLVE_REGIME_DISRUPTION) + message = "Disruption between" + case(COLLRESOLVE_REGIME_SUPERCATASTROPHIC) + message = "Supercatastrophic disruption between" + end select + call collision_io_collider_message(nbody_system%pl, impactors%id, message) + call swiftest_io_log_one_message(COLLISION_LOG_OUT, message) + + ! Collisional fragments will be uniformly distributed around the pre-impact barycenter + call collider%set_mass_dist(param) + + ! Generate the position and velocity distributions of the fragments + call fraggle_generate_fragments(collider, nbody_system, param, lfailure) + + dpe = collider%pe(2) - collider%pe(1) + nbody_system%Ecollisions = nbody_system%Ecollisions - dpe + nbody_system%Euntracked = nbody_system%Euntracked + dpe + + if (lfailure) then + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "No fragment solution found, so treat as a pure hit-and-run") + status = ACTIVE + nfrag = 0 + pl%status(impactors%id(:)) = status + pl%ldiscard(impactors%id(:)) = .false. + pl%lcollision(impactors%id(:)) = .false. + select type(before => collider%before) + class is (swiftest_nbody_system) + select type(after => collider%after) + class is (swiftest_nbody_system) + allocate(after%pl, source=before%pl) ! Be sure to save the pl so that snapshots still work + end select + end select + else + ! Populate the list of new bodies + nfrag = fragments%nbody + write(message, *) nfrag + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Generating " // trim(adjustl(message)) // " fragments") + select case(impactors%regime) + case(COLLRESOLVE_REGIME_DISRUPTION) + status = DISRUPTED + ibiggest = impactors%id(maxloc(pl%Gmass(impactors%id(:)), dim=1)) + fragments%id(1) = pl%id(ibiggest) + fragments%id(2:nfrag) = [(i, i = param%maxid + 1, param%maxid + nfrag - 1)] + param%maxid = fragments%id(nfrag) + case(COLLRESOLVE_REGIME_SUPERCATASTROPHIC) + status = SUPERCATASTROPHIC + fragments%id(1:nfrag) = [(i, i = param%maxid + 1, param%maxid + nfrag)] + param%maxid = fragments%id(nfrag) + end select + + call collision_resolve_mergeaddsub(nbody_system, param, t, status) + end if + end associate + + return + end subroutine fraggle_generate_disruption + + + module subroutine fraggle_generate_hitandrun(collider, nbody_system, param, t) + !! author: Jennifer L.L. Pouplin, Carlisle A. Wishard, and David A. Minton + !! + !! Create the fragments resulting from a non-catastrophic hit-and-run collision + !! + implicit none + ! Arguments + class(fraggle_system), intent(inout) :: collider !! Fraggle collision system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions + real(DP), intent(in) :: t !! Time of collision + ! Result + integer(I4B) :: status !! Status flag assigned to this outcome + ! Internals + integer(I4B) :: i, ibiggest, nfrag, jtarg, jproj + logical :: lpure + character(len=STRMAX) :: message + real(DP) :: dpe + + select type(before => collider%before) + class is (swiftest_nbody_system) + select type(after => collider%after) + class is (swiftest_nbody_system) + associate(impactors => collider%impactors, fragments => collider%fragments, pl => nbody_system%pl) + message = "Hit and run between" + call collision_io_collider_message(nbody_system%pl, impactors%id, message) + call swiftest_io_log_one_message(COLLISION_LOG_OUT, trim(adjustl(message))) + + if (impactors%mass(1) > impactors%mass(2)) then + jtarg = 1 + jproj = 2 + else + jtarg = 2 + jproj = 1 + end if + + if (impactors%mass_dist(2) > 0.9_DP * impactors%mass(jproj)) then ! Pure hit and run, so we'll just keep the two bodies untouched + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Pure hit and run. No new fragments generated.") + nfrag = 0 + lpure = .true. + else ! Imperfect hit and run, so we'll keep the largest body and destroy the other + lpure = .false. + call collider%set_mass_dist(param) + + ! Generate the position and velocity distributions of the fragments + call fraggle_generate_fragments(collider, nbody_system, param, lpure) + + dpe = collider%pe(2) - collider%pe(1) + nbody_system%Ecollisions = nbody_system%Ecollisions - dpe + nbody_system%Euntracked = nbody_system%Euntracked + dpe + + if (lpure) then + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Should have been a pure hit and run instead") + nfrag = 0 + else + nfrag = fragments%nbody + write(message, *) nfrag + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Generating " // trim(adjustl(message)) // " fragments") + end if + end if + if (lpure) then ! Reset these bodies back to being active so that nothing further is done to them + status = HIT_AND_RUN_PURE + pl%status(impactors%id(:)) = ACTIVE + pl%ldiscard(impactors%id(:)) = .false. + pl%lcollision(impactors%id(:)) = .false. + allocate(after%pl, source=before%pl) ! Be sure to save the pl so that snapshots still work + else + ibiggest = impactors%id(maxloc(pl%Gmass(impactors%id(:)), dim=1)) + fragments%id(1) = pl%id(ibiggest) + fragments%id(2:nfrag) = [(i, i = param%maxid + 1, param%maxid + nfrag - 1)] + param%maxid = fragments%id(nfrag) + status = HIT_AND_RUN_DISRUPT + call collision_resolve_mergeaddsub(nbody_system, param, t, status) + end if + end associate + end select + end select + + + return + end subroutine fraggle_generate_hitandrun + + module subroutine fraggle_generate_system(self, nbody_system, param, t) implicit none class(fraggle_system), intent(inout) :: self !! Fraggle fragment nbody_system object @@ -26,38 +186,37 @@ module subroutine fraggle_generate_system(self, nbody_system, param, t) real(DP), intent(in) :: t !! The time of the collision ! Internals integer(I4B) :: i - - ! select type(nbody_system) - ! class is (swiftest_nbody_system) - ! select type(param) - ! class is (swiftest_parameters) - ! associate(impactors => self%impactors, plpl_collision => nbody_system%plpl_collision) - ! select case (impactors%regime) - ! case (COLLRESOLVE_REGIME_DISRUPTION, COLLRESOLVE_REGIME_SUPERCATASTROPHIC) - ! plpl_collision%status(i) = fraggle_resolve_disruption(nbody_system, param, t) - ! case (COLLRESOLVE_REGIME_HIT_AND_RUN) - ! plpl_collision%status(i) = fraggle_resolve_hitandrun(nbody_system, param, t) - ! case (COLLRESOLVE_REGIME_MERGE, COLLRESOLVE_REGIME_GRAZE_AND_MERGE) - ! plpl_collision%status(i) = collision_resolve_merge(nbody_system, param, t) - ! case default - ! write(*,*) "Error in swiftest_collision, unrecognized collision regime" - ! call util_exit(FAILURE) - ! end select - ! end associate - ! end select - ! end select + + select type(nbody_system) + class is (swiftest_nbody_system) + select type(param) + class is (swiftest_parameters) + select case (self%impactors%regime) + case (COLLRESOLVE_REGIME_DISRUPTION, COLLRESOLVE_REGIME_SUPERCATASTROPHIC) + call fraggle_generate_disruption(self, nbody_system, param, t) + case (COLLRESOLVE_REGIME_HIT_AND_RUN) + call fraggle_generate_hitandrun(self, nbody_system, param, t) + case (COLLRESOLVE_REGIME_MERGE, COLLRESOLVE_REGIME_GRAZE_AND_MERGE) + call self%collision_system%generate(nbody_system, param, t) + case default + write(*,*) "Error in swiftest_collision, unrecognized collision regime" + call util_exit(FAILURE) + end select + end select + end select + return end subroutine fraggle_generate_system - module subroutine fraggle_generate_fragments(collision_system, nbody_system, param, lfailure) + module subroutine fraggle_generate_fragments(collider, nbody_system, param, lfailure) !! Author: Jennifer L.L. Pouplin, Carlisle A. Wishard, and David A. Minton !! !! Generates a nbody_system of fragments in barycentric coordinates that conserves energy and momentum. use, intrinsic :: ieee_exceptions implicit none ! Arguments - class(fraggle_system), intent(inout) :: collision_system !! Fraggle nbody_system object the outputs will be the fragmentation + class(fraggle_system), intent(inout) :: collider !! Fraggle nbody_system object the outputs will be the fragmentation class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters logical, intent(out) :: lfailure !! Answers the question: Should this have been a merger instead? @@ -82,9 +241,9 @@ module subroutine fraggle_generate_fragments(collision_system, nbody_system, par class is (swiftest_nbody_system) select type(param) class is (swiftest_parameters) - select type(fragments => collision_system%fragments) + select type(fragments => collider%fragments) class is (fraggle_fragments(*)) - associate(impactors => collision_system%impactors, nfrag => fragments%nbody, pl => nbody_system%pl) + associate(impactors => collider%impactors, nfrag => fragments%nbody, pl => nbody_system%pl) write(message,*) nfrag call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Fraggle generating " // trim(adjustl(message)) // " fragments.") @@ -106,12 +265,12 @@ module subroutine fraggle_generate_fragments(collision_system, nbody_system, par lk_plpl = .false. end if - call collision_system%set_natural_scale() + call collider%set_natural_scale() call fragments%reset() ! Calculate the initial energy of the nbody_system without the collisional family - call collision_system%get_energy_and_momentum(nbody_system, param, lbefore=.true.) + call collider%get_energy_and_momentum(nbody_system, param, lbefore=.true.) ! Start out the fragments close to the initial separation distance. This will be increased if there is any overlap or we fail to find a solution r_max_start = 1.2_DP * .mag.(impactors%rb(:,2) - impactors%rb(:,1)) @@ -129,38 +288,38 @@ module subroutine fraggle_generate_fragments(collision_system, nbody_system, par lfailure = .false. call ieee_set_flag(ieee_all, .false.) ! Set all fpe flags to quiet - call fraggle_generate_pos_vec(collision_system, r_max_start) - call collision_system%set_coordinate_system() + call fraggle_generate_pos_vec(collider, r_max_start) + call collider%set_coordinate_system() ! Initial velocity guess will be the barycentric velocity of the colliding nbody_system so that the budgets are based on the much smaller collisional-frame velocities do concurrent (i = 1:nfrag) fragments%vb(:, i) = impactors%vbcom(:) end do - call collision_system%get_energy_and_momentum(nbody_system, param, lbefore=.false.) - call collision_system%set_budgets() + call collider%get_energy_and_momentum(nbody_system, param, lbefore=.false.) + call collider%set_budgets() - call fraggle_generate_spins(collision_system, f_spin, lfailure) + call fraggle_generate_spins(collider, f_spin, lfailure) if (lfailure) then call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Fraggle failed to find spins") cycle end if - call fraggle_generate_tan_vel(collision_system, lfailure) + call fraggle_generate_tan_vel(collider, lfailure) if (lfailure) then call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Fraggle failed to find tangential velocities") cycle end if - call fraggle_generate_rad_vel(collision_system, lfailure) + call fraggle_generate_rad_vel(collider, lfailure) if (lfailure) then call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Fraggle failed to find radial velocities") cycle end if - call collision_system%get_energy_and_momentum(nbody_system, param, lbefore=.false.) - dEtot = collision_system%Etot(2) - collision_system%Etot(1) - dLmag = .mag. (collision_system%Ltot(:,2) - collision_system%Ltot(:,1)) + call collider%get_energy_and_momentum(nbody_system, param, lbefore=.false.) + dEtot = collider%Etot(2) - collider%Etot(1) + dLmag = .mag. (collider%Ltot(:,2) - collider%Ltot(:,1)) exit lfailure = ((abs(dEtot + impactors%Qloss) > FRAGGLE_ETOL) .or. (dEtot > 0.0_DP)) @@ -171,9 +330,9 @@ module subroutine fraggle_generate_fragments(collision_system, nbody_system, par cycle end if - lfailure = ((abs(dLmag) / (.mag.collision_system%Ltot(:,1))) > FRAGGLE_LTOL) + lfailure = ((abs(dLmag) / (.mag.collider%Ltot(:,1))) > FRAGGLE_LTOL) if (lfailure) then - write(message,*) dLmag / (.mag.collision_system%Ltot(:,1)) + write(message,*) dLmag / (.mag.collider%Ltot(:,1)) call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Fraggle failed due to high angular momentum error: " // & trim(adjustl(message))) cycle @@ -196,7 +355,7 @@ module subroutine fraggle_generate_fragments(collision_system, nbody_system, par trim(adjustl(message)) // " tries") end if - call collision_system%set_original_scale() + call collider%set_original_scale() ! Restore the big array if (lk_plpl) call pl%flatten(param) @@ -210,7 +369,7 @@ module subroutine fraggle_generate_fragments(collision_system, nbody_system, par end subroutine fraggle_generate_fragments - subroutine fraggle_generate_pos_vec(collision_system, r_max_start) + subroutine fraggle_generate_pos_vec(collider, r_max_start) !! Author: Jennifer L.L. Pouplin, Carlisle A. Wishard, and David A. Minton !! !! Initializes the orbits of the fragments around the center of mass. The fragments are initially placed on a plane defined by the @@ -218,7 +377,7 @@ subroutine fraggle_generate_pos_vec(collision_system, r_max_start) !! The initial positions do not conserve energy or momentum, so these need to be adjusted later. implicit none ! Arguments - class(fraggle_system), intent(inout) :: collision_system !! Fraggle collision system object + class(fraggle_system), intent(inout) :: collider !! Fraggle collision system object real(DP), intent(in) :: r_max_start !! Initial guess for the starting maximum radial distance of fragments ! Internals real(DP) :: dis, rad, r_max, fdistort @@ -227,7 +386,7 @@ subroutine fraggle_generate_pos_vec(collision_system, r_max_start) integer(I4B) :: i, j logical :: lnoncat, lhitandrun - associate(fragments => collision_system%fragments, impactors => collision_system%impactors, nfrag => collision_system%fragments%nbody) + associate(fragments => collider%fragments, impactors => collider%impactors, nfrag => collider%fragments%nbody) allocate(loverlap(nfrag)) lnoncat = (impactors%regime /= COLLRESOLVE_REGIME_SUPERCATASTROPHIC) ! For non-catastrophic impacts, make the fragments act like ejecta and point away from the impact point @@ -276,7 +435,7 @@ subroutine fraggle_generate_pos_vec(collision_system, r_max_start) end do end do call fraggle_util_shift_vector_to_origin(fragments%mass, fragments%rc) - call collision_system%set_coordinate_system() + call collider%set_coordinate_system() do concurrent(i = 1:nfrag) fragments%rb(:,i) = fragments%rc(:,i) + impactors%rbcom(:) @@ -293,7 +452,7 @@ subroutine fraggle_generate_pos_vec(collision_system, r_max_start) end subroutine fraggle_generate_pos_vec - subroutine fraggle_generate_spins(collision_system, f_spin, lfailure) + subroutine fraggle_generate_spins(collider, f_spin, lfailure) !! Author: Jennifer L.L. Pouplin, Carlisle A. Wishard, and David A. Minton !! !! Calculates the spins of a collection of fragments such that they conserve angular momentum without blowing the fragment kinetic energy budget. @@ -301,19 +460,19 @@ subroutine fraggle_generate_spins(collision_system, f_spin, lfailure) !! A failure will trigger a restructuring of the fragments so we will try new values of the radial position distribution. implicit none ! Arguments - class(fraggle_system), intent(inout) :: collision_system !! Fraggle collision system object + class(fraggle_system), intent(inout) :: collider !! Fraggle collision system object real(DP), intent(in) :: f_spin !! Fraction of energy or momentum that goes into spin (whichever gives the lowest kinetic energy) logical, intent(out) :: lfailure !! Logical flag indicating whether this step fails or succeeds! ! Internals real(DP), dimension(NDIM) :: L_remainder, rot_L, rot_ke, L - real(DP), dimension(NDIM,collision_system%fragments%nbody) :: frot_rand ! The random rotation factor applied to fragments + real(DP), dimension(NDIM,collider%fragments%nbody) :: frot_rand ! The random rotation factor applied to fragments real(DP), parameter :: frot_rand_mag = 1.50_DP ! The magnitude of the rotation variation to apply to the fragments integer(I4B) :: i character(len=STRMAX) :: message real(DP) :: ke_remainder, ke - associate(impactors => collision_system%impactors, nfrag => collision_system%fragments%nbody) - select type(fragments => collision_system%fragments) + associate(impactors => collider%impactors, nfrag => collider%fragments%nbody) + select type(fragments => collider%fragments) class is (fraggle_fragments(*)) lfailure = .false. L_remainder(:) = fragments%L_budget(:) @@ -383,7 +542,7 @@ subroutine fraggle_generate_spins(collision_system, f_spin, lfailure) end subroutine fraggle_generate_spins - subroutine fraggle_generate_tan_vel(collision_system, lfailure) + subroutine fraggle_generate_tan_vel(collider, lfailure) !! Author: Jennifer L.L. Pouplin, Carlisle A. Wishard, and David A. Minton !! !! Adjusts the tangential velocities and spins of a collection of fragments such that they conserve angular momentum without blowing the fragment kinetic energy budget. @@ -398,7 +557,7 @@ subroutine fraggle_generate_tan_vel(collision_system, lfailure) !! A failure will trigger a restructuring of the fragments so we will try new values of the radial position distribution. implicit none ! Arguments - class(fraggle_system), intent(inout) :: collision_system !! Fraggle collision system object + class(fraggle_system), intent(inout) :: collider !! Fraggle collision system object logical, intent(out) :: lfailure !! Logical flag indicating whether this step fails or succeeds ! Internals integer(I4B) :: i, try @@ -409,14 +568,14 @@ subroutine fraggle_generate_tan_vel(collision_system, lfailure) integer(I4B), parameter :: MAXTRY = 100 real(DP) :: tol real(DP), dimension(:), allocatable :: v_t_initial, v_t_output - real(DP), dimension(collision_system%fragments%nbody) :: kefrag, vnoise + real(DP), dimension(collider%fragments%nbody) :: kefrag, vnoise type(lambda_obj_err) :: objective_function real(DP), dimension(NDIM) :: L_frag_tot character(len=STRMAX) :: message real(DP) :: ke_diff - associate(impactors => collision_system%impactors, nfrag => collision_system%fragments%nbody) - select type(fragments => collision_system%fragments) + associate(impactors => collider%impactors, nfrag => collider%fragments%nbody) + select type(fragments => collider%fragments) class is (fraggle_fragments(*)) lfailure = .false. @@ -470,7 +629,7 @@ subroutine fraggle_generate_tan_vel(collision_system, lfailure) call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Tangential velocity failure diagnostics") call fragments%get_angular_momentum() L_frag_tot = fragments%Lspin(:) + fragments%Lorbit(:) - write(message, *) .mag.(fragments%L_budget(:) - L_frag_tot(:)) / (.mag.collision_system%Ltot(:,1)) + write(message, *) .mag.(fragments%L_budget(:) - L_frag_tot(:)) / (.mag.collider%Ltot(:,1)) call swiftest_io_log_one_message(COLLISION_LOG_OUT, "|L_remainder| : " // trim(adjustl(message))) write(message, *) fragments%ke_budget call swiftest_io_log_one_message(COLLISION_LOG_OUT, "ke_budget : " // trim(adjustl(message))) @@ -504,7 +663,7 @@ function solve_fragment_tan_vel(lfailure, v_t_mag_input) result(v_t_mag_output) real(DP), dimension(2 * NDIM) :: b ! RHS of linear equation used to solve for momentum constraint in Gauss elimination code real(DP), dimension(NDIM) :: L_lin_others, L_orb_others, L, vtmp - select type(fragments => collision_system%fragments) + select type(fragments => collider%fragments) class is (fraggle_fragments(*)) associate(nfrag => fragments%nbody) lfailure = .false. @@ -547,13 +706,13 @@ function tangential_objective_function(v_t_mag_input, lfailure) result(fval) real(DP) :: fval ! Internals integer(I4B) :: i - real(DP), dimension(NDIM,collision_system%fragments%nbody) :: v_shift - real(DP), dimension(collision_system%fragments%nbody) :: v_t_new, kearr + real(DP), dimension(NDIM,collider%fragments%nbody) :: v_shift + real(DP), dimension(collider%fragments%nbody) :: v_t_new, kearr real(DP) :: keo - select type(fragments => collision_system%fragments) + select type(fragments => collider%fragments) class is (fraggle_fragments(*)) - associate(impactors => collision_system%impactors, nfrag => fragments%nbody) + associate(impactors => collider%impactors, nfrag => fragments%nbody) lfailure = .false. v_t_new(:) = solve_fragment_tan_vel(v_t_mag_input=v_t_mag_input(:), lfailure=lfailure) @@ -575,14 +734,14 @@ end function tangential_objective_function end subroutine fraggle_generate_tan_vel - subroutine fraggle_generate_rad_vel(collision_system, lfailure) + subroutine fraggle_generate_rad_vel(collider, lfailure) !! Author: Jennifer L.L. Pouplin, Carlisle A. Wishard, and David A. Minton !! !! !! Adjust the fragment velocities to set the fragment orbital kinetic energy. This will minimize the difference between the fragment kinetic energy and the energy budget implicit none ! Arguments - class(fraggle_system), intent(inout) :: collision_system !! Fraggle collision system object + class(fraggle_system), intent(inout) :: collider !! Fraggle collision system object logical, intent(out) :: lfailure !! Logical flag indicating whether this step fails or succeeds! ! Internals real(DP), parameter :: TOL_MIN = FRAGGLE_ETOL ! This needs to be more accurate than the tangential step, as we are trying to minimize the total residual energy @@ -592,12 +751,12 @@ subroutine fraggle_generate_rad_vel(collision_system, lfailure) real(DP) :: ke_radial, tol integer(I4B) :: i real(DP), dimension(:), allocatable :: v_r_initial, v_r_output - real(DP), dimension(collision_system%fragments%nbody) :: vnoise + real(DP), dimension(collider%fragments%nbody) :: vnoise type(lambda_obj) :: objective_function character(len=STRMAX) :: message - associate(impactors => collision_system%impactors, nfrag => collision_system%fragments%nbody) - select type(fragments => collision_system%fragments) + associate(impactors => collider%impactors, nfrag => collider%fragments%nbody) + select type(fragments => collider%fragments) class is (fraggle_fragments(*)) ! Set the "target" ke for the radial component @@ -671,11 +830,11 @@ function radial_objective_function(v_r_mag_input) result(fval) ! Internals integer(I4B) :: i real(DP), dimension(:,:), allocatable :: v_shift - real(DP), dimension(collision_system%fragments%nbody) :: kearr + real(DP), dimension(collider%fragments%nbody) :: kearr real(DP) :: keo, ke_radial, rotmag2, vmag2 - associate(impactors => collision_system%impactors, nfrag => collision_system%fragments%nbody) - select type(fragments => collision_system%fragments) + associate(impactors => collider%impactors, nfrag => collider%fragments%nbody) + select type(fragments => collider%fragments) class is (fraggle_fragments(*)) allocate(v_shift, mold=fragments%vb) v_shift(:,:) = fraggle_util_vmag_to_vb(v_r_mag_input, fragments%v_r_unit, fragments%v_t_mag, fragments%v_t_unit, fragments%mass, impactors%vbcom) diff --git a/src/fraggle/fraggle_module.f90 b/src/fraggle/fraggle_module.f90 index 89c5ab5f7..fe0b8fda0 100644 --- a/src/fraggle/fraggle_module.f90 +++ b/src/fraggle/fraggle_module.f90 @@ -97,23 +97,21 @@ module subroutine fraggle_set_natural_scale_factors(self) class(fraggle_system), intent(inout) :: self !! Fraggle collision system object end subroutine fraggle_set_natural_scale_factors - module function fraggle_resolve_disruption(collision_system, nbody_system, param, t) result(status) + module subroutine fraggle_generate_disruption(collider, nbody_system, param, t) implicit none - class(fraggle_system), intent(inout) :: collision_system !! Fraggle collision system object + class(fraggle_system), intent(inout) :: collider !! Fraggle collision system object class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions real(DP), intent(in) :: t !! Time of collision - integer(I4B) :: status !! Status flag assigned to this outcome - end function fraggle_resolve_disruption + end subroutine fraggle_generate_disruption - module function fraggle_resolve_hitandrun(collision_system, nbody_system, param, t) result(status) + module subroutine fraggle_generate_hitandrun(collider, nbody_system, param, t) implicit none - class(fraggle_system), intent(inout) :: collision_system !! Fraggle collision system object + class(fraggle_system), intent(inout) :: collider !! Fraggle collision system object class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions real(DP), intent(in) :: t !! Time of collision - integer(I4B) :: status !! Status flag assigned to this outcome - end function fraggle_resolve_hitandrun + end subroutine fraggle_generate_hitandrun module subroutine fraggle_set_original_scale_factors(self) implicit none diff --git a/src/fraggle/fraggle_resolve.f90 b/src/fraggle/fraggle_resolve.f90 deleted file mode 100644 index 10c7bf3e2..000000000 --- a/src/fraggle/fraggle_resolve.f90 +++ /dev/null @@ -1,176 +0,0 @@ -!! Copyright 2022 - David Minton, Carlisle Wishard, Jennifer Pouplin, Jake Elliott, & Dana Singh -!! This file is part of Swiftest. -!! Swiftest is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License -!! as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. -!! Swiftest is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty -!! of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. -!! You should have received a copy of the GNU General Public License along with Swiftest. -!! If not, see: https://www.gnu.org/licenses. - -submodule(fraggle) s_fraggle_resolve - use swiftest - use symba -contains - - module function fraggle_resolve_disruption(collision_system, nbody_system, param, t) result(status) - !! author: Jennifer L.L. Pouplin, Carlisle A. Wishard, and David A. Minton - !! - !! Create the fragments resulting from a non-catastrophic disruption collision - !! - implicit none - ! Arguments - class(fraggle_system), intent(inout) :: collision_system - class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions - real(DP), intent(in) :: t !! Time of collision - ! Result - integer(I4B) :: status !! Status flag assigned to this outcome - ! Internals - integer(I4B) :: i, ibiggest, nfrag - logical :: lfailure - character(len=STRMAX) :: message - real(DP) :: dpe - - associate(impactors => collision_system%impactors, fragments => collision_system%fragments, pl => nbody_system%pl) - select case(impactors%regime) - case(COLLRESOLVE_REGIME_DISRUPTION) - message = "Disruption between" - case(COLLRESOLVE_REGIME_SUPERCATASTROPHIC) - message = "Supercatastrophic disruption between" - end select - call collision_io_collider_message(nbody_system%pl, impactors%id, message) - call swiftest_io_log_one_message(COLLISION_LOG_OUT, message) - - ! Collisional fragments will be uniformly distributed around the pre-impact barycenter - call collision_system%set_mass_dist(param) - - ! Generate the position and velocity distributions of the fragments - call fraggle_generate_fragments(collision_system, nbody_system, param, lfailure) - - dpe = collision_system%pe(2) - collision_system%pe(1) - nbody_system%Ecollisions = nbody_system%Ecollisions - dpe - nbody_system%Euntracked = nbody_system%Euntracked + dpe - - if (lfailure) then - call swiftest_io_log_one_message(COLLISION_LOG_OUT, "No fragment solution found, so treat as a pure hit-and-run") - status = ACTIVE - nfrag = 0 - pl%status(impactors%id(:)) = status - pl%ldiscard(impactors%id(:)) = .false. - pl%lcollision(impactors%id(:)) = .false. - select type(before => collision_system%before) - class is (swiftest_nbody_system) - select type(after => collision_system%after) - class is (swiftest_nbody_system) - allocate(after%pl, source=before%pl) ! Be sure to save the pl so that snapshots still work - end select - end select - else - ! Populate the list of new bodies - nfrag = fragments%nbody - write(message, *) nfrag - call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Generating " // trim(adjustl(message)) // " fragments") - select case(impactors%regime) - case(COLLRESOLVE_REGIME_DISRUPTION) - status = DISRUPTED - ibiggest = impactors%id(maxloc(pl%Gmass(impactors%id(:)), dim=1)) - fragments%id(1) = pl%id(ibiggest) - fragments%id(2:nfrag) = [(i, i = param%maxid + 1, param%maxid + nfrag - 1)] - param%maxid = fragments%id(nfrag) - case(COLLRESOLVE_REGIME_SUPERCATASTROPHIC) - status = SUPERCATASTROPHIC - fragments%id(1:nfrag) = [(i, i = param%maxid + 1, param%maxid + nfrag)] - param%maxid = fragments%id(nfrag) - end select - - call collision_resolve_mergeaddsub(nbody_system, param, t, status) - end if - end associate - - return - end function fraggle_resolve_disruption - - - module function fraggle_resolve_hitandrun(collision_system, nbody_system, param, t) result(status) - !! author: Jennifer L.L. Pouplin, Carlisle A. Wishard, and David A. Minton - !! - !! Create the fragments resulting from a non-catastrophic hit-and-run collision - !! - implicit none - ! Arguments - class(fraggle_system), intent(inout) :: collision_system !! Fraggle collision system object - class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions - real(DP), intent(in) :: t !! Time of collision - ! Result - integer(I4B) :: status !! Status flag assigned to this outcome - ! Internals - integer(I4B) :: i, ibiggest, nfrag, jtarg, jproj - logical :: lpure - character(len=STRMAX) :: message - real(DP) :: dpe - - select type(before => collision_system%before) - class is (swiftest_nbody_system) - select type(after => collision_system%after) - class is (swiftest_nbody_system) - associate(impactors => collision_system%impactors, fragments => collision_system%fragments, pl => nbody_system%pl) - message = "Hit and run between" - call collision_io_collider_message(nbody_system%pl, impactors%id, message) - call swiftest_io_log_one_message(COLLISION_LOG_OUT, trim(adjustl(message))) - - if (impactors%mass(1) > impactors%mass(2)) then - jtarg = 1 - jproj = 2 - else - jtarg = 2 - jproj = 1 - end if - - if (impactors%mass_dist(2) > 0.9_DP * impactors%mass(jproj)) then ! Pure hit and run, so we'll just keep the two bodies untouched - call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Pure hit and run. No new fragments generated.") - nfrag = 0 - lpure = .true. - else ! Imperfect hit and run, so we'll keep the largest body and destroy the other - lpure = .false. - call collision_system%set_mass_dist(param) - - ! Generate the position and velocity distributions of the fragments - call fraggle_generate_fragments(collision_system, nbody_system, param, lpure) - - dpe = collision_system%pe(2) - collision_system%pe(1) - nbody_system%Ecollisions = nbody_system%Ecollisions - dpe - nbody_system%Euntracked = nbody_system%Euntracked + dpe - - if (lpure) then - call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Should have been a pure hit and run instead") - nfrag = 0 - else - nfrag = fragments%nbody - write(message, *) nfrag - call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Generating " // trim(adjustl(message)) // " fragments") - end if - end if - if (lpure) then ! Reset these bodies back to being active so that nothing further is done to them - status = HIT_AND_RUN_PURE - pl%status(impactors%id(:)) = ACTIVE - pl%ldiscard(impactors%id(:)) = .false. - pl%lcollision(impactors%id(:)) = .false. - allocate(after%pl, source=before%pl) ! Be sure to save the pl so that snapshots still work - else - ibiggest = impactors%id(maxloc(pl%Gmass(impactors%id(:)), dim=1)) - fragments%id(1) = pl%id(ibiggest) - fragments%id(2:nfrag) = [(i, i = param%maxid + 1, param%maxid + nfrag - 1)] - param%maxid = fragments%id(nfrag) - status = HIT_AND_RUN_DISRUPT - call collision_resolve_mergeaddsub(nbody_system, param, t, status) - end if - end associate - end select - end select - - - return - end function fraggle_resolve_hitandrun - -end submodule s_fraggle_resolve \ No newline at end of file diff --git a/src/swiftest/swiftest_module.f90 b/src/swiftest/swiftest_module.f90 index 4ce4ac3b5..7a6fe0b79 100644 --- a/src/swiftest/swiftest_module.f90 +++ b/src/swiftest/swiftest_module.f90 @@ -245,7 +245,7 @@ module swiftest contains ! Massive body-specific concrete methods ! These are concrete because they are the same implemenation for all integrators - procedure :: make_impactors => make_impactors_pl !! Make impactors out of the current kinship relationships + procedure :: make_impactors => swiftest_make_impactors_pl !! Make impactors out of the current kinship relationships procedure :: discard => swiftest_discard_pl !! Placeholder method for discarding massive bodies procedure :: accel_int => swiftest_kick_getacch_int_pl !! Compute direct cross (third) term heliocentric accelerations of massive bodies procedure :: accel_obl => swiftest_obl_acc_pl !! Compute the barycentric accelerations of bodies due to the oblateness of the central body @@ -1827,7 +1827,10 @@ end subroutine swiftest_util_version end interface contains - subroutine make_impactors_pl(self, idx) + subroutine swiftest_make_impactors_pl(self, idx) + !! author: David A. Minton + !! + !! This is a simple wrapper function that is used to make a type-bound procedure using a subroutine whose interface is in the collision module, which must be defined first implicit none class(swiftest_pl), intent(inout) :: self !! Massive body object integer(I4B), dimension(:), intent(in) :: idx !! Array holding the indices of the two bodies involved in the collision) @@ -1835,7 +1838,7 @@ subroutine make_impactors_pl(self, idx) call collision_resolve_make_impactors_pl(self, idx) return - end subroutine make_impactors_pl + end subroutine swiftest_make_impactors_pl subroutine swiftest_final_kin(self) From 3f35f81356c6e42d65ff6b50ec69c4a88bf1f86c Mon Sep 17 00:00:00 2001 From: David A Minton Date: Thu, 22 Dec 2022 11:03:16 -0500 Subject: [PATCH 491/569] cleanup --- src/CMakeLists.txt | 1 - src/fraggle/fraggle_io.f90 | 16 ---------------- src/fraggle/fraggle_module.f90 | 12 ++++-------- 3 files changed, 4 insertions(+), 25 deletions(-) delete mode 100644 src/fraggle/fraggle_io.f90 diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index 7d3eded2a..ddeb2b357 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -51,7 +51,6 @@ SET(FAST_MATH_FILES ${SRC}/encounter/encounter_setup.f90 ${SRC}/encounter/encounter_util.f90 ${SRC}/fraggle/fraggle_generate.f90 - ${SRC}/fraggle/fraggle_io.f90 ${SRC}/fraggle/fraggle_resolve.f90 ${SRC}/fraggle/fraggle_set.f90 ${SRC}/fraggle/fraggle_setup.f90 diff --git a/src/fraggle/fraggle_io.f90 b/src/fraggle/fraggle_io.f90 deleted file mode 100644 index c2e479dbb..000000000 --- a/src/fraggle/fraggle_io.f90 +++ /dev/null @@ -1,16 +0,0 @@ -!! Copyright 2022 - David Minton, Carlisle Wishard, Jennifer Pouplin, Jake Elliott, & Dana Singh -!! This file is part of Swiftest. -!! Swiftest is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License -!! as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. -!! Swiftest is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty -!! of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. -!! You should have received a copy of the GNU General Public License along with Swiftest. -!! If not, see: https://www.gnu.org/licenses. - -submodule(fraggle) s_fraggle_io - use swiftest - -contains - - -end submodule s_fraggle_io \ No newline at end of file diff --git a/src/fraggle/fraggle_module.f90 b/src/fraggle/fraggle_module.f90 index fe0b8fda0..d3bd3c9af 100644 --- a/src/fraggle/fraggle_module.f90 +++ b/src/fraggle/fraggle_module.f90 @@ -60,9 +60,9 @@ module fraggle interface - module subroutine fraggle_generate_fragments(collision_system, nbody_system, param, lfailure) + module subroutine fraggle_generate_fragments(collider, nbody_system, param, lfailure) implicit none - class(fraggle_system), intent(inout) :: collision_system !! Fraggle system object the outputs will be the fragmentation + class(fraggle_system), intent(inout) :: collider !! Fraggle system object the outputs will be the fragmentation class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters logical, intent(out) :: lfailure !! Answers the question: Should this have been a merger instead? @@ -70,16 +70,12 @@ end subroutine fraggle_generate_fragments module subroutine fraggle_generate_system(self, nbody_system, param, t) implicit none - class(fraggle_system), intent(inout) :: self !! Fraggle fragment system object + class(fraggle_system), intent(inout) :: self !! Fraggle fragment system object class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(base_parameters), intent(inout) :: param !! Current run configuration parameters - real(DP), intent(in) :: t !! Time of collision + real(DP), intent(in) :: t !! Time of collision end subroutine fraggle_generate_system - module subroutine fraggle_io_log_regime(collision_system) - implicit none - class(fraggle_system), intent(inout) :: collision_system !! Fraggle collision system object - end subroutine fraggle_io_log_regime module subroutine fraggle_set_budgets(self) implicit none From 83c3ae2aeb083df6e4ca1f5f9137ece78dc78cec Mon Sep 17 00:00:00 2001 From: David A Minton Date: Thu, 22 Dec 2022 11:03:34 -0500 Subject: [PATCH 492/569] More cleanup --- src/CMakeLists.txt | 1 - 1 file changed, 1 deletion(-) diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index ddeb2b357..86ffe6ee3 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -51,7 +51,6 @@ SET(FAST_MATH_FILES ${SRC}/encounter/encounter_setup.f90 ${SRC}/encounter/encounter_util.f90 ${SRC}/fraggle/fraggle_generate.f90 - ${SRC}/fraggle/fraggle_resolve.f90 ${SRC}/fraggle/fraggle_set.f90 ${SRC}/fraggle/fraggle_setup.f90 ${SRC}/fraggle/fraggle_util.f90 From cb8cf384500d2e3dc898ea2837cb8756fc161e6a Mon Sep 17 00:00:00 2001 From: David A Minton Date: Thu, 22 Dec 2022 15:36:51 -0500 Subject: [PATCH 493/569] Started getting the bounce model written --- src/collision/collision_generate.f90 | 90 ++++++++++++++++++++--- src/collision/collision_io.f90 | 2 +- src/collision/collision_module.f90 | 73 +++++++++--------- src/collision/collision_resolve.f90 | 4 +- src/collision/collision_setup.f90 | 6 +- src/collision/collision_util.f90 | 10 +-- src/fraggle/fraggle_generate.f90 | 20 +++-- src/fraggle/fraggle_module.f90 | 58 +++++++-------- src/fraggle/fraggle_set.f90 | 106 +++++++++++++-------------- src/fraggle/fraggle_setup.f90 | 2 +- src/fraggle/fraggle_util.f90 | 4 +- src/swiftest/swiftest_module.f90 | 2 +- src/swiftest/swiftest_setup.f90 | 4 +- 13 files changed, 229 insertions(+), 152 deletions(-) diff --git a/src/collision/collision_generate.f90 b/src/collision/collision_generate.f90 index d89353e44..f646c45ea 100644 --- a/src/collision/collision_generate.f90 +++ b/src/collision/collision_generate.f90 @@ -8,11 +8,57 @@ !! You should have received a copy of the GNU General Public License along with Swiftest. !! If not, see: https://www.gnu.org/licenses. -submodule(collision) s_collision_model +submodule(collision) s_collision_generate use swiftest contains - module subroutine collision_generate_merge_system(self, nbody_system, param, t) + module subroutine collision_generate_hitandrun(collider, nbody_system, param, t) + !! author: Jennifer L.L. Pouplin, Carlisle A. Wishard, and David A. Minton + !! + !! Create the fragments resulting from a non-catastrophic hit-and-run collision + !! + implicit none + ! Arguments + class(collision_merge), intent(inout) :: collider !! Fraggle collision system object + class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object + class(base_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions + real(DP), intent(in) :: t !! Time of collision + ! Internals + integer(I4B) :: i, ibiggest, nfrag, jtarg, jproj + logical :: lpure + character(len=STRMAX) :: message + real(DP) :: dpe + + select type(nbody_system) + class is (swiftest_nbody_system) + select type (pl => nbody_system%pl) + class is (swiftest_pl) + select type(before => collider%after) + class is (swiftest_nbody_system) + select type(after => collider%after) + class is (swiftest_nbody_system) + associate(impactors => collider%impactors, fragments => collider%fragments, pl => nbody_system%pl) + message = "Hit and run between" + call collision_io_collider_message(nbody_system%pl, impactors%id, message) + call swiftest_io_log_one_message(COLLISION_LOG_OUT, trim(adjustl(message))) + + collider%status = HIT_AND_RUN_PURE + pl%status(impactors%id(:)) = ACTIVE + pl%ldiscard(impactors%id(:)) = .false. + pl%lcollision(impactors%id(:)) = .false. + allocate(after%pl, source=before%pl) ! Be sure to save the pl so that snapshots still work + end associate + end select + end select + end select + end select + + + return + end subroutine collision_generate_hitandrun + + + module subroutine collision_generate_merge(self, nbody_system, param, t) !! author: Jennifer L.L. Pouplin, Carlisle A. Wishard, and David A. Minton !! !! Merge massive bodies in any collisionals ystem. @@ -22,7 +68,7 @@ module subroutine collision_generate_merge_system(self, nbody_system, param, t) !! Adapted from Hal Levison's Swift routines symba5_merge.f and discard_mass_merge.f implicit none ! Arguments - class(collision_system), intent(inout) :: self !! Merge fragment system object + class(collision_merge), intent(inout) :: self !! Merge fragment system object class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(base_parameters), intent(inout) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! The time of the collision @@ -106,23 +152,49 @@ module subroutine collision_generate_merge_system(self, nbody_system, param, t) end associate end select return - end subroutine collision_generate_merge_system + end subroutine collision_generate_merge - module subroutine collision_generate_bounce_system(self, nbody_system, param, t) + module subroutine collision_generate_bounce(self, nbody_system, param, t) + !! author: David A. Minton + !! + !! In this collision model, if the collision would result in a disruption, the bodies are instead "bounced" off + !! of the center of mass. This is done as a reflection in the 2-body equivalent distance vector direction. implicit none + ! Arguments class(collision_bounce), intent(inout) :: self !! Bounce fragment system object class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(base_parameters), intent(inout) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! The time of the collision - end subroutine collision_generate_bounce_system + ! Internals + integer(I4B) :: nfrag + + select type(nbody_system) + class is (swiftest_nbody_system) + associate(impactors => nbody_system%collider%impactors, fragments => nbody_system%collider%fragments) + select case (impactors%regime) + case (COLLRESOLVE_REGIME_DISRUPTION, COLLRESOLVE_REGIME_SUPERCATASTROPHIC) + nfrag = size(impactors%id(:)) + case (COLLRESOLVE_REGIME_HIT_AND_RUN) + call collision_generate_hitandrun(self, nbody_system, param, t) + case (COLLRESOLVE_REGIME_MERGE, COLLRESOLVE_REGIME_GRAZE_AND_MERGE) + call self%collision_merge%generate(nbody_system, param, t) ! Use the default collision model, which is merge + case default + write(*,*) "Error in swiftest_collision, unrecognized collision regime" + call util_exit(FAILURE) + end select + end associate + end select + + return + end subroutine collision_generate_bounce - module subroutine collision_generate_simple_system(self, nbody_system, param, t) + module subroutine collision_generate_simple(self, nbody_system, param, t) implicit none class(collision_simple), intent(inout) :: self !! Simple fragment system object class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(base_parameters), intent(inout) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! The time of the collision - end subroutine collision_generate_simple_system + end subroutine collision_generate_simple -end submodule s_collision_model \ No newline at end of file +end submodule s_collision_generate \ No newline at end of file diff --git a/src/collision/collision_io.f90 b/src/collision/collision_io.f90 index 0eccda309..1a11bf43a 100644 --- a/src/collision/collision_io.f90 +++ b/src/collision/collision_io.f90 @@ -51,7 +51,7 @@ module subroutine collision_io_log_regime(self) !! Writes a log of the results of the collisional regime determination implicit none ! Arguments - class(collision_system), intent(inout) :: self !! Collision system object + class(collision_merge), intent(inout) :: self !! Collision system object ! Internals character(STRMAX) :: errmsg diff --git a/src/collision/collision_module.f90 b/src/collision/collision_module.f90 index 5e1166ea3..494855d12 100644 --- a/src/collision/collision_module.f90 +++ b/src/collision/collision_module.f90 @@ -110,11 +110,11 @@ module collision end type collision_fragments - type :: collision_system + type :: collision_merge !! This class defines a collisional nbody_system that stores impactors and fragments. This is written so that various collision models (i.e. Fraggle) could potentially be used !! to resolve collision by defining extended types of encounters_impactors and/or encounetr_fragments !! - !! The generate method for this class is the merge model. This allows any extended type to have access to the merge procedure by selecting the collision_system parent class + !! The generate method for this class is the merge model. This allows any extended type to have access to the merge procedure by selecting the collision_merge parent class class(collision_fragments(:)), allocatable :: fragments !! Object containing information on the pre-collision system class(collision_impactors), allocatable :: impactors !! Object containing information on the post-collision system class(base_nbody_system), allocatable :: before !! A snapshot of the subset of the nbody_system involved in the collision @@ -138,19 +138,19 @@ module collision procedure :: get_energy_and_momentum => collision_util_get_energy_momentum !! Calculates total nbody_system energy in either the pre-collision outcome state (lbefore = .true.) or the post-collision outcome state (lbefore = .false.) procedure :: reset => collision_util_reset_system !! Deallocates all allocatables procedure :: set_coordinate_system => collision_util_set_coordinate_system !! Sets the coordinate nbody_system of the collisional nbody_system - procedure :: generate => collision_generate_merge_system !! Merges the impactors to make a single final body - end type collision_system + procedure :: generate => collision_generate_merge !! Merges the impactors to make a single final body + end type collision_merge - type, extends(collision_system) :: collision_bounce + type, extends(collision_merge) :: collision_bounce contains - procedure :: generate => collision_generate_bounce_system !! If a collision would result in a disruption, "bounce" the bodies instead. - final :: collision_final_bounce_system !! Finalizer will deallocate all allocatables + procedure :: generate => collision_generate_bounce !! If a collision would result in a disruption, "bounce" the bodies instead. + final :: collision_final_bounce !! Finalizer will deallocate all allocatables end type collision_bounce - type, extends(collision_system) :: collision_simple + type, extends(collision_merge) :: collision_simple contains - procedure :: generate => collision_generate_simple_system !! If a collision would result in a disruption [TODO: SOMETHING LIKE CHAMBERS 2012] - final :: collision_final_simple_system !! Finalizer will deallocate all allocatables + procedure :: generate => collision_generate_simple !! If a collision would result in a disruption [TODO: SOMETHING LIKE CHAMBERS 2012] + final :: collision_final_simple !! Finalizer will deallocate all allocatables end type collision_simple @@ -178,7 +178,7 @@ module collision type, extends(encounter_snapshot) :: collision_snapshot logical :: lcollision !! Indicates that this snapshot contains at least one collision - class(collision_system), allocatable :: collider !! Collider object at this snapshot + class(collision_merge), allocatable :: collider !! Collider object at this snapshot contains procedure :: write_frame => collision_io_netcdf_write_frame_snapshot !! Writes a frame of encounter data to file procedure :: get_idvals => collision_util_get_idvalues_snapshot !! Gets an array of all id values saved in this snapshot @@ -197,29 +197,38 @@ module collision interface - module subroutine collision_generate_merge_system(self, nbody_system, param, t) + + module subroutine collision_generate_hitandrun(collider, nbody_system, param, t) + implicit none + class(collision_merge), intent(inout) :: collider !! Merge (or extended) collision system object + class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object + class(base_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions + real(DP), intent(in) :: t !! Time of collision + end subroutine collision_generate_hitandrun + + module subroutine collision_generate_merge(self, nbody_system, param, t) implicit none - class(collision_system), intent(inout) :: self !! Merge fragment nbody_system object + class(collision_merge), intent(inout) :: self !! Merge fragment nbody_system object class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(base_parameters), intent(inout) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! The time of the collision - end subroutine collision_generate_merge_system + end subroutine collision_generate_merge - module subroutine collision_generate_bounce_system(self, nbody_system, param, t) + module subroutine collision_generate_bounce(self, nbody_system, param, t) implicit none class(collision_bounce), intent(inout) :: self !! Bounce fragment nbody_system object class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(base_parameters), intent(inout) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! The time of the collision - end subroutine collision_generate_bounce_system + end subroutine collision_generate_bounce - module subroutine collision_generate_simple_system(self, nbody_system, param, t) + module subroutine collision_generate_simple(self, nbody_system, param, t) implicit none class(collision_simple), intent(inout) :: self !! Simple fragment nbody_system object class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(base_parameters), intent(inout) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! The time of the collision - end subroutine collision_generate_simple_system + end subroutine collision_generate_simple module subroutine collision_io_collider_message(pl, collidx, collider_message) implicit none @@ -230,7 +239,7 @@ end subroutine collision_io_collider_message module subroutine collision_io_log_regime(self) implicit none - class(collision_system), intent(inout) :: self !! Collision system object + class(collision_merge), intent(inout) :: self !! Collision system object end subroutine collision_io_log_regime module subroutine collision_io_netcdf_dump(self, param) @@ -339,36 +348,36 @@ end subroutine collision_resolve_pltp module subroutine collision_util_set_coordinate_system(self) implicit none - class(collision_system), intent(inout) :: self !! Collisional nbody_system + class(collision_merge), intent(inout) :: self !! Collisional nbody_system end subroutine collision_util_set_coordinate_system module subroutine collision_setup_system(self, nbody_system) implicit none - class(collision_system), intent(inout) :: self !! Encounter collision system object + class(collision_merge), intent(inout) :: self !! Encounter collision system object class(base_nbody_system), intent(in) :: nbody_system !! Current nbody system. Used as a mold for the before/after snapshots end subroutine collision_setup_system module subroutine collision_setup_impactors_system(self) implicit none - class(collision_system), intent(inout) :: self !! Encounter collision system object + class(collision_merge), intent(inout) :: self !! Encounter collision system object end subroutine collision_setup_impactors_system module subroutine collision_setup_fragments_system(self, nfrag) implicit none - class(collision_system), intent(inout) :: self !! Encounter collision system object + class(collision_merge), intent(inout) :: self !! Encounter collision system object integer(I4B), intent(in) :: nfrag !! Number of fragments to create end subroutine collision_setup_fragments_system module subroutine collision_util_add_fragments_to_system(self, nbody_system, param) implicit none - class(collision_system), intent(in) :: self !! Collision system object + class(collision_merge), intent(in) :: self !! Collision system object class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(base_parameters), intent(in) :: param !! Current swiftest run configuration parameters end subroutine collision_util_add_fragments_to_system module subroutine collision_util_construct_temporary_system(self, nbody_system, param, tmpsys, tmpparam) implicit none - class(collision_system), intent(inout) :: self !! Collision system object + class(collision_merge), intent(inout) :: self !! Collision system object class(base_nbody_system), intent(in) :: nbody_system !! Original swiftest nbody system object class(base_parameters), intent(in) :: param !! Current swiftest run configuration parameters class(base_nbody_system), allocatable, intent(out) :: tmpsys !! Output temporary swiftest nbody system object @@ -389,7 +398,7 @@ end subroutine collision_util_get_idvalues_snapshot module subroutine collision_util_get_energy_momentum(self, nbody_system, param, lbefore) use base, only : base_nbody_system, base_parameters implicit none - class(collision_system), intent(inout) :: self !! Encounter collision system object + class(collision_merge), intent(inout) :: self !! Encounter collision system object class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(base_parameters), intent(inout) :: param !! Current swiftest run configuration parameters logical, intent(in) :: lbefore !! Flag indicating that this the "before" state of the nbody_system, with impactors included and fragments excluded or vice versa @@ -407,7 +416,7 @@ end subroutine collision_util_reset_impactors module subroutine collision_util_reset_system(self) implicit none - class(collision_system), intent(inout) :: self !! Collision system object + class(collision_merge), intent(inout) :: self !! Collision system object end subroutine collision_util_reset_system module subroutine collision_util_snapshot(self, param, nbody_system, t, arg) @@ -523,7 +532,7 @@ subroutine collision_final_storage(self) end subroutine collision_final_storage - subroutine collision_final_bounce_system(self) + subroutine collision_final_bounce(self) !! author: David A. Minton !! !! Finalizer will deallocate all allocatables @@ -536,10 +545,10 @@ subroutine collision_final_bounce_system(self) if (allocated(self%fragments)) deallocate(self%fragments) return - end subroutine collision_final_bounce_system + end subroutine collision_final_bounce - subroutine collision_final_simple_system(self) + subroutine collision_final_simple(self) !! author: David A. Minton !! !! Finalizer will deallocate all allocatables @@ -552,9 +561,7 @@ subroutine collision_final_simple_system(self) if (allocated(self%fragments)) deallocate(self%fragments) return - end subroutine collision_final_simple_system - - + end subroutine collision_final_simple end module collision diff --git a/src/collision/collision_resolve.f90 b/src/collision/collision_resolve.f90 index f4ade21b7..d7eff07eb 100644 --- a/src/collision/collision_resolve.f90 +++ b/src/collision/collision_resolve.f90 @@ -323,7 +323,7 @@ module subroutine collision_resolve_mergeaddsub(nbody_system, param, t, status) select type(param) class is (swiftest_parameters) associate(pl => nbody_system%pl, pl_discards => nbody_system%pl_discards, info => nbody_system%pl%info, pl_adds => nbody_system%pl_adds, cb => nbody_system%cb, npl => pl%nbody, & - collision_system => nbody_system%collider, impactors => nbody_system%collider%impactors,fragments => nbody_system%collider%fragments) + collision_merge => nbody_system%collider, impactors => nbody_system%collider%impactors,fragments => nbody_system%collider%fragments) ! Add the impactors%id bodies to the subtraction list nimpactors = impactors%ncoll @@ -437,7 +437,7 @@ module subroutine collision_resolve_mergeaddsub(nbody_system, param, t, status) end where ! Log the properties of the new bodies - select type(after => collision_system%after) + select type(after => collision_merge%after) class is (swiftest_nbody_system) allocate(after%pl, source=plnew) end select diff --git a/src/collision/collision_setup.f90 b/src/collision/collision_setup.f90 index d3be371d3..5b621a44f 100644 --- a/src/collision/collision_setup.f90 +++ b/src/collision/collision_setup.f90 @@ -18,7 +18,7 @@ module subroutine collision_setup_system(self, nbody_system) !! but not fragments. Those are setup later when the number of fragments is known. implicit none ! Arguments - class(collision_system), intent(inout) :: self !! Encounter collision system object + class(collision_merge), intent(inout) :: self !! Encounter collision system object class(base_nbody_system), intent(in) :: nbody_system !! Current nbody system. Used as a mold for the before/after snapshots call self%setup_impactors() @@ -38,7 +38,7 @@ module subroutine collision_setup_impactors_system(self) !! Initializer for the impactors for the encounter collision system. Deallocates old impactors before creating new ones implicit none ! Arguments - class(collision_system), intent(inout) :: self !! Encounter collision system object + class(collision_merge), intent(inout) :: self !! Encounter collision system object if (allocated(self%impactors)) deallocate(self%impactors) allocate(collision_impactors :: self%impactors) @@ -53,7 +53,7 @@ module subroutine collision_setup_fragments_system(self, nfrag) !! Initializer for the fragments of the collision system. implicit none ! Arguments - class(collision_system), intent(inout) :: self !! Encounter collision system object + class(collision_merge), intent(inout) :: self !! Encounter collision system object integer(I4B), intent(in) :: nfrag !! Number of fragments to create if (allocated(self%fragments)) deallocate(self%fragments) diff --git a/src/collision/collision_util.f90 b/src/collision/collision_util.f90 index c2d3a1924..4474544c1 100644 --- a/src/collision/collision_util.f90 +++ b/src/collision/collision_util.f90 @@ -17,7 +17,7 @@ module subroutine collision_util_add_fragments_to_system(self, nbody_system, par !! Adds fragments to the temporary system pl object implicit none ! Arguments - class(collision_system), intent(in) :: self !! Collision system system object + class(collision_merge), intent(in) :: self !! Collision system system object class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(base_parameters), intent(in) :: param !! Current swiftest run configuration parameters ! Internals @@ -67,7 +67,7 @@ module subroutine collision_util_construct_temporary_system(self, nbody_system, !! Constructs a temporary internal system consisting of active bodies and additional fragments. This internal temporary system is used to calculate system energy with and without fragments implicit none ! Arguments - class(collision_system), intent(inout) :: self !! Fraggle collision system object + class(collision_merge), intent(inout) :: self !! Fraggle collision system object class(base_nbody_system), intent(in) :: nbody_system !! Original swiftest nbody system object class(base_parameters), intent(in) :: param !! Current swiftest run configuration parameters class(base_nbody_system), allocatable, intent(out) :: tmpsys !! Output temporary swiftest nbody system object @@ -180,7 +180,7 @@ module subroutine collision_util_get_energy_momentum(self, nbody_system, param, !! This will temporarily expand the massive body object in a temporary system object called tmpsys to feed it into symba_energy implicit none ! Arguments - class(collision_system), intent(inout) :: self !! Encounter collision system object + class(collision_merge), intent(inout) :: self !! Encounter collision system object class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(base_parameters), intent(inout) :: param !! Current swiftest run configuration parameters logical, intent(in) :: lbefore !! Flag indicating that this the "before" state of the nbody_system, with impactors included and fragments excluded or vice versa @@ -349,7 +349,7 @@ module subroutine collision_util_reset_system(self) !! Resets the collider nbody_system and deallocates all allocatables implicit none ! Arguments - class(collision_system), intent(inout) :: self !! Collision system object + class(collision_merge), intent(inout) :: self !! Collision system object if (allocated(self%before)) deallocate(self%before) if (allocated(self%after)) deallocate(self%after) @@ -375,7 +375,7 @@ module subroutine collision_util_set_coordinate_system(self) !! Defines the collisional coordinate nbody_system, including the unit vectors of both the nbody_system and individual fragments. implicit none ! Arguments - class(collision_system), intent(inout) :: self !! Collisional nbody_system + class(collision_merge), intent(inout) :: self !! Collisional nbody_system ! Internals integer(I4B) :: i real(DP), dimension(NDIM) :: delta_r, delta_v, Ltot diff --git a/src/fraggle/fraggle_generate.f90 b/src/fraggle/fraggle_generate.f90 index a85c783aa..d7d3766a0 100644 --- a/src/fraggle/fraggle_generate.f90 +++ b/src/fraggle/fraggle_generate.f90 @@ -25,7 +25,7 @@ module subroutine fraggle_generate_disruption(collider, nbody_system, param, t) !! implicit none ! Arguments - class(fraggle_system), intent(inout) :: collider + class(collision_fraggle), intent(inout) :: collider class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions real(DP), intent(in) :: t !! Time of collision @@ -102,7 +102,7 @@ module subroutine fraggle_generate_hitandrun(collider, nbody_system, param, t) !! implicit none ! Arguments - class(fraggle_system), intent(inout) :: collider !! Fraggle collision system object + class(collision_fraggle), intent(inout) :: collider !! Fraggle collision system object class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions real(DP), intent(in) :: t !! Time of collision @@ -180,12 +180,10 @@ end subroutine fraggle_generate_hitandrun module subroutine fraggle_generate_system(self, nbody_system, param, t) implicit none - class(fraggle_system), intent(inout) :: self !! Fraggle fragment nbody_system object + class(collision_fraggle), intent(inout) :: self !! Fraggle fragment nbody_system object class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(base_parameters), intent(inout) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! The time of the collision - ! Internals - integer(I4B) :: i select type(nbody_system) class is (swiftest_nbody_system) @@ -197,7 +195,7 @@ module subroutine fraggle_generate_system(self, nbody_system, param, t) case (COLLRESOLVE_REGIME_HIT_AND_RUN) call fraggle_generate_hitandrun(self, nbody_system, param, t) case (COLLRESOLVE_REGIME_MERGE, COLLRESOLVE_REGIME_GRAZE_AND_MERGE) - call self%collision_system%generate(nbody_system, param, t) + call self%collision_merge%generate(nbody_system, param, t) case default write(*,*) "Error in swiftest_collision, unrecognized collision regime" call util_exit(FAILURE) @@ -216,7 +214,7 @@ module subroutine fraggle_generate_fragments(collider, nbody_system, param, lfai use, intrinsic :: ieee_exceptions implicit none ! Arguments - class(fraggle_system), intent(inout) :: collider !! Fraggle nbody_system object the outputs will be the fragmentation + class(collision_fraggle), intent(inout) :: collider !! Fraggle nbody_system object the outputs will be the fragmentation class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters logical, intent(out) :: lfailure !! Answers the question: Should this have been a merger instead? @@ -377,7 +375,7 @@ subroutine fraggle_generate_pos_vec(collider, r_max_start) !! The initial positions do not conserve energy or momentum, so these need to be adjusted later. implicit none ! Arguments - class(fraggle_system), intent(inout) :: collider !! Fraggle collision system object + class(collision_fraggle), intent(inout) :: collider !! Fraggle collision system object real(DP), intent(in) :: r_max_start !! Initial guess for the starting maximum radial distance of fragments ! Internals real(DP) :: dis, rad, r_max, fdistort @@ -460,7 +458,7 @@ subroutine fraggle_generate_spins(collider, f_spin, lfailure) !! A failure will trigger a restructuring of the fragments so we will try new values of the radial position distribution. implicit none ! Arguments - class(fraggle_system), intent(inout) :: collider !! Fraggle collision system object + class(collision_fraggle), intent(inout) :: collider !! Fraggle collision system object real(DP), intent(in) :: f_spin !! Fraction of energy or momentum that goes into spin (whichever gives the lowest kinetic energy) logical, intent(out) :: lfailure !! Logical flag indicating whether this step fails or succeeds! ! Internals @@ -557,7 +555,7 @@ subroutine fraggle_generate_tan_vel(collider, lfailure) !! A failure will trigger a restructuring of the fragments so we will try new values of the radial position distribution. implicit none ! Arguments - class(fraggle_system), intent(inout) :: collider !! Fraggle collision system object + class(collision_fraggle), intent(inout) :: collider !! Fraggle collision system object logical, intent(out) :: lfailure !! Logical flag indicating whether this step fails or succeeds ! Internals integer(I4B) :: i, try @@ -741,7 +739,7 @@ subroutine fraggle_generate_rad_vel(collider, lfailure) !! Adjust the fragment velocities to set the fragment orbital kinetic energy. This will minimize the difference between the fragment kinetic energy and the energy budget implicit none ! Arguments - class(fraggle_system), intent(inout) :: collider !! Fraggle collision system object + class(collision_fraggle), intent(inout) :: collider !! Fraggle collision system object logical, intent(out) :: lfailure !! Logical flag indicating whether this step fails or succeeds! ! Internals real(DP), parameter :: TOL_MIN = FRAGGLE_ETOL ! This needs to be more accurate than the tangential step, as we are trying to minimize the total residual energy diff --git a/src/fraggle/fraggle_module.f90 b/src/fraggle/fraggle_module.f90 index d3bd3c9af..83aaee06b 100644 --- a/src/fraggle/fraggle_module.f90 +++ b/src/fraggle/fraggle_module.f90 @@ -37,7 +37,7 @@ module fraggle end type fraggle_fragments - type, extends(collision_system) :: fraggle_system + type, extends(collision_merge) :: collision_fraggle ! Scale factors used to scale dimensioned quantities to a more "natural" system where important quantities (like kinetic energy, momentum) are of order ~1 real(DP) :: dscale = 1.0_DP !! Distance dimension scale factor real(DP) :: mscale = 1.0_DP !! Mass scale factor @@ -55,68 +55,68 @@ module fraggle procedure :: construct_temporary_system => fraggle_util_construct_temporary_system !! Constructs temporary n-body system in order to compute pre- and post-impact energy and momentum procedure :: reset => fraggle_util_reset_system !! Deallocates all allocatables final :: fraggle_final_system !! Finalizer will deallocate all allocatables - end type fraggle_system + end type collision_fraggle interface + + module subroutine fraggle_generate_disruption(collider, nbody_system, param, t) + implicit none + class(collision_fraggle), intent(inout) :: collider !! Fraggle collision system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions + real(DP), intent(in) :: t !! Time of collision + end subroutine fraggle_generate_disruption + module subroutine fraggle_generate_fragments(collider, nbody_system, param, lfailure) implicit none - class(fraggle_system), intent(inout) :: collider !! Fraggle system object the outputs will be the fragmentation + class(collision_fraggle), intent(inout) :: collider !! Fraggle system object the outputs will be the fragmentation class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters logical, intent(out) :: lfailure !! Answers the question: Should this have been a merger instead? end subroutine fraggle_generate_fragments + module subroutine fraggle_generate_hitandrun(collider, nbody_system, param, t) + implicit none + class(collision_fraggle), intent(inout) :: collider !! Fraggle collision system object + class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions + real(DP), intent(in) :: t !! Time of collision + end subroutine fraggle_generate_hitandrun + module subroutine fraggle_generate_system(self, nbody_system, param, t) implicit none - class(fraggle_system), intent(inout) :: self !! Fraggle fragment system object + class(collision_fraggle), intent(inout) :: self !! Fraggle fragment system object class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(base_parameters), intent(inout) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! Time of collision end subroutine fraggle_generate_system - module subroutine fraggle_set_budgets(self) implicit none - class(fraggle_system), intent(inout) :: self !! Fraggle collision system object + class(collision_fraggle), intent(inout) :: self !! Fraggle collision system object end subroutine fraggle_set_budgets module subroutine fraggle_set_mass_dist(self, param) implicit none - class(fraggle_system), intent(inout) :: self !! Fraggle collision system object + class(collision_fraggle), intent(inout) :: self !! Fraggle collision system object class(swiftest_parameters), intent(in) :: param !! Current Swiftest run configuration parameters end subroutine fraggle_set_mass_dist module subroutine fraggle_set_natural_scale_factors(self) implicit none - class(fraggle_system), intent(inout) :: self !! Fraggle collision system object + class(collision_fraggle), intent(inout) :: self !! Fraggle collision system object end subroutine fraggle_set_natural_scale_factors - module subroutine fraggle_generate_disruption(collider, nbody_system, param, t) - implicit none - class(fraggle_system), intent(inout) :: collider !! Fraggle collision system object - class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions - real(DP), intent(in) :: t !! Time of collision - end subroutine fraggle_generate_disruption - - module subroutine fraggle_generate_hitandrun(collider, nbody_system, param, t) - implicit none - class(fraggle_system), intent(inout) :: collider !! Fraggle collision system object - class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions - real(DP), intent(in) :: t !! Time of collision - end subroutine fraggle_generate_hitandrun - module subroutine fraggle_set_original_scale_factors(self) implicit none - class(fraggle_system), intent(inout) :: self !! Fraggle collision system object + class(collision_fraggle), intent(inout) :: self !! Fraggle collision system object end subroutine fraggle_set_original_scale_factors module subroutine fraggle_setup_fragments_system(self, nfrag) implicit none - class(fraggle_system), intent(inout) :: self !! Encounter collision system object + class(collision_fraggle), intent(inout) :: self !! Encounter collision system object integer(I4B), intent(in) :: nfrag !! Number of fragments to create end subroutine fraggle_setup_fragments_system @@ -127,7 +127,7 @@ end subroutine fraggle_util_get_angular_momentum module subroutine fraggle_util_construct_temporary_system(self, nbody_system, param, tmpsys, tmpparam) implicit none - class(fraggle_system), intent(inout) :: self !! Fraggle collision system object + class(collision_fraggle), intent(inout) :: self !! Fraggle collision system object class(base_nbody_system), intent(in) :: nbody_system !! Original swiftest nbody system object class(base_parameters), intent(in) :: param !! Current swiftest run configuration parameters class(base_nbody_system), allocatable, intent(out) :: tmpsys !! Output temporary swiftest nbody system object @@ -146,7 +146,7 @@ end subroutine fraggle_util_reset_fragments module subroutine fraggle_util_reset_system(self) implicit none - class(fraggle_system), intent(inout) :: self !! Collision system object + class(collision_fraggle), intent(inout) :: self !! Collision system object end subroutine fraggle_util_reset_system module subroutine fraggle_util_restructure(self, impactors, try, f_spin, r_max_start) @@ -198,7 +198,7 @@ subroutine fraggle_final_system(self) !! Finalizer will deallocate all allocatables implicit none ! Arguments - type(fraggle_system), intent(inout) :: self !! Collision impactors storage object + type(collision_fraggle), intent(inout) :: self !! Collision impactors storage object call self%reset() if (allocated(self%impactors)) deallocate(self%impactors) diff --git a/src/fraggle/fraggle_set.f90 b/src/fraggle/fraggle_set.f90 index d466db871..21ba46588 100644 --- a/src/fraggle/fraggle_set.f90 +++ b/src/fraggle/fraggle_set.f90 @@ -18,7 +18,7 @@ module subroutine fraggle_set_budgets(self) !! Sets the energy and momentum budgets of the fragments based on the collider values and the before/after values of energy and momentum implicit none ! Arguments - class(fraggle_system), intent(inout) :: self !! Fraggle collision system object + class(collision_fraggle), intent(inout) :: self !! Fraggle collision system object ! Internals real(DP) :: dEtot real(DP), dimension(NDIM) :: dL @@ -48,7 +48,7 @@ module subroutine fraggle_set_mass_dist(self, param) !! implicit none ! Arguments - class(fraggle_system), intent(inout) :: self !! Fraggle collision system object + class(collision_fraggle), intent(inout) :: self !! Fraggle collision system object class(swiftest_parameters), intent(in) :: param !! Current Swiftest run configuration parameters ! Internals integer(I4B) :: i, jproj, jtarg, nfrag, istart @@ -183,39 +183,39 @@ module subroutine fraggle_set_natural_scale_factors(self) !! This scaling makes it easier for the non-linear minimization to converge on a solution implicit none ! Arguments - class(fraggle_system), intent(inout) :: self !! Fraggle collision system object + class(collision_fraggle), intent(inout) :: self !! Fraggle collision system object ! Internals integer(I4B) :: i - associate(collision_system => self, fragments => self%fragments, impactors => self%impactors) + associate(collision_merge => self, fragments => self%fragments, impactors => self%impactors) ! Set scale factors - collision_system%Escale = 0.5_DP * ( impactors%mass(1) * dot_product(impactors%vb(:,1), impactors%vb(:,1)) & + collision_merge%Escale = 0.5_DP * ( impactors%mass(1) * dot_product(impactors%vb(:,1), impactors%vb(:,1)) & + impactors%mass(2) * dot_product(impactors%vb(:,2), impactors%vb(:,2))) - collision_system%dscale = sum(impactors%radius(:)) - collision_system%mscale = fragments%mtot - collision_system%vscale = sqrt(collision_system%Escale / collision_system%mscale) - collision_system%tscale = collision_system%dscale / collision_system%vscale - collision_system%Lscale = collision_system%mscale * collision_system%dscale * collision_system%vscale + collision_merge%dscale = sum(impactors%radius(:)) + collision_merge%mscale = fragments%mtot + collision_merge%vscale = sqrt(collision_merge%Escale / collision_merge%mscale) + collision_merge%tscale = collision_merge%dscale / collision_merge%vscale + collision_merge%Lscale = collision_merge%mscale * collision_merge%dscale * collision_merge%vscale ! Scale all dimensioned quantities of impactors and fragments - impactors%rbcom(:) = impactors%rbcom(:) / collision_system%dscale - impactors%vbcom(:) = impactors%vbcom(:) / collision_system%vscale - impactors%rbimp(:) = impactors%rbimp(:) / collision_system%dscale - impactors%rb(:,:) = impactors%rb(:,:) / collision_system%dscale - impactors%vb(:,:) = impactors%vb(:,:) / collision_system%vscale - impactors%mass(:) = impactors%mass(:) / collision_system%mscale - impactors%radius(:) = impactors%radius(:) / collision_system%dscale - impactors%Lspin(:,:) = impactors%Lspin(:,:) / collision_system%Lscale - impactors%Lorbit(:,:) = impactors%Lorbit(:,:) / collision_system%Lscale + impactors%rbcom(:) = impactors%rbcom(:) / collision_merge%dscale + impactors%vbcom(:) = impactors%vbcom(:) / collision_merge%vscale + impactors%rbimp(:) = impactors%rbimp(:) / collision_merge%dscale + impactors%rb(:,:) = impactors%rb(:,:) / collision_merge%dscale + impactors%vb(:,:) = impactors%vb(:,:) / collision_merge%vscale + impactors%mass(:) = impactors%mass(:) / collision_merge%mscale + impactors%radius(:) = impactors%radius(:) / collision_merge%dscale + impactors%Lspin(:,:) = impactors%Lspin(:,:) / collision_merge%Lscale + impactors%Lorbit(:,:) = impactors%Lorbit(:,:) / collision_merge%Lscale do i = 1, 2 impactors%rot(:,i) = impactors%Lspin(:,i) / (impactors%mass(i) * impactors%radius(i)**2 * impactors%Ip(3, i)) end do - fragments%mtot = fragments%mtot / collision_system%mscale - fragments%mass = fragments%mass / collision_system%mscale - fragments%radius = fragments%radius / collision_system%dscale - impactors%Qloss = impactors%Qloss / collision_system%Escale + fragments%mtot = fragments%mtot / collision_merge%mscale + fragments%mass = fragments%mass / collision_merge%mscale + fragments%radius = fragments%radius / collision_merge%dscale + impactors%Qloss = impactors%Qloss / collision_merge%Escale end associate return @@ -229,7 +229,7 @@ module subroutine fraggle_set_original_scale_factors(self) use, intrinsic :: ieee_exceptions implicit none ! Arguments - class(fraggle_system), intent(inout) :: self !! Fraggle fragment system object + class(collision_fraggle), intent(inout) :: self !! Fraggle fragment system object ! Internals integer(I4B) :: i logical, dimension(size(IEEE_ALL)) :: fpe_halting_modes @@ -237,50 +237,50 @@ module subroutine fraggle_set_original_scale_factors(self) call ieee_get_halting_mode(IEEE_ALL,fpe_halting_modes) ! Save the current halting modes so we can turn them off temporarily call ieee_set_halting_mode(IEEE_ALL,.false.) - associate(collision_system => self, fragments => self%fragments, impactors => self%impactors) + associate(collision_merge => self, fragments => self%fragments, impactors => self%impactors) ! Restore scale factors - impactors%rbcom(:) = impactors%rbcom(:) * collision_system%dscale - impactors%vbcom(:) = impactors%vbcom(:) * collision_system%vscale - impactors%rbimp(:) = impactors%rbimp(:) * collision_system%dscale + impactors%rbcom(:) = impactors%rbcom(:) * collision_merge%dscale + impactors%vbcom(:) = impactors%vbcom(:) * collision_merge%vscale + impactors%rbimp(:) = impactors%rbimp(:) * collision_merge%dscale - impactors%mass = impactors%mass * collision_system%mscale - impactors%radius = impactors%radius * collision_system%dscale - impactors%rb = impactors%rb * collision_system%dscale - impactors%vb = impactors%vb * collision_system%vscale - impactors%Lspin = impactors%Lspin * collision_system%Lscale + impactors%mass = impactors%mass * collision_merge%mscale + impactors%radius = impactors%radius * collision_merge%dscale + impactors%rb = impactors%rb * collision_merge%dscale + impactors%vb = impactors%vb * collision_merge%vscale + impactors%Lspin = impactors%Lspin * collision_merge%Lscale do i = 1, 2 impactors%rot(:,i) = impactors%Lspin(:,i) * (impactors%mass(i) * impactors%radius(i)**2 * impactors%Ip(3, i)) end do - fragments%mtot = fragments%mtot * collision_system%mscale - fragments%mass = fragments%mass * collision_system%mscale - fragments%radius = fragments%radius * collision_system%dscale - fragments%rot = fragments%rot / collision_system%tscale - fragments%rc = fragments%rc * collision_system%dscale - fragments%vc = fragments%vc * collision_system%vscale + fragments%mtot = fragments%mtot * collision_merge%mscale + fragments%mass = fragments%mass * collision_merge%mscale + fragments%radius = fragments%radius * collision_merge%dscale + fragments%rot = fragments%rot / collision_merge%tscale + fragments%rc = fragments%rc * collision_merge%dscale + fragments%vc = fragments%vc * collision_merge%vscale do i = 1, fragments%nbody fragments%rb(:, i) = fragments%rc(:, i) + impactors%rbcom(:) fragments%vb(:, i) = fragments%vc(:, i) + impactors%vbcom(:) end do - impactors%Qloss = impactors%Qloss * collision_system%Escale + impactors%Qloss = impactors%Qloss * collision_merge%Escale - collision_system%Lorbit(:,:) = collision_system%Lorbit(:,:) * collision_system%Lscale - collision_system%Lspin(:,:) = collision_system%Lspin(:,:) * collision_system%Lscale - collision_system%Ltot(:,:) = collision_system%Ltot(:,:) * collision_system%Lscale - collision_system%ke_orbit(:) = collision_system%ke_orbit(:) * collision_system%Escale - collision_system%ke_spin(:) = collision_system%ke_spin(:) * collision_system%Escale - collision_system%pe(:) = collision_system%pe(:) * collision_system%Escale - collision_system%Etot(:) = collision_system%Etot(:) * collision_system%Escale + collision_merge%Lorbit(:,:) = collision_merge%Lorbit(:,:) * collision_merge%Lscale + collision_merge%Lspin(:,:) = collision_merge%Lspin(:,:) * collision_merge%Lscale + collision_merge%Ltot(:,:) = collision_merge%Ltot(:,:) * collision_merge%Lscale + collision_merge%ke_orbit(:) = collision_merge%ke_orbit(:) * collision_merge%Escale + collision_merge%ke_spin(:) = collision_merge%ke_spin(:) * collision_merge%Escale + collision_merge%pe(:) = collision_merge%pe(:) * collision_merge%Escale + collision_merge%Etot(:) = collision_merge%Etot(:) * collision_merge%Escale - collision_system%mscale = 1.0_DP - collision_system%dscale = 1.0_DP - collision_system%vscale = 1.0_DP - collision_system%tscale = 1.0_DP - collision_system%Lscale = 1.0_DP - collision_system%Escale = 1.0_DP + collision_merge%mscale = 1.0_DP + collision_merge%dscale = 1.0_DP + collision_merge%vscale = 1.0_DP + collision_merge%tscale = 1.0_DP + collision_merge%Lscale = 1.0_DP + collision_merge%Escale = 1.0_DP end associate call ieee_set_halting_mode(IEEE_ALL,fpe_halting_modes) diff --git a/src/fraggle/fraggle_setup.f90 b/src/fraggle/fraggle_setup.f90 index b612f05b2..65e48718a 100644 --- a/src/fraggle/fraggle_setup.f90 +++ b/src/fraggle/fraggle_setup.f90 @@ -18,7 +18,7 @@ module subroutine fraggle_setup_fragments_system(self, nfrag) !! Initializer for the fragments of the collision system. implicit none ! Arguments - class(fraggle_system), intent(inout) :: self !! Encounter collision system object + class(collision_fraggle), intent(inout) :: self !! Encounter collision system object integer(I4B), intent(in) :: nfrag !! Number of fragments to create if (allocated(self%fragments)) deallocate(self%fragments) diff --git a/src/fraggle/fraggle_util.f90 b/src/fraggle/fraggle_util.f90 index b8f6ef57d..07b5eef50 100644 --- a/src/fraggle/fraggle_util.f90 +++ b/src/fraggle/fraggle_util.f90 @@ -42,7 +42,7 @@ module subroutine fraggle_util_construct_temporary_system(self, nbody_system, pa !! Constructs a temporary internal system consisting of active bodies and additional fragments. This internal temporary system is used to calculate system energy with and without fragments implicit none ! Arguments - class(fraggle_system), intent(inout) :: self !! Fraggle collision system object + class(collision_fraggle), intent(inout) :: self !! Fraggle collision system object class(base_nbody_system), intent(in) :: nbody_system !! Original swiftest nbody system object class(base_parameters), intent(in) :: param !! Current swiftest run configuration parameters class(base_nbody_system), allocatable, intent(out) :: tmpsys !! Output temporary swiftest nbody system object @@ -97,7 +97,7 @@ module subroutine fraggle_util_reset_system(self) !! Resets the collider system and deallocates all allocatables implicit none ! Arguments - class(fraggle_system), intent(inout) :: self !! Collision system object + class(collision_fraggle), intent(inout) :: self !! Collision system object self%dscale = 1.0_DP self%mscale = 1.0_DP diff --git a/src/swiftest/swiftest_module.f90 b/src/swiftest/swiftest_module.f90 index 7a6fe0b79..ff94cb85c 100644 --- a/src/swiftest/swiftest_module.f90 +++ b/src/swiftest/swiftest_module.f90 @@ -322,7 +322,7 @@ module swiftest class(encounter_list), allocatable :: plpl_encounter !! List of massive body-massive body encounters in a single step class(collision_list_plpl), allocatable :: plpl_collision !! List of massive body-massive body collisions in a single step class(collision_list_plpl), allocatable :: pltp_collision !! List of massive body-massive body collisions in a single step - class(collision_system), allocatable :: collider !! Collision system object + class(collision_merge), allocatable :: collider !! Collision system object class(encounter_storage(nframes=:)), allocatable :: encounter_history !! Stores encounter history for later retrieval and saving to file class(collision_storage(nframes=:)), allocatable :: collision_history !! Stores encounter history for later retrieval and saving to file diff --git a/src/swiftest/swiftest_setup.f90 b/src/swiftest/swiftest_setup.f90 index ffa455ac0..ae7f0dc40 100644 --- a/src/swiftest/swiftest_setup.f90 +++ b/src/swiftest/swiftest_setup.f90 @@ -117,13 +117,13 @@ module subroutine swiftest_setup_construct_system(nbody_system, param) select case(param%collision_model) case("MERGE") - allocate(collision_system :: nbody_system%collider) + allocate(collision_merge :: nbody_system%collider) case("BOUNCE") allocate(collision_bounce :: nbody_system%collider) case("SIMPLE") allocate(collision_simple :: nbody_system%collider) case("FRAGGLE") - allocate(fraggle_system :: nbody_system%collider) + allocate(collision_fraggle :: nbody_system%collider) end select call nbody_system%collider%setup(nbody_system) From 989b60c76852273704fa4bcf71ce30969e970b9d Mon Sep 17 00:00:00 2001 From: David A Minton Date: Thu, 22 Dec 2022 15:50:43 -0500 Subject: [PATCH 494/569] Cleanup --- src/collision/collision_generate.f90 | 6 +++- src/collision/collision_io.f90 | 51 ++++++++++++++-------------- src/collision/collision_module.f90 | 4 +-- src/collision/collision_regime.f90 | 9 ++--- 4 files changed, 37 insertions(+), 33 deletions(-) diff --git a/src/collision/collision_generate.f90 b/src/collision/collision_generate.f90 index f646c45ea..d689c3662 100644 --- a/src/collision/collision_generate.f90 +++ b/src/collision/collision_generate.f90 @@ -167,7 +167,7 @@ module subroutine collision_generate_bounce(self, nbody_system, param, t) class(base_parameters), intent(inout) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! The time of the collision ! Internals - integer(I4B) :: nfrag + integer(I4B) :: i,nfrag select type(nbody_system) class is (swiftest_nbody_system) @@ -175,6 +175,9 @@ module subroutine collision_generate_bounce(self, nbody_system, param, t) select case (impactors%regime) case (COLLRESOLVE_REGIME_DISRUPTION, COLLRESOLVE_REGIME_SUPERCATASTROPHIC) nfrag = size(impactors%id(:)) + call self%setup_fragments(nfrag) + + case (COLLRESOLVE_REGIME_HIT_AND_RUN) call collision_generate_hitandrun(self, nbody_system, param, t) case (COLLRESOLVE_REGIME_MERGE, COLLRESOLVE_REGIME_GRAZE_AND_MERGE) @@ -189,6 +192,7 @@ module subroutine collision_generate_bounce(self, nbody_system, param, t) return end subroutine collision_generate_bounce + module subroutine collision_generate_simple(self, nbody_system, param, t) implicit none class(collision_simple), intent(inout) :: self !! Simple fragment system object diff --git a/src/collision/collision_io.f90 b/src/collision/collision_io.f90 index 1a11bf43a..048653068 100644 --- a/src/collision/collision_io.f90 +++ b/src/collision/collision_io.f90 @@ -45,40 +45,39 @@ module subroutine collision_io_collider_message(pl, collidx, collider_message) end subroutine collision_io_collider_message - module subroutine collision_io_log_regime(self) + module subroutine collision_io_log_regime(impactors) !! author: David A. Minton !! !! Writes a log of the results of the collisional regime determination implicit none ! Arguments - class(collision_merge), intent(inout) :: self !! Collision system object + class(collision_impactors), intent(inout) :: impactors !! Collision system object ! Internals character(STRMAX) :: errmsg - associate(fragments => self%fragments, impactors => self%impactors) - open(unit=LUN, file=COLLISION_LOG_OUT, status = 'OLD', position = 'APPEND', form = 'FORMATTED', err = 667, iomsg = errmsg) - write(LUN, *, err = 667, iomsg = errmsg) - write(LUN, *) "--------------------------------------------------------------------" - write(LUN, *) " Collisional regime determination results" - write(LUN, *) "--------------------------------------------------------------------" - write(LUN, *) "True number of impactors : ",impactors%ncoll - write(LUN, *) "Index list of true impactors : ",impactors%id(1:impactors%ncoll) - select case(impactors%regime) - case(COLLRESOLVE_REGIME_MERGE) - write(LUN, *) "Regime: Merge" - case(COLLRESOLVE_REGIME_DISRUPTION) - write(LUN, *) "Regime: Disruption" - case(COLLRESOLVE_REGIME_SUPERCATASTROPHIC) - write(LUN, *) "Regime: Supercatastrophic disruption" - case(COLLRESOLVE_REGIME_GRAZE_AND_MERGE) - write(LUN, *) "Regime: Graze and merge" - case(COLLRESOLVE_REGIME_HIT_AND_RUN) - write(LUN, *) "Regime: Hit and run" - end select - write(LUN, *) "Energy loss : ", impactors%Qloss - write(LUN, *) "--------------------------------------------------------------------" - close(LUN) - end associate + open(unit=LUN, file=COLLISION_LOG_OUT, status = 'OLD', position = 'APPEND', form = 'FORMATTED', err = 667, iomsg = errmsg) + write(LUN, *, err = 667, iomsg = errmsg) + write(LUN, *) "--------------------------------------------------------------------" + write(LUN, *) " Collisional regime determination results" + write(LUN, *) "--------------------------------------------------------------------" + write(LUN, *) "True number of impactors : ",impactors%ncoll + write(LUN, *) "Index list of true impactors : ",impactors%id(1:impactors%ncoll) + select case(impactors%regime) + case(COLLRESOLVE_REGIME_MERGE) + write(LUN, *) "Regime: Merge" + case(COLLRESOLVE_REGIME_DISRUPTION) + write(LUN, *) "Regime: Disruption" + case(COLLRESOLVE_REGIME_SUPERCATASTROPHIC) + write(LUN, *) "Regime: Supercatastrophic disruption" + case(COLLRESOLVE_REGIME_GRAZE_AND_MERGE) + write(LUN, *) "Regime: Graze and merge" + case(COLLRESOLVE_REGIME_HIT_AND_RUN) + write(LUN, *) "Regime: Hit and run" + end select + write(LUN, *) "Energy loss : ", impactors%Qloss + write(LUN, *) "--------------------------------------------------------------------" + close(LUN) + return 667 continue write(*,*) "Error writing collision regime information to log file: " // trim(adjustl(errmsg)) diff --git a/src/collision/collision_module.f90 b/src/collision/collision_module.f90 index 494855d12..237999adf 100644 --- a/src/collision/collision_module.f90 +++ b/src/collision/collision_module.f90 @@ -237,9 +237,9 @@ module subroutine collision_io_collider_message(pl, collidx, collider_message) character(*), intent(inout) :: collider_message !! The message to print to the screen. end subroutine collision_io_collider_message - module subroutine collision_io_log_regime(self) + module subroutine collision_io_log_regime(impactors) implicit none - class(collision_merge), intent(inout) :: self !! Collision system object + class(collision_impactors), intent(inout) :: impactors !! Collision system object end subroutine collision_io_log_regime module subroutine collision_io_netcdf_dump(self, param) diff --git a/src/collision/collision_regime.f90 b/src/collision/collision_regime.f90 index ac571b23c..197a84f42 100644 --- a/src/collision/collision_regime.f90 +++ b/src/collision/collision_regime.f90 @@ -32,19 +32,20 @@ module subroutine collision_regime_impactors(self, nbody_system, param) select type(param) class is (swiftest_parameters) + mtot = sum(impactors%mass(:)) + impactors%rbcom(:) = (impactors%mass(1) * impactors%rb(:,1) + impactors%mass(2) * impactors%rb(:,2)) / mtot + impactors%vbcom(:) = (impactors%mass(1) * impactors%vb(:,1) + impactors%mass(2) * impactors%vb(:,2)) / mtot + select case(param%collision_model) case("MERGE") impactors%regime = COLLRESOLVE_REGIME_MERGE - mtot = sum(impactors%mass(:)) if (allocated(impactors%mass_dist)) deallocate(impactors%mass_dist) allocate(impactors%mass_dist(1)) impactors%mass_dist(1) = mtot - impactors%rbcom(:) = (impactors%mass(1) * impactors%rb(:,1) + impactors%mass(2) * impactors%rb(:,2)) / mtot - impactors%vbcom(:) = (impactors%mass(1) * impactors%vb(:,1) + impactors%mass(2) * impactors%vb(:,2)) / mtot case default call collision_regime_LS12(impactors, nbody_system, param) + call collision_io_log_regime(self) end select - !call fraggle_io_log_regime(impactors, fragments) end select end select end associate From f378e69719002957f6afbbbb251b84cd215ecabf Mon Sep 17 00:00:00 2001 From: David A Minton Date: Thu, 22 Dec 2022 17:16:11 -0500 Subject: [PATCH 495/569] Cleanup and bugfixes --- examples/Fragmentation/Fragmentation_Movie.py | 2 +- src/collision/collision_generate.f90 | 46 ++++++++++++++----- src/collision/collision_module.f90 | 4 +- src/collision/collision_util.f90 | 16 +++++-- 4 files changed, 50 insertions(+), 18 deletions(-) diff --git a/examples/Fragmentation/Fragmentation_Movie.py b/examples/Fragmentation/Fragmentation_Movie.py index baff5c002..b8fd8217a 100644 --- a/examples/Fragmentation/Fragmentation_Movie.py +++ b/examples/Fragmentation/Fragmentation_Movie.py @@ -206,7 +206,7 @@ def data_stream(self, frame=0): # Set fragmentation parameters minimum_fragment_gmass = 0.2 * body_Gmass[style][1] # Make the minimum fragment mass a fraction of the smallest body gmtiny = 0.99 * body_Gmass[style][1] # Make GMTINY just smaller than the smallest original body. This will prevent runaway collisional cascades - sim.set_parameter(collision_model="merge", encounter_save="both", gmtiny=gmtiny, minimum_fragment_gmass=minimum_fragment_gmass, verbose=False) + sim.set_parameter(collision_model="bounce", encounter_save="both", gmtiny=gmtiny, minimum_fragment_gmass=minimum_fragment_gmass, verbose=False) sim.run(dt=1e-3, tstop=1.0e-3, istep_out=1, dump_cadence=0) print("Generating animation") diff --git a/src/collision/collision_generate.f90 b/src/collision/collision_generate.f90 index d689c3662..421cf0558 100644 --- a/src/collision/collision_generate.f90 +++ b/src/collision/collision_generate.f90 @@ -33,10 +33,7 @@ module subroutine collision_generate_hitandrun(collider, nbody_system, param, t) class is (swiftest_nbody_system) select type (pl => nbody_system%pl) class is (swiftest_pl) - select type(before => collider%after) - class is (swiftest_nbody_system) - select type(after => collider%after) - class is (swiftest_nbody_system) + associate(impactors => collider%impactors, fragments => collider%fragments, pl => nbody_system%pl) message = "Hit and run between" call collision_io_collider_message(nbody_system%pl, impactors%id, message) @@ -46,12 +43,19 @@ module subroutine collision_generate_hitandrun(collider, nbody_system, param, t) pl%status(impactors%id(:)) = ACTIVE pl%ldiscard(impactors%id(:)) = .false. pl%lcollision(impactors%id(:)) = .false. - allocate(after%pl, source=before%pl) ! Be sure to save the pl so that snapshots still work + + ! Be sure to save the pl so that snapshots still work + select type(before => collider%before) + class is (swiftest_nbody_system) + select type(after => collider%after) + class is (swiftest_nbody_system) + allocate(after%pl, source=before%pl) + end select + end select end associate end select end select - end select - end select + return @@ -167,17 +171,36 @@ module subroutine collision_generate_bounce(self, nbody_system, param, t) class(base_parameters), intent(inout) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! The time of the collision ! Internals - integer(I4B) :: i,nfrag + integer(I4B) :: i,j,nfrag + real(DP), dimension(NDIM) :: vcom, rnorm select type(nbody_system) class is (swiftest_nbody_system) + select type (pl => nbody_system%pl) + class is (swiftest_pl) associate(impactors => nbody_system%collider%impactors, fragments => nbody_system%collider%fragments) select case (impactors%regime) case (COLLRESOLVE_REGIME_DISRUPTION, COLLRESOLVE_REGIME_SUPERCATASTROPHIC) nfrag = size(impactors%id(:)) - call self%setup_fragments(nfrag) - - + do i = 1, nfrag + j = impactors%id(i) + vcom(:) = pl%vb(:,j) - impactors%vbcom(:) + rnorm(:) = .unit. (impactors%rb(:,2) - impactors%rb(:,1)) + ! Do the reflection + vcom(:) = vcom(:) - 2 * dot_product(vcom(:),rnorm(:)) * rnorm(:) + pl%vb(:,j) = impactors%vbcom(:) + vcom(:) + self%status = DISRUPTED + pl%status(j) = ACTIVE + pl%ldiscard(j) = .false. + pl%lcollision(j) = .false. + end do + select type(before => self%before) + class is (swiftest_nbody_system) + select type(after => self%after) + class is (swiftest_nbody_system) + allocate(after%pl, source=before%pl) ! Be sure to save the pl so that snapshots still work + end select + end select case (COLLRESOLVE_REGIME_HIT_AND_RUN) call collision_generate_hitandrun(self, nbody_system, param, t) case (COLLRESOLVE_REGIME_MERGE, COLLRESOLVE_REGIME_GRAZE_AND_MERGE) @@ -188,6 +211,7 @@ module subroutine collision_generate_bounce(self, nbody_system, param, t) end select end associate end select + end select return end subroutine collision_generate_bounce diff --git a/src/collision/collision_module.f90 b/src/collision/collision_module.f90 index 237999adf..7b8331d1b 100644 --- a/src/collision/collision_module.f90 +++ b/src/collision/collision_module.f90 @@ -78,7 +78,7 @@ module collision procedure :: consolidate => collision_resolve_consolidate_impactors !! Consolidates a multi-body collision into an equivalent 2-body collision procedure :: get_regime => collision_regime_impactors !! Determine which fragmentation regime the set of impactors will be procedure :: reset => collision_util_reset_impactors !! Resets the collider object variables to 0 and deallocates the index and mass distributions - final :: collision_final_impactors !! Finalizer will deallocate all allocatables + final :: collision_final_impactors !! Finalizer will deallocate all allocatables end type collision_impactors @@ -353,7 +353,7 @@ end subroutine collision_util_set_coordinate_system module subroutine collision_setup_system(self, nbody_system) implicit none - class(collision_merge), intent(inout) :: self !! Encounter collision system object + class(collision_merge), intent(inout) :: self !! Encounter collision system object class(base_nbody_system), intent(in) :: nbody_system !! Current nbody system. Used as a mold for the before/after snapshots end subroutine collision_setup_system diff --git a/src/collision/collision_util.f90 b/src/collision/collision_util.f90 index 4474544c1..9338597a3 100644 --- a/src/collision/collision_util.f90 +++ b/src/collision/collision_util.f90 @@ -351,8 +351,16 @@ module subroutine collision_util_reset_system(self) ! Arguments class(collision_merge), intent(inout) :: self !! Collision system object - if (allocated(self%before)) deallocate(self%before) - if (allocated(self%after)) deallocate(self%after) + select type(before => self%before) + class is (swiftest_nbody_system) + if (allocated(before%pl)) deallocate(before%pl) + if (allocated(before%tp)) deallocate(before%tp) + end select + select type(after => self%after) + class is (swiftest_nbody_system) + if (allocated(after%pl)) deallocate(after%pl) + if (allocated(after%tp)) deallocate(after%tp) + end select self%Lorbit(:,:) = 0.0_DP self%Lspin(:,:) = 0.0_DP @@ -486,7 +494,7 @@ module subroutine collision_util_snapshot(self, param, nbody_system, t, arg) character(*), intent(in), optional :: arg !! "before": takes a snapshot just before the collision. "after" takes the snapshot just after the collision. ! Arguments class(collision_snapshot), allocatable :: snapshot - class(swiftest_pl), allocatable :: pl + class(swiftest_pl), allocatable :: pl character(len=:), allocatable :: stage if (present(arg)) then @@ -515,7 +523,7 @@ module subroutine collision_util_snapshot(self, param, nbody_system, t, arg) pl%info(:) = nbody_system%pl%info(idx(:)) select type (before => nbody_system%collider%before) class is (swiftest_nbody_system) - allocate(before%pl, source=pl) + call move_alloc(pl, before%pl) end select end associate case("after") From 3ccde0ba37549487513488160cfac919b1bfe9c2 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Thu, 22 Dec 2022 20:07:50 -0500 Subject: [PATCH 496/569] Fixed bug that kept encounter data from being written --- src/encounter/encounter_io.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/encounter/encounter_io.f90 b/src/encounter/encounter_io.f90 index 4b572af9d..b26516ef5 100644 --- a/src/encounter/encounter_io.f90 +++ b/src/encounter/encounter_io.f90 @@ -173,7 +173,7 @@ module subroutine encounter_io_netcdf_write_frame_snapshot(self, history, param) select type(pl => self%pl) class is (swiftest_pl) select type(tp => self%tp) - class is (swiftest_pl) + class is (swiftest_tp) select type (nc => history%nc) class is (encounter_netcdf_parameters) associate(tslot => param%ioutput) From 45b1064c09c68931e7b9816177b957690b8069c5 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Thu, 22 Dec 2022 20:08:16 -0500 Subject: [PATCH 497/569] Fixed bug that was causing the data.nc file to be closed before we were ready --- src/collision/collision_resolve.f90 | 7 ++----- src/fraggle/fraggle_generate.f90 | 6 +++--- src/swiftest/swiftest_io.f90 | 5 +++-- 3 files changed, 8 insertions(+), 10 deletions(-) diff --git a/src/collision/collision_resolve.f90 b/src/collision/collision_resolve.f90 index d7eff07eb..4dbfc4ea1 100644 --- a/src/collision/collision_resolve.f90 +++ b/src/collision/collision_resolve.f90 @@ -493,7 +493,6 @@ module subroutine collision_resolve_plpl(self, nbody_system, param, t, dt, irec) real(DP) :: Eorbit_before, Eorbit_after logical :: lplpl_collision character(len=STRMAX) :: timestr - class(swiftest_parameters), allocatable :: tmp_param integer(I4B), dimension(2) :: idx_parent !! Index of the two bodies considered the "parents" of the collision logical :: lgoodcollision integer(I4B) :: i, loop, ncollisions @@ -533,7 +532,6 @@ module subroutine collision_resolve_plpl(self, nbody_system, param, t, dt, irec) trim(adjustl(timestr))) call swiftest_io_log_one_message(COLLISION_LOG_OUT, "***********************************************************" // & "***********************************************************") - allocate(tmp_param, source=param) do i = 1, ncollisions idx_parent(1) = pl%kin(idx1(i))%parent @@ -555,15 +553,14 @@ module subroutine collision_resolve_plpl(self, nbody_system, param, t, dt, irec) if ((nbody_system%pl_adds%nbody == 0) .and. (nbody_system%pl_discards%nbody == 0)) exit ! Save the add/discard information to file - call nbody_system%write_discard(tmp_param) + call nbody_system%write_discard(param) ! Rearrange the arrays: Remove discarded bodies, add any new bodies, resort, and recompute all indices and encounter lists - call pl%rearray(nbody_system, tmp_param) + call pl%rearray(nbody_system, param) ! Destroy the add/discard list so that we don't append the same body multiple times if another collision is detected call nbody_system%pl_discards%setup(0, param) call nbody_system%pl_adds%setup(0, param) - deallocate(tmp_param) ! Check whether or not any of the particles that were just added are themselves in a collision state. This will generate a new plpl_collision call plpl_encounter%collision_check(nbody_system, param, t, dt, irec, lplpl_collision) diff --git a/src/fraggle/fraggle_generate.f90 b/src/fraggle/fraggle_generate.f90 index d7d3766a0..fa3a9d2a6 100644 --- a/src/fraggle/fraggle_generate.f90 +++ b/src/fraggle/fraggle_generate.f90 @@ -25,7 +25,7 @@ module subroutine fraggle_generate_disruption(collider, nbody_system, param, t) !! implicit none ! Arguments - class(collision_fraggle), intent(inout) :: collider + class(collision_fraggle), intent(inout) :: collider class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions real(DP), intent(in) :: t !! Time of collision @@ -102,7 +102,7 @@ module subroutine fraggle_generate_hitandrun(collider, nbody_system, param, t) !! implicit none ! Arguments - class(collision_fraggle), intent(inout) :: collider !! Fraggle collision system object + class(collision_fraggle), intent(inout) :: collider !! Fraggle collision system object class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions real(DP), intent(in) :: t !! Time of collision @@ -180,7 +180,7 @@ end subroutine fraggle_generate_hitandrun module subroutine fraggle_generate_system(self, nbody_system, param, t) implicit none - class(collision_fraggle), intent(inout) :: self !! Fraggle fragment nbody_system object + class(collision_fraggle), intent(inout) :: self !! Fraggle fragment nbody_system object class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(base_parameters), intent(inout) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! The time of the collision diff --git a/src/swiftest/swiftest_io.f90 b/src/swiftest/swiftest_io.f90 index d3fbb229e..55360c7ca 100644 --- a/src/swiftest/swiftest_io.f90 +++ b/src/swiftest/swiftest_io.f90 @@ -2049,8 +2049,9 @@ module subroutine swiftest_io_param_reader(self, unit, iotype, v_list, iostat, i param%GU = GC / (param%DU2M**3 / (param%MU2KG * param%TU2S**2)) - ! All reporting of collision information in SyMBA (including mergers) is now recorded in the Fraggle logfile - call swiftest_io_log_start(param, COLLISION_LOG_OUT, "Fraggle logfile") + ! A minimal log of collision outcomes is stored in the following log file + ! More complete data on collisions is stored in the NetCDF output files + call swiftest_io_log_start(param, COLLISION_LOG_OUT, "Collision logfile") if ((param%encounter_save /= "NONE") .and. & (param%encounter_save /= "TRAJECTORY") .and. & From 26d0bbbe19fa6313a03d375682777f54762441fd Mon Sep 17 00:00:00 2001 From: David A Minton Date: Thu, 22 Dec 2022 20:41:22 -0500 Subject: [PATCH 498/569] Fixed typo that kept helio from being run --- src/swiftest/swiftest_io.f90 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/swiftest/swiftest_io.f90 b/src/swiftest/swiftest_io.f90 index 55360c7ca..68e34e33b 100644 --- a/src/swiftest/swiftest_io.f90 +++ b/src/swiftest/swiftest_io.f90 @@ -345,13 +345,13 @@ module subroutine swiftest_io_get_args(integrator, param_file_name, display_styl else if (narg >= 2) then call swiftest_io_toupper(arg(1)) select case(arg(1)) - case('INT_BS') + case('BS') integrator = INT_BS - case('INT_HELIO') + case('HELIO') integrator = INT_HELIO - case('INT_RA15') + case('RA15') integrator = INT_RA15 - case('INT_TU4') + case('TU4') integrator = INT_TU4 case('WHM') integrator = INT_WHM From c1964db1f70b0f1d86510d76fbedd0e40e0b38b9 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Thu, 22 Dec 2022 20:43:24 -0500 Subject: [PATCH 499/569] Fixed allocation bug --- src/swiftest/swiftest_io.f90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/swiftest/swiftest_io.f90 b/src/swiftest/swiftest_io.f90 index 68e34e33b..343da3be6 100644 --- a/src/swiftest/swiftest_io.f90 +++ b/src/swiftest/swiftest_io.f90 @@ -265,8 +265,8 @@ module subroutine swiftest_io_dump_system(self, param) if (idx > NDUMPFILES) idx = 1 ! Dump the encounter history if necessary - if (param%lenc_save_trajectory .or. param%lenc_save_closest) call self%encounter_history%dump(param) - call self%collision_history%dump(param) + if (param%lenc_save_trajectory .or. param%lenc_save_closest .and. allocated(self%encounter_history)) call self%encounter_history%dump(param) + if (allocated(self%collision_history)) call self%collision_history%dump(param) ! Dump the nbody_system history to file call param%system_history%dump(param) From 65f81a8047e8816826ebc55e1666789d2f4b08c6 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Thu, 22 Dec 2022 20:53:56 -0500 Subject: [PATCH 500/569] Fixed bug in closest approach computation --- src/collision/collision_check.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/collision/collision_check.f90 b/src/collision/collision_check.f90 index fcf25f8e0..eb5c26f8d 100644 --- a/src/collision/collision_check.f90 +++ b/src/collision/collision_check.f90 @@ -114,7 +114,7 @@ module subroutine collision_check_plpl(self, nbody_system, param, t, dt, irec, l end do lany_collision = any(lcollision(:)) - !lany_closest = (param%lenc_save_closest .and. any(self%lclosest(:))) + lany_closest = (param%lenc_save_closest .and. any(self%lclosest(:))) if (lany_collision .or. lany_closest) then From b231e3a201cae218b4bfee5bcfc082d57474e636 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Thu, 22 Dec 2022 23:03:16 -0500 Subject: [PATCH 501/569] Fixing bugs in Fraggle --- examples/Fragmentation/Fragmentation_Movie.py | 2 +- src/fraggle/fraggle_generate.f90 | 1 - src/fraggle/fraggle_setup.f90 | 4 ++-- 3 files changed, 3 insertions(+), 4 deletions(-) diff --git a/examples/Fragmentation/Fragmentation_Movie.py b/examples/Fragmentation/Fragmentation_Movie.py index b8fd8217a..374574e9c 100644 --- a/examples/Fragmentation/Fragmentation_Movie.py +++ b/examples/Fragmentation/Fragmentation_Movie.py @@ -206,7 +206,7 @@ def data_stream(self, frame=0): # Set fragmentation parameters minimum_fragment_gmass = 0.2 * body_Gmass[style][1] # Make the minimum fragment mass a fraction of the smallest body gmtiny = 0.99 * body_Gmass[style][1] # Make GMTINY just smaller than the smallest original body. This will prevent runaway collisional cascades - sim.set_parameter(collision_model="bounce", encounter_save="both", gmtiny=gmtiny, minimum_fragment_gmass=minimum_fragment_gmass, verbose=False) + sim.set_parameter(collision_model="fraggle", encounter_save="both", gmtiny=gmtiny, minimum_fragment_gmass=minimum_fragment_gmass, verbose=False) sim.run(dt=1e-3, tstop=1.0e-3, istep_out=1, dump_cadence=0) print("Generating animation") diff --git a/src/fraggle/fraggle_generate.f90 b/src/fraggle/fraggle_generate.f90 index fa3a9d2a6..fe27bc9fd 100644 --- a/src/fraggle/fraggle_generate.f90 +++ b/src/fraggle/fraggle_generate.f90 @@ -252,7 +252,6 @@ module subroutine fraggle_generate_fragments(collider, nbody_system, param, lfai return end if - ! This is a factor that will "distort" the shape of the frgment cloud in the direction of the impact velocity f_spin= .mag. (runit(:) .cross. vunit(:)) diff --git a/src/fraggle/fraggle_setup.f90 b/src/fraggle/fraggle_setup.f90 index 65e48718a..534924c74 100644 --- a/src/fraggle/fraggle_setup.f90 +++ b/src/fraggle/fraggle_setup.f90 @@ -22,8 +22,8 @@ module subroutine fraggle_setup_fragments_system(self, nfrag) integer(I4B), intent(in) :: nfrag !! Number of fragments to create if (allocated(self%fragments)) deallocate(self%fragments) - allocate(fraggle_fragments(nfrag) :: self%fragments) - + allocate(fraggle_fragments(nbody=nfrag) :: self%fragments) + self%fragments%nbody = nfrag return end subroutine fraggle_setup_fragments_system From d54cb62247dd0fd4109550db9d647ee5ecec15d6 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Fri, 23 Dec 2022 06:10:56 -0500 Subject: [PATCH 502/569] Restructured a bit so that the fragment SFD generator is in the main collision module, not Fraggle --- src/collision/collision_generate.f90 | 2 +- src/collision/collision_module.f90 | 19 ++-- src/collision/collision_setup.f90 | 2 +- src/collision/collision_util.f90 | 136 +++++++++++++++++++++++++++ src/fraggle/fraggle_module.f90 | 23 ++--- src/fraggle/fraggle_set.f90 | 136 --------------------------- src/fraggle/fraggle_setup.f90 | 1 + src/swiftest/swiftest_setup.f90 | 2 +- 8 files changed, 159 insertions(+), 162 deletions(-) diff --git a/src/collision/collision_generate.f90 b/src/collision/collision_generate.f90 index 421cf0558..59b78fb26 100644 --- a/src/collision/collision_generate.f90 +++ b/src/collision/collision_generate.f90 @@ -219,7 +219,7 @@ end subroutine collision_generate_bounce module subroutine collision_generate_simple(self, nbody_system, param, t) implicit none - class(collision_simple), intent(inout) :: self !! Simple fragment system object + class(collision_simple_disruption), intent(inout) :: self !! Simple fragment system object class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(base_parameters), intent(inout) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! The time of the collision diff --git a/src/collision/collision_module.f90 b/src/collision/collision_module.f90 index 7b8331d1b..98463fb93 100644 --- a/src/collision/collision_module.f90 +++ b/src/collision/collision_module.f90 @@ -147,11 +147,12 @@ module collision final :: collision_final_bounce !! Finalizer will deallocate all allocatables end type collision_bounce - type, extends(collision_merge) :: collision_simple + type, extends(collision_merge) :: collision_simple_disruption contains - procedure :: generate => collision_generate_simple !! If a collision would result in a disruption [TODO: SOMETHING LIKE CHAMBERS 2012] - final :: collision_final_simple !! Finalizer will deallocate all allocatables - end type collision_simple + procedure :: generate => collision_generate_simple !! If a collision would result in a disruption [TODO: SOMETHING LIKE CHAMBERS 2012] + procedure :: set_mass_dist => collision_util_set_mass_dist !! Sets the distribution of mass among the fragments depending on the regime type + final :: collision_final_simple !! Finalizer will deallocate all allocatables + end type collision_simple_disruption !! NetCDF dimension and variable names for the enounter save object @@ -224,7 +225,7 @@ end subroutine collision_generate_bounce module subroutine collision_generate_simple(self, nbody_system, param, t) implicit none - class(collision_simple), intent(inout) :: self !! Simple fragment nbody_system object + class(collision_simple_disruption), intent(inout) :: self !! Simple fragment nbody_system object class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(base_parameters), intent(inout) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! The time of the collision @@ -389,6 +390,12 @@ module subroutine collision_util_reset_fragments(self) class(collision_fragments(*)), intent(inout) :: self end subroutine collision_util_reset_fragments + module subroutine collision_util_set_mass_dist(self, param) + implicit none + class(collision_simple_disruption), intent(inout) :: self !! Simple disruption collision object + class(base_parameters), intent(in) :: param !! Current Swiftest run configuration parameters + end subroutine collision_util_set_mass_dist + module subroutine collision_util_get_idvalues_snapshot(self, idvals) implicit none class(collision_snapshot), intent(in) :: self !! Collision snapshot object @@ -554,7 +561,7 @@ subroutine collision_final_simple(self) !! Finalizer will deallocate all allocatables implicit none ! Arguments - type(collision_simple), intent(inout) :: self !! Collision system object + type(collision_simple_disruption), intent(inout) :: self !! Collision system object call self%reset() if (allocated(self%impactors)) deallocate(self%impactors) diff --git a/src/collision/collision_setup.f90 b/src/collision/collision_setup.f90 index 5b621a44f..2c4880cb0 100644 --- a/src/collision/collision_setup.f90 +++ b/src/collision/collision_setup.f90 @@ -58,11 +58,11 @@ module subroutine collision_setup_fragments_system(self, nfrag) if (allocated(self%fragments)) deallocate(self%fragments) allocate(collision_fragments(nfrag) :: self%fragments) + self%fragments%nbody = nfrag return end subroutine collision_setup_fragments_system - end submodule s_collision_setup \ No newline at end of file diff --git a/src/collision/collision_util.f90 b/src/collision/collision_util.f90 index 9338597a3..410090107 100644 --- a/src/collision/collision_util.f90 +++ b/src/collision/collision_util.f90 @@ -435,6 +435,142 @@ module subroutine collision_util_set_coordinate_system(self) end subroutine collision_util_set_coordinate_system + module subroutine collision_util_set_mass_dist(self, param) + !! author: David A. Minton + !! + !! Sets the mass of fragments based on the mass distribution returned by the regime calculation. + !! This subroutine must be run after the the setup routine has been run on the fragments + !! + implicit none + ! Arguments + class(collision_simple_disruption), intent(inout) :: self !! Fraggle collision system object + class(base_parameters), intent(in) :: param !! Current Swiftest run configuration parameters + ! Internals + integer(I4B) :: i, jproj, jtarg, nfrag, istart + real(DP), dimension(2) :: volume + real(DP), dimension(NDIM) :: Ip_avg + real(DP) :: mfrag, mremaining, min_mfrag, mtot + real(DP), parameter :: BETA = 2.85_DP + integer(I4B), parameter :: NFRAGMAX = 100 !! Maximum number of fragments that can be generated + integer(I4B), parameter :: NFRAGMIN = 7 !! Minimum number of fragments that can be generated (set by the fraggle_generate algorithm for constraining momentum and energy) + integer(I4B), parameter :: NFRAG_SIZE_MULTIPLIER = 3 !! Log-space scale factor that scales the number of fragments by the collisional system mass + integer(I4B), parameter :: iMlr = 1 + integer(I4B), parameter :: iMslr = 2 + integer(I4B), parameter :: iMrem = 3 + + associate(impactors => self%impactors) + ! Get mass weighted mean of Ip and density + volume(1:2) = 4._DP / 3._DP * PI * impactors%radius(1:2)**3 + mtot = sum(impactors%mass(:)) + Ip_avg(:) = (impactors%mass(1) * impactors%Ip(:,1) + impactors%mass(2) * impactors%Ip(:,2)) / mtot + + if (impactors%mass(1) > impactors%mass(2)) then + jtarg = 1 + jproj = 2 + else + jtarg = 2 + jproj = 1 + end if + + select case(impactors%regime) + case(COLLRESOLVE_REGIME_DISRUPTION, COLLRESOLVE_REGIME_SUPERCATASTROPHIC, COLLRESOLVE_REGIME_HIT_AND_RUN) + ! The first two bins of the mass_dist are the largest and second-largest fragments that came out of collision_regime. + ! The remainder from the third bin will be distributed among nfrag-2 bodies. The following code will determine nfrag based on + ! the limits bracketed above and the model size distribution of fragments. + ! Check to see if our size distribution would give us a smaller number of fragments than the maximum number + + select type(param) + class is (swiftest_parameters) + min_mfrag = (param%min_GMfrag / param%GU) + ! The number of fragments we generate is bracked by the minimum required by fraggle_generate (7) and the + ! maximum set by the NFRAG_SIZE_MULTIPLIER which limits the total number of fragments to prevent the nbody + ! code from getting an overwhelmingly large number of fragments + nfrag = ceiling(NFRAG_SIZE_MULTIPLIER * log(mtot / min_mfrag)) + nfrag = max(min(nfrag, NFRAGMAX), NFRAGMIN) + class default + min_mfrag = 0.0_DP + nfrag = NFRAGMAX + end select + + i = iMrem + mremaining = impactors%mass_dist(iMrem) + do while (i <= nfrag) + mfrag = (1 + i - iMslr)**(-3._DP / BETA) * impactors%mass_dist(iMslr) + if (mremaining - mfrag < 0.0_DP) exit + mremaining = mremaining - mfrag + i = i + 1 + end do + if (i < nfrag) nfrag = max(i, NFRAGMIN) ! The sfd would actually give us fewer fragments than our maximum + call self%setup_fragments(nfrag) + + case (COLLRESOLVE_REGIME_MERGE, COLLRESOLVE_REGIME_GRAZE_AND_MERGE) + + call self%setup_fragments(1) + select type(fragments => self%fragments) + class is (collision_fragments(*)) + fragments%mass(1) = impactors%mass_dist(1) + fragments%radius(1) = impactors%radius(jtarg) + fragments%density(1) = impactors%mass_dist(1) / volume(jtarg) + if (param%lrotation) fragments%Ip(:, 1) = impactors%Ip(:,1) + end select + return + case default + write(*,*) "collision_util_set_mass_dist_fragments error: Unrecognized regime code",impactors%regime + end select + + select type(fragments => self%fragments) + class is (collision_fragments(*)) + fragments%mtot = mtot + + ! Make the first two bins the same as the Mlr and Mslr values that came from collision_regime + fragments%mass(1) = impactors%mass_dist(iMlr) + fragments%mass(2) = impactors%mass_dist(iMslr) + + ! Distribute the remaining mass the 3:nfrag bodies following the model SFD given by slope BETA + mremaining = impactors%mass_dist(iMrem) + do i = iMrem, nfrag + mfrag = (1 + i - iMslr)**(-3._DP / BETA) * impactors%mass_dist(iMslr) + fragments%mass(i) = mfrag + mremaining = mremaining - mfrag + end do + + ! If there is any residual mass (either positive or negative) we will distribute remaining mass proportionally among the the fragments + if (mremaining < 0.0_DP) then ! If the remainder is negative, this means that that the number of fragments required by the SFD is smaller than our lower limit set by fraggle_generate. + istart = iMrem ! We will reduce the mass of the 3:nfrag bodies to prevent the second-largest fragment from going smaller + else ! If the remainder is postiive, this means that the number of fragments required by the SFD is larger than our upper limit set by computational expediency. + istart = iMslr ! We will increase the mass of the 2:nfrag bodies to compensate, which ensures that the second largest fragment remains the second largest + end if + mfrag = 1._DP + mremaining / sum(fragments%mass(istart:nfrag)) + fragments%mass(istart:nfrag) = fragments%mass(istart:nfrag) * mfrag + + ! There may still be some small residual due to round-off error. If so, simply add it to the last bin of the mass distribution. + mremaining = fragments%mtot - sum(fragments%mass(1:nfrag)) + fragments%mass(nfrag) = fragments%mass(nfrag) + mremaining + + ! Compute physical properties of the new fragments + select case(impactors%regime) + case(COLLRESOLVE_REGIME_HIT_AND_RUN) ! The hit and run case always preserves the largest body intact, so there is no need to recompute the physical properties of the first fragment + fragments%radius(1) = impactors%radius(jtarg) + fragments%density(1) = impactors%mass_dist(iMlr) / volume(jtarg) + fragments%Ip(:, 1) = impactors%Ip(:,1) + istart = 2 + case default + istart = 1 + end select + + fragments%density(istart:nfrag) = fragments%mtot / sum(volume(:)) + fragments%radius(istart:nfrag) = (3 * fragments%mass(istart:nfrag) / (4 * PI * fragments%density(istart:nfrag)))**(1.0_DP / 3.0_DP) + do i = istart, nfrag + fragments%Ip(:, i) = Ip_avg(:) + end do + + end select + end associate + + return + end subroutine collision_util_set_mass_dist + + subroutine collision_util_save_snapshot(collision_history, snapshot) !! author: David A. Minton !! diff --git a/src/fraggle/fraggle_module.f90 b/src/fraggle/fraggle_module.f90 index 83aaee06b..2471b9975 100644 --- a/src/fraggle/fraggle_module.f90 +++ b/src/fraggle/fraggle_module.f90 @@ -15,10 +15,8 @@ module fraggle implicit none public - !> Class definition for the variables that describe a collection of fragments by Fraggle barycentric coordinates type, extends(collision_fragments) :: fraggle_fragments - real(DP), dimension(nbody) :: v_r_mag !! Array of radial direction velocity magnitudes of individual fragments real(DP), dimension(nbody) :: v_t_mag !! Array of tangential direction velocity magnitudes of individual fragments real(DP), dimension(nbody) :: v_n_mag !! Array of normal direction velocity magnitudes of individual fragments @@ -28,16 +26,15 @@ module fraggle real(DP) :: ke_spin !! Spin kinetic energy of all fragments real(DP) :: ke_budget !! Kinetic energy budget for computing fragment trajectories real(DP), dimension(NDIM) :: L_budget !! Angular momentum budget for computing fragment trajectories - contains - procedure :: get_angular_momentum => fraggle_util_get_angular_momentum !! Calcualtes the current angular momentum of the fragments - procedure :: reset => fraggle_util_reset_fragments !! Resets all position and velocity-dependent fragment quantities in order to do a fresh calculation (does not reset mass, radius, or other values that get set prior to the call to fraggle_generate) - procedure :: restructure => fraggle_util_restructure !! Restructure the inputs after a failed attempt failed to find a set of positions and velocities that satisfy the energy and momentum constraints - final :: fraggle_final_fragments !! Finalizer will deallocate all allocatables + procedure :: get_angular_momentum => fraggle_util_get_angular_momentum !! Calcualtes the current angular momentum of the fragments + procedure :: reset => fraggle_util_reset_fragments !! Resets all position and velocity-dependent fragment quantities in order to do a fresh calculation (does not reset mass, radius, or other values that get set prior to the call to fraggle_generate) + procedure :: restructure => fraggle_util_restructure !! Restructure the inputs after a failed attempt failed to find a set of positions and velocities that satisfy the energy and momentum constraints + final :: fraggle_final_fragments !! Finalizer will deallocate all allocatables end type fraggle_fragments - type, extends(collision_merge) :: collision_fraggle + type, extends(collision_simple_disruption) :: collision_fraggle ! Scale factors used to scale dimensioned quantities to a more "natural" system where important quantities (like kinetic energy, momentum) are of order ~1 real(DP) :: dscale = 1.0_DP !! Distance dimension scale factor real(DP) :: mscale = 1.0_DP !! Mass scale factor @@ -48,13 +45,12 @@ module fraggle contains procedure :: generate => fraggle_generate_system !! Generates a system of fragments in barycentric coordinates that conserves energy and momentum. procedure :: set_budgets => fraggle_set_budgets !! Sets the energy and momentum budgets of the fragments based on the collider value - procedure :: set_mass_dist => fraggle_set_mass_dist !! Sets the distribution of mass among the fragments depending on the regime type procedure :: set_natural_scale => fraggle_set_natural_scale_factors !! Scales dimenional quantities to ~O(1) with respect to the collisional system. procedure :: set_original_scale => fraggle_set_original_scale_factors !! Restores dimenional quantities back to the original system units procedure :: setup_fragments => fraggle_setup_fragments_system !! Initializer for the fragments of the collision system. procedure :: construct_temporary_system => fraggle_util_construct_temporary_system !! Constructs temporary n-body system in order to compute pre- and post-impact energy and momentum procedure :: reset => fraggle_util_reset_system !! Deallocates all allocatables - final :: fraggle_final_system !! Finalizer will deallocate all allocatables + final :: fraggle_final_system !! Finalizer will deallocate all allocatables end type collision_fraggle @@ -98,12 +94,6 @@ module subroutine fraggle_set_budgets(self) class(collision_fraggle), intent(inout) :: self !! Fraggle collision system object end subroutine fraggle_set_budgets - module subroutine fraggle_set_mass_dist(self, param) - implicit none - class(collision_fraggle), intent(inout) :: self !! Fraggle collision system object - class(swiftest_parameters), intent(in) :: param !! Current Swiftest run configuration parameters - end subroutine fraggle_set_mass_dist - module subroutine fraggle_set_natural_scale_factors(self) implicit none class(collision_fraggle), intent(inout) :: self !! Fraggle collision system object @@ -176,7 +166,6 @@ end function fraggle_util_vmag_to_vb end interface contains - subroutine fraggle_final_fragments(self) !! author: David A. Minton diff --git a/src/fraggle/fraggle_set.f90 b/src/fraggle/fraggle_set.f90 index 21ba46588..03f2e5e88 100644 --- a/src/fraggle/fraggle_set.f90 +++ b/src/fraggle/fraggle_set.f90 @@ -40,142 +40,6 @@ module subroutine fraggle_set_budgets(self) end subroutine fraggle_set_budgets - module subroutine fraggle_set_mass_dist(self, param) - !! author: David A. Minton - !! - !! Sets the mass of fragments based on the mass distribution returned by the regime calculation. - !! This subroutine must be run after the the setup routine has been run on the fragments - !! - implicit none - ! Arguments - class(collision_fraggle), intent(inout) :: self !! Fraggle collision system object - class(swiftest_parameters), intent(in) :: param !! Current Swiftest run configuration parameters - ! Internals - integer(I4B) :: i, jproj, jtarg, nfrag, istart - real(DP), dimension(2) :: volume - real(DP), dimension(NDIM) :: Ip_avg - real(DP) :: mfrag, mremaining, min_mfrag, mtot - real(DP), parameter :: BETA = 2.85_DP - integer(I4B), parameter :: NFRAGMAX = 100 !! Maximum number of fragments that can be generated - integer(I4B), parameter :: NFRAGMIN = 7 !! Minimum number of fragments that can be generated (set by the fraggle_generate algorithm for constraining momentum and energy) - integer(I4B), parameter :: NFRAG_SIZE_MULTIPLIER = 3 !! Log-space scale factor that scales the number of fragments by the collisional system mass - integer(I4B), parameter :: iMlr = 1 - integer(I4B), parameter :: iMslr = 2 - integer(I4B), parameter :: iMrem = 3 - - associate(impactors => self%impactors) - ! Get mass weighted mean of Ip and density - volume(1:2) = 4._DP / 3._DP * PI * impactors%radius(1:2)**3 - mtot = sum(impactors%mass(:)) - Ip_avg(:) = (impactors%mass(1) * impactors%Ip(:,1) + impactors%mass(2) * impactors%Ip(:,2)) / mtot - - if (impactors%mass(1) > impactors%mass(2)) then - jtarg = 1 - jproj = 2 - else - jtarg = 2 - jproj = 1 - end if - - select case(impactors%regime) - case(COLLRESOLVE_REGIME_DISRUPTION, COLLRESOLVE_REGIME_SUPERCATASTROPHIC, COLLRESOLVE_REGIME_HIT_AND_RUN) - ! The first two bins of the mass_dist are the largest and second-largest fragments that came out of collision_regime. - ! The remainder from the third bin will be distributed among nfrag-2 bodies. The following code will determine nfrag based on - ! the limits bracketed above and the model size distribution of fragments. - ! Check to see if our size distribution would give us a smaller number of fragments than the maximum number - - select type(param) - class is (swiftest_parameters) - min_mfrag = (param%min_GMfrag / param%GU) - ! The number of fragments we generate is bracked by the minimum required by fraggle_generate (7) and the - ! maximum set by the NFRAG_SIZE_MULTIPLIER which limits the total number of fragments to prevent the nbody - ! code from getting an overwhelmingly large number of fragments - nfrag = ceiling(NFRAG_SIZE_MULTIPLIER * log(mtot / min_mfrag)) - nfrag = max(min(nfrag, NFRAGMAX), NFRAGMIN) - class default - min_mfrag = 0.0_DP - nfrag = NFRAGMAX - end select - - i = iMrem - mremaining = impactors%mass_dist(iMrem) - do while (i <= nfrag) - mfrag = (1 + i - iMslr)**(-3._DP / BETA) * impactors%mass_dist(iMslr) - if (mremaining - mfrag < 0.0_DP) exit - mremaining = mremaining - mfrag - i = i + 1 - end do - if (i < nfrag) nfrag = max(i, NFRAGMIN) ! The sfd would actually give us fewer fragments than our maximum - call self%setup_fragments(nfrag) - - case (COLLRESOLVE_REGIME_MERGE, COLLRESOLVE_REGIME_GRAZE_AND_MERGE) - - call self%setup_fragments(1) - select type(fragments => self%fragments) - class is (fraggle_fragments(*)) - fragments%mass(1) = impactors%mass_dist(1) - fragments%radius(1) = impactors%radius(jtarg) - fragments%density(1) = impactors%mass_dist(1) / volume(jtarg) - if (param%lrotation) fragments%Ip(:, 1) = impactors%Ip(:,1) - end select - return - case default - write(*,*) "fraggle_set_mass_dist_fragments error: Unrecognized regime code",impactors%regime - end select - - select type(fragments => self%fragments) - class is (fraggle_fragments(*)) - fragments%mtot = mtot - - ! Make the first two bins the same as the Mlr and Mslr values that came from collision_regime - fragments%mass(1) = impactors%mass_dist(iMlr) - fragments%mass(2) = impactors%mass_dist(iMslr) - - ! Distribute the remaining mass the 3:nfrag bodies following the model SFD given by slope BETA - mremaining = impactors%mass_dist(iMrem) - do i = iMrem, nfrag - mfrag = (1 + i - iMslr)**(-3._DP / BETA) * impactors%mass_dist(iMslr) - fragments%mass(i) = mfrag - mremaining = mremaining - mfrag - end do - - ! If there is any residual mass (either positive or negative) we will distribute remaining mass proportionally among the the fragments - if (mremaining < 0.0_DP) then ! If the remainder is negative, this means that that the number of fragments required by the SFD is smaller than our lower limit set by fraggle_generate. - istart = iMrem ! We will reduce the mass of the 3:nfrag bodies to prevent the second-largest fragment from going smaller - else ! If the remainder is postiive, this means that the number of fragments required by the SFD is larger than our upper limit set by computational expediency. - istart = iMslr ! We will increase the mass of the 2:nfrag bodies to compensate, which ensures that the second largest fragment remains the second largest - end if - mfrag = 1._DP + mremaining / sum(fragments%mass(istart:nfrag)) - fragments%mass(istart:nfrag) = fragments%mass(istart:nfrag) * mfrag - - ! There may still be some small residual due to round-off error. If so, simply add it to the last bin of the mass distribution. - mremaining = fragments%mtot - sum(fragments%mass(1:nfrag)) - fragments%mass(nfrag) = fragments%mass(nfrag) + mremaining - - ! Compute physical properties of the new fragments - select case(impactors%regime) - case(COLLRESOLVE_REGIME_HIT_AND_RUN) ! The hit and run case always preserves the largest body intact, so there is no need to recompute the physical properties of the first fragment - fragments%radius(1) = impactors%radius(jtarg) - fragments%density(1) = impactors%mass_dist(iMlr) / volume(jtarg) - fragments%Ip(:, 1) = impactors%Ip(:,1) - istart = 2 - case default - istart = 1 - end select - - fragments%density(istart:nfrag) = fragments%mtot / sum(volume(:)) - fragments%radius(istart:nfrag) = (3 * fragments%mass(istart:nfrag) / (4 * PI * fragments%density(istart:nfrag)))**(1.0_DP / 3.0_DP) - do i = istart, nfrag - fragments%Ip(:, i) = Ip_avg(:) - end do - - end select - end associate - - return - end subroutine fraggle_set_mass_dist - - module subroutine fraggle_set_natural_scale_factors(self) !! author: David A. Minton !! diff --git a/src/fraggle/fraggle_setup.f90 b/src/fraggle/fraggle_setup.f90 index 534924c74..e54ca46fd 100644 --- a/src/fraggle/fraggle_setup.f90 +++ b/src/fraggle/fraggle_setup.f90 @@ -24,6 +24,7 @@ module subroutine fraggle_setup_fragments_system(self, nfrag) if (allocated(self%fragments)) deallocate(self%fragments) allocate(fraggle_fragments(nbody=nfrag) :: self%fragments) self%fragments%nbody = nfrag + return end subroutine fraggle_setup_fragments_system diff --git a/src/swiftest/swiftest_setup.f90 b/src/swiftest/swiftest_setup.f90 index ae7f0dc40..c693c96ed 100644 --- a/src/swiftest/swiftest_setup.f90 +++ b/src/swiftest/swiftest_setup.f90 @@ -121,7 +121,7 @@ module subroutine swiftest_setup_construct_system(nbody_system, param) case("BOUNCE") allocate(collision_bounce :: nbody_system%collider) case("SIMPLE") - allocate(collision_simple :: nbody_system%collider) + allocate(collision_simple_disruption :: nbody_system%collider) case("FRAGGLE") allocate(collision_fraggle :: nbody_system%collider) end select From 5e4bff866912c41098e60d2a2d5dce95b5e75d50 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Fri, 23 Dec 2022 06:31:56 -0500 Subject: [PATCH 503/569] Consolidated setup and util submodules --- src/CMakeLists.txt | 18 +- src/collision/collision_module.f90 | 20 +- src/collision/collision_setup.f90 | 68 --- src/collision/collision_util.f90 | 55 +- src/encounter/encounter_module.f90 | 12 +- src/encounter/encounter_setup.f90 | 108 ---- src/encounter/encounter_util.f90 | 93 ++++ src/fraggle/fraggle_module.f90 | 66 +-- src/fraggle/fraggle_set.f90 | 155 ------ src/fraggle/fraggle_setup.f90 | 31 -- src/fraggle/fraggle_util.f90 | 203 +++++++- src/helio/helio_module.f90 | 6 +- src/helio/{helio_setup.f90 => helio_util.f90} | 18 +- src/rmvs/rmvs_module.f90 | 118 +++-- src/rmvs/rmvs_setup.f90 | 166 ------ src/rmvs/rmvs_util.f90 | 226 +++++--- src/swiftest/swiftest_driver.f90 | 2 +- src/swiftest/swiftest_module.f90 | 36 +- src/swiftest/swiftest_setup.f90 | 385 -------------- src/swiftest/swiftest_util.f90 | 490 ++++++++++++++++-- src/symba/symba_module.f90 | 18 +- src/symba/symba_setup.f90 | 98 ---- src/symba/symba_util.f90 | 84 +++ src/whm/whm_module.f90 | 14 +- src/whm/whm_setup.f90 | 100 ---- src/whm/whm_util.f90 | 87 ++++ 26 files changed, 1274 insertions(+), 1403 deletions(-) delete mode 100644 src/collision/collision_setup.f90 delete mode 100644 src/encounter/encounter_setup.f90 delete mode 100644 src/fraggle/fraggle_set.f90 delete mode 100644 src/fraggle/fraggle_setup.f90 rename src/helio/{helio_setup.f90 => helio_util.f90} (72%) delete mode 100644 src/rmvs/rmvs_setup.f90 delete mode 100644 src/swiftest/swiftest_setup.f90 delete mode 100644 src/symba/symba_setup.f90 delete mode 100644 src/whm/whm_setup.f90 diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index 86ffe6ee3..adfde33c7 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -44,51 +44,43 @@ SET(FAST_MATH_FILES ${SRC}/collision/collision_io.f90 ${SRC}/collision/collision_regime.f90 ${SRC}/collision/collision_resolve.f90 - ${SRC}/collision/collision_setup.f90 ${SRC}/collision/collision_util.f90 ${SRC}/encounter/encounter_check.f90 ${SRC}/encounter/encounter_io.f90 - ${SRC}/encounter/encounter_setup.f90 ${SRC}/encounter/encounter_util.f90 ${SRC}/fraggle/fraggle_generate.f90 - ${SRC}/fraggle/fraggle_set.f90 - ${SRC}/fraggle/fraggle_setup.f90 ${SRC}/fraggle/fraggle_util.f90 ${SRC}/helio/helio_drift.f90 ${SRC}/helio/helio_gr.f90 - ${SRC}/helio/helio_setup.f90 ${SRC}/helio/helio_step.f90 + ${SRC}/helio/helio_util.f90 ${SRC}/netcdf_io/netcdf_io_implementations.f90 ${SRC}/operator/operator_cross.f90 ${SRC}/operator/operator_mag.f90 ${SRC}/operator/operator_unit.f90 ${SRC}/rmvs/rmvs_discard.f90 ${SRC}/rmvs/rmvs_encounter_check.f90 - ${SRC}/rmvs/rmvs_setup.f90 ${SRC}/rmvs/rmvs_step.f90 ${SRC}/rmvs/rmvs_util.f90 ${SRC}/swiftest/swiftest_discard.f90 - ${SRC}/swiftest/swiftest_io.f90 - ${SRC}/swiftest/swiftest_obl.f90 - ${SRC}/swiftest/swiftest_util.f90 ${SRC}/swiftest/swiftest_drift.f90 - ${SRC}/swiftest/swiftest_orbel.f90 ${SRC}/swiftest/swiftest_gr.f90 + ${SRC}/swiftest/swiftest_io.f90 ${SRC}/swiftest/swiftest_kick.f90 - ${SRC}/swiftest/swiftest_setup.f90 + ${SRC}/swiftest/swiftest_obl.f90 + ${SRC}/swiftest/swiftest_orbel.f90 + ${SRC}/swiftest/swiftest_util.f90 ${SRC}/symba/symba_discard.f90 ${SRC}/symba/symba_drift.f90 ${SRC}/symba/symba_encounter_check.f90 ${SRC}/symba/symba_gr.f90 ${SRC}/symba/symba_io.f90 - ${SRC}/symba/symba_setup.f90 ${SRC}/symba/symba_step.f90 ${SRC}/symba/symba_util.f90 ${SRC}/walltime/walltime_implementations.f90 ${SRC}/whm/whm_coord.f90 ${SRC}/whm/whm_drift.f90 ${SRC}/whm/whm_gr.f90 - ${SRC}/whm/whm_setup.f90 ${SRC}/whm/whm_step.f90 ${SRC}/whm/whm_util.f90 ${SRC}/swiftest/swiftest_driver.f90 diff --git a/src/collision/collision_module.f90 b/src/collision/collision_module.f90 index 98463fb93..40ef8b012 100644 --- a/src/collision/collision_module.f90 +++ b/src/collision/collision_module.f90 @@ -130,9 +130,9 @@ module collision real(DP), dimension(2) :: pe !! Before/after potential energy real(DP), dimension(2) :: Etot !! Before/after total nbody_system energy contains - procedure :: setup => collision_setup_system !! Initializer for the encounter collision system and the before/after snapshots - procedure :: setup_impactors => collision_setup_impactors_system !! Initializer for the impactors for the encounter collision system. Deallocates old impactors before creating new ones - procedure :: setup_fragments => collision_setup_fragments_system !! Initializer for the fragments of the collision system. + procedure :: setup => collision_util_setup_system !! Initializer for the encounter collision system and the before/after snapshots + procedure :: setup_impactors => collision_util_setup_impactors_system !! Initializer for the impactors for the encounter collision system. Deallocates old impactors before creating new ones + procedure :: setup_fragments => collision_util_setup_fragments_system !! Initializer for the fragments of the collision system. procedure :: add_fragments => collision_util_add_fragments_to_system !! Add fragments to nbody_system procedure :: construct_temporary_system => collision_util_construct_temporary_system !! Constructs temporary n-body nbody_system in order to compute pre- and post-impact energy and momentum procedure :: get_energy_and_momentum => collision_util_get_energy_momentum !! Calculates total nbody_system energy in either the pre-collision outcome state (lbefore = .true.) or the post-collision outcome state (lbefore = .false.) @@ -352,22 +352,22 @@ module subroutine collision_util_set_coordinate_system(self) class(collision_merge), intent(inout) :: self !! Collisional nbody_system end subroutine collision_util_set_coordinate_system - module subroutine collision_setup_system(self, nbody_system) + module subroutine collision_util_setup_system(self, nbody_system) implicit none class(collision_merge), intent(inout) :: self !! Encounter collision system object class(base_nbody_system), intent(in) :: nbody_system !! Current nbody system. Used as a mold for the before/after snapshots - end subroutine collision_setup_system + end subroutine collision_util_setup_system - module subroutine collision_setup_impactors_system(self) + module subroutine collision_util_setup_impactors_system(self) implicit none class(collision_merge), intent(inout) :: self !! Encounter collision system object - end subroutine collision_setup_impactors_system + end subroutine collision_util_setup_impactors_system - module subroutine collision_setup_fragments_system(self, nfrag) + module subroutine collision_util_setup_fragments_system(self, nfrag) implicit none class(collision_merge), intent(inout) :: self !! Encounter collision system object integer(I4B), intent(in) :: nfrag !! Number of fragments to create - end subroutine collision_setup_fragments_system + end subroutine collision_util_setup_fragments_system module subroutine collision_util_add_fragments_to_system(self, nbody_system, param) implicit none @@ -438,7 +438,6 @@ end subroutine collision_util_snapshot contains - subroutine collision_final_fragments(self) !! author: David A. Minton !! @@ -466,6 +465,7 @@ subroutine collision_final_impactors(self) return end subroutine collision_final_impactors + subroutine collision_final_netcdf_parameters(self) !! author: David A. Minton !! diff --git a/src/collision/collision_setup.f90 b/src/collision/collision_setup.f90 deleted file mode 100644 index 2c4880cb0..000000000 --- a/src/collision/collision_setup.f90 +++ /dev/null @@ -1,68 +0,0 @@ -!! Copyright 2022 - David Minton, Carlisle Wishard, Jennifer Pouplin, Jake Elliott, & Dana Singh -!! This file is part of Swiftest. -!! Swiftest is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License -!! as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. -!! Swiftest is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty -!! of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. -!! You should have received a copy of the GNU General Public License along with Swiftest. -!! If not, see: https://www.gnu.org/licenses. - -submodule (collision) s_collision_setup - use swiftest -contains - - module subroutine collision_setup_system(self, nbody_system) - !! author: David A. Minton - !! - !! Initializer for the encounter collision system. Sets up impactors and the before/after snapshots, - !! but not fragments. Those are setup later when the number of fragments is known. - implicit none - ! Arguments - class(collision_merge), intent(inout) :: self !! Encounter collision system object - class(base_nbody_system), intent(in) :: nbody_system !! Current nbody system. Used as a mold for the before/after snapshots - - call self%setup_impactors() - if (allocated(self%before)) deallocate(self%before) - if (allocated(self%after)) deallocate(self%after) - - allocate(self%before, mold=nbody_system) - allocate(self%after, mold=nbody_system) - - return - end subroutine collision_setup_system - - - module subroutine collision_setup_impactors_system(self) - !! author: David A. Minton - !! - !! Initializer for the impactors for the encounter collision system. Deallocates old impactors before creating new ones - implicit none - ! Arguments - class(collision_merge), intent(inout) :: self !! Encounter collision system object - - if (allocated(self%impactors)) deallocate(self%impactors) - allocate(collision_impactors :: self%impactors) - - return - end subroutine collision_setup_impactors_system - - - module subroutine collision_setup_fragments_system(self, nfrag) - !! author: David A. Minton - !! - !! Initializer for the fragments of the collision system. - implicit none - ! Arguments - class(collision_merge), intent(inout) :: self !! Encounter collision system object - integer(I4B), intent(in) :: nfrag !! Number of fragments to create - - if (allocated(self%fragments)) deallocate(self%fragments) - allocate(collision_fragments(nfrag) :: self%fragments) - self%fragments%nbody = nfrag - - return - end subroutine collision_setup_fragments_system - -end submodule s_collision_setup - - \ No newline at end of file diff --git a/src/collision/collision_util.f90 b/src/collision/collision_util.f90 index 410090107..62e275d24 100644 --- a/src/collision/collision_util.f90 +++ b/src/collision/collision_util.f90 @@ -88,7 +88,7 @@ module subroutine collision_util_construct_temporary_system(self, nbody_system, if (allocated(tmpparam)) deallocate(tmpparam) if (allocated(tmpsys)) deallocate(tmpsys) allocate(tmpparam, source=param) - call swiftest_setup_construct_system(tmpsys_local, tmpparam_local) + call swiftest_util_setup_construct_system(tmpsys_local, tmpparam_local) ! No test particles necessary for energy/momentum calcs call tmpsys_local%tp%setup(0, tmpparam_local) @@ -571,6 +571,59 @@ module subroutine collision_util_set_mass_dist(self, param) end subroutine collision_util_set_mass_dist + module subroutine collision_util_setup_system(self, nbody_system) + !! author: David A. Minton + !! + !! Initializer for the encounter collision system. Sets up impactors and the before/after snapshots, + !! but not fragments. Those are setup later when the number of fragments is known. + implicit none + ! Arguments + class(collision_merge), intent(inout) :: self !! Encounter collision system object + class(base_nbody_system), intent(in) :: nbody_system !! Current nbody system. Used as a mold for the before/after snapshots + + call self%setup_impactors() + if (allocated(self%before)) deallocate(self%before) + if (allocated(self%after)) deallocate(self%after) + + allocate(self%before, mold=nbody_system) + allocate(self%after, mold=nbody_system) + + return + end subroutine collision_util_setup_system + + + module subroutine collision_util_setup_impactors_system(self) + !! author: David A. Minton + !! + !! Initializer for the impactors for the encounter collision system. Deallocates old impactors before creating new ones + implicit none + ! Arguments + class(collision_merge), intent(inout) :: self !! Encounter collision system object + + if (allocated(self%impactors)) deallocate(self%impactors) + allocate(collision_impactors :: self%impactors) + + return + end subroutine collision_util_setup_impactors_system + + + module subroutine collision_util_setup_fragments_system(self, nfrag) + !! author: David A. Minton + !! + !! Initializer for the fragments of the collision system. + implicit none + ! Arguments + class(collision_merge), intent(inout) :: self !! Encounter collision system object + integer(I4B), intent(in) :: nfrag !! Number of fragments to create + + if (allocated(self%fragments)) deallocate(self%fragments) + allocate(collision_fragments(nfrag) :: self%fragments) + self%fragments%nbody = nfrag + + return + end subroutine collision_util_setup_fragments_system + + subroutine collision_util_save_snapshot(collision_history, snapshot) !! author: David A. Minton !! diff --git a/src/encounter/encounter_module.f90 b/src/encounter/encounter_module.f90 index abb3c3422..0f7ee1055 100644 --- a/src/encounter/encounter_module.f90 +++ b/src/encounter/encounter_module.f90 @@ -37,7 +37,7 @@ module encounter real(DP), dimension(:,:), allocatable :: v2 !! the velocity of body 2 in the encounter integer(I4B), dimension(:), allocatable :: level !! Recursion level (used in SyMBA) contains - procedure :: setup => encounter_setup_list !! A constructor that sets the number of encounters and allocates and initializes all arrays + procedure :: setup => encounter_util_setup_list !! A constructor that sets the number of encounters and allocates and initializes all arrays procedure :: append => encounter_util_append_list !! Appends elements from one structure to another procedure :: copy => encounter_util_copy_list !! Copies elements from the source encounter list into self. procedure :: dealloc => encounter_util_dealloc_list !! Deallocates all allocatables @@ -98,7 +98,7 @@ module encounter type encounter_bounding_box type(encounter_bounding_box_1D), dimension(SWEEPDIM) :: aabb contains - procedure :: setup => encounter_setup_aabb !! Setup a new axis-aligned bounding box structure + procedure :: setup => encounter_util_setup_aabb !! Setup a new axis-aligned bounding box structure procedure :: sweep_single => encounter_check_sweep_aabb_single_list !! Sweeps the sorted bounding box extents and returns the encounter candidates procedure :: sweep_double => encounter_check_sweep_aabb_double_list !! Sweeps the sorted bounding box extents and returns the encounter candidates generic :: sweep => sweep_single, sweep_double @@ -236,18 +236,18 @@ module subroutine encounter_io_netcdf_write_frame_snapshot(self, history, param) class(base_parameters), intent(inout) :: param !! Current run configuration parameters end subroutine encounter_io_netcdf_write_frame_snapshot - module subroutine encounter_setup_aabb(self, n, n_last) + module subroutine encounter_util_setup_aabb(self, n, n_last) implicit none class(encounter_bounding_box), intent(inout) :: self !! Swiftest encounter structure integer(I4B), intent(in) :: n !! Number of objects with bounding box extents integer(I4B), intent(in) :: n_last !! Number of objects with bounding box extents the previous time this was called - end subroutine encounter_setup_aabb + end subroutine encounter_util_setup_aabb - module subroutine encounter_setup_list(self, n) + module subroutine encounter_util_setup_list(self, n) implicit none class(encounter_list), intent(inout) :: self !! Swiftest encounter structure integer(I8B), intent(in) :: n !! Number of encounters to allocate space for - end subroutine encounter_setup_list + end subroutine encounter_util_setup_list module subroutine encounter_util_append_list(self, source, lsource_mask) implicit none diff --git a/src/encounter/encounter_setup.f90 b/src/encounter/encounter_setup.f90 deleted file mode 100644 index 3cf165129..000000000 --- a/src/encounter/encounter_setup.f90 +++ /dev/null @@ -1,108 +0,0 @@ -!! Copyright 2022 - David Minton, Carlisle Wishard, Jennifer Pouplin, Jake Elliott, & Dana Singh -!! This file is part of Swiftest. -!! Swiftest is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License -!! as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. -!! Swiftest is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty -!! of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. -!! You should have received a copy of the GNU General Public License along with Swiftest. -!! If not, see: https://www.gnu.org/licenses. - -submodule (encounter) s_encounter_setup - use swiftest -contains - - module subroutine encounter_setup_aabb(self, n, n_last) - !! author: David A. Minton - !! - !! Sets up or modifies an axis-aligned bounding box structure. - implicit none - ! Arguments - class(encounter_bounding_box), intent(inout) :: self !! Swiftest encounter structure - integer(I4B), intent(in) :: n !! Number of objects with bounding box extents - integer(I4B), intent(in) :: n_last !! Number of objects with bounding box extents the previous time this was called - ! Internals - integer(I4B) :: next, next_last, k, dim - integer(I4B), dimension(:), allocatable :: itmp - - next = 2 * n - next_last = 2 * n_last - - if (n > n_last) then ! The number of bodies has grown. Resize and append the new bodies - do dim = 1, SWEEPDIM - allocate(itmp(next)) - if (n_last > 0) itmp(1:next_last) = self%aabb(dim)%ind(1:next_last) - call move_alloc(itmp, self%aabb(dim)%ind) - self%aabb(dim)%ind(next_last+1:next) = [(k, k = next_last+1, next)] - end do - else ! The number of bodies has gone down. Resize and chop of the old indices - do dim = 1, SWEEPDIM - allocate(itmp(next)) - itmp(1:next) = pack(self%aabb(dim)%ind(1:next_last), self%aabb(dim)%ind(1:next_last) <= next) - call move_alloc(itmp, self%aabb(dim)%ind) - end do - end if - - do dim = 1, SWEEPDIM - if (allocated(self%aabb(dim)%ibeg)) deallocate(self%aabb(dim)%ibeg) - allocate(self%aabb(dim)%ibeg(n)) - if (allocated(self%aabb(dim)%iend)) deallocate(self%aabb(dim)%iend) - allocate(self%aabb(dim)%iend(n)) - end do - - return - end subroutine encounter_setup_aabb - - - module subroutine encounter_setup_list(self, n) - !! author: David A. Minton - !! - !! A constructor that sets the number of encounters and allocates and initializes all arrays - !! - implicit none - ! Arguments - class(encounter_list), intent(inout) :: self !! Swiftest encounter structure - integer(I8B), intent(in) :: n !! Number of encounters to allocate space for - ! Internals - integer(I8B) :: i - - if (n < 0) return - call self%dealloc() - - self%nenc = n - if (n == 0_I8B) return - self%t = 0.0_DP - - allocate(self%tcollision(n)) - allocate(self%lvdotr(n)) - allocate(self%lclosest(n)) - allocate(self%status(n)) - allocate(self%index1(n)) - allocate(self%index2(n)) - allocate(self%id1(n)) - allocate(self%id2(n)) - allocate(self%r1(NDIM,n)) - allocate(self%r2(NDIM,n)) - allocate(self%v1(NDIM,n)) - allocate(self%v2(NDIM,n)) - allocate(self%level(n)) - - self%tcollision(:) = 0.0_DP - self%lvdotr(:) = .false. - self%lclosest(:) = .false. - self%status(:) = INACTIVE - self%index1(:) = 0 - self%index2(:) = 0 - self%id1(:) = 0 - self%id2(:) = 0 - self%r1(:,:) = 0.0_DP - self%r2(:,:) = 0.0_DP - self%v1(:,:) = 0.0_DP - self%v2(:,:) = 0.0_DP - self%level(:) = 0 - - return - end subroutine encounter_setup_list - -end submodule s_encounter_setup - - \ No newline at end of file diff --git a/src/encounter/encounter_util.f90 b/src/encounter/encounter_util.f90 index 06648ca9f..45e6f48fb 100644 --- a/src/encounter/encounter_util.f90 +++ b/src/encounter/encounter_util.f90 @@ -281,6 +281,99 @@ module subroutine encounter_util_resize_list(self, nnew) end subroutine encounter_util_resize_list + module subroutine encounter_util_setup_aabb(self, n, n_last) + !! author: David A. Minton + !! + !! Sets up or modifies an axis-aligned bounding box structure. + implicit none + ! Arguments + class(encounter_bounding_box), intent(inout) :: self !! Swiftest encounter structure + integer(I4B), intent(in) :: n !! Number of objects with bounding box extents + integer(I4B), intent(in) :: n_last !! Number of objects with bounding box extents the previous time this was called + ! Internals + integer(I4B) :: next, next_last, k, dim + integer(I4B), dimension(:), allocatable :: itmp + + next = 2 * n + next_last = 2 * n_last + + if (n > n_last) then ! The number of bodies has grown. Resize and append the new bodies + do dim = 1, SWEEPDIM + allocate(itmp(next)) + if (n_last > 0) itmp(1:next_last) = self%aabb(dim)%ind(1:next_last) + call move_alloc(itmp, self%aabb(dim)%ind) + self%aabb(dim)%ind(next_last+1:next) = [(k, k = next_last+1, next)] + end do + else ! The number of bodies has gone down. Resize and chop of the old indices + do dim = 1, SWEEPDIM + allocate(itmp(next)) + itmp(1:next) = pack(self%aabb(dim)%ind(1:next_last), self%aabb(dim)%ind(1:next_last) <= next) + call move_alloc(itmp, self%aabb(dim)%ind) + end do + end if + + do dim = 1, SWEEPDIM + if (allocated(self%aabb(dim)%ibeg)) deallocate(self%aabb(dim)%ibeg) + allocate(self%aabb(dim)%ibeg(n)) + if (allocated(self%aabb(dim)%iend)) deallocate(self%aabb(dim)%iend) + allocate(self%aabb(dim)%iend(n)) + end do + + return + end subroutine encounter_util_setup_aabb + + + module subroutine encounter_util_setup_list(self, n) + !! author: David A. Minton + !! + !! A constructor that sets the number of encounters and allocates and initializes all arrays + !! + implicit none + ! Arguments + class(encounter_list), intent(inout) :: self !! Swiftest encounter structure + integer(I8B), intent(in) :: n !! Number of encounters to allocate space for + ! Internals + integer(I8B) :: i + + if (n < 0) return + call self%dealloc() + + self%nenc = n + if (n == 0_I8B) return + self%t = 0.0_DP + + allocate(self%tcollision(n)) + allocate(self%lvdotr(n)) + allocate(self%lclosest(n)) + allocate(self%status(n)) + allocate(self%index1(n)) + allocate(self%index2(n)) + allocate(self%id1(n)) + allocate(self%id2(n)) + allocate(self%r1(NDIM,n)) + allocate(self%r2(NDIM,n)) + allocate(self%v1(NDIM,n)) + allocate(self%v2(NDIM,n)) + allocate(self%level(n)) + + self%tcollision(:) = 0.0_DP + self%lvdotr(:) = .false. + self%lclosest(:) = .false. + self%status(:) = INACTIVE + self%index1(:) = 0 + self%index2(:) = 0 + self%id1(:) = 0 + self%id2(:) = 0 + self%r1(:,:) = 0.0_DP + self%r2(:,:) = 0.0_DP + self%v1(:,:) = 0.0_DP + self%v2(:,:) = 0.0_DP + self%level(:) = 0 + + return + end subroutine encounter_util_setup_list + + module subroutine encounter_util_spill_list(self, discards, lspill_list, ldestructive) !! author: David A. Minton !! diff --git a/src/fraggle/fraggle_module.f90 b/src/fraggle/fraggle_module.f90 index 2471b9975..72c0e5dc3 100644 --- a/src/fraggle/fraggle_module.f90 +++ b/src/fraggle/fraggle_module.f90 @@ -44,10 +44,10 @@ module fraggle real(DP) :: Lscale = 1.0_DP !! Angular momentum scale factor (a convenience unit that is derived from dscale, tscale, and mscale) contains procedure :: generate => fraggle_generate_system !! Generates a system of fragments in barycentric coordinates that conserves energy and momentum. - procedure :: set_budgets => fraggle_set_budgets !! Sets the energy and momentum budgets of the fragments based on the collider value - procedure :: set_natural_scale => fraggle_set_natural_scale_factors !! Scales dimenional quantities to ~O(1) with respect to the collisional system. - procedure :: set_original_scale => fraggle_set_original_scale_factors !! Restores dimenional quantities back to the original system units - procedure :: setup_fragments => fraggle_setup_fragments_system !! Initializer for the fragments of the collision system. + procedure :: set_budgets => fraggle_util_set_budgets !! Sets the energy and momentum budgets of the fragments based on the collider value + procedure :: set_natural_scale => fraggle_util_set_natural_scale_factors !! Scales dimenional quantities to ~O(1) with respect to the collisional system. + procedure :: set_original_scale => fraggle_util_set_original_scale_factors !! Restores dimenional quantities back to the original system units + procedure :: setup_fragments => fraggle_util_setup_fragments_system !! Initializer for the fragments of the collision system. procedure :: construct_temporary_system => fraggle_util_construct_temporary_system !! Constructs temporary n-body system in order to compute pre- and post-impact energy and momentum procedure :: reset => fraggle_util_reset_system !! Deallocates all allocatables final :: fraggle_final_system !! Finalizer will deallocate all allocatables @@ -89,31 +89,11 @@ module subroutine fraggle_generate_system(self, nbody_system, param, t) real(DP), intent(in) :: t !! Time of collision end subroutine fraggle_generate_system - module subroutine fraggle_set_budgets(self) - implicit none - class(collision_fraggle), intent(inout) :: self !! Fraggle collision system object - end subroutine fraggle_set_budgets - - module subroutine fraggle_set_natural_scale_factors(self) - implicit none - class(collision_fraggle), intent(inout) :: self !! Fraggle collision system object - end subroutine fraggle_set_natural_scale_factors - - module subroutine fraggle_set_original_scale_factors(self) - implicit none - class(collision_fraggle), intent(inout) :: self !! Fraggle collision system object - end subroutine fraggle_set_original_scale_factors - - module subroutine fraggle_setup_fragments_system(self, nfrag) + module subroutine fraggle_util_setup_fragments_system(self, nfrag) implicit none class(collision_fraggle), intent(inout) :: self !! Encounter collision system object integer(I4B), intent(in) :: nfrag !! Number of fragments to create - end subroutine fraggle_setup_fragments_system - - module subroutine fraggle_util_get_angular_momentum(self) - implicit none - class(fraggle_fragments(*)), intent(inout) :: self !! Fraggle fragment system object - end subroutine fraggle_util_get_angular_momentum + end subroutine fraggle_util_setup_fragments_system module subroutine fraggle_util_construct_temporary_system(self, nbody_system, param, tmpsys, tmpparam) implicit none @@ -124,10 +104,10 @@ module subroutine fraggle_util_construct_temporary_system(self, nbody_system, pa class(base_parameters), allocatable, intent(out) :: tmpparam !! Output temporary configuration run parameters end subroutine fraggle_util_construct_temporary_system - module subroutine fraggle_final_impactors(self) + module subroutine fraggle_util_get_angular_momentum(self) implicit none - type(collision_impactors), intent(inout) :: self !! Fraggle impactors object - end subroutine fraggle_final_impactors + class(fraggle_fragments(*)), intent(inout) :: self !! Fraggle fragment system object + end subroutine fraggle_util_get_angular_momentum module subroutine fraggle_util_reset_fragments(self) implicit none @@ -148,6 +128,22 @@ module subroutine fraggle_util_restructure(self, impactors, try, f_spin, r_max_s real(DP), intent(inout) :: r_max_start !! The maximum radial distance that the position calculation starts with. This increases after a failed attempt end subroutine fraggle_util_restructure + module subroutine fraggle_util_set_budgets(self) + implicit none + class(collision_fraggle), intent(inout) :: self !! Fraggle collision system object + end subroutine fraggle_util_set_budgets + + module subroutine fraggle_util_set_natural_scale_factors(self) + implicit none + class(collision_fraggle), intent(inout) :: self !! Fraggle collision system object + end subroutine fraggle_util_set_natural_scale_factors + + module subroutine fraggle_util_set_original_scale_factors(self) + implicit none + class(collision_fraggle), intent(inout) :: self !! Fraggle collision system object + end subroutine fraggle_util_set_original_scale_factors + + module subroutine fraggle_util_shift_vector_to_origin(m_frag, vec_frag) implicit none real(DP), dimension(:), intent(in) :: m_frag !! Fragment masses @@ -181,6 +177,18 @@ subroutine fraggle_final_fragments(self) end subroutine fraggle_final_fragments + subroutine fraggle_final_impactors(self) + !! author: David A. Minton + !! + !! Finalizer will deallocate all allocatables + implicit none + ! Arguments + type(collision_impactors), intent(inout) :: self !! Fraggle impactors object + call self%reset() + return + end subroutine fraggle_final_impactors + + subroutine fraggle_final_system(self) !! author: David A. Minton !! diff --git a/src/fraggle/fraggle_set.f90 b/src/fraggle/fraggle_set.f90 deleted file mode 100644 index 03f2e5e88..000000000 --- a/src/fraggle/fraggle_set.f90 +++ /dev/null @@ -1,155 +0,0 @@ -!! Copyright 2022 - David Minton, Carlisle Wishard, Jennifer Pouplin, Jake Elliott, & Dana Singh -!! This file is part of Swiftest. -!! Swiftest is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License -!! as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. -!! Swiftest is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty -!! of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. -!! You should have received a copy of the GNU General Public License along with Swiftest. -!! If not, see: https://www.gnu.org/licenses. - -submodule(fraggle) s_fraggle_set - use swiftest - use symba -contains - - module subroutine fraggle_set_budgets(self) - !! author: David A. Minton - !! - !! Sets the energy and momentum budgets of the fragments based on the collider values and the before/after values of energy and momentum - implicit none - ! Arguments - class(collision_fraggle), intent(inout) :: self !! Fraggle collision system object - ! Internals - real(DP) :: dEtot - real(DP), dimension(NDIM) :: dL - - associate(impactors => self%impactors) - select type(fragments => self%fragments) - class is (fraggle_fragments(*)) - - dEtot = self%Etot(2) - self%Etot(1) - dL(:) = self%Ltot(:,2) - self%Ltot(:,1) - - fragments%L_budget(:) = -dL(:) - fragments%ke_budget = -(dEtot - 0.5_DP * fragments%mtot * dot_product(impactors%vbcom(:), impactors%vbcom(:))) - impactors%Qloss - - end select - end associate - - return - end subroutine fraggle_set_budgets - - - module subroutine fraggle_set_natural_scale_factors(self) - !! author: David A. Minton - !! - !! Scales dimenional quantities to ~O(1) with respect to the collisional system. - !! This scaling makes it easier for the non-linear minimization to converge on a solution - implicit none - ! Arguments - class(collision_fraggle), intent(inout) :: self !! Fraggle collision system object - ! Internals - integer(I4B) :: i - - associate(collision_merge => self, fragments => self%fragments, impactors => self%impactors) - ! Set scale factors - collision_merge%Escale = 0.5_DP * ( impactors%mass(1) * dot_product(impactors%vb(:,1), impactors%vb(:,1)) & - + impactors%mass(2) * dot_product(impactors%vb(:,2), impactors%vb(:,2))) - collision_merge%dscale = sum(impactors%radius(:)) - collision_merge%mscale = fragments%mtot - collision_merge%vscale = sqrt(collision_merge%Escale / collision_merge%mscale) - collision_merge%tscale = collision_merge%dscale / collision_merge%vscale - collision_merge%Lscale = collision_merge%mscale * collision_merge%dscale * collision_merge%vscale - - ! Scale all dimensioned quantities of impactors and fragments - impactors%rbcom(:) = impactors%rbcom(:) / collision_merge%dscale - impactors%vbcom(:) = impactors%vbcom(:) / collision_merge%vscale - impactors%rbimp(:) = impactors%rbimp(:) / collision_merge%dscale - impactors%rb(:,:) = impactors%rb(:,:) / collision_merge%dscale - impactors%vb(:,:) = impactors%vb(:,:) / collision_merge%vscale - impactors%mass(:) = impactors%mass(:) / collision_merge%mscale - impactors%radius(:) = impactors%radius(:) / collision_merge%dscale - impactors%Lspin(:,:) = impactors%Lspin(:,:) / collision_merge%Lscale - impactors%Lorbit(:,:) = impactors%Lorbit(:,:) / collision_merge%Lscale - - do i = 1, 2 - impactors%rot(:,i) = impactors%Lspin(:,i) / (impactors%mass(i) * impactors%radius(i)**2 * impactors%Ip(3, i)) - end do - - fragments%mtot = fragments%mtot / collision_merge%mscale - fragments%mass = fragments%mass / collision_merge%mscale - fragments%radius = fragments%radius / collision_merge%dscale - impactors%Qloss = impactors%Qloss / collision_merge%Escale - end associate - - return - end subroutine fraggle_set_natural_scale_factors - - - module subroutine fraggle_set_original_scale_factors(self) - !! author: David A. Minton - !! - !! Restores dimenional quantities back to the system units - use, intrinsic :: ieee_exceptions - implicit none - ! Arguments - class(collision_fraggle), intent(inout) :: self !! Fraggle fragment system object - ! Internals - integer(I4B) :: i - logical, dimension(size(IEEE_ALL)) :: fpe_halting_modes - - call ieee_get_halting_mode(IEEE_ALL,fpe_halting_modes) ! Save the current halting modes so we can turn them off temporarily - call ieee_set_halting_mode(IEEE_ALL,.false.) - - associate(collision_merge => self, fragments => self%fragments, impactors => self%impactors) - - ! Restore scale factors - impactors%rbcom(:) = impactors%rbcom(:) * collision_merge%dscale - impactors%vbcom(:) = impactors%vbcom(:) * collision_merge%vscale - impactors%rbimp(:) = impactors%rbimp(:) * collision_merge%dscale - - impactors%mass = impactors%mass * collision_merge%mscale - impactors%radius = impactors%radius * collision_merge%dscale - impactors%rb = impactors%rb * collision_merge%dscale - impactors%vb = impactors%vb * collision_merge%vscale - impactors%Lspin = impactors%Lspin * collision_merge%Lscale - do i = 1, 2 - impactors%rot(:,i) = impactors%Lspin(:,i) * (impactors%mass(i) * impactors%radius(i)**2 * impactors%Ip(3, i)) - end do - - fragments%mtot = fragments%mtot * collision_merge%mscale - fragments%mass = fragments%mass * collision_merge%mscale - fragments%radius = fragments%radius * collision_merge%dscale - fragments%rot = fragments%rot / collision_merge%tscale - fragments%rc = fragments%rc * collision_merge%dscale - fragments%vc = fragments%vc * collision_merge%vscale - - do i = 1, fragments%nbody - fragments%rb(:, i) = fragments%rc(:, i) + impactors%rbcom(:) - fragments%vb(:, i) = fragments%vc(:, i) + impactors%vbcom(:) - end do - - impactors%Qloss = impactors%Qloss * collision_merge%Escale - - collision_merge%Lorbit(:,:) = collision_merge%Lorbit(:,:) * collision_merge%Lscale - collision_merge%Lspin(:,:) = collision_merge%Lspin(:,:) * collision_merge%Lscale - collision_merge%Ltot(:,:) = collision_merge%Ltot(:,:) * collision_merge%Lscale - collision_merge%ke_orbit(:) = collision_merge%ke_orbit(:) * collision_merge%Escale - collision_merge%ke_spin(:) = collision_merge%ke_spin(:) * collision_merge%Escale - collision_merge%pe(:) = collision_merge%pe(:) * collision_merge%Escale - collision_merge%Etot(:) = collision_merge%Etot(:) * collision_merge%Escale - - collision_merge%mscale = 1.0_DP - collision_merge%dscale = 1.0_DP - collision_merge%vscale = 1.0_DP - collision_merge%tscale = 1.0_DP - collision_merge%Lscale = 1.0_DP - collision_merge%Escale = 1.0_DP - end associate - call ieee_set_halting_mode(IEEE_ALL,fpe_halting_modes) - - return - end subroutine fraggle_set_original_scale_factors - - -end submodule s_fraggle_set \ No newline at end of file diff --git a/src/fraggle/fraggle_setup.f90 b/src/fraggle/fraggle_setup.f90 deleted file mode 100644 index e54ca46fd..000000000 --- a/src/fraggle/fraggle_setup.f90 +++ /dev/null @@ -1,31 +0,0 @@ -!! Copyright 2022 - David Minton, Carlisle Wishard, Jennifer Pouplin, Jake Elliott, & Dana Singh -!! This file is part of Swiftest. -!! Swiftest is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License -!! as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. -!! Swiftest is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty -!! of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. -!! You should have received a copy of the GNU General Public License along with Swiftest. -!! If not, see: https://www.gnu.org/licenses. - -submodule (fraggle) s_fraggle_setup - use swiftest - use symba -contains - - module subroutine fraggle_setup_fragments_system(self, nfrag) - !! author: David A. Minton - !! - !! Initializer for the fragments of the collision system. - implicit none - ! Arguments - class(collision_fraggle), intent(inout) :: self !! Encounter collision system object - integer(I4B), intent(in) :: nfrag !! Number of fragments to create - - if (allocated(self%fragments)) deallocate(self%fragments) - allocate(fraggle_fragments(nbody=nfrag) :: self%fragments) - self%fragments%nbody = nfrag - - return - end subroutine fraggle_setup_fragments_system - -end submodule s_fraggle_setup \ No newline at end of file diff --git a/src/fraggle/fraggle_util.f90 b/src/fraggle/fraggle_util.f90 index 07b5eef50..f3e6b87f6 100644 --- a/src/fraggle/fraggle_util.f90 +++ b/src/fraggle/fraggle_util.f90 @@ -12,28 +12,6 @@ use symba contains - module subroutine fraggle_util_get_angular_momentum(self) - !! Author: David A. Minton - !! - !! Calcualtes the current angular momentum of the fragments - implicit none - ! Arguments - class(fraggle_fragments(*)), intent(inout) :: self !! Fraggle fragment system object - ! Internals - integer(I4B) :: i - - associate(fragments => self, nfrag => self%nbody) - fragments%Lorbit(:) = 0.0_DP - fragments%Lspin(:) = 0.0_DP - - do i = 1, nfrag - fragments%Lorbit(:) = fragments%Lorbit(:) + fragments%mass(i) * (fragments%rc(:, i) .cross. fragments%vc(:, i)) - fragments%Lspin(:) = fragments%Lspin(:) + fragments%mass(i) * fragments%radius(i)**2 * fragments%Ip(:, i) * fragments%rot(:, i) - end do - end associate - - return - end subroutine fraggle_util_get_angular_momentum module subroutine fraggle_util_construct_temporary_system(self, nbody_system, param, tmpsys, tmpparam) @@ -62,6 +40,30 @@ module subroutine fraggle_util_construct_temporary_system(self, nbody_system, pa end subroutine fraggle_util_construct_temporary_system + module subroutine fraggle_util_get_angular_momentum(self) + !! Author: David A. Minton + !! + !! Calcualtes the current angular momentum of the fragments + implicit none + ! Arguments + class(fraggle_fragments(*)), intent(inout) :: self !! Fraggle fragment system object + ! Internals + integer(I4B) :: i + + associate(fragments => self, nfrag => self%nbody) + fragments%Lorbit(:) = 0.0_DP + fragments%Lspin(:) = 0.0_DP + + do i = 1, nfrag + fragments%Lorbit(:) = fragments%Lorbit(:) + fragments%mass(i) * (fragments%rc(:, i) .cross. fragments%vc(:, i)) + fragments%Lspin(:) = fragments%Lspin(:) + fragments%mass(i) * fragments%radius(i)**2 * fragments%Ip(:, i) * fragments%rot(:, i) + end do + end associate + + return + end subroutine fraggle_util_get_angular_momentum + + module subroutine fraggle_util_reset_fragments(self) !! author: David A. Minton !! @@ -159,6 +161,163 @@ module subroutine fraggle_util_restructure(self, impactors, try, f_spin, r_max_s end subroutine fraggle_util_restructure + module subroutine fraggle_util_set_budgets(self) + !! author: David A. Minton + !! + !! Sets the energy and momentum budgets of the fragments based on the collider values and the before/after values of energy and momentum + implicit none + ! Arguments + class(collision_fraggle), intent(inout) :: self !! Fraggle collision system object + ! Internals + real(DP) :: dEtot + real(DP), dimension(NDIM) :: dL + + associate(impactors => self%impactors) + select type(fragments => self%fragments) + class is (fraggle_fragments(*)) + + dEtot = self%Etot(2) - self%Etot(1) + dL(:) = self%Ltot(:,2) - self%Ltot(:,1) + + fragments%L_budget(:) = -dL(:) + fragments%ke_budget = -(dEtot - 0.5_DP * fragments%mtot * dot_product(impactors%vbcom(:), impactors%vbcom(:))) - impactors%Qloss + + end select + end associate + + return + end subroutine fraggle_util_set_budgets + + + module subroutine fraggle_util_set_natural_scale_factors(self) + !! author: David A. Minton + !! + !! Scales dimenional quantities to ~O(1) with respect to the collisional system. + !! This scaling makes it easier for the non-linear minimization to converge on a solution + implicit none + ! Arguments + class(collision_fraggle), intent(inout) :: self !! Fraggle collision system object + ! Internals + integer(I4B) :: i + + associate(collision_merge => self, fragments => self%fragments, impactors => self%impactors) + ! Set scale factors + collision_merge%Escale = 0.5_DP * ( impactors%mass(1) * dot_product(impactors%vb(:,1), impactors%vb(:,1)) & + + impactors%mass(2) * dot_product(impactors%vb(:,2), impactors%vb(:,2))) + collision_merge%dscale = sum(impactors%radius(:)) + collision_merge%mscale = fragments%mtot + collision_merge%vscale = sqrt(collision_merge%Escale / collision_merge%mscale) + collision_merge%tscale = collision_merge%dscale / collision_merge%vscale + collision_merge%Lscale = collision_merge%mscale * collision_merge%dscale * collision_merge%vscale + + ! Scale all dimensioned quantities of impactors and fragments + impactors%rbcom(:) = impactors%rbcom(:) / collision_merge%dscale + impactors%vbcom(:) = impactors%vbcom(:) / collision_merge%vscale + impactors%rbimp(:) = impactors%rbimp(:) / collision_merge%dscale + impactors%rb(:,:) = impactors%rb(:,:) / collision_merge%dscale + impactors%vb(:,:) = impactors%vb(:,:) / collision_merge%vscale + impactors%mass(:) = impactors%mass(:) / collision_merge%mscale + impactors%radius(:) = impactors%radius(:) / collision_merge%dscale + impactors%Lspin(:,:) = impactors%Lspin(:,:) / collision_merge%Lscale + impactors%Lorbit(:,:) = impactors%Lorbit(:,:) / collision_merge%Lscale + + do i = 1, 2 + impactors%rot(:,i) = impactors%Lspin(:,i) / (impactors%mass(i) * impactors%radius(i)**2 * impactors%Ip(3, i)) + end do + + fragments%mtot = fragments%mtot / collision_merge%mscale + fragments%mass = fragments%mass / collision_merge%mscale + fragments%radius = fragments%radius / collision_merge%dscale + impactors%Qloss = impactors%Qloss / collision_merge%Escale + end associate + + return + end subroutine fraggle_util_set_natural_scale_factors + + + module subroutine fraggle_util_set_original_scale_factors(self) + !! author: David A. Minton + !! + !! Restores dimenional quantities back to the system units + use, intrinsic :: ieee_exceptions + implicit none + ! Arguments + class(collision_fraggle), intent(inout) :: self !! Fraggle fragment system object + ! Internals + integer(I4B) :: i + logical, dimension(size(IEEE_ALL)) :: fpe_halting_modes + + call ieee_get_halting_mode(IEEE_ALL,fpe_halting_modes) ! Save the current halting modes so we can turn them off temporarily + call ieee_set_halting_mode(IEEE_ALL,.false.) + + associate(collision_merge => self, fragments => self%fragments, impactors => self%impactors) + + ! Restore scale factors + impactors%rbcom(:) = impactors%rbcom(:) * collision_merge%dscale + impactors%vbcom(:) = impactors%vbcom(:) * collision_merge%vscale + impactors%rbimp(:) = impactors%rbimp(:) * collision_merge%dscale + + impactors%mass = impactors%mass * collision_merge%mscale + impactors%radius = impactors%radius * collision_merge%dscale + impactors%rb = impactors%rb * collision_merge%dscale + impactors%vb = impactors%vb * collision_merge%vscale + impactors%Lspin = impactors%Lspin * collision_merge%Lscale + do i = 1, 2 + impactors%rot(:,i) = impactors%Lspin(:,i) * (impactors%mass(i) * impactors%radius(i)**2 * impactors%Ip(3, i)) + end do + + fragments%mtot = fragments%mtot * collision_merge%mscale + fragments%mass = fragments%mass * collision_merge%mscale + fragments%radius = fragments%radius * collision_merge%dscale + fragments%rot = fragments%rot / collision_merge%tscale + fragments%rc = fragments%rc * collision_merge%dscale + fragments%vc = fragments%vc * collision_merge%vscale + + do i = 1, fragments%nbody + fragments%rb(:, i) = fragments%rc(:, i) + impactors%rbcom(:) + fragments%vb(:, i) = fragments%vc(:, i) + impactors%vbcom(:) + end do + + impactors%Qloss = impactors%Qloss * collision_merge%Escale + + collision_merge%Lorbit(:,:) = collision_merge%Lorbit(:,:) * collision_merge%Lscale + collision_merge%Lspin(:,:) = collision_merge%Lspin(:,:) * collision_merge%Lscale + collision_merge%Ltot(:,:) = collision_merge%Ltot(:,:) * collision_merge%Lscale + collision_merge%ke_orbit(:) = collision_merge%ke_orbit(:) * collision_merge%Escale + collision_merge%ke_spin(:) = collision_merge%ke_spin(:) * collision_merge%Escale + collision_merge%pe(:) = collision_merge%pe(:) * collision_merge%Escale + collision_merge%Etot(:) = collision_merge%Etot(:) * collision_merge%Escale + + collision_merge%mscale = 1.0_DP + collision_merge%dscale = 1.0_DP + collision_merge%vscale = 1.0_DP + collision_merge%tscale = 1.0_DP + collision_merge%Lscale = 1.0_DP + collision_merge%Escale = 1.0_DP + end associate + call ieee_set_halting_mode(IEEE_ALL,fpe_halting_modes) + + return + end subroutine fraggle_util_set_original_scale_factors + + + module subroutine fraggle_util_setup_fragments_system(self, nfrag) + !! author: David A. Minton + !! + !! Initializer for the fragments of the collision system. + implicit none + ! Arguments + class(collision_fraggle), intent(inout) :: self !! Encounter collision system object + integer(I4B), intent(in) :: nfrag !! Number of fragments to create + + if (allocated(self%fragments)) deallocate(self%fragments) + allocate(fraggle_fragments(nbody=nfrag) :: self%fragments) + self%fragments%nbody = nfrag + + return + end subroutine fraggle_util_setup_fragments_system + + module subroutine fraggle_util_shift_vector_to_origin(m_frag, vec_frag) !! Author: Jennifer L.L. Pouplin, Carlisle A. Wishard, and David A. Minton !! diff --git a/src/helio/helio_module.f90 b/src/helio/helio_module.f90 index b8d9d8b26..a9d41b1a9 100644 --- a/src/helio/helio_module.f90 +++ b/src/helio/helio_module.f90 @@ -21,7 +21,7 @@ module helio type, extends(whm_nbody_system) :: helio_nbody_system contains procedure :: step => helio_step_system !! Advance the Helio nbody system forward in time by one step - procedure :: initialize => helio_setup_initialize_system !! Performs Helio-specific initilization steps, including converting to DH coordinates + procedure :: initialize => helio_util_setup_initialize_system !! Performs Helio-specific initilization steps, including converting to DH coordinates final :: helio_final_system !! Finalizes the Helio nbody_system object - deallocates all allocatables end type helio_nbody_system @@ -168,11 +168,11 @@ module subroutine helio_kick_vb_tp(self, nbody_system, param, t, dt, lbeg) logical, intent(in) :: lbeg !! Logical flag indicating whether this is the beginning of the half step or not. end subroutine helio_kick_vb_tp - module subroutine helio_setup_initialize_system(self, param) + module subroutine helio_util_setup_initialize_system(self, param) implicit none class(helio_nbody_system), intent(inout) :: self !! Helio nbody system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - end subroutine helio_setup_initialize_system + end subroutine helio_util_setup_initialize_system module subroutine helio_step_pl(self, nbody_system, param, t, dt) implicit none diff --git a/src/helio/helio_setup.f90 b/src/helio/helio_util.f90 similarity index 72% rename from src/helio/helio_setup.f90 rename to src/helio/helio_util.f90 index 80effc1a9..5de0564a0 100644 --- a/src/helio/helio_setup.f90 +++ b/src/helio/helio_util.f90 @@ -1,17 +1,17 @@ !! Copyright 2022 - David Minton, Carlisle Wishard, Jennifer Pouplin, Jake Elliott, & Dana Singh !! This file is part of Swiftest. -!! Swiftest is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License +!! Swiftest is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License !! as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. -!! Swiftest is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty +!! Swiftest is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty !! of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. -!! You should have received a copy of the GNU General Public License along with Swiftest. -!! If not, see: https://www.gnu.org/licenses. +!! You should have received a copy of the GNU General Public License along with Swiftest. +!! If not, see: https://www.gnu.org/licenses. -submodule(helio) s_helio_setup +submodule(helio) s_helio_util use swiftest contains - module subroutine helio_setup_initialize_system(self, param) + module subroutine helio_util_setup_initialize_system(self, param) !! author: David A. Minton !! !! Initialize a Helio nbody system from files, converting all heliocentric quantities to barycentric. @@ -21,13 +21,13 @@ module subroutine helio_setup_initialize_system(self, param) class(helio_nbody_system), intent(inout) :: self !! Helio nbody system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - call whm_setup_initialize_system(self, param) + call whm_util_setup_initialize_system(self, param) call self%pl%h2b(self%cb) call self%tp%h2b(self%cb) call self%pl%sort("mass", ascending=.false.) call self%pl%flatten(param) return - end subroutine helio_setup_initialize_system + end subroutine helio_util_setup_initialize_system -end submodule s_helio_setup \ No newline at end of file +end submodule s_helio_util diff --git a/src/rmvs/rmvs_module.f90 b/src/rmvs/rmvs_module.f90 index 51e824b8d..3417ea0e2 100644 --- a/src/rmvs/rmvs_module.f90 +++ b/src/rmvs/rmvs_module.f90 @@ -32,7 +32,7 @@ module rmvs real(DP), dimension(:,:), allocatable :: vbeg !! Planet velocities at beginning ot step contains !> Replace the abstract procedures with concrete ones - procedure :: initialize => rmvs_setup_initialize_system !! Performs RMVS-specific initilization steps, including generating the close encounter planetocentric structures + procedure :: initialize => rmvs_util_setup_initialize_system !! Performs RMVS-specific initilization steps, including generating the close encounter planetocentric structures procedure :: step => rmvs_step_system !! Advance the RMVS nbody system forward in time by one step final :: rmvs_final_system !! Finalizes the RMVS nbody system object - deallocates all allocatables end type rmvs_nbody_system @@ -62,7 +62,7 @@ module rmvs !! RMVS test particle class type, extends(whm_tp) :: rmvs_tp !! Note to developers: If you add componenets to this class, be sure to update methods and subroutines that traverse the - !! component list, such as rmvs_setup_tp and rmvs_util_spill_tp + !! component list, such as rmvs_util_setup_tp and rmvs_util_spill_tp ! encounter steps) logical, dimension(:), allocatable :: lperi !! planetocentric pericenter passage flag (persistent for a full rmvs time step) over a full RMVS time step) integer(I4B), dimension(:), allocatable :: plperP !! index of planet associated with pericenter distance peri (persistent over a full RMVS time step) @@ -79,7 +79,7 @@ module rmvs procedure :: encounter_check => rmvs_encounter_check_tp !! Checks if any test particles are undergoing a close encounter with a massive body procedure :: accel => rmvs_kick_getacch_tp !! Calculates either the standard or modified version of the acceleration depending if the !! if the test particle is undergoing a close encounter or not - procedure :: setup => rmvs_setup_tp !! Constructor method - Allocates space for the input number of bodiess + procedure :: setup => rmvs_util_setup_tp !! Constructor method - Allocates space for the input number of bodiess procedure :: append => rmvs_util_append_tp !! Appends elements from one structure to another procedure :: dealloc => rmvs_util_dealloc_tp !! Deallocates all allocatable arrays procedure :: fill => rmvs_util_fill_tp !! "Fills" bodies from one object into another depending on the results of a mask (uses the UNPACK intrinsic) @@ -101,7 +101,7 @@ module rmvs class(rmvs_nbody_system), dimension(:), allocatable :: planetocentric !! Planetocentric version of the massive body objects (one for each massive body) logical :: lplanetocentric = .false. !! Flag that indicates that the object is a planetocentric set of masive bodies used for close encounter calculations contains - procedure :: setup => rmvs_setup_pl !! Constructor method - Allocates space for the input number of bodiess + procedure :: setup => rmvs_util_setup_pl !! Constructor method - Allocates space for the input number of bodiess procedure :: append => rmvs_util_append_pl !! Appends elements from one structure to another procedure :: dealloc => rmvs_util_dealloc_pl !! Deallocates all allocatable arrays procedure :: fill => rmvs_util_fill_pl !! "Fills" bodies from one object into another depending on the results of a mask (uses the UNPACK intrinsic) @@ -138,25 +138,25 @@ module subroutine rmvs_kick_getacch_tp(self, nbody_system, param, t, lbeg) logical, intent(in) :: lbeg !! Logical flag that determines whether or not this is the beginning or end of the step end subroutine rmvs_kick_getacch_tp - module subroutine rmvs_setup_pl(self, n, param) + module subroutine rmvs_util_setup_pl(self, n, param) implicit none class(rmvs_pl), intent(inout) :: self !! RMVS massive body object integer(I4B), intent(in) :: n !! Number of particles to allocate space for class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters - end subroutine rmvs_setup_pl + end subroutine rmvs_util_setup_pl - module subroutine rmvs_setup_initialize_system(self, param) + module subroutine rmvs_util_setup_initialize_system(self, param) implicit none class(rmvs_nbody_system), intent(inout) :: self !! RMVS system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - end subroutine rmvs_setup_initialize_system + end subroutine rmvs_util_setup_initialize_system - module subroutine rmvs_setup_tp(self, n, param) + module subroutine rmvs_util_setup_tp(self, n, param) implicit none class(rmvs_tp), intent(inout) :: self !! RMVS test particle object integer(I4B), intent(in) :: n !! Number of particles to allocate space for class(swiftest_parameters), intent(in) :: param !! Current run configuration parametere - end subroutine rmvs_setup_tp + end subroutine rmvs_util_setup_tp module subroutine rmvs_util_append_pl(self, source, lsource_mask) implicit none @@ -206,31 +206,6 @@ module subroutine rmvs_util_fill_tp(self, inserts, lfill_list) logical, dimension(:), intent(in) :: lfill_list !! Logical array of bodies to merge into the keeps end subroutine rmvs_util_fill_tp - module subroutine rmvs_final_cb(self) - implicit none - type(rmvs_cb), intent(inout) :: self !! RMVS central body object - end subroutine rmvs_final_cb - - module subroutine rmvs_final_interp(self) - implicit none - type(rmvs_interp), intent(inout) :: self !! RMVS interpolated nbody_system variables object - end subroutine rmvs_final_interp - - module subroutine rmvs_final_pl(self) - implicit none - type(rmvs_pl), intent(inout) :: self !! RMVS massive body object - end subroutine rmvs_final_pl - - module subroutine rmvs_final_system(self) - implicit none - type(rmvs_nbody_system), intent(inout) :: self !! RMVS nbody system object - end subroutine rmvs_final_system - - module subroutine rmvs_final_tp(self) - implicit none - type(rmvs_tp), intent(inout) :: self !! RMVS test particle object - end subroutine rmvs_final_tp - module subroutine rmvs_util_resize_pl(self, nnew) implicit none class(rmvs_pl), intent(inout) :: self !! RMVS massive body object @@ -295,4 +270,77 @@ end subroutine rmvs_step_system end interface + contains + + subroutine rmvs_final_cb(self) + !! author: David A. Minton + !! + !! Finalize the RMVS massive body object - deallocates all allocatables + implicit none + ! Arguments + type(rmvs_cb), intent(inout) :: self !! RMVS central body object + + call self%dealloc() + + return + end subroutine rmvs_final_cb + + + subroutine rmvs_final_interp(self) + !! author: David A. Minton + !! + !! Finalize the RMVS nbody system object - deallocates all allocatables + implicit none + ! Arguments + type(rmvs_interp), intent(inout) :: self !! RMVS nbody system object + + call self%dealloc() + + return + end subroutine rmvs_final_interp + + + subroutine rmvs_final_pl(self) + !! author: David A. Minton + !! + !! Finalize the RMVS massive body object - deallocates all allocatables + implicit none + ! Arguments + type(rmvs_pl), intent(inout) :: self !! RMVS massive body object + + call self%dealloc() + + return + end subroutine rmvs_final_pl + + + subroutine rmvs_final_system(self) + !! author: David A. Minton + !! + !! Finalize the RMVS nbody system object - deallocates all allocatables + implicit none + ! Arguments + type(rmvs_nbody_system), intent(inout) :: self !! RMVS nbody system object + + if (allocated(self%vbeg)) deallocate(self%vbeg) + call whm_final_system(self%whm_nbody_system) + + return + end subroutine rmvs_final_system + + + subroutine rmvs_final_tp(self) + !! author: David A. Minton + !! + !! Finalize the RMVS test particle object - deallocates all allocatables + implicit none + ! Arguments + type(rmvs_tp), intent(inout) :: self !! RMVS test particle object + + call self%dealloc() + + return + end subroutine rmvs_final_tp + + end module rmvs diff --git a/src/rmvs/rmvs_setup.f90 b/src/rmvs/rmvs_setup.f90 deleted file mode 100644 index fe7d15b6d..000000000 --- a/src/rmvs/rmvs_setup.f90 +++ /dev/null @@ -1,166 +0,0 @@ -!! Copyright 2022 - David Minton, Carlisle Wishard, Jennifer Pouplin, Jake Elliott, & Dana Singh -!! This file is part of Swiftest. -!! Swiftest is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License -!! as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. -!! Swiftest is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty -!! of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. -!! You should have received a copy of the GNU General Public License along with Swiftest. -!! If not, see: https://www.gnu.org/licenses. - -submodule(rmvs) s_rmvs_setup - use swiftest -contains - - module subroutine rmvs_setup_pl(self, n, param) - !! author: David A. Minton - !! - !! Allocate RMVS test particle structure - !! - !! Equivalent in functionality to David E. Kaufmann's Swifter routine rmvs_setup.f90 - implicit none - ! Arguments - class(rmvs_pl), intent(inout) :: self !! RMVS test particle object - integer(I4B), intent(in) :: n !! Number of particles to allocate space for - class(swiftest_parameters), intent(in) :: param !! Current run configuration parameter - ! Internals - integer(I4B) :: i - - !> Call allocation method for parent class - associate(pl => self) - call whm_setup_pl(pl, n, param) - if (n == 0) return - - allocate(pl%outer(0:NTENC)) - allocate(pl%inner(0:NTPHENC)) - if (.not.pl%lplanetocentric) then - allocate(pl%nenc(n)) - pl%nenc(:) = 0 - ! Set up inner and outer planet interpolation vector storage containers - do i = 0, NTENC - allocate(pl%outer(i)%x(NDIM, n)) - allocate(pl%outer(i)%v(NDIM, n)) - pl%outer(i)%x(:,:) = 0.0_DP - pl%outer(i)%v(:,:) = 0.0_DP - end do - do i = 0, NTPHENC - allocate(pl%inner(i)%x(NDIM, n)) - allocate(pl%inner(i)%v(NDIM, n)) - allocate(pl%inner(i)%aobl(NDIM, n)) - pl%inner(i)%x(:,:) = 0.0_DP - pl%inner(i)%v(:,:) = 0.0_DP - pl%inner(i)%aobl(:,:) = 0.0_DP - end do - ! if (param%ltides) then - ! do i = 0, NTPHENC - ! allocate(pl%inner(i)%atide(NDIM, n)) - ! pl%inner(i)%atide(:,:) = 0.0_DP - ! end do - ! end if - end if - end associate - return - end subroutine rmvs_setup_pl - - - module subroutine rmvs_setup_initialize_system(self, param) - !! author: David A. Minton - !! - !! Initialize an RMVS nbody system from files and sets up the planetocentric structures. - !! - !! We currently rearrange the pl order to keep it consistent with the way Swifter does it - !! In Swifter, the central body occupies the first position in the pl list, and during - !! encounters, the encountering planet is skipped in loops. In Swiftest, we instantiate an - !! RMVS nbody system object attached to each pl to store planetocentric versions of the nbody_system - !! to use during close encounters. - implicit none - ! Arguments - class(rmvs_nbody_system), intent(inout) :: self !! RMVS system object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - ! Internals - integer(I4B) :: i, j - - ! Call parent method - call whm_setup_initialize_system(self, param) - - ! Set up the pl-tp planetocentric encounter structures for pl and cb. The planetocentric tp structures are - ! generated as necessary during close encounter steps. - select type(pl => self%pl) - class is(rmvs_pl) - select type(cb => self%cb) - class is (rmvs_cb) - select type (tp => self%tp) - class is (rmvs_tp) - tp%cb_heliocentric = cb - pl%lplanetocentric = .false. - tp%lplanetocentric = .false. - cb%lplanetocentric = .false. - associate(npl => pl%nbody) - allocate(pl%planetocentric(npl)) - pl%planetocentric(:)%lplanetocentric = .true. - do i = 1, npl - allocate(pl%planetocentric(i)%cb, source=cb) - allocate(rmvs_pl :: pl%planetocentric(i)%pl) - select type(cbenci => pl%planetocentric(i)%cb) - class is (rmvs_cb) - select type(plenci => pl%planetocentric(i)%pl) - class is (rmvs_pl) - cbenci%lplanetocentric = .true. - plenci%lplanetocentric = .true. - call plenci%setup(npl, param) - plenci%status(:) = ACTIVE - plenci%lmask(:) = .true. - ! plind stores the heliocentric index value of a planetocentric planet - ! e.g. Consider an encounter with planet 3. - ! Then the following will be the values of plind: - ! pl%planetocentric(3)%pl%plind(1) = 0 (central body - never used) - ! pl%planetocentric(3)%pl%plind(2) = 1 - ! pl%planetocentric(3)%pl%plind(3) = 2 - ! pl%planetocentric(3)%pl%plind(4) = 4 - ! pl%planetocentric(3)%pl%plind(5) = 5 - ! etc. - allocate(plenci%plind(npl)) - plenci%plind(1:npl) = [(j,j=1,npl)] - plenci%plind(2:npl) = pack(plenci%plind(1:npl), plenci%plind(1:npl) /= i) - plenci%plind(1) = 0 - plenci%Gmass(1) = cb%Gmass - plenci%Gmass(2:npl) = pl%Gmass(plenci%plind(2:npl)) - cbenci%Gmass = pl%Gmass(i) - end select - end select - end do - end associate - end select - end select - end select - return - end subroutine rmvs_setup_initialize_system - - - module subroutine rmvs_setup_tp(self, n, param) - !! author: David A. Minton - !! - !! Allocate WHM test particle structure - !! - !! Equivalent in functionality to David E. Kaufmann's Swifter routine whm_setup.f90 - implicit none - ! Arguments - class(rmvs_tp), intent(inout) :: self !! RMVS test particle object - integer(I4B), intent(in) :: n !! Number of particles to allocate space for - class(swiftest_parameters), intent(in) :: param !! Current run configuration parameter - - !> Call allocation method for parent class. - call self%whm_tp%setup(n, param) - if (n <= 0) return - - allocate(self%lperi(n)) - allocate(self%plperP(n)) - allocate(self%plencP(n)) - - if (self%lplanetocentric) allocate(self%rheliocentric(NDIM, n)) - - self%lperi(:) = .false. - - return - end subroutine rmvs_setup_tp - -end submodule s_rmvs_setup diff --git a/src/rmvs/rmvs_util.f90 b/src/rmvs/rmvs_util.f90 index 26306f064..07e4f9a51 100644 --- a/src/rmvs/rmvs_util.f90 +++ b/src/rmvs/rmvs_util.f90 @@ -181,78 +181,7 @@ module subroutine rmvs_util_fill_pl(self, inserts, lfill_list) return end subroutine rmvs_util_fill_pl - - module subroutine rmvs_final_cb(self) - !! author: David A. Minton - !! - !! Finalize the RMVS massive body object - deallocates all allocatables - implicit none - ! Arguments - type(rmvs_cb), intent(inout) :: self !! RMVS central body object - - call self%dealloc() - - return - end subroutine rmvs_final_cb - - - module subroutine rmvs_final_interp(self) - !! author: David A. Minton - !! - !! Finalize the RMVS nbody system object - deallocates all allocatables - implicit none - ! Arguments - type(rmvs_interp), intent(inout) :: self !! RMVS nbody system object - - call self%dealloc() - - return - end subroutine rmvs_final_interp - - - module subroutine rmvs_final_pl(self) - !! author: David A. Minton - !! - !! Finalize the RMVS massive body object - deallocates all allocatables - implicit none - ! Arguments - type(rmvs_pl), intent(inout) :: self !! RMVS massive body object - - call self%dealloc() - - return - end subroutine rmvs_final_pl - - - module subroutine rmvs_final_system(self) - !! author: David A. Minton - !! - !! Finalize the RMVS nbody system object - deallocates all allocatables - implicit none - ! Arguments - type(rmvs_nbody_system), intent(inout) :: self !! RMVS nbody system object - - if (allocated(self%vbeg)) deallocate(self%vbeg) - call whm_final_system(self%whm_nbody_system) - - return - end subroutine rmvs_final_system - - - module subroutine rmvs_final_tp(self) - !! author: David A. Minton - !! - !! Finalize the RMVS test particle object - deallocates all allocatables - implicit none - ! Arguments - type(rmvs_tp), intent(inout) :: self !! RMVS test particle object - - call self%dealloc() - - return - end subroutine rmvs_final_tp - - + module subroutine rmvs_util_fill_tp(self, inserts, lfill_list) !! author: David A. Minton !! @@ -327,6 +256,159 @@ module subroutine rmvs_util_resize_tp(self, nnew) end subroutine rmvs_util_resize_tp + module subroutine rmvs_util_setup_pl(self, n, param) + !! author: David A. Minton + !! + !! Allocate RMVS test particle structure + !! + !! Equivalent in functionality to David E. Kaufmann's Swifter routine rmvs_util_setup.f90 + implicit none + ! Arguments + class(rmvs_pl), intent(inout) :: self !! RMVS test particle object + integer(I4B), intent(in) :: n !! Number of particles to allocate space for + class(swiftest_parameters), intent(in) :: param !! Current run configuration parameter + ! Internals + integer(I4B) :: i + + !> Call allocation method for parent class + associate(pl => self) + call whm_util_setup_pl(pl, n, param) + if (n == 0) return + + allocate(pl%outer(0:NTENC)) + allocate(pl%inner(0:NTPHENC)) + if (.not.pl%lplanetocentric) then + allocate(pl%nenc(n)) + pl%nenc(:) = 0 + ! Set up inner and outer planet interpolation vector storage containers + do i = 0, NTENC + allocate(pl%outer(i)%x(NDIM, n)) + allocate(pl%outer(i)%v(NDIM, n)) + pl%outer(i)%x(:,:) = 0.0_DP + pl%outer(i)%v(:,:) = 0.0_DP + end do + do i = 0, NTPHENC + allocate(pl%inner(i)%x(NDIM, n)) + allocate(pl%inner(i)%v(NDIM, n)) + allocate(pl%inner(i)%aobl(NDIM, n)) + pl%inner(i)%x(:,:) = 0.0_DP + pl%inner(i)%v(:,:) = 0.0_DP + pl%inner(i)%aobl(:,:) = 0.0_DP + end do + ! if (param%ltides) then + ! do i = 0, NTPHENC + ! allocate(pl%inner(i)%atide(NDIM, n)) + ! pl%inner(i)%atide(:,:) = 0.0_DP + ! end do + ! end if + end if + end associate + return + end subroutine rmvs_util_setup_pl + + + module subroutine rmvs_util_setup_initialize_system(self, param) + !! author: David A. Minton + !! + !! Initialize an RMVS nbody system from files and sets up the planetocentric structures. + !! + !! We currently rearrange the pl order to keep it consistent with the way Swifter does it + !! In Swifter, the central body occupies the first position in the pl list, and during + !! encounters, the encountering planet is skipped in loops. In Swiftest, we instantiate an + !! RMVS nbody system object attached to each pl to store planetocentric versions of the nbody_system + !! to use during close encounters. + implicit none + ! Arguments + class(rmvs_nbody_system), intent(inout) :: self !! RMVS system object + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + ! Internals + integer(I4B) :: i, j + + ! Call parent method + call whm_util_setup_initialize_system(self, param) + + ! Set up the pl-tp planetocentric encounter structures for pl and cb. The planetocentric tp structures are + ! generated as necessary during close encounter steps. + select type(pl => self%pl) + class is(rmvs_pl) + select type(cb => self%cb) + class is (rmvs_cb) + select type (tp => self%tp) + class is (rmvs_tp) + tp%cb_heliocentric = cb + pl%lplanetocentric = .false. + tp%lplanetocentric = .false. + cb%lplanetocentric = .false. + associate(npl => pl%nbody) + allocate(pl%planetocentric(npl)) + pl%planetocentric(:)%lplanetocentric = .true. + do i = 1, npl + allocate(pl%planetocentric(i)%cb, source=cb) + allocate(rmvs_pl :: pl%planetocentric(i)%pl) + select type(cbenci => pl%planetocentric(i)%cb) + class is (rmvs_cb) + select type(plenci => pl%planetocentric(i)%pl) + class is (rmvs_pl) + cbenci%lplanetocentric = .true. + plenci%lplanetocentric = .true. + call plenci%setup(npl, param) + plenci%status(:) = ACTIVE + plenci%lmask(:) = .true. + ! plind stores the heliocentric index value of a planetocentric planet + ! e.g. Consider an encounter with planet 3. + ! Then the following will be the values of plind: + ! pl%planetocentric(3)%pl%plind(1) = 0 (central body - never used) + ! pl%planetocentric(3)%pl%plind(2) = 1 + ! pl%planetocentric(3)%pl%plind(3) = 2 + ! pl%planetocentric(3)%pl%plind(4) = 4 + ! pl%planetocentric(3)%pl%plind(5) = 5 + ! etc. + allocate(plenci%plind(npl)) + plenci%plind(1:npl) = [(j,j=1,npl)] + plenci%plind(2:npl) = pack(plenci%plind(1:npl), plenci%plind(1:npl) /= i) + plenci%plind(1) = 0 + plenci%Gmass(1) = cb%Gmass + plenci%Gmass(2:npl) = pl%Gmass(plenci%plind(2:npl)) + cbenci%Gmass = pl%Gmass(i) + end select + end select + end do + end associate + end select + end select + end select + return + end subroutine rmvs_util_setup_initialize_system + + + module subroutine rmvs_util_setup_tp(self, n, param) + !! author: David A. Minton + !! + !! Allocate WHM test particle structure + !! + !! Equivalent in functionality to David E. Kaufmann's Swifter routine whm_util_setup.f90 + implicit none + ! Arguments + class(rmvs_tp), intent(inout) :: self !! RMVS test particle object + integer(I4B), intent(in) :: n !! Number of particles to allocate space for + class(swiftest_parameters), intent(in) :: param !! Current run configuration parameter + + !> Call allocation method for parent class. + call self%whm_tp%setup(n, param) + if (n <= 0) return + + allocate(self%lperi(n)) + allocate(self%plperP(n)) + allocate(self%plencP(n)) + + if (self%lplanetocentric) allocate(self%rheliocentric(NDIM, n)) + + self%lperi(:) = .false. + + return + end subroutine rmvs_util_setup_tp + + module subroutine rmvs_util_sort_pl(self, sortby, ascending) !! author: David A. Minton !! diff --git a/src/swiftest/swiftest_driver.f90 b/src/swiftest/swiftest_driver.f90 index 4c0b18ce1..e2ee1c054 100644 --- a/src/swiftest/swiftest_driver.f90 +++ b/src/swiftest/swiftest_driver.f90 @@ -71,7 +71,7 @@ program swiftest_driver if (dump_cadence == 0) dump_cadence = ceiling(nloops / (1.0_DP * istep_out), kind=I8B) ! Construct the main n-body nbody_system using the user-input integrator to choose the type of nbody_system - call swiftest_setup_construct_system(nbody_system, param) + call swiftest_util_setup_construct_system(nbody_system, param) !> Define the maximum number of threads nthreads = 1 ! In the *serial* case diff --git a/src/swiftest/swiftest_module.f90 b/src/swiftest/swiftest_module.f90 index ff94cb85c..d09f88374 100644 --- a/src/swiftest/swiftest_module.f90 +++ b/src/swiftest/swiftest_module.f90 @@ -144,7 +144,7 @@ module swiftest procedure :: accel_obl => swiftest_obl_acc_body !! Compute the barycentric accelerations of bodies due to the oblateness of the central body procedure :: el2xv => swiftest_orbel_el2xv_vec !! Convert orbital elements to position and velocity vectors procedure :: xv2el => swiftest_orbel_xv2el_vec !! Convert position and velocity vectors to orbital elements - procedure :: setup => swiftest_setup_body !! A constructor that sets the number of bodies and allocates all allocatable arrays + procedure :: setup => swiftest_util_setup_body !! A constructor that sets the number of bodies and allocates all allocatable arrays procedure :: accel_user => swiftest_user_kick_getacch_body !! Add user-supplied heliocentric accelerations to planets procedure :: append => swiftest_util_append_body !! Appends elements from one structure to another procedure :: dealloc => swiftest_util_dealloc_body !! Deallocates all allocatable arrays @@ -249,7 +249,7 @@ module swiftest procedure :: discard => swiftest_discard_pl !! Placeholder method for discarding massive bodies procedure :: accel_int => swiftest_kick_getacch_int_pl !! Compute direct cross (third) term heliocentric accelerations of massive bodies procedure :: accel_obl => swiftest_obl_acc_pl !! Compute the barycentric accelerations of bodies due to the oblateness of the central body - procedure :: setup => swiftest_setup_pl !! A base constructor that sets the number of bodies and allocates and initializes all arrays + procedure :: setup => swiftest_util_setup_pl !! A base constructor that sets the number of bodies and allocates and initializes all arrays ! procedure :: accel_tides => tides_kick_getacch_pl !! Compute the accelerations of bodies due to tidal interactions with the central body procedure :: append => swiftest_util_append_pl !! Appends elements from one structure to another procedure :: h2b => swiftest_util_coord_h2b_pl !! Convert massive bodies from heliocentric to barycentric coordinates (position and velocity) @@ -281,14 +281,14 @@ module swiftest integer(I8B) :: npltp !! Number of pl-tp comparisons in the flattened upper triangular matrix integer(I4B), dimension(:), allocatable :: nplenc !! number of encounters with planets this time step !! Note to developers: If you add components to this class, be sure to update methods and subroutines that traverse the - !! component list, such as swiftest_setup_tp and util_spill_tp + !! component list, such as swiftest_util_setup_tp and util_spill_tp contains ! Test particle-specific concrete methods ! These are concrete because they are the same implemenation for all integrators procedure :: discard => swiftest_discard_tp !! Check to see if test particles should be discarded based on their positions relative to the massive bodies procedure :: accel_int => swiftest_kick_getacch_int_tp !! Compute direct cross (third) term heliocentric accelerations of test particles by massive bodies procedure :: accel_obl => swiftest_obl_acc_tp !! Compute the barycentric accelerations of bodies due to the oblateness of the central body - procedure :: setup => swiftest_setup_tp !! A base constructor that sets the number of bodies and + procedure :: setup => swiftest_util_setup_tp !! A base constructor that sets the number of bodies and procedure :: append => swiftest_util_append_tp !! Appends elements from one structure to another procedure :: h2b => swiftest_util_coord_h2b_tp !! Convert test particles from heliocentric to barycentric coordinates (position and velocity) procedure :: b2h => swiftest_util_coord_b2h_tp !! Convert test particles from barycentric to heliocentric coordinates (position and velocity) @@ -385,8 +385,8 @@ module swiftest procedure :: read_in => swiftest_io_read_in_system !! Reads the initial conditions for an nbody system procedure :: read_particle_info => swiftest_io_netcdf_read_particle_info_system !! Read in particle metadata from file procedure :: obl_pot => swiftest_obl_pot_system !! Compute the contribution to the total gravitational potential due solely to the oblateness of the central body - procedure :: initialize => swiftest_setup_initialize_system !! Initialize the nbody_system from input files - procedure :: init_particle_info => swiftest_setup_initialize_particle_info_system !! Initialize the nbody_system from input files + procedure :: initialize => swiftest_util_setup_initialize_system !! Initialize the nbody_system from input files + procedure :: init_particle_info => swiftest_util_setup_initialize_particle_info_system !! Initialize the nbody_system from input files ! procedure :: step_spin => tides_step_spin_system !! Steps the spins of the massive & central bodies due to tides. procedure :: set_msys => swiftest_util_set_msys !! Sets the value of msys from the masses of nbody_system bodies. procedure :: get_energy_and_momentum => swiftest_util_get_energy_momentum_system !! Calculates the total nbody_system energy and momentum @@ -1007,44 +1007,44 @@ module subroutine swiftest_orbel_xv2el_vec(self, cb) class(swiftest_cb), intent(inout) :: cb !! Swiftest central body object end subroutine swiftest_orbel_xv2el_vec - module subroutine swiftest_setup_body(self, n, param) + module subroutine swiftest_util_setup_body(self, n, param) implicit none class(swiftest_body), intent(inout) :: self !! Swiftest body object integer(I4B), intent(in) :: n !! Number of particles to allocate space for class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters - end subroutine swiftest_setup_body + end subroutine swiftest_util_setup_body - module subroutine swiftest_setup_construct_system(nbody_system, param) + module subroutine swiftest_util_setup_construct_system(nbody_system, param) implicit none class(swiftest_nbody_system), allocatable, intent(inout) :: nbody_system !! Swiftest nbody_system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - end subroutine swiftest_setup_construct_system + end subroutine swiftest_util_setup_construct_system - module subroutine swiftest_setup_initialize_particle_info_system(self, param) + module subroutine swiftest_util_setup_initialize_particle_info_system(self, param) implicit none class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nbody system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - end subroutine swiftest_setup_initialize_particle_info_system + end subroutine swiftest_util_setup_initialize_particle_info_system - module subroutine swiftest_setup_initialize_system(self, param) + module subroutine swiftest_util_setup_initialize_system(self, param) implicit none class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nbody_system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - end subroutine swiftest_setup_initialize_system + end subroutine swiftest_util_setup_initialize_system - module subroutine swiftest_setup_pl(self, n, param) + module subroutine swiftest_util_setup_pl(self, n, param) implicit none class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object integer(I4B), intent(in) :: n !! Number of particles to allocate space for class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters - end subroutine swiftest_setup_pl + end subroutine swiftest_util_setup_pl - module subroutine swiftest_setup_tp(self, n, param) + module subroutine swiftest_util_setup_tp(self, n, param) implicit none class(swiftest_tp), intent(inout) :: self !! Swiftest test particle object integer(I4B), intent(in) :: n !! Number of particles to allocate space for class(swiftest_parameters), intent(in) :: param !! Current run configuration parametersr - end subroutine swiftest_setup_tp + end subroutine swiftest_util_setup_tp module subroutine swiftest_user_kick_getacch_body(self, nbody_system, param, t, lbeg) implicit none diff --git a/src/swiftest/swiftest_setup.f90 b/src/swiftest/swiftest_setup.f90 deleted file mode 100644 index c693c96ed..000000000 --- a/src/swiftest/swiftest_setup.f90 +++ /dev/null @@ -1,385 +0,0 @@ -!! Copyright 2022 - David Minton, Carlisle Wishard, Jennifer Pouplin, Jake Elliott, & Dana Singh -!! This file is part of Swiftest. -!! Swiftest is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License -!! as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. -!! Swiftest is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty -!! of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. -!! You should have received a copy of the GNU General Public License along with Swiftest. -!! If not, see: https://www.gnu.org/licenses. - -submodule (swiftest) s_setup - use whm - use rmvs - use helio - use symba - use fraggle -contains - - module subroutine swiftest_setup_construct_system(nbody_system, param) - !! author: David A. Minton - !! - !! Constructor for a Swiftest nbody system. Creates the nbody system object based on the user-input integrator - !! - implicit none - ! Arguments - class(swiftest_nbody_system), allocatable, intent(inout) :: nbody_system !! Swiftest nbody_system object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - ! Internals - type(encounter_storage) :: encounter_history - type(collision_storage) :: collision_history - - select type(param) - class is (swiftest_parameters) - allocate(swiftest_storage(param%dump_cadence) :: param%system_history) - allocate(swiftest_netcdf_parameters :: param%system_history%nc) - call param%system_history%reset() - - select case(param%integrator) - case (INT_BS) - write(*,*) 'Bulirsch-Stoer integrator not yet enabled' - case (INT_HELIO) - allocate(helio_nbody_system :: nbody_system) - select type(nbody_system) - class is (helio_nbody_system) - allocate(helio_cb :: nbody_system%cb) - allocate(helio_pl :: nbody_system%pl) - allocate(helio_tp :: nbody_system%tp) - allocate(helio_tp :: nbody_system%tp_discards) - end select - param%collision_model = "MERGE" - case (INT_RA15) - write(*,*) 'Radau integrator not yet enabled' - case (INT_TU4) - write(*,*) 'INT_TU4 integrator not yet enabled' - case (INT_WHM) - allocate(whm_nbody_system :: nbody_system) - select type(nbody_system) - class is (whm_nbody_system) - allocate(whm_cb :: nbody_system%cb) - allocate(whm_pl :: nbody_system%pl) - allocate(whm_tp :: nbody_system%tp) - allocate(whm_tp :: nbody_system%tp_discards) - end select - param%collision_model = "MERGE" - case (INT_RMVS) - allocate(rmvs_nbody_system :: nbody_system) - select type(nbody_system) - class is (rmvs_nbody_system) - allocate(rmvs_cb :: nbody_system%cb) - allocate(rmvs_pl :: nbody_system%pl) - allocate(rmvs_tp :: nbody_system%tp) - allocate(rmvs_tp :: nbody_system%tp_discards) - end select - param%collision_model = "MERGE" - case (INT_SYMBA) - allocate(symba_nbody_system :: nbody_system) - select type(nbody_system) - class is (symba_nbody_system) - allocate(symba_cb :: nbody_system%cb) - allocate(symba_pl :: nbody_system%pl) - allocate(symba_tp :: nbody_system%tp) - - allocate(symba_tp :: nbody_system%tp_discards) - allocate(symba_pl :: nbody_system%pl_adds) - allocate(symba_pl :: nbody_system%pl_discards) - - allocate(symba_list_pltp :: nbody_system%pltp_encounter) - allocate(symba_list_plpl :: nbody_system%plpl_encounter) - allocate(collision_list_plpl :: nbody_system%plpl_collision) - - if (param%lenc_save_trajectory .or. param%lenc_save_closest) then - allocate(encounter_netcdf_parameters :: encounter_history%nc) - call encounter_history%reset() - select type(nc => encounter_history%nc) - class is (encounter_netcdf_parameters) - nc%file_number = param%iloop / param%dump_cadence - end select - allocate(nbody_system%encounter_history, source=encounter_history) - end if - - allocate(collision_netcdf_parameters :: collision_history%nc) - call collision_history%reset() - select type(nc => collision_history%nc) - class is (collision_netcdf_parameters) - nc%file_number = param%iloop / param%dump_cadence - end select - allocate(nbody_system%collision_history, source=collision_history) - - end select - case (INT_RINGMOONS) - write(*,*) 'RINGMOONS-SyMBA integrator not yet enabled' - case default - write(*,*) 'Unkown integrator',param%integrator - call util_exit(FAILURE) - end select - - allocate(swiftest_particle_info :: nbody_system%cb%info) - - select case(param%collision_model) - case("MERGE") - allocate(collision_merge :: nbody_system%collider) - case("BOUNCE") - allocate(collision_bounce :: nbody_system%collider) - case("SIMPLE") - allocate(collision_simple_disruption :: nbody_system%collider) - case("FRAGGLE") - allocate(collision_fraggle :: nbody_system%collider) - end select - call nbody_system%collider%setup(nbody_system) - - end select - - return - end subroutine swiftest_setup_construct_system - - - module subroutine swiftest_setup_initialize_particle_info_system(self, param) - !! author: David A. Minton - !! - !! Setup up particle information metadata from initial conditions - ! - implicit none - ! Arguments - class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nbody system object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - ! Internals - integer(I4B) :: i - - associate(pl => self%pl, npl => self%pl%nbody, tp => self%tp, ntp => self%tp%nbody) - - if (.not. allocated(self%cb%info)) allocate(swiftest_particle_info :: self%cb%info) - - call self%cb%info%set_value(particle_type=CB_TYPE_NAME, status="ACTIVE", origin_type="Initial conditions", & - origin_time=param%t0, origin_rh=[0.0_DP, 0.0_DP, 0.0_DP], origin_vh=[0.0_DP, 0.0_DP, 0.0_DP]) - do i = 1, self%pl%nbody - call pl%info(i)%set_value(particle_type=PL_TYPE_NAME, status="ACTIVE", origin_type="Initial conditions", & - origin_time=param%t0, origin_rh=self%pl%rh(:,i), origin_vh=self%pl%vh(:,i)) - end do - do i = 1, self%tp%nbody - call tp%info(i)%set_value(particle_type=TP_TYPE_NAME, status="ACTIVE", origin_type="Initial conditions", & - origin_time=param%t0, origin_rh=self%tp%rh(:,i), origin_vh=self%tp%vh(:,i)) - end do - - end associate - - return - end subroutine swiftest_setup_initialize_particle_info_system - - - module subroutine swiftest_setup_initialize_system(self, param) - !! author: David A. Minton - !! - !! Wrapper method to initialize a basic Swiftest nbody system from files - !! - implicit none - ! Arguments - class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nbody_system object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - - associate(nbody_system => self, cb => self%cb, pl => self%pl, tp => self%tp) - - call nbody_system%read_in(param) - call nbody_system%validate_ids(param) - call nbody_system%set_msys() - call pl%set_mu(cb) - call tp%set_mu(cb) - if (param%in_form == "EL") then - call pl%el2xv(cb) - call tp%el2xv(cb) - end if - call pl%flatten(param) - if (.not.param%lrhill_present) call pl%set_rhill(cb) - pl%lfirst = param%lfirstkick - tp%lfirst = param%lfirstkick - - if (.not.param%lrestart) then - call nbody_system%init_particle_info(param) - end if - end associate - - return - end subroutine swiftest_setup_initialize_system - - - module subroutine swiftest_setup_body(self, n, param) - !! author: David A. Minton - !! - !! Constructor for base Swiftest particle class. Allocates space for all particles and - !! initializes all components with a value. - !! Note: Timing tests indicate that (NDIM, n) is more efficient than (NDIM, n) - implicit none - ! Arguments - class(swiftest_body), intent(inout) :: self !! Swiftest generic body object - integer(I4B), intent(in) :: n !! Number of particles to allocate space for - class(swiftest_parameters), intent(in) :: param !! Current run configuration parameter - ! Internals - integer(I4B) :: i - - if (n < 0) return - - self%lfirst = .true. - - call self%dealloc() - - self%nbody = n - if (n == 0) return - - allocate(swiftest_particle_info :: self%info(n)) - allocate(self%id(n)) - allocate(self%status(n)) - allocate(self%ldiscard(n)) - allocate(self%lmask(n)) - allocate(self%mu(n)) - allocate(self%rh(NDIM, n)) - allocate(self%vh(NDIM, n)) - allocate(self%rb(NDIM, n)) - allocate(self%vb(NDIM, n)) - allocate(self%ah(NDIM, n)) - allocate(self%ir3h(n)) - allocate(self%aobl(NDIM, n)) - if (param%lclose) then - allocate(self%lcollision(n)) - allocate(self%lencounter(n)) - self%lcollision(:) = .false. - self%lencounter(:) = .false. - end if - - self%id(:) = 0 - do i = 1, n - call self%info(i)%set_value(& - name = "UNNAMED", & - particle_type = "UNKNOWN", & - status = "INACTIVE", & - origin_type = "UNKNOWN", & - collision_id = 0, & - origin_time = -huge(1.0_DP), & - origin_rh = [0.0_DP, 0.0_DP, 0.0_DP], & - origin_vh = [0.0_DP, 0.0_DP, 0.0_DP], & - discard_time = huge(1.0_DP), & - discard_rh = [0.0_DP, 0.0_DP, 0.0_DP], & - discard_vh = [0.0_DP, 0.0_DP, 0.0_DP], & - discard_body_id = -1 & - ) - end do - - self%status(:) = INACTIVE - self%ldiscard(:) = .false. - self%lmask(:) = .false. - self%mu(:) = 0.0_DP - self%rh(:,:) = 0.0_DP - self%vh(:,:) = 0.0_DP - self%rb(:,:) = 0.0_DP - self%vb(:,:) = 0.0_DP - self%ah(:,:) = 0.0_DP - self%ir3h(:) = 0.0_DP - self%aobl(:,:) = 0.0_DP - - if (param%ltides) then - allocate(self%atide(NDIM, n)) - self%atide(:,:) = 0.0_DP - end if - if (param%lgr) then - allocate(self%agr(NDIM, n)) - self%agr(:,:) = 0.0_DP - end if - - return - end subroutine swiftest_setup_body - - - module subroutine swiftest_setup_pl(self, n, param) - !! author: David A. Minton - !! - !! Constructor for base Swiftest massive body class. Allocates space for all particles and - !! initializes all components with a value. - implicit none - ! Arguments - class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object - integer(I4B), intent(in) :: n !! Number of particles to allocate space for - class(swiftest_parameters), intent(in) :: param !! Current run configuration parameter - - !> Call allocation method for parent class - !> The parent class here is the abstract swiftest_body class, so we can't use the type-bound procedure - call swiftest_setup_body(self, n, param) - if (n == 0) return - - allocate(self%mass(n)) - allocate(self%Gmass(n)) - allocate(self%rhill(n)) - allocate(self%renc(n)) - - self%mass(:) = 0.0_DP - self%Gmass(:) = 0.0_DP - self%rhill(:) = 0.0_DP - self%renc(:) = 0.0_DP - - self%nplpl = 0 - - if (param%lclose) then - allocate(self%nplenc(n)) - allocate(self%ntpenc(n)) - allocate(self%radius(n)) - allocate(self%density(n)) - - self%nplenc(:) = 0 - self%ntpenc(:) = 0 - self%radius(:) = 0.0_DP - self%density(:) = 1.0_DP - - end if - - if (param%lmtiny_pl) then - allocate(self%lmtiny(n)) - self%lmtiny(:) = .false. - end if - - if (param%lrotation) then - allocate(self%rot(NDIM, n)) - allocate(self%Ip(NDIM, n)) - self%rot(:,:) = 0.0_DP - self%Ip(:,:) = 0.0_DP - end if - - if (param%ltides) then - allocate(self%k2(n)) - allocate(self%Q(n)) - allocate(self%tlag(n)) - self%k2(:) = 0.0_DP - self%Q(:) = 0.0_DP - self%tlag(:) = 0.0_DP - end if - - return - end subroutine swiftest_setup_pl - - - module subroutine swiftest_setup_tp(self, n, param) - !! author: David A. Minton - !! - !! Constructor for base Swiftest test particle particle class. Allocates space for - !! all particles and initializes all components with a value. - implicit none - ! Arguments - class(swiftest_tp), intent(inout) :: self !! Swiftest test particle object - integer(I4B), intent(in) :: n !! Number of particles to allocate space for - class(swiftest_parameters), intent(in) :: param !! Current run configuration parameter - - !> Call allocation method for parent class - !> The parent class here is the abstract swiftest_body class, so we can't use the type-bound procedure - call swiftest_setup_body(self, n, param) - if (n == 0) return - - allocate(self%isperi(n)) - allocate(self%peri(n)) - allocate(self%atp(n)) - allocate(self%nplenc(n)) - - self%isperi(:) = 0 - self%peri(:) = 0.0_DP - self%atp(:) = 0.0_DP - self%nplenc(:) = 0 - - return - end subroutine swiftest_setup_tp - -end submodule s_setup diff --git a/src/swiftest/swiftest_util.f90 b/src/swiftest/swiftest_util.f90 index b94dbbd07..56f2259f6 100644 --- a/src/swiftest/swiftest_util.f90 +++ b/src/swiftest/swiftest_util.f90 @@ -8,6 +8,11 @@ !! If not, see: https://www.gnu.org/licenses. submodule (swiftest) s_util + use whm + use rmvs + use helio + use symba + use fraggle contains module subroutine swiftest_util_append_arr_char_string(arr, source, nold, nsrc, lsource_mask) @@ -2541,6 +2546,374 @@ module subroutine swiftest_util_set_rhill_approximate(self,cb) end subroutine swiftest_util_set_rhill_approximate + module subroutine swiftest_util_setup_construct_system(nbody_system, param) + !! author: David A. Minton + !! + !! Constructor for a Swiftest nbody system. Creates the nbody system object based on the user-input integrator + !! + implicit none + ! Arguments + class(swiftest_nbody_system), allocatable, intent(inout) :: nbody_system !! Swiftest nbody_system object + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + ! Internals + type(encounter_storage) :: encounter_history + type(collision_storage) :: collision_history + + select type(param) + class is (swiftest_parameters) + allocate(swiftest_storage(param%dump_cadence) :: param%system_history) + allocate(swiftest_netcdf_parameters :: param%system_history%nc) + call param%system_history%reset() + + select case(param%integrator) + case (INT_BS) + write(*,*) 'Bulirsch-Stoer integrator not yet enabled' + case (INT_HELIO) + allocate(helio_nbody_system :: nbody_system) + select type(nbody_system) + class is (helio_nbody_system) + allocate(helio_cb :: nbody_system%cb) + allocate(helio_pl :: nbody_system%pl) + allocate(helio_tp :: nbody_system%tp) + allocate(helio_tp :: nbody_system%tp_discards) + end select + param%collision_model = "MERGE" + case (INT_RA15) + write(*,*) 'Radau integrator not yet enabled' + case (INT_TU4) + write(*,*) 'INT_TU4 integrator not yet enabled' + case (INT_WHM) + allocate(whm_nbody_system :: nbody_system) + select type(nbody_system) + class is (whm_nbody_system) + allocate(whm_cb :: nbody_system%cb) + allocate(whm_pl :: nbody_system%pl) + allocate(whm_tp :: nbody_system%tp) + allocate(whm_tp :: nbody_system%tp_discards) + end select + param%collision_model = "MERGE" + case (INT_RMVS) + allocate(rmvs_nbody_system :: nbody_system) + select type(nbody_system) + class is (rmvs_nbody_system) + allocate(rmvs_cb :: nbody_system%cb) + allocate(rmvs_pl :: nbody_system%pl) + allocate(rmvs_tp :: nbody_system%tp) + allocate(rmvs_tp :: nbody_system%tp_discards) + end select + param%collision_model = "MERGE" + case (INT_SYMBA) + allocate(symba_nbody_system :: nbody_system) + select type(nbody_system) + class is (symba_nbody_system) + allocate(symba_cb :: nbody_system%cb) + allocate(symba_pl :: nbody_system%pl) + allocate(symba_tp :: nbody_system%tp) + + allocate(symba_tp :: nbody_system%tp_discards) + allocate(symba_pl :: nbody_system%pl_adds) + allocate(symba_pl :: nbody_system%pl_discards) + + allocate(symba_list_pltp :: nbody_system%pltp_encounter) + allocate(symba_list_plpl :: nbody_system%plpl_encounter) + allocate(collision_list_plpl :: nbody_system%plpl_collision) + + if (param%lenc_save_trajectory .or. param%lenc_save_closest) then + allocate(encounter_netcdf_parameters :: encounter_history%nc) + call encounter_history%reset() + select type(nc => encounter_history%nc) + class is (encounter_netcdf_parameters) + nc%file_number = param%iloop / param%dump_cadence + end select + allocate(nbody_system%encounter_history, source=encounter_history) + end if + + allocate(collision_netcdf_parameters :: collision_history%nc) + call collision_history%reset() + select type(nc => collision_history%nc) + class is (collision_netcdf_parameters) + nc%file_number = param%iloop / param%dump_cadence + end select + allocate(nbody_system%collision_history, source=collision_history) + + end select + case (INT_RINGMOONS) + write(*,*) 'RINGMOONS-SyMBA integrator not yet enabled' + case default + write(*,*) 'Unkown integrator',param%integrator + call util_exit(FAILURE) + end select + + allocate(swiftest_particle_info :: nbody_system%cb%info) + + select case(param%collision_model) + case("MERGE") + allocate(collision_merge :: nbody_system%collider) + case("BOUNCE") + allocate(collision_bounce :: nbody_system%collider) + case("SIMPLE") + allocate(collision_simple_disruption :: nbody_system%collider) + case("FRAGGLE") + allocate(collision_fraggle :: nbody_system%collider) + end select + call nbody_system%collider%setup(nbody_system) + + end select + + return + end subroutine swiftest_util_setup_construct_system + + + module subroutine swiftest_util_setup_initialize_particle_info_system(self, param) + !! author: David A. Minton + !! + !! Setup up particle information metadata from initial conditions + ! + implicit none + ! Arguments + class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nbody system object + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + ! Internals + integer(I4B) :: i + + associate(pl => self%pl, npl => self%pl%nbody, tp => self%tp, ntp => self%tp%nbody) + + if (.not. allocated(self%cb%info)) allocate(swiftest_particle_info :: self%cb%info) + + call self%cb%info%set_value(particle_type=CB_TYPE_NAME, status="ACTIVE", origin_type="Initial conditions", & + origin_time=param%t0, origin_rh=[0.0_DP, 0.0_DP, 0.0_DP], origin_vh=[0.0_DP, 0.0_DP, 0.0_DP]) + do i = 1, self%pl%nbody + call pl%info(i)%set_value(particle_type=PL_TYPE_NAME, status="ACTIVE", origin_type="Initial conditions", & + origin_time=param%t0, origin_rh=self%pl%rh(:,i), origin_vh=self%pl%vh(:,i)) + end do + do i = 1, self%tp%nbody + call tp%info(i)%set_value(particle_type=TP_TYPE_NAME, status="ACTIVE", origin_type="Initial conditions", & + origin_time=param%t0, origin_rh=self%tp%rh(:,i), origin_vh=self%tp%vh(:,i)) + end do + + end associate + + return + end subroutine swiftest_util_setup_initialize_particle_info_system + + + module subroutine swiftest_util_setup_initialize_system(self, param) + !! author: David A. Minton + !! + !! Wrapper method to initialize a basic Swiftest nbody system from files + !! + implicit none + ! Arguments + class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nbody_system object + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + + associate(nbody_system => self, cb => self%cb, pl => self%pl, tp => self%tp) + + call nbody_system%read_in(param) + call nbody_system%validate_ids(param) + call nbody_system%set_msys() + call pl%set_mu(cb) + call tp%set_mu(cb) + if (param%in_form == "EL") then + call pl%el2xv(cb) + call tp%el2xv(cb) + end if + call pl%flatten(param) + if (.not.param%lrhill_present) call pl%set_rhill(cb) + pl%lfirst = param%lfirstkick + tp%lfirst = param%lfirstkick + + if (.not.param%lrestart) then + call nbody_system%init_particle_info(param) + end if + end associate + + return + end subroutine swiftest_util_setup_initialize_system + + + module subroutine swiftest_util_setup_body(self, n, param) + !! author: David A. Minton + !! + !! Constructor for base Swiftest particle class. Allocates space for all particles and + !! initializes all components with a value. + !! Note: Timing tests indicate that (NDIM, n) is more efficient than (NDIM, n) + implicit none + ! Arguments + class(swiftest_body), intent(inout) :: self !! Swiftest generic body object + integer(I4B), intent(in) :: n !! Number of particles to allocate space for + class(swiftest_parameters), intent(in) :: param !! Current run configuration parameter + ! Internals + integer(I4B) :: i + + if (n < 0) return + + self%lfirst = .true. + + call self%dealloc() + + self%nbody = n + if (n == 0) return + + allocate(swiftest_particle_info :: self%info(n)) + allocate(self%id(n)) + allocate(self%status(n)) + allocate(self%ldiscard(n)) + allocate(self%lmask(n)) + allocate(self%mu(n)) + allocate(self%rh(NDIM, n)) + allocate(self%vh(NDIM, n)) + allocate(self%rb(NDIM, n)) + allocate(self%vb(NDIM, n)) + allocate(self%ah(NDIM, n)) + allocate(self%ir3h(n)) + allocate(self%aobl(NDIM, n)) + if (param%lclose) then + allocate(self%lcollision(n)) + allocate(self%lencounter(n)) + self%lcollision(:) = .false. + self%lencounter(:) = .false. + end if + + self%id(:) = 0 + do i = 1, n + call self%info(i)%set_value(& + name = "UNNAMED", & + particle_type = "UNKNOWN", & + status = "INACTIVE", & + origin_type = "UNKNOWN", & + collision_id = 0, & + origin_time = -huge(1.0_DP), & + origin_rh = [0.0_DP, 0.0_DP, 0.0_DP], & + origin_vh = [0.0_DP, 0.0_DP, 0.0_DP], & + discard_time = huge(1.0_DP), & + discard_rh = [0.0_DP, 0.0_DP, 0.0_DP], & + discard_vh = [0.0_DP, 0.0_DP, 0.0_DP], & + discard_body_id = -1 & + ) + end do + + self%status(:) = INACTIVE + self%ldiscard(:) = .false. + self%lmask(:) = .false. + self%mu(:) = 0.0_DP + self%rh(:,:) = 0.0_DP + self%vh(:,:) = 0.0_DP + self%rb(:,:) = 0.0_DP + self%vb(:,:) = 0.0_DP + self%ah(:,:) = 0.0_DP + self%ir3h(:) = 0.0_DP + self%aobl(:,:) = 0.0_DP + + if (param%ltides) then + allocate(self%atide(NDIM, n)) + self%atide(:,:) = 0.0_DP + end if + if (param%lgr) then + allocate(self%agr(NDIM, n)) + self%agr(:,:) = 0.0_DP + end if + + return + end subroutine swiftest_util_setup_body + + + module subroutine swiftest_util_setup_pl(self, n, param) + !! author: David A. Minton + !! + !! Constructor for base Swiftest massive body class. Allocates space for all particles and + !! initializes all components with a value. + implicit none + ! Arguments + class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object + integer(I4B), intent(in) :: n !! Number of particles to allocate space for + class(swiftest_parameters), intent(in) :: param !! Current run configuration parameter + + !> Call allocation method for parent class + !> The parent class here is the abstract swiftest_body class, so we can't use the type-bound procedure + call swiftest_util_setup_body(self, n, param) + if (n == 0) return + + allocate(self%mass(n)) + allocate(self%Gmass(n)) + allocate(self%rhill(n)) + allocate(self%renc(n)) + + self%mass(:) = 0.0_DP + self%Gmass(:) = 0.0_DP + self%rhill(:) = 0.0_DP + self%renc(:) = 0.0_DP + + self%nplpl = 0 + + if (param%lclose) then + allocate(self%nplenc(n)) + allocate(self%ntpenc(n)) + allocate(self%radius(n)) + allocate(self%density(n)) + + self%nplenc(:) = 0 + self%ntpenc(:) = 0 + self%radius(:) = 0.0_DP + self%density(:) = 1.0_DP + + end if + + if (param%lmtiny_pl) then + allocate(self%lmtiny(n)) + self%lmtiny(:) = .false. + end if + + if (param%lrotation) then + allocate(self%rot(NDIM, n)) + allocate(self%Ip(NDIM, n)) + self%rot(:,:) = 0.0_DP + self%Ip(:,:) = 0.0_DP + end if + + if (param%ltides) then + allocate(self%k2(n)) + allocate(self%Q(n)) + allocate(self%tlag(n)) + self%k2(:) = 0.0_DP + self%Q(:) = 0.0_DP + self%tlag(:) = 0.0_DP + end if + + return + end subroutine swiftest_util_setup_pl + + + module subroutine swiftest_util_setup_tp(self, n, param) + !! author: David A. Minton + !! + !! Constructor for base Swiftest test particle particle class. Allocates space for + !! all particles and initializes all components with a value. + implicit none + ! Arguments + class(swiftest_tp), intent(inout) :: self !! Swiftest test particle object + integer(I4B), intent(in) :: n !! Number of particles to allocate space for + class(swiftest_parameters), intent(in) :: param !! Current run configuration parameter + + !> Call allocation method for parent class + !> The parent class here is the abstract swiftest_body class, so we can't use the type-bound procedure + call swiftest_util_setup_body(self, n, param) + if (n == 0) return + + allocate(self%isperi(n)) + allocate(self%peri(n)) + allocate(self%atp(n)) + allocate(self%nplenc(n)) + + self%isperi(:) = 0 + self%peri(:) = 0.0_DP + self%atp(:) = 0.0_DP + self%nplenc(:) = 0 + + return + end subroutine swiftest_util_setup_tp + + module subroutine swiftest_util_snapshot_system(self, param, nbody_system, t, arg) !! author: David A. Minton !! @@ -2628,7 +3001,7 @@ pure module subroutine swiftest_util_sort_dp(arr) ! Arguments real(DP), dimension(:), intent(inout) :: arr - call swiftest_qsort_DP(arr) + call swiftest_util_sort_qsort_DP(arr) return end subroutine swiftest_util_sort_dp @@ -2657,13 +3030,13 @@ pure module subroutine swiftest_util_sort_index_dp(arr, ind) end if allocate(tmparr, mold=arr) tmparr(:) = arr(ind(:)) - call swiftest_qsort_DP(tmparr, ind) + call swiftest_util_sort_qsort_DP(tmparr, ind) return end subroutine swiftest_util_sort_index_dp - recursive pure subroutine swiftest_qsort_DP(arr, ind) + recursive pure subroutine swiftest_util_sort_qsort_DP(arr, ind) !! author: David A. Minton !! !! Sort input DP precision array by index in ascending numerical order using quicksort sort. @@ -2677,21 +3050,21 @@ recursive pure subroutine swiftest_qsort_DP(arr, ind) if (size(arr) > 1) then if (present(ind)) then - call swiftest_partition_DP(arr, iq, ind) - call swiftest_qsort_DP(arr(:iq-1),ind(:iq-1)) - call swiftest_qsort_DP(arr(iq:), ind(iq:)) + call swiftest_util_sort_partition_DP(arr, iq, ind) + call swiftest_util_sort_qsort_DP(arr(:iq-1),ind(:iq-1)) + call swiftest_util_sort_qsort_DP(arr(iq:), ind(iq:)) else - call swiftest_partition_DP(arr, iq) - call swiftest_qsort_DP(arr(:iq-1)) - call swiftest_qsort_DP(arr(iq:)) + call swiftest_util_sort_partition_DP(arr, iq) + call swiftest_util_sort_qsort_DP(arr(:iq-1)) + call swiftest_util_sort_qsort_DP(arr(iq:)) end if end if return - end subroutine swiftest_qsort_DP + end subroutine swiftest_util_sort_qsort_DP - pure subroutine swiftest_partition_DP(arr, marker, ind) + pure subroutine swiftest_util_sort_partition_DP(arr, marker, ind) !! author: David A. Minton !! !! Partition function for quicksort on DP type @@ -2745,7 +3118,7 @@ pure subroutine swiftest_partition_DP(arr, marker, ind) end do return - end subroutine swiftest_partition_DP + end subroutine swiftest_util_sort_partition_DP pure module subroutine swiftest_util_sort_i4b(arr) @@ -2758,7 +3131,7 @@ pure module subroutine swiftest_util_sort_i4b(arr) ! Arguments integer(I4B), dimension(:), intent(inout) :: arr - call swiftest_qsort_I4B(arr) + call swiftest_util_sort_qsort_I4B(arr) return end subroutine swiftest_util_sort_i4b @@ -2786,7 +3159,7 @@ pure module subroutine swiftest_util_sort_index_I4B(arr, ind) end if allocate(tmparr, mold=arr) tmparr(:) = arr(ind(:)) - call swiftest_qsort_I4B(tmparr, ind) + call swiftest_util_sort_qsort_I4B(tmparr, ind) return end subroutine swiftest_util_sort_index_I4B @@ -2814,13 +3187,13 @@ pure module subroutine swiftest_util_sort_index_I4B_I8Bind(arr, ind) end if allocate(tmparr, mold=arr) tmparr(:) = arr(ind(:)) - call swiftest_qsort_I4B_I8Bind(tmparr, ind) + call swiftest_util_sort_qsort_I4B_I8Bind(tmparr, ind) return end subroutine swiftest_util_sort_index_I4B_I8Bind - recursive pure subroutine swiftest_qsort_I4B(arr, ind) + recursive pure subroutine swiftest_util_sort_qsort_I4B(arr, ind) !! author: David A. Minton !! !! Sort input I4B array by index in ascending numerical order using quicksort. @@ -2834,20 +3207,21 @@ recursive pure subroutine swiftest_qsort_I4B(arr, ind) if (size(arr) > 1) then if (present(ind)) then - call swiftest_partition_I4B(arr, iq, ind) - call swiftest_qsort_I4B(arr(:iq-1),ind(:iq-1)) - call swiftest_qsort_I4B(arr(iq:), ind(iq:)) + call swiftest_util_sort_partition_I4B(arr, iq, ind) + call swiftest_util_sort_qsort_I4B(arr(:iq-1),ind(:iq-1)) + call swiftest_util_sort_qsort_I4B(arr(iq:), ind(iq:)) else - call swiftest_partition_I4B(arr, iq) - call swiftest_qsort_I4B(arr(:iq-1)) - call swiftest_qsort_I4B(arr(iq:)) + call swiftest_util_sort_partition_I4B(arr, iq) + call swiftest_util_sort_qsort_I4B(arr(:iq-1)) + call swiftest_util_sort_qsort_I4B(arr(iq:)) end if end if return - end subroutine swiftest_qsort_I4B + end subroutine swiftest_util_sort_qsort_I4B - recursive pure subroutine swiftest_qsort_I4B_I8Bind(arr, ind) + + recursive pure subroutine swiftest_util_sort_qsort_I4B_I8Bind(arr, ind) !! author: David A. Minton !! !! Sort input I4B array by index in ascending numerical order using quicksort. @@ -2861,21 +3235,21 @@ recursive pure subroutine swiftest_qsort_I4B_I8Bind(arr, ind) if (size(arr) > 1_I8B) then if (present(ind)) then - call swiftest_partition_I4B_I8Bind(arr, iq, ind) - call swiftest_qsort_I4B_I8Bind(arr(:iq-1_I8B),ind(:iq-1_I8B)) - call swiftest_qsort_I4B_I8Bind(arr(iq:), ind(iq:)) + call swiftest_util_sort_partition_I4B_I8Bind(arr, iq, ind) + call swiftest_util_sort_qsort_I4B_I8Bind(arr(:iq-1_I8B),ind(:iq-1_I8B)) + call swiftest_util_sort_qsort_I4B_I8Bind(arr(iq:), ind(iq:)) else - call swiftest_partition_I4B_I8Bind(arr, iq) - call swiftest_qsort_I4B_I8Bind(arr(:iq-1_I8B)) - call swiftest_qsort_I4B_I8Bind(arr(iq:)) + call swiftest_util_sort_partition_I4B_I8Bind(arr, iq) + call swiftest_util_sort_qsort_I4B_I8Bind(arr(:iq-1_I8B)) + call swiftest_util_sort_qsort_I4B_I8Bind(arr(iq:)) end if end if return - end subroutine swiftest_qsort_I4B_I8Bind + end subroutine swiftest_util_sort_qsort_I4B_I8Bind - recursive pure subroutine swiftest_qsort_I8B_I8Bind(arr, ind) + recursive pure subroutine swiftest_util_sort_qsort_I8B_I8Bind(arr, ind) !! author: David A. Minton !! !! Sort input I8B array by index in ascending numerical order using quicksort. @@ -2889,21 +3263,21 @@ recursive pure subroutine swiftest_qsort_I8B_I8Bind(arr, ind) if (size(arr) > 1_I8B) then if (present(ind)) then - call swiftest_partition_I8B_I8Bind(arr, iq, ind) - call swiftest_qsort_I8B_I8Bind(arr(:iq-1_I8B),ind(:iq-1_I8B)) - call swiftest_qsort_I8B_I8Bind(arr(iq:), ind(iq:)) + call swiftest_util_sort_partition_I8B_I8Bind(arr, iq, ind) + call swiftest_util_sort_qsort_I8B_I8Bind(arr(:iq-1_I8B),ind(:iq-1_I8B)) + call swiftest_util_sort_qsort_I8B_I8Bind(arr(iq:), ind(iq:)) else - call swiftest_partition_I8B_I8Bind(arr, iq) - call swiftest_qsort_I8B_I8Bind(arr(:iq-1_I8B)) - call swiftest_qsort_I8B_I8Bind(arr(iq:)) + call swiftest_util_sort_partition_I8B_I8Bind(arr, iq) + call swiftest_util_sort_qsort_I8B_I8Bind(arr(:iq-1_I8B)) + call swiftest_util_sort_qsort_I8B_I8Bind(arr(iq:)) end if end if return - end subroutine swiftest_qsort_I8B_I8Bind + end subroutine swiftest_util_sort_qsort_I8B_I8Bind - pure subroutine swiftest_partition_I4B(arr, marker, ind) + pure subroutine swiftest_util_sort_partition_I4B(arr, marker, ind) !! author: David A. Minton !! !! Partition function for quicksort on I4B type @@ -2957,9 +3331,10 @@ pure subroutine swiftest_partition_I4B(arr, marker, ind) end do return - end subroutine swiftest_partition_I4B + end subroutine swiftest_util_sort_partition_I4B + - pure subroutine swiftest_partition_I4B_I8Bind(arr, marker, ind) + pure subroutine swiftest_util_sort_partition_I4B_I8Bind(arr, marker, ind) !! author: David A. Minton !! !! Partition function for quicksort on I4B type @@ -3013,9 +3388,10 @@ pure subroutine swiftest_partition_I4B_I8Bind(arr, marker, ind) end do return - end subroutine swiftest_partition_I4B_I8Bind + end subroutine swiftest_util_sort_partition_I4B_I8Bind + - pure subroutine swiftest_partition_I8B_I8Bind(arr, marker, ind) + pure subroutine swiftest_util_sort_partition_I8B_I8Bind(arr, marker, ind) !! author: David A. Minton !! !! Partition function for quicksort on I8B type with I8B index @@ -3069,7 +3445,7 @@ pure subroutine swiftest_partition_I8B_I8Bind(arr, marker, ind) end do return - end subroutine swiftest_partition_I8B_I8Bind + end subroutine swiftest_util_sort_partition_I8B_I8Bind pure module subroutine swiftest_util_sort_sp(arr) @@ -3081,7 +3457,7 @@ pure module subroutine swiftest_util_sort_sp(arr) ! Arguments real(SP), dimension(:), intent(inout) :: arr - call swiftest_qsort_SP(arr) + call swiftest_util_sort_qsort_SP(arr) return end subroutine swiftest_util_sort_sp @@ -3109,13 +3485,13 @@ pure module subroutine swiftest_util_sort_index_sp(arr, ind) end if allocate(tmparr, mold=arr) tmparr(:) = arr(ind(:)) - call swiftest_qsort_SP(tmparr, ind) + call swiftest_util_sort_qsort_SP(tmparr, ind) return end subroutine swiftest_util_sort_index_sp - recursive pure subroutine swiftest_qsort_SP(arr, ind) + recursive pure subroutine swiftest_util_sort_qsort_SP(arr, ind) !! author: David A. Minton !! !! Sort input DP precision array by index in ascending numerical order using quicksort. @@ -3129,21 +3505,21 @@ recursive pure subroutine swiftest_qsort_SP(arr, ind) if (size(arr) > 1) then if (present(ind)) then - call swiftest_partition_SP(arr, iq, ind) - call swiftest_qsort_SP(arr(:iq-1),ind(:iq-1)) - call swiftest_qsort_SP(arr(iq:), ind(iq:)) + call swiftest_util_sort_partition_SP(arr, iq, ind) + call swiftest_util_sort_qsort_SP(arr(:iq-1),ind(:iq-1)) + call swiftest_util_sort_qsort_SP(arr(iq:), ind(iq:)) else - call swiftest_partition_SP(arr, iq) - call swiftest_qsort_SP(arr(:iq-1)) - call swiftest_qsort_SP(arr(iq:)) + call swiftest_util_sort_partition_SP(arr, iq) + call swiftest_util_sort_qsort_SP(arr(:iq-1)) + call swiftest_util_sort_qsort_SP(arr(iq:)) end if end if return - end subroutine swiftest_qsort_SP + end subroutine swiftest_util_sort_qsort_SP - pure subroutine swiftest_partition_SP(arr, marker, ind) + pure subroutine swiftest_util_sort_partition_SP(arr, marker, ind) !! author: David A. Minton !! !! Partition function for quicksort on SP type @@ -3197,7 +3573,7 @@ pure subroutine swiftest_partition_SP(arr, marker, ind) end do return - end subroutine swiftest_partition_SP + end subroutine swiftest_util_sort_partition_SP module subroutine swiftest_util_sort_pl(self, sortby, ascending) diff --git a/src/symba/symba_module.f90 b/src/symba/symba_module.f90 index 280fe2af8..f120919fe 100644 --- a/src/symba/symba_module.f90 +++ b/src/symba/symba_module.f90 @@ -40,7 +40,7 @@ module symba procedure :: gr_pos_kick => symba_gr_p4_pl !! Position kick due to p**4 term in the post-Newtonian correction procedure :: accel_int => symba_kick_getacch_int_pl !! Compute direct cross (third) term heliocentric accelerations of massive bodiess, with no mutual interactions between bodies below GMTINY procedure :: accel => symba_kick_getacch_pl !! Compute heliocentric accelerations of massive bodies - procedure :: setup => symba_setup_pl !! Constructor method - Allocates space for the input number of bodies + procedure :: setup => symba_util_setup_pl !! Constructor method - Allocates space for the input number of bodies procedure :: append => symba_util_append_pl !! Appends elements from one structure to another procedure :: dealloc => symba_util_dealloc_pl !! Deallocates all allocatable arrays procedure :: fill => symba_util_fill_pl !! "Fills" bodies from one object into another depending on the results of a mask (uses the UNPACK intrinsic) @@ -62,7 +62,7 @@ module symba procedure :: encounter_check => symba_encounter_check_tp !! Checks if any test particles are undergoing a close encounter with a massive body procedure :: gr_pos_kick => symba_gr_p4_tp !! Position kick due to p**4 term in the post-Newtonian correction procedure :: accel => symba_kick_getacch_tp !! Compute heliocentric accelerations of test particles - procedure :: setup => symba_setup_tp !! Constructor method - Allocates space for the input number of bodies + procedure :: setup => symba_util_setup_tp !! Constructor method - Allocates space for the input number of bodies procedure :: append => symba_util_append_tp !! Appends elements from one structure to another procedure :: dealloc => symba_util_dealloc_tp !! Deallocates all allocatable arrays procedure :: fill => symba_util_fill_tp !! "Fills" bodies from one object into another depending on the results of a mask (uses the UNPACK intrinsic) @@ -95,7 +95,7 @@ module symba type, extends(helio_nbody_system) :: symba_nbody_system integer(I4B) :: irec !! nbody_system recursion level contains - procedure :: initialize => symba_setup_initialize_system !! Performs SyMBA-specific initilization steps + procedure :: initialize => symba_util_setup_initialize_system !! Performs SyMBA-specific initilization steps procedure :: step => symba_step_system !! Advance the SyMBA nbody system forward in time by one step procedure :: interp => symba_step_interp_system !! Perform an interpolation step on the SymBA nbody system procedure :: set_recur_levels => symba_step_set_recur_levels_system !! Sets recursion levels of bodies and encounter lists to the current nbody_system level @@ -243,25 +243,25 @@ module subroutine symba_kick_list_pltp(self, nbody_system, dt, irec, sgn) integer(I4B), intent(in) :: sgn !! sign to be applied to acceleration end subroutine symba_kick_list_pltp - module subroutine symba_setup_initialize_system(self, param) + module subroutine symba_util_setup_initialize_system(self, param) implicit none class(symba_nbody_system), intent(inout) :: self !! SyMBA nbody_system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - end subroutine symba_setup_initialize_system + end subroutine symba_util_setup_initialize_system - module subroutine symba_setup_pl(self, n, param) + module subroutine symba_util_setup_pl(self, n, param) implicit none class(symba_pl), intent(inout) :: self !! SyMBA massive body object integer(I4B), intent(in) :: n !! Number of particles to allocate space for class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters - end subroutine symba_setup_pl + end subroutine symba_util_setup_pl - module subroutine symba_setup_tp(self, n, param) + module subroutine symba_util_setup_tp(self, n, param) implicit none class(symba_tp), intent(inout) :: self !! SyMBA test particle object integer(I4B), intent(in) :: n !! Number of particles to allocate space for class(swiftest_parameters), intent(in) :: param !! Current run configuration parameter - end subroutine symba_setup_tp + end subroutine symba_util_setup_tp module subroutine symba_step_system(self, param, t, dt) implicit none diff --git a/src/symba/symba_setup.f90 b/src/symba/symba_setup.f90 deleted file mode 100644 index 20e713c5c..000000000 --- a/src/symba/symba_setup.f90 +++ /dev/null @@ -1,98 +0,0 @@ -!! Copyright 2022 - David Minton, Carlisle Wishard, Jennifer Pouplin, Jake Elliott, & Dana Singh -!! This file is part of Swiftest. -!! Swiftest is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License -!! as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. -!! Swiftest is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty -!! of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. -!! You should have received a copy of the GNU General Public License along with Swiftest. -!! If not, see: https://www.gnu.org/licenses. - -submodule(symba) s_symba_setup - use swiftest -contains - - module subroutine symba_setup_initialize_system(self, param) - !! author: David A. Minton - !! - !! Initialize an SyMBA nbody system from files and sets up the planetocentric structures. - !! This subroutine will also sort the massive bodies in descending order by mass - !! - implicit none - ! Arguments - class(symba_nbody_system), intent(inout) :: self !! SyMBA nbody_system object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - - ! Call parent method - associate(nbody_system => self) - call helio_setup_initialize_system(nbody_system, param) - call nbody_system%pltp_encounter%setup(0_I8B) - call nbody_system%plpl_encounter%setup(0_I8B) - call nbody_system%plpl_collision%setup(0_I8B) - end associate - - return - end subroutine symba_setup_initialize_system - - - module subroutine symba_setup_pl(self, n, param) - !! author: David A. Minton - !! - !! Allocate SyMBA test particle structure - !! - !! Equivalent in functionality to David E. Kaufmann's Swifter routine symba_setup.f90 - implicit none - ! Arguments - class(symba_pl), intent(inout) :: self !! SyMBA massive body object - integer(I4B), intent(in) :: n !! Number of particles to allocate space for - class(swiftest_parameters), intent(in) :: param !! Current run configuration parameter - ! Internals - integer(I4B) :: i - - !> Call allocation method for parent class. - call self%helio_pl%setup(n, param) - if (n == 0) return - - allocate(self%levelg(n)) - allocate(self%levelm(n)) - allocate(self%isperi(n)) - allocate(self%peri(n)) - allocate(self%atp(n)) - allocate(self%kin(n)) - - - self%levelg(:) = -1 - self%levelm(:) = -1 - self%isperi(:) = 0 - self%peri(:) = 0.0_DP - self%atp(:) = 0.0_DP - call self%reset_kinship([(i, i=1, n)]) - return - end subroutine symba_setup_pl - - - module subroutine symba_setup_tp(self, n, param) - !! author: David A. Minton - !! - !! Allocate WHM test particle structure - !! - !! Equivalent in functionality to David E. Kaufmann's Swifter routine whm_setup.f90 - implicit none - ! Arguments - class(symba_tp), intent(inout) :: self !! SyMBA test particle object - integer(I4B), intent(in) :: n !! Number of particles to allocate space for - class(swiftest_parameters), intent(in) :: param !! Current run configuration parameter - - !> Call allocation method for parent class. - call self%helio_tp%setup(n, param) - if (n == 0) return - - allocate(self%levelg(n)) - allocate(self%levelm(n)) - - self%levelg(:) = -1 - self%levelm(:) = -1 - - return - end subroutine symba_setup_tp - -end submodule s_symba_setup diff --git a/src/symba/symba_util.f90 b/src/symba/symba_util.f90 index 18bbbdfdb..87ba8dacf 100644 --- a/src/symba/symba_util.f90 +++ b/src/symba/symba_util.f90 @@ -272,6 +272,90 @@ module subroutine symba_util_set_renc(self, scale) return end subroutine symba_util_set_renc + module subroutine symba_util_setup_initialize_system(self, param) + !! author: David A. Minton + !! + !! Initialize an SyMBA nbody system from files and sets up the planetocentric structures. + !! This subroutine will also sort the massive bodies in descending order by mass + !! + implicit none + ! Arguments + class(symba_nbody_system), intent(inout) :: self !! SyMBA nbody_system object + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + + ! Call parent method + associate(nbody_system => self) + call helio_util_setup_initialize_system(nbody_system, param) + call nbody_system%pltp_encounter%setup(0_I8B) + call nbody_system%plpl_encounter%setup(0_I8B) + call nbody_system%plpl_collision%setup(0_I8B) + end associate + + return + end subroutine symba_util_setup_initialize_system + + + module subroutine symba_util_setup_pl(self, n, param) + !! author: David A. Minton + !! + !! Allocate SyMBA test particle structure + !! + !! Equivalent in functionality to David E. Kaufmann's Swifter routine symba_util_setup.f90 + implicit none + ! Arguments + class(symba_pl), intent(inout) :: self !! SyMBA massive body object + integer(I4B), intent(in) :: n !! Number of particles to allocate space for + class(swiftest_parameters), intent(in) :: param !! Current run configuration parameter + ! Internals + integer(I4B) :: i + + !> Call allocation method for parent class. + call self%helio_pl%setup(n, param) + if (n == 0) return + + allocate(self%levelg(n)) + allocate(self%levelm(n)) + allocate(self%isperi(n)) + allocate(self%peri(n)) + allocate(self%atp(n)) + allocate(self%kin(n)) + + + self%levelg(:) = -1 + self%levelm(:) = -1 + self%isperi(:) = 0 + self%peri(:) = 0.0_DP + self%atp(:) = 0.0_DP + call self%reset_kinship([(i, i=1, n)]) + return + end subroutine symba_util_setup_pl + + + module subroutine symba_util_setup_tp(self, n, param) + !! author: David A. Minton + !! + !! Allocate WHM test particle structure + !! + !! Equivalent in functionality to David E. Kaufmann's Swifter routine whm_util_setup.f90 + implicit none + ! Arguments + class(symba_tp), intent(inout) :: self !! SyMBA test particle object + integer(I4B), intent(in) :: n !! Number of particles to allocate space for + class(swiftest_parameters), intent(in) :: param !! Current run configuration parameter + + !> Call allocation method for parent class. + call self%helio_tp%setup(n, param) + if (n == 0) return + + allocate(self%levelg(n)) + allocate(self%levelm(n)) + + self%levelg(:) = -1 + self%levelm(:) = -1 + + return + end subroutine symba_util_setup_tp + module subroutine symba_util_sort_pl(self, sortby, ascending) !! author: David A. Minton diff --git a/src/whm/whm_module.f90 b/src/whm/whm_module.f90 index fad0d8a55..d902065f6 100644 --- a/src/whm/whm_module.f90 +++ b/src/whm/whm_module.f90 @@ -30,7 +30,7 @@ module whm real(DP), dimension(:), allocatable :: muj !! Jacobi mu: GMcb * eta(i) / eta(i - 1) real(DP), dimension(:), allocatable :: ir3j !! Third term of heliocentric acceleration !! Note to developers: If you add componenets to this class, be sure to update methods and subroutines that traverse the - !! component list, such as whm_setup_pl and whm_util_spill_pl + !! component list, such as whm_util_setup_pl and whm_util_spill_pl contains procedure :: h2j => whm_coord_h2j_pl !! Convert position and velcoity vectors from heliocentric to Jacobi coordinates procedure :: j2h => whm_coord_j2h_pl !! Convert position and velcoity vectors from Jacobi to helliocentric coordinates @@ -49,7 +49,7 @@ module whm procedure :: sort => whm_util_sort_pl !! Sort a WHM massive body object in-place. procedure :: rearrange => whm_util_sort_rearrange_pl !! Rearranges the order of array elements of body based on an input index array. Used in sorting methods procedure :: spill => whm_util_spill_pl !!"Spills" bodies from one object to another depending on the results of a mask (uses the PACK intrinsic) - procedure :: setup => whm_setup_pl !! Constructor method - Allocates space for the input number of bodiess + procedure :: setup => whm_util_setup_pl !! Constructor method - Allocates space for the input number of bodiess procedure :: step => whm_step_pl !! Steps the body forward one stepsize final :: whm_final_pl !! Finalizes the WHM massive body object - deallocates all allocatables end type whm_pl @@ -72,7 +72,7 @@ module whm type, extends(swiftest_nbody_system) :: whm_nbody_system contains !> Replace the abstract procedures with concrete ones - procedure :: initialize => whm_setup_initialize_system !! Performs WHM-specific initilization steps, like calculating the Jacobi masses + procedure :: initialize => whm_util_setup_initialize_system !! Performs WHM-specific initilization steps, like calculating the Jacobi masses procedure :: step => whm_step_system !! Advance the WHM nbody system forward in time by one step final :: whm_final_system !! Finalizes the WHM nbody_system object - deallocates all allocatables end type whm_nbody_system @@ -173,18 +173,18 @@ pure module subroutine whm_gr_p4_tp(self, nbody_system, param, dt) end subroutine whm_gr_p4_tp !> Reads WHM massive body object in from file - module subroutine whm_setup_pl(self, n, param) + module subroutine whm_util_setup_pl(self, n, param) implicit none class(whm_pl), intent(inout) :: self !! WHM massive body objectobject integer(I4B), intent(in) :: n !! Number of particles to allocate space for class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters - end subroutine whm_setup_pl + end subroutine whm_util_setup_pl - module subroutine whm_setup_initialize_system(self, param) + module subroutine whm_util_setup_initialize_system(self, param) implicit none class(whm_nbody_system), intent(inout) :: self !! WHM nbody system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - end subroutine whm_setup_initialize_system + end subroutine whm_util_setup_initialize_system module subroutine whm_step_pl(self, nbody_system, param, t, dt) implicit none diff --git a/src/whm/whm_setup.f90 b/src/whm/whm_setup.f90 deleted file mode 100644 index fe4745777..000000000 --- a/src/whm/whm_setup.f90 +++ /dev/null @@ -1,100 +0,0 @@ -!! Copyright 2022 - David Minton, Carlisle Wishard, Jennifer Pouplin, Jake Elliott, & Dana Singh -!! This file is part of Swiftest. -!! Swiftest is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License -!! as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. -!! Swiftest is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty -!! of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. -!! You should have received a copy of the GNU General Public License along with Swiftest. -!! If not, see: https://www.gnu.org/licenses. - -submodule(whm) s_whm_setup - use swiftest -contains - - module subroutine whm_setup_pl(self, n, param) - !! author: David A. Minton - !! - !! Allocate WHM planet structure - !! - !! Equivalent in functionality to David E. Kaufmann's Swifter routine whm_setup.f90 - implicit none - ! Arguments - class(whm_pl), intent(inout) :: self !! Swiftest test particle object - integer(I4B), intent(in) :: n !! Number of particles to allocate space for - class(swiftest_parameters), intent(in) :: param !! Current run configuration parameter - - !> Call allocation method for parent class - call swiftest_setup_pl(self, n, param) - if (n == 0) return - - allocate(self%eta(n)) - allocate(self%muj(n)) - allocate(self%xj(NDIM, n)) - allocate(self%vj(NDIM, n)) - allocate(self%ir3j(n)) - - self%eta(:) = 0.0_DP - self%muj(:) = 0.0_DP - self%xj(:,:) = 0.0_DP - self%vj(:,:) = 0.0_DP - self%ir3j(:) = 0.0_DP - - return - end subroutine whm_setup_pl - - - module subroutine whm_util_set_mu_eta_pl(self, cb) - !! author: David A. Minton - !! - !! Sets the Jacobi mass value eta for all massive bodies - implicit none - ! Arguments - class(whm_pl), intent(inout) :: self !! WHM nbody_system object - class(swiftest_cb), intent(inout) :: cb !! Swiftest central body object - ! Internals - integer(I4B) :: i - - associate(pl => self, npl => self%nbody) - if (npl == 0) return - call swiftest_util_set_mu_pl(pl, cb) - pl%eta(1) = cb%Gmass + pl%Gmass(1) - pl%muj(1) = pl%eta(1) - do i = 2, npl - pl%eta(i) = pl%eta(i - 1) + pl%Gmass(i) - pl%muj(i) = cb%Gmass * pl%eta(i) / pl%eta(i - 1) - end do - end associate - - return - end subroutine whm_util_set_mu_eta_pl - - - module subroutine whm_setup_initialize_system(self, param) - !! author: David A. Minton - !! - !! Initialize a WHM nbody system from files - !! - implicit none - ! Arguments - class(whm_nbody_system), intent(inout) :: self !! WHM nbody system object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - - call swiftest_setup_initialize_system(self, param) - ! First we need to make sure that the massive bodies are sorted by heliocentric distance before computing jacobies - call swiftest_util_set_ir3h(self%pl) - call self%pl%sort("ir3h", ascending=.false.) - call self%pl%flatten(param) - - ! Make sure that the discard list gets allocated initially - call self%tp_discards%setup(0, param) - call self%pl%set_mu(self%cb) - call self%tp%set_mu(self%cb) - if (param%lgr .and. param%in_type == "ASCII") then !! pseudovelocity conversion for NetCDF input files is handled by NetCDF routines - call self%pl%v2pv(param) - call self%tp%v2pv(param) - end if - - return - end subroutine whm_setup_initialize_system - -end submodule s_whm_setup \ No newline at end of file diff --git a/src/whm/whm_util.f90 b/src/whm/whm_util.f90 index 6ce3ce8df..a9377536d 100644 --- a/src/whm/whm_util.f90 +++ b/src/whm/whm_util.f90 @@ -142,6 +142,93 @@ module subroutine whm_util_set_ir3j(self) end subroutine whm_util_set_ir3j + module subroutine whm_util_setup_pl(self, n, param) + !! author: David A. Minton + !! + !! Allocate WHM planet structure + !! + !! Equivalent in functionality to David E. Kaufmann's Swifter routine whm_util_setup.f90 + implicit none + ! Arguments + class(whm_pl), intent(inout) :: self !! Swiftest test particle object + integer(I4B), intent(in) :: n !! Number of particles to allocate space for + class(swiftest_parameters), intent(in) :: param !! Current run configuration parameter + + !> Call allocation method for parent class + call swiftest_util_setup_pl(self, n, param) + if (n == 0) return + + allocate(self%eta(n)) + allocate(self%muj(n)) + allocate(self%xj(NDIM, n)) + allocate(self%vj(NDIM, n)) + allocate(self%ir3j(n)) + + self%eta(:) = 0.0_DP + self%muj(:) = 0.0_DP + self%xj(:,:) = 0.0_DP + self%vj(:,:) = 0.0_DP + self%ir3j(:) = 0.0_DP + + return + end subroutine whm_util_setup_pl + + + module subroutine whm_util_set_mu_eta_pl(self, cb) + !! author: David A. Minton + !! + !! Sets the Jacobi mass value eta for all massive bodies + implicit none + ! Arguments + class(whm_pl), intent(inout) :: self !! WHM nbody_system object + class(swiftest_cb), intent(inout) :: cb !! Swiftest central body object + ! Internals + integer(I4B) :: i + + associate(pl => self, npl => self%nbody) + if (npl == 0) return + call swiftest_util_set_mu_pl(pl, cb) + pl%eta(1) = cb%Gmass + pl%Gmass(1) + pl%muj(1) = pl%eta(1) + do i = 2, npl + pl%eta(i) = pl%eta(i - 1) + pl%Gmass(i) + pl%muj(i) = cb%Gmass * pl%eta(i) / pl%eta(i - 1) + end do + end associate + + return + end subroutine whm_util_set_mu_eta_pl + + + module subroutine whm_util_setup_initialize_system(self, param) + !! author: David A. Minton + !! + !! Initialize a WHM nbody system from files + !! + implicit none + ! Arguments + class(whm_nbody_system), intent(inout) :: self !! WHM nbody system object + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters + + call swiftest_util_setup_initialize_system(self, param) + ! First we need to make sure that the massive bodies are sorted by heliocentric distance before computing jacobies + call swiftest_util_set_ir3h(self%pl) + call self%pl%sort("ir3h", ascending=.false.) + call self%pl%flatten(param) + + ! Make sure that the discard list gets allocated initially + call self%tp_discards%setup(0, param) + call self%pl%set_mu(self%cb) + call self%tp%set_mu(self%cb) + if (param%lgr .and. param%in_type == "ASCII") then !! pseudovelocity conversion for NetCDF input files is handled by NetCDF routines + call self%pl%v2pv(param) + call self%tp%v2pv(param) + end if + + return + end subroutine whm_util_setup_initialize_system + + module subroutine whm_util_sort_pl(self, sortby, ascending) !! author: David A. Minton !! From 530fdb79a796c18fc6ae06c3b968af19080e1bf2 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Fri, 23 Dec 2022 06:33:30 -0500 Subject: [PATCH 504/569] Removed unecessary symba use statement from fraggle util submodule --- src/fraggle/fraggle_util.f90 | 3 --- 1 file changed, 3 deletions(-) diff --git a/src/fraggle/fraggle_util.f90 b/src/fraggle/fraggle_util.f90 index f3e6b87f6..80be9062c 100644 --- a/src/fraggle/fraggle_util.f90 +++ b/src/fraggle/fraggle_util.f90 @@ -9,11 +9,8 @@ submodule(fraggle) s_fraggle_util use swiftest - use symba contains - - module subroutine fraggle_util_construct_temporary_system(self, nbody_system, param, tmpsys, tmpparam) !! Author: David A. Minton !! From 777491163fc920f4512481ef8d2bbe2766bfc3fb Mon Sep 17 00:00:00 2001 From: David A Minton Date: Fri, 23 Dec 2022 06:40:30 -0500 Subject: [PATCH 505/569] Cleaned up submodule names --- src/collision/collision_io.f90 | 7 ++----- src/encounter/encounter_io.f90 | 4 ++-- src/rmvs/rmvs_encounter_check.f90 | 4 ++-- src/swiftest/swiftest_discard.f90 | 4 ++-- src/swiftest/swiftest_drift.f90 | 4 ++-- src/swiftest/swiftest_gr.f90 | 4 ++-- src/swiftest/swiftest_io.f90 | 4 ++-- src/swiftest/swiftest_kick.f90 | 4 ++-- src/swiftest/swiftest_obl.f90 | 10 +++++----- src/swiftest/swiftest_orbel.f90 | 4 ++-- src/swiftest/swiftest_user.f90 | 4 ++-- src/swiftest/swiftest_util.f90 | 4 ++-- 12 files changed, 27 insertions(+), 30 deletions(-) diff --git a/src/collision/collision_io.f90 b/src/collision/collision_io.f90 index 048653068..d5eaa3f8a 100644 --- a/src/collision/collision_io.f90 +++ b/src/collision/collision_io.f90 @@ -7,7 +7,7 @@ !! You should have received a copy of the GNU General Public License along with Swiftest. !! If not, see: https://www.gnu.org/licenses. -submodule(collision) s_collision_io_netcdf +submodule(collision) s_collision_io use swiftest contains @@ -342,7 +342,4 @@ module subroutine collision_io_netcdf_write_frame_snapshot(self, history, param) return end subroutine collision_io_netcdf_write_frame_snapshot - - - -end submodule s_collision_io_netcdf \ No newline at end of file +end submodule s_collision_io \ No newline at end of file diff --git a/src/encounter/encounter_io.f90 b/src/encounter/encounter_io.f90 index b26516ef5..ce49e0cbd 100644 --- a/src/encounter/encounter_io.f90 +++ b/src/encounter/encounter_io.f90 @@ -7,7 +7,7 @@ !! You should have received a copy of the GNU General Public License along with Swiftest. !! If not, see: https://www.gnu.org/licenses. -submodule (encounter) s_encounter_io_netcdf +submodule (encounter) s_encounter_io use swiftest contains @@ -226,4 +226,4 @@ module subroutine encounter_io_netcdf_write_frame_snapshot(self, history, param) return end subroutine encounter_io_netcdf_write_frame_snapshot -end submodule s_encounter_io_netcdf \ No newline at end of file +end submodule s_encounter_io \ No newline at end of file diff --git a/src/rmvs/rmvs_encounter_check.f90 b/src/rmvs/rmvs_encounter_check.f90 index 68e052a6f..00aafd1fb 100644 --- a/src/rmvs/rmvs_encounter_check.f90 +++ b/src/rmvs/rmvs_encounter_check.f90 @@ -7,7 +7,7 @@ !! You should have received a copy of the GNU General Public License along with Swiftest. !! If not, see: https://www.gnu.org/licenses. -submodule (rmvs) s_rmvs_chk +submodule (rmvs) s_rmvs_encounter_check use swiftest contains @@ -59,4 +59,4 @@ module function rmvs_encounter_check_tp(self, param, nbody_system, dt) result(le end function rmvs_encounter_check_tp -end submodule s_rmvs_chk +end submodule s_rmvs_encounter_check diff --git a/src/swiftest/swiftest_discard.f90 b/src/swiftest/swiftest_discard.f90 index 5f2f5d331..c9c6df340 100644 --- a/src/swiftest/swiftest_discard.f90 +++ b/src/swiftest/swiftest_discard.f90 @@ -7,7 +7,7 @@ !! You should have received a copy of the GNU General Public License along with Swiftest. !! If not, see: https://www.gnu.org/licenses. -submodule (swiftest) s_discard +submodule (swiftest) s_swiftest_discard contains module subroutine swiftest_discard_system(self, param) @@ -321,4 +321,4 @@ subroutine swiftest_discard_pl_close(dx, dv, dt, r2crit, iflag, r2min) return end subroutine swiftest_discard_pl_close -end submodule s_discard +end submodule s_swiftest_discard diff --git a/src/swiftest/swiftest_drift.f90 b/src/swiftest/swiftest_drift.f90 index 8e2273435..89f8afa16 100644 --- a/src/swiftest/swiftest_drift.f90 +++ b/src/swiftest/swiftest_drift.f90 @@ -7,7 +7,7 @@ !! You should have received a copy of the GNU General Public License along with Swiftest. !! If not, see: https://www.gnu.org/licenses. -submodule (swiftest) s_drift +submodule (swiftest) s_swiftest_drift !> Integration control parameters: real(DP), parameter :: E2MAX = 0.36_DP real(DP), parameter :: DM2MAX = 0.16_DP @@ -556,4 +556,4 @@ pure subroutine swiftest_drift_kepu_stumpff(x, c0, c1, c2, c3) end subroutine swiftest_drift_kepu_stumpff -end submodule s_drift +end submodule s_swiftest_drift diff --git a/src/swiftest/swiftest_gr.f90 b/src/swiftest/swiftest_gr.f90 index b4cc17c2b..3274f218e 100644 --- a/src/swiftest/swiftest_gr.f90 +++ b/src/swiftest/swiftest_gr.f90 @@ -7,7 +7,7 @@ !! You should have received a copy of the GNU General Public License along with Swiftest. !! If not, see: https://www.gnu.org/licenses. -submodule(swiftest) s_gr +submodule(swiftest) s_swiftest_gr contains pure module subroutine swiftest_gr_kick_getaccb_ns_body(self, nbody_system, param) @@ -270,4 +270,4 @@ pure module subroutine swiftest_gr_vh2pv_body(self, param) return end subroutine swiftest_gr_vh2pv_body -end submodule s_gr \ No newline at end of file +end submodule s_swiftest_gr \ No newline at end of file diff --git a/src/swiftest/swiftest_io.f90 b/src/swiftest/swiftest_io.f90 index 343da3be6..37f684071 100644 --- a/src/swiftest/swiftest_io.f90 +++ b/src/swiftest/swiftest_io.f90 @@ -7,7 +7,7 @@ !! You should have received a copy of the GNU General Public License along with Swiftest. !! If not, see: https://www.gnu.org/licenses. -submodule (swiftest) s_io +submodule (swiftest) s_swiftest_io use symba use netcdf contains @@ -2903,4 +2903,4 @@ module subroutine swiftest_io_write_frame_system(self, param) call util_exit(FAILURE) end subroutine swiftest_io_write_frame_system -end submodule s_io +end submodule s_swiftest_io diff --git a/src/swiftest/swiftest_kick.f90 b/src/swiftest/swiftest_kick.f90 index 9e9576321..922fd50c7 100644 --- a/src/swiftest/swiftest_kick.f90 +++ b/src/swiftest/swiftest_kick.f90 @@ -7,7 +7,7 @@ !! You should have received a copy of the GNU General Public License along with Swiftest. !! If not, see: https://www.gnu.org/licenses. -submodule(swiftest) s_kick +submodule(swiftest) s_swiftest_kick contains module subroutine swiftest_kick_getacch_int_pl(self, param) !! author: David A. Minton @@ -316,4 +316,4 @@ pure module subroutine swiftest_kick_getacch_int_one_tp(rji2, xr, yr, zr, GMpl, return end subroutine swiftest_kick_getacch_int_one_tp -end submodule s_kick +end submodule s_swiftest_kick diff --git a/src/swiftest/swiftest_obl.f90 b/src/swiftest/swiftest_obl.f90 index 3864c9f2d..2b87b7264 100644 --- a/src/swiftest/swiftest_obl.f90 +++ b/src/swiftest/swiftest_obl.f90 @@ -7,7 +7,7 @@ !! You should have received a copy of the GNU General Public License along with Swiftest. !! If not, see: https://www.gnu.org/licenses. -submodule (swiftest) s_obl +submodule (swiftest) s_swiftest_obl contains module subroutine swiftest_obl_acc_body(self, nbody_system) !! author: David A. Minton @@ -136,7 +136,7 @@ module subroutine swiftest_obl_pot_system(self) associate(nbody_system => self, pl => self%pl, npl => self%pl%nbody, cb => self%cb) if (.not. any(pl%lmask(1:npl))) return do concurrent (i = 1:npl, pl%lmask(i)) - oblpot_arr(i) = obl_pot_one(cb%Gmass, pl%Gmass(i), cb%j2rp2, cb%j4rp4, pl%rh(3,i), 1.0_DP / norm2(pl%rh(:,i))) + oblpot_arr(i) = swiftest_obl_pot_one(cb%Gmass, pl%Gmass(i), cb%j2rp2, cb%j4rp4, pl%rh(3,i), 1.0_DP / norm2(pl%rh(:,i))) end do nbody_system%oblpot = sum(oblpot_arr, pl%lmask(1:npl)) end associate @@ -145,7 +145,7 @@ module subroutine swiftest_obl_pot_system(self) end subroutine swiftest_obl_pot_system - elemental function obl_pot_one(GMcb, GMpl, j2rp2, j4rp4, zh, irh) result(oblpot) + elemental function swiftest_obl_pot_one(GMcb, GMpl, j2rp2, j4rp4, zh, irh) result(oblpot) !! author: David A. Minton !! !! Compute the contribution to the total gravitational potential due solely to the oblateness of the central body from a single massive body @@ -179,6 +179,6 @@ elemental function obl_pot_one(GMcb, GMpl, j2rp2, j4rp4, zh, irh) result(oblpot) oblpot = t0 * (t1 * p2 + t3 * p4) return - end function obl_pot_one + end function swiftest_obl_pot_one -end submodule s_obl +end submodule s_swiftest_obl diff --git a/src/swiftest/swiftest_orbel.f90 b/src/swiftest/swiftest_orbel.f90 index 097034111..d383f0eed 100644 --- a/src/swiftest/swiftest_orbel.f90 +++ b/src/swiftest/swiftest_orbel.f90 @@ -7,7 +7,7 @@ !! You should have received a copy of the GNU General Public License along with Swiftest. !! If not, see: https://www.gnu.org/licenses. -submodule (swiftest) s_orbel +submodule (swiftest) s_swiftest_orbel contains module subroutine swiftest_orbel_el2xv_vec(self, cb) @@ -1046,4 +1046,4 @@ pure module subroutine swiftest_orbel_xv2el(mu, px, py, pz, vx, vy, vz, a, e, in end subroutine swiftest_orbel_xv2el -end submodule s_orbel +end submodule s_swiftest_orbel diff --git a/src/swiftest/swiftest_user.f90 b/src/swiftest/swiftest_user.f90 index 927455729..805a500ef 100644 --- a/src/swiftest/swiftest_user.f90 +++ b/src/swiftest/swiftest_user.f90 @@ -7,7 +7,7 @@ !! You should have received a copy of the GNU General Public License along with Swiftest. !! If not, see: https://www.gnu.org/licenses. -submodule(swiftest) s_user_kick_getacch +submodule(swiftest) s_swiftest_user use swiftest contains module subroutine swiftest_user_kick_getacch_body(self, nbody_system, param, t, lbeg) @@ -27,4 +27,4 @@ module subroutine swiftest_user_kick_getacch_body(self, nbody_system, param, t, return end subroutine swiftest_user_kick_getacch_body -end submodule s_user_kick_getacch +end submodule s_swiftest_user diff --git a/src/swiftest/swiftest_util.f90 b/src/swiftest/swiftest_util.f90 index 56f2259f6..3cd3793e1 100644 --- a/src/swiftest/swiftest_util.f90 +++ b/src/swiftest/swiftest_util.f90 @@ -7,7 +7,7 @@ !! You should have received a copy of the GNU General Public License along with Swiftest. !! If not, see: https://www.gnu.org/licenses. -submodule (swiftest) s_util +submodule (swiftest) s_swiftest_util use whm use rmvs use helio @@ -4601,4 +4601,4 @@ module subroutine swiftest_util_version() return end subroutine swiftest_util_version -end submodule s_util \ No newline at end of file +end submodule s_swiftest_util \ No newline at end of file From 13ae3bba0c9e613b69ecb107deff946b127e581c Mon Sep 17 00:00:00 2001 From: David A Minton Date: Fri, 23 Dec 2022 06:47:36 -0500 Subject: [PATCH 506/569] Added interfaces to minimizer module to help with debugging --- src/fraggle/fraggle_generate.f90 | 2 +- src/misc/minimizer_module.f90 | 77 +++++++++++++++++++++++++++++--- 2 files changed, 71 insertions(+), 8 deletions(-) diff --git a/src/fraggle/fraggle_generate.f90 b/src/fraggle/fraggle_generate.f90 index fe27bc9fd..73a2c0255 100644 --- a/src/fraggle/fraggle_generate.f90 +++ b/src/fraggle/fraggle_generate.f90 @@ -851,6 +851,6 @@ function radial_objective_function(v_r_mag_input) result(fval) return end function radial_objective_function - end subroutine fraggle_generate_rad_vel + end subroutine fraggle_generate_rad_vel end submodule s_fraggle_generate diff --git a/src/misc/minimizer_module.f90 b/src/misc/minimizer_module.f90 index a52fe2b00..5a189ad03 100644 --- a/src/misc/minimizer_module.f90 +++ b/src/misc/minimizer_module.f90 @@ -32,6 +32,70 @@ module subroutine minimize_bfgs(f, N, x0, eps, maxloop, lerr, x1) logical, intent(out) :: lerr real(DP), dimension(:), intent(out), allocatable :: x1 end subroutine minimize_bfgs + + module function gradf(f, N, x1, dx, lerr) result(grad) + implicit none + integer(I4B), intent(in) :: N + class(lambda_obj), intent(inout) :: f + real(DP), dimension(:), intent(in) :: x1 + real(DP), intent(in) :: dx + logical, intent(out) :: lerr + real(DP), dimension(N) :: grad + end function gradf + + module function minimize1D(f, x0, S, N, eps, lerr) result(astar) + implicit none + integer(I4B), intent(in) :: N + class(lambda_obj), intent(inout) :: f + real(DP), dimension(:), intent(in) :: x0, S + real(DP), intent(in) :: eps + logical, intent(out) :: lerr + real(DP) :: astar + end function minimize1D + + module function n2one(f, x0, S, N, a, lerr) result(fnew) + implicit none + integer(I4B), intent(in) :: N + class(lambda_obj), intent(inout) :: f + real(DP), dimension(:), intent(in) :: x0, S + real(DP), intent(in) :: a + logical, intent(out) :: lerr + real(DP) :: fnew + end function n2one + + module subroutine bracket(f, x0, S, N, gam, step, lo, hi, lerr) + implicit none + integer(I4B), intent(in) :: N + class(lambda_obj), intent(inout) :: f + real(DP), dimension(:), intent(in) :: x0, S + real(DP), intent(in) :: gam, step + real(DP), intent(inout) :: lo + real(DP), intent(out) :: hi + logical, intent(out) :: lerr + end subroutine bracket + + module subroutine golden(f, x0, S, N, eps, lo, hi, lerr) + implicit none + integer(I4B), intent(in) :: N + class(lambda_obj), intent(inout) :: f + real(DP), dimension(:), intent(in) :: x0, S + real(DP), intent(in) :: eps + real(DP), intent(inout) :: lo + real(DP), intent(out) :: hi + logical, intent(out) :: lerr + end subroutine golden + + module subroutine quadfit(f, x0, S, N, eps, lo, hi, lerr) + implicit none + ! Arguments + integer(I4B), intent(in) :: N + class(lambda_obj), intent(inout) :: f + real(DP), dimension(:), intent(in) :: x0, S + real(DP), intent(in) :: eps + real(DP), intent(inout) :: lo + real(DP), intent(out) :: hi + logical, intent(out) :: lerr + end subroutine quadfit end interface contains @@ -153,7 +217,7 @@ module subroutine minimize_bfgs(f, N, x0, eps, maxloop, lerr, x1) end subroutine minimize_bfgs - function gradf(f, N, x1, dx, lerr) result(grad) + module function gradf(f, N, x1, dx, lerr) result(grad) !! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - !! Purpose: Estimates the gradient of a function using a central difference !! approximation @@ -211,7 +275,7 @@ function gradf(f, N, x1, dx, lerr) result(grad) end function gradf - function minimize1D(f, x0, S, N, eps, lerr) result(astar) + module function minimize1D(f, x0, S, N, eps, lerr) result(astar) !! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - !! This program find the minimum of a function of N variables in a single direction !! S using in sequence: @@ -286,7 +350,7 @@ function minimize1D(f, x0, S, N, eps, lerr) result(astar) end function minimize1D - function n2one(f, x0, S, N, a, lerr) result(fnew) + module function n2one(f, x0, S, N, a, lerr) result(fnew) implicit none ! Arguments integer(I4B), intent(in) :: N @@ -294,7 +358,6 @@ function n2one(f, x0, S, N, a, lerr) result(fnew) real(DP), dimension(:), intent(in) :: x0, S real(DP), intent(in) :: a logical, intent(out) :: lerr - ! Return real(DP) :: fnew ! Internals @@ -313,7 +376,7 @@ function n2one(f, x0, S, N, a, lerr) result(fnew) end function n2one - subroutine bracket(f, x0, S, N, gam, step, lo, hi, lerr) + module subroutine bracket(f, x0, S, N, gam, step, lo, hi, lerr) ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - !! This subroutine brackets the minimum. It recieves as input: !! f%eval(x) : lambda function object containing the objective function as the eval metho @@ -420,7 +483,7 @@ subroutine bracket(f, x0, S, N, gam, step, lo, hi, lerr) end subroutine bracket - subroutine golden(f, x0, S, N, eps, lo, hi, lerr) + module subroutine golden(f, x0, S, N, eps, lo, hi, lerr) ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - !! This function uses the golden section method to reduce the starting interval lo, hi by some amount sigma. !! It recieves as input: @@ -482,7 +545,7 @@ subroutine golden(f, x0, S, N, eps, lo, hi, lerr) end subroutine golden - subroutine quadfit(f, x0, S, N, eps, lo, hi, lerr) + module subroutine quadfit(f, x0, S, N, eps, lo, hi, lerr) ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - !! This function uses a quadratic polynomial fit to locate the minimum of a function !! to some accuracy eps. It recieves as input: From bed6564e0bef980b714a963fdf631f94781ea6c3 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Fri, 23 Dec 2022 07:14:18 -0500 Subject: [PATCH 507/569] Cleanup and fixed up some of the coordinate system vector calcs --- src/collision/collision_generate.f90 | 120 +++++++++++++-------------- src/collision/collision_module.f90 | 21 ++--- src/collision/collision_util.f90 | 11 ++- src/fraggle/fraggle_generate.f90 | 6 +- 4 files changed, 81 insertions(+), 77 deletions(-) diff --git a/src/collision/collision_generate.f90 b/src/collision/collision_generate.f90 index 59b78fb26..2d4a006a8 100644 --- a/src/collision/collision_generate.f90 +++ b/src/collision/collision_generate.f90 @@ -12,6 +12,64 @@ use swiftest contains + module subroutine collision_generate_bounce(self, nbody_system, param, t) + !! author: David A. Minton + !! + !! In this collision model, if the collision would result in a disruption, the bodies are instead "bounced" off + !! of the center of mass. This is done as a reflection in the 2-body equivalent distance vector direction. + implicit none + ! Arguments + class(collision_bounce), intent(inout) :: self !! Bounce fragment system object + class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object + class(base_parameters), intent(inout) :: param !! Current run configuration parameters + real(DP), intent(in) :: t !! The time of the collision + ! Internals + integer(I4B) :: i,j,nfrag + real(DP), dimension(NDIM) :: vcom, rnorm + + select type(nbody_system) + class is (swiftest_nbody_system) + select type (pl => nbody_system%pl) + class is (swiftest_pl) + associate(impactors => nbody_system%collider%impactors, fragments => nbody_system%collider%fragments) + select case (impactors%regime) + case (COLLRESOLVE_REGIME_DISRUPTION, COLLRESOLVE_REGIME_SUPERCATASTROPHIC) + nfrag = size(impactors%id(:)) + do i = 1, nfrag + j = impactors%id(i) + vcom(:) = pl%vb(:,j) - impactors%vbcom(:) + rnorm(:) = .unit. (impactors%rb(:,2) - impactors%rb(:,1)) + ! Do the reflection + vcom(:) = vcom(:) - 2 * dot_product(vcom(:),rnorm(:)) * rnorm(:) + pl%vb(:,j) = impactors%vbcom(:) + vcom(:) + self%status = DISRUPTED + pl%status(j) = ACTIVE + pl%ldiscard(j) = .false. + pl%lcollision(j) = .false. + end do + select type(before => self%before) + class is (swiftest_nbody_system) + select type(after => self%after) + class is (swiftest_nbody_system) + allocate(after%pl, source=before%pl) ! Be sure to save the pl so that snapshots still work + end select + end select + case (COLLRESOLVE_REGIME_HIT_AND_RUN) + call collision_generate_hitandrun(self, nbody_system, param, t) + case (COLLRESOLVE_REGIME_MERGE, COLLRESOLVE_REGIME_GRAZE_AND_MERGE) + call self%collision_merge%generate(nbody_system, param, t) ! Use the default collision model, which is merge + case default + write(*,*) "Error in swiftest_collision, unrecognized collision regime" + call util_exit(FAILURE) + end select + end associate + end select + end select + + return + end subroutine collision_generate_bounce + + module subroutine collision_generate_hitandrun(collider, nbody_system, param, t) !! author: Jennifer L.L. Pouplin, Carlisle A. Wishard, and David A. Minton !! @@ -159,70 +217,12 @@ module subroutine collision_generate_merge(self, nbody_system, param, t) end subroutine collision_generate_merge - module subroutine collision_generate_bounce(self, nbody_system, param, t) - !! author: David A. Minton - !! - !! In this collision model, if the collision would result in a disruption, the bodies are instead "bounced" off - !! of the center of mass. This is done as a reflection in the 2-body equivalent distance vector direction. - implicit none - ! Arguments - class(collision_bounce), intent(inout) :: self !! Bounce fragment system object - class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object - class(base_parameters), intent(inout) :: param !! Current run configuration parameters - real(DP), intent(in) :: t !! The time of the collision - ! Internals - integer(I4B) :: i,j,nfrag - real(DP), dimension(NDIM) :: vcom, rnorm - - select type(nbody_system) - class is (swiftest_nbody_system) - select type (pl => nbody_system%pl) - class is (swiftest_pl) - associate(impactors => nbody_system%collider%impactors, fragments => nbody_system%collider%fragments) - select case (impactors%regime) - case (COLLRESOLVE_REGIME_DISRUPTION, COLLRESOLVE_REGIME_SUPERCATASTROPHIC) - nfrag = size(impactors%id(:)) - do i = 1, nfrag - j = impactors%id(i) - vcom(:) = pl%vb(:,j) - impactors%vbcom(:) - rnorm(:) = .unit. (impactors%rb(:,2) - impactors%rb(:,1)) - ! Do the reflection - vcom(:) = vcom(:) - 2 * dot_product(vcom(:),rnorm(:)) * rnorm(:) - pl%vb(:,j) = impactors%vbcom(:) + vcom(:) - self%status = DISRUPTED - pl%status(j) = ACTIVE - pl%ldiscard(j) = .false. - pl%lcollision(j) = .false. - end do - select type(before => self%before) - class is (swiftest_nbody_system) - select type(after => self%after) - class is (swiftest_nbody_system) - allocate(after%pl, source=before%pl) ! Be sure to save the pl so that snapshots still work - end select - end select - case (COLLRESOLVE_REGIME_HIT_AND_RUN) - call collision_generate_hitandrun(self, nbody_system, param, t) - case (COLLRESOLVE_REGIME_MERGE, COLLRESOLVE_REGIME_GRAZE_AND_MERGE) - call self%collision_merge%generate(nbody_system, param, t) ! Use the default collision model, which is merge - case default - write(*,*) "Error in swiftest_collision, unrecognized collision regime" - call util_exit(FAILURE) - end select - end associate - end select - end select - - return - end subroutine collision_generate_bounce - - - module subroutine collision_generate_simple(self, nbody_system, param, t) + module subroutine collision_generate_simple_disruption(self, nbody_system, param, t) implicit none class(collision_simple_disruption), intent(inout) :: self !! Simple fragment system object class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(base_parameters), intent(inout) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! The time of the collision - end subroutine collision_generate_simple + end subroutine collision_generate_simple_disruption end submodule s_collision_generate \ No newline at end of file diff --git a/src/collision/collision_module.f90 b/src/collision/collision_module.f90 index 40ef8b012..ca0002f24 100644 --- a/src/collision/collision_module.f90 +++ b/src/collision/collision_module.f90 @@ -66,13 +66,14 @@ module collision real(DP) :: Mcb !! Mass of central body (used to compute potential energy in regime determination) ! Values in a coordinate frame centered on the collider barycenter and collisional nbody_system unit vectors - real(DP), dimension(NDIM) :: x_unit !! x-direction unit vector of collisional nbody_system - real(DP), dimension(NDIM) :: y_unit !! y-direction unit vector of collisional nbody_system - real(DP), dimension(NDIM) :: z_unit !! z-direction unit vector of collisional nbody_system - real(DP), dimension(NDIM) :: v_unit !! z-direction unit vector of collisional nbody_system - real(DP), dimension(NDIM) :: rbcom !! Center of mass position vector of the collider nbody_system in nbody_system barycentric coordinates - real(DP), dimension(NDIM) :: vbcom !! Velocity vector of the center of mass of the collider nbody_system in nbody_system barycentric coordinates - real(DP), dimension(NDIM) :: rbimp !! Impact point position vector of the collider nbody_system in nbody_system barycentric coordinates + real(DP), dimension(NDIM) :: x_unit !! x-direction unit vector of collisional nbody_system + real(DP), dimension(NDIM) :: y_unit !! y-direction unit vector of collisional nbody_system + real(DP), dimension(NDIM) :: z_unit !! z-direction unit vector of collisional nbody_system + real(DP), dimension(NDIM) :: v_unit !! velocity direction unit vector of collisional nbody_system + real(DP), dimension(NDIM) :: rbcom !! Center of mass position vector of the collider nbody_system in nbody_system barycentric coordinates + real(DP), dimension(NDIM) :: vbcom !! Velocity vector of the center of mass of the collider nbody_system in nbody_system barycentric coordinates + real(DP), dimension(NDIM) :: rbimp !! Impact point position vector of the collider nbody_system in nbody_system barycentric coordinates + real(DP), dimension(NDIM) :: vbimp !! The impact point velocity vector is the component of the velocity in the distance vector direction contains procedure :: consolidate => collision_resolve_consolidate_impactors !! Consolidates a multi-body collision into an equivalent 2-body collision @@ -149,7 +150,7 @@ module collision type, extends(collision_merge) :: collision_simple_disruption contains - procedure :: generate => collision_generate_simple !! If a collision would result in a disruption [TODO: SOMETHING LIKE CHAMBERS 2012] + procedure :: generate => collision_generate_simple_disruption !! If a collision would result in a disruption [TODO: SOMETHING LIKE CHAMBERS 2012] procedure :: set_mass_dist => collision_util_set_mass_dist !! Sets the distribution of mass among the fragments depending on the regime type final :: collision_final_simple !! Finalizer will deallocate all allocatables end type collision_simple_disruption @@ -223,13 +224,13 @@ module subroutine collision_generate_bounce(self, nbody_system, param, t) real(DP), intent(in) :: t !! The time of the collision end subroutine collision_generate_bounce - module subroutine collision_generate_simple(self, nbody_system, param, t) + module subroutine collision_generate_simple_disruption(self, nbody_system, param, t) implicit none class(collision_simple_disruption), intent(inout) :: self !! Simple fragment nbody_system object class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(base_parameters), intent(inout) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! The time of the collision - end subroutine collision_generate_simple + end subroutine collision_generate_simple_disruption module subroutine collision_io_collider_message(pl, collidx, collider_message) implicit none diff --git a/src/collision/collision_util.f90 b/src/collision/collision_util.f90 index 62e275d24..784802dba 100644 --- a/src/collision/collision_util.f90 +++ b/src/collision/collision_util.f90 @@ -87,7 +87,7 @@ module subroutine collision_util_construct_temporary_system(self, nbody_system, ! Set up a new system based on the original if (allocated(tmpparam)) deallocate(tmpparam) if (allocated(tmpsys)) deallocate(tmpsys) - allocate(tmpparam, source=param) + allocate(tmpparam_local, source=param) call swiftest_util_setup_construct_system(tmpsys_local, tmpparam_local) ! No test particles necessary for energy/momentum calcs @@ -411,10 +411,13 @@ module subroutine collision_util_set_coordinate_system(self) ! The cross product of the y- by z-axis will give us the x-axis impactors%x_unit(:) = impactors%y_unit(:) .cross. impactors%z_unit(:) - impactors%v_unit(:) = .unit.delta_v(:) - if (.not.any(fragments%rc(:,:) > 0.0_DP)) return + ! The "bounce" unit vector is the projection of + impactors%vbimp(:) = dot_product(delta_v(:),impactors%x_unit(:)) * impactors%x_unit(:) + + if ((.not.allocated(self%fragments)) .or. (nfrag == 0) .or. (.not.any(fragments%rc(:,:) > 0.0_DP))) return + fragments%rmag(:) = .mag. fragments%rc(:,:) ! Randomize the tangential velocity direction. @@ -623,7 +626,7 @@ module subroutine collision_util_setup_fragments_system(self, nfrag) return end subroutine collision_util_setup_fragments_system - + subroutine collision_util_save_snapshot(collision_history, snapshot) !! author: David A. Minton !! diff --git a/src/fraggle/fraggle_generate.f90 b/src/fraggle/fraggle_generate.f90 index 73a2c0255..e555b11f2 100644 --- a/src/fraggle/fraggle_generate.f90 +++ b/src/fraggle/fraggle_generate.f90 @@ -252,9 +252,6 @@ module subroutine fraggle_generate_fragments(collider, nbody_system, param, lfai return end if - ! This is a factor that will "distort" the shape of the frgment cloud in the direction of the impact velocity - f_spin= .mag. (runit(:) .cross. vunit(:)) - if (param%lflatten_interactions) then lk_plpl = allocated(pl%k_plpl) if (lk_plpl) deallocate(pl%k_plpl) @@ -288,6 +285,9 @@ module subroutine fraggle_generate_fragments(collider, nbody_system, param, lfai call fraggle_generate_pos_vec(collider, r_max_start) call collider%set_coordinate_system() + ! This is a factor that will "distort" the shape of the fragment cloud in the direction of the impact velocity + f_spin= .mag. (impactors%y_unit(:) .cross. impactors%v_unit(:)) + ! Initial velocity guess will be the barycentric velocity of the colliding nbody_system so that the budgets are based on the much smaller collisional-frame velocities do concurrent (i = 1:nfrag) fragments%vb(:, i) = impactors%vbcom(:) From ca9031140a005a3778ef51d52a994e89f06756b8 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Fri, 23 Dec 2022 07:42:37 -0500 Subject: [PATCH 508/569] Improved the position initialization. Experimenting now with doing spins at the end instead of the beginning --- src/fraggle/fraggle_generate.f90 | 55 ++++++++++++++------------------ 1 file changed, 24 insertions(+), 31 deletions(-) diff --git a/src/fraggle/fraggle_generate.f90 b/src/fraggle/fraggle_generate.f90 index e555b11f2..8e52da0c5 100644 --- a/src/fraggle/fraggle_generate.f90 +++ b/src/fraggle/fraggle_generate.f90 @@ -227,7 +227,6 @@ module subroutine fraggle_generate_fragments(collider, nbody_system, param, lfai logical, dimension(size(IEEE_ALL)) :: fpe_halting_modes, fpe_quiet_modes logical, dimension(size(IEEE_USUAL)) :: fpe_flag character(len=STRMAX) :: message - real(DP), dimension(NDIM) :: runit, vunit ! The minimization and linear solvers can sometimes lead to floating point exceptions. Rather than halting the code entirely if this occurs, we ! can simply fail the attempt and try again. So we need to turn off any floating point exception halting modes temporarily @@ -267,9 +266,10 @@ module subroutine fraggle_generate_fragments(collider, nbody_system, param, lfai call collider%get_energy_and_momentum(nbody_system, param, lbefore=.true.) ! Start out the fragments close to the initial separation distance. This will be increased if there is any overlap or we fail to find a solution - r_max_start = 1.2_DP * .mag.(impactors%rb(:,2) - impactors%rb(:,1)) + r_max_start = 1.1_DP * .mag.(impactors%rb(:,2) - impactors%rb(:,1)) lfailure = .false. try = 1 + f_spin = F_SPIN_FIRST do while (try < MAXTRY) write(message,*) try call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Fraggle try " // trim(adjustl(message))) @@ -285,9 +285,6 @@ module subroutine fraggle_generate_fragments(collider, nbody_system, param, lfai call fraggle_generate_pos_vec(collider, r_max_start) call collider%set_coordinate_system() - ! This is a factor that will "distort" the shape of the fragment cloud in the direction of the impact velocity - f_spin= .mag. (impactors%y_unit(:) .cross. impactors%v_unit(:)) - ! Initial velocity guess will be the barycentric velocity of the colliding nbody_system so that the budgets are based on the much smaller collisional-frame velocities do concurrent (i = 1:nfrag) fragments%vb(:, i) = impactors%vbcom(:) @@ -296,12 +293,6 @@ module subroutine fraggle_generate_fragments(collider, nbody_system, param, lfai call collider%get_energy_and_momentum(nbody_system, param, lbefore=.false.) call collider%set_budgets() - call fraggle_generate_spins(collider, f_spin, lfailure) - if (lfailure) then - call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Fraggle failed to find spins") - cycle - end if - call fraggle_generate_tan_vel(collider, lfailure) if (lfailure) then call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Fraggle failed to find tangential velocities") @@ -314,6 +305,12 @@ module subroutine fraggle_generate_fragments(collider, nbody_system, param, lfai cycle end if + call fraggle_generate_spins(collider, f_spin, lfailure) + if (lfailure) then + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Fraggle failed to find spins") + cycle + end if + call collider%get_energy_and_momentum(nbody_system, param, lbefore=.false.) dEtot = collider%Etot(2) - collider%Etot(1) dLmag = .mag. (collider%Ltot(:,2) - collider%Ltot(:,1)) @@ -378,7 +375,6 @@ subroutine fraggle_generate_pos_vec(collider, r_max_start) real(DP), intent(in) :: r_max_start !! Initial guess for the starting maximum radial distance of fragments ! Internals real(DP) :: dis, rad, r_max, fdistort - real(DP), dimension(NDIM) :: runit, vunit logical, dimension(:), allocatable :: loverlap integer(I4B) :: i, j logical :: lnoncat, lhitandrun @@ -394,35 +390,32 @@ subroutine fraggle_generate_pos_vec(collider, r_max_start) r_max = r_max_start rad = sum(impactors%radius(:)) + ! This is a factor that will "distort" the shape of the fragment cloud in the direction of the impact velocity + fdistort = .mag. (impactors%y_unit(:) .cross. impactors%v_unit(:)) - ! Get the unit vectors for the relative position and velocity vectors. These are used to shift the fragment cloud depending on the - runit(:) = impactors%rb(:,2) - impactors%rb(:,1) - runit(:) = runit(:) / (.mag. runit(:)) - - vunit(:) = impactors%vb(:,2) - impactors%vb(:,1) - vunit(:) = vunit(:) / (.mag. vunit(:)) - - ! This is a factor that will "distort" the shape of the frgment cloud in the direction of the impact velocity - fdistort = .mag. (runit(:) .cross. vunit(:)) - - ! We will treat the first two fragments of the list as special cases. They get initialized the maximum distances apart along the original impactor distance vector. - ! This is done because in a regular disruption, the first body is the largest, the second the second largest, and the rest are smaller equal-mass fragments. + ! We will treat the first two fragments of the list as special cases. They get initialized at the original positions of the impactor bodies + fragments%rc(:, 1) = impactors%rb(:, 1) - impactors%rbcom(:) + fragments%rc(:, 2) = impactors%rb(:, 2) - impactors%rbcom(:) call random_number(fragments%rc(:,3:nfrag)) loverlap(:) = .true. do while (any(loverlap(3:nfrag))) - fragments%rc(:, 1) = impactors%rb(:, 1) - impactors%rbcom(:) - fragments%rc(:, 2) = impactors%rb(:, 2) - impactors%rbcom(:) - r_max = r_max + 0.1_DP * rad + if (lhitandrun) then ! For a hit-and-run with disruption, the fragment cloud size is based on the radius of the disrupted body + r_max = 2 * impactors%radius(2) + else ! For disruptions, the the fragment cloud size is based on the mutual collision system + r_max = r_max + 0.1_DP * rad + end if do i = 3, nfrag - if (loverlap(i)) then + if (loverlap(i)) then call random_number(fragments%rc(:,i)) fragments%rc(:,i) = 2 * (fragments%rc(:, i) - 0.5_DP) - fragments%rc(:, i) = fragments%rc(:,i) + fdistort * vunit(:) - fragments%rc(:, i) = r_max * fragments%rc(:, i) + fragments%rc(:, i) = fragments%rc(:,i) + fdistort * impactors%v_unit(:) + fragments%rc(:, i) = r_max * fragments%rc(:, i) fragments%rc(:, i) = fragments%rc(:, i) + (impactors%rbimp(:) - impactors%rbcom(:)) ! Shift the center of the fragment cloud to the impact point rather than the CoM - !if (lnoncat .and. dot_product(fragments%rc(:,i), runit(:)) < 0.0_DP) fragments%rc(:, i) = -fragments%rc(:, i) ! Make sure the fragment cloud points away from the impact point + if (lnoncat .and. dot_product(fragments%rc(:,i), impactors%y_unit(:)) < 0.0_DP) fragments%rc(:, i) = -fragments%rc(:, i) ! Make sure the fragment cloud points away from the impact point end if end do + + ! Check for any overlapping bodies. loverlap(:) = .false. do j = 1, nfrag do i = j + 1, nfrag From 9a3723fd0902a69133daf05728da8569d462ff3d Mon Sep 17 00:00:00 2001 From: David A Minton Date: Fri, 23 Dec 2022 09:00:44 -0500 Subject: [PATCH 509/569] cleaned up some missing bits from the append utility --- src/collision/collision_generate.f90 | 5 +- src/collision/collision_regime.f90 | 13 --- src/collision/collision_util.f90 | 10 ++- src/fraggle/fraggle_generate.f90 | 124 +++++++++++++++++---------- src/misc/minimizer_module.f90 | 3 +- src/swiftest/swiftest_util.f90 | 15 +++- 6 files changed, 108 insertions(+), 62 deletions(-) diff --git a/src/collision/collision_generate.f90 b/src/collision/collision_generate.f90 index 2d4a006a8..2be2408bb 100644 --- a/src/collision/collision_generate.f90 +++ b/src/collision/collision_generate.f90 @@ -149,12 +149,15 @@ module subroutine collision_generate_merge(self, nbody_system, param, t) select type(pl => nbody_system%pl) class is (swiftest_pl) + ! Get coordinate system + call self%set_coordinate_system() + ! Generate the merged body as a single fragment call self%setup_fragments(1) ! Calculate the initial energy of the nbody_system without the collisional family call self%get_energy_and_momentum(nbody_system, param, lbefore=.true.) - + ! The new body's metadata will be taken from the largest of the two impactor bodies, so we need ! its index in the main pl structure ibiggest = impactors%id(maxloc(pl%Gmass(impactors%id(:)), dim=1)) diff --git a/src/collision/collision_regime.f90 b/src/collision/collision_regime.f90 index 197a84f42..a1ae47fe0 100644 --- a/src/collision/collision_regime.f90 +++ b/src/collision/collision_regime.f90 @@ -32,10 +32,6 @@ module subroutine collision_regime_impactors(self, nbody_system, param) select type(param) class is (swiftest_parameters) - mtot = sum(impactors%mass(:)) - impactors%rbcom(:) = (impactors%mass(1) * impactors%rb(:,1) + impactors%mass(2) * impactors%rb(:,2)) / mtot - impactors%vbcom(:) = (impactors%mass(1) * impactors%vb(:,1) + impactors%mass(2) * impactors%vb(:,2)) / mtot - select case(param%collision_model) case("MERGE") impactors%regime = COLLRESOLVE_REGIME_MERGE @@ -105,15 +101,6 @@ subroutine collision_regime_LS12(impactors, nbody_system, param) impactors%mass_dist(2) = min(max(mslr, 0.0_DP), mtot) impactors%mass_dist(3) = min(max(mtot - mlr - mslr, 0.0_DP), mtot) - ! Find the center of mass of the collisional system - mtot = sum(impactors%mass(:)) - impactors%rbcom(:) = (impactors%mass(1) * impactors%rb(:,1) + impactors%mass(2) * impactors%rb(:,2)) / mtot - impactors%vbcom(:) = (impactors%mass(1) * impactors%vb(:,1) + impactors%mass(2) * impactors%vb(:,2)) / mtot - - ! Find the point of impact between the two bodies - runit(:) = impactors%rb(:,2) - impactors%rb(:,1) - runit(:) = runit(:) / (.mag. runit(:)) - impactors%rbimp(:) = impactors%rb(:,1) + impactors%radius(1) * runit(:) ! Convert quantities back to the system units and save them into the fragment system impactors%mass_dist(:) = (impactors%mass_dist(:) / param%MU2KG) diff --git a/src/collision/collision_util.f90 b/src/collision/collision_util.f90 index 784802dba..35d4e10f2 100644 --- a/src/collision/collision_util.f90 +++ b/src/collision/collision_util.f90 @@ -387,7 +387,7 @@ module subroutine collision_util_set_coordinate_system(self) ! Internals integer(I4B) :: i real(DP), dimension(NDIM) :: delta_r, delta_v, Ltot - real(DP) :: L_mag + real(DP) :: L_mag, mtot real(DP), dimension(NDIM, self%fragments%nbody) :: L_sigma associate(fragments => self%fragments, impactors => self%impactors, nfrag => self%fragments%nbody) @@ -413,6 +413,14 @@ module subroutine collision_util_set_coordinate_system(self) impactors%x_unit(:) = impactors%y_unit(:) .cross. impactors%z_unit(:) impactors%v_unit(:) = .unit.delta_v(:) + ! Find the center of mass of the collisional system + mtot = sum(impactors%mass(:)) + impactors%rbcom(:) = (impactors%mass(1) * impactors%rb(:,1) + impactors%mass(2) * impactors%rb(:,2)) / mtot + impactors%vbcom(:) = (impactors%mass(1) * impactors%vb(:,1) + impactors%mass(2) * impactors%vb(:,2)) / mtot + + ! Find the point of impact between the two bodies + impactors%rbimp(:) = impactors%rb(:,1) + impactors%radius(1) * impactors%y_unit(:) + ! The "bounce" unit vector is the projection of impactors%vbimp(:) = dot_product(delta_v(:),impactors%x_unit(:)) * impactors%x_unit(:) diff --git a/src/fraggle/fraggle_generate.f90 b/src/fraggle/fraggle_generate.f90 index 8e52da0c5..3cfb3ee82 100644 --- a/src/fraggle/fraggle_generate.f90 +++ b/src/fraggle/fraggle_generate.f90 @@ -118,7 +118,7 @@ module subroutine fraggle_generate_hitandrun(collider, nbody_system, param, t) class is (swiftest_nbody_system) select type(after => collider%after) class is (swiftest_nbody_system) - associate(impactors => collider%impactors, fragments => collider%fragments, pl => nbody_system%pl) + associate(impactors => collider%impactors,pl => nbody_system%pl) message = "Hit and run between" call collision_io_collider_message(nbody_system%pl, impactors%id, message) call swiftest_io_log_one_message(COLLISION_LOG_OUT, trim(adjustl(message))) @@ -150,7 +150,7 @@ module subroutine fraggle_generate_hitandrun(collider, nbody_system, param, t) call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Should have been a pure hit and run instead") nfrag = 0 else - nfrag = fragments%nbody + nfrag = collider%fragments%nbody write(message, *) nfrag call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Generating " // trim(adjustl(message)) // " fragments") end if @@ -163,9 +163,9 @@ module subroutine fraggle_generate_hitandrun(collider, nbody_system, param, t) allocate(after%pl, source=before%pl) ! Be sure to save the pl so that snapshots still work else ibiggest = impactors%id(maxloc(pl%Gmass(impactors%id(:)), dim=1)) - fragments%id(1) = pl%id(ibiggest) - fragments%id(2:nfrag) = [(i, i = param%maxid + 1, param%maxid + nfrag - 1)] - param%maxid = fragments%id(nfrag) + collider%fragments%id(1) = pl%id(ibiggest) + collider%fragments%id(2:nfrag) = [(i, i = param%maxid + 1, param%maxid + nfrag - 1)] + param%maxid = collider%fragments%id(nfrag) status = HIT_AND_RUN_DISRUPT call collision_resolve_mergeaddsub(nbody_system, param, t, status) end if @@ -293,44 +293,46 @@ module subroutine fraggle_generate_fragments(collider, nbody_system, param, lfai call collider%get_energy_and_momentum(nbody_system, param, lbefore=.false.) call collider%set_budgets() - call fraggle_generate_tan_vel(collider, lfailure) - if (lfailure) then - call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Fraggle failed to find tangential velocities") - cycle - end if - - call fraggle_generate_rad_vel(collider, lfailure) - if (lfailure) then - call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Fraggle failed to find radial velocities") - cycle - end if - - call fraggle_generate_spins(collider, f_spin, lfailure) - if (lfailure) then - call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Fraggle failed to find spins") - cycle - end if - - call collider%get_energy_and_momentum(nbody_system, param, lbefore=.false.) - dEtot = collider%Etot(2) - collider%Etot(1) - dLmag = .mag. (collider%Ltot(:,2) - collider%Ltot(:,1)) - exit - - lfailure = ((abs(dEtot + impactors%Qloss) > FRAGGLE_ETOL) .or. (dEtot > 0.0_DP)) - if (lfailure) then - write(message, *) dEtot, abs(dEtot + impactors%Qloss) / FRAGGLE_ETOL - call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Fraggle failed due to high energy error: " // & - trim(adjustl(message))) - cycle - end if - - lfailure = ((abs(dLmag) / (.mag.collider%Ltot(:,1))) > FRAGGLE_LTOL) - if (lfailure) then - write(message,*) dLmag / (.mag.collider%Ltot(:,1)) - call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Fraggle failed due to high angular momentum error: " // & - trim(adjustl(message))) - cycle - end if + call fraggle_generate_vel_vec_guess(collider) + + ! call fraggle_generate_tan_vel(collider, lfailure) + ! if (lfailure) then + ! call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Fraggle failed to find tangential velocities") + ! cycle + ! end if + + ! call fraggle_generate_rad_vel(collider, lfailure) + ! if (lfailure) then + ! call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Fraggle failed to find radial velocities") + ! cycle + ! end if + + ! call fraggle_generate_spins(collider, f_spin, lfailure) + ! if (lfailure) then + ! call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Fraggle failed to find spins") + ! cycle + ! end if + + ! call collider%get_energy_and_momentum(nbody_system, param, lbefore=.false.) + ! dEtot = collider%Etot(2) - collider%Etot(1) + ! dLmag = .mag. (collider%Ltot(:,2) - collider%Ltot(:,1)) + ! exit + + ! lfailure = ((abs(dEtot + impactors%Qloss) > FRAGGLE_ETOL) .or. (dEtot > 0.0_DP)) + ! if (lfailure) then + ! write(message, *) dEtot, abs(dEtot + impactors%Qloss) / FRAGGLE_ETOL + ! call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Fraggle failed due to high energy error: " // & + ! trim(adjustl(message))) + ! cycle + ! end if + + ! lfailure = ((abs(dLmag) / (.mag.collider%Ltot(:,1))) > FRAGGLE_LTOL) + ! if (lfailure) then + ! write(message,*) dLmag / (.mag.collider%Ltot(:,1)) + ! call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Fraggle failed due to high angular momentum error: " // & + ! trim(adjustl(message))) + ! cycle + ! end if ! Check if any of the usual floating point exceptions happened, and fail the try if so call ieee_get_flag(ieee_usual, fpe_flag) @@ -442,6 +444,42 @@ subroutine fraggle_generate_pos_vec(collider, r_max_start) end subroutine fraggle_generate_pos_vec + subroutine fraggle_generate_vel_vec_guess(collider) + !! Author: David A. Minton + !! + !! Generates an initial "guess" for the velocitity vectors + implicit none + ! Arguments + class(collision_fraggle), intent(inout) :: collider !! Fraggle collision system object + ! Internals + integer(I4B) :: i, j + logical :: lcat + real(DP), dimension(NDIM) :: vimp_unit + real(DP), dimension(NDIM,collider%fragments%nbody) :: vnoise + real(DP), parameter :: VNOISE_MAG = 0.10_DP + real(DP) :: vmag + + associate(fragments => collider%fragments, impactors => collider%impactors, nfrag => collider%fragments%nbody) + lcat = (impactors%regime == COLLRESOLVE_REGIME_SUPERCATASTROPHIC) + + ! "Bounce" the first two bodies + do i = 1,2 + fragments%vc(:,i) = impactors%vb(:,i) - impactors%vbcom(:) - 2 * impactors%vbimp(:) + end do + + vmag = .mag.impactors%vbcom(:) + vimp_unit(:) = .unit. impactors%vbimp(:) + call random_number(vnoise) + vnoise = (2 * vnoise - 1.0_DP) * vmag + do i = 3, nfrag + vimp_unit(:) = .unit. (fragments%rc(:,i) + impactors%rbcom(:) - impactors%rbimp(:)) + fragments%vc(:,i) = vmag * vimp_unit(:) + vnoise(:,i) + end do + end associate + return + end subroutine fraggle_generate_vel_vec_guess + + subroutine fraggle_generate_spins(collider, f_spin, lfailure) !! Author: Jennifer L.L. Pouplin, Carlisle A. Wishard, and David A. Minton !! diff --git a/src/misc/minimizer_module.f90 b/src/misc/minimizer_module.f90 index 5a189ad03..772db418a 100644 --- a/src/misc/minimizer_module.f90 +++ b/src/misc/minimizer_module.f90 @@ -140,9 +140,10 @@ module subroutine minimize_bfgs(f, N, x0, eps, maxloop, lerr, x1) call ieee_get_status(original_fpe_status) ! Save the original floating point exception status call ieee_set_flag(ieee_all, .false.) ! Set all flags to quiet - allocate(fpe_flag(size(ieee_usual))) + if (.not.allocated(fpe_flag)) allocate(fpe_flag(size(ieee_usual))) lerr = .false. + if (allocated(x1)) deallocate(x1) allocate(x1, source=x0) ! Initialize approximate Hessian with the identity matrix (i.e. begin with method of steepest descent) ! Get initial gradient and initialize arrays for updated values of gradient and x diff --git a/src/swiftest/swiftest_util.f90 b/src/swiftest/swiftest_util.f90 index 3cd3793e1..3d6cd2047 100644 --- a/src/swiftest/swiftest_util.f90 +++ b/src/swiftest/swiftest_util.f90 @@ -235,11 +235,13 @@ module subroutine swiftest_util_append_body(self, source, lsource_mask) nsrc = source%nbody nnew = count(lsource_mask(1:nsrc)) - call swiftest_util_append(self%info, source%info, nold, nsrc, lsource_mask) call swiftest_util_append(self%id, source%id, nold, nsrc, lsource_mask) + call swiftest_util_append(self%info, source%info, nold, nsrc, lsource_mask) + call swiftest_util_append(self%lmask, source%lmask, nold, nsrc, lsource_mask) call swiftest_util_append(self%status, source%status, nold, nsrc, lsource_mask) call swiftest_util_append(self%ldiscard, source%ldiscard, nold, nsrc, lsource_mask) - call swiftest_util_append(self%lmask, source%lmask, nold, nsrc, lsource_mask) + call swiftest_util_append(self%lencounter, source%lencounter, nold, nsrc, lsource_mask) + call swiftest_util_append(self%lcollision, source%lcollision, nold, nsrc, lsource_mask) call swiftest_util_append(self%mu, source%mu, nold, nsrc, lsource_mask) call swiftest_util_append(self%rh, source%rh, nold, nsrc, lsource_mask) call swiftest_util_append(self%vh, source%vh, nold, nsrc, lsource_mask) @@ -250,6 +252,9 @@ module subroutine swiftest_util_append_body(self, source, lsource_mask) call swiftest_util_append(self%atide, source%atide, nold, nsrc, lsource_mask) call swiftest_util_append(self%agr, source%agr, nold, nsrc, lsource_mask) call swiftest_util_append(self%ir3h, source%ir3h, nold, nsrc, lsource_mask) + call swiftest_util_append(self%isperi, source%isperi, nold, nsrc, lsource_mask) + call swiftest_util_append(self%peri, source%peri, nold, nsrc, lsource_mask) + call swiftest_util_append(self%atp, source%atp, nold, nsrc, lsource_mask) call swiftest_util_append(self%a, source%a, nold, nsrc, lsource_mask) call swiftest_util_append(self%e, source%e, nold, nsrc, lsource_mask) call swiftest_util_append(self%inc, source%inc, nold, nsrc, lsource_mask) @@ -282,15 +287,19 @@ module subroutine swiftest_util_append_pl(self, source, lsource_mask) call swiftest_util_append(self%rhill, source%rhill, nold, nsrc, lsource_mask) call swiftest_util_append(self%renc, source%renc, nold, nsrc, lsource_mask) call swiftest_util_append(self%radius, source%radius, nold, nsrc, lsource_mask) + call swiftest_util_append(self%density, source%density, nold, nsrc, lsource_mask) call swiftest_util_append(self%rbeg, source%rbeg, nold, nsrc, lsource_mask) call swiftest_util_append(self%rend, source%rend, nold, nsrc, lsource_mask) call swiftest_util_append(self%vbeg, source%vbeg, nold, nsrc, lsource_mask) - call swiftest_util_append(self%density, source%density, nold, nsrc, lsource_mask) call swiftest_util_append(self%Ip, source%Ip, nold, nsrc, lsource_mask) call swiftest_util_append(self%rot, source%rot, nold, nsrc, lsource_mask) call swiftest_util_append(self%k2, source%k2, nold, nsrc, lsource_mask) call swiftest_util_append(self%Q, source%Q, nold, nsrc, lsource_mask) call swiftest_util_append(self%tlag, source%tlag, nold, nsrc, lsource_mask) + call swiftest_util_append(self%kin, source%kin, nold, nsrc, lsource_mask) + call swiftest_util_append(self%lmtiny, source%lmtiny, nold, nsrc, lsource_mask) + call swiftest_util_append(self%nplenc, source%nplenc, nold, nsrc, lsource_mask) + call swiftest_util_append(self%ntpenc, source%ntpenc, nold, nsrc, lsource_mask) if (allocated(self%k_plpl)) deallocate(self%k_plpl) From af8afde1ffeea47adb09865cb669ad9fb04974b3 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Fri, 23 Dec 2022 09:02:40 -0500 Subject: [PATCH 510/569] Cleanup --- src/swiftest/swiftest_io.f90 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/swiftest/swiftest_io.f90 b/src/swiftest/swiftest_io.f90 index 37f684071..ca36846da 100644 --- a/src/swiftest/swiftest_io.f90 +++ b/src/swiftest/swiftest_io.f90 @@ -1687,16 +1687,16 @@ module subroutine swiftest_io_netcdf_write_info_cb(self, nc, param) character(len=:), allocatable :: charstring ! This string of spaces of length NAMELEN is used to clear out any old data left behind inside the string variables - call netcdf_io_check( nf90_set_fill(nc%id, nf90_nofill, old_mode), "netcdf_io_write_info_body nf90_set_fill nf90_nofill" ) + call netcdf_io_check( nf90_set_fill(nc%id, nf90_nofill, old_mode), "netcdf_io_write_info_cb nf90_set_fill nf90_nofill" ) idslot = self%id + 1 - call netcdf_io_check( nf90_put_var(nc%id, nc%id_varid, self%id, start=[idslot]), "netcdf_io_write_info_body nf90_put_var cb id_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%id_varid, self%id, start=[idslot]), "netcdf_io_write_info_cb nf90_put_var id_varid" ) charstring = trim(adjustl(self%info%name)) - call netcdf_io_check( nf90_put_var(nc%id, nc%name_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "netcdf_io_write_info_body nf90_put_var cb name_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%name_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "netcdf_io_write_info_cb nf90_put_var name_varid" ) charstring = trim(adjustl(self%info%particle_type)) - call netcdf_io_check( nf90_put_var(nc%id, nc%ptype_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "netcdf_io_write_info_body nf90_put_var cb ptype_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%ptype_varid, charstring, start=[1, idslot], count=[len(charstring), 1]), "netcdf_io_write_info_cb nf90_put_var ptype_varid" ) if (param%lclose) then charstring = trim(adjustl(self%info%origin_type)) From 10b8f2d8116fec70ce389fba13f741ef775411a2 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Fri, 23 Dec 2022 09:10:20 -0500 Subject: [PATCH 511/569] Prevented netcdf files from being closed prematurely. --- src/collision/collision_util.f90 | 4 ++++ src/encounter/encounter_check.f90 | 4 ++++ 2 files changed, 8 insertions(+) diff --git a/src/collision/collision_util.f90 b/src/collision/collision_util.f90 index 35d4e10f2..fb0cbee06 100644 --- a/src/collision/collision_util.f90 +++ b/src/collision/collision_util.f90 @@ -88,6 +88,10 @@ module subroutine collision_util_construct_temporary_system(self, nbody_system, if (allocated(tmpparam)) deallocate(tmpparam) if (allocated(tmpsys)) deallocate(tmpsys) allocate(tmpparam_local, source=param) + select type(tmpparam_local) + class is (swiftest_parameters) + tmpparam_local%system_history%nc%lfile_is_open = .false. + end select call swiftest_util_setup_construct_system(tmpsys_local, tmpparam_local) ! No test particles necessary for energy/momentum calcs diff --git a/src/encounter/encounter_check.f90 b/src/encounter/encounter_check.f90 index de81b75bc..276024b3f 100644 --- a/src/encounter/encounter_check.f90 +++ b/src/encounter/encounter_check.f90 @@ -125,6 +125,10 @@ module subroutine encounter_check_all_plplm(param, nplm, nplt, xplm, vplm, xplt, ! end if allocate(tmp_param, source=param) + select type(tmp_param) + class is (swiftest_parameters) + tmp_param%system_history%nc%lfile_is_open = .false. + end select ! Turn off adaptive encounter checks for the pl-pl group tmp_param%ladaptive_encounters_plpl = .false. From ebcef5e05c349edfe2176d0cb18a8d1a997bfd67 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Fri, 23 Dec 2022 10:24:00 -0500 Subject: [PATCH 512/569] Cleaned up a bunch of lingering problems left over from transferring a bunch of symba body variables to swiftest --- src/swiftest/swiftest_module.f90 | 2 +- src/swiftest/swiftest_util.f90 | 46 +++++++++++++++++--------------- src/symba/symba_util.f90 | 46 ++------------------------------ 3 files changed, 28 insertions(+), 66 deletions(-) diff --git a/src/swiftest/swiftest_module.f90 b/src/swiftest/swiftest_module.f90 index d09f88374..82e233bb3 100644 --- a/src/swiftest/swiftest_module.f90 +++ b/src/swiftest/swiftest_module.f90 @@ -322,7 +322,7 @@ module swiftest class(encounter_list), allocatable :: plpl_encounter !! List of massive body-massive body encounters in a single step class(collision_list_plpl), allocatable :: plpl_collision !! List of massive body-massive body collisions in a single step class(collision_list_plpl), allocatable :: pltp_collision !! List of massive body-massive body collisions in a single step - class(collision_merge), allocatable :: collider !! Collision system object + class(collision_merge), allocatable :: collider !! Collision system object class(encounter_storage(nframes=:)), allocatable :: encounter_history !! Stores encounter history for later retrieval and saving to file class(collision_storage(nframes=:)), allocatable :: collision_history !! Stores encounter history for later retrieval and saving to file diff --git a/src/swiftest/swiftest_util.f90 b/src/swiftest/swiftest_util.f90 index 3d6cd2047..32a137c50 100644 --- a/src/swiftest/swiftest_util.f90 +++ b/src/swiftest/swiftest_util.f90 @@ -328,9 +328,7 @@ module subroutine swiftest_util_append_tp(self, source, lsource_mask) select type(source) class is (swiftest_tp) associate(nold => self%nbody, nsrc => source%nbody) - call swiftest_util_append(self%isperi, source%isperi, nold, nsrc, lsource_mask) - call swiftest_util_append(self%peri, source%peri, nold, nsrc, lsource_mask) - call swiftest_util_append(self%atp, source%atp, nold, nsrc, lsource_mask) + call swiftest_util_append(self%nplenc, source%nplenc, nold, nsrc, lsource_mask) call swiftest_util_append_body(self, source, lsource_mask) end associate @@ -806,9 +804,6 @@ module subroutine swiftest_util_dealloc_tp(self) class(swiftest_tp), intent(inout) :: self !! Swiftest test particle object if (allocated(self%nplenc)) deallocate(self%nplenc) - if (allocated(self%isperi)) deallocate(self%isperi) - if (allocated(self%peri)) deallocate(self%peri) - if (allocated(self%atp)) deallocate(self%atp) if (allocated(self%k_pltp)) deallocate(self%k_pltp) call swiftest_util_dealloc_body(self) @@ -1903,6 +1898,7 @@ module subroutine swiftest_util_reset_kinship_pl(self, idx) ! Internals integer(I4B) :: i, j + self%kin(idx(:))%parent = idx(:) self%kin(idx(:))%nchild = 0 do j = 1, size(idx(:)) @@ -2777,6 +2773,9 @@ module subroutine swiftest_util_setup_body(self, n, param) allocate(self%ah(NDIM, n)) allocate(self%ir3h(n)) allocate(self%aobl(NDIM, n)) + allocate(self%isperi(n)) + allocate(self%peri(n)) + allocate(self%atp(n)) if (param%lclose) then allocate(self%lcollision(n)) allocate(self%lencounter(n)) @@ -2813,6 +2812,9 @@ module subroutine swiftest_util_setup_body(self, n, param) self%ah(:,:) = 0.0_DP self%ir3h(:) = 0.0_DP self%aobl(:,:) = 0.0_DP + self%isperi(:) = 1 + self%peri(:) = 0.0_DP + self%atp(:) = 0.0_DP if (param%ltides) then allocate(self%atide(NDIM, n)) @@ -2837,6 +2839,8 @@ module subroutine swiftest_util_setup_pl(self, n, param) class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object integer(I4B), intent(in) :: n !! Number of particles to allocate space for class(swiftest_parameters), intent(in) :: param !! Current run configuration parameter + ! Internals + integer(I4B) :: i !> Call allocation method for parent class !> The parent class here is the abstract swiftest_body class, so we can't use the type-bound procedure @@ -2860,12 +2864,13 @@ module subroutine swiftest_util_setup_pl(self, n, param) allocate(self%ntpenc(n)) allocate(self%radius(n)) allocate(self%density(n)) + allocate(self%kin(n)) self%nplenc(:) = 0 self%ntpenc(:) = 0 self%radius(:) = 0.0_DP self%density(:) = 1.0_DP - + call self%reset_kinship([(i, i=1, n)]) end if if (param%lmtiny_pl) then @@ -2909,14 +2914,9 @@ module subroutine swiftest_util_setup_tp(self, n, param) call swiftest_util_setup_body(self, n, param) if (n == 0) return - allocate(self%isperi(n)) - allocate(self%peri(n)) - allocate(self%atp(n)) allocate(self%nplenc(n)) - self%isperi(:) = 0 - self%peri(:) = 0.0_DP - self%atp(:) = 0.0_DP + self%npltp = 0_I8B self%nplenc(:) = 0 return @@ -2986,7 +2986,11 @@ module subroutine swiftest_util_sort_body(self, sortby, ascending) call swiftest_util_sort(direction * body%capom(1:n), ind) case("mu") call swiftest_util_sort(direction * body%mu(1:n), ind) - case("lfirst", "nbody", "ldiscard", "rh", "vh", "rb", "vb", "ah", "aobl", "atide", "agr") + case("peri") + call swiftest_util_sort(direction * body%peri(1:n), ind) + case("atp") + call swiftest_util_sort(direction * body%atp(1:n), ind) + case("info", "lfirst", "nbody", "ldiscard", "lcollision", "lencounter", "rh", "vh", "rb", "vb", "ah", "aobl", "atide", "agr","isperi") write(*,*) 'Cannot sort by ' // trim(adjustl(sortby)) // '. Component not sortable!' case default write(*,*) 'Cannot sort by ' // trim(adjustl(sortby)) // '. Component not found!' @@ -3625,7 +3629,11 @@ module subroutine swiftest_util_sort_pl(self, sortby, ascending) call swiftest_util_sort(direction * pl%Q(1:npl), ind) case("tlag") call swiftest_util_sort(direction * pl%tlag(1:npl), ind) - case("rbeg", "rend", "vbeg", "Ip", "rot", "k_plpl", "nplpl") + case("nplenc") + call swiftest_util_sort(direction * pl%nplenc(1:npl), ind) + case("ntpenc") + call swiftest_util_sort(direction * pl%ntpenc(1:npl), ind) + case("lmtiny", "nplm", "nplplm", "kin", "rbeg", "rend", "vbeg", "Ip", "rot", "k_plpl", "nplpl") write(*,*) 'Cannot sort by ' // trim(adjustl(sortby)) // '. Component not sortable!' case default ! Look for components in the parent class call swiftest_util_sort_body(pl, sortby, ascending) @@ -3664,12 +3672,8 @@ module subroutine swiftest_util_sort_tp(self, sortby, ascending) associate(tp => self, ntp => self%nbody) select case(sortby) - case("peri") - call swiftest_util_sort(direction * tp%peri(1:ntp), ind) - case("atp") - call swiftest_util_sort(direction * tp%atp(1:ntp), ind) - case("isperi") - write(*,*) 'Cannot sort by ' // trim(adjustl(sortby)) // '. Component not sortable!' + case("nplenc") + call swiftest_util_sort(direction * tp%nplenc(1:ntp), ind) case default ! Look for components in the parent class call swiftest_util_sort_body(tp, sortby, ascending) return diff --git a/src/symba/symba_util.f90 b/src/symba/symba_util.f90 index 87ba8dacf..0a78693b2 100644 --- a/src/symba/symba_util.f90 +++ b/src/symba/symba_util.f90 @@ -79,9 +79,6 @@ module subroutine symba_util_dealloc_pl(self) if (allocated(self%levelg)) deallocate(self%levelg) if (allocated(self%levelm)) deallocate(self%levelm) - if (allocated(self%isperi)) deallocate(self%isperi) - if (allocated(self%peri)) deallocate(self%peri) - if (allocated(self%atp)) deallocate(self%atp) call self%helio_pl%dealloc() @@ -121,18 +118,9 @@ module subroutine symba_util_fill_pl(self, inserts, lfill_list) associate(keeps => self) select type(inserts) class is (symba_pl) - call swiftest_util_fill(keeps%lcollision, inserts%lcollision, lfill_list) - call swiftest_util_fill(keeps%lencounter, inserts%lencounter, lfill_list) - call swiftest_util_fill(keeps%lmtiny, inserts%lmtiny, lfill_list) - call swiftest_util_fill(keeps%nplenc, inserts%nplenc, lfill_list) - call swiftest_util_fill(keeps%ntpenc, inserts%ntpenc, lfill_list) call swiftest_util_fill(keeps%levelg, inserts%levelg, lfill_list) call swiftest_util_fill(keeps%levelm, inserts%levelm, lfill_list) - call swiftest_util_fill(keeps%isperi, inserts%isperi, lfill_list) - call swiftest_util_fill(keeps%peri, inserts%peri, lfill_list) - call swiftest_util_fill(keeps%atp, inserts%atp, lfill_list) - call swiftest_util_fill(keeps%kin, inserts%kin, lfill_list) - + call swiftest_util_fill_pl(keeps, inserts, lfill_list) ! Note: helio_pl does not have its own fill method, so we skip back to the base class class default write(*,*) "Invalid object passed to the fill method. Source must be of class symba_pl or its descendents!" @@ -221,9 +209,6 @@ module subroutine symba_util_resize_pl(self, nnew) call swiftest_util_resize(self%levelg, nnew) call swiftest_util_resize(self%levelm, nnew) - call swiftest_util_resize(self%isperi, nnew) - call swiftest_util_resize(self%peri, nnew) - call swiftest_util_resize(self%atp, nnew) call swiftest_util_resize_pl(self, nnew) @@ -315,18 +300,9 @@ module subroutine symba_util_setup_pl(self, n, param) allocate(self%levelg(n)) allocate(self%levelm(n)) - allocate(self%isperi(n)) - allocate(self%peri(n)) - allocate(self%atp(n)) - allocate(self%kin(n)) - self%levelg(:) = -1 self%levelm(:) = -1 - self%isperi(:) = 0 - self%peri(:) = 0.0_DP - self%atp(:) = 0.0_DP - call self%reset_kinship([(i, i=1, n)]) return end subroutine symba_util_setup_pl @@ -381,20 +357,11 @@ module subroutine symba_util_sort_pl(self, sortby, ascending) associate(pl => self, npl => self%nbody) select case(sortby) - case("nplenc") - call swiftest_util_sort(direction * pl%nplenc(1:npl), ind) - case("ntpenc") - call swiftest_util_sort(direction * pl%ntpenc(1:npl), ind) case("levelg") call swiftest_util_sort(direction * pl%levelg(1:npl), ind) case("levelm") call swiftest_util_sort(direction * pl%levelm(1:npl), ind) - case("peri") - call swiftest_util_sort(direction * pl%peri(1:npl), ind) - case("atp") - call swiftest_util_sort(direction * pl%atp(1:npl), ind) - case("lcollision", "lencounter", "lmtiny", "nplm", "nplplm", "kin", "info") - write(*,*) 'Cannot sort by ' // trim(adjustl(sortby)) // '. Component not sortable!' + case default ! Look for components in the parent class call swiftest_util_sort_pl(pl, sortby, ascending) return @@ -508,17 +475,8 @@ module subroutine symba_util_spill_pl(self, discards, lspill_list, ldestructive) associate(keeps => self) select type(discards) class is (symba_pl) - call swiftest_util_spill(keeps%lcollision, discards%lcollision, lspill_list, ldestructive) - call swiftest_util_spill(keeps%lencounter, discards%lencounter, lspill_list, ldestructive) - call swiftest_util_spill(keeps%lmtiny, discards%lmtiny, lspill_list, ldestructive) - call swiftest_util_spill(keeps%nplenc, discards%nplenc, lspill_list, ldestructive) - call swiftest_util_spill(keeps%ntpenc, discards%ntpenc, lspill_list, ldestructive) call swiftest_util_spill(keeps%levelg, discards%levelg, lspill_list, ldestructive) call swiftest_util_spill(keeps%levelm, discards%levelm, lspill_list, ldestructive) - call swiftest_util_spill(keeps%isperi, discards%isperi, lspill_list, ldestructive) - call swiftest_util_spill(keeps%peri, discards%peri, lspill_list, ldestructive) - call swiftest_util_spill(keeps%atp, discards%atp, lspill_list, ldestructive) - call swiftest_util_spill(keeps%kin, discards%kin, lspill_list, ldestructive) call swiftest_util_spill_pl(keeps, discards, lspill_list, ldestructive) class default From 9627d1f8f6d96abeeaf3b92571c607b7dc0ddcb6 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Fri, 23 Dec 2022 11:00:07 -0500 Subject: [PATCH 513/569] Refactoring and cleaning, aiming to get collisional coordinate system computed earlier --- src/collision/collision_module.f90 | 60 ++++++++++++----------- src/collision/collision_resolve.f90 | 3 ++ src/collision/collision_util.f90 | 75 ++++++++++++++++++----------- src/fraggle/fraggle_generate.f90 | 4 +- 4 files changed, 84 insertions(+), 58 deletions(-) diff --git a/src/collision/collision_module.f90 b/src/collision/collision_module.f90 index ca0002f24..570e1cccc 100644 --- a/src/collision/collision_module.f90 +++ b/src/collision/collision_module.f90 @@ -65,21 +65,22 @@ module collision real(DP), dimension(:), allocatable :: mass_dist !! Distribution of fragment mass determined by the regime calculation (largest fragment, second largest, and remainder) real(DP) :: Mcb !! Mass of central body (used to compute potential energy in regime determination) - ! Values in a coordinate frame centered on the collider barycenter and collisional nbody_system unit vectors - real(DP), dimension(NDIM) :: x_unit !! x-direction unit vector of collisional nbody_system - real(DP), dimension(NDIM) :: y_unit !! y-direction unit vector of collisional nbody_system - real(DP), dimension(NDIM) :: z_unit !! z-direction unit vector of collisional nbody_system - real(DP), dimension(NDIM) :: v_unit !! velocity direction unit vector of collisional nbody_system + ! Values in a coordinate frame centered on the collider barycenter and collisional system unit vectors + real(DP), dimension(NDIM) :: x_unit !! x-direction unit vector of collisional system + real(DP), dimension(NDIM) :: y_unit !! y-direction unit vector of collisional system + real(DP), dimension(NDIM) :: z_unit !! z-direction unit vector of collisional system + real(DP), dimension(NDIM) :: v_unit !! velocity direction unit vector of collisional system real(DP), dimension(NDIM) :: rbcom !! Center of mass position vector of the collider nbody_system in nbody_system barycentric coordinates real(DP), dimension(NDIM) :: vbcom !! Velocity vector of the center of mass of the collider nbody_system in nbody_system barycentric coordinates real(DP), dimension(NDIM) :: rbimp !! Impact point position vector of the collider nbody_system in nbody_system barycentric coordinates real(DP), dimension(NDIM) :: vbimp !! The impact point velocity vector is the component of the velocity in the distance vector direction contains - procedure :: consolidate => collision_resolve_consolidate_impactors !! Consolidates a multi-body collision into an equivalent 2-body collision - procedure :: get_regime => collision_regime_impactors !! Determine which fragmentation regime the set of impactors will be - procedure :: reset => collision_util_reset_impactors !! Resets the collider object variables to 0 and deallocates the index and mass distributions - final :: collision_final_impactors !! Finalizer will deallocate all allocatables + procedure :: consolidate => collision_resolve_consolidate_impactors !! Consolidates a multi-body collision into an equivalent 2-body collision + procedure :: get_regime => collision_regime_impactors !! Determine which fragmentation regime the set of impactors will be + procedure :: reset => collision_util_reset_impactors !! Resets the collider object variables to 0 and deallocates the index and mass distributions + procedure :: set_coordinate_system => collision_util_set_coordinate_impactors !! Sets the coordinate system of the impactors + final :: collision_final_impactors !! Finalizer will deallocate all allocatables end type collision_impactors @@ -112,7 +113,7 @@ module collision type :: collision_merge - !! This class defines a collisional nbody_system that stores impactors and fragments. This is written so that various collision models (i.e. Fraggle) could potentially be used + !! This class defines a collisional system that stores impactors and fragments. This is written so that various collision models (i.e. Fraggle) could potentially be used !! to resolve collision by defining extended types of encounters_impactors and/or encounetr_fragments !! !! The generate method for this class is the merge model. This allows any extended type to have access to the merge procedure by selecting the collision_merge parent class @@ -131,15 +132,15 @@ module collision real(DP), dimension(2) :: pe !! Before/after potential energy real(DP), dimension(2) :: Etot !! Before/after total nbody_system energy contains - procedure :: setup => collision_util_setup_system !! Initializer for the encounter collision system and the before/after snapshots - procedure :: setup_impactors => collision_util_setup_impactors_system !! Initializer for the impactors for the encounter collision system. Deallocates old impactors before creating new ones - procedure :: setup_fragments => collision_util_setup_fragments_system !! Initializer for the fragments of the collision system. - procedure :: add_fragments => collision_util_add_fragments_to_system !! Add fragments to nbody_system + procedure :: setup => collision_util_setup_collider !! Initializer for the encounter collision system and the before/after snapshots + procedure :: setup_impactors => collision_util_setup_impactors_collider !! Initializer for the impactors for the encounter collision system. Deallocates old impactors before creating new ones + procedure :: setup_fragments => collision_util_setup_fragments_collider !! Initializer for the fragments of the collision system. + procedure :: add_fragments => collision_util_add_fragments_to_collider !! Add fragments to nbody_system procedure :: construct_temporary_system => collision_util_construct_temporary_system !! Constructs temporary n-body nbody_system in order to compute pre- and post-impact energy and momentum procedure :: get_energy_and_momentum => collision_util_get_energy_momentum !! Calculates total nbody_system energy in either the pre-collision outcome state (lbefore = .true.) or the post-collision outcome state (lbefore = .false.) procedure :: reset => collision_util_reset_system !! Deallocates all allocatables - procedure :: set_coordinate_system => collision_util_set_coordinate_system !! Sets the coordinate nbody_system of the collisional nbody_system - procedure :: generate => collision_generate_merge !! Merges the impactors to make a single final body + procedure :: set_coordinate_system => collision_util_set_coordinate_collider !! Sets the coordinate system of the collisional system + procedure :: generate => collision_generate_merge !! Merges the impactors to make a single final body end type collision_merge type, extends(collision_merge) :: collision_bounce @@ -348,34 +349,39 @@ module subroutine collision_resolve_pltp(self, nbody_system, param, t, dt, irec) integer(I4B), intent(in) :: irec !! Current recursion level end subroutine collision_resolve_pltp - module subroutine collision_util_set_coordinate_system(self) + module subroutine collision_util_set_coordinate_collider(self) implicit none - class(collision_merge), intent(inout) :: self !! Collisional nbody_system - end subroutine collision_util_set_coordinate_system + class(collision_merge), intent(inout) :: self !! collisional system + end subroutine collision_util_set_coordinate_collider - module subroutine collision_util_setup_system(self, nbody_system) + module subroutine collision_util_set_coordinate_impactors(self) + implicit none + class(collision_impactors), intent(inout) :: self !! collisional system + end subroutine collision_util_set_coordinate_impactors + + module subroutine collision_util_setup_collider(self, nbody_system) implicit none class(collision_merge), intent(inout) :: self !! Encounter collision system object class(base_nbody_system), intent(in) :: nbody_system !! Current nbody system. Used as a mold for the before/after snapshots - end subroutine collision_util_setup_system + end subroutine collision_util_setup_collider - module subroutine collision_util_setup_impactors_system(self) + module subroutine collision_util_setup_impactors_collider(self) implicit none class(collision_merge), intent(inout) :: self !! Encounter collision system object - end subroutine collision_util_setup_impactors_system + end subroutine collision_util_setup_impactors_collider - module subroutine collision_util_setup_fragments_system(self, nfrag) + module subroutine collision_util_setup_fragments_collider(self, nfrag) implicit none class(collision_merge), intent(inout) :: self !! Encounter collision system object integer(I4B), intent(in) :: nfrag !! Number of fragments to create - end subroutine collision_util_setup_fragments_system + end subroutine collision_util_setup_fragments_collider - module subroutine collision_util_add_fragments_to_system(self, nbody_system, param) + module subroutine collision_util_add_fragments_to_collider(self, nbody_system, param) implicit none class(collision_merge), intent(in) :: self !! Collision system object class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(base_parameters), intent(in) :: param !! Current swiftest run configuration parameters - end subroutine collision_util_add_fragments_to_system + end subroutine collision_util_add_fragments_to_collider module subroutine collision_util_construct_temporary_system(self, nbody_system, param, tmpsys, tmpparam) implicit none diff --git a/src/collision/collision_resolve.f90 b/src/collision/collision_resolve.f90 index 4dbfc4ea1..dae44b9cc 100644 --- a/src/collision/collision_resolve.f90 +++ b/src/collision/collision_resolve.f90 @@ -148,6 +148,9 @@ module subroutine collision_resolve_consolidate_impactors(self, nbody_system, pa ! Destroy the kinship relationships for all members of this impactors%id call pl%reset_kinship(impactors%id(:)) + ! Set the coordinate system of the impactors + call impactors%set_coordinate_system() + end associate end select return diff --git a/src/collision/collision_util.f90 b/src/collision/collision_util.f90 index fb0cbee06..06a39f4ed 100644 --- a/src/collision/collision_util.f90 +++ b/src/collision/collision_util.f90 @@ -11,7 +11,7 @@ use swiftest contains - module subroutine collision_util_add_fragments_to_system(self, nbody_system, param) + module subroutine collision_util_add_fragments_to_collider(self, nbody_system, param) !! Author: David A. Minton !! !! Adds fragments to the temporary system pl object @@ -58,7 +58,7 @@ module subroutine collision_util_add_fragments_to_system(self, nbody_system, par end select return - end subroutine collision_util_add_fragments_to_system + end subroutine collision_util_add_fragments_to_collider module subroutine collision_util_construct_temporary_system(self, nbody_system, param, tmpsys, tmpparam) @@ -381,7 +381,7 @@ module subroutine collision_util_reset_system(self) end subroutine collision_util_reset_system - module subroutine collision_util_set_coordinate_system(self) + module subroutine collision_util_set_coordinate_collider(self) !! author: David A. Minton !! !! Defines the collisional coordinate nbody_system, including the unit vectors of both the nbody_system and individual fragments. @@ -390,11 +390,45 @@ module subroutine collision_util_set_coordinate_system(self) class(collision_merge), intent(inout) :: self !! Collisional nbody_system ! Internals integer(I4B) :: i - real(DP), dimension(NDIM) :: delta_r, delta_v, Ltot - real(DP) :: L_mag, mtot real(DP), dimension(NDIM, self%fragments%nbody) :: L_sigma associate(fragments => self%fragments, impactors => self%impactors, nfrag => self%fragments%nbody) + call impactors%set_coordinate_system() + + if ((.not.allocated(self%fragments)) .or. (nfrag == 0) .or. (.not.any(fragments%rc(:,:) > 0.0_DP))) return + + fragments%rmag(:) = .mag. fragments%rc(:,:) + + ! Randomize the tangential velocity direction. + ! This helps to ensure that the tangential velocity doesn't completely line up with the angular momentum vector, otherwise we can get an ill-conditioned nbody_system + call random_number(L_sigma(:,:)) + do concurrent(i = 1:nfrag, fragments%rmag(i) > 0.0_DP) + fragments%v_n_unit(:, i) = impactors%z_unit(:) + 2e-1_DP * (L_sigma(:,i) - 0.5_DP) + end do + + ! Define the radial, normal, and tangential unit vectors for each individual fragment + fragments%v_r_unit(:,:) = .unit. fragments%rc(:,:) + fragments%v_n_unit(:,:) = .unit. fragments%v_n_unit(:,:) + fragments%v_t_unit(:,:) = .unit. (fragments%v_n_unit(:,:) .cross. fragments%v_r_unit(:,:)) + + end associate + + return + end subroutine collision_util_set_coordinate_collider + + + module subroutine collision_util_set_coordinate_impactors(self) + !! author: David A. Minton + !! + !! Defines the collisional coordinate nbody_system, including the unit vectors of both the nbody_system and individual fragments. + implicit none + ! Arguments + class(collision_impactors), intent(inout) :: self !! Collisional nbody_system + ! Internals + real(DP), dimension(NDIM) :: delta_r, delta_v, Ltot + real(DP) :: L_mag, mtot + + associate(impactors => self) delta_v(:) = impactors%vb(:, 2) - impactors%vb(:, 1) delta_r(:) = impactors%rb(:, 2) - impactors%rb(:, 1) @@ -427,27 +461,10 @@ module subroutine collision_util_set_coordinate_system(self) ! The "bounce" unit vector is the projection of impactors%vbimp(:) = dot_product(delta_v(:),impactors%x_unit(:)) * impactors%x_unit(:) - - if ((.not.allocated(self%fragments)) .or. (nfrag == 0) .or. (.not.any(fragments%rc(:,:) > 0.0_DP))) return - - fragments%rmag(:) = .mag. fragments%rc(:,:) - - ! Randomize the tangential velocity direction. - ! This helps to ensure that the tangential velocity doesn't completely line up with the angular momentum vector, otherwise we can get an ill-conditioned nbody_system - call random_number(L_sigma(:,:)) - do concurrent(i = 1:nfrag, fragments%rmag(i) > 0.0_DP) - fragments%v_n_unit(:, i) = impactors%z_unit(:) + 2e-1_DP * (L_sigma(:,i) - 0.5_DP) - end do - - ! Define the radial, normal, and tangential unit vectors for each individual fragment - fragments%v_r_unit(:,:) = .unit. fragments%rc(:,:) - fragments%v_n_unit(:,:) = .unit. fragments%v_n_unit(:,:) - fragments%v_t_unit(:,:) = .unit. (fragments%v_n_unit(:,:) .cross. fragments%v_r_unit(:,:)) - end associate return - end subroutine collision_util_set_coordinate_system + end subroutine collision_util_set_coordinate_impactors module subroutine collision_util_set_mass_dist(self, param) @@ -586,7 +603,7 @@ module subroutine collision_util_set_mass_dist(self, param) end subroutine collision_util_set_mass_dist - module subroutine collision_util_setup_system(self, nbody_system) + module subroutine collision_util_setup_collider(self, nbody_system) !! author: David A. Minton !! !! Initializer for the encounter collision system. Sets up impactors and the before/after snapshots, @@ -604,10 +621,10 @@ module subroutine collision_util_setup_system(self, nbody_system) allocate(self%after, mold=nbody_system) return - end subroutine collision_util_setup_system + end subroutine collision_util_setup_collider - module subroutine collision_util_setup_impactors_system(self) + module subroutine collision_util_setup_impactors_collider(self) !! author: David A. Minton !! !! Initializer for the impactors for the encounter collision system. Deallocates old impactors before creating new ones @@ -619,10 +636,10 @@ module subroutine collision_util_setup_impactors_system(self) allocate(collision_impactors :: self%impactors) return - end subroutine collision_util_setup_impactors_system + end subroutine collision_util_setup_impactors_collider - module subroutine collision_util_setup_fragments_system(self, nfrag) + module subroutine collision_util_setup_fragments_collider(self, nfrag) !! author: David A. Minton !! !! Initializer for the fragments of the collision system. @@ -636,7 +653,7 @@ module subroutine collision_util_setup_fragments_system(self, nfrag) self%fragments%nbody = nfrag return - end subroutine collision_util_setup_fragments_system + end subroutine collision_util_setup_fragments_collider subroutine collision_util_save_snapshot(collision_history, snapshot) diff --git a/src/fraggle/fraggle_generate.f90 b/src/fraggle/fraggle_generate.f90 index 3cfb3ee82..b809e45f4 100644 --- a/src/fraggle/fraggle_generate.f90 +++ b/src/fraggle/fraggle_generate.f90 @@ -632,7 +632,7 @@ subroutine fraggle_generate_tan_vel(collider, lfailure) end do fragments%v_t_mag(1:nfrag) = solve_fragment_tan_vel(v_t_mag_input=v_t_initial(7:nfrag), lfailure=lfailure) - ! Perform one final shift of the radial velocity vectors to align with the center of mass of the collisional nbody_system (the origin) + ! Perform one final shift of the radial velocity vectors to align with the center of mass of the collisional system (the origin) fragments%vb(:,1:nfrag) = fraggle_util_vmag_to_vb(fragments%v_r_mag(1:nfrag), fragments%v_r_unit(:,1:nfrag), fragments%v_t_mag(1:nfrag), & fragments%v_t_unit(:,1:nfrag), fragments%mass(1:nfrag), impactors%vbcom(:)) do concurrent (i = 1:nfrag) @@ -813,7 +813,7 @@ subroutine fraggle_generate_rad_vel(collider, lfailure) v_r_initial(:) = v_r_initial(:) * vnoise(:) end do - ! Shift the radial velocity vectors to align with the center of mass of the collisional nbody_system (the origin) + ! Shift the radial velocity vectors to align with the center of mass of the collisional system (the origin) fragments%ke_orbit = 0.0_DP fragments%ke_spin = 0.0_DP fragments%vb(:,1:nfrag) = fraggle_util_vmag_to_vb(fragments%v_r_mag(1:nfrag), fragments%v_r_unit(:,1:nfrag), & From 0c637aa1236f415774d160c1f8937a54c6cd46ac Mon Sep 17 00:00:00 2001 From: David A Minton Date: Fri, 23 Dec 2022 11:29:55 -0500 Subject: [PATCH 514/569] Cleanup and getting velocities under control with correct units --- src/collision/collision_resolve.f90 | 8 ++------ src/fraggle/fraggle_util.f90 | 2 ++ 2 files changed, 4 insertions(+), 6 deletions(-) diff --git a/src/collision/collision_resolve.f90 b/src/collision/collision_resolve.f90 index dae44b9cc..419875a80 100644 --- a/src/collision/collision_resolve.f90 +++ b/src/collision/collision_resolve.f90 @@ -345,12 +345,8 @@ module subroutine collision_resolve_mergeaddsub(nbody_system, param, t, status) plnew%id(1:nfrag) = fragments%id(1:nfrag) plnew%rb(:, 1:nfrag) = fragments%rb(:, 1:nfrag) plnew%vb(:, 1:nfrag) = fragments%vb(:, 1:nfrag) - call pl%vb2vh(cb) - call pl%rh2rb(cb) - do i = 1, nfrag - plnew%rh(:,i) = fragments%rb(:, i) - cb%rb(:) - plnew%vh(:,i) = fragments%vb(:, i) - cb%vb(:) - end do + plnew%status(1:nfrag) = ACTIVE + call plnew%b2h(cb) plnew%mass(1:nfrag) = fragments%mass(1:nfrag) plnew%Gmass(1:nfrag) = param%GU * fragments%mass(1:nfrag) plnew%radius(1:nfrag) = fragments%radius(1:nfrag) diff --git a/src/fraggle/fraggle_util.f90 b/src/fraggle/fraggle_util.f90 index 80be9062c..22691f17a 100644 --- a/src/fraggle/fraggle_util.f90 +++ b/src/fraggle/fraggle_util.f90 @@ -211,6 +211,7 @@ module subroutine fraggle_util_set_natural_scale_factors(self) impactors%rbcom(:) = impactors%rbcom(:) / collision_merge%dscale impactors%vbcom(:) = impactors%vbcom(:) / collision_merge%vscale impactors%rbimp(:) = impactors%rbimp(:) / collision_merge%dscale + impactors%vbimp(:) = impactors%vbimp(:) / collision_merge%vscale impactors%rb(:,:) = impactors%rb(:,:) / collision_merge%dscale impactors%vb(:,:) = impactors%vb(:,:) / collision_merge%vscale impactors%mass(:) = impactors%mass(:) / collision_merge%mscale @@ -253,6 +254,7 @@ module subroutine fraggle_util_set_original_scale_factors(self) impactors%rbcom(:) = impactors%rbcom(:) * collision_merge%dscale impactors%vbcom(:) = impactors%vbcom(:) * collision_merge%vscale impactors%rbimp(:) = impactors%rbimp(:) * collision_merge%dscale + impactors%vbimp(:) = impactors%vbimp(:) * collision_merge%vscale impactors%mass = impactors%mass * collision_merge%mscale impactors%radius = impactors%radius * collision_merge%dscale From ba80e3ca4d8586d18f3b7518fbdca5e85fe24882 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Fri, 23 Dec 2022 12:07:58 -0500 Subject: [PATCH 515/569] Moved the fragment position and initial velocity distribution code into the "simple disruption" model. This will allow these simpler distributions to be tested before adding in the energy and momentum constraints that Fraggle uses. --- examples/Fragmentation/Fragmentation_Movie.py | 4 +- src/collision/collision_generate.f90 | 137 +++++++++++- src/collision/collision_module.f90 | 70 ++++--- src/collision/collision_util.f90 | 34 ++- src/fraggle/fraggle_generate.f90 | 198 ++++-------------- src/fraggle/fraggle_module.f90 | 7 - src/fraggle/fraggle_util.f90 | 32 +-- 7 files changed, 256 insertions(+), 226 deletions(-) diff --git a/examples/Fragmentation/Fragmentation_Movie.py b/examples/Fragmentation/Fragmentation_Movie.py index 374574e9c..381bca121 100644 --- a/examples/Fragmentation/Fragmentation_Movie.py +++ b/examples/Fragmentation/Fragmentation_Movie.py @@ -206,8 +206,8 @@ def data_stream(self, frame=0): # Set fragmentation parameters minimum_fragment_gmass = 0.2 * body_Gmass[style][1] # Make the minimum fragment mass a fraction of the smallest body gmtiny = 0.99 * body_Gmass[style][1] # Make GMTINY just smaller than the smallest original body. This will prevent runaway collisional cascades - sim.set_parameter(collision_model="fraggle", encounter_save="both", gmtiny=gmtiny, minimum_fragment_gmass=minimum_fragment_gmass, verbose=False) + sim.set_parameter(collision_model="simple", encounter_save="both", gmtiny=gmtiny, minimum_fragment_gmass=minimum_fragment_gmass, verbose=False) sim.run(dt=1e-3, tstop=1.0e-3, istep_out=1, dump_cadence=0) print("Generating animation") - anim = AnimatedScatter(sim,movie_filename,movie_titles[style],style,nskip=1) \ No newline at end of file + anim = AnimatedScatter(sim,movie_filename,movie_titles[style],style,nskip=1) diff --git a/src/collision/collision_generate.f90 b/src/collision/collision_generate.f90 index 2be2408bb..a3ff0cbca 100644 --- a/src/collision/collision_generate.f90 +++ b/src/collision/collision_generate.f90 @@ -123,7 +123,7 @@ end subroutine collision_generate_hitandrun module subroutine collision_generate_merge(self, nbody_system, param, t) !! author: Jennifer L.L. Pouplin, Carlisle A. Wishard, and David A. Minton !! - !! Merge massive bodies in any collisionals ystem. + !! Merge massive bodies in any collisional system. !! !! Adapted from David E. Kaufmann's Swifter routines symba_merge_pl.f90 and symba_discard_merge_pl.f90 !! @@ -221,11 +221,146 @@ end subroutine collision_generate_merge module subroutine collision_generate_simple_disruption(self, nbody_system, param, t) + !! author: Jennifer L.L. Pouplin, Carlisle A. Wishard, and David A. Minton + !! + !! Generates a simple fragment position and velocity distribution based on the collision + !! regime. It makes no attempt to constrain the energy of the collision implicit none + ! Arguments class(collision_simple_disruption), intent(inout) :: self !! Simple fragment system object class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(base_parameters), intent(inout) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! The time of the collision + ! Internals + real(DP) :: r_max_start + + associate(impactors => self%impactors, fragments => self%fragments, nfrag => self%fragments%nbody) + r_max_start = 1.1_DP * .mag.(impactors%rb(:,2) - impactors%rb(:,1)) + call collision_generate_simple_pos_vec(self, r_max_start) + call self%set_coordinate_system() + call collision_generate_simple_vel_vec(self) + end associate + + return end subroutine collision_generate_simple_disruption + + module subroutine collision_generate_simple_pos_vec(collider, r_max_start) + !! Author: Jennifer L.L. Pouplin, Carlisle A. Wishard, and David A. Minton + !! + !! Initializes the position vectors of the fragments around the center of mass based on the collision style. + !! For hit and run with disruption, the fragments are generated in a random cloud around the smallest of the two colliders (body 2) + !! For disruptive collisions, the fragments are generated in a random cloud around the impact point. Bodies are checked for overlap and + !! regenerated if they overlap. + implicit none + ! Arguments + class(collision_simple_disruption), intent(inout) :: collider !! Fraggle collision system object + real(DP), intent(in) :: r_max_start !! The maximum radial distance of fragments for disruptive collisions + ! Internals + real(DP) :: dis, rad, r_max, fdistort + logical, dimension(:), allocatable :: loverlap + integer(I4B) :: i, j + logical :: lnoncat, lhitandrun + + associate(fragments => collider%fragments, impactors => collider%impactors, nfrag => collider%fragments%nbody) + allocate(loverlap(nfrag)) + + lnoncat = (impactors%regime /= COLLRESOLVE_REGIME_SUPERCATASTROPHIC) ! For non-catastrophic impacts, make the fragments act like ejecta and point away from the impact point + lhitandrun = (impactors%regime == COLLRESOLVE_REGIME_HIT_AND_RUN) ! Disruptive hit and runs have their own fragment distribution + + ! Place the fragments into a region that is big enough that we should usually not have overlapping bodies + ! An overlapping bodies will collide in the next time step, so it's not a major problem if they do (it just slows the run down) + r_max = r_max_start + rad = sum(impactors%radius(:)) + + ! This is a factor that will "distort" the shape of the fragment cloud in the direction of the impact velocity + fdistort = .mag. (impactors%y_unit(:) .cross. impactors%v_unit(:)) + + ! We will treat the first two fragments of the list as special cases. They get initialized at the original positions of the impactor bodies + fragments%rc(:, 1) = impactors%rb(:, 1) - impactors%rbcom(:) + fragments%rc(:, 2) = impactors%rb(:, 2) - impactors%rbcom(:) + call random_number(fragments%rc(:,3:nfrag)) + loverlap(:) = .true. + do while (any(loverlap(3:nfrag))) + if (lhitandrun) then ! For a hit-and-run with disruption, the fragment cloud size is based on the radius of the disrupted body + r_max = 2 * impactors%radius(2) + else ! For disruptions, the the fragment cloud size is based on the mutual collision system + r_max = r_max + 0.1_DP * rad + end if + do i = 3, nfrag + if (loverlap(i)) then + call random_number(fragments%rc(:,i)) + fragments%rc(:,i) = 2 * (fragments%rc(:, i) - 0.5_DP) + fragments%rc(:, i) = fragments%rc(:,i) + fdistort * impactors%v_unit(:) + fragments%rc(:, i) = r_max * fragments%rc(:, i) + fragments%rc(:, i) = fragments%rc(:, i) + (impactors%rbimp(:) - impactors%rbcom(:)) ! Shift the center of the fragment cloud to the impact point rather than the CoM + if (lnoncat .and. dot_product(fragments%rc(:,i), impactors%y_unit(:)) < 0.0_DP) fragments%rc(:, i) = -fragments%rc(:, i) ! Make sure the fragment cloud points away from the impact point + end if + end do + + ! Check for any overlapping bodies. + loverlap(:) = .false. + do j = 1, nfrag + do i = j + 1, nfrag + dis = .mag.(fragments%rc(:,j) - fragments%rc(:,i)) + loverlap(i) = loverlap(i) .or. (dis <= (fragments%radius(i) + fragments%radius(j))) + end do + end do + end do + call collision_util_shift_vector_to_origin(fragments%mass, fragments%rc) + call collider%set_coordinate_system() + + do concurrent(i = 1:nfrag) + fragments%rb(:,i) = fragments%rc(:,i) + impactors%rbcom(:) + end do + + impactors%rbcom(:) = 0.0_DP + do concurrent(i = 1:nfrag) + impactors%rbcom(:) = impactors%rbcom(:) + fragments%mass(i) * fragments%rb(:,i) + end do + impactors%rbcom(:) = impactors%rbcom(:) / fragments%mtot + end associate + + return + end subroutine collision_generate_simple_pos_vec + + + module subroutine collision_generate_simple_vel_vec(collider) + !! Author: David A. Minton + !! + !! Generates an initial "guess" for the velocitity vectors + implicit none + ! Arguments + class(collision_simple_disruption), intent(inout) :: collider !! Fraggle collision system object + ! Internals + integer(I4B) :: i, j + logical :: lcat + real(DP), dimension(NDIM) :: vimp_unit + real(DP), dimension(NDIM,collider%fragments%nbody) :: vnoise + real(DP), parameter :: VNOISE_MAG = 0.10_DP + real(DP) :: vmag + + associate(fragments => collider%fragments, impactors => collider%impactors, nfrag => collider%fragments%nbody) + lcat = (impactors%regime == COLLRESOLVE_REGIME_SUPERCATASTROPHIC) + + ! "Bounce" the first two bodies + do i = 1,2 + fragments%vc(:,i) = impactors%vb(:,i) - impactors%vbcom(:) - 2 * impactors%vbimp(:) + end do + + vmag = .mag.impactors%vbcom(:) + vimp_unit(:) = .unit. impactors%vbimp(:) + call random_number(vnoise) + vnoise = (2 * vnoise - 1.0_DP) * vmag + do i = 3, nfrag + vimp_unit(:) = .unit. (fragments%rc(:,i) + impactors%rbcom(:) - impactors%rbimp(:)) + fragments%vc(:,i) = vmag * vimp_unit(:) + vnoise(:,i) + end do + end associate + return + end subroutine collision_generate_simple_vel_vec + + + + end submodule s_collision_generate \ No newline at end of file diff --git a/src/collision/collision_module.f90 b/src/collision/collision_module.f90 index 570e1cccc..ef75b56e9 100644 --- a/src/collision/collision_module.f90 +++ b/src/collision/collision_module.f90 @@ -233,6 +233,17 @@ module subroutine collision_generate_simple_disruption(self, nbody_system, param real(DP), intent(in) :: t !! The time of the collision end subroutine collision_generate_simple_disruption + module subroutine collision_generate_simple_pos_vec(collider, r_max_start) + implicit none + class(collision_simple_disruption), intent(inout) :: collider !! Fraggle collision system object + real(DP), intent(in) :: r_max_start !! The maximum radial distance of fragments for disruptive collisions + end subroutine collision_generate_simple_pos_vec + + module subroutine collision_generate_simple_vel_vec(collider) + implicit none + class(collision_simple_disruption), intent(inout) :: collider !! Fraggle collision system object + end subroutine collision_generate_simple_vel_vec + module subroutine collision_io_collider_message(pl, collidx, collider_message) implicit none class(base_object), intent(in) :: pl !! Swiftest massive body object @@ -349,32 +360,6 @@ module subroutine collision_resolve_pltp(self, nbody_system, param, t, dt, irec) integer(I4B), intent(in) :: irec !! Current recursion level end subroutine collision_resolve_pltp - module subroutine collision_util_set_coordinate_collider(self) - implicit none - class(collision_merge), intent(inout) :: self !! collisional system - end subroutine collision_util_set_coordinate_collider - - module subroutine collision_util_set_coordinate_impactors(self) - implicit none - class(collision_impactors), intent(inout) :: self !! collisional system - end subroutine collision_util_set_coordinate_impactors - - module subroutine collision_util_setup_collider(self, nbody_system) - implicit none - class(collision_merge), intent(inout) :: self !! Encounter collision system object - class(base_nbody_system), intent(in) :: nbody_system !! Current nbody system. Used as a mold for the before/after snapshots - end subroutine collision_util_setup_collider - - module subroutine collision_util_setup_impactors_collider(self) - implicit none - class(collision_merge), intent(inout) :: self !! Encounter collision system object - end subroutine collision_util_setup_impactors_collider - - module subroutine collision_util_setup_fragments_collider(self, nfrag) - implicit none - class(collision_merge), intent(inout) :: self !! Encounter collision system object - integer(I4B), intent(in) :: nfrag !! Number of fragments to create - end subroutine collision_util_setup_fragments_collider module subroutine collision_util_add_fragments_to_collider(self, nbody_system, param) implicit none @@ -403,6 +388,39 @@ module subroutine collision_util_set_mass_dist(self, param) class(base_parameters), intent(in) :: param !! Current Swiftest run configuration parameters end subroutine collision_util_set_mass_dist + module subroutine collision_util_set_coordinate_collider(self) + implicit none + class(collision_merge), intent(inout) :: self !! collisional system + end subroutine collision_util_set_coordinate_collider + + module subroutine collision_util_set_coordinate_impactors(self) + implicit none + class(collision_impactors), intent(inout) :: self !! collisional system + end subroutine collision_util_set_coordinate_impactors + + module subroutine collision_util_setup_collider(self, nbody_system) + implicit none + class(collision_merge), intent(inout) :: self !! Encounter collision system object + class(base_nbody_system), intent(in) :: nbody_system !! Current nbody system. Used as a mold for the before/after snapshots + end subroutine collision_util_setup_collider + + module subroutine collision_util_setup_impactors_collider(self) + implicit none + class(collision_merge), intent(inout) :: self !! Encounter collision system object + end subroutine collision_util_setup_impactors_collider + + module subroutine collision_util_setup_fragments_collider(self, nfrag) + implicit none + class(collision_merge), intent(inout) :: self !! Encounter collision system object + integer(I4B), intent(in) :: nfrag !! Number of fragments to create + end subroutine collision_util_setup_fragments_collider + + module subroutine collision_util_shift_vector_to_origin(m_frag, vec_frag) + implicit none + real(DP), dimension(:), intent(in) :: m_frag !! Fragment masses + real(DP), dimension(:,:), intent(inout) :: vec_frag !! Fragment positions or velocities in the center of mass frame + end subroutine + module subroutine collision_util_get_idvalues_snapshot(self, idvals) implicit none class(collision_snapshot), intent(in) :: self !! Collision snapshot object diff --git a/src/collision/collision_util.f90 b/src/collision/collision_util.f90 index 06a39f4ed..da68b42d6 100644 --- a/src/collision/collision_util.f90 +++ b/src/collision/collision_util.f90 @@ -459,8 +459,8 @@ module subroutine collision_util_set_coordinate_impactors(self) ! Find the point of impact between the two bodies impactors%rbimp(:) = impactors%rb(:,1) + impactors%radius(1) * impactors%y_unit(:) - ! The "bounce" unit vector is the projection of - impactors%vbimp(:) = dot_product(delta_v(:),impactors%x_unit(:)) * impactors%x_unit(:) + ! The "bounce" unit vector is the projection of the velocity vector into the distance vector + impactors%vbimp(:) = dot_product(delta_v(:),impactors%y_unit(:)) * impactors%y_unit(:) end associate return @@ -656,6 +656,36 @@ module subroutine collision_util_setup_fragments_collider(self, nfrag) end subroutine collision_util_setup_fragments_collider + module subroutine collision_util_shift_vector_to_origin(m_frag, vec_frag) + !! Author: Jennifer L.L. Pouplin, Carlisle A. Wishard, and David A. Minton + !! + !! Adjusts the position or velocity of the fragments as needed to align them with the origin + implicit none + ! Arguments + real(DP), dimension(:), intent(in) :: m_frag !! Fragment masses + real(DP), dimension(:,:), intent(inout) :: vec_frag !! Fragment positions or velocities in the center of mass frame + + ! Internals + real(DP), dimension(NDIM) :: mvec_frag, COM_offset + integer(I4B) :: i, nfrag + real(DP) :: mtot + + mvec_frag(:) = 0.0_DP + mtot = sum(m_frag) + nfrag = size(m_frag) + + do i = 1, nfrag + mvec_frag = mvec_frag(:) + vec_frag(:,i) * m_frag(i) + end do + COM_offset(:) = -mvec_frag(:) / mtot + do i = 1, nfrag + vec_frag(:, i) = vec_frag(:, i) + COM_offset(:) + end do + + return + end subroutine collision_util_shift_vector_to_origin + + subroutine collision_util_save_snapshot(collision_history, snapshot) !! author: David A. Minton !! diff --git a/src/fraggle/fraggle_generate.f90 b/src/fraggle/fraggle_generate.f90 index b809e45f4..4424b2412 100644 --- a/src/fraggle/fraggle_generate.f90 +++ b/src/fraggle/fraggle_generate.f90 @@ -282,7 +282,7 @@ module subroutine fraggle_generate_fragments(collider, nbody_system, param, lfai lfailure = .false. call ieee_set_flag(ieee_all, .false.) ! Set all fpe flags to quiet - call fraggle_generate_pos_vec(collider, r_max_start) + call collision_generate_simple_pos_vec(collider, r_max_start) call collider%set_coordinate_system() ! Initial velocity guess will be the barycentric velocity of the colliding nbody_system so that the budgets are based on the much smaller collisional-frame velocities @@ -293,46 +293,46 @@ module subroutine fraggle_generate_fragments(collider, nbody_system, param, lfai call collider%get_energy_and_momentum(nbody_system, param, lbefore=.false.) call collider%set_budgets() - call fraggle_generate_vel_vec_guess(collider) - - ! call fraggle_generate_tan_vel(collider, lfailure) - ! if (lfailure) then - ! call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Fraggle failed to find tangential velocities") - ! cycle - ! end if - - ! call fraggle_generate_rad_vel(collider, lfailure) - ! if (lfailure) then - ! call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Fraggle failed to find radial velocities") - ! cycle - ! end if - - ! call fraggle_generate_spins(collider, f_spin, lfailure) - ! if (lfailure) then - ! call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Fraggle failed to find spins") - ! cycle - ! end if - - ! call collider%get_energy_and_momentum(nbody_system, param, lbefore=.false.) - ! dEtot = collider%Etot(2) - collider%Etot(1) - ! dLmag = .mag. (collider%Ltot(:,2) - collider%Ltot(:,1)) - ! exit - - ! lfailure = ((abs(dEtot + impactors%Qloss) > FRAGGLE_ETOL) .or. (dEtot > 0.0_DP)) - ! if (lfailure) then - ! write(message, *) dEtot, abs(dEtot + impactors%Qloss) / FRAGGLE_ETOL - ! call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Fraggle failed due to high energy error: " // & - ! trim(adjustl(message))) - ! cycle - ! end if - - ! lfailure = ((abs(dLmag) / (.mag.collider%Ltot(:,1))) > FRAGGLE_LTOL) - ! if (lfailure) then - ! write(message,*) dLmag / (.mag.collider%Ltot(:,1)) - ! call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Fraggle failed due to high angular momentum error: " // & - ! trim(adjustl(message))) - ! cycle - ! end if + call collision_generate_simple_vel_vec(collider) + + call fraggle_generate_tan_vel(collider, lfailure) + if (lfailure) then + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Fraggle failed to find tangential velocities") + cycle + end if + + call fraggle_generate_rad_vel(collider, lfailure) + if (lfailure) then + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Fraggle failed to find radial velocities") + cycle + end if + + call fraggle_generate_spins(collider, f_spin, lfailure) + if (lfailure) then + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Fraggle failed to find spins") + cycle + end if + + call collider%get_energy_and_momentum(nbody_system, param, lbefore=.false.) + dEtot = collider%Etot(2) - collider%Etot(1) + dLmag = .mag. (collider%Ltot(:,2) - collider%Ltot(:,1)) + exit + + lfailure = ((abs(dEtot + impactors%Qloss) > FRAGGLE_ETOL) .or. (dEtot > 0.0_DP)) + if (lfailure) then + write(message, *) dEtot, abs(dEtot + impactors%Qloss) / FRAGGLE_ETOL + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Fraggle failed due to high energy error: " // & + trim(adjustl(message))) + cycle + end if + + lfailure = ((abs(dLmag) / (.mag.collider%Ltot(:,1))) > FRAGGLE_LTOL) + if (lfailure) then + write(message,*) dLmag / (.mag.collider%Ltot(:,1)) + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Fraggle failed due to high angular momentum error: " // & + trim(adjustl(message))) + cycle + end if ! Check if any of the usual floating point exceptions happened, and fail the try if so call ieee_get_flag(ieee_usual, fpe_flag) @@ -364,122 +364,6 @@ module subroutine fraggle_generate_fragments(collider, nbody_system, param, lfai return end subroutine fraggle_generate_fragments - - subroutine fraggle_generate_pos_vec(collider, r_max_start) - !! Author: Jennifer L.L. Pouplin, Carlisle A. Wishard, and David A. Minton - !! - !! Initializes the orbits of the fragments around the center of mass. The fragments are initially placed on a plane defined by the - !! pre-impact angular momentum. They are distributed on an ellipse surrounding the center of mass. - !! The initial positions do not conserve energy or momentum, so these need to be adjusted later. - implicit none - ! Arguments - class(collision_fraggle), intent(inout) :: collider !! Fraggle collision system object - real(DP), intent(in) :: r_max_start !! Initial guess for the starting maximum radial distance of fragments - ! Internals - real(DP) :: dis, rad, r_max, fdistort - logical, dimension(:), allocatable :: loverlap - integer(I4B) :: i, j - logical :: lnoncat, lhitandrun - - associate(fragments => collider%fragments, impactors => collider%impactors, nfrag => collider%fragments%nbody) - allocate(loverlap(nfrag)) - - lnoncat = (impactors%regime /= COLLRESOLVE_REGIME_SUPERCATASTROPHIC) ! For non-catastrophic impacts, make the fragments act like ejecta and point away from the impact point - lhitandrun = (impactors%regime == COLLRESOLVE_REGIME_HIT_AND_RUN) ! Disruptive hit and runs have their own fragment distribution - - ! Place the fragments into a region that is big enough that we should usually not have overlapping bodies - ! An overlapping bodies will collide in the next time step, so it's not a major problem if they do (it just slows the run down) - r_max = r_max_start - rad = sum(impactors%radius(:)) - - ! This is a factor that will "distort" the shape of the fragment cloud in the direction of the impact velocity - fdistort = .mag. (impactors%y_unit(:) .cross. impactors%v_unit(:)) - - ! We will treat the first two fragments of the list as special cases. They get initialized at the original positions of the impactor bodies - fragments%rc(:, 1) = impactors%rb(:, 1) - impactors%rbcom(:) - fragments%rc(:, 2) = impactors%rb(:, 2) - impactors%rbcom(:) - call random_number(fragments%rc(:,3:nfrag)) - loverlap(:) = .true. - do while (any(loverlap(3:nfrag))) - if (lhitandrun) then ! For a hit-and-run with disruption, the fragment cloud size is based on the radius of the disrupted body - r_max = 2 * impactors%radius(2) - else ! For disruptions, the the fragment cloud size is based on the mutual collision system - r_max = r_max + 0.1_DP * rad - end if - do i = 3, nfrag - if (loverlap(i)) then - call random_number(fragments%rc(:,i)) - fragments%rc(:,i) = 2 * (fragments%rc(:, i) - 0.5_DP) - fragments%rc(:, i) = fragments%rc(:,i) + fdistort * impactors%v_unit(:) - fragments%rc(:, i) = r_max * fragments%rc(:, i) - fragments%rc(:, i) = fragments%rc(:, i) + (impactors%rbimp(:) - impactors%rbcom(:)) ! Shift the center of the fragment cloud to the impact point rather than the CoM - if (lnoncat .and. dot_product(fragments%rc(:,i), impactors%y_unit(:)) < 0.0_DP) fragments%rc(:, i) = -fragments%rc(:, i) ! Make sure the fragment cloud points away from the impact point - end if - end do - - ! Check for any overlapping bodies. - loverlap(:) = .false. - do j = 1, nfrag - do i = j + 1, nfrag - dis = .mag.(fragments%rc(:,j) - fragments%rc(:,i)) - loverlap(i) = loverlap(i) .or. (dis <= (fragments%radius(i) + fragments%radius(j))) - end do - end do - end do - call fraggle_util_shift_vector_to_origin(fragments%mass, fragments%rc) - call collider%set_coordinate_system() - - do concurrent(i = 1:nfrag) - fragments%rb(:,i) = fragments%rc(:,i) + impactors%rbcom(:) - end do - - impactors%rbcom(:) = 0.0_DP - do concurrent(i = 1:nfrag) - impactors%rbcom(:) = impactors%rbcom(:) + fragments%mass(i) * fragments%rb(:,i) - end do - impactors%rbcom(:) = impactors%rbcom(:) / fragments%mtot - end associate - - return - end subroutine fraggle_generate_pos_vec - - - subroutine fraggle_generate_vel_vec_guess(collider) - !! Author: David A. Minton - !! - !! Generates an initial "guess" for the velocitity vectors - implicit none - ! Arguments - class(collision_fraggle), intent(inout) :: collider !! Fraggle collision system object - ! Internals - integer(I4B) :: i, j - logical :: lcat - real(DP), dimension(NDIM) :: vimp_unit - real(DP), dimension(NDIM,collider%fragments%nbody) :: vnoise - real(DP), parameter :: VNOISE_MAG = 0.10_DP - real(DP) :: vmag - - associate(fragments => collider%fragments, impactors => collider%impactors, nfrag => collider%fragments%nbody) - lcat = (impactors%regime == COLLRESOLVE_REGIME_SUPERCATASTROPHIC) - - ! "Bounce" the first two bodies - do i = 1,2 - fragments%vc(:,i) = impactors%vb(:,i) - impactors%vbcom(:) - 2 * impactors%vbimp(:) - end do - - vmag = .mag.impactors%vbcom(:) - vimp_unit(:) = .unit. impactors%vbimp(:) - call random_number(vnoise) - vnoise = (2 * vnoise - 1.0_DP) * vmag - do i = 3, nfrag - vimp_unit(:) = .unit. (fragments%rc(:,i) + impactors%rbcom(:) - impactors%rbimp(:)) - fragments%vc(:,i) = vmag * vimp_unit(:) + vnoise(:,i) - end do - end associate - return - end subroutine fraggle_generate_vel_vec_guess - - subroutine fraggle_generate_spins(collider, f_spin, lfailure) !! Author: Jennifer L.L. Pouplin, Carlisle A. Wishard, and David A. Minton !! diff --git a/src/fraggle/fraggle_module.f90 b/src/fraggle/fraggle_module.f90 index 72c0e5dc3..7e364dc6f 100644 --- a/src/fraggle/fraggle_module.f90 +++ b/src/fraggle/fraggle_module.f90 @@ -143,13 +143,6 @@ module subroutine fraggle_util_set_original_scale_factors(self) class(collision_fraggle), intent(inout) :: self !! Fraggle collision system object end subroutine fraggle_util_set_original_scale_factors - - module subroutine fraggle_util_shift_vector_to_origin(m_frag, vec_frag) - implicit none - real(DP), dimension(:), intent(in) :: m_frag !! Fragment masses - real(DP), dimension(:,:), intent(inout) :: vec_frag !! Fragment positions or velocities in the center of mass frame - end subroutine - module function fraggle_util_vmag_to_vb(v_r_mag, v_r_unit, v_t_mag, v_t_unit, m_frag, vcom) result(vb) implicit none real(DP), dimension(:), intent(in) :: v_r_mag !! Unknown radial component of fragment velocity vector diff --git a/src/fraggle/fraggle_util.f90 b/src/fraggle/fraggle_util.f90 index 22691f17a..928e3655e 100644 --- a/src/fraggle/fraggle_util.f90 +++ b/src/fraggle/fraggle_util.f90 @@ -317,36 +317,6 @@ module subroutine fraggle_util_setup_fragments_system(self, nfrag) end subroutine fraggle_util_setup_fragments_system - module subroutine fraggle_util_shift_vector_to_origin(m_frag, vec_frag) - !! Author: Jennifer L.L. Pouplin, Carlisle A. Wishard, and David A. Minton - !! - !! Adjusts the position or velocity of the fragments as needed to align them with the origin - implicit none - ! Arguments - real(DP), dimension(:), intent(in) :: m_frag !! Fragment masses - real(DP), dimension(:,:), intent(inout) :: vec_frag !! Fragment positions or velocities in the center of mass frame - - ! Internals - real(DP), dimension(NDIM) :: mvec_frag, COM_offset - integer(I4B) :: i, nfrag - real(DP) :: mtot - - mvec_frag(:) = 0.0_DP - mtot = sum(m_frag) - nfrag = size(m_frag) - - do i = 1, nfrag - mvec_frag = mvec_frag(:) + vec_frag(:,i) * m_frag(i) - end do - COM_offset(:) = -mvec_frag(:) / mtot - do i = 1, nfrag - vec_frag(:, i) = vec_frag(:, i) + COM_offset(:) - end do - - return - end subroutine fraggle_util_shift_vector_to_origin - - module function fraggle_util_vmag_to_vb(v_r_mag, v_r_unit, v_t_mag, v_t_unit, m_frag, vcom) result(vb) !! Author: David A. Minton !! @@ -370,7 +340,7 @@ module function fraggle_util_vmag_to_vb(v_r_mag, v_r_unit, v_t_mag, v_t_unit, m_ vb(:,i) = abs(v_r_mag(i)) * v_r_unit(:, i) end do ! In order to keep satisfying the kinetic energy constraint, we must shift the origin of the radial component of the velocities to the center of mass - call fraggle_util_shift_vector_to_origin(m_frag, vb) + call collision_util_shift_vector_to_origin(m_frag, vb) do i = 1, nfrag vb(:, i) = vb(:, i) + v_t_mag(i) * v_t_unit(:, i) + vcom(:) From 33504209a65a9ed4402089ea7ff4e9e846950fa8 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Fri, 23 Dec 2022 12:21:22 -0500 Subject: [PATCH 516/569] Set up simple disruption model --- src/collision/collision_generate.f90 | 24 +++++++++++++++++------- src/collision/collision_module.f90 | 1 + src/collision/collision_resolve.f90 | 3 ++- 3 files changed, 20 insertions(+), 8 deletions(-) diff --git a/src/collision/collision_generate.f90 b/src/collision/collision_generate.f90 index a3ff0cbca..aa2e79761 100644 --- a/src/collision/collision_generate.f90 +++ b/src/collision/collision_generate.f90 @@ -328,28 +328,38 @@ end subroutine collision_generate_simple_pos_vec module subroutine collision_generate_simple_vel_vec(collider) !! Author: David A. Minton !! - !! Generates an initial "guess" for the velocitity vectors + !! Generates an initial velocity distribution. For disruptions, the velocity magnitude is set to be + !! 2x the escape velocity of the colliding pair. For hit and runs the velocity magnitude is set to be + !! 2x the escape velocity of the smallest of the two bodies. implicit none ! Arguments class(collision_simple_disruption), intent(inout) :: collider !! Fraggle collision system object ! Internals integer(I4B) :: i, j - logical :: lcat - real(DP), dimension(NDIM) :: vimp_unit + logical :: lhr + real(DP), dimension(NDIM) :: vimp_unit, vcom, rnorm real(DP), dimension(NDIM,collider%fragments%nbody) :: vnoise real(DP), parameter :: VNOISE_MAG = 0.10_DP real(DP) :: vmag associate(fragments => collider%fragments, impactors => collider%impactors, nfrag => collider%fragments%nbody) - lcat = (impactors%regime == COLLRESOLVE_REGIME_SUPERCATASTROPHIC) + lhr = (impactors%regime == COLLRESOLVE_REGIME_HIT_AND_RUN) ! "Bounce" the first two bodies do i = 1,2 - fragments%vc(:,i) = impactors%vb(:,i) - impactors%vbcom(:) - 2 * impactors%vbimp(:) + vcom(:) = impactors%vb(:,i) - impactors%vbcom(:) + rnorm(:) = impactors%y_unit(:) + ! Do the reflection + vcom(:) = vcom(:) - 2 * dot_product(vcom(:),rnorm(:)) * rnorm(:) + fragments%vc(:,i) = vcom(:) end do - vmag = .mag.impactors%vbcom(:) - vimp_unit(:) = .unit. impactors%vbimp(:) + ! Compute the escape velocity + if (lhr) then + vmag = 2 * sqrt(2 * impactors%Gmass(2) / impactors%radius(2)) + else + vmag = 2 * sqrt(2 * sum(impactors%Gmass(:)) / (.mag. (impactors%rb(:,2) - impactors%rb(:,1)))) + end if call random_number(vnoise) vnoise = (2 * vnoise - 1.0_DP) * vmag do i = 3, nfrag diff --git a/src/collision/collision_module.f90 b/src/collision/collision_module.f90 index ef75b56e9..046341a93 100644 --- a/src/collision/collision_module.f90 +++ b/src/collision/collision_module.f90 @@ -58,6 +58,7 @@ module collision real(DP), dimension(NDIM,2) :: Lspin !! Two-body equivalent spin angular momentum vectors of the collider bodies prior to collision real(DP), dimension(NDIM,2) :: Lorbit !! Two-body equivalent orbital angular momentum vectors of the collider bodies prior to collision real(DP), dimension(NDIM,2) :: Ip !! Two-body equivalent principal axes moments of inertia the collider bodies prior to collision + real(DP), dimension(2) :: Gmass !! Two-body equivalent G*mass of the collider bodies prior to the collision real(DP), dimension(2) :: mass !! Two-body equivalent mass of the collider bodies prior to the collision real(DP), dimension(2) :: radius !! Two-body equivalent radii of the collider bodies prior to the collision real(DP) :: Qloss !! Energy lost during the collision diff --git a/src/collision/collision_resolve.f90 b/src/collision/collision_resolve.f90 index 419875a80..af4e4583c 100644 --- a/src/collision/collision_resolve.f90 +++ b/src/collision/collision_resolve.f90 @@ -57,7 +57,8 @@ module subroutine collision_resolve_consolidate_impactors(self, nbody_system, pa pl%kin(idx_parent(2))%parent = idx_parent(1) end if - impactors%mass(:) = pl%mass(idx_parent(:)) ! Note: This is meant to mass, not G*mass, as the collisional regime determination uses mass values that will be converted to Si + impactors%Gmass(:) = pl%Gmass(idx_parent(:)) + impactors%mass(:) = pl%mass(idx_parent(:)) impactors%radius(:) = pl%radius(idx_parent(:)) volume(:) = (4.0_DP / 3.0_DP) * PI * impactors%radius(:)**3 From 9eaa79958a8c75783611a98678cb1213f4567e66 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Fri, 23 Dec 2022 16:07:18 -0500 Subject: [PATCH 517/569] More restructuring to put most of the basic infrastructure of generating fragments into the simple disruption model --- src/collision/collision_generate.f90 | 212 +++++++++++++++++++---- src/collision/collision_module.f90 | 77 +++++---- src/collision/collision_resolve.f90 | 4 +- src/collision/collision_util.f90 | 16 +- src/fraggle/fraggle_generate.f90 | 245 ++++----------------------- src/fraggle/fraggle_module.f90 | 45 ++--- src/fraggle/fraggle_util.f90 | 102 +++++------ src/swiftest/swiftest_module.f90 | 2 +- src/swiftest/swiftest_util.f90 | 2 +- 9 files changed, 326 insertions(+), 379 deletions(-) diff --git a/src/collision/collision_generate.f90 b/src/collision/collision_generate.f90 index aa2e79761..333e5d059 100644 --- a/src/collision/collision_generate.f90 +++ b/src/collision/collision_generate.f90 @@ -12,6 +12,26 @@ use swiftest contains + module subroutine collision_generate_basic(self, nbody_system, param, t) + !! author: Jennifer L.L. Pouplin, Carlisle A. Wishard, and David A. Minton + !! + !! Merge massive bodies no matter the regime + !! + !! Adapted from David E. Kaufmann's Swifter routines symba_merge_pl.f90 and symba_discard_merge_pl.f90 + !! + !! Adapted from Hal Levison's Swift routines symba5_merge.f and discard_mass_merge.f + implicit none + ! Arguments + class(collision_basic), intent(inout) :: self !! Merge fragment system object + class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object + class(base_parameters), intent(inout) :: param !! Current run configuration parameters + real(DP), intent(in) :: t !! The time of the collision + + call self%merge(nbody_system, param, t) + + return + end subroutine collision_generate_basic + module subroutine collision_generate_bounce(self, nbody_system, param, t) !! author: David A. Minton !! @@ -55,9 +75,9 @@ module subroutine collision_generate_bounce(self, nbody_system, param, t) end select end select case (COLLRESOLVE_REGIME_HIT_AND_RUN) - call collision_generate_hitandrun(self, nbody_system, param, t) + call self%hitandrun(nbody_system, param, t) case (COLLRESOLVE_REGIME_MERGE, COLLRESOLVE_REGIME_GRAZE_AND_MERGE) - call self%collision_merge%generate(nbody_system, param, t) ! Use the default collision model, which is merge + call self%merge(nbody_system, param, t) ! Use the default collision model, which is merge case default write(*,*) "Error in swiftest_collision, unrecognized collision regime" call util_exit(FAILURE) @@ -70,54 +90,178 @@ module subroutine collision_generate_bounce(self, nbody_system, param, t) end subroutine collision_generate_bounce - module subroutine collision_generate_hitandrun(collider, nbody_system, param, t) + module subroutine collision_generate_hitandrun(self, nbody_system, param, t) !! author: Jennifer L.L. Pouplin, Carlisle A. Wishard, and David A. Minton !! !! Create the fragments resulting from a non-catastrophic hit-and-run collision !! implicit none ! Arguments - class(collision_merge), intent(inout) :: collider !! Fraggle collision system object - class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object - class(base_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions - real(DP), intent(in) :: t !! Time of collision + class(collision_basic), intent(inout) :: self !! Collision system object + class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object + class(base_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions + real(DP), intent(in) :: t !! Time of collision + ! Result + integer(I4B) :: status !! Status flag assigned to this outcome ! Internals integer(I4B) :: i, ibiggest, nfrag, jtarg, jproj logical :: lpure character(len=STRMAX) :: message real(DP) :: dpe + select type(nbody_system) class is (swiftest_nbody_system) - select type (pl => nbody_system%pl) + select type(pl => nbody_system%pl) class is (swiftest_pl) - - associate(impactors => collider%impactors, fragments => collider%fragments, pl => nbody_system%pl) + associate(impactors => self%impactors) message = "Hit and run between" call collision_io_collider_message(nbody_system%pl, impactors%id, message) call swiftest_io_log_one_message(COLLISION_LOG_OUT, trim(adjustl(message))) - collider%status = HIT_AND_RUN_PURE - pl%status(impactors%id(:)) = ACTIVE - pl%ldiscard(impactors%id(:)) = .false. - pl%lcollision(impactors%id(:)) = .false. - - ! Be sure to save the pl so that snapshots still work - select type(before => collider%before) - class is (swiftest_nbody_system) - select type(after => collider%after) - class is (swiftest_nbody_system) - allocate(after%pl, source=before%pl) - end select - end select + if (impactors%mass(1) > impactors%mass(2)) then + jtarg = 1 + jproj = 2 + else + jtarg = 2 + jproj = 1 + end if + + ! The simple disruption model (and its extended types allow for non-pure hit and run. + !For the basic merge model, all hit and runs are pure + select type(self) + class is (collision_simple_disruption) + if (impactors%mass_dist(2) > 0.9_DP * impactors%mass(jproj)) then ! Pure hit and run, so we'll just keep the two bodies untouched + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Pure hit and run. No new fragments generated.") + nfrag = 0 + lpure = .true. + else ! Imperfect hit and run, so we'll keep the largest body and destroy the other + lpure = .false. + call self%set_mass_dist(param) + + ! Generate the position and velocity distributions of the fragments + call self%disrupt(nbody_system, param, t, lpure) + + dpe = self%pe(2) - self%pe(1) + nbody_system%Ecollisions = nbody_system%Ecollisions - dpe + nbody_system%Euntracked = nbody_system%Euntracked + dpe + + if (lpure) then + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Should have been a pure hit and run instead") + nfrag = 0 + else + nfrag = self%fragments%nbody + write(message, *) nfrag + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Generating " // trim(adjustl(message)) // " fragments") + end if + end if + class default + lpure = .true. + end select + + if (lpure) then ! Reset these bodies back to being active so that nothing further is done to them + status = HIT_AND_RUN_PURE + pl%status(impactors%id(:)) = ACTIVE + pl%ldiscard(impactors%id(:)) = .false. + pl%lcollision(impactors%id(:)) = .false. + ! Be sure to save the pl so that snapshots still work + select type(before => self%before) + class is (swiftest_nbody_system) + select type(after => self%after) + class is (swiftest_nbody_system) + allocate(after%pl, source=before%pl) + end select + end select + else + ibiggest = impactors%id(maxloc(pl%Gmass(impactors%id(:)), dim=1)) + self%fragments%id(1) = pl%id(ibiggest) + self%fragments%id(2:nfrag) = [(i, i = param%maxid + 1, param%maxid + nfrag - 1)] + param%maxid = self%fragments%id(nfrag) + status = HIT_AND_RUN_DISRUPT + call collision_resolve_mergeaddsub(nbody_system, param, t, status) + end if end associate end select end select + return + end subroutine collision_generate_hitandrun + + + module subroutine collision_generate_simple(self, nbody_system, param, t) + !! author: Jennifer L.L. Pouplin, Carlisle A. Wishard, and David A. Minton + !! + !! Create the fragments resulting from a non-catastrophic disruption collision + !! + implicit none + ! Arguments + class(collision_simple_disruption), intent(inout) :: self + class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object + class(base_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions + real(DP), intent(in) :: t !! Time of collision + ! Internals + integer(I4B) :: i, ibiggest, nfrag, status + logical :: lfailure + character(len=STRMAX) :: message + real(DP) :: dpe + select type(nbody_system) + class is (swiftest_nbody_system) + select type(pl => nbody_system%pl) + class is (swiftest_pl) + associate(impactors => self%impactors, fragments => self%fragments, status => self%status) + select case (impactors%regime) + case (COLLRESOLVE_REGIME_HIT_AND_RUN) + call self%hitandrun(nbody_system, param, t) + return + case (COLLRESOLVE_REGIME_MERGE, COLLRESOLVE_REGIME_GRAZE_AND_MERGE) + call self%merge(nbody_system, param, t) ! Use the default collision model, which is merge + return + case(COLLRESOLVE_REGIME_DISRUPTION) + message = "Disruption between" + case(COLLRESOLVE_REGIME_SUPERCATASTROPHIC) + message = "Supercatastrophic disruption between" + case default + write(*,*) "Error in swiftest_collision, unrecognized collision regime" + call util_exit(FAILURE) + end select + call collision_io_collider_message(nbody_system%pl, impactors%id, message) + call swiftest_io_log_one_message(COLLISION_LOG_OUT, message) + + ! Collisional fragments will be uniformly distributed around the pre-impact barycenter + call self%set_mass_dist(param) + + ! Generate the position and velocity distributions of the fragments + call self%disrupt(nbody_system, param, t) + + dpe = self%pe(2) - self%pe(1) + nbody_system%Ecollisions = nbody_system%Ecollisions - dpe + nbody_system%Euntracked = nbody_system%Euntracked + dpe + + ! Populate the list of new bodies + nfrag = fragments%nbody + write(message, *) nfrag + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Generating " // trim(adjustl(message)) // " fragments") + select case(impactors%regime) + case(COLLRESOLVE_REGIME_DISRUPTION) + status = DISRUPTED + ibiggest = impactors%id(maxloc(pl%Gmass(impactors%id(:)), dim=1)) + fragments%id(1) = pl%id(ibiggest) + fragments%id(2:nfrag) = [(i, i = param%maxid + 1, param%maxid + nfrag - 1)] + param%maxid = fragments%id(nfrag) + case(COLLRESOLVE_REGIME_SUPERCATASTROPHIC) + status = SUPERCATASTROPHIC + fragments%id(1:nfrag) = [(i, i = param%maxid + 1, param%maxid + nfrag)] + param%maxid = fragments%id(nfrag) + end select + + call collision_resolve_mergeaddsub(nbody_system, param, t, status) + end associate + end select + end select return - end subroutine collision_generate_hitandrun + end subroutine collision_generate_simple module subroutine collision_generate_merge(self, nbody_system, param, t) @@ -130,7 +274,7 @@ module subroutine collision_generate_merge(self, nbody_system, param, t) !! Adapted from Hal Levison's Swift routines symba5_merge.f and discard_mass_merge.f implicit none ! Arguments - class(collision_merge), intent(inout) :: self !! Merge fragment system object + class(collision_basic), intent(inout) :: self !! Merge fragment system object class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(base_parameters), intent(inout) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! The time of the collision @@ -220,7 +364,7 @@ module subroutine collision_generate_merge(self, nbody_system, param, t) end subroutine collision_generate_merge - module subroutine collision_generate_simple_disruption(self, nbody_system, param, t) + module subroutine collision_generate_disrupt(self, nbody_system, param, t, lfailure) !! author: Jennifer L.L. Pouplin, Carlisle A. Wishard, and David A. Minton !! !! Generates a simple fragment position and velocity distribution based on the collision @@ -231,18 +375,16 @@ module subroutine collision_generate_simple_disruption(self, nbody_system, param class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(base_parameters), intent(inout) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! The time of the collision + logical, optional, intent(out) :: lfailure ! Internals real(DP) :: r_max_start - associate(impactors => self%impactors, fragments => self%fragments, nfrag => self%fragments%nbody) - r_max_start = 1.1_DP * .mag.(impactors%rb(:,2) - impactors%rb(:,1)) - call collision_generate_simple_pos_vec(self, r_max_start) - call self%set_coordinate_system() - call collision_generate_simple_vel_vec(self) - end associate - + r_max_start = 1.1_DP * .mag.(self%impactors%rb(:,2) - self%impactors%rb(:,1)) + call collision_generate_simple_pos_vec(self, r_max_start) + call self%set_coordinate_system() + call collision_generate_simple_vel_vec(self) return - end subroutine collision_generate_simple_disruption + end subroutine collision_generate_disrupt module subroutine collision_generate_simple_pos_vec(collider, r_max_start) @@ -371,6 +513,4 @@ module subroutine collision_generate_simple_vel_vec(collider) end subroutine collision_generate_simple_vel_vec - - end submodule s_collision_generate \ No newline at end of file diff --git a/src/collision/collision_module.f90 b/src/collision/collision_module.f90 index 046341a93..51be502a4 100644 --- a/src/collision/collision_module.f90 +++ b/src/collision/collision_module.f90 @@ -113,11 +113,11 @@ module collision end type collision_fragments - type :: collision_merge + type :: collision_basic !! This class defines a collisional system that stores impactors and fragments. This is written so that various collision models (i.e. Fraggle) could potentially be used !! to resolve collision by defining extended types of encounters_impactors and/or encounetr_fragments !! - !! The generate method for this class is the merge model. This allows any extended type to have access to the merge procedure by selecting the collision_merge parent class + !! The generate method for this class is the merge model. This allows any extended type to have access to the merge procedure by selecting the collision_basic parent class class(collision_fragments(:)), allocatable :: fragments !! Object containing information on the pre-collision system class(collision_impactors), allocatable :: impactors !! Object containing information on the post-collision system class(base_nbody_system), allocatable :: before !! A snapshot of the subset of the nbody_system involved in the collision @@ -141,18 +141,21 @@ module collision procedure :: get_energy_and_momentum => collision_util_get_energy_momentum !! Calculates total nbody_system energy in either the pre-collision outcome state (lbefore = .true.) or the post-collision outcome state (lbefore = .false.) procedure :: reset => collision_util_reset_system !! Deallocates all allocatables procedure :: set_coordinate_system => collision_util_set_coordinate_collider !! Sets the coordinate system of the collisional system - procedure :: generate => collision_generate_merge !! Merges the impactors to make a single final body - end type collision_merge + procedure :: generate => collision_generate_basic !! Merges the impactors to make a single final body + procedure :: hitandrun => collision_generate_hitandrun !! Merges the impactors to make a single final body + procedure :: merge => collision_generate_merge !! Merges the impactors to make a single final body + end type collision_basic - type, extends(collision_merge) :: collision_bounce + type, extends(collision_basic) :: collision_bounce contains procedure :: generate => collision_generate_bounce !! If a collision would result in a disruption, "bounce" the bodies instead. final :: collision_final_bounce !! Finalizer will deallocate all allocatables end type collision_bounce - type, extends(collision_merge) :: collision_simple_disruption + type, extends(collision_basic) :: collision_simple_disruption contains - procedure :: generate => collision_generate_simple_disruption !! If a collision would result in a disruption [TODO: SOMETHING LIKE CHAMBERS 2012] + procedure :: generate => collision_generate_simple !! A simple disruption models that does not constrain energy loss in collisions + procedure :: disrupt => collision_generate_disrupt !! Disrupt the colliders into the fragments procedure :: set_mass_dist => collision_util_set_mass_dist !! Sets the distribution of mass among the fragments depending on the regime type final :: collision_final_simple !! Finalizer will deallocate all allocatables end type collision_simple_disruption @@ -182,7 +185,7 @@ module collision type, extends(encounter_snapshot) :: collision_snapshot logical :: lcollision !! Indicates that this snapshot contains at least one collision - class(collision_merge), allocatable :: collider !! Collider object at this snapshot + class(collision_basic), allocatable :: collider !! Collider object at this snapshot contains procedure :: write_frame => collision_io_netcdf_write_frame_snapshot !! Writes a frame of encounter data to file procedure :: get_idvals => collision_util_get_idvalues_snapshot !! Gets an array of all id values saved in this snapshot @@ -201,10 +204,34 @@ module collision interface + module subroutine collision_generate_basic(self, nbody_system, param, t) + implicit none + class(collision_basic), intent(inout) :: self !! Merge fragment nbody_system object + class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object + class(base_parameters), intent(inout) :: param !! Current run configuration parameters + real(DP), intent(in) :: t !! The time of the collision + end subroutine collision_generate_basic + + module subroutine collision_generate_bounce(self, nbody_system, param, t) + implicit none + class(collision_bounce), intent(inout) :: self !! Bounce fragment nbody_system object + class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object + class(base_parameters), intent(inout) :: param !! Current run configuration parameters + real(DP), intent(in) :: t !! The time of the collision + end subroutine collision_generate_bounce + + module subroutine collision_generate_disrupt(self, nbody_system, param, t, lfailure) + implicit none + class(collision_simple_disruption), intent(inout) :: self + class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object + class(base_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions + real(DP), intent(in) :: t !! Time of collision + logical, optional, intent(out) :: lfailure !! Disruption failed + end subroutine collision_generate_disrupt - module subroutine collision_generate_hitandrun(collider, nbody_system, param, t) + module subroutine collision_generate_hitandrun(self, nbody_system, param, t) implicit none - class(collision_merge), intent(inout) :: collider !! Merge (or extended) collision system object + class(collision_basic), intent(inout) :: self class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(base_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions real(DP), intent(in) :: t !! Time of collision @@ -212,27 +239,19 @@ end subroutine collision_generate_hitandrun module subroutine collision_generate_merge(self, nbody_system, param, t) implicit none - class(collision_merge), intent(inout) :: self !! Merge fragment nbody_system object + class(collision_basic), intent(inout) :: self !! Merge fragment nbody_system object class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(base_parameters), intent(inout) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! The time of the collision end subroutine collision_generate_merge - module subroutine collision_generate_bounce(self, nbody_system, param, t) - implicit none - class(collision_bounce), intent(inout) :: self !! Bounce fragment nbody_system object - class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object - class(base_parameters), intent(inout) :: param !! Current run configuration parameters - real(DP), intent(in) :: t !! The time of the collision - end subroutine collision_generate_bounce - - module subroutine collision_generate_simple_disruption(self, nbody_system, param, t) + module subroutine collision_generate_simple(self, nbody_system, param, t) implicit none class(collision_simple_disruption), intent(inout) :: self !! Simple fragment nbody_system object class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(base_parameters), intent(inout) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! The time of the collision - end subroutine collision_generate_simple_disruption + end subroutine collision_generate_simple module subroutine collision_generate_simple_pos_vec(collider, r_max_start) implicit none @@ -364,14 +383,14 @@ end subroutine collision_resolve_pltp module subroutine collision_util_add_fragments_to_collider(self, nbody_system, param) implicit none - class(collision_merge), intent(in) :: self !! Collision system object + class(collision_basic), intent(in) :: self !! Collision system object class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(base_parameters), intent(in) :: param !! Current swiftest run configuration parameters end subroutine collision_util_add_fragments_to_collider module subroutine collision_util_construct_temporary_system(self, nbody_system, param, tmpsys, tmpparam) implicit none - class(collision_merge), intent(inout) :: self !! Collision system object + class(collision_basic), intent(inout) :: self !! Collision system object class(base_nbody_system), intent(in) :: nbody_system !! Original swiftest nbody system object class(base_parameters), intent(in) :: param !! Current swiftest run configuration parameters class(base_nbody_system), allocatable, intent(out) :: tmpsys !! Output temporary swiftest nbody system object @@ -391,7 +410,7 @@ end subroutine collision_util_set_mass_dist module subroutine collision_util_set_coordinate_collider(self) implicit none - class(collision_merge), intent(inout) :: self !! collisional system + class(collision_basic), intent(inout) :: self !! collisional system end subroutine collision_util_set_coordinate_collider module subroutine collision_util_set_coordinate_impactors(self) @@ -401,18 +420,18 @@ end subroutine collision_util_set_coordinate_impactors module subroutine collision_util_setup_collider(self, nbody_system) implicit none - class(collision_merge), intent(inout) :: self !! Encounter collision system object + class(collision_basic), intent(inout) :: self !! Encounter collision system object class(base_nbody_system), intent(in) :: nbody_system !! Current nbody system. Used as a mold for the before/after snapshots end subroutine collision_util_setup_collider module subroutine collision_util_setup_impactors_collider(self) implicit none - class(collision_merge), intent(inout) :: self !! Encounter collision system object + class(collision_basic), intent(inout) :: self !! Encounter collision system object end subroutine collision_util_setup_impactors_collider module subroutine collision_util_setup_fragments_collider(self, nfrag) implicit none - class(collision_merge), intent(inout) :: self !! Encounter collision system object + class(collision_basic), intent(inout) :: self !! Encounter collision system object integer(I4B), intent(in) :: nfrag !! Number of fragments to create end subroutine collision_util_setup_fragments_collider @@ -431,7 +450,7 @@ end subroutine collision_util_get_idvalues_snapshot module subroutine collision_util_get_energy_momentum(self, nbody_system, param, lbefore) use base, only : base_nbody_system, base_parameters implicit none - class(collision_merge), intent(inout) :: self !! Encounter collision system object + class(collision_basic), intent(inout) :: self !! Encounter collision system object class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(base_parameters), intent(inout) :: param !! Current swiftest run configuration parameters logical, intent(in) :: lbefore !! Flag indicating that this the "before" state of the nbody_system, with impactors included and fragments excluded or vice versa @@ -449,7 +468,7 @@ end subroutine collision_util_reset_impactors module subroutine collision_util_reset_system(self) implicit none - class(collision_merge), intent(inout) :: self !! Collision system object + class(collision_basic), intent(inout) :: self !! Collision system object end subroutine collision_util_reset_system module subroutine collision_util_snapshot(self, param, nbody_system, t, arg) diff --git a/src/collision/collision_resolve.f90 b/src/collision/collision_resolve.f90 index af4e4583c..9e91b1ecd 100644 --- a/src/collision/collision_resolve.f90 +++ b/src/collision/collision_resolve.f90 @@ -327,7 +327,7 @@ module subroutine collision_resolve_mergeaddsub(nbody_system, param, t, status) select type(param) class is (swiftest_parameters) associate(pl => nbody_system%pl, pl_discards => nbody_system%pl_discards, info => nbody_system%pl%info, pl_adds => nbody_system%pl_adds, cb => nbody_system%cb, npl => pl%nbody, & - collision_merge => nbody_system%collider, impactors => nbody_system%collider%impactors,fragments => nbody_system%collider%fragments) + collision_basic => nbody_system%collider, impactors => nbody_system%collider%impactors,fragments => nbody_system%collider%fragments) ! Add the impactors%id bodies to the subtraction list nimpactors = impactors%ncoll @@ -437,7 +437,7 @@ module subroutine collision_resolve_mergeaddsub(nbody_system, param, t, status) end where ! Log the properties of the new bodies - select type(after => collision_merge%after) + select type(after => collision_basic%after) class is (swiftest_nbody_system) allocate(after%pl, source=plnew) end select diff --git a/src/collision/collision_util.f90 b/src/collision/collision_util.f90 index da68b42d6..d1cd1bf99 100644 --- a/src/collision/collision_util.f90 +++ b/src/collision/collision_util.f90 @@ -17,7 +17,7 @@ module subroutine collision_util_add_fragments_to_collider(self, nbody_system, p !! Adds fragments to the temporary system pl object implicit none ! Arguments - class(collision_merge), intent(in) :: self !! Collision system system object + class(collision_basic), intent(in) :: self !! Collision system system object class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(base_parameters), intent(in) :: param !! Current swiftest run configuration parameters ! Internals @@ -67,7 +67,7 @@ module subroutine collision_util_construct_temporary_system(self, nbody_system, !! Constructs a temporary internal system consisting of active bodies and additional fragments. This internal temporary system is used to calculate system energy with and without fragments implicit none ! Arguments - class(collision_merge), intent(inout) :: self !! Fraggle collision system object + class(collision_basic), intent(inout) :: self !! Fraggle collision system object class(base_nbody_system), intent(in) :: nbody_system !! Original swiftest nbody system object class(base_parameters), intent(in) :: param !! Current swiftest run configuration parameters class(base_nbody_system), allocatable, intent(out) :: tmpsys !! Output temporary swiftest nbody system object @@ -184,7 +184,7 @@ module subroutine collision_util_get_energy_momentum(self, nbody_system, param, !! This will temporarily expand the massive body object in a temporary system object called tmpsys to feed it into symba_energy implicit none ! Arguments - class(collision_merge), intent(inout) :: self !! Encounter collision system object + class(collision_basic), intent(inout) :: self !! Encounter collision system object class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(base_parameters), intent(inout) :: param !! Current swiftest run configuration parameters logical, intent(in) :: lbefore !! Flag indicating that this the "before" state of the nbody_system, with impactors included and fragments excluded or vice versa @@ -353,7 +353,7 @@ module subroutine collision_util_reset_system(self) !! Resets the collider nbody_system and deallocates all allocatables implicit none ! Arguments - class(collision_merge), intent(inout) :: self !! Collision system object + class(collision_basic), intent(inout) :: self !! Collision system object select type(before => self%before) class is (swiftest_nbody_system) @@ -387,7 +387,7 @@ module subroutine collision_util_set_coordinate_collider(self) !! Defines the collisional coordinate nbody_system, including the unit vectors of both the nbody_system and individual fragments. implicit none ! Arguments - class(collision_merge), intent(inout) :: self !! Collisional nbody_system + class(collision_basic), intent(inout) :: self !! Collisional nbody_system ! Internals integer(I4B) :: i real(DP), dimension(NDIM, self%fragments%nbody) :: L_sigma @@ -610,7 +610,7 @@ module subroutine collision_util_setup_collider(self, nbody_system) !! but not fragments. Those are setup later when the number of fragments is known. implicit none ! Arguments - class(collision_merge), intent(inout) :: self !! Encounter collision system object + class(collision_basic), intent(inout) :: self !! Encounter collision system object class(base_nbody_system), intent(in) :: nbody_system !! Current nbody system. Used as a mold for the before/after snapshots call self%setup_impactors() @@ -630,7 +630,7 @@ module subroutine collision_util_setup_impactors_collider(self) !! Initializer for the impactors for the encounter collision system. Deallocates old impactors before creating new ones implicit none ! Arguments - class(collision_merge), intent(inout) :: self !! Encounter collision system object + class(collision_basic), intent(inout) :: self !! Encounter collision system object if (allocated(self%impactors)) deallocate(self%impactors) allocate(collision_impactors :: self%impactors) @@ -645,7 +645,7 @@ module subroutine collision_util_setup_fragments_collider(self, nfrag) !! Initializer for the fragments of the collision system. implicit none ! Arguments - class(collision_merge), intent(inout) :: self !! Encounter collision system object + class(collision_basic), intent(inout) :: self !! Encounter collision system object integer(I4B), intent(in) :: nfrag !! Number of fragments to create if (allocated(self%fragments)) deallocate(self%fragments) diff --git a/src/fraggle/fraggle_generate.f90 b/src/fraggle/fraggle_generate.f90 index 4424b2412..3c48b71bf 100644 --- a/src/fraggle/fraggle_generate.f90 +++ b/src/fraggle/fraggle_generate.f90 @@ -18,207 +18,19 @@ contains - module subroutine fraggle_generate_disruption(collider, nbody_system, param, t) - !! author: Jennifer L.L. Pouplin, Carlisle A. Wishard, and David A. Minton - !! - !! Create the fragments resulting from a non-catastrophic disruption collision - !! - implicit none - ! Arguments - class(collision_fraggle), intent(inout) :: collider - class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions - real(DP), intent(in) :: t !! Time of collision - ! Internals - integer(I4B) :: i, ibiggest, nfrag - logical :: lfailure - character(len=STRMAX) :: message - real(DP) :: dpe - - associate(impactors => collider%impactors, fragments => collider%fragments, pl => nbody_system%pl, status => collider%status) - select case(impactors%regime) - case(COLLRESOLVE_REGIME_DISRUPTION) - message = "Disruption between" - case(COLLRESOLVE_REGIME_SUPERCATASTROPHIC) - message = "Supercatastrophic disruption between" - end select - call collision_io_collider_message(nbody_system%pl, impactors%id, message) - call swiftest_io_log_one_message(COLLISION_LOG_OUT, message) - - ! Collisional fragments will be uniformly distributed around the pre-impact barycenter - call collider%set_mass_dist(param) - - ! Generate the position and velocity distributions of the fragments - call fraggle_generate_fragments(collider, nbody_system, param, lfailure) - - dpe = collider%pe(2) - collider%pe(1) - nbody_system%Ecollisions = nbody_system%Ecollisions - dpe - nbody_system%Euntracked = nbody_system%Euntracked + dpe - - if (lfailure) then - call swiftest_io_log_one_message(COLLISION_LOG_OUT, "No fragment solution found, so treat as a pure hit-and-run") - status = ACTIVE - nfrag = 0 - pl%status(impactors%id(:)) = status - pl%ldiscard(impactors%id(:)) = .false. - pl%lcollision(impactors%id(:)) = .false. - select type(before => collider%before) - class is (swiftest_nbody_system) - select type(after => collider%after) - class is (swiftest_nbody_system) - allocate(after%pl, source=before%pl) ! Be sure to save the pl so that snapshots still work - end select - end select - else - ! Populate the list of new bodies - nfrag = fragments%nbody - write(message, *) nfrag - call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Generating " // trim(adjustl(message)) // " fragments") - select case(impactors%regime) - case(COLLRESOLVE_REGIME_DISRUPTION) - status = DISRUPTED - ibiggest = impactors%id(maxloc(pl%Gmass(impactors%id(:)), dim=1)) - fragments%id(1) = pl%id(ibiggest) - fragments%id(2:nfrag) = [(i, i = param%maxid + 1, param%maxid + nfrag - 1)] - param%maxid = fragments%id(nfrag) - case(COLLRESOLVE_REGIME_SUPERCATASTROPHIC) - status = SUPERCATASTROPHIC - fragments%id(1:nfrag) = [(i, i = param%maxid + 1, param%maxid + nfrag)] - param%maxid = fragments%id(nfrag) - end select - - call collision_resolve_mergeaddsub(nbody_system, param, t, status) - end if - end associate - - return - end subroutine fraggle_generate_disruption - - - module subroutine fraggle_generate_hitandrun(collider, nbody_system, param, t) - !! author: Jennifer L.L. Pouplin, Carlisle A. Wishard, and David A. Minton - !! - !! Create the fragments resulting from a non-catastrophic hit-and-run collision - !! - implicit none - ! Arguments - class(collision_fraggle), intent(inout) :: collider !! Fraggle collision system object - class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions - real(DP), intent(in) :: t !! Time of collision - ! Result - integer(I4B) :: status !! Status flag assigned to this outcome - ! Internals - integer(I4B) :: i, ibiggest, nfrag, jtarg, jproj - logical :: lpure - character(len=STRMAX) :: message - real(DP) :: dpe - - select type(before => collider%before) - class is (swiftest_nbody_system) - select type(after => collider%after) - class is (swiftest_nbody_system) - associate(impactors => collider%impactors,pl => nbody_system%pl) - message = "Hit and run between" - call collision_io_collider_message(nbody_system%pl, impactors%id, message) - call swiftest_io_log_one_message(COLLISION_LOG_OUT, trim(adjustl(message))) - - if (impactors%mass(1) > impactors%mass(2)) then - jtarg = 1 - jproj = 2 - else - jtarg = 2 - jproj = 1 - end if - - if (impactors%mass_dist(2) > 0.9_DP * impactors%mass(jproj)) then ! Pure hit and run, so we'll just keep the two bodies untouched - call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Pure hit and run. No new fragments generated.") - nfrag = 0 - lpure = .true. - else ! Imperfect hit and run, so we'll keep the largest body and destroy the other - lpure = .false. - call collider%set_mass_dist(param) - - ! Generate the position and velocity distributions of the fragments - call fraggle_generate_fragments(collider, nbody_system, param, lpure) - - dpe = collider%pe(2) - collider%pe(1) - nbody_system%Ecollisions = nbody_system%Ecollisions - dpe - nbody_system%Euntracked = nbody_system%Euntracked + dpe - - if (lpure) then - call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Should have been a pure hit and run instead") - nfrag = 0 - else - nfrag = collider%fragments%nbody - write(message, *) nfrag - call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Generating " // trim(adjustl(message)) // " fragments") - end if - end if - if (lpure) then ! Reset these bodies back to being active so that nothing further is done to them - status = HIT_AND_RUN_PURE - pl%status(impactors%id(:)) = ACTIVE - pl%ldiscard(impactors%id(:)) = .false. - pl%lcollision(impactors%id(:)) = .false. - allocate(after%pl, source=before%pl) ! Be sure to save the pl so that snapshots still work - else - ibiggest = impactors%id(maxloc(pl%Gmass(impactors%id(:)), dim=1)) - collider%fragments%id(1) = pl%id(ibiggest) - collider%fragments%id(2:nfrag) = [(i, i = param%maxid + 1, param%maxid + nfrag - 1)] - param%maxid = collider%fragments%id(nfrag) - status = HIT_AND_RUN_DISRUPT - call collision_resolve_mergeaddsub(nbody_system, param, t, status) - end if - end associate - end select - end select - - - return - end subroutine fraggle_generate_hitandrun - - - module subroutine fraggle_generate_system(self, nbody_system, param, t) - implicit none - class(collision_fraggle), intent(inout) :: self !! Fraggle fragment nbody_system object - class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object - class(base_parameters), intent(inout) :: param !! Current run configuration parameters - real(DP), intent(in) :: t !! The time of the collision - - select type(nbody_system) - class is (swiftest_nbody_system) - select type(param) - class is (swiftest_parameters) - select case (self%impactors%regime) - case (COLLRESOLVE_REGIME_DISRUPTION, COLLRESOLVE_REGIME_SUPERCATASTROPHIC) - call fraggle_generate_disruption(self, nbody_system, param, t) - case (COLLRESOLVE_REGIME_HIT_AND_RUN) - call fraggle_generate_hitandrun(self, nbody_system, param, t) - case (COLLRESOLVE_REGIME_MERGE, COLLRESOLVE_REGIME_GRAZE_AND_MERGE) - call self%collision_merge%generate(nbody_system, param, t) - case default - write(*,*) "Error in swiftest_collision, unrecognized collision regime" - call util_exit(FAILURE) - end select - end select - end select - - return - end subroutine fraggle_generate_system - - - module subroutine fraggle_generate_fragments(collider, nbody_system, param, lfailure) + module subroutine fraggle_generate_disrupt(self, nbody_system, param, t, lfailure) !! Author: Jennifer L.L. Pouplin, Carlisle A. Wishard, and David A. Minton !! !! Generates a nbody_system of fragments in barycentric coordinates that conserves energy and momentum. use, intrinsic :: ieee_exceptions implicit none ! Arguments - class(collision_fraggle), intent(inout) :: collider !! Fraggle nbody_system object the outputs will be the fragmentation - class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - logical, intent(out) :: lfailure !! Answers the question: Should this have been a merger instead? - ! Internals + class(collision_fraggle), intent(inout) :: self !! Fraggle system object the outputs will be the fragmentation + class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object + class(base_parameters), intent(inout) :: param !! Current run configuration parameters + real(DP), intent(in) :: t !! Time of collision + logical, optional, intent(out) :: lfailure !! Answers the question: Should this have been a merger instead? + ! Internals integer(I4B) :: i integer(I4B) :: try real(DP) :: r_max_start, f_spin, dEtot, dLmag @@ -238,9 +50,9 @@ module subroutine fraggle_generate_fragments(collider, nbody_system, param, lfai class is (swiftest_nbody_system) select type(param) class is (swiftest_parameters) - select type(fragments => collider%fragments) + select type(fragments => self%fragments) class is (fraggle_fragments(*)) - associate(impactors => collider%impactors, nfrag => fragments%nbody, pl => nbody_system%pl) + associate(impactors => self%impactors, nfrag => fragments%nbody, pl => nbody_system%pl) write(message,*) nfrag call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Fraggle generating " // trim(adjustl(message)) // " fragments.") @@ -258,12 +70,12 @@ module subroutine fraggle_generate_fragments(collider, nbody_system, param, lfai lk_plpl = .false. end if - call collider%set_natural_scale() + call self%set_natural_scale() call fragments%reset() ! Calculate the initial energy of the nbody_system without the collisional family - call collider%get_energy_and_momentum(nbody_system, param, lbefore=.true.) + call self%get_energy_and_momentum(nbody_system, param, lbefore=.true.) ! Start out the fragments close to the initial separation distance. This will be increased if there is any overlap or we fail to find a solution r_max_start = 1.1_DP * .mag.(impactors%rb(:,2) - impactors%rb(:,1)) @@ -282,40 +94,40 @@ module subroutine fraggle_generate_fragments(collider, nbody_system, param, lfai lfailure = .false. call ieee_set_flag(ieee_all, .false.) ! Set all fpe flags to quiet - call collision_generate_simple_pos_vec(collider, r_max_start) - call collider%set_coordinate_system() + call collision_generate_simple_pos_vec(self, r_max_start) + call self%set_coordinate_system() ! Initial velocity guess will be the barycentric velocity of the colliding nbody_system so that the budgets are based on the much smaller collisional-frame velocities do concurrent (i = 1:nfrag) fragments%vb(:, i) = impactors%vbcom(:) end do - call collider%get_energy_and_momentum(nbody_system, param, lbefore=.false.) - call collider%set_budgets() + call self%get_energy_and_momentum(nbody_system, param, lbefore=.false.) + call self%set_budgets() - call collision_generate_simple_vel_vec(collider) + call collision_generate_simple_vel_vec(self) - call fraggle_generate_tan_vel(collider, lfailure) + call fraggle_generate_tan_vel(self, lfailure) if (lfailure) then call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Fraggle failed to find tangential velocities") cycle end if - call fraggle_generate_rad_vel(collider, lfailure) + call fraggle_generate_rad_vel(self, lfailure) if (lfailure) then call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Fraggle failed to find radial velocities") cycle end if - call fraggle_generate_spins(collider, f_spin, lfailure) + call fraggle_generate_spins(self, f_spin, lfailure) if (lfailure) then call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Fraggle failed to find spins") cycle end if - call collider%get_energy_and_momentum(nbody_system, param, lbefore=.false.) - dEtot = collider%Etot(2) - collider%Etot(1) - dLmag = .mag. (collider%Ltot(:,2) - collider%Ltot(:,1)) + call self%get_energy_and_momentum(nbody_system, param, lbefore=.false.) + dEtot = self%Etot(2) - self%Etot(1) + dLmag = .mag. (self%Ltot(:,2) - self%Ltot(:,1)) exit lfailure = ((abs(dEtot + impactors%Qloss) > FRAGGLE_ETOL) .or. (dEtot > 0.0_DP)) @@ -326,9 +138,9 @@ module subroutine fraggle_generate_fragments(collider, nbody_system, param, lfai cycle end if - lfailure = ((abs(dLmag) / (.mag.collider%Ltot(:,1))) > FRAGGLE_LTOL) + lfailure = ((abs(dLmag) / (.mag.self%Ltot(:,1))) > FRAGGLE_LTOL) if (lfailure) then - write(message,*) dLmag / (.mag.collider%Ltot(:,1)) + write(message,*) dLmag / (.mag.self%Ltot(:,1)) call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Fraggle failed due to high angular momentum error: " // & trim(adjustl(message))) cycle @@ -351,7 +163,7 @@ module subroutine fraggle_generate_fragments(collider, nbody_system, param, lfai trim(adjustl(message)) // " tries") end if - call collider%set_original_scale() + call self%set_original_scale() ! Restore the big array if (lk_plpl) call pl%flatten(param) @@ -362,7 +174,8 @@ module subroutine fraggle_generate_fragments(collider, nbody_system, param, lfai call ieee_set_halting_mode(IEEE_ALL,fpe_halting_modes) ! Save the current halting modes so we can turn them off temporarily return - end subroutine fraggle_generate_fragments + end subroutine fraggle_generate_disrupt + subroutine fraggle_generate_spins(collider, f_spin, lfailure) !! Author: Jennifer L.L. Pouplin, Carlisle A. Wishard, and David A. Minton @@ -373,8 +186,8 @@ subroutine fraggle_generate_spins(collider, f_spin, lfailure) implicit none ! Arguments class(collision_fraggle), intent(inout) :: collider !! Fraggle collision system object - real(DP), intent(in) :: f_spin !! Fraction of energy or momentum that goes into spin (whichever gives the lowest kinetic energy) - logical, intent(out) :: lfailure !! Logical flag indicating whether this step fails or succeeds! + real(DP), intent(in) :: f_spin !! Fraction of energy or momentum that goes into spin (whichever gives the lowest kinetic energy) + logical, intent(out) :: lfailure !! Logical flag indicating whether this step fails or succeeds! ! Internals real(DP), dimension(NDIM) :: L_remainder, rot_L, rot_ke, L real(DP), dimension(NDIM,collider%fragments%nbody) :: frot_rand ! The random rotation factor applied to fragments diff --git a/src/fraggle/fraggle_module.f90 b/src/fraggle/fraggle_module.f90 index 7e364dc6f..fe0eaf8a3 100644 --- a/src/fraggle/fraggle_module.f90 +++ b/src/fraggle/fraggle_module.f90 @@ -43,11 +43,11 @@ module fraggle real(DP) :: Escale = 1.0_DP !! Energy scale factor (a convenience unit that is derived from dscale, tscale, and mscale) real(DP) :: Lscale = 1.0_DP !! Angular momentum scale factor (a convenience unit that is derived from dscale, tscale, and mscale) contains - procedure :: generate => fraggle_generate_system !! Generates a system of fragments in barycentric coordinates that conserves energy and momentum. - procedure :: set_budgets => fraggle_util_set_budgets !! Sets the energy and momentum budgets of the fragments based on the collider value - procedure :: set_natural_scale => fraggle_util_set_natural_scale_factors !! Scales dimenional quantities to ~O(1) with respect to the collisional system. - procedure :: set_original_scale => fraggle_util_set_original_scale_factors !! Restores dimenional quantities back to the original system units - procedure :: setup_fragments => fraggle_util_setup_fragments_system !! Initializer for the fragments of the collision system. + procedure :: disrupt => fraggle_generate_disrupt !! Generates a system of fragments in barycentric coordinates that conserves energy and momentum. + procedure :: set_budgets => fraggle_util_set_budgets !! Sets the energy and momentum budgets of the fragments based on the collider value + procedure :: set_natural_scale => fraggle_util_set_natural_scale_factors !! Scales dimenional quantities to ~O(1) with respect to the collisional system. + procedure :: set_original_scale => fraggle_util_set_original_scale_factors !! Restores dimenional quantities back to the original system units + procedure :: setup_fragments => fraggle_util_setup_fragments_system !! Initializer for the fragments of the collision system. procedure :: construct_temporary_system => fraggle_util_construct_temporary_system !! Constructs temporary n-body system in order to compute pre- and post-impact energy and momentum procedure :: reset => fraggle_util_reset_system !! Deallocates all allocatables final :: fraggle_final_system !! Finalizer will deallocate all allocatables @@ -55,39 +55,14 @@ module fraggle interface - - - module subroutine fraggle_generate_disruption(collider, nbody_system, param, t) - implicit none - class(collision_fraggle), intent(inout) :: collider !! Fraggle collision system object - class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions - real(DP), intent(in) :: t !! Time of collision - end subroutine fraggle_generate_disruption - - module subroutine fraggle_generate_fragments(collider, nbody_system, param, lfailure) - implicit none - class(collision_fraggle), intent(inout) :: collider !! Fraggle system object the outputs will be the fragmentation - class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - logical, intent(out) :: lfailure !! Answers the question: Should this have been a merger instead? - end subroutine fraggle_generate_fragments - - module subroutine fraggle_generate_hitandrun(collider, nbody_system, param, t) - implicit none - class(collision_fraggle), intent(inout) :: collider !! Fraggle collision system object - class(swiftest_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object - class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions - real(DP), intent(in) :: t !! Time of collision - end subroutine fraggle_generate_hitandrun - - module subroutine fraggle_generate_system(self, nbody_system, param, t) + module subroutine fraggle_generate_disrupt(self, nbody_system, param, t, lfailure) implicit none - class(collision_fraggle), intent(inout) :: self !! Fraggle fragment system object + class(collision_fraggle), intent(inout) :: self !! Fraggle system object the outputs will be the fragmentation class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(base_parameters), intent(inout) :: param !! Current run configuration parameters - real(DP), intent(in) :: t !! Time of collision - end subroutine fraggle_generate_system + real(DP), intent(in) :: t !! Time of collision + logical, optional, intent(out) :: lfailure !! Answers the question: Should this have been a merger instead? + end subroutine fraggle_generate_disrupt module subroutine fraggle_util_setup_fragments_system(self, nfrag) implicit none diff --git a/src/fraggle/fraggle_util.f90 b/src/fraggle/fraggle_util.f90 index 928e3655e..2e2e55961 100644 --- a/src/fraggle/fraggle_util.f90 +++ b/src/fraggle/fraggle_util.f90 @@ -197,36 +197,36 @@ module subroutine fraggle_util_set_natural_scale_factors(self) ! Internals integer(I4B) :: i - associate(collision_merge => self, fragments => self%fragments, impactors => self%impactors) + associate(collider => self, fragments => self%fragments, impactors => self%impactors) ! Set scale factors - collision_merge%Escale = 0.5_DP * ( impactors%mass(1) * dot_product(impactors%vb(:,1), impactors%vb(:,1)) & + collider%Escale = 0.5_DP * ( impactors%mass(1) * dot_product(impactors%vb(:,1), impactors%vb(:,1)) & + impactors%mass(2) * dot_product(impactors%vb(:,2), impactors%vb(:,2))) - collision_merge%dscale = sum(impactors%radius(:)) - collision_merge%mscale = fragments%mtot - collision_merge%vscale = sqrt(collision_merge%Escale / collision_merge%mscale) - collision_merge%tscale = collision_merge%dscale / collision_merge%vscale - collision_merge%Lscale = collision_merge%mscale * collision_merge%dscale * collision_merge%vscale + collider%dscale = sum(impactors%radius(:)) + collider%mscale = fragments%mtot + collider%vscale = sqrt(collider%Escale / collider%mscale) + collider%tscale = collider%dscale / collider%vscale + collider%Lscale = collider%mscale * collider%dscale * collider%vscale ! Scale all dimensioned quantities of impactors and fragments - impactors%rbcom(:) = impactors%rbcom(:) / collision_merge%dscale - impactors%vbcom(:) = impactors%vbcom(:) / collision_merge%vscale - impactors%rbimp(:) = impactors%rbimp(:) / collision_merge%dscale - impactors%vbimp(:) = impactors%vbimp(:) / collision_merge%vscale - impactors%rb(:,:) = impactors%rb(:,:) / collision_merge%dscale - impactors%vb(:,:) = impactors%vb(:,:) / collision_merge%vscale - impactors%mass(:) = impactors%mass(:) / collision_merge%mscale - impactors%radius(:) = impactors%radius(:) / collision_merge%dscale - impactors%Lspin(:,:) = impactors%Lspin(:,:) / collision_merge%Lscale - impactors%Lorbit(:,:) = impactors%Lorbit(:,:) / collision_merge%Lscale + impactors%rbcom(:) = impactors%rbcom(:) / collider%dscale + impactors%vbcom(:) = impactors%vbcom(:) / collider%vscale + impactors%rbimp(:) = impactors%rbimp(:) / collider%dscale + impactors%vbimp(:) = impactors%vbimp(:) / collider%vscale + impactors%rb(:,:) = impactors%rb(:,:) / collider%dscale + impactors%vb(:,:) = impactors%vb(:,:) / collider%vscale + impactors%mass(:) = impactors%mass(:) / collider%mscale + impactors%radius(:) = impactors%radius(:) / collider%dscale + impactors%Lspin(:,:) = impactors%Lspin(:,:) / collider%Lscale + impactors%Lorbit(:,:) = impactors%Lorbit(:,:) / collider%Lscale do i = 1, 2 impactors%rot(:,i) = impactors%Lspin(:,i) / (impactors%mass(i) * impactors%radius(i)**2 * impactors%Ip(3, i)) end do - fragments%mtot = fragments%mtot / collision_merge%mscale - fragments%mass = fragments%mass / collision_merge%mscale - fragments%radius = fragments%radius / collision_merge%dscale - impactors%Qloss = impactors%Qloss / collision_merge%Escale + fragments%mtot = fragments%mtot / collider%mscale + fragments%mass = fragments%mass / collider%mscale + fragments%radius = fragments%radius / collider%dscale + impactors%Qloss = impactors%Qloss / collider%Escale end associate return @@ -248,51 +248,51 @@ module subroutine fraggle_util_set_original_scale_factors(self) call ieee_get_halting_mode(IEEE_ALL,fpe_halting_modes) ! Save the current halting modes so we can turn them off temporarily call ieee_set_halting_mode(IEEE_ALL,.false.) - associate(collision_merge => self, fragments => self%fragments, impactors => self%impactors) + associate(collider => self, fragments => self%fragments, impactors => self%impactors) ! Restore scale factors - impactors%rbcom(:) = impactors%rbcom(:) * collision_merge%dscale - impactors%vbcom(:) = impactors%vbcom(:) * collision_merge%vscale - impactors%rbimp(:) = impactors%rbimp(:) * collision_merge%dscale - impactors%vbimp(:) = impactors%vbimp(:) * collision_merge%vscale + impactors%rbcom(:) = impactors%rbcom(:) * collider%dscale + impactors%vbcom(:) = impactors%vbcom(:) * collider%vscale + impactors%rbimp(:) = impactors%rbimp(:) * collider%dscale + impactors%vbimp(:) = impactors%vbimp(:) * collider%vscale - impactors%mass = impactors%mass * collision_merge%mscale - impactors%radius = impactors%radius * collision_merge%dscale - impactors%rb = impactors%rb * collision_merge%dscale - impactors%vb = impactors%vb * collision_merge%vscale - impactors%Lspin = impactors%Lspin * collision_merge%Lscale + impactors%mass = impactors%mass * collider%mscale + impactors%radius = impactors%radius * collider%dscale + impactors%rb = impactors%rb * collider%dscale + impactors%vb = impactors%vb * collider%vscale + impactors%Lspin = impactors%Lspin * collider%Lscale do i = 1, 2 impactors%rot(:,i) = impactors%Lspin(:,i) * (impactors%mass(i) * impactors%radius(i)**2 * impactors%Ip(3, i)) end do - fragments%mtot = fragments%mtot * collision_merge%mscale - fragments%mass = fragments%mass * collision_merge%mscale - fragments%radius = fragments%radius * collision_merge%dscale - fragments%rot = fragments%rot / collision_merge%tscale - fragments%rc = fragments%rc * collision_merge%dscale - fragments%vc = fragments%vc * collision_merge%vscale + fragments%mtot = fragments%mtot * collider%mscale + fragments%mass = fragments%mass * collider%mscale + fragments%radius = fragments%radius * collider%dscale + fragments%rot = fragments%rot / collider%tscale + fragments%rc = fragments%rc * collider%dscale + fragments%vc = fragments%vc * collider%vscale do i = 1, fragments%nbody fragments%rb(:, i) = fragments%rc(:, i) + impactors%rbcom(:) fragments%vb(:, i) = fragments%vc(:, i) + impactors%vbcom(:) end do - impactors%Qloss = impactors%Qloss * collision_merge%Escale + impactors%Qloss = impactors%Qloss * collider%Escale - collision_merge%Lorbit(:,:) = collision_merge%Lorbit(:,:) * collision_merge%Lscale - collision_merge%Lspin(:,:) = collision_merge%Lspin(:,:) * collision_merge%Lscale - collision_merge%Ltot(:,:) = collision_merge%Ltot(:,:) * collision_merge%Lscale - collision_merge%ke_orbit(:) = collision_merge%ke_orbit(:) * collision_merge%Escale - collision_merge%ke_spin(:) = collision_merge%ke_spin(:) * collision_merge%Escale - collision_merge%pe(:) = collision_merge%pe(:) * collision_merge%Escale - collision_merge%Etot(:) = collision_merge%Etot(:) * collision_merge%Escale + collider%Lorbit(:,:) = collider%Lorbit(:,:) * collider%Lscale + collider%Lspin(:,:) = collider%Lspin(:,:) * collider%Lscale + collider%Ltot(:,:) = collider%Ltot(:,:) * collider%Lscale + collider%ke_orbit(:) = collider%ke_orbit(:) * collider%Escale + collider%ke_spin(:) = collider%ke_spin(:) * collider%Escale + collider%pe(:) = collider%pe(:) * collider%Escale + collider%Etot(:) = collider%Etot(:) * collider%Escale - collision_merge%mscale = 1.0_DP - collision_merge%dscale = 1.0_DP - collision_merge%vscale = 1.0_DP - collision_merge%tscale = 1.0_DP - collision_merge%Lscale = 1.0_DP - collision_merge%Escale = 1.0_DP + collider%mscale = 1.0_DP + collider%dscale = 1.0_DP + collider%vscale = 1.0_DP + collider%tscale = 1.0_DP + collider%Lscale = 1.0_DP + collider%Escale = 1.0_DP end associate call ieee_set_halting_mode(IEEE_ALL,fpe_halting_modes) diff --git a/src/swiftest/swiftest_module.f90 b/src/swiftest/swiftest_module.f90 index 82e233bb3..d4f88412b 100644 --- a/src/swiftest/swiftest_module.f90 +++ b/src/swiftest/swiftest_module.f90 @@ -322,7 +322,7 @@ module swiftest class(encounter_list), allocatable :: plpl_encounter !! List of massive body-massive body encounters in a single step class(collision_list_plpl), allocatable :: plpl_collision !! List of massive body-massive body collisions in a single step class(collision_list_plpl), allocatable :: pltp_collision !! List of massive body-massive body collisions in a single step - class(collision_merge), allocatable :: collider !! Collision system object + class(collision_basic), allocatable :: collider !! Collision system object class(encounter_storage(nframes=:)), allocatable :: encounter_history !! Stores encounter history for later retrieval and saving to file class(collision_storage(nframes=:)), allocatable :: collision_history !! Stores encounter history for later retrieval and saving to file diff --git a/src/swiftest/swiftest_util.f90 b/src/swiftest/swiftest_util.f90 index 32a137c50..eae7556e0 100644 --- a/src/swiftest/swiftest_util.f90 +++ b/src/swiftest/swiftest_util.f90 @@ -2653,7 +2653,7 @@ module subroutine swiftest_util_setup_construct_system(nbody_system, param) select case(param%collision_model) case("MERGE") - allocate(collision_merge :: nbody_system%collider) + allocate(collision_basic :: nbody_system%collider) case("BOUNCE") allocate(collision_bounce :: nbody_system%collider) case("SIMPLE") From 230ef683d2d6f899127f1f1526d8b7472e9fe235 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Fri, 23 Dec 2022 16:10:22 -0500 Subject: [PATCH 518/569] cleanup --- src/encounter/encounter_check.f90 | 70 +++++++++++++++--------------- src/encounter/encounter_module.f90 | 10 ++--- src/swiftest/swiftest_kick.f90 | 12 ++--- src/swiftest/swiftest_module.f90 | 4 +- 4 files changed, 48 insertions(+), 48 deletions(-) diff --git a/src/encounter/encounter_check.f90 b/src/encounter/encounter_check.f90 index 276024b3f..330f3320b 100644 --- a/src/encounter/encounter_check.f90 +++ b/src/encounter/encounter_check.f90 @@ -71,7 +71,7 @@ module subroutine encounter_check_all_plpl(param, npl, x, v, renc, dt, nenc, ind end subroutine encounter_check_all_plpl - module subroutine encounter_check_all_plplm(param, nplm, nplt, xplm, vplm, xplt, vplt, rencm, renct, dt, nenc, index1, index2, lvdotr) + module subroutine encounter_check_all_plplm(param, nplm, nplt, rplm, vplm, rplt, vplt, rencm, renct, dt, nenc, index1, index2, lvdotr) !! author: David A. Minton !! !! Check for encounters between fully interacting massive bodies partially interacting massive bodies. Choose between the standard triangular or the Sort & Sweep method based on user inputs @@ -81,9 +81,9 @@ module subroutine encounter_check_all_plplm(param, nplm, nplt, xplm, vplm, xplt, class(base_parameters), intent(inout) :: param !! Current Swiftest run configuration parameter5s integer(I4B), intent(in) :: nplm !! Total number of fully interacting massive bodies integer(I4B), intent(in) :: nplt !! Total number of partially interacting masive bodies (GM < GMTINY) - real(DP), dimension(:,:), intent(in) :: xplm !! Position vectors of fully interacting massive bodies + real(DP), dimension(:,:), intent(in) :: rplm !! Position vectors of fully interacting massive bodies real(DP), dimension(:,:), intent(in) :: vplm !! Velocity vectors of fully interacting massive bodies - real(DP), dimension(:,:), intent(in) :: xplt !! Position vectors of partially interacting massive bodies + real(DP), dimension(:,:), intent(in) :: rplt !! Position vectors of partially interacting massive bodies real(DP), dimension(:,:), intent(in) :: vplt !! Velocity vectors of partially interacting massive bodies real(DP), dimension(:), intent(in) :: rencm !! Critical radii of fully interacting massive bodies that defines an encounter real(DP), dimension(:), intent(in) :: renct !! Critical radii of partially interacting massive bodies that defines an encounter @@ -134,13 +134,13 @@ module subroutine encounter_check_all_plplm(param, nplm, nplt, xplm, vplm, xplt, tmp_param%ladaptive_encounters_plpl = .false. ! Start with the pl-pl group - call encounter_check_all_plpl(tmp_param, nplm, xplm, vplm, rencm, dt, nenc, index1, index2, lvdotr) + call encounter_check_all_plpl(tmp_param, nplm, rplm, vplm, rencm, dt, nenc, index1, index2, lvdotr) ! if (param%lencounter_sas_plpl) then - ! call encounter_check_all_sort_and_sweep_plplm(nplm, nplt, xplm, vplm, xplt, vplt, rencm, renct, dt, & + ! call encounter_check_all_sort_and_sweep_plplm(nplm, nplt, rplm, vplm, rplt, vplt, rencm, renct, dt, & ! plmplt_nenc, plmplt_index1, plmplt_index2, plmplt_lvdotr) ! else - call encounter_check_all_triangular_plplm(nplm, nplt, xplm, vplm, xplt, vplt, rencm, renct, dt, plmplt_nenc, plmplt_index1, plmplt_index2, plmplt_lvdotr) + call encounter_check_all_triangular_plplm(nplm, nplt, rplm, vplm, rplt, vplt, rencm, renct, dt, plmplt_nenc, plmplt_index1, plmplt_index2, plmplt_lvdotr) ! end if ! if (skipit) then @@ -180,7 +180,7 @@ module subroutine encounter_check_all_plplm(param, nplm, nplt, xplm, vplm, xplt, end subroutine encounter_check_all_plplm - module subroutine encounter_check_all_pltp(param, npl, ntp, xpl, vpl, xtp, vtp, renc, dt, nenc, index1, index2, lvdotr) + module subroutine encounter_check_all_pltp(param, npl, ntp, rpl, vpl, xtp, vtp, renc, dt, nenc, index1, index2, lvdotr) !! author: David A. Minton !! !! Check for encounters between massive bodies and test particles. Choose between the standard triangular or the Sort & Sweep method based on user inputs @@ -190,7 +190,7 @@ module subroutine encounter_check_all_pltp(param, npl, ntp, xpl, vpl, xtp, vtp, class(base_parameters), intent(inout) :: param !! Current Swiftest run configuration parameter5s integer(I4B), intent(in) :: npl !! Total number of massive bodies integer(I4B), intent(in) :: ntp !! Total number of test particles - real(DP), dimension(:,:), intent(in) :: xpl !! Position vectors of massive bodies + real(DP), dimension(:,:), intent(in) :: rpl !! Position vectors of massive bodies real(DP), dimension(:,:), intent(in) :: vpl !! Velocity vectors of massive bodies real(DP), dimension(:,:), intent(in) :: xtp !! Position vectors of test particlse real(DP), dimension(:,:), intent(in) :: vtp !! Velocity vectors of test particles @@ -229,9 +229,9 @@ module subroutine encounter_check_all_pltp(param, npl, ntp, xpl, vpl, xtp, vtp, ! end if ! if (param%lencounter_sas_pltp) then - ! call encounter_check_all_sort_and_sweep_pltp(npl, ntp, xpl, vpl, xtp, vtp, renc, dt, nenc, index1, index2, lvdotr) + ! call encounter_check_all_sort_and_sweep_pltp(npl, ntp, rpl, vpl, xtp, vtp, renc, dt, nenc, index1, index2, lvdotr) ! else - call encounter_check_all_triangular_pltp(npl, ntp, xpl, vpl, xtp, vtp, renc, dt, nenc, index1, index2, lvdotr) + call encounter_check_all_triangular_pltp(npl, ntp, rpl, vpl, xtp, vtp, renc, dt, nenc, index1, index2, lvdotr) ! end if ! if (.not.lfirst .and. param%ladaptive_encounters_pltp .and. npltp > 0) then @@ -297,7 +297,7 @@ subroutine encounter_check_all_sort_and_sweep_plpl(npl, x, v, renc, dt, nenc, in end subroutine encounter_check_all_sort_and_sweep_plpl - subroutine encounter_check_all_sort_and_sweep_plplm(nplm, nplt, xplm, vplm, xplt, vplt, rencm, renct, dt, nenc, index1, index2, lvdotr) + subroutine encounter_check_all_sort_and_sweep_plplm(nplm, nplt, rplm, vplm, rplt, vplt, rencm, renct, dt, nenc, index1, index2, lvdotr) !! author: David A. Minton !! !! Check for encounters between massive bodies and test particles. @@ -308,9 +308,9 @@ subroutine encounter_check_all_sort_and_sweep_plplm(nplm, nplt, xplm, vplm, xplt ! Arguments integer(I4B), intent(in) :: nplm !! Total number of fully interacting massive bodies integer(I4B), intent(in) :: nplt !! Total number of partially interacting masive bodies (GM < GMTINY) - real(DP), dimension(:,:), intent(in) :: xplm !! Position vectors of fully interacting massive bodies + real(DP), dimension(:,:), intent(in) :: rplm !! Position vectors of fully interacting massive bodies real(DP), dimension(:,:), intent(in) :: vplm !! Velocity vectors of fully interacting massive bodies - real(DP), dimension(:,:), intent(in) :: xplt !! Position vectors of partially interacting massive bodies + real(DP), dimension(:,:), intent(in) :: rplt !! Position vectors of partially interacting massive bodies real(DP), dimension(:,:), intent(in) :: vplt !! Velocity vectors of partially interacting massive bodies real(DP), dimension(:), intent(in) :: rencm !! Critical radii of fully interacting massive bodies that defines an encounter real(DP), dimension(:), intent(in) :: renct !! Critical radii of partially interacting massive bodies that defines an encounter @@ -337,7 +337,7 @@ subroutine encounter_check_all_sort_and_sweep_plplm(nplm, nplt, xplm, vplm, xplt end if !$omp parallel do default(private) schedule(static) & - !$omp shared(xplm, xplt, vplm, vplt, rencm, renct, boundingbox) & + !$omp shared(rplm, rplt, vplm, vplt, rencm, renct, boundingbox) & !$omp firstprivate(dt, nplm, nplt, ntot) do dim = 1, SWEEPDIM where(vplm(dim,1:nplm) < 0.0_DP) @@ -356,20 +356,20 @@ subroutine encounter_check_all_sort_and_sweep_plplm(nplm, nplt, xplm, vplm, xplt vpltshift_max(1:nplt) = 1 end where - call boundingbox%aabb(dim)%sort(ntot, [xplm(dim,1:nplm) - rencm(1:nplm) + vplmshift_min(1:nplm) * vplm(dim,1:nplm) * dt, & - xplt(dim,1:nplt) - renct(1:nplt) + vpltshift_min(1:nplt) * vplt(dim,1:nplt) * dt, & - xplm(dim,1:nplm) + rencm(1:nplm) + vplmshift_max(1:nplm) * vplm(dim,1:nplm) * dt, & - xplt(dim,1:nplt) + renct(1:nplt) + vpltshift_max(1:nplt) * vplt(dim,1:nplt) * dt]) + call boundingbox%aabb(dim)%sort(ntot, [rplm(dim,1:nplm) - rencm(1:nplm) + vplmshift_min(1:nplm) * vplm(dim,1:nplm) * dt, & + rplt(dim,1:nplt) - renct(1:nplt) + vpltshift_min(1:nplt) * vplt(dim,1:nplt) * dt, & + rplm(dim,1:nplm) + rencm(1:nplm) + vplmshift_max(1:nplm) * vplm(dim,1:nplm) * dt, & + rplt(dim,1:nplt) + renct(1:nplt) + vpltshift_max(1:nplt) * vplt(dim,1:nplt) * dt]) end do !$omp end parallel do - call boundingbox%sweep(nplm, nplt, xplm, vplm, xplt, vplt, rencm, renct, dt, nenc, index1, index2, lvdotr) + call boundingbox%sweep(nplm, nplt, rplm, vplm, rplt, vplt, rencm, renct, dt, nenc, index1, index2, lvdotr) return end subroutine encounter_check_all_sort_and_sweep_plplm - subroutine encounter_check_all_sort_and_sweep_pltp(npl, ntp, xpl, vpl, xtp, vtp, rencpl, dt, nenc, index1, index2, lvdotr) + subroutine encounter_check_all_sort_and_sweep_pltp(npl, ntp, rpl, vpl, xtp, vtp, rencpl, dt, nenc, index1, index2, lvdotr) !! author: David A. Minton !! !! Check for encounters between massive bodies and test particles. @@ -380,7 +380,7 @@ subroutine encounter_check_all_sort_and_sweep_pltp(npl, ntp, xpl, vpl, xtp, vtp, ! Arguments integer(I4B), intent(in) :: npl !! Total number of massive bodies integer(I4B), intent(in) :: ntp !! Total number of test particles - real(DP), dimension(:,:), intent(in) :: xpl !! Position vectors of massive bodies + real(DP), dimension(:,:), intent(in) :: rpl !! Position vectors of massive bodies real(DP), dimension(:,:), intent(in) :: vpl !! Velocity vectors of massive bodies real(DP), dimension(:,:), intent(in) :: xtp !! Position vectors of massive bodies real(DP), dimension(:,:), intent(in) :: vtp !! Velocity vectors of massive bodies @@ -411,7 +411,7 @@ subroutine encounter_check_all_sort_and_sweep_pltp(npl, ntp, xpl, vpl, xtp, vtp, renctp(:) = 0.0_DP !$omp parallel do default(private) schedule(static) & - !$omp shared(xpl, xtp, vpl, vtp, rencpl, renctp, boundingbox) & + !$omp shared(rpl, xtp, vpl, vtp, rencpl, renctp, boundingbox) & !$omp firstprivate(dt, npl, ntp, ntot) do dim = 1, SWEEPDIM where(vpl(dim,1:npl) < 0.0_DP) @@ -430,14 +430,14 @@ subroutine encounter_check_all_sort_and_sweep_pltp(npl, ntp, xpl, vpl, xtp, vtp, vtpshift_max(1:ntp) = 1 end where - call boundingbox%aabb(dim)%sort(ntot, [xpl(dim,1:npl) - rencpl(1:npl) + vplshift_min(1:npl) * vpl(dim,1:npl) * dt, & + call boundingbox%aabb(dim)%sort(ntot, [rpl(dim,1:npl) - rencpl(1:npl) + vplshift_min(1:npl) * vpl(dim,1:npl) * dt, & xtp(dim,1:ntp) - renctp(1:ntp) + vtpshift_min(1:ntp) * vtp(dim,1:ntp) * dt, & - xpl(dim,1:npl) + rencpl(1:npl) + vplshift_max(1:npl) * vpl(dim,1:npl) * dt, & + rpl(dim,1:npl) + rencpl(1:npl) + vplshift_max(1:npl) * vpl(dim,1:npl) * dt, & xtp(dim,1:ntp) + renctp(1:ntp) + vtpshift_max(1:ntp) * vtp(dim,1:ntp) * dt]) end do !$omp end parallel do - call boundingbox%sweep(npl, ntp, xpl, vpl, xtp, vtp, rencpl, renctp, dt, nenc, index1, index2, lvdotr) + call boundingbox%sweep(npl, ntp, rpl, vpl, xtp, vtp, rencpl, renctp, dt, nenc, index1, index2, lvdotr) return end subroutine encounter_check_all_sort_and_sweep_pltp @@ -584,7 +584,7 @@ subroutine encounter_check_all_triangular_plpl(npl, x, v, renc, dt, nenc, index1 end subroutine encounter_check_all_triangular_plpl - subroutine encounter_check_all_triangular_plplm(nplm, nplt, xplm, vplm, xplt, vplt, rencm, renct, dt, & + subroutine encounter_check_all_triangular_plplm(nplm, nplt, rplm, vplm, rplt, vplt, rencm, renct, dt, & nenc, index1, index2, lvdotr) !! author: David A. Minton !! @@ -594,9 +594,9 @@ subroutine encounter_check_all_triangular_plplm(nplm, nplt, xplm, vplm, xplt, vp ! Arguments integer(I4B), intent(in) :: nplm !! Total number of fully interacting massive bodies integer(I4B), intent(in) :: nplt !! Total number of partially interacting masive bodies (GM < GMTINY) - real(DP), dimension(:,:), intent(in) :: xplm !! Position vectors of fully interacting massive bodies + real(DP), dimension(:,:), intent(in) :: rplm !! Position vectors of fully interacting massive bodies real(DP), dimension(:,:), intent(in) :: vplm !! Velocity vectors of fully interacting massive bodies - real(DP), dimension(:,:), intent(in) :: xplt !! Position vectors of partially interacting massive bodies + real(DP), dimension(:,:), intent(in) :: rplt !! Position vectors of partially interacting massive bodies real(DP), dimension(:,:), intent(in) :: vplt !! Velocity vectors of partially interacting massive bodies real(DP), dimension(:), intent(in) :: rencm !! Critical radii of fully interacting massive bodies that defines an encounter real(DP), dimension(:), intent(in) :: renct !! Critical radii of partially interacting massive bodies that defines an encounter @@ -613,12 +613,12 @@ subroutine encounter_check_all_triangular_plplm(nplm, nplt, xplm, vplm, xplt, vp call swiftest_util_index_array(ind_arr, nplt) !$omp parallel do default(private) schedule(dynamic)& - !$omp shared(xplm, vplm, xplt, vplt, rencm, renct, lenc, ind_arr) & + !$omp shared(rplm, vplm, rplt, vplt, rencm, renct, lenc, ind_arr) & !$omp firstprivate(nplm, nplt, dt) do i = 1, nplm - call encounter_check_all_triangular_one(0, nplt, xplm(1,i), xplm(2,i), xplm(3,i), & + call encounter_check_all_triangular_one(0, nplt, rplm(1,i), rplm(2,i), rplm(3,i), & vplm(1,i), vplm(2,i), vplm(3,i), & - xplt(1,:), xplt(2,:), xplt(3,:), & + rplt(1,:), rplt(2,:), rplt(3,:), & vplt(1,:), vplt(2,:), vplt(3,:), & rencm(i), renct(:), dt, ind_arr(:), lenc(i)) if (lenc(i)%nenc > 0) lenc(i)%index1(:) = i @@ -631,7 +631,7 @@ subroutine encounter_check_all_triangular_plplm(nplm, nplt, xplm, vplm, xplt, vp end subroutine encounter_check_all_triangular_plplm - subroutine encounter_check_all_triangular_pltp(npl, ntp, xpl, vpl, xtp, vtp, renc, dt, & + subroutine encounter_check_all_triangular_pltp(npl, ntp, rpl, vpl, xtp, vtp, renc, dt, & nenc, index1, index2, lvdotr) !! author: David A. Minton !! @@ -641,7 +641,7 @@ subroutine encounter_check_all_triangular_pltp(npl, ntp, xpl, vpl, xtp, vtp, ren ! Arguments integer(I4B), intent(in) :: npl !! Total number of massive bodies integer(I4B), intent(in) :: ntp !! Total number of test particles - real(DP), dimension(:,:), intent(in) :: xpl !! Position vectors of massive bodies + real(DP), dimension(:,:), intent(in) :: rpl !! Position vectors of massive bodies real(DP), dimension(:,:), intent(in) :: vpl !! Velocity vectors of massive bodies real(DP), dimension(:,:), intent(in) :: xtp !! Position vectors of massive bodies real(DP), dimension(:,:), intent(in) :: vtp !! Velocity vectors of massive bodies @@ -661,10 +661,10 @@ subroutine encounter_check_all_triangular_pltp(npl, ntp, xpl, vpl, xtp, vtp, ren renct(:) = 0.0_DP !$omp parallel do default(private) schedule(dynamic)& - !$omp shared(xpl, vpl, xtp, vtp, renc, renct, lenc, ind_arr) & + !$omp shared(rpl, vpl, xtp, vtp, renc, renct, lenc, ind_arr) & !$omp firstprivate(npl, ntp, dt) do i = 1, npl - call encounter_check_all_triangular_one(0, ntp, xpl(1,i), xpl(2,i), xpl(3,i), & + call encounter_check_all_triangular_one(0, ntp, rpl(1,i), rpl(2,i), rpl(3,i), & vpl(1,i), vpl(2,i), vpl(3,i), & xtp(1,:), xtp(2,:), xtp(3,:), & vtp(1,:), vtp(2,:), vtp(3,:), & diff --git a/src/encounter/encounter_module.f90 b/src/encounter/encounter_module.f90 index 0f7ee1055..32ff67d25 100644 --- a/src/encounter/encounter_module.f90 +++ b/src/encounter/encounter_module.f90 @@ -121,16 +121,16 @@ module subroutine encounter_check_all_plpl(param, npl, x, v, renc, dt, nenc, ind integer(I8B), intent(out) :: nenc !! Total number of encounters end subroutine encounter_check_all_plpl - module subroutine encounter_check_all_plplm(param, nplm, nplt, xplm, vplm, xplt, vplt, rencm, renct, dt, & + module subroutine encounter_check_all_plplm(param, nplm, nplt, rplm, vplm, rplt, vplt, rencm, renct, dt, & nenc, index1, index2, lvdotr) use base, only: base_parameters implicit none class(base_parameters), intent(inout) :: param !! Current Swiftest run configuration parameter5s integer(I4B), intent(in) :: nplm !! Total number of fully interacting massive bodies integer(I4B), intent(in) :: nplt !! Total number of partially interacting masive bodies (GM < GMTINY) - real(DP), dimension(:,:), intent(in) :: xplm !! Position vectors of fully interacting massive bodies + real(DP), dimension(:,:), intent(in) :: rplm !! Position vectors of fully interacting massive bodies real(DP), dimension(:,:), intent(in) :: vplm !! Velocity vectors of fully interacting massive bodies - real(DP), dimension(:,:), intent(in) :: xplt !! Position vectors of partially interacting massive bodies + real(DP), dimension(:,:), intent(in) :: rplt !! Position vectors of partially interacting massive bodies real(DP), dimension(:,:), intent(in) :: vplt !! Velocity vectors of partially interacting massive bodies real(DP), dimension(:), intent(in) :: rencm !! Critical radii of fully interacting massive bodies that defines an encounter real(DP), dimension(:), intent(in) :: renct !! Critical radii of partially interacting massive bodies that defines an encounter @@ -141,13 +141,13 @@ module subroutine encounter_check_all_plplm(param, nplm, nplt, xplm, vplm, xplt, logical, dimension(:), allocatable, intent(out) :: lvdotr !! Logical flag indicating the sign of v .dot. x end subroutine encounter_check_all_plplm - module subroutine encounter_check_all_pltp(param, npl, ntp, xpl, vpl, xtp, vtp, renc, dt, nenc, index1, index2, lvdotr) + module subroutine encounter_check_all_pltp(param, npl, ntp, rpl, vpl, xtp, vtp, renc, dt, nenc, index1, index2, lvdotr) use base, only: base_parameters implicit none class(base_parameters), intent(inout) :: param !! Current Swiftest run configuration parameter5s integer(I4B), intent(in) :: npl !! Total number of massive bodies integer(I4B), intent(in) :: ntp !! Total number of test particles - real(DP), dimension(:,:), intent(in) :: xpl !! Position vectors of massive bodies + real(DP), dimension(:,:), intent(in) :: rpl !! Position vectors of massive bodies real(DP), dimension(:,:), intent(in) :: vpl !! Velocity vectors of massive bodies real(DP), dimension(:,:), intent(in) :: xtp !! Position vectors of massive bodies real(DP), dimension(:,:), intent(in) :: vtp !! Velocity vectors of massive bodies diff --git a/src/swiftest/swiftest_kick.f90 b/src/swiftest/swiftest_kick.f90 index 922fd50c7..23740432a 100644 --- a/src/swiftest/swiftest_kick.f90 +++ b/src/swiftest/swiftest_kick.f90 @@ -222,7 +222,7 @@ module subroutine swiftest_kick_getacch_int_all_triangular_pl(npl, nplm, x, Gmas end subroutine swiftest_kick_getacch_int_all_triangular_pl - module subroutine swiftest_kick_getacch_int_all_tp(ntp, npl, xtp, xpl, GMpl, lmask, acc) + module subroutine swiftest_kick_getacch_int_all_tp(ntp, npl, xtp, rpl, GMpl, lmask, acc) !! author: David A. Minton !! !! Compute direct cross (third) term heliocentric accelerations of test particles by massive bodies with parallelisim @@ -233,7 +233,7 @@ module subroutine swiftest_kick_getacch_int_all_tp(ntp, npl, xtp, xpl, GMpl, lma integer(I4B), intent(in) :: ntp !! Number of test particles integer(I4B), intent(in) :: npl !! Number of massive bodies real(DP), dimension(:,:), intent(in) :: xtp !! Test particle position vector array - real(DP), dimension(:,:), intent(in) :: xpl !! Massive body particle position vector array + real(DP), dimension(:,:), intent(in) :: rpl !! Massive body particle position vector array real(DP), dimension(:), intent(in) :: GMpl !! Array of massive body G*mass logical, dimension(:), intent(in) :: lmask !! Logical mask indicating which test particles should be computed real(DP), dimension(:,:), intent(inout) :: acc !! Acceleration vector array @@ -243,14 +243,14 @@ module subroutine swiftest_kick_getacch_int_all_tp(ntp, npl, xtp, xpl, GMpl, lma integer(I4B) :: i, j !$omp parallel do default(private) schedule(static)& - !$omp shared(npl, ntp, lmask, xtp, xpl, GMpl) & + !$omp shared(npl, ntp, lmask, xtp, rpl, GMpl) & !$omp reduction(-:acc) do i = 1, ntp if (lmask(i)) then do j = 1, npl - xr = xtp(1, i) - xpl(1, j) - yr = xtp(2, i) - xpl(2, j) - zr = xtp(3, i) - xpl(3, j) + xr = xtp(1, i) - rpl(1, j) + yr = xtp(2, i) - rpl(2, j) + zr = xtp(3, i) - rpl(3, j) rji2 = xr**2 + yr**2 + zr**2 call swiftest_kick_getacch_int_one_tp(rji2, xr, yr, zr, GMpl(j), acc(1,i), acc(2,i), acc(3,i)) end do diff --git a/src/swiftest/swiftest_module.f90 b/src/swiftest/swiftest_module.f90 index d4f88412b..a0ac7bc85 100644 --- a/src/swiftest/swiftest_module.f90 +++ b/src/swiftest/swiftest_module.f90 @@ -893,12 +893,12 @@ module subroutine swiftest_kick_getacch_int_all_triangular_pl(npl, nplm, x, Gmas real(DP), dimension(:,:), intent(inout) :: acc !! Acceleration vector array end subroutine swiftest_kick_getacch_int_all_triangular_pl - module subroutine swiftest_kick_getacch_int_all_tp(ntp, npl, xtp, xpl, GMpl, lmask, acc) + module subroutine swiftest_kick_getacch_int_all_tp(ntp, npl, xtp, rpl, GMpl, lmask, acc) implicit none integer(I4B), intent(in) :: ntp !! Number of test particles integer(I4B), intent(in) :: npl !! Number of massive bodies real(DP), dimension(:,:), intent(in) :: xtp !! Test particle position vector array - real(DP), dimension(:,:), intent(in) :: xpl !! Massive body particle position vector array + real(DP), dimension(:,:), intent(in) :: rpl !! Massive body particle position vector array real(DP), dimension(:), intent(in) :: GMpl !! Array of massive body G*mass logical, dimension(:), intent(in) :: lmask !! Logical mask indicating which test particles should be computed real(DP), dimension(:,:), intent(inout) :: acc !! Acceleration vector array From a62beb70e41254d26c7df71700eb55a6829b5834 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Fri, 23 Dec 2022 16:43:58 -0500 Subject: [PATCH 519/569] Cleanup. Made sure barycentric velocity of fragments gets computed in the simple disruption model --- src/collision/collision_generate.f90 | 20 +++++++++------ src/fraggle/fraggle_generate.f90 | 37 ++++++++++++++-------------- 2 files changed, 31 insertions(+), 26 deletions(-) diff --git a/src/collision/collision_generate.f90 b/src/collision/collision_generate.f90 index 333e5d059..27d02359c 100644 --- a/src/collision/collision_generate.f90 +++ b/src/collision/collision_generate.f90 @@ -226,14 +226,6 @@ module subroutine collision_generate_simple(self, nbody_system, param, t) write(*,*) "Error in swiftest_collision, unrecognized collision regime" call util_exit(FAILURE) end select - call collision_io_collider_message(nbody_system%pl, impactors%id, message) - call swiftest_io_log_one_message(COLLISION_LOG_OUT, message) - - ! Collisional fragments will be uniformly distributed around the pre-impact barycenter - call self%set_mass_dist(param) - - ! Generate the position and velocity distributions of the fragments - call self%disrupt(nbody_system, param, t) dpe = self%pe(2) - self%pe(1) nbody_system%Ecollisions = nbody_system%Ecollisions - dpe @@ -379,10 +371,12 @@ module subroutine collision_generate_disrupt(self, nbody_system, param, t, lfail ! Internals real(DP) :: r_max_start + call self%get_energy_and_momentum(nbody_system, param, lbefore=.true.) r_max_start = 1.1_DP * .mag.(self%impactors%rb(:,2) - self%impactors%rb(:,1)) call collision_generate_simple_pos_vec(self, r_max_start) call self%set_coordinate_system() call collision_generate_simple_vel_vec(self) + call self%get_energy_and_momentum(nbody_system, param, lbefore=.false.) return end subroutine collision_generate_disrupt @@ -508,6 +502,16 @@ module subroutine collision_generate_simple_vel_vec(collider) vimp_unit(:) = .unit. (fragments%rc(:,i) + impactors%rbcom(:) - impactors%rbimp(:)) fragments%vc(:,i) = vmag * vimp_unit(:) + vnoise(:,i) end do + do concurrent(i = 1:nfrag) + fragments%vb(:,i) = fragments%vc(:,i) + impactors%vbcom(:) + end do + + impactors%vbcom(:) = 0.0_DP + do concurrent(i = 1:nfrag) + impactors%vbcom(:) = impactors%vbcom(:) + fragments%mass(i) * fragments%vb(:,i) + end do + impactors%vbcom(:) = impactors%vbcom(:) / fragments%mtot + end associate return end subroutine collision_generate_simple_vel_vec diff --git a/src/fraggle/fraggle_generate.f90 b/src/fraggle/fraggle_generate.f90 index 3c48b71bf..0d8331970 100644 --- a/src/fraggle/fraggle_generate.f90 +++ b/src/fraggle/fraggle_generate.f90 @@ -35,7 +35,7 @@ module subroutine fraggle_generate_disrupt(self, nbody_system, param, t, lfailur integer(I4B) :: try real(DP) :: r_max_start, f_spin, dEtot, dLmag integer(I4B), parameter :: MAXTRY = 100 - logical :: lk_plpl + logical :: lk_plpl, lfailure_local logical, dimension(size(IEEE_ALL)) :: fpe_halting_modes, fpe_quiet_modes logical, dimension(size(IEEE_USUAL)) :: fpe_flag character(len=STRMAX) :: message @@ -59,7 +59,7 @@ module subroutine fraggle_generate_disrupt(self, nbody_system, param, t, lfailur if (nfrag < NFRAG_MIN) then write(message,*) "Fraggle needs at least ",NFRAG_MIN," fragments, but only ",nfrag," were given." call swiftest_io_log_one_message(COLLISION_LOG_OUT, message) - lfailure = .true. + lfailure_local = .true. return end if @@ -79,19 +79,19 @@ module subroutine fraggle_generate_disrupt(self, nbody_system, param, t, lfailur ! Start out the fragments close to the initial separation distance. This will be increased if there is any overlap or we fail to find a solution r_max_start = 1.1_DP * .mag.(impactors%rb(:,2) - impactors%rb(:,1)) - lfailure = .false. + lfailure_local = .false. try = 1 f_spin = F_SPIN_FIRST do while (try < MAXTRY) write(message,*) try call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Fraggle try " // trim(adjustl(message))) - if (lfailure) then + if (lfailure_local) then call fragments%restructure(impactors, try, f_spin, r_max_start) call fragments%reset() try = try + 1 end if - lfailure = .false. + lfailure_local = .false. call ieee_set_flag(ieee_all, .false.) ! Set all fpe flags to quiet call collision_generate_simple_pos_vec(self, r_max_start) @@ -107,20 +107,20 @@ module subroutine fraggle_generate_disrupt(self, nbody_system, param, t, lfailur call collision_generate_simple_vel_vec(self) - call fraggle_generate_tan_vel(self, lfailure) - if (lfailure) then + call fraggle_generate_tan_vel(self, lfailure_local) + if (lfailure_local) then call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Fraggle failed to find tangential velocities") cycle end if - call fraggle_generate_rad_vel(self, lfailure) - if (lfailure) then + call fraggle_generate_rad_vel(self, lfailure_local) + if (lfailure_local) then call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Fraggle failed to find radial velocities") cycle end if - call fraggle_generate_spins(self, f_spin, lfailure) - if (lfailure) then + call fraggle_generate_spins(self, f_spin, lfailure_local) + if (lfailure_local) then call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Fraggle failed to find spins") cycle end if @@ -130,16 +130,16 @@ module subroutine fraggle_generate_disrupt(self, nbody_system, param, t, lfailur dLmag = .mag. (self%Ltot(:,2) - self%Ltot(:,1)) exit - lfailure = ((abs(dEtot + impactors%Qloss) > FRAGGLE_ETOL) .or. (dEtot > 0.0_DP)) - if (lfailure) then + lfailure_local = ((abs(dEtot + impactors%Qloss) > FRAGGLE_ETOL) .or. (dEtot > 0.0_DP)) + if (lfailure_local) then write(message, *) dEtot, abs(dEtot + impactors%Qloss) / FRAGGLE_ETOL call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Fraggle failed due to high energy error: " // & trim(adjustl(message))) cycle end if - lfailure = ((abs(dLmag) / (.mag.self%Ltot(:,1))) > FRAGGLE_LTOL) - if (lfailure) then + lfailure_local = ((abs(dLmag) / (.mag.self%Ltot(:,1))) > FRAGGLE_LTOL) + if (lfailure_local) then write(message,*) dLmag / (.mag.self%Ltot(:,1)) call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Fraggle failed due to high angular momentum error: " // & trim(adjustl(message))) @@ -148,14 +148,14 @@ module subroutine fraggle_generate_disrupt(self, nbody_system, param, t, lfailur ! Check if any of the usual floating point exceptions happened, and fail the try if so call ieee_get_flag(ieee_usual, fpe_flag) - lfailure = any(fpe_flag) - if (.not.lfailure) exit + lfailure_local = any(fpe_flag) + if (.not.lfailure_local) exit write(message,*) "Fraggle failed due to a floating point exception: ", fpe_flag call swiftest_io_log_one_message(COLLISION_LOG_OUT, message) end do write(message,*) try - if (lfailure) then + if (lfailure_local) then call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Fraggle fragment generation failed after " // & trim(adjustl(message)) // " tries") else @@ -167,6 +167,7 @@ module subroutine fraggle_generate_disrupt(self, nbody_system, param, t, lfailur ! Restore the big array if (lk_plpl) call pl%flatten(param) + if (present(lfailure)) lfailure = lfailure_local end associate end select end select From 758940e6bc67bf5fd4755adb5c862882dcf55e09 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Fri, 23 Dec 2022 17:20:48 -0500 Subject: [PATCH 520/569] Add rotation to the simple disruption model --- src/collision/collision_generate.f90 | 42 +++++++++++++++++++++++++++- src/collision/collision_module.f90 | 9 ++++-- 2 files changed, 48 insertions(+), 3 deletions(-) diff --git a/src/collision/collision_generate.f90 b/src/collision/collision_generate.f90 index 27d02359c..56f0177ae 100644 --- a/src/collision/collision_generate.f90 +++ b/src/collision/collision_generate.f90 @@ -376,6 +376,7 @@ module subroutine collision_generate_disrupt(self, nbody_system, param, t, lfail call collision_generate_simple_pos_vec(self, r_max_start) call self%set_coordinate_system() call collision_generate_simple_vel_vec(self) + call collision_generate_simple_rot_vec(self) call self%get_energy_and_momentum(nbody_system, param, lbefore=.false.) return end subroutine collision_generate_disrupt @@ -461,6 +462,45 @@ module subroutine collision_generate_simple_pos_vec(collider, r_max_start) end subroutine collision_generate_simple_pos_vec + module subroutine collision_generate_simple_rot_vec(collider) + !! Author: Jennifer L.L. Pouplin, Carlisle A. Wishard, and David A. Minton + !! + !! Calculates the spins of a collection of fragments such that they conserve angular momentum + implicit none + ! Arguments + class(collision_basic), intent(inout) :: collider !! Fraggle collision system object + ! Internals + real(DP), dimension(NDIM) :: Ltotal, Lresidual + integer(I4B) :: i + + associate(fragments => collider%fragments, impactors => collider%impactors, nfrag => collider%fragments%nbody) + + fragments%rot(:,:) = 0.0_DP + ! Keep the first two bodies spinning as before to start with + Lresidual(:) = 0.0_DP + do i = 1,2 + fragments%rot(:,i) = impactors%Lspin(:,i) / (fragments%mass(i) * fragments%radius(i)**2 * fragments%Ip(3,i)) + Lresidual(:) = Lresidual(:) + impactors%Lorbit(:,i) + end do + + ! Compute the current orbital angular momentum + do i = 1, nfrag + Lresidual(:) = Lresidual(:) - fragments%mass(i) * (fragments%rc(:,i) .cross. fragments%vc(:,i)) + end do + + ! Distributed most of the remaining angular momentum amongst all the particles + if (.mag.(Lresidual(:)) > tiny(1.0_DP)) then + do i = 1,nfrag + fragments%rot(:,i) = fragments%rot(:,i) + Lresidual(:) / (nfrag * fragments%mass(i) * fragments%radius(i)**2 * fragments%Ip(3,i)) + end do + end if + + end associate + + return + end subroutine collision_generate_simple_rot_vec + + module subroutine collision_generate_simple_vel_vec(collider) !! Author: David A. Minton !! @@ -471,7 +511,7 @@ module subroutine collision_generate_simple_vel_vec(collider) ! Arguments class(collision_simple_disruption), intent(inout) :: collider !! Fraggle collision system object ! Internals - integer(I4B) :: i, j + integer(I4B) :: i logical :: lhr real(DP), dimension(NDIM) :: vimp_unit, vcom, rnorm real(DP), dimension(NDIM,collider%fragments%nbody) :: vnoise diff --git a/src/collision/collision_module.f90 b/src/collision/collision_module.f90 index 51be502a4..ecc7aa3d5 100644 --- a/src/collision/collision_module.f90 +++ b/src/collision/collision_module.f90 @@ -255,13 +255,18 @@ end subroutine collision_generate_simple module subroutine collision_generate_simple_pos_vec(collider, r_max_start) implicit none - class(collision_simple_disruption), intent(inout) :: collider !! Fraggle collision system object + class(collision_simple_disruption), intent(inout) :: collider !! Collision system object real(DP), intent(in) :: r_max_start !! The maximum radial distance of fragments for disruptive collisions end subroutine collision_generate_simple_pos_vec + module subroutine collision_generate_simple_rot_vec(collider) + implicit none + class(collision_basic), intent(inout) :: collider !! Collision system object + end subroutine collision_generate_simple_rot_vec + module subroutine collision_generate_simple_vel_vec(collider) implicit none - class(collision_simple_disruption), intent(inout) :: collider !! Fraggle collision system object + class(collision_simple_disruption), intent(inout) :: collider !! Collision system object end subroutine collision_generate_simple_vel_vec module subroutine collision_io_collider_message(pl, collidx, collider_message) From 4930ee383e1ba28a3c194172d28f4c34235e4566 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Fri, 23 Dec 2022 18:34:51 -0500 Subject: [PATCH 521/569] Fixed some bugs --- src/collision/collision_generate.f90 | 113 ++++++++++++++------------- src/swiftest/swiftest_util.f90 | 30 ++++--- 2 files changed, 72 insertions(+), 71 deletions(-) diff --git a/src/collision/collision_generate.f90 b/src/collision/collision_generate.f90 index 56f0177ae..91d879848 100644 --- a/src/collision/collision_generate.f90 +++ b/src/collision/collision_generate.f90 @@ -278,7 +278,7 @@ module subroutine collision_generate_merge(self, nbody_system, param, t) select type(nbody_system) class is (swiftest_nbody_system) - associate(impactors => nbody_system%collider%impactors, fragments => nbody_system%collider%fragments) + associate(impactors => nbody_system%collider%impactors) message = "Merging" call collision_io_collider_message(nbody_system%pl, impactors%id, message) call swiftest_io_log_one_message(COLLISION_LOG_OUT, message) @@ -290,65 +290,67 @@ module subroutine collision_generate_merge(self, nbody_system, param, t) ! Generate the merged body as a single fragment call self%setup_fragments(1) + associate(fragments => nbody_system%collider%fragments) - ! Calculate the initial energy of the nbody_system without the collisional family - call self%get_energy_and_momentum(nbody_system, param, lbefore=.true.) - - ! The new body's metadata will be taken from the largest of the two impactor bodies, so we need - ! its index in the main pl structure - ibiggest = impactors%id(maxloc(pl%Gmass(impactors%id(:)), dim=1)) - fragments%id(1) = pl%id(ibiggest) - allocate(fragments%info, source=pl%info(ibiggest:ibiggest)) - - ! Compute the physical properties of the new body after the merge. - volume = 4._DP / 3._DP * PI * sum(impactors%radius(:)**3) - fragments%mass(1) = impactors%mass_dist(1) - fragments%density(1) = fragments%mass(1) / volume - fragments%radius(1) = (3._DP * volume / (4._DP * PI))**(THIRD) - if (param%lrotation) then - do concurrent(i = 1:NDIM) - fragments%Ip(i,1) = sum(impactors%mass(:) * impactors%Ip(i,:)) - Lspin_new(i) = sum(impactors%Lorbit(i,:) + impactors%Lorbit(i,:)) - end do - fragments%Ip(:,1) = fragments%Ip(:,1) / fragments%mass(1) - fragments%rot(:,1) = Lspin_new(:) / (fragments%Ip(3,1) * fragments%mass(1) * fragments%radius(1)**2) - else ! If spin is not enabled, we will consider the lost pre-collision angular momentum as "escaped" and add it to our bookkeeping variable - nbody_system%Lescape(:) = nbody_system%Lescape(:) + impactors%Lorbit(:,1) + impactors%Lorbit(:,2) - end if + ! Calculate the initial energy of the nbody_system without the collisional family + call self%get_energy_and_momentum(nbody_system, param, lbefore=.true.) + + ! The new body's metadata will be taken from the largest of the two impactor bodies, so we need + ! its index in the main pl structure + ibiggest = impactors%id(maxloc(pl%Gmass(impactors%id(:)), dim=1)) + fragments%id(1) = pl%id(ibiggest) + allocate(fragments%info, source=pl%info(ibiggest:ibiggest)) + + ! Compute the physical properties of the new body after the merge. + volume = 4._DP / 3._DP * PI * sum(impactors%radius(:)**3) + fragments%mass(1) = impactors%mass_dist(1) + fragments%density(1) = fragments%mass(1) / volume + fragments%radius(1) = (3._DP * volume / (4._DP * PI))**(THIRD) + if (param%lrotation) then + do concurrent(i = 1:NDIM) + fragments%Ip(i,1) = sum(impactors%mass(:) * impactors%Ip(i,:)) + Lspin_new(i) = sum(impactors%Lorbit(i,:) + impactors%Lorbit(i,:)) + end do + fragments%Ip(:,1) = fragments%Ip(:,1) / fragments%mass(1) + fragments%rot(:,1) = Lspin_new(:) / (fragments%Ip(3,1) * fragments%mass(1) * fragments%radius(1)**2) + else ! If spin is not enabled, we will consider the lost pre-collision angular momentum as "escaped" and add it to our bookkeeping variable + nbody_system%Lescape(:) = nbody_system%Lescape(:) + impactors%Lorbit(:,1) + impactors%Lorbit(:,2) + end if - ! The fragment trajectory will be the barycentric trajectory - fragments%rb(:,1) = impactors%rbcom(:) - fragments%vb(:,1) = impactors%vbcom(:) - - ! Get the energy of the system after the collision - call self%get_energy_and_momentum(nbody_system, param, lbefore=.false.) - - ! Keep track of the component of potential energy that is now not considered because two bodies became one - dpe = self%pe(2) - self%pe(1) - nbody_system%Ecollisions = nbody_system%Ecollisions - dpe - nbody_system%Euntracked = nbody_system%Euntracked + dpe - - ! Update any encounter lists that have the removed bodies in them so that they instead point to the new body - do k = 1, nbody_system%plpl_encounter%nenc - do j = 1, impactors%ncoll - i = impactors%id(j) - if (i == ibiggest) cycle - if (nbody_system%plpl_encounter%id1(k) == pl%id(i)) then - nbody_system%plpl_encounter%id1(k) = pl%id(ibiggest) - nbody_system%plpl_encounter%index1(k) = i - end if - if (nbody_system%plpl_encounter%id2(k) == pl%id(i)) then - nbody_system%plpl_encounter%id2(k) = pl%id(ibiggest) - nbody_system%plpl_encounter%index2(k) = i - end if - if (nbody_system%plpl_encounter%id1(k) == nbody_system%plpl_encounter%id2(k)) nbody_system%plpl_encounter%status(k) = INACTIVE + ! The fragment trajectory will be the barycentric trajectory + fragments%rb(:,1) = impactors%rbcom(:) + fragments%vb(:,1) = impactors%vbcom(:) + + ! Get the energy of the system after the collision + call self%get_energy_and_momentum(nbody_system, param, lbefore=.false.) + + ! Keep track of the component of potential energy that is now not considered because two bodies became one + dpe = self%pe(2) - self%pe(1) + nbody_system%Ecollisions = nbody_system%Ecollisions - dpe + nbody_system%Euntracked = nbody_system%Euntracked + dpe + + ! Update any encounter lists that have the removed bodies in them so that they instead point to the new body + do k = 1, nbody_system%plpl_encounter%nenc + do j = 1, impactors%ncoll + i = impactors%id(j) + if (i == ibiggest) cycle + if (nbody_system%plpl_encounter%id1(k) == pl%id(i)) then + nbody_system%plpl_encounter%id1(k) = pl%id(ibiggest) + nbody_system%plpl_encounter%index1(k) = i + end if + if (nbody_system%plpl_encounter%id2(k) == pl%id(i)) then + nbody_system%plpl_encounter%id2(k) = pl%id(ibiggest) + nbody_system%plpl_encounter%index2(k) = i + end if + if (nbody_system%plpl_encounter%id1(k) == nbody_system%plpl_encounter%id2(k)) nbody_system%plpl_encounter%status(k) = INACTIVE + end do end do - end do - self%status = MERGED - - call collision_resolve_mergeaddsub(nbody_system, param, t, self%status) + self%status = MERGED + + call collision_resolve_mergeaddsub(nbody_system, param, t, self%status) + end associate end select end associate end select @@ -544,6 +546,7 @@ module subroutine collision_generate_simple_vel_vec(collider) end do do concurrent(i = 1:nfrag) fragments%vb(:,i) = fragments%vc(:,i) + impactors%vbcom(:) + if (lhr) fragments%vb(:,i) = fragments%vb(:,i) + impactors%vb(:,2) end do impactors%vbcom(:) = 0.0_DP diff --git a/src/swiftest/swiftest_util.f90 b/src/swiftest/swiftest_util.f90 index eae7556e0..2d207b1f7 100644 --- a/src/swiftest/swiftest_util.f90 +++ b/src/swiftest/swiftest_util.f90 @@ -1735,8 +1735,6 @@ module subroutine swiftest_util_rearray_pl(self, nbody_system, param) call pl%reset_kinship([(i, i=1, npl)]) ! Re-build the encounter list - - ! Be sure to get the level info if this is a SyMBA nbody_system select type(nbody_system) class is (symba_nbody_system) @@ -1744,23 +1742,23 @@ module subroutine swiftest_util_rearray_pl(self, nbody_system, param) class is (symba_pl) select type(tp) class is (symba_tp) - allocate(levelg_orig_pl, source=pl%levelg) - allocate(levelm_orig_pl, source=pl%levelm) - allocate(nplenc_orig_tp, source=tp%nplenc) - call move_alloc(levelg_orig_pl, pl%levelg) - call move_alloc(levelm_orig_pl, pl%levelm) - call move_alloc(nplenc_orig_pl, pl%nplenc) + ! allocate(levelg_orig_pl, source=pl%levelg) + ! allocate(levelm_orig_pl, source=pl%levelm) + ! allocate(nplenc_orig_tp, source=tp%nplenc) + ! call move_alloc(levelg_orig_pl, pl%levelg) + ! call move_alloc(levelm_orig_pl, pl%levelm) + ! call move_alloc(nplenc_orig_pl, pl%nplenc) lencounter = pl%encounter_check(param, nbody_system, param%dt, nbody_system%irec) if (tp%nbody > 0) then - allocate(levelg_orig_tp, source=tp%levelg) - allocate(levelm_orig_tp, source=tp%levelm) - allocate(nplenc_orig_tp, source=tp%nplenc) - allocate(ntpenc_orig_pl, source=pl%ntpenc) + ! allocate(levelg_orig_tp, source=tp%levelg) + ! allocate(levelm_orig_tp, source=tp%levelm) + ! allocate(nplenc_orig_tp, source=tp%nplenc) + ! allocate(ntpenc_orig_pl, source=pl%ntpenc) lencounter = tp%encounter_check(param, nbody_system, param%dt, nbody_system%irec) - call move_alloc(levelg_orig_tp, tp%levelg) - call move_alloc(levelm_orig_tp, tp%levelm) - call move_alloc(nplenc_orig_tp, tp%nplenc) - call move_alloc(ntpenc_orig_pl, pl%ntpenc) + ! call move_alloc(levelg_orig_tp, tp%levelg) + ! call move_alloc(levelm_orig_tp, tp%levelm) + ! call move_alloc(nplenc_orig_tp, tp%nplenc) + ! call move_alloc(ntpenc_orig_pl, pl%ntpenc) end if end select end select From 09a508dce6658997255d406f45b0b9cd7e27b45a Mon Sep 17 00:00:00 2001 From: David A Minton Date: Fri, 23 Dec 2022 18:44:50 -0500 Subject: [PATCH 522/569] Finally getting hit and runs that are closer to what I imagine they should be --- src/collision/collision_generate.f90 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/collision/collision_generate.f90 b/src/collision/collision_generate.f90 index 91d879848..5898311a3 100644 --- a/src/collision/collision_generate.f90 +++ b/src/collision/collision_generate.f90 @@ -517,7 +517,7 @@ module subroutine collision_generate_simple_vel_vec(collider) logical :: lhr real(DP), dimension(NDIM) :: vimp_unit, vcom, rnorm real(DP), dimension(NDIM,collider%fragments%nbody) :: vnoise - real(DP), parameter :: VNOISE_MAG = 0.10_DP + real(DP), parameter :: VNOISE_MAG = 0.50_DP real(DP) :: vmag associate(fragments => collider%fragments, impactors => collider%impactors, nfrag => collider%fragments%nbody) @@ -528,7 +528,7 @@ module subroutine collision_generate_simple_vel_vec(collider) vcom(:) = impactors%vb(:,i) - impactors%vbcom(:) rnorm(:) = impactors%y_unit(:) ! Do the reflection - vcom(:) = vcom(:) - 2 * dot_product(vcom(:),rnorm(:)) * rnorm(:) + if (.not. lhr) vcom(:) = vcom(:) - 2 * dot_product(vcom(:),rnorm(:)) * rnorm(:) fragments%vc(:,i) = vcom(:) end do @@ -542,11 +542,11 @@ module subroutine collision_generate_simple_vel_vec(collider) vnoise = (2 * vnoise - 1.0_DP) * vmag do i = 3, nfrag vimp_unit(:) = .unit. (fragments%rc(:,i) + impactors%rbcom(:) - impactors%rbimp(:)) - fragments%vc(:,i) = vmag * vimp_unit(:) + vnoise(:,i) + fragments%vc(:,i) = vmag * vimp_unit(:) + vnoise(:,i) + if (lhr) fragments%vc(:,i) = fragments%vc(:,i) + fragments%vc(:,2) end do do concurrent(i = 1:nfrag) fragments%vb(:,i) = fragments%vc(:,i) + impactors%vbcom(:) - if (lhr) fragments%vb(:,i) = fragments%vb(:,i) + impactors%vb(:,2) end do impactors%vbcom(:) = 0.0_DP From e28c01e3148d1c38452dfdd802c91e34f58f8944 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Fri, 23 Dec 2022 19:20:23 -0500 Subject: [PATCH 523/569] Fixed bugs that were preventing disruptions from working in the simple model --- src/collision/collision_generate.f90 | 42 +++++++++++++++------------- src/collision/collision_resolve.f90 | 37 ++++++++++++------------ 2 files changed, 41 insertions(+), 38 deletions(-) diff --git a/src/collision/collision_generate.f90 b/src/collision/collision_generate.f90 index 5898311a3..4e55b7f51 100644 --- a/src/collision/collision_generate.f90 +++ b/src/collision/collision_generate.f90 @@ -209,7 +209,7 @@ module subroutine collision_generate_simple(self, nbody_system, param, t) class is (swiftest_nbody_system) select type(pl => nbody_system%pl) class is (swiftest_pl) - associate(impactors => self%impactors, fragments => self%fragments, status => self%status) + associate(impactors => self%impactors, status => self%status) select case (impactors%regime) case (COLLRESOLVE_REGIME_HIT_AND_RUN) @@ -226,30 +226,34 @@ module subroutine collision_generate_simple(self, nbody_system, param, t) write(*,*) "Error in swiftest_collision, unrecognized collision regime" call util_exit(FAILURE) end select + call self%set_mass_dist(param) + call self%disrupt(nbody_system, param, t) dpe = self%pe(2) - self%pe(1) nbody_system%Ecollisions = nbody_system%Ecollisions - dpe nbody_system%Euntracked = nbody_system%Euntracked + dpe - ! Populate the list of new bodies - nfrag = fragments%nbody - write(message, *) nfrag - call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Generating " // trim(adjustl(message)) // " fragments") - select case(impactors%regime) - case(COLLRESOLVE_REGIME_DISRUPTION) - status = DISRUPTED - ibiggest = impactors%id(maxloc(pl%Gmass(impactors%id(:)), dim=1)) - fragments%id(1) = pl%id(ibiggest) - fragments%id(2:nfrag) = [(i, i = param%maxid + 1, param%maxid + nfrag - 1)] - param%maxid = fragments%id(nfrag) - case(COLLRESOLVE_REGIME_SUPERCATASTROPHIC) - status = SUPERCATASTROPHIC - fragments%id(1:nfrag) = [(i, i = param%maxid + 1, param%maxid + nfrag)] - param%maxid = fragments%id(nfrag) - end select + associate (fragments => self%fragments) + ! Populate the list of new bodies + nfrag = fragments%nbody + write(message, *) nfrag + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Generating " // trim(adjustl(message)) // " fragments") + select case(impactors%regime) + case(COLLRESOLVE_REGIME_DISRUPTION) + status = DISRUPTED + ibiggest = impactors%id(maxloc(pl%Gmass(impactors%id(:)), dim=1)) + fragments%id(1) = pl%id(ibiggest) + fragments%id(2:nfrag) = [(i, i = param%maxid + 1, param%maxid + nfrag - 1)] + param%maxid = fragments%id(nfrag) + case(COLLRESOLVE_REGIME_SUPERCATASTROPHIC) + status = SUPERCATASTROPHIC + fragments%id(1:nfrag) = [(i, i = param%maxid + 1, param%maxid + nfrag)] + param%maxid = fragments%id(nfrag) + end select - call collision_resolve_mergeaddsub(nbody_system, param, t, status) - end associate + call collision_resolve_mergeaddsub(nbody_system, param, t, status) + end associate + end associate end select end select return diff --git a/src/collision/collision_resolve.f90 b/src/collision/collision_resolve.f90 index 9e91b1ecd..f29e6abce 100644 --- a/src/collision/collision_resolve.f90 +++ b/src/collision/collision_resolve.f90 @@ -507,22 +507,21 @@ module subroutine collision_resolve_plpl(self, nbody_system, param, t, dt, irec) associate(plpl_encounter => self, plpl_collision => nbody_system%plpl_collision, & collision_history => nbody_system%collision_history, pl => nbody_system%pl, cb => nbody_system%cb, & collider => nbody_system%collider, fragments => nbody_system%collider%fragments, impactors => nbody_system%collider%impactors) - associate( idx1 => plpl_collision%index1, idx2 => plpl_collision%index2) + if (plpl_collision%nenc == 0) return ! No collisions to resolve - if (plpl_collision%nenc == 0) return ! No collisions to resolve + ! Make sure that the heliocentric and barycentric coordinates are consistent with each other + call pl%vb2vh(nbody_system%cb) + call pl%rh2rb(nbody_system%cb) - ! Make sure that the heliocentric and barycentric coordinates are consistent with each other - call pl%vb2vh(nbody_system%cb) - call pl%rh2rb(nbody_system%cb) - - ! Get the energy before the collision is resolved - if (param%lenergy) then - call nbody_system%get_energy_and_momentum(param) - Eorbit_before = nbody_system%te - end if + ! Get the energy before the collision is resolved + if (param%lenergy) then + call nbody_system%get_energy_and_momentum(param) + Eorbit_before = nbody_system%te + end if - do loop = 1, MAXCASCADE + do loop = 1, MAXCASCADE + associate( idx1 => plpl_collision%index1, idx2 => plpl_collision%index2) ncollisions = plpl_collision%nenc write(timestr,*) t call swiftest_io_log_one_message(COLLISION_LOG_OUT, "") @@ -572,15 +571,15 @@ module subroutine collision_resolve_plpl(self, nbody_system, param, t, dt, irec) write(*,*) "Consider reducing the step size or changing the parameters in the collisional model to reduce the number of fragments." call util_exit(FAILURE) end if - end do + end associate + end do - if (param%lenergy) then - call nbody_system%get_energy_and_momentum(param) - Eorbit_after = nbody_system%te - nbody_system%Ecollisions = nbody_system%Ecollisions + (Eorbit_after - Eorbit_before) - end if + if (param%lenergy) then + call nbody_system%get_energy_and_momentum(param) + Eorbit_after = nbody_system%te + nbody_system%Ecollisions = nbody_system%Ecollisions + (Eorbit_after - Eorbit_before) + end if - end associate end associate end select end select From 31504c6a3649ce49d5f66b5fbf947e6447732d3f Mon Sep 17 00:00:00 2001 From: David A Minton Date: Fri, 23 Dec 2022 20:19:27 -0500 Subject: [PATCH 524/569] Tweaked the velocity distributions --- src/collision/collision_generate.f90 | 22 ++++++++++------------ 1 file changed, 10 insertions(+), 12 deletions(-) diff --git a/src/collision/collision_generate.f90 b/src/collision/collision_generate.f90 index 4e55b7f51..0f6da8d79 100644 --- a/src/collision/collision_generate.f90 +++ b/src/collision/collision_generate.f90 @@ -290,7 +290,7 @@ module subroutine collision_generate_merge(self, nbody_system, param, t) select type(pl => nbody_system%pl) class is (swiftest_pl) ! Get coordinate system - call self%set_coordinate_system() + call impactors%set_coordinate_system() ! Generate the merged body as a single fragment call self%setup_fragments(1) @@ -378,7 +378,7 @@ module subroutine collision_generate_disrupt(self, nbody_system, param, t, lfail real(DP) :: r_max_start call self%get_energy_and_momentum(nbody_system, param, lbefore=.true.) - r_max_start = 1.1_DP * .mag.(self%impactors%rb(:,2) - self%impactors%rb(:,1)) + r_max_start = 1.5_DP * .mag.(self%impactors%rb(:,2) - self%impactors%rb(:,1)) call collision_generate_simple_pos_vec(self, r_max_start) call self%set_coordinate_system() call collision_generate_simple_vel_vec(self) @@ -518,15 +518,15 @@ module subroutine collision_generate_simple_vel_vec(collider) class(collision_simple_disruption), intent(inout) :: collider !! Fraggle collision system object ! Internals integer(I4B) :: i - logical :: lhr + logical :: lhr, lnoncat real(DP), dimension(NDIM) :: vimp_unit, vcom, rnorm real(DP), dimension(NDIM,collider%fragments%nbody) :: vnoise - real(DP), parameter :: VNOISE_MAG = 0.50_DP + real(DP), parameter :: VNOISE_MAG = 0.20_DP real(DP) :: vmag associate(fragments => collider%fragments, impactors => collider%impactors, nfrag => collider%fragments%nbody) lhr = (impactors%regime == COLLRESOLVE_REGIME_HIT_AND_RUN) - + lnoncat = (impactors%regime /= COLLRESOLVE_REGIME_SUPERCATASTROPHIC) ! For non-catastrophic impacts, make the fragments act like ejecta and point away from the impact point ! "Bounce" the first two bodies do i = 1,2 vcom(:) = impactors%vb(:,i) - impactors%vbcom(:) @@ -536,18 +536,16 @@ module subroutine collision_generate_simple_vel_vec(collider) fragments%vc(:,i) = vcom(:) end do - ! Compute the escape velocity + ! Compute the escape velocity and velocity dispursion + call random_number(vnoise) if (lhr) then vmag = 2 * sqrt(2 * impactors%Gmass(2) / impactors%radius(2)) else - vmag = 2 * sqrt(2 * sum(impactors%Gmass(:)) / (.mag. (impactors%rb(:,2) - impactors%rb(:,1)))) + vmag = .mag. (impactors%vb(:,2) - impactors%vb(:,1)) end if - call random_number(vnoise) - vnoise = (2 * vnoise - 1.0_DP) * vmag do i = 3, nfrag - vimp_unit(:) = .unit. (fragments%rc(:,i) + impactors%rbcom(:) - impactors%rbimp(:)) - fragments%vc(:,i) = vmag * vimp_unit(:) + vnoise(:,i) - if (lhr) fragments%vc(:,i) = fragments%vc(:,i) + fragments%vc(:,2) + vimp_unit(:) = .unit. (fragments%rc(:,i) - (impactors%rbimp(:) - impactors%rbcom(:))) + fragments%vc(:,i) = vmag * (vimp_unit(:) + vnoise(:,i)) + fragments%vc(:,2) end do do concurrent(i = 1:nfrag) fragments%vb(:,i) = fragments%vc(:,i) + impactors%vbcom(:) From 3bb3b044b6683dc852a3e6253e50da80b4ff3101 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Mon, 26 Dec 2022 08:25:24 -0500 Subject: [PATCH 525/569] Lots of improvements to the simple collision model, which should improve Fraggle's ability to successfully find solutions --- examples/Fragmentation/Fragmentation_Movie.py | 40 +++-- src/collision/collision_generate.f90 | 154 ++++++++++-------- src/collision/collision_module.f90 | 52 +++--- src/collision/collision_resolve.f90 | 18 +- src/collision/collision_util.f90 | 46 +++++- src/fraggle/fraggle_generate.f90 | 2 +- src/fraggle/fraggle_util.f90 | 4 +- src/swiftest/swiftest_util.f90 | 22 +-- 8 files changed, 201 insertions(+), 137 deletions(-) diff --git a/examples/Fragmentation/Fragmentation_Movie.py b/examples/Fragmentation/Fragmentation_Movie.py index 381bca121..317ff7de7 100644 --- a/examples/Fragmentation/Fragmentation_Movie.py +++ b/examples/Fragmentation/Fragmentation_Movie.py @@ -36,30 +36,42 @@ # ---------------------------------------------------------------------------------------------------------------------- # Define the names and initial conditions of the various fragmentation simulation types # ---------------------------------------------------------------------------------------------------------------------- -available_movie_styles = ["disruption_headon", "supercatastrophic_off_axis", "hitandrun"] -movie_title_list = ["Head-on Disruption", "Off-axis Supercatastrophic", "Hit and Run"] +available_movie_styles = ["disruption_headon", "disruption_off_axis", "supercatastrophic_headon", "supercatastrophic_off_axis","hitandrun"] +movie_title_list = ["Head-on Disruption", "Off-axis Disruption", "Head-on Supercatastrophic", "Off-axis Supercatastrophic", "Hit and Run"] movie_titles = dict(zip(available_movie_styles, movie_title_list)) # These initial conditions were generated by trial and error names = ["Target","Projectile"] pos_vectors = {"disruption_headon" : [np.array([1.0, -5.0e-05, 0.0]), np.array([1.0, 5.0e-05 ,0.0])], + "disruption_off_axis" : [np.array([1.0, -5.0e-05, 0.0]), + np.array([1.0, 5.0e-05 ,0.0])], + "supercatastrophic_headon": [np.array([1.0, -5.0e-05, 0.0]), + np.array([1.0, 5.0e-05, 0.0])], "supercatastrophic_off_axis": [np.array([1.0, -5.0e-05, 0.0]), np.array([1.0, 5.0e-05, 0.0])], "hitandrun" : [np.array([1.0, -4.2e-05, 0.0]), np.array([1.0, 4.2e-05, 0.0])] } -vel_vectors = {"disruption_headon" : [np.array([-2.562596e-04, 6.280005, 0.0]), - np.array([-2.562596e-04, -6.280005, 0.0])], - "supercatastrophic_off_axis": [np.array([0.0, 6.28, 0.0]), - np.array([0.5, -6.28, 0.0])], - "hitandrun" : [np.array([0.0, 6.28, 0.0]), - np.array([-1.45, -6.28, 0.00])] +vel_vectors = {"disruption_headon" : [np.array([ 0.00, 6.280005, 0.0]), + np.array([ 0.00, -6.280005, 0.0])], + "disruption_off_axis" : [np.array([ 0.00, 6.280005, 0.0]), + np.array([ 0.50, -6.280005, 0.0])], + "supercatastrophic_headon": [np.array([ 0.00, 6.28, 0.0]), + np.array([ 0.00, -6.28, 0.0])], + "supercatastrophic_off_axis": [np.array([ 0.00, 6.28, 0.0]), + np.array([ 0.50, -6.28, 0.0])], + "hitandrun" : [np.array([ 0.00, 6.28, 0.0]), + np.array([-1.45, -6.28, 0.0])] } rot_vectors = {"disruption_headon" : [np.array([0.0, 0.0, 0.0]), np.array([0.0, 0.0, 0.0])], + "disruption_off_axis": [np.array([0.0, 0.0, 6.0e4]), + np.array([0.0, 0.0, 1.0e5])], + "supercatastrophic_headon": [np.array([0.0, 0.0, 0.0]), + np.array([0.0, 0.0, 0.0])], "supercatastrophic_off_axis": [np.array([0.0, 0.0, -6.0e4]), np.array([0.0, 0.0, 1.0e5])], "hitandrun" : [np.array([0.0, 0.0, 6.0e4]), @@ -67,6 +79,8 @@ } body_Gmass = {"disruption_headon" : [1e-7, 1e-10], + "disruption_off_axis" : [1e-7, 1e-10], + "supercatastrophic_headon": [1e-7, 1e-8], "supercatastrophic_off_axis": [1e-7, 1e-8], "hitandrun" : [1e-7, 7e-10] } @@ -185,12 +199,14 @@ def data_stream(self, frame=0): print("Select a fragmentation movie to generate.") print("1. Head-on disruption") - print("2. Off-axis supercatastrophic") - print("3. Hit and run") - print("4. All of the above") + print("2. Off-axis disruption") + print("3. Head-on supercatastrophic") + print("4. Off-axis supercatastrophic") + print("5. Hit and run") + print("6. All of the above") user_selection = int(input("? ")) - if user_selection > 0 and user_selection < 4: + if user_selection > 0 and user_selection < 6: movie_styles = [available_movie_styles[user_selection-1]] else: print("Generating all movie styles") diff --git a/src/collision/collision_generate.f90 b/src/collision/collision_generate.f90 index 0f6da8d79..16e0c39b7 100644 --- a/src/collision/collision_generate.f90 +++ b/src/collision/collision_generate.f90 @@ -32,6 +32,7 @@ module subroutine collision_generate_basic(self, nbody_system, param, t) return end subroutine collision_generate_basic + module subroutine collision_generate_bounce(self, nbody_system, param, t) !! author: David A. Minton !! @@ -200,8 +201,7 @@ module subroutine collision_generate_simple(self, nbody_system, param, t) class(base_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions real(DP), intent(in) :: t !! Time of collision ! Internals - integer(I4B) :: i, ibiggest, nfrag, status - logical :: lfailure + integer(I4B) :: i, ibiggest, nfrag character(len=STRMAX) :: message real(DP) :: dpe @@ -370,16 +370,14 @@ module subroutine collision_generate_disrupt(self, nbody_system, param, t, lfail implicit none ! Arguments class(collision_simple_disruption), intent(inout) :: self !! Simple fragment system object - class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object - class(base_parameters), intent(inout) :: param !! Current run configuration parameters - real(DP), intent(in) :: t !! The time of the collision - logical, optional, intent(out) :: lfailure + class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object + class(base_parameters), intent(inout) :: param !! Current run configuration parameters + real(DP), intent(in) :: t !! The time of the collision + logical, optional, intent(out) :: lfailure ! Internals - real(DP) :: r_max_start call self%get_energy_and_momentum(nbody_system, param, lbefore=.true.) - r_max_start = 1.5_DP * .mag.(self%impactors%rb(:,2) - self%impactors%rb(:,1)) - call collision_generate_simple_pos_vec(self, r_max_start) + call collision_generate_simple_pos_vec(self) call self%set_coordinate_system() call collision_generate_simple_vel_vec(self) call collision_generate_simple_rot_vec(self) @@ -388,7 +386,7 @@ module subroutine collision_generate_disrupt(self, nbody_system, param, t, lfail end subroutine collision_generate_disrupt - module subroutine collision_generate_simple_pos_vec(collider, r_max_start) + module subroutine collision_generate_simple_pos_vec(collider) !! Author: Jennifer L.L. Pouplin, Carlisle A. Wishard, and David A. Minton !! !! Initializes the position vectors of the fragments around the center of mass based on the collision style. @@ -398,46 +396,51 @@ module subroutine collision_generate_simple_pos_vec(collider, r_max_start) implicit none ! Arguments class(collision_simple_disruption), intent(inout) :: collider !! Fraggle collision system object - real(DP), intent(in) :: r_max_start !! The maximum radial distance of fragments for disruptive collisions ! Internals - real(DP) :: dis, rad, r_max, fdistort - logical, dimension(:), allocatable :: loverlap - integer(I4B) :: i, j - logical :: lnoncat, lhitandrun + real(DP) :: dis + real(DP), dimension(NDIM,2) :: fragment_cloud_center + real(DP), dimension(2) :: fragment_cloud_radius + logical, dimension(collider%fragments%nbody) :: loverlap + integer(I4B) :: i, j, loop + logical :: lcat, lhitandrun + integer(I4B), parameter :: MAXLOOP = 10000 + real(DP) :: rdistance + real(DP), parameter :: fail_scale = 1.1_DP ! Scale factor to apply to cloud radius and distance if cloud generation fails - associate(fragments => collider%fragments, impactors => collider%impactors, nfrag => collider%fragments%nbody) - allocate(loverlap(nfrag)) - lnoncat = (impactors%regime /= COLLRESOLVE_REGIME_SUPERCATASTROPHIC) ! For non-catastrophic impacts, make the fragments act like ejecta and point away from the impact point - lhitandrun = (impactors%regime == COLLRESOLVE_REGIME_HIT_AND_RUN) ! Disruptive hit and runs have their own fragment distribution + associate(fragments => collider%fragments, impactors => collider%impactors, nfrag => collider%fragments%nbody) + lcat = (impactors%regime == COLLRESOLVE_REGIME_SUPERCATASTROPHIC) + lhitandrun = (impactors%regime == COLLRESOLVE_REGIME_HIT_AND_RUN) - ! Place the fragments into a region that is big enough that we should usually not have overlapping bodies - ! An overlapping bodies will collide in the next time step, so it's not a major problem if they do (it just slows the run down) - r_max = r_max_start - rad = sum(impactors%radius(:)) + ! We will treat the first two fragments of the list as special cases. + ! Place the first two bodies at the centers of the two fragment clouds, but be sure they are sufficiently far apart to avoid overlap + rdistance = .mag. (impactors%rc(:,2) - impactors%rc(:,1)) - sum(fragments%radius(1:2)) + rdistance = min(0.5_DP*rdistance, 1e-6_DP*impactors%radius(2)) - ! This is a factor that will "distort" the shape of the fragment cloud in the direction of the impact velocity - fdistort = .mag. (impactors%y_unit(:) .cross. impactors%v_unit(:)) + fragment_cloud_radius(:) = impactors%radius(:) - ! We will treat the first two fragments of the list as special cases. They get initialized at the original positions of the impactor bodies - fragments%rc(:, 1) = impactors%rb(:, 1) - impactors%rbcom(:) - fragments%rc(:, 2) = impactors%rb(:, 2) - impactors%rbcom(:) - call random_number(fragments%rc(:,3:nfrag)) loverlap(:) = .true. - do while (any(loverlap(3:nfrag))) - if (lhitandrun) then ! For a hit-and-run with disruption, the fragment cloud size is based on the radius of the disrupted body - r_max = 2 * impactors%radius(2) - else ! For disruptions, the the fragment cloud size is based on the mutual collision system - r_max = r_max + 0.1_DP * rad - end if - do i = 3, nfrag - if (loverlap(i)) then + do loop = 1, MAXLOOP + if (.not.any(loverlap(:))) exit + fragment_cloud_center(:,1) = impactors%rc(:,1) + rdistance * impactors%bounce_unit(:) + fragment_cloud_center(:,2) = impactors%rc(:,2) - rdistance * impactors%bounce_unit(:) + do concurrent(i = 1:nfrag, loverlap(i)) + if (i < 3) then + fragments%rc(:,i) = fragment_cloud_center(:,i) + else + ! Make a random cloud call random_number(fragments%rc(:,i)) - fragments%rc(:,i) = 2 * (fragments%rc(:, i) - 0.5_DP) - fragments%rc(:, i) = fragments%rc(:,i) + fdistort * impactors%v_unit(:) - fragments%rc(:, i) = r_max * fragments%rc(:, i) - fragments%rc(:, i) = fragments%rc(:, i) + (impactors%rbimp(:) - impactors%rbcom(:)) ! Shift the center of the fragment cloud to the impact point rather than the CoM - if (lnoncat .and. dot_product(fragments%rc(:,i), impactors%y_unit(:)) < 0.0_DP) fragments%rc(:, i) = -fragments%rc(:, i) ! Make sure the fragment cloud points away from the impact point + + ! Make the fragment cloud symmertic about 0 + fragments%rc(:,i) = 2 *(fragments%rc(:,i) - 0.5_DP) + + j = fragments%origin_body(i) + + ! Scale the cloud size + fragments%rc(:,i) = fragment_cloud_radius(j) * fragments%rc(:,i) + + ! Shift to the cloud center coordinates + fragments%rc(:,i) = fragments%rc(:,i) + fragment_cloud_center(:,j) end if end do @@ -449,6 +452,8 @@ module subroutine collision_generate_simple_pos_vec(collider, r_max_start) loverlap(i) = loverlap(i) .or. (dis <= (fragments%radius(i) + fragments%radius(j))) end do end do + rdistance = rdistance * fail_scale + fragment_cloud_radius(:) = fragment_cloud_radius(:) * fail_scale end do call collision_util_shift_vector_to_origin(fragments%mass, fragments%rc) call collider%set_coordinate_system() @@ -476,7 +481,7 @@ module subroutine collision_generate_simple_rot_vec(collider) ! Arguments class(collision_basic), intent(inout) :: collider !! Fraggle collision system object ! Internals - real(DP), dimension(NDIM) :: Ltotal, Lresidual + real(DP), dimension(NDIM) :: Lresidual integer(I4B) :: i associate(fragments => collider%fragments, impactors => collider%impactors, nfrag => collider%fragments%nbody) @@ -517,35 +522,52 @@ module subroutine collision_generate_simple_vel_vec(collider) ! Arguments class(collision_simple_disruption), intent(inout) :: collider !! Fraggle collision system object ! Internals - integer(I4B) :: i - logical :: lhr, lnoncat - real(DP), dimension(NDIM) :: vimp_unit, vcom, rnorm - real(DP), dimension(NDIM,collider%fragments%nbody) :: vnoise - real(DP), parameter :: VNOISE_MAG = 0.20_DP - real(DP) :: vmag + integer(I4B) :: i,j + logical :: lhitandrun, lnoncat + real(DP), dimension(NDIM) :: vimp_unit, rimp, vrot + real(DP), dimension(2) :: vimp + real(DP) :: vmag, vdisp + integer(I4B), dimension(collider%fragments%nbody) :: vsign + real(DP), dimension(collider%fragments%nbody) :: vscale associate(fragments => collider%fragments, impactors => collider%impactors, nfrag => collider%fragments%nbody) - lhr = (impactors%regime == COLLRESOLVE_REGIME_HIT_AND_RUN) + lhitandrun = (impactors%regime == COLLRESOLVE_REGIME_HIT_AND_RUN) lnoncat = (impactors%regime /= COLLRESOLVE_REGIME_SUPERCATASTROPHIC) ! For non-catastrophic impacts, make the fragments act like ejecta and point away from the impact point ! "Bounce" the first two bodies - do i = 1,2 - vcom(:) = impactors%vb(:,i) - impactors%vbcom(:) - rnorm(:) = impactors%y_unit(:) - ! Do the reflection - if (.not. lhr) vcom(:) = vcom(:) - 2 * dot_product(vcom(:),rnorm(:)) * rnorm(:) - fragments%vc(:,i) = vcom(:) - end do - - ! Compute the escape velocity and velocity dispursion - call random_number(vnoise) - if (lhr) then - vmag = 2 * sqrt(2 * impactors%Gmass(2) / impactors%radius(2)) + where(fragments%origin_body(:) == 1) + vsign(:) = -1 + elsewhere + vsign(:) = 1 + end where + + ! Compute the velocity dispersion based on the escape velocity + if (lhitandrun) then + vdisp = 2 * sqrt(2 * impactors%Gmass(2) / impactors%radius(2)) else - vmag = .mag. (impactors%vb(:,2) - impactors%vb(:,1)) + vdisp = 2 * sqrt(2 * sum(impactors%Gmass(:)) / sum(impactors%radius(:))) + !vmag = abs(dot_product(impactors%vb(:,2) - impactors%vb(:,1), impactors%y_unit(:))) end if - do i = 3, nfrag - vimp_unit(:) = .unit. (fragments%rc(:,i) - (impactors%rbimp(:) - impactors%rbcom(:))) - fragments%vc(:,i) = vmag * (vimp_unit(:) + vnoise(:,i)) + fragments%vc(:,2) + + vimp(:) = .mag.impactors%vc(:,:) + + ! Scale the magnitude of the velocity by the distance from the impact point and add a bit of shear + do concurrent(i = 1:nfrag) + rimp(:) = fragments%rc(:,i) - impactors%rbimp(:) + vscale(i) = .mag. rimp(:) / (.mag. (impactors%rb(:,2) - impactors%rb(:,1))) + end do + vscale(:) = vscale(:)/maxval(vscale(:)) + + fragments%vc(:,1) = .mag.impactors%vc(:,1) * impactors%bounce_unit(:) + do concurrent(i = 2:nfrag) + rimp(:) = fragments%rc(:,i) - impactors%rbimp(:) + vimp_unit(:) = .unit. rimp(:) + + j = fragments%origin_body(i) + vrot(:) = impactors%rot(:,j) .cross. (fragments%rc(:,i) - impactors%rb(:,j) + impactors%rbcom(:)) + + vmag = .mag.impactors%vc(:,j) * vscale(i) + + fragments%vc(:,i) = vmag * 0.5_DP * (impactors%bounce_unit(:) + vimp_unit(:)) * vsign(i) + vrot(:) end do do concurrent(i = 1:nfrag) fragments%vb(:,i) = fragments%vc(:,i) + impactors%vbcom(:) diff --git a/src/collision/collision_module.f90 b/src/collision/collision_module.f90 index ecc7aa3d5..c0df619c5 100644 --- a/src/collision/collision_module.f90 +++ b/src/collision/collision_module.f90 @@ -52,8 +52,10 @@ module collision type, extends(base_object) :: collision_impactors integer(I4B) :: ncoll !! Number of bodies involved in the collision integer(I4B), dimension(:), allocatable :: id !! Index of bodies involved in the collision - real(DP), dimension(NDIM,2) :: rb !! Two-body equivalent position vectors of the collider bodies prior to collision - real(DP), dimension(NDIM,2) :: vb !! Two-body equivalent velocity vectors of the collider bodies prior to collision + real(DP), dimension(NDIM,2) :: rb !! Two-body equivalent position vectors of the collider bodies prior to collision in system barycentric coordinates + real(DP), dimension(NDIM,2) :: vb !! Two-body equivalent velocity vectors of the collider bodies prior to collision in system barycentric coordinate + real(DP), dimension(NDIM,2) :: rc !! Two-body equivalent position vectors of the collider bodies prior to collision in collision center of mass coordinates + real(DP), dimension(NDIM,2) :: vc !! Two-body equivalent velocity vectors of the collider bodies prior to collision in collision center of mass coordinates real(DP), dimension(NDIM,2) :: rot !! Two-body equivalent principal axes moments of inertia the collider bodies prior to collision real(DP), dimension(NDIM,2) :: Lspin !! Two-body equivalent spin angular momentum vectors of the collider bodies prior to collision real(DP), dimension(NDIM,2) :: Lorbit !! Two-body equivalent orbital angular momentum vectors of the collider bodies prior to collision @@ -74,7 +76,7 @@ module collision real(DP), dimension(NDIM) :: rbcom !! Center of mass position vector of the collider nbody_system in nbody_system barycentric coordinates real(DP), dimension(NDIM) :: vbcom !! Velocity vector of the center of mass of the collider nbody_system in nbody_system barycentric coordinates real(DP), dimension(NDIM) :: rbimp !! Impact point position vector of the collider nbody_system in nbody_system barycentric coordinates - real(DP), dimension(NDIM) :: vbimp !! The impact point velocity vector is the component of the velocity in the distance vector direction + real(DP), dimension(NDIM) :: bounce_unit !! The impact point velocity vector is the component of the velocity in the distance vector direction contains procedure :: consolidate => collision_resolve_consolidate_impactors !! Consolidates a multi-body collision into an equivalent 2-body collision @@ -87,26 +89,27 @@ module collision !> Class definition for the variables that describe a collection of fragments in barycentric coordinates type, extends(base_multibody) :: collision_fragments - real(DP) :: mtot !! Total mass of fragments - class(base_particle_info), dimension(:), allocatable :: info !! Particle metadata information - integer(I4B), dimension(nbody) :: status !! An integrator-specific status indicator - real(DP), dimension(NDIM,nbody) :: rh !! Heliocentric position - real(DP), dimension(NDIM,nbody) :: vh !! Heliocentric velocity - real(DP), dimension(NDIM,nbody) :: rb !! Barycentric position - real(DP), dimension(NDIM,nbody) :: vb !! Barycentric velocity - real(DP), dimension(NDIM,nbody) :: rot !! rotation vectors of fragments - real(DP), dimension(NDIM,nbody) :: Ip !! Principal axes moment of inertia for fragments - real(DP), dimension(nbody) :: mass !! masses of fragments - real(DP), dimension(nbody) :: radius !! Radii of fragments - real(DP), dimension(nbody) :: density !! Radii of fragments - real(DP), dimension(NDIM,nbody) :: rc !! Position vectors in the collision coordinate frame - real(DP), dimension(NDIM,nbody) :: vc !! Velocity vectors in the collision coordinate frame - real(DP), dimension(nbody) :: rmag !! Array of radial distance magnitudes of individual fragments in the collisional coordinate frame - real(DP), dimension(nbody) :: vmag !! Array of radial distance magnitudes of individual fragments in the collisional coordinate frame - real(DP), dimension(nbody) :: rotmag !! Array of rotation magnitudes of individual fragments - real(DP), dimension(NDIM,nbody) :: v_r_unit !! Array of radial direction unit vectors of individual fragments in the collisional coordinate frame - real(DP), dimension(NDIM,nbody) :: v_t_unit !! Array of tangential direction unit vectors of individual fragments in the collisional coordinate frame - real(DP), dimension(NDIM,nbody) :: v_n_unit !! Array of normal direction unit vectors of individual fragments in the collisional coordinate frame + real(DP) :: mtot !! Total mass of fragments + class(base_particle_info), dimension(:), allocatable :: info !! Particle metadata information + integer(I4B), dimension(nbody) :: status !! An integrator-specific status indicator + real(DP), dimension(NDIM,nbody) :: rh !! Heliocentric position + real(DP), dimension(NDIM,nbody) :: vh !! Heliocentric velocity + real(DP), dimension(NDIM,nbody) :: rb !! Barycentric position + real(DP), dimension(NDIM,nbody) :: vb !! Barycentric velocity + real(DP), dimension(NDIM,nbody) :: rot !! rotation vectors of fragments + real(DP), dimension(NDIM,nbody) :: Ip !! Principal axes moment of inertia for fragments + real(DP), dimension(nbody) :: mass !! masses of fragments + real(DP), dimension(nbody) :: radius !! Radii of fragments + real(DP), dimension(nbody) :: density !! Radii of fragments + real(DP), dimension(NDIM,nbody) :: rc !! Position vectors in the collision coordinate frame + real(DP), dimension(NDIM,nbody) :: vc !! Velocity vectors in the collision coordinate frame + real(DP), dimension(nbody) :: rmag !! Array of radial distance magnitudes of individual fragments in the collisional coordinate frame + real(DP), dimension(nbody) :: vmag !! Array of radial distance magnitudes of individual fragments in the collisional coordinate frame + real(DP), dimension(nbody) :: rotmag !! Array of rotation magnitudes of individual fragments + real(DP), dimension(NDIM,nbody) :: v_r_unit !! Array of radial direction unit vectors of individual fragments in the collisional coordinate frame + real(DP), dimension(NDIM,nbody) :: v_t_unit !! Array of tangential direction unit vectors of individual fragments in the collisional coordinate frame + real(DP), dimension(NDIM,nbody) :: v_n_unit !! Array of normal direction unit vectors of individual fragments in the collisional coordinate frame + integer(I1B), dimension(nbody) :: origin_body !! Array of indices indicating which impactor body (1 or 2) the fragment originates from contains procedure :: reset => collision_util_reset_fragments !! Deallocates all allocatable arrays and sets everything else to 0 final :: collision_final_fragments !! Finalizer deallocates all allocatables @@ -253,10 +256,9 @@ module subroutine collision_generate_simple(self, nbody_system, param, t) real(DP), intent(in) :: t !! The time of the collision end subroutine collision_generate_simple - module subroutine collision_generate_simple_pos_vec(collider, r_max_start) + module subroutine collision_generate_simple_pos_vec(collider) implicit none class(collision_simple_disruption), intent(inout) :: collider !! Collision system object - real(DP), intent(in) :: r_max_start !! The maximum radial distance of fragments for disruptive collisions end subroutine collision_generate_simple_pos_vec module subroutine collision_generate_simple_rot_vec(collider) diff --git a/src/collision/collision_resolve.f90 b/src/collision/collision_resolve.f90 index f29e6abce..9e7e1e468 100644 --- a/src/collision/collision_resolve.f90 +++ b/src/collision/collision_resolve.f90 @@ -179,10 +179,10 @@ module subroutine collision_resolve_extract_plpl(self, nbody_system, param) class is (swiftest_nbody_system) select type (pl => nbody_system%pl) class is (swiftest_pl) - associate(plpl_encounter => self, idx1 => self%index1, idx2 => self%index2, plparent => pl%kin%parent) - nplplenc = plpl_encounter%nenc + associate(idx1 => self%index1, idx2 => self%index2, plparent => pl%kin%parent) + nplplenc = self%nenc allocate(lplpl_collision(nplplenc)) - lplpl_collision(:) = plpl_encounter%status(1:nplplenc) == COLLIDED + lplpl_collision(:) = self%status(1:nplplenc) == COLLIDED if (.not.any(lplpl_collision)) return ! Collisions have been detected in this step. So we need to determine which of them are between unique bodies. @@ -221,7 +221,7 @@ module subroutine collision_resolve_extract_plpl(self, nbody_system, param) ! Create a mask that contains only the pl-pl encounters that did not result in a collision, and then discard them lplpl_collision(:) = .false. lplpl_collision(collision_idx(:)) = .true. - call plpl_encounter%spill(nbody_system%plpl_collision, lplpl_collision, ldestructive=.true.) ! Extract any encounters that are not collisions from the list. + call self%spill(nbody_system%plpl_collision, lplpl_collision, ldestructive=.true.) ! Extract any encounters that are not collisions from the list. end associate end select end select @@ -483,9 +483,9 @@ module subroutine collision_resolve_plpl(self, nbody_system, param, t, dt, irec) !! implicit none ! Arguments - class(collision_list_plpl), intent(inout) :: self !! Swiftest pl-pl encounter list - class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object - class(base_parameters), intent(inout) :: param !! Current run configuration parameters with Swiftest additions + class(collision_list_plpl), intent(inout) :: self !! Swiftest pl-pl encounter list + class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object + class(base_parameters), intent(inout) :: param !! Current run configuration parameters with Swiftest additions real(DP), intent(in) :: t !! Current simulation time real(DP), intent(in) :: dt !! Current simulation step size integer(I4B), intent(in) :: irec !! Current recursion level @@ -504,7 +504,7 @@ module subroutine collision_resolve_plpl(self, nbody_system, param, t, dt, irec) class is (swiftest_pl) select type(param) class is (swiftest_parameters) - associate(plpl_encounter => self, plpl_collision => nbody_system%plpl_collision, & + associate(plpl_collision => nbody_system%plpl_collision, & collision_history => nbody_system%collision_history, pl => nbody_system%pl, cb => nbody_system%cb, & collider => nbody_system%collider, fragments => nbody_system%collider%fragments, impactors => nbody_system%collider%impactors) if (plpl_collision%nenc == 0) return ! No collisions to resolve @@ -562,7 +562,7 @@ module subroutine collision_resolve_plpl(self, nbody_system, param, t, dt, irec) call nbody_system%pl_adds%setup(0, param) ! Check whether or not any of the particles that were just added are themselves in a collision state. This will generate a new plpl_collision - call plpl_encounter%collision_check(nbody_system, param, t, dt, irec, lplpl_collision) + call self%collision_check(nbody_system, param, t, dt, irec, lplpl_collision) if (.not.lplpl_collision) exit if (loop == MAXCASCADE) then diff --git a/src/collision/collision_util.f90 b/src/collision/collision_util.f90 index d1cd1bf99..76b48ea9e 100644 --- a/src/collision/collision_util.f90 +++ b/src/collision/collision_util.f90 @@ -455,12 +455,23 @@ module subroutine collision_util_set_coordinate_impactors(self) mtot = sum(impactors%mass(:)) impactors%rbcom(:) = (impactors%mass(1) * impactors%rb(:,1) + impactors%mass(2) * impactors%rb(:,2)) / mtot impactors%vbcom(:) = (impactors%mass(1) * impactors%vb(:,1) + impactors%mass(2) * impactors%vb(:,2)) / mtot + + ! The center of mass coordinate position and velocities + impactors%rc(:,1) = impactors%rb(:,1) - impactors%rbcom(:) + impactors%rc(:,2) = impactors%rb(:,2) - impactors%rbcom(:) + impactors%vc(:,1) = impactors%vb(:,1) - impactors%vbcom(:) + impactors%vc(:,2) = impactors%vb(:,2) - impactors%vbcom(:) ! Find the point of impact between the two bodies - impactors%rbimp(:) = impactors%rb(:,1) + impactors%radius(1) * impactors%y_unit(:) + impactors%rbimp(:) = impactors%rb(:,1) + impactors%radius(1) * impactors%y_unit(:) - impactors%rbcom(:) + + ! Set the velocity direction as the "bounce" direction" for disruptions, and body 2's direction for hit and runs + if (impactors%regime == COLLRESOLVE_REGIME_HIT_AND_RUN) then + impactors%bounce_unit(:) = .unit. impactors%vc(:,2) + else + impactors%bounce_unit(:) = .unit. (impactors%vc(:,2) - 2 * dot_product(impactors%vc(:,2),impactors%y_unit(:)) * impactors%y_unit(:)) + end if - ! The "bounce" unit vector is the projection of the velocity vector into the distance vector - impactors%vbimp(:) = dot_product(delta_v(:),impactors%y_unit(:)) * impactors%y_unit(:) end associate return @@ -478,10 +489,10 @@ module subroutine collision_util_set_mass_dist(self, param) class(collision_simple_disruption), intent(inout) :: self !! Fraggle collision system object class(base_parameters), intent(in) :: param !! Current Swiftest run configuration parameters ! Internals - integer(I4B) :: i, jproj, jtarg, nfrag, istart + integer(I4B) :: i, j, jproj, jtarg, nfrag, istart real(DP), dimension(2) :: volume real(DP), dimension(NDIM) :: Ip_avg - real(DP) :: mfrag, mremaining, min_mfrag, mtot + real(DP) :: mfrag, mremaining, min_mfrag, mtot, mcumul real(DP), parameter :: BETA = 2.85_DP integer(I4B), parameter :: NFRAGMAX = 100 !! Maximum number of fragments that can be generated integer(I4B), parameter :: NFRAGMIN = 7 !! Minimum number of fragments that can be generated (set by the fraggle_generate algorithm for constraining momentum and energy) @@ -489,6 +500,7 @@ module subroutine collision_util_set_mass_dist(self, param) integer(I4B), parameter :: iMlr = 1 integer(I4B), parameter :: iMslr = 2 integer(I4B), parameter :: iMrem = 3 + logical :: flipper associate(impactors => self%impactors) ! Get mass weighted mean of Ip and density @@ -596,7 +608,31 @@ module subroutine collision_util_set_mass_dist(self, param) fragments%Ip(:, i) = Ip_avg(:) end do + ! For catastrophic impacts, we will assign each of the n>2 fragments to one of the two original bodies so that the fragment cloud occupies + ! roughly the same space as both original bodies. For all other disruption cases, we use body 2 as the center of the cloud. + fragments%origin_body(1) = 1 + fragments%origin_body(2) = 2 + if (impactors%regime == COLLRESOLVE_REGIME_SUPERCATASTROPHIC) then + mcumul = fragments%mass(1) + flipper = .true. + j = 2 + do i = 1, nfrag + if (flipper .and. (mcumul < impactors%mass(1))) then + flipper = .false. + j = 1 + else + j = 2 + flipper = .true. + end if + fragments%origin_body(i) = j + end do + else + fragments%origin_body(3:nfrag) = 2 + end if + end select + + end associate return diff --git a/src/fraggle/fraggle_generate.f90 b/src/fraggle/fraggle_generate.f90 index 0d8331970..21a297c08 100644 --- a/src/fraggle/fraggle_generate.f90 +++ b/src/fraggle/fraggle_generate.f90 @@ -94,7 +94,7 @@ module subroutine fraggle_generate_disrupt(self, nbody_system, param, t, lfailur lfailure_local = .false. call ieee_set_flag(ieee_all, .false.) ! Set all fpe flags to quiet - call collision_generate_simple_pos_vec(self, r_max_start) + call collision_generate_simple_pos_vec(self) call self%set_coordinate_system() ! Initial velocity guess will be the barycentric velocity of the colliding nbody_system so that the budgets are based on the much smaller collisional-frame velocities diff --git a/src/fraggle/fraggle_util.f90 b/src/fraggle/fraggle_util.f90 index 2e2e55961..43823642c 100644 --- a/src/fraggle/fraggle_util.f90 +++ b/src/fraggle/fraggle_util.f90 @@ -211,7 +211,7 @@ module subroutine fraggle_util_set_natural_scale_factors(self) impactors%rbcom(:) = impactors%rbcom(:) / collider%dscale impactors%vbcom(:) = impactors%vbcom(:) / collider%vscale impactors%rbimp(:) = impactors%rbimp(:) / collider%dscale - impactors%vbimp(:) = impactors%vbimp(:) / collider%vscale + impactors%bounce_unit(:) = impactors%bounce_unit(:) / collider%vscale impactors%rb(:,:) = impactors%rb(:,:) / collider%dscale impactors%vb(:,:) = impactors%vb(:,:) / collider%vscale impactors%mass(:) = impactors%mass(:) / collider%mscale @@ -254,7 +254,7 @@ module subroutine fraggle_util_set_original_scale_factors(self) impactors%rbcom(:) = impactors%rbcom(:) * collider%dscale impactors%vbcom(:) = impactors%vbcom(:) * collider%vscale impactors%rbimp(:) = impactors%rbimp(:) * collider%dscale - impactors%vbimp(:) = impactors%vbimp(:) * collider%vscale + impactors%bounce_unit(:) = impactors%bounce_unit(:) * collider%vscale impactors%mass = impactors%mass * collider%mscale impactors%radius = impactors%radius * collider%dscale diff --git a/src/swiftest/swiftest_util.f90 b/src/swiftest/swiftest_util.f90 index 2d207b1f7..b17dce303 100644 --- a/src/swiftest/swiftest_util.f90 +++ b/src/swiftest/swiftest_util.f90 @@ -1661,8 +1661,6 @@ module subroutine swiftest_util_rearray_pl(self, nbody_system, param) logical, dimension(:), allocatable :: lmask, ldump_mask class(encounter_list), allocatable :: plplenc_old logical :: lencounter - integer(I4B), dimension(:), allocatable :: levelg_orig_pl, levelm_orig_pl, levelg_orig_tp, levelm_orig_tp - integer(I4B), dimension(:), allocatable :: nplenc_orig_pl, nplenc_orig_tp, ntpenc_orig_pl associate(pl => self, tp => nbody_system%tp, pl_adds => nbody_system%pl_adds) @@ -1742,23 +1740,9 @@ module subroutine swiftest_util_rearray_pl(self, nbody_system, param) class is (symba_pl) select type(tp) class is (symba_tp) - ! allocate(levelg_orig_pl, source=pl%levelg) - ! allocate(levelm_orig_pl, source=pl%levelm) - ! allocate(nplenc_orig_tp, source=tp%nplenc) - ! call move_alloc(levelg_orig_pl, pl%levelg) - ! call move_alloc(levelm_orig_pl, pl%levelm) - ! call move_alloc(nplenc_orig_pl, pl%nplenc) lencounter = pl%encounter_check(param, nbody_system, param%dt, nbody_system%irec) if (tp%nbody > 0) then - ! allocate(levelg_orig_tp, source=tp%levelg) - ! allocate(levelm_orig_tp, source=tp%levelm) - ! allocate(nplenc_orig_tp, source=tp%nplenc) - ! allocate(ntpenc_orig_pl, source=pl%ntpenc) lencounter = tp%encounter_check(param, nbody_system, param%dt, nbody_system%irec) - ! call move_alloc(levelg_orig_tp, tp%levelg) - ! call move_alloc(levelm_orig_tp, tp%levelm) - ! call move_alloc(nplenc_orig_tp, tp%nplenc) - ! call move_alloc(ntpenc_orig_pl, pl%ntpenc) end if end select end select @@ -2523,7 +2507,11 @@ module subroutine swiftest_util_set_rhill(self,cb) if (self%nbody == 0) return call self%xv2el(cb) - self%rhill(1:self%nbody) = self%a(1:self%nbody) * (self%Gmass(1:self%nbody) / cb%Gmass / 3)**THIRD + where(self%a(1:self%nbody) > 0.0_DP) + self%rhill(1:self%nbody) = self%a(1:self%nbody) * (self%Gmass(1:self%nbody) / cb%Gmass / 3)**THIRD + elsewhere + self%rhill(1:self%nbody) = (.mag.self%rh(:,1:self%nbody)) * (self%Gmass(1:self%nbody) / cb%Gmass / 3)**THIRD + end where return end subroutine swiftest_util_set_rhill From e9cfe2367ab13ecaecd5a0e0ea018354dffc0836 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Mon, 26 Dec 2022 08:46:14 -0500 Subject: [PATCH 526/569] Added pure vs non pure hit and run examples --- examples/Fragmentation/Fragmentation_Movie.py | 34 ++++++++++++------- 1 file changed, 22 insertions(+), 12 deletions(-) diff --git a/examples/Fragmentation/Fragmentation_Movie.py b/examples/Fragmentation/Fragmentation_Movie.py index 317ff7de7..88ced4615 100644 --- a/examples/Fragmentation/Fragmentation_Movie.py +++ b/examples/Fragmentation/Fragmentation_Movie.py @@ -36,8 +36,8 @@ # ---------------------------------------------------------------------------------------------------------------------- # Define the names and initial conditions of the various fragmentation simulation types # ---------------------------------------------------------------------------------------------------------------------- -available_movie_styles = ["disruption_headon", "disruption_off_axis", "supercatastrophic_headon", "supercatastrophic_off_axis","hitandrun"] -movie_title_list = ["Head-on Disruption", "Off-axis Disruption", "Head-on Supercatastrophic", "Off-axis Supercatastrophic", "Hit and Run"] +available_movie_styles = ["disruption_headon", "disruption_off_axis", "supercatastrophic_headon", "supercatastrophic_off_axis","hitandrun_disrupt", "hitandrun_pure"] +movie_title_list = ["Head-on Disruption", "Off-axis Disruption", "Head-on Supercatastrophic", "Off-axis Supercatastrophic", "Hit and Run w/ Runner Disruption", "Pure Hit and Run"] movie_titles = dict(zip(available_movie_styles, movie_title_list)) # These initial conditions were generated by trial and error @@ -50,8 +50,10 @@ np.array([1.0, 5.0e-05, 0.0])], "supercatastrophic_off_axis": [np.array([1.0, -5.0e-05, 0.0]), np.array([1.0, 5.0e-05, 0.0])], - "hitandrun" : [np.array([1.0, -4.2e-05, 0.0]), - np.array([1.0, 4.2e-05, 0.0])] + "hitandrun_disrupt" : [np.array([1.0, -4.2e-05, 0.0]), + np.array([1.0, 4.2e-05, 0.0])], + "hitandrun_pure" : [np.array([1.0, -4.2e-05, 0.0]), + np.array([1.0, 4.2e-05, 0.0])] } vel_vectors = {"disruption_headon" : [np.array([ 0.00, 6.280005, 0.0]), @@ -62,8 +64,10 @@ np.array([ 0.00, -6.28, 0.0])], "supercatastrophic_off_axis": [np.array([ 0.00, 6.28, 0.0]), np.array([ 0.50, -6.28, 0.0])], - "hitandrun" : [np.array([ 0.00, 6.28, 0.0]), - np.array([-1.45, -6.28, 0.0])] + "hitandrun_disrupt" : [np.array([ 0.00, 6.28, 0.0]), + np.array([-1.45, -6.28, 0.0])], + "hitandrun_pure" : [np.array([ 0.00, 6.28, 0.0]), + np.array([-1.50, -6.28, 0.0])] } rot_vectors = {"disruption_headon" : [np.array([0.0, 0.0, 0.0]), @@ -74,7 +78,9 @@ np.array([0.0, 0.0, 0.0])], "supercatastrophic_off_axis": [np.array([0.0, 0.0, -6.0e4]), np.array([0.0, 0.0, 1.0e5])], - "hitandrun" : [np.array([0.0, 0.0, 6.0e4]), + "hitandrun_disrupt" : [np.array([0.0, 0.0, 6.0e4]), + np.array([0.0, 0.0, 1.0e5])], + "hitandrun_pure" : [np.array([0.0, 0.0, 6.0e4]), np.array([0.0, 0.0, 1.0e5])] } @@ -82,7 +88,8 @@ "disruption_off_axis" : [1e-7, 1e-10], "supercatastrophic_headon": [1e-7, 1e-8], "supercatastrophic_off_axis": [1e-7, 1e-8], - "hitandrun" : [1e-7, 7e-10] + "hitandrun_disrupt" : [1e-7, 7e-10], + "hitandrun_pure" : [1e-7, 7e-10] } density = 3000 * swiftest.AU2M**3 / swiftest.MSun @@ -91,7 +98,8 @@ for k,v in body_Gmass.items(): body_radius[k] = [((Gmass/GU)/(4./3.*np.pi*density))**(1./3.) for Gmass in v] -body_radius["hitandrun"] = [7e-6, 3.25e-6] +body_radius["hitandrun_disrupt"] = [7e-6, 3.25e-6] +body_radius["hitandrun_pure"] = [7e-6, 3.25e-6] # ---------------------------------------------------------------------------------------------------------------------- # Define the animation class that will generate the movies of the fragmentation outcomes @@ -202,17 +210,19 @@ def data_stream(self, frame=0): print("2. Off-axis disruption") print("3. Head-on supercatastrophic") print("4. Off-axis supercatastrophic") - print("5. Hit and run") - print("6. All of the above") + print("5. Hit and run with disruption of the runner") + print("6. Pure hit and run") + print("7. All of the above") user_selection = int(input("? ")) - if user_selection > 0 and user_selection < 6: + if user_selection > 0 and user_selection < 7: movie_styles = [available_movie_styles[user_selection-1]] else: print("Generating all movie styles") movie_styles = available_movie_styles.copy() for style in movie_styles: + print(f"Generating {movie_titles[style]}") movie_filename = f"{style}.mp4" # Pull in the Swiftest output data from the parameter file and store it as a Xarray dataset. sim = swiftest.Simulation(simdir=style, rotation=True, init_cond_format = "XV", compute_conservation_values=True) From b190d037e14b1325b5840a894ac431dab0b96abf Mon Sep 17 00:00:00 2001 From: David A Minton Date: Mon, 26 Dec 2022 08:50:12 -0500 Subject: [PATCH 527/569] Improved disruptive hit and run by removing the velocity dispersion of runner fragments (kept the rotational shear though) --- src/collision/collision_generate.f90 | 11 ++++++++--- 1 file changed, 8 insertions(+), 3 deletions(-) diff --git a/src/collision/collision_generate.f90 b/src/collision/collision_generate.f90 index 16e0c39b7..3683346fb 100644 --- a/src/collision/collision_generate.f90 +++ b/src/collision/collision_generate.f90 @@ -559,15 +559,20 @@ module subroutine collision_generate_simple_vel_vec(collider) fragments%vc(:,1) = .mag.impactors%vc(:,1) * impactors%bounce_unit(:) do concurrent(i = 2:nfrag) - rimp(:) = fragments%rc(:,i) - impactors%rbimp(:) - vimp_unit(:) = .unit. rimp(:) j = fragments%origin_body(i) vrot(:) = impactors%rot(:,j) .cross. (fragments%rc(:,i) - impactors%rb(:,j) + impactors%rbcom(:)) vmag = .mag.impactors%vc(:,j) * vscale(i) - fragments%vc(:,i) = vmag * 0.5_DP * (impactors%bounce_unit(:) + vimp_unit(:)) * vsign(i) + vrot(:) + if (lhitandrun) then + fragments%vc(:,i) = vmag * 0.5_DP * impactors%bounce_unit(:) * vsign(i) + vrot(:) + else + ! Add more velocity dispersion to disruptions vs hit and runs. + rimp(:) = fragments%rc(:,i) - impactors%rbimp(:) + vimp_unit(:) = .unit. rimp(:) + fragments%vc(:,i) = vmag * 0.5_DP * (impactors%bounce_unit(:) + vimp_unit(:)) * vsign(i) + vrot(:) + end if end do do concurrent(i = 1:nfrag) fragments%vb(:,i) = fragments%vc(:,i) + impactors%vbcom(:) From 112e04866cab6aa9db11de6c77af0bc1dd1fd7d2 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Tue, 27 Dec 2022 11:32:28 -0500 Subject: [PATCH 528/569] Started a simplified Fraggle. There are some issues with it (probably related to energy/momentum budgets) but the infrastructure is in place. --- examples/Fragmentation/Fragmentation_Movie.py | 2 +- src/collision/collision_generate.f90 | 39 +- src/collision/collision_module.f90 | 3 +- src/collision/collision_util.f90 | 15 +- src/fraggle/fraggle_generate.f90 | 513 ++++-------------- src/fraggle/fraggle_module.f90 | 16 +- src/fraggle/fraggle_util.f90 | 49 +- src/misc/minimizer_module.f90 | 15 +- 8 files changed, 210 insertions(+), 442 deletions(-) diff --git a/examples/Fragmentation/Fragmentation_Movie.py b/examples/Fragmentation/Fragmentation_Movie.py index 88ced4615..ebad58734 100644 --- a/examples/Fragmentation/Fragmentation_Movie.py +++ b/examples/Fragmentation/Fragmentation_Movie.py @@ -232,7 +232,7 @@ def data_stream(self, frame=0): # Set fragmentation parameters minimum_fragment_gmass = 0.2 * body_Gmass[style][1] # Make the minimum fragment mass a fraction of the smallest body gmtiny = 0.99 * body_Gmass[style][1] # Make GMTINY just smaller than the smallest original body. This will prevent runaway collisional cascades - sim.set_parameter(collision_model="simple", encounter_save="both", gmtiny=gmtiny, minimum_fragment_gmass=minimum_fragment_gmass, verbose=False) + sim.set_parameter(collision_model="fraggle", encounter_save="both", gmtiny=gmtiny, minimum_fragment_gmass=minimum_fragment_gmass, verbose=False) sim.run(dt=1e-3, tstop=1.0e-3, istep_out=1, dump_cadence=0) print("Generating animation") diff --git a/src/collision/collision_generate.f90 b/src/collision/collision_generate.f90 index 3683346fb..978dfdcff 100644 --- a/src/collision/collision_generate.f90 +++ b/src/collision/collision_generate.f90 @@ -141,7 +141,9 @@ module subroutine collision_generate_hitandrun(self, nbody_system, param, t) call self%set_mass_dist(param) ! Generate the position and velocity distributions of the fragments + call self%get_energy_and_momentum(nbody_system, param, lbefore=.true.) call self%disrupt(nbody_system, param, t, lpure) + call self%get_energy_and_momentum(nbody_system, param, lbefore=.false.) dpe = self%pe(2) - self%pe(1) nbody_system%Ecollisions = nbody_system%Ecollisions - dpe @@ -227,7 +229,9 @@ module subroutine collision_generate_simple(self, nbody_system, param, t) call util_exit(FAILURE) end select call self%set_mass_dist(param) + call self%get_energy_and_momentum(nbody_system, param, lbefore=.true.) call self%disrupt(nbody_system, param, t) + call self%get_energy_and_momentum(nbody_system, param, lbefore=.false.) dpe = self%pe(2) - self%pe(1) nbody_system%Ecollisions = nbody_system%Ecollisions - dpe @@ -376,12 +380,11 @@ module subroutine collision_generate_disrupt(self, nbody_system, param, t, lfail logical, optional, intent(out) :: lfailure ! Internals - call self%get_energy_and_momentum(nbody_system, param, lbefore=.true.) call collision_generate_simple_pos_vec(self) call self%set_coordinate_system() call collision_generate_simple_vel_vec(self) call collision_generate_simple_rot_vec(self) - call self%get_energy_and_momentum(nbody_system, param, lbefore=.false.) + return end subroutine collision_generate_disrupt @@ -481,28 +484,34 @@ module subroutine collision_generate_simple_rot_vec(collider) ! Arguments class(collision_basic), intent(inout) :: collider !! Fraggle collision system object ! Internals - real(DP), dimension(NDIM) :: Lresidual + real(DP), dimension(NDIM) :: Lresidual, Lbefore, Lafter, Lspin, rot integer(I4B) :: i associate(fragments => collider%fragments, impactors => collider%impactors, nfrag => collider%fragments%nbody) fragments%rot(:,:) = 0.0_DP - ! Keep the first two bodies spinning as before to start with - Lresidual(:) = 0.0_DP - do i = 1,2 - fragments%rot(:,i) = impactors%Lspin(:,i) / (fragments%mass(i) * fragments%radius(i)**2 * fragments%Ip(3,i)) - Lresidual(:) = Lresidual(:) + impactors%Lorbit(:,i) - end do + ! Torque the first body based on the change in angular momentum betwen the pre- and post-impact system + Lbefore(:) = impactors%mass(2) * (impactors%rb(:,2) - impactors%rb(:,1)) .cross. (impactors%vb(:,2) - impactors%vb(:,1)) - ! Compute the current orbital angular momentum - do i = 1, nfrag - Lresidual(:) = Lresidual(:) - fragments%mass(i) * (fragments%rc(:,i) .cross. fragments%vc(:,i)) + Lafter(:) = 0.0_DP + do i = 2, nfrag + Lafter(:) = Lafter(:) + fragments%mass(i) * (fragments%rb(:,i) - fragments%rb(:,1)) .cross. (fragments%vb(:,i) - fragments%vb(:,1)) end do + Lspin(:) = impactors%Lspin(:,1) + (Lbefore(:) - Lafter(:)) + + fragments%rot(:,1) = Lspin(:) / (fragments%mass(1) * fragments%radius(1)**2 * fragments%Ip(3,1)) + + Lresidual(:) = sum(impactors%Lspin(:,:) + impactors%Lorbit(:,:), dim=2) - Lspin(:) + + ! Randomize the rotational vector direction of the n>1 fragments and distribute the residual momentum amongst them + call random_number(fragments%rot(:,2:nfrag)) + rot(:) = Lresidual(:) / sum(fragments%mass(2:nfrag) * fragments%radius(2:nfrag)**2 * fragments%Ip(3,2:nfrag)) + + fragments%rot(:,2:nfrag) = .unit. fragments%rot(:,2:nfrag) * .mag. rot(:) - ! Distributed most of the remaining angular momentum amongst all the particles if (.mag.(Lresidual(:)) > tiny(1.0_DP)) then - do i = 1,nfrag - fragments%rot(:,i) = fragments%rot(:,i) + Lresidual(:) / (nfrag * fragments%mass(i) * fragments%radius(i)**2 * fragments%Ip(3,i)) + do i = 2,nfrag + fragments%rot(:,i) = fragments%rot(:,i) + Lresidual(:) / ((nfrag - 1) * fragments%mass(i) * fragments%radius(i)**2 * fragments%Ip(3,i)) end do end if diff --git a/src/collision/collision_module.f90 b/src/collision/collision_module.f90 index c0df619c5..cfac7b49f 100644 --- a/src/collision/collision_module.f90 +++ b/src/collision/collision_module.f90 @@ -498,8 +498,7 @@ subroutine collision_final_fragments(self) ! Arguments type(collision_fragments(*)), intent(inout) :: self - call self%reset() - + if (allocated(self%info)) deallocate(self%info) return end subroutine collision_final_fragments diff --git a/src/collision/collision_util.f90 b/src/collision/collision_util.f90 index 76b48ea9e..4a8ee6b74 100644 --- a/src/collision/collision_util.f90 +++ b/src/collision/collision_util.f90 @@ -191,8 +191,7 @@ module subroutine collision_util_get_energy_momentum(self, nbody_system, param, ! Internals class(base_nbody_system), allocatable, save :: tmpsys class(base_parameters), allocatable, save :: tmpparam - integer(I4B) :: npl_before, npl_after, stage - + integer(I4B) :: npl_before, npl_after, stage,i select type(nbody_system) class is (swiftest_nbody_system) select type(param) @@ -226,7 +225,11 @@ module subroutine collision_util_get_energy_momentum(self, nbody_system, param, ! Build the exluded body logical mask for the *after* case: Only the new bodies are used to compute energy and momentum call self%add_fragments(tmpsys, tmpparam) tmpsys%pl%status(impactors%id(1:impactors%ncoll)) = INACTIVE - tmpsys%pl%status(npl_before+1:npl_after) = ACTIVE + do concurrent(i = npl_before+1:npl_after) + tmpsys%pl%status(i) = ACTIVE + tmpsys%pl%rot(:,i) = 0.0_DP + tmpsys%pl%vb(:,i) = impactors%vbcom(:) + end do end select end if select type(tmpsys) @@ -234,7 +237,8 @@ module subroutine collision_util_get_energy_momentum(self, nbody_system, param, if (param%lflatten_interactions) call tmpsys%pl%flatten(param) - call tmpsys%get_energy_and_momentum(param) + call tmpsys%get_energy_and_momentum(param) + ! Calculate the current fragment energy and momentum balances if (lbefore) then @@ -248,8 +252,7 @@ module subroutine collision_util_get_energy_momentum(self, nbody_system, param, self%ke_orbit(stage) = tmpsys%ke_orbit self%ke_spin(stage) = tmpsys%ke_spin self%pe(stage) = tmpsys%pe - self%Etot(stage) = tmpsys%te - if (stage == 2) self%Etot(stage) = self%Etot(stage) - (self%pe(2) - self%pe(1)) ! Gotta be careful with PE when number of bodies changes. + self%Etot(stage) = tmpsys%ke_orbit + tmpsys%ke_spin end select end associate end select diff --git a/src/fraggle/fraggle_generate.f90 b/src/fraggle/fraggle_generate.f90 index 21a297c08..7ca7cac06 100644 --- a/src/fraggle/fraggle_generate.f90 +++ b/src/fraggle/fraggle_generate.f90 @@ -12,9 +12,8 @@ use symba integer(I4B), parameter :: NFRAG_MIN = 7 !! The minimum allowable number of fragments (set to 6 because that's how many unknowns are needed in the tangential velocity calculation) - real(DP), parameter :: F_SPIN_FIRST = 0.05_DP !! The initial try value of the fraction of energy or momenum in spin (whichever has the lowest kinetic energy) - real(DP), parameter :: FRAGGLE_LTOL = 10 * epsilon(1.0_DP) - real(DP), parameter :: FRAGGLE_ETOL = 1e-8_DP + real(DP), parameter :: FRAGGLE_LTOL = 1e-4_DP !10 * epsilon(1.0_DP) + real(DP), parameter :: FRAGGLE_ETOL = 1e-1_DP contains @@ -31,10 +30,9 @@ module subroutine fraggle_generate_disrupt(self, nbody_system, param, t, lfailur real(DP), intent(in) :: t !! Time of collision logical, optional, intent(out) :: lfailure !! Answers the question: Should this have been a merger instead? ! Internals - integer(I4B) :: i integer(I4B) :: try - real(DP) :: r_max_start, f_spin, dEtot, dLmag - integer(I4B), parameter :: MAXTRY = 100 + real(DP) :: dEtot, dLmag + integer(I4B), parameter :: MAXTRY = 10 logical :: lk_plpl, lfailure_local logical, dimension(size(IEEE_ALL)) :: fpe_halting_modes, fpe_quiet_modes logical, dimension(size(IEEE_USUAL)) :: fpe_flag @@ -69,66 +67,38 @@ module subroutine fraggle_generate_disrupt(self, nbody_system, param, t, lfailur else lk_plpl = .false. end if + call ieee_set_flag(ieee_all, .false.) ! Set all fpe flags to quiet call self%set_natural_scale() call fragments%reset() - ! Calculate the initial energy of the nbody_system without the collisional family - call self%get_energy_and_momentum(nbody_system, param, lbefore=.true.) - - ! Start out the fragments close to the initial separation distance. This will be increased if there is any overlap or we fail to find a solution - r_max_start = 1.1_DP * .mag.(impactors%rb(:,2) - impactors%rb(:,1)) lfailure_local = .false. try = 1 - f_spin = F_SPIN_FIRST + do while (try < MAXTRY) write(message,*) try call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Fraggle try " // trim(adjustl(message))) if (lfailure_local) then - call fragments%restructure(impactors, try, f_spin, r_max_start) + !call fragments%restructure(impactors, try, f_spin, r_max_start) call fragments%reset() try = try + 1 end if - lfailure_local = .false. - call ieee_set_flag(ieee_all, .false.) ! Set all fpe flags to quiet - - call collision_generate_simple_pos_vec(self) - call self%set_coordinate_system() - - ! Initial velocity guess will be the barycentric velocity of the colliding nbody_system so that the budgets are based on the much smaller collisional-frame velocities - do concurrent (i = 1:nfrag) - fragments%vb(:, i) = impactors%vbcom(:) - end do + ! Use the simple collision model to generate initial conditions + ! Compute the "before" energy/momentum and the budgets + call self%get_energy_and_momentum(nbody_system, param, lbefore=.true.) + call self%collision_simple_disruption%disrupt(nbody_system, param, t) call self%get_energy_and_momentum(nbody_system, param, lbefore=.false.) call self%set_budgets() - call collision_generate_simple_vel_vec(self) - - call fraggle_generate_tan_vel(self, lfailure_local) - if (lfailure_local) then - call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Fraggle failed to find tangential velocities") - cycle - end if - - call fraggle_generate_rad_vel(self, lfailure_local) - if (lfailure_local) then - call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Fraggle failed to find radial velocities") - cycle - end if - - call fraggle_generate_spins(self, f_spin, lfailure_local) - if (lfailure_local) then - call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Fraggle failed to find spins") - cycle - end if + ! Minimize difference between energy/momentum and budgets + call fraggle_generate_minimize(self, lfailure_local) call self%get_energy_and_momentum(nbody_system, param, lbefore=.false.) dEtot = self%Etot(2) - self%Etot(1) dLmag = .mag. (self%Ltot(:,2) - self%Ltot(:,1)) - exit lfailure_local = ((abs(dEtot + impactors%Qloss) > FRAGGLE_ETOL) .or. (dEtot > 0.0_DP)) if (lfailure_local) then @@ -136,6 +106,8 @@ module subroutine fraggle_generate_disrupt(self, nbody_system, param, t, lfailur call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Fraggle failed due to high energy error: " // & trim(adjustl(message))) cycle + lfailure_local = .false. + exit end if lfailure_local = ((abs(dLmag) / (.mag.self%Ltot(:,1))) > FRAGGLE_LTOL) @@ -178,408 +150,143 @@ module subroutine fraggle_generate_disrupt(self, nbody_system, param, t, lfailur end subroutine fraggle_generate_disrupt - subroutine fraggle_generate_spins(collider, f_spin, lfailure) - !! Author: Jennifer L.L. Pouplin, Carlisle A. Wishard, and David A. Minton - !! - !! Calculates the spins of a collection of fragments such that they conserve angular momentum without blowing the fragment kinetic energy budget. - !! - !! A failure will trigger a restructuring of the fragments so we will try new values of the radial position distribution. - implicit none - ! Arguments - class(collision_fraggle), intent(inout) :: collider !! Fraggle collision system object - real(DP), intent(in) :: f_spin !! Fraction of energy or momentum that goes into spin (whichever gives the lowest kinetic energy) - logical, intent(out) :: lfailure !! Logical flag indicating whether this step fails or succeeds! - ! Internals - real(DP), dimension(NDIM) :: L_remainder, rot_L, rot_ke, L - real(DP), dimension(NDIM,collider%fragments%nbody) :: frot_rand ! The random rotation factor applied to fragments - real(DP), parameter :: frot_rand_mag = 1.50_DP ! The magnitude of the rotation variation to apply to the fragments - integer(I4B) :: i - character(len=STRMAX) :: message - real(DP) :: ke_remainder, ke - - associate(impactors => collider%impactors, nfrag => collider%fragments%nbody) - select type(fragments => collider%fragments) - class is (fraggle_fragments(*)) - lfailure = .false. - L_remainder(:) = fragments%L_budget(:) - ke_remainder = fragments%ke_budget - - ! Add a fraction of the orbit angular momentum of the second body to the spin of the first body to kick things off - L(:) = impactors%Lspin(:,1) + f_spin * (impactors%Lorbit(:,2) + impactors%Lspin(:,2)) - fragments%rot(:,1) = L(:) / (fragments%mass(1) * fragments%radius(1)**2 * fragments%Ip(3,1)) - L_remainder(:) = L_remainder(:) - L(:) - - ! Partition the spin momentum of the second body into the spin of the fragments, with some random variation - L(:) = impactors%Lspin(:,2) / (nfrag - 1) - - call random_number(frot_rand(:,2:nfrag)) - frot_rand(:,2:nfrag) = 2 * (frot_rand(:,2:nfrag) - 0.5_DP) * frot_rand_mag - - do i = 2, nfrag - rot_L(:) = L(:) + frot_rand(:,i) * .mag.L(:) - fragments%rot(:,i) = rot_L(:) / (fragments%mass(i) * fragments%radius(i)**2 * fragments%Ip(3,1)) - L_remainder(:) = L_remainder(:) - rot_L(:) - end do - - ! Make sure we didn't blow our kinetic energy budget - do i = 1, nfrag - ke_remainder = ke_remainder - 0.5_DP * fragments%mass(i) * fragments%Ip(3, i) * fragments%radius(i)**2 * .mag.(fragments%rot(:, i)) - end do - - ! Distributed most of the remaining angular momentum amongst all the particles - fragments%ke_spin = 0.0_DP - if (.mag.(L_remainder(:)) > FRAGGLE_LTOL) then - do i = nfrag, 1, -1 - ! Convert a fraction (f_spin) of either the remaining angular momentum or kinetic energy budget into spin, whichever gives the smaller rotation so as not to blow any budgets - rot_ke(:) = sqrt(2 * f_spin * ke_remainder / (i * fragments%mass(i) * fragments%radius(i)**2 * fragments%Ip(3, i))) * L_remainder(:) / .mag.(L_remainder(:)) - rot_L(:) = f_spin * L_remainder(:) / (i * fragments%mass(i) * fragments%radius(i)**2 * fragments%Ip(3, i)) - if (.mag.(rot_ke) < .mag.(rot_L)) then - fragments%rot(:,i) = fragments%rot(:,i) + rot_ke(:) - else - fragments%rot(:, i) = fragments%rot(:,i) + rot_L(:) - end if - ke = 0.5_DP * fragments%mass(i) * fragments%Ip(3, i) * fragments%radius(i)**2 * norm2(fragments%rot(:, i)) - L(:) = fragments%mass(i) * fragments%radius(i)**2 * fragments%Ip(3, i) * fragments%rot(:, i) - ke_remainder = ke_remainder - ke - L_remainder(:) = L_remainder(:) - L(:) - fragments%ke_spin = fragments%ke_spin + ke - end do - end if - - lfailure = ((fragments%ke_budget - fragments%ke_spin - fragments%ke_orbit) < 0.0_DP) - - if (lfailure) then - call swiftest_io_log_one_message(COLLISION_LOG_OUT, " ") - call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Spin failure diagnostics") - write(message, *) fragments%ke_budget - call swiftest_io_log_one_message(COLLISION_LOG_OUT, "ke_budget : " // trim(adjustl(message))) - write(message, *) fragments%ke_spin - call swiftest_io_log_one_message(COLLISION_LOG_OUT, "ke_spin : " // trim(adjustl(message))) - write(message, *) fragments%ke_orbit - call swiftest_io_log_one_message(COLLISION_LOG_OUT, "ke_orbit : " // trim(adjustl(message))) - write(message, *) fragments%ke_budget - fragments%ke_spin - fragments%ke_orbit - call swiftest_io_log_one_message(COLLISION_LOG_OUT, "ke_remainder : " // trim(adjustl(message))) - end if - - end select - end associate - - return - end subroutine fraggle_generate_spins - - - subroutine fraggle_generate_tan_vel(collider, lfailure) + subroutine fraggle_generate_minimize(collider, lfailure) !! Author: Jennifer L.L. Pouplin, Carlisle A. Wishard, and David A. Minton !! - !! Adjusts the tangential velocities and spins of a collection of fragments such that they conserve angular momentum without blowing the fragment kinetic energy budget. - !! This procedure works in several stages, with a goal to solve the angular and linear momentum constraints on the fragments, while still leaving a positive balance of - !! our fragment kinetic energy (fragments%ke_budget) that we can put into the radial velocity distribution. - !! - !! The first thing we'll try to do is solve for the tangential velocities of the first 6 fragments, using angular and linear momentum as constraints and an initial - !! tangential velocity distribution for the remaining bodies (if there are any) that distributes their angular momentum equally between them. - !! If that doesn't work and we blow our kinetic energy budget, we will attempt to find a tangential velocity distribution that minimizes the kinetic energy while - !! conserving momentum. + !! Minimizes the differences between the energy and momentum and the budget !! - !! A failure will trigger a restructuring of the fragments so we will try new values of the radial position distribution. + !! A failure will trigger a restructuring of the fragments so we will try a new random distribution implicit none ! Arguments class(collision_fraggle), intent(inout) :: collider !! Fraggle collision system object logical, intent(out) :: lfailure !! Logical flag indicating whether this step fails or succeeds ! Internals - integer(I4B) :: i, try - real(DP), parameter :: TOL_MIN = 1e0_DP ! This doesn't have to be very accurate, as we really just want a tangential velocity distribution with less kinetic energy than our initial guess. - real(DP), parameter :: TOL_INIT = 1e-12_DP - real(DP), parameter :: VNOISE_MAG = 1e-1_DP !! Magnitude of the noise to apply to initial conditions to help minimizer find a solution in case of failure - integer(I4B), parameter :: MAXLOOP = 10 - integer(I4B), parameter :: MAXTRY = 100 - real(DP) :: tol - real(DP), dimension(:), allocatable :: v_t_initial, v_t_output - real(DP), dimension(collider%fragments%nbody) :: kefrag, vnoise - type(lambda_obj_err) :: objective_function - real(DP), dimension(NDIM) :: L_frag_tot - character(len=STRMAX) :: message - real(DP) :: ke_diff + real(DP), parameter :: TOL_MIN = 1.0e-6_DP + real(DP), parameter :: TOL_INIT = 1e-8_DP + integer(I4B), parameter :: MAXLOOP = 30 + real(DP), dimension(collider%fragments%nbody) :: input_v + real(DP), dimension(:), allocatable :: output_v + type(lambda_obj) :: Efunc + real(DP) :: tol, fval + integer(I4B) :: i, nelem + + associate(impactors => collider%impactors, nfrag => collider%fragments%nbody) + select type(fragments => collider%fragments) + class is (fraggle_fragments(*)) + + nelem = 2 * (nfrag - 1) + lfailure = .false. + ! Find the local kinetic energy minimum for the nbody_system that conserves linear and angular momentum + Efunc = lambda_obj(E_objective_function) + tol = TOL_INIT - associate(impactors => collider%impactors, nfrag => collider%fragments%nbody) - select type(fragments => collider%fragments) - class is (fraggle_fragments(*)) - lfailure = .false. + do while(tol < TOL_MIN) - allocate(v_t_initial, mold=fragments%v_t_mag) - do try = 1, MAXTRY - v_t_initial(1) = dot_product(impactors%vb(:,1),fragments%v_t_unit(:,1)) - do i = 2, nfrag - v_t_initial(i) = dot_product(impactors%vb(:,2), fragments%v_t_unit(:,i)) - end do - fragments%v_t_mag(:) = v_t_initial + fragments%v_r_unit(:,:) = .unit. fragments%vc(:,:) + fragments%vmag(:) = .mag. fragments%vc(:,:) + + input_v(:) = fragments%vmag(1:nfrag) + fval = E_objective_function(input_v) + call minimize_bfgs(Efunc, nelem, input_v, tol, MAXLOOP, lfailure, output_v) + fval = E_objective_function(output_v) + input_v(:) = output_v(:) - ! Find the local kinetic energy minimum for the nbody_system that conserves linear and angular momentum - objective_function = lambda_obj(tangential_objective_function, lfailure) + fragments%vmag(1:nfrag) = output_v(1:nfrag) - tol = TOL_INIT - do while(tol < TOL_MIN) - call minimize_bfgs(objective_function, nfrag-6, v_t_initial(7:nfrag), tol, MAXLOOP, lfailure, v_t_output) - fragments%v_t_mag(7:nfrag) = v_t_output(:) - ! Now that the KE-minimized values of the i>6 fragments are found, calculate the momentum-conserving solution for tangential velociteis - v_t_initial(7:nfrag) = fragments%v_t_mag(7:nfrag) - if (.not.lfailure) exit - tol = tol * 2_DP ! Keep increasing the tolerance until we converge on a solution - call random_number(vnoise(1:nfrag)) ! Adding a bit of noise to the initial conditions helps it find a solution more often - vnoise(:) = 1.0_DP + VNOISE_MAG * (2 * vnoise(:) - 1._DP) - v_t_initial(:) = v_t_initial(:) * vnoise(:) - end do - fragments%v_t_mag(1:nfrag) = solve_fragment_tan_vel(v_t_mag_input=v_t_initial(7:nfrag), lfailure=lfailure) + do concurrent(i=2:nfrag) + fragments%vc(:,i) = abs(fragments%vmag(i)) * fragments%v_r_unit(:,i) + end do - ! Perform one final shift of the radial velocity vectors to align with the center of mass of the collisional system (the origin) - fragments%vb(:,1:nfrag) = fraggle_util_vmag_to_vb(fragments%v_r_mag(1:nfrag), fragments%v_r_unit(:,1:nfrag), fragments%v_t_mag(1:nfrag), & - fragments%v_t_unit(:,1:nfrag), fragments%mass(1:nfrag), impactors%vbcom(:)) - do concurrent (i = 1:nfrag) - fragments%vc(:,i) = fragments%vb(:,i) - impactors%vbcom(:) - end do + call collision_util_shift_vector_to_origin(fragments%mass, fragments%vc) + ! Set spins in order to conserve angular momentum + call fraggle_generate_set_spins(fragments) - ! Now do a kinetic energy budget check to make sure we are still within the budget. - kefrag = 0.0_DP - do concurrent(i = 1:nfrag) - kefrag(i) = fragments%mass(i) * dot_product(fragments%vb(:, i), fragments%vb(:, i)) + if (.not.lfailure) exit + tol = tol * 2 ! Keep increasing the tolerance until we converge on a solution end do - fragments%ke_orbit = 0.5_DP * sum(kefrag(:)) - - ! If we are over the energy budget, flag this as a failure so we can try again - ke_diff = fragments%ke_budget - fragments%ke_spin - fragments%ke_orbit - lfailure = ke_diff < 0.0_DP - if (.not.lfailure) exit - fragments%rc(:,:) = fragments%rc(:,:) * 1.1_DP - end do - if (lfailure) then - call swiftest_io_log_one_message(COLLISION_LOG_OUT, " ") - call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Tangential velocity failure diagnostics") - call fragments%get_angular_momentum() - L_frag_tot = fragments%Lspin(:) + fragments%Lorbit(:) - write(message, *) .mag.(fragments%L_budget(:) - L_frag_tot(:)) / (.mag.collider%Ltot(:,1)) - call swiftest_io_log_one_message(COLLISION_LOG_OUT, "|L_remainder| : " // trim(adjustl(message))) - write(message, *) fragments%ke_budget - call swiftest_io_log_one_message(COLLISION_LOG_OUT, "ke_budget : " // trim(adjustl(message))) - write(message, *) fragments%ke_spin - call swiftest_io_log_one_message(COLLISION_LOG_OUT, "ke_spin : " // trim(adjustl(message))) - write(message, *) fragments%ke_orbit - call swiftest_io_log_one_message(COLLISION_LOG_OUT, "ke_tangential : " // trim(adjustl(message))) - write(message, *) fragments%ke_budget - fragments%ke_spin - fragments%ke_orbit - call swiftest_io_log_one_message(COLLISION_LOG_OUT, "ke_radial : " // trim(adjustl(message))) - end if - end select + end select end associate return contains - function solve_fragment_tan_vel(lfailure, v_t_mag_input) result(v_t_mag_output) - !! Author: Jennifer L.L. Pouplin, Carlisle A. Wishard, and David A. Minton - !! - !! Adjusts the positions, velocities, and spins of a collection of fragments such that they conserve angular momentum - implicit none - ! Arguments - logical, intent(out) :: lfailure !! Error flag - real(DP), dimension(:), optional, intent(in) :: v_t_mag_input !! Unknown tangential velocities for fragments 7:nfrag - ! Internals - integer(I4B) :: i - ! Result - real(DP), dimension(:), allocatable :: v_t_mag_output - - real(DP), dimension(2 * NDIM, 2 * NDIM) :: A ! LHS of linear equation used to solve for momentum constraint in Gauss elimination code - real(DP), dimension(2 * NDIM) :: b ! RHS of linear equation used to solve for momentum constraint in Gauss elimination code - real(DP), dimension(NDIM) :: L_lin_others, L_orb_others, L, vtmp - - select type(fragments => collider%fragments) - class is (fraggle_fragments(*)) - associate(nfrag => fragments%nbody) - lfailure = .false. - ! We have 6 constraint equations (2 vector constraints in 3 dimensions each) - ! The first 3 are that the linear momentum of the fragments is zero with respect to the collisional barycenter - ! The second 3 are that the sum of the angular momentum of the fragments is conserved from the pre-impact state - L_lin_others(:) = 0.0_DP - L_orb_others(:) = 0.0_DP - do i = 1, nfrag - if (i <= 2 * NDIM) then ! The tangential velocities of the first set of bodies will be the unknowns we will solve for to satisfy the constraints - A(1:3, i) = fragments%mass(i) * fragments%v_t_unit(:, i) - A(4:6, i) = fragments%mass(i) * fragments%rmag(i) * (fragments%v_r_unit(:, i) .cross. fragments%v_t_unit(:, i)) - else if (present(v_t_mag_input)) then - vtmp(:) = v_t_mag_input(i - 6) * fragments%v_t_unit(:, i) - L_lin_others(:) = L_lin_others(:) + fragments%mass(i) * vtmp(:) - L(:) = fragments%mass(i) * (fragments%rc(:, i) .cross. vtmp(:)) - L_orb_others(:) = L_orb_others(:) + L(:) - end if - end do - b(1:3) = -L_lin_others(:) - b(4:6) = fragments%L_budget(:) - fragments%Lspin(:) - L_orb_others(:) - allocate(v_t_mag_output(nfrag)) - v_t_mag_output(1:6) = solve_linear_system(A, b, 6, lfailure) - if (present(v_t_mag_input)) v_t_mag_output(7:nfrag) = v_t_mag_input(:) - end associate - end select - return - end function solve_fragment_tan_vel - - function tangential_objective_function(v_t_mag_input, lfailure) result(fval) + function E_objective_function(val_input) result(fval) !! Author: David A. Minton !! - !! Objective function for evaluating how close our fragment velocities get to minimizing KE error from our required value + !! Objective function for evaluating how close our fragment trajectories are to the energy budget implicit none ! Arguments - real(DP), dimension(:), intent(in) :: v_t_mag_input !! Unknown tangential component of velocity vector set previously by angular momentum constraint - logical, intent(out) :: lfailure !! Error flag + real(DP), dimension(:), intent(in) :: val_input !! Flattened velocity and rotation arrays ! Result - real(DP) :: fval + real(DP) :: fval !! The objective function result, which is the sum of the squares of the difference between the calculated fragment kinetic energy and the components of angular and linear momentum + !! Minimizing this brings us closer to our objective ! Internals integer(I4B) :: i - real(DP), dimension(NDIM,collider%fragments%nbody) :: v_shift - real(DP), dimension(collider%fragments%nbody) :: v_t_new, kearr - real(DP) :: keo - - select type(fragments => collider%fragments) - class is (fraggle_fragments(*)) - associate(impactors => collider%impactors, nfrag => fragments%nbody) - lfailure = .false. - - v_t_new(:) = solve_fragment_tan_vel(v_t_mag_input=v_t_mag_input(:), lfailure=lfailure) - v_shift(:,:) = fraggle_util_vmag_to_vb(fragments%v_r_mag, fragments%v_r_unit, v_t_new, fragments%v_t_unit, fragments%mass, impactors%vbcom) - - kearr = 0.0_DP - do concurrent(i = 1:nfrag) - kearr(i) = fragments%mass(i) * dot_product(v_shift(:, i), v_shift(:, i)) - end do - keo = 0.5_DP * sum(kearr(:)) - fval = keo - lfailure = .false. + type(fraggle_fragments(:)), allocatable :: tmp_frag + real(DP) :: deltaE + + associate(impactors => collider%impactors, nfrag => collider%fragments%nbody) + select type(fragments => collider%fragments) + class is (fraggle_fragments(*)) + allocate(tmp_frag, source=fragments) + tmp_frag%vmag(1:nfrag) = val_input(1:nfrag) + do concurrent(i=1:nfrag) + tmp_frag%vc(:,i) = abs(tmp_frag%vmag(i)) * tmp_frag%v_r_unit(:,i) + end do + + call collision_util_shift_vector_to_origin(tmp_frag%mass, tmp_frag%vc) + ! Set spins in order to conserve angular momentum + call fraggle_generate_set_spins(tmp_frag) + + ! Get the current kinetic energy of the system + call fragments%get_kinetic_energy() + deltaE = fragments%ke_budget - (fragments%ke_orbit + fragments%ke_spin) + + ! Use the deltaE as the basis of our objective function, with a higher penalty for having excess kinetic energy compared with having a deficit + if (deltaE < 0.0_DP) then + fval = deltaE**4 + else + fval = deltaE**2 + end if + + end select end associate - end select - + return - end function tangential_objective_function + end function E_objective_function - end subroutine fraggle_generate_tan_vel + end subroutine fraggle_generate_minimize - subroutine fraggle_generate_rad_vel(collider, lfailure) - !! Author: Jennifer L.L. Pouplin, Carlisle A. Wishard, and David A. Minton + + subroutine fraggle_generate_set_spins(fragments) + !! Author: David A. Minton !! - !! - !! Adjust the fragment velocities to set the fragment orbital kinetic energy. This will minimize the difference between the fragment kinetic energy and the energy budget + !! Distributes any residual angular momentum into the spins of the n>1 fragments implicit none ! Arguments - class(collision_fraggle), intent(inout) :: collider !! Fraggle collision system object - logical, intent(out) :: lfailure !! Logical flag indicating whether this step fails or succeeds! + class(fraggle_fragments(*)), intent(inout) :: fragments !! Fraggle fragment system object ! Internals - real(DP), parameter :: TOL_MIN = FRAGGLE_ETOL ! This needs to be more accurate than the tangential step, as we are trying to minimize the total residual energy - real(DP), parameter :: TOL_INIT = 1e-14_DP - real(DP), parameter :: VNOISE_MAG = 1e-10_DP !! Magnitude of the noise to apply to initial conditions to help minimizer find a solution in case of failure - integer(I4B), parameter :: MAXLOOP = 100 - real(DP) :: ke_radial, tol - integer(I4B) :: i - real(DP), dimension(:), allocatable :: v_r_initial, v_r_output - real(DP), dimension(collider%fragments%nbody) :: vnoise - type(lambda_obj) :: objective_function - character(len=STRMAX) :: message - - associate(impactors => collider%impactors, nfrag => collider%fragments%nbody) - select type(fragments => collider%fragments) - class is (fraggle_fragments(*)) - ! Set the "target" ke for the radial component - - allocate(v_r_initial, source=fragments%v_r_mag) - ! Initialize radial velocity magnitudes with a random value that related to equipartition of kinetic energy with some noise and scaled with respect to the initial distance - v_r_initial(1) = dot_product(impactors%vb(:,1),fragments%v_r_unit(:,1)) - fragments%ke_orbit = 0.5_DP * fragments%mass(1) * v_r_initial(1)**2 - - ke_radial = fragments%ke_budget - fragments%ke_spin - fragments%ke_orbit - call random_number(vnoise(1:nfrag)) - vnoise(:) = 1.0_DP + VNOISE_MAG * (2 * vnoise(:) - 1.0_DP) - v_r_initial(2:nfrag) = -sqrt(abs(2 * ke_radial) / (fragments%mass(1:nfrag) * nfrag)) * vnoise(1:nfrag) - - ! Initialize the lambda function using a structure constructor that calls the init method - ! Minimize the ke objective function using the BFGS optimizer - objective_function = lambda_obj(radial_objective_function) - tol = TOL_INIT - do while(tol < TOL_MIN) - call minimize_bfgs(objective_function, nfrag, v_r_initial, tol, MAXLOOP, lfailure, v_r_output) - fragments%v_r_mag(1:nfrag) = v_r_output(1:nfrag) - if (.not.lfailure) exit - tol = tol * 2 ! Keep increasing the tolerance until we converge on a solution - v_r_initial(:) = fragments%v_r_mag(:) - call random_number(vnoise(1:nfrag)) ! Adding a bit of noise to the initial conditions helps it find a solution more often - vnoise(:) = 1.0_DP + VNOISE_MAG * (2 * vnoise(:) - 1._DP) - v_r_initial(:) = v_r_initial(:) * vnoise(:) - end do - - ! Shift the radial velocity vectors to align with the center of mass of the collisional system (the origin) - fragments%ke_orbit = 0.0_DP - fragments%ke_spin = 0.0_DP - fragments%vb(:,1:nfrag) = fraggle_util_vmag_to_vb(fragments%v_r_mag(1:nfrag), fragments%v_r_unit(:,1:nfrag), & - fragments%v_t_mag(1:nfrag), fragments%v_t_unit(:,1:nfrag), fragments%mass(1:nfrag), impactors%vbcom(:)) - do i = 1, nfrag - fragments%vc(:, i) = fragments%vb(:, i) - impactors%vbcom(:) - fragments%ke_orbit = fragments%ke_orbit + fragments%mass(i) * norm2(fragments%vb(:, i)) - fragments%ke_spin = fragments%ke_spin + fragments%mass(i) * fragments%radius(i)**2 * fragments%Ip(3,i) * norm2(fragments%rot(:,i)) + integer(I4B) :: i + real(DP), dimension(NDIM) :: Lresidual + + call fragments%get_angular_momentum() + Lresidual(:) = fragments%L_budget(:) - (fragments%Lorbit(:) + fragments%Lspin(:)) + + ! Distribute residual angular momentum amongst the fragments + if (.mag.(Lresidual(:)) > tiny(1.0_DP)) then + do i = 2,fragments%nbody + fragments%rot(:,i) = fragments%rot(:,i) + Lresidual(:) / ((fragments%nbody - 1) * fragments%mass(i) * fragments%radius(i)**2 * fragments%Ip(3,i)) end do - fragments%ke_orbit = 0.5_DP * fragments%ke_orbit - fragments%ke_spin = 0.5_DP * fragments%ke_spin - - lfailure = abs((fragments%ke_budget - (fragments%ke_orbit + fragments%ke_spin)) / fragments%ke_budget) > FRAGGLE_ETOL - if (lfailure) then - call swiftest_io_log_one_message(COLLISION_LOG_OUT, " ") - call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Radial velocity failure diagnostics") - write(message, *) fragments%ke_budget - call swiftest_io_log_one_message(COLLISION_LOG_OUT, "ke_budget : " // trim(adjustl(message))) - write(message, *) fragments%ke_spin - call swiftest_io_log_one_message(COLLISION_LOG_OUT, "ke_spin : " // trim(adjustl(message))) - write(message, *) fragments%ke_orbit - call swiftest_io_log_one_message(COLLISION_LOG_OUT, "ke_orbit : " // trim(adjustl(message))) - write(message, *) fragments%ke_budget - (fragments%ke_orbit + fragments%ke_spin) - call swiftest_io_log_one_message(COLLISION_LOG_OUT, "ke_remainder : " // trim(adjustl(message))) - end if + end if - end select - end associate return + end subroutine fraggle_generate_set_spins + + - contains - function radial_objective_function(v_r_mag_input) result(fval) - !! Author: David A. Minton - !! - !! Objective function for evaluating how close our fragment velocities get to minimizing KE error from our required value - implicit none - ! Arguments - real(DP), dimension(:), intent(in) :: v_r_mag_input !! Unknown radial component of fragment velocity vector - ! Result - real(DP) :: fval !! The objective function result, which is the square of the difference between the calculated fragment kinetic energy and our target - !! Minimizing this brings us closer to our objective - ! Internals - integer(I4B) :: i - real(DP), dimension(:,:), allocatable :: v_shift - real(DP), dimension(collider%fragments%nbody) :: kearr - real(DP) :: keo, ke_radial, rotmag2, vmag2 - - associate(impactors => collider%impactors, nfrag => collider%fragments%nbody) - select type(fragments => collider%fragments) - class is (fraggle_fragments(*)) - allocate(v_shift, mold=fragments%vb) - v_shift(:,:) = fraggle_util_vmag_to_vb(v_r_mag_input, fragments%v_r_unit, fragments%v_t_mag, fragments%v_t_unit, fragments%mass, impactors%vbcom) - do i = 1,fragments%nbody - rotmag2 = fragments%rot(1,i)**2 + fragments%rot(2,i)**2 + fragments%rot(3,i)**2 - vmag2 = v_shift(1,i)**2 + v_shift(2,i)**2 + v_shift(3,i)**2 - kearr(i) = fragments%mass(i) * (fragments%Ip(3, i) * fragments%radius(i)**2 * rotmag2 + vmag2) - end do - keo = 2 * fragments%ke_budget - sum(kearr(:)) - ke_radial = fragments%ke_budget - fragments%ke_orbit - fragments%ke_spin - ! The following ensures that fval = 0 is a local minimum, which is what the BFGS method is searching for - fval = (keo / (2 * ke_radial))**2 - end select - end associate - - return - end function radial_objective_function - end subroutine fraggle_generate_rad_vel end submodule s_fraggle_generate diff --git a/src/fraggle/fraggle_module.f90 b/src/fraggle/fraggle_module.f90 index fe0eaf8a3..f2ad578c4 100644 --- a/src/fraggle/fraggle_module.f90 +++ b/src/fraggle/fraggle_module.f90 @@ -27,10 +27,11 @@ module fraggle real(DP) :: ke_budget !! Kinetic energy budget for computing fragment trajectories real(DP), dimension(NDIM) :: L_budget !! Angular momentum budget for computing fragment trajectories contains - procedure :: get_angular_momentum => fraggle_util_get_angular_momentum !! Calcualtes the current angular momentum of the fragments - procedure :: reset => fraggle_util_reset_fragments !! Resets all position and velocity-dependent fragment quantities in order to do a fresh calculation (does not reset mass, radius, or other values that get set prior to the call to fraggle_generate) - procedure :: restructure => fraggle_util_restructure !! Restructure the inputs after a failed attempt failed to find a set of positions and velocities that satisfy the energy and momentum constraints - final :: fraggle_final_fragments !! Finalizer will deallocate all allocatables + procedure :: get_angular_momentum => fraggle_util_get_angular_momentum !! Calcualtes the current angular momentum of the fragments + procedure :: get_kinetic_energy => fraggle_util_get_kinetic_energy !! Calcualtes the current kinetic energy of the fragments + procedure :: reset => fraggle_util_reset_fragments !! Resets all position and velocity-dependent fragment quantities in order to do a fresh calculation (does not reset mass, radius, or other values that get set prior to the call to fraggle_generate) + procedure :: restructure => fraggle_util_restructure !! Restructure the inputs after a failed attempt failed to find a set of positions and velocities that satisfy the energy and momentum constraints + final :: fraggle_final_fragments !! Finalizer will deallocate all allocatables end type fraggle_fragments @@ -84,6 +85,11 @@ module subroutine fraggle_util_get_angular_momentum(self) class(fraggle_fragments(*)), intent(inout) :: self !! Fraggle fragment system object end subroutine fraggle_util_get_angular_momentum + module subroutine fraggle_util_get_kinetic_energy(self) + implicit none + class(fraggle_fragments(*)), intent(inout) :: self !! Fraggle fragment system object + end subroutine fraggle_util_get_kinetic_energy + module subroutine fraggle_util_reset_fragments(self) implicit none class(fraggle_fragments(*)), intent(inout) :: self @@ -139,7 +145,7 @@ subroutine fraggle_final_fragments(self) ! Arguments type(fraggle_fragments(*)), intent(inout) :: self !! Fraggle encountar storage object - call self%collision_fragments%reset() + if (allocated(self%info)) deallocate(self%info) return end subroutine fraggle_final_fragments diff --git a/src/fraggle/fraggle_util.f90 b/src/fraggle/fraggle_util.f90 index 43823642c..07d845053 100644 --- a/src/fraggle/fraggle_util.f90 +++ b/src/fraggle/fraggle_util.f90 @@ -40,7 +40,7 @@ end subroutine fraggle_util_construct_temporary_system module subroutine fraggle_util_get_angular_momentum(self) !! Author: David A. Minton !! - !! Calcualtes the current angular momentum of the fragments + !! Calculates the current angular momentum of the fragments implicit none ! Arguments class(fraggle_fragments(*)), intent(inout) :: self !! Fraggle fragment system object @@ -61,6 +61,33 @@ module subroutine fraggle_util_get_angular_momentum(self) end subroutine fraggle_util_get_angular_momentum + module subroutine fraggle_util_get_kinetic_energy(self) + !! Author: David A. Minton + !! + !! Calculates the current kinetic energy of the fragments + implicit none + ! Argument + class(fraggle_fragments(*)), intent(inout) :: self !! Fraggle fragment system object + ! Internals + integer(I4B) :: i + + associate(fragments => self, nfrag => self%nbody) + fragments%ke_orbit = 0.0_DP + fragments%ke_spin = 0.0_DP + + do i = 1, nfrag + fragments%ke_orbit = fragments%ke_orbit + fragments%mass(i) * dot_product(fragments%vc(:,i), fragments%vc(:,i)) + fragments%ke_spin = fragments%ke_spin + fragments%mass(i) * fragments%Ip(3,i) * dot_product(fragments%rot(:,i),fragments%rot(:,i) ) + end do + + fragments%ke_orbit = fragments%ke_orbit / 2 + fragments%ke_spin = fragments%ke_spin / 2 + + end associate + + return + end subroutine fraggle_util_get_kinetic_energy + module subroutine fraggle_util_reset_fragments(self) !! author: David A. Minton !! @@ -177,7 +204,7 @@ module subroutine fraggle_util_set_budgets(self) dL(:) = self%Ltot(:,2) - self%Ltot(:,1) fragments%L_budget(:) = -dL(:) - fragments%ke_budget = -(dEtot - 0.5_DP * fragments%mtot * dot_product(impactors%vbcom(:), impactors%vbcom(:))) - impactors%Qloss + fragments%ke_budget = -(dEtot - impactors%Qloss) end select end associate @@ -214,7 +241,10 @@ module subroutine fraggle_util_set_natural_scale_factors(self) impactors%bounce_unit(:) = impactors%bounce_unit(:) / collider%vscale impactors%rb(:,:) = impactors%rb(:,:) / collider%dscale impactors%vb(:,:) = impactors%vb(:,:) / collider%vscale + impactors%rc(:,:) = impactors%rc(:,:) / collider%dscale + impactors%vc(:,:) = impactors%vc(:,:) / collider%vscale impactors%mass(:) = impactors%mass(:) / collider%mscale + impactors%Mcb = impactors%Mcb / collider%mscale impactors%radius(:) = impactors%radius(:) / collider%dscale impactors%Lspin(:,:) = impactors%Lspin(:,:) / collider%Lscale impactors%Lorbit(:,:) = impactors%Lorbit(:,:) / collider%Lscale @@ -256,11 +286,16 @@ module subroutine fraggle_util_set_original_scale_factors(self) impactors%rbimp(:) = impactors%rbimp(:) * collider%dscale impactors%bounce_unit(:) = impactors%bounce_unit(:) * collider%vscale - impactors%mass = impactors%mass * collider%mscale - impactors%radius = impactors%radius * collider%dscale - impactors%rb = impactors%rb * collider%dscale - impactors%vb = impactors%vb * collider%vscale - impactors%Lspin = impactors%Lspin * collider%Lscale + impactors%mass = impactors%mass * collider%mscale + impactors%Mcb = impactors%Mcb * collider%mscale + impactors%mass_dist = impactors%mass_dist * collider%mscale + impactors%radius = impactors%radius * collider%dscale + impactors%rb = impactors%rb * collider%dscale + impactors%vb = impactors%vb * collider%vscale + impactors%rc = impactors%rc * collider%dscale + impactors%vc = impactors%vc * collider%vscale + impactors%Lspin = impactors%Lspin * collider%Lscale + impactors%Lorbit = impactors%Lorbit * collider%Lscale do i = 1, 2 impactors%rot(:,i) = impactors%Lspin(:,i) * (impactors%mass(i) * impactors%radius(i)**2 * impactors%Ip(3, i)) end do diff --git a/src/misc/minimizer_module.f90 b/src/misc/minimizer_module.f90 index 772db418a..667f061db 100644 --- a/src/misc/minimizer_module.f90 +++ b/src/misc/minimizer_module.f90 @@ -128,7 +128,7 @@ module subroutine minimize_bfgs(f, N, x0, eps, maxloop, lerr, x1) real(DP), dimension(:), intent(out), allocatable :: x1 ! Internals integer(I4B) :: i, j, k, l, conv - real(DP), parameter :: graddelta = 1e-4_DP !! Delta x for gradient calculations + real(DP), parameter :: graddelta = 1e-6_DP !! Delta x for gradient calculations real(DP), dimension(N) :: S !! Direction vectors real(DP), dimension(N,N) :: H !! Approximated inverse Hessian matrix real(DP), dimension(N) :: grad1 !! gradient of f @@ -137,6 +137,7 @@ module subroutine minimize_bfgs(f, N, x0, eps, maxloop, lerr, x1) real(DP), dimension(N) :: y, P real(DP), dimension(N,N) :: PP, PyH, HyP real(DP), save :: yHy, Py + real(DP) :: Hnorm call ieee_get_status(original_fpe_status) ! Save the original floating point exception status call ieee_set_flag(ieee_all, .false.) ! Set all flags to quiet @@ -181,7 +182,7 @@ module subroutine minimize_bfgs(f, N, x0, eps, maxloop, lerr, x1) end do !$omp end do simd ! prevent divide by zero (convergence) - if (abs(Py) < tiny(Py)) exit + if (abs(Py) < N**2 * tiny(Py)) exit ! set up update PyH(:,:) = 0._DP HyP(:,:) = 0._DP @@ -201,13 +202,21 @@ module subroutine minimize_bfgs(f, N, x0, eps, maxloop, lerr, x1) ! update H matrix H(:,:) = H(:,:) + ((1._DP - yHy / Py) * PP(:,:) - PyH(:,:) - HyP(:,:)) / Py ! Normalize to prevent it from blowing up if it takes many iterations to find a solution - H(:,:) = H(:,:) / norm2(H(:,:)) + Hnorm = 0.0_DP + do concurrent (j = 1:N,k=1:N,abs(H(j,k))>sqrt(10*tiny(1.0_DP))) + Hnorm = Hnorm + H(j,k)**2 + end do + Hnorm = sqrt(Hnorm) ! Stop everything if there are any exceptions to allow the routine to fail gracefully call ieee_get_flag(ieee_usual, fpe_flag) if (any(fpe_flag)) exit if (i == maxloop) then lerr = .true. end if + where(abs(H(:,:)) < sqrt(10*tiny(1.0_DP)) ) + H(:,:) = 0.0_DP + endwhere + H(:,:) = H(:,:) / Hnorm end do call ieee_get_flag(ieee_usual, fpe_flag) lerr = lerr .or. any(fpe_flag) From 6ed292e69d924a1baf549b8bd61be3bf8b21ef30 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Tue, 27 Dec 2022 11:50:43 -0500 Subject: [PATCH 529/569] Improvements to the energy budget calcs and bug fixes --- src/collision/collision_module.f90 | 21 ++++- src/collision/collision_util.f90 | 139 ++++++++++++++++++----------- src/fraggle/fraggle_generate.f90 | 11 ++- src/fraggle/fraggle_module.f90 | 27 +----- src/fraggle/fraggle_util.f90 | 102 +-------------------- src/misc/minimizer_module.f90 | 2 +- 6 files changed, 113 insertions(+), 189 deletions(-) diff --git a/src/collision/collision_module.f90 b/src/collision/collision_module.f90 index cfac7b49f..ed94b6be1 100644 --- a/src/collision/collision_module.f90 +++ b/src/collision/collision_module.f90 @@ -110,9 +110,15 @@ module collision real(DP), dimension(NDIM,nbody) :: v_t_unit !! Array of tangential direction unit vectors of individual fragments in the collisional coordinate frame real(DP), dimension(NDIM,nbody) :: v_n_unit !! Array of normal direction unit vectors of individual fragments in the collisional coordinate frame integer(I1B), dimension(nbody) :: origin_body !! Array of indices indicating which impactor body (1 or 2) the fragment originates from + real(DP), dimension(NDIM) :: Lorbit !! Orbital angular momentum vector of all fragments + real(DP), dimension(NDIM) :: Lspin !! Spin angular momentum vector of all fragments + real(DP) :: ke_orbit !! Orbital kinetic energy of all fragments + real(DP) :: ke_spin !! Spin kinetic energy of all fragments contains - procedure :: reset => collision_util_reset_fragments !! Deallocates all allocatable arrays and sets everything else to 0 - final :: collision_final_fragments !! Finalizer deallocates all allocatables + procedure :: reset => collision_util_reset_fragments !! Deallocates all allocatable arrays and sets everything else to 0 + procedure :: get_angular_momentum => collision_util_get_angular_momentum !! Calcualtes the current angular momentum of the fragments + procedure :: get_kinetic_energy => collision_util_get_kinetic_energy !! Calcualtes the current kinetic energy of the fragments + final :: collision_final_fragments !! Finalizer deallocates all allocatables end type collision_fragments @@ -404,6 +410,17 @@ module subroutine collision_util_construct_temporary_system(self, nbody_system, class(base_parameters), allocatable, intent(out) :: tmpparam !! Output temporary configuration run parameters end subroutine collision_util_construct_temporary_system + + module subroutine collision_util_get_angular_momentum(self) + implicit none + class(collision_fragments(*)), intent(inout) :: self !! Fraggle fragment system object + end subroutine collision_util_get_angular_momentum + + module subroutine collision_util_get_kinetic_energy(self) + implicit none + class(collision_fragments(*)), intent(inout) :: self !! Fraggle fragment system object + end subroutine collision_util_get_kinetic_energy + module subroutine collision_util_reset_fragments(self) implicit none class(collision_fragments(*)), intent(inout) :: self diff --git a/src/collision/collision_util.f90 b/src/collision/collision_util.f90 index 4a8ee6b74..f182b6dfb 100644 --- a/src/collision/collision_util.f90 +++ b/src/collision/collision_util.f90 @@ -175,6 +175,59 @@ module subroutine collision_util_get_idvalues_snapshot(self, idvals) end subroutine collision_util_get_idvalues_snapshot + + module subroutine collision_util_get_angular_momentum(self) + !! Author: David A. Minton + !! + !! Calculates the current angular momentum of the fragments + implicit none + ! Arguments + class(collision_fragments(*)), intent(inout) :: self !! Fraggle fragment system object + ! Internals + integer(I4B) :: i + + associate(fragments => self, nfrag => self%nbody) + fragments%Lorbit(:) = 0.0_DP + fragments%Lspin(:) = 0.0_DP + + do i = 1, nfrag + fragments%Lorbit(:) = fragments%Lorbit(:) + fragments%mass(i) * (fragments%rc(:, i) .cross. fragments%vc(:, i)) + fragments%Lspin(:) = fragments%Lspin(:) + fragments%mass(i) * fragments%radius(i)**2 * fragments%Ip(:, i) * fragments%rot(:, i) + end do + end associate + + return + end subroutine collision_util_get_angular_momentum + + + module subroutine collision_util_get_kinetic_energy(self) + !! Author: David A. Minton + !! + !! Calculates the current kinetic energy of the fragments + implicit none + ! Argument + class(collision_fragments(*)), intent(inout) :: self !! Fraggle fragment system object + ! Internals + integer(I4B) :: i + + associate(fragments => self, nfrag => self%nbody) + fragments%ke_orbit = 0.0_DP + fragments%ke_spin = 0.0_DP + + do i = 1, nfrag + fragments%ke_orbit = fragments%ke_orbit + fragments%mass(i) * dot_product(fragments%vc(:,i), fragments%vc(:,i)) + fragments%ke_spin = fragments%ke_spin + fragments%mass(i) * fragments%Ip(3,i) * dot_product(fragments%rot(:,i),fragments%rot(:,i) ) + end do + + fragments%ke_orbit = fragments%ke_orbit / 2 + fragments%ke_spin = fragments%ke_spin / 2 + + end associate + + return + end subroutine collision_util_get_kinetic_energy + + module subroutine collision_util_get_energy_momentum(self, nbody_system, param, lbefore) !! Author: David A. Minton !! @@ -189,71 +242,49 @@ module subroutine collision_util_get_energy_momentum(self, nbody_system, param, class(base_parameters), intent(inout) :: param !! Current swiftest run configuration parameters logical, intent(in) :: lbefore !! Flag indicating that this the "before" state of the nbody_system, with impactors included and fragments excluded or vice versa ! Internals - class(base_nbody_system), allocatable, save :: tmpsys - class(base_parameters), allocatable, save :: tmpparam - integer(I4B) :: npl_before, npl_after, stage,i + integer(I4B) :: stage,i + real(DP), dimension(NDIM) :: Lorbit, Lspin + real(DP) :: ke_orbit, ke_spin + select type(nbody_system) class is (swiftest_nbody_system) select type(param) class is (swiftest_parameters) associate(fragments => self%fragments, impactors => self%impactors, nfrag => self%fragments%nbody, pl => nbody_system%pl, cb => nbody_system%cb) - ! Because we're making a copy of the massive body object with the excludes/fragments appended, we need to deallocate the - ! big k_plpl array and recreate it when we're done, otherwise we run the risk of blowing up the memory by - ! allocating two of these ginormous arrays simulteouously. This is not particularly efficient, but as this - ! subroutine should be called relatively infrequently, it shouldn't matter too much. - - npl_before = pl%nbody - npl_after = npl_before + nfrag if (lbefore) then - call self%construct_temporary_system(nbody_system, param, tmpsys, tmpparam) - select type(tmpsys) - class is (swiftest_nbody_system) - ! Build the exluded body logical mask for the *before* case: Only the original bodies are used to compute energy and momentum - tmpsys%pl%status(impactors%id(1:impactors%ncoll)) = ACTIVE - tmpsys%pl%status(npl_before+1:npl_after) = INACTIVE - end select - else - if (.not.allocated(tmpsys)) then - write(*,*) "Error in collision_util_get_energy_momentum. " // & - " This must be called with lbefore=.true. at least once before calling it with lbefore=.false." - call util_exit(FAILURE) - end if - select type(tmpsys) - class is (swiftest_nbody_system) - ! Build the exluded body logical mask for the *after* case: Only the new bodies are used to compute energy and momentum - call self%add_fragments(tmpsys, tmpparam) - tmpsys%pl%status(impactors%id(1:impactors%ncoll)) = INACTIVE - do concurrent(i = npl_before+1:npl_after) - tmpsys%pl%status(i) = ACTIVE - tmpsys%pl%rot(:,i) = 0.0_DP - tmpsys%pl%vb(:,i) = impactors%vbcom(:) - end do - end select - end if - select type(tmpsys) - class is (swiftest_nbody_system) - if (param%lflatten_interactions) call tmpsys%pl%flatten(param) - - call tmpsys%get_energy_and_momentum(param) + Lorbit(:) = sum(impactors%Lorbit(:,:), dim=2) + Lspin(:) = sum(impactors%Lspin(:,:), dim=2) + ke_orbit = 0.0_DP + ke_spin = 0.0_DP + do concurrent(i = 1:2) + ke_orbit = ke_orbit + impactors%mass(i) * dot_product(impactors%vc(:,i), impactors%vc(:,i)) + ke_spin = ke_spin + impactors%mass(i) * impactors%radius(i)**2 * impactors%Ip(3,i) * dot_product(impactors%rot(:,i), impactors%rot(:,i)) + end do + else + call fragments%get_angular_momentum() + Lorbit(:) = fragments%Lorbit(:) + Lspin(:) = fragments%Lspin(:) + call fragments%get_kinetic_energy() + ke_orbit = fragments%ke_orbit + ke_spin = fragments%ke_spin - ! Calculate the current fragment energy and momentum balances - if (lbefore) then - stage = 1 - else - stage = 2 - end if - self%Lorbit(:,stage) = tmpsys%Lorbit(:) - self%Lspin(:,stage) = tmpsys%Lspin(:) - self%Ltot(:,stage) = tmpsys%Ltot(:) - self%ke_orbit(stage) = tmpsys%ke_orbit - self%ke_spin(stage) = tmpsys%ke_spin - self%pe(stage) = tmpsys%pe - self%Etot(stage) = tmpsys%ke_orbit + tmpsys%ke_spin - end select + end if + ! Calculate the current fragment energy and momentum balances + if (lbefore) then + stage = 1 + else + stage = 2 + end if + self%Lorbit(:,stage) = Lorbit(:) + self%Lspin(:,stage) = Lspin(:) + self%Ltot(:,stage) = Lorbit(:) + Lspin(:) + self%ke_orbit(stage) = ke_orbit + self%ke_spin(stage) = ke_spin + self%Etot(stage) = ke_orbit + ke_spin end associate end select end select diff --git a/src/fraggle/fraggle_generate.f90 b/src/fraggle/fraggle_generate.f90 index 7ca7cac06..2738039e3 100644 --- a/src/fraggle/fraggle_generate.f90 +++ b/src/fraggle/fraggle_generate.f90 @@ -80,7 +80,6 @@ module subroutine fraggle_generate_disrupt(self, nbody_system, param, t, lfailur write(message,*) try call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Fraggle try " // trim(adjustl(message))) if (lfailure_local) then - !call fragments%restructure(impactors, try, f_spin, r_max_start) call fragments%reset() try = try + 1 end if @@ -163,7 +162,7 @@ subroutine fraggle_generate_minimize(collider, lfailure) ! Internals real(DP), parameter :: TOL_MIN = 1.0e-6_DP real(DP), parameter :: TOL_INIT = 1e-8_DP - integer(I4B), parameter :: MAXLOOP = 30 + integer(I4B), parameter :: MAXLOOP = 50 real(DP), dimension(collider%fragments%nbody) :: input_v real(DP), dimension(:), allocatable :: output_v type(lambda_obj) :: Efunc @@ -174,7 +173,7 @@ subroutine fraggle_generate_minimize(collider, lfailure) select type(fragments => collider%fragments) class is (fraggle_fragments(*)) - nelem = 2 * (nfrag - 1) + nelem = nfrag lfailure = .false. ! Find the local kinetic energy minimum for the nbody_system that conserves linear and angular momentum Efunc = lambda_obj(E_objective_function) @@ -193,7 +192,7 @@ subroutine fraggle_generate_minimize(collider, lfailure) fragments%vmag(1:nfrag) = output_v(1:nfrag) - do concurrent(i=2:nfrag) + do concurrent(i=1:nfrag) fragments%vc(:,i) = abs(fragments%vmag(i)) * fragments%v_r_unit(:,i) end do @@ -240,8 +239,8 @@ function E_objective_function(val_input) result(fval) call fraggle_generate_set_spins(tmp_frag) ! Get the current kinetic energy of the system - call fragments%get_kinetic_energy() - deltaE = fragments%ke_budget - (fragments%ke_orbit + fragments%ke_spin) + call tmp_frag%get_kinetic_energy() + deltaE = tmp_frag%ke_budget - (tmp_frag%ke_orbit + tmp_frag%ke_spin) ! Use the deltaE as the basis of our objective function, with a higher penalty for having excess kinetic energy compared with having a deficit if (deltaE < 0.0_DP) then diff --git a/src/fraggle/fraggle_module.f90 b/src/fraggle/fraggle_module.f90 index f2ad578c4..a40e196b4 100644 --- a/src/fraggle/fraggle_module.f90 +++ b/src/fraggle/fraggle_module.f90 @@ -20,17 +20,11 @@ module fraggle real(DP), dimension(nbody) :: v_r_mag !! Array of radial direction velocity magnitudes of individual fragments real(DP), dimension(nbody) :: v_t_mag !! Array of tangential direction velocity magnitudes of individual fragments real(DP), dimension(nbody) :: v_n_mag !! Array of normal direction velocity magnitudes of individual fragments - real(DP), dimension(NDIM) :: Lorbit !! Orbital angular momentum vector of all fragments - real(DP), dimension(NDIM) :: Lspin !! Spin angular momentum vector of all fragments - real(DP) :: ke_orbit !! Orbital kinetic energy of all fragments - real(DP) :: ke_spin !! Spin kinetic energy of all fragments real(DP) :: ke_budget !! Kinetic energy budget for computing fragment trajectories real(DP), dimension(NDIM) :: L_budget !! Angular momentum budget for computing fragment trajectories contains - procedure :: get_angular_momentum => fraggle_util_get_angular_momentum !! Calcualtes the current angular momentum of the fragments - procedure :: get_kinetic_energy => fraggle_util_get_kinetic_energy !! Calcualtes the current kinetic energy of the fragments + procedure :: reset => fraggle_util_reset_fragments !! Resets all position and velocity-dependent fragment quantities in order to do a fresh calculation (does not reset mass, radius, or other values that get set prior to the call to fraggle_generate) - procedure :: restructure => fraggle_util_restructure !! Restructure the inputs after a failed attempt failed to find a set of positions and velocities that satisfy the energy and momentum constraints final :: fraggle_final_fragments !! Finalizer will deallocate all allocatables end type fraggle_fragments @@ -80,16 +74,6 @@ module subroutine fraggle_util_construct_temporary_system(self, nbody_system, pa class(base_parameters), allocatable, intent(out) :: tmpparam !! Output temporary configuration run parameters end subroutine fraggle_util_construct_temporary_system - module subroutine fraggle_util_get_angular_momentum(self) - implicit none - class(fraggle_fragments(*)), intent(inout) :: self !! Fraggle fragment system object - end subroutine fraggle_util_get_angular_momentum - - module subroutine fraggle_util_get_kinetic_energy(self) - implicit none - class(fraggle_fragments(*)), intent(inout) :: self !! Fraggle fragment system object - end subroutine fraggle_util_get_kinetic_energy - module subroutine fraggle_util_reset_fragments(self) implicit none class(fraggle_fragments(*)), intent(inout) :: self @@ -100,15 +84,6 @@ module subroutine fraggle_util_reset_system(self) class(collision_fraggle), intent(inout) :: self !! Collision system object end subroutine fraggle_util_reset_system - module subroutine fraggle_util_restructure(self, impactors, try, f_spin, r_max_start) - implicit none - class(fraggle_fragments(*)), intent(inout) :: self !! Fraggle fragment system object - class(collision_impactors), intent(in) :: impactors !! Fraggle collider system object - integer(I4B), intent(in) :: try !! The current number of times Fraggle has tried to find a solution - real(DP), intent(inout) :: f_spin !! Fraction of energy/momentum that goes into spin. This decreases ater a failed attempt - real(DP), intent(inout) :: r_max_start !! The maximum radial distance that the position calculation starts with. This increases after a failed attempt - end subroutine fraggle_util_restructure - module subroutine fraggle_util_set_budgets(self) implicit none class(collision_fraggle), intent(inout) :: self !! Fraggle collision system object diff --git a/src/fraggle/fraggle_util.f90 b/src/fraggle/fraggle_util.f90 index 07d845053..f85eed056 100644 --- a/src/fraggle/fraggle_util.f90 +++ b/src/fraggle/fraggle_util.f90 @@ -37,57 +37,6 @@ module subroutine fraggle_util_construct_temporary_system(self, nbody_system, pa end subroutine fraggle_util_construct_temporary_system - module subroutine fraggle_util_get_angular_momentum(self) - !! Author: David A. Minton - !! - !! Calculates the current angular momentum of the fragments - implicit none - ! Arguments - class(fraggle_fragments(*)), intent(inout) :: self !! Fraggle fragment system object - ! Internals - integer(I4B) :: i - - associate(fragments => self, nfrag => self%nbody) - fragments%Lorbit(:) = 0.0_DP - fragments%Lspin(:) = 0.0_DP - - do i = 1, nfrag - fragments%Lorbit(:) = fragments%Lorbit(:) + fragments%mass(i) * (fragments%rc(:, i) .cross. fragments%vc(:, i)) - fragments%Lspin(:) = fragments%Lspin(:) + fragments%mass(i) * fragments%radius(i)**2 * fragments%Ip(:, i) * fragments%rot(:, i) - end do - end associate - - return - end subroutine fraggle_util_get_angular_momentum - - - module subroutine fraggle_util_get_kinetic_energy(self) - !! Author: David A. Minton - !! - !! Calculates the current kinetic energy of the fragments - implicit none - ! Argument - class(fraggle_fragments(*)), intent(inout) :: self !! Fraggle fragment system object - ! Internals - integer(I4B) :: i - - associate(fragments => self, nfrag => self%nbody) - fragments%ke_orbit = 0.0_DP - fragments%ke_spin = 0.0_DP - - do i = 1, nfrag - fragments%ke_orbit = fragments%ke_orbit + fragments%mass(i) * dot_product(fragments%vc(:,i), fragments%vc(:,i)) - fragments%ke_spin = fragments%ke_spin + fragments%mass(i) * fragments%Ip(3,i) * dot_product(fragments%rot(:,i),fragments%rot(:,i) ) - end do - - fragments%ke_orbit = fragments%ke_orbit / 2 - fragments%ke_spin = fragments%ke_spin / 2 - - end associate - - return - end subroutine fraggle_util_get_kinetic_energy - module subroutine fraggle_util_reset_fragments(self) !! author: David A. Minton !! @@ -138,53 +87,6 @@ module subroutine fraggle_util_reset_system(self) end subroutine fraggle_util_reset_system - module subroutine fraggle_util_restructure(self, impactors, try, f_spin, r_max_start) - !! Author: David A. Minton - !! - !! Restructure the inputs after a failed attempt failed to find a set of positions and velocities that satisfy the energy and momentum constraints - implicit none - ! Arguments - class(fraggle_fragments(*)), intent(inout) :: self !! Fraggle fragment system object - class(collision_impactors), intent(in) :: impactors !! Fraggle collider system object - integer(I4B), intent(in) :: try !! The current number of times Fraggle has tried to find a solution - real(DP), intent(inout) :: f_spin !! Fraction of energy/momentum that goes into spin. This decreases ater a failed attempt - real(DP), intent(inout) :: r_max_start !! The maximum radial distance that the position calculation starts with. This increases after a failed attempt - ! Internals - real(DP), save :: ke_tot_deficit, r_max_start_old, ke_avg_deficit_old - real(DP) :: delta_r, delta_r_max, ke_avg_deficit - real(DP), parameter :: ke_avg_deficit_target = 0.0_DP - - ! Introduce a bit of noise in the radius determination so we don't just flip flop between similar failed positions - associate(fragments => self) - call random_number(delta_r_max) - delta_r_max = sum(impactors%radius(:)) * (1.0_DP + 2e-1_DP * (delta_r_max - 0.5_DP)) - if (try == 1) then - ke_tot_deficit = - (fragments%ke_budget - fragments%ke_orbit - fragments%ke_spin) - ke_avg_deficit = ke_tot_deficit - delta_r = delta_r_max - else - ! Linearly interpolate the last two failed solution ke deficits to find a new distance value to try - ke_tot_deficit = ke_tot_deficit - (fragments%ke_budget - fragments%ke_orbit - fragments%ke_spin) - ke_avg_deficit = ke_tot_deficit / try - delta_r = (r_max_start - r_max_start_old) * (ke_avg_deficit_target - ke_avg_deficit_old) & - / (ke_avg_deficit - ke_avg_deficit_old) - if (abs(delta_r) > delta_r_max) delta_r = sign(delta_r_max, delta_r) - end if - r_max_start_old = r_max_start - r_max_start = r_max_start + delta_r ! The larger lever arm can help if the problem is in the angular momentum step - ke_avg_deficit_old = ke_avg_deficit - - if (f_spin > epsilon(1.0_DP)) then ! Try reducing the fraction in spin - f_spin = f_spin / 2 - else - f_spin = 0.0_DP - end if - end associate - - return - end subroutine fraggle_util_restructure - - module subroutine fraggle_util_set_budgets(self) !! author: David A. Minton !! @@ -200,8 +102,8 @@ module subroutine fraggle_util_set_budgets(self) select type(fragments => self%fragments) class is (fraggle_fragments(*)) - dEtot = self%Etot(2) - self%Etot(1) - dL(:) = self%Ltot(:,2) - self%Ltot(:,1) + dEtot = self%Etot(1) + dL(:) = self%Ltot(:,1) fragments%L_budget(:) = -dL(:) fragments%ke_budget = -(dEtot - impactors%Qloss) diff --git a/src/misc/minimizer_module.f90 b/src/misc/minimizer_module.f90 index 667f061db..8beab3879 100644 --- a/src/misc/minimizer_module.f90 +++ b/src/misc/minimizer_module.f90 @@ -128,7 +128,7 @@ module subroutine minimize_bfgs(f, N, x0, eps, maxloop, lerr, x1) real(DP), dimension(:), intent(out), allocatable :: x1 ! Internals integer(I4B) :: i, j, k, l, conv - real(DP), parameter :: graddelta = 1e-6_DP !! Delta x for gradient calculations + real(DP), parameter :: graddelta = 1e-4_DP !! Delta x for gradient calculations real(DP), dimension(N) :: S !! Direction vectors real(DP), dimension(N,N) :: H !! Approximated inverse Hessian matrix real(DP), dimension(N) :: grad1 !! gradient of f From 7805c9365dac6b6ed892a62368e0a91e7e0f453b Mon Sep 17 00:00:00 2001 From: David A Minton Date: Tue, 27 Dec 2022 18:02:22 -0500 Subject: [PATCH 530/569] Fraggle sort of works again. The constraints are not met as well, but it does *something* at least --- src/collision/collision_generate.f90 | 16 ++++++++++++---- src/collision/collision_util.f90 | 4 +++- src/fraggle/fraggle_generate.f90 | 23 +++++++++++++---------- src/misc/minimizer_module.f90 | 2 +- 4 files changed, 29 insertions(+), 16 deletions(-) diff --git a/src/collision/collision_generate.f90 b/src/collision/collision_generate.f90 index 978dfdcff..165ee42a8 100644 --- a/src/collision/collision_generate.f90 +++ b/src/collision/collision_generate.f90 @@ -328,6 +328,8 @@ module subroutine collision_generate_merge(self, nbody_system, param, t) ! The fragment trajectory will be the barycentric trajectory fragments%rb(:,1) = impactors%rbcom(:) fragments%vb(:,1) = impactors%vbcom(:) + fragments%rc(:,1) = 0.0_DP + fragments%vc(:,1) = 0.0_DP ! Get the energy of the system after the collision call self%get_energy_and_momentum(nbody_system, param, lbefore=.false.) @@ -485,7 +487,9 @@ module subroutine collision_generate_simple_rot_vec(collider) class(collision_basic), intent(inout) :: collider !! Fraggle collision system object ! Internals real(DP), dimension(NDIM) :: Lresidual, Lbefore, Lafter, Lspin, rot - integer(I4B) :: i + real(DP) :: ke_residual, rotmag_old, rotmag_new, vmag_old, vmag_new + integer(I4B) :: i, loop + integer(I4B) :: MAXLOOP = 10 associate(fragments => collider%fragments, impactors => collider%impactors, nfrag => collider%fragments%nbody) @@ -537,7 +541,7 @@ module subroutine collision_generate_simple_vel_vec(collider) real(DP), dimension(2) :: vimp real(DP) :: vmag, vdisp integer(I4B), dimension(collider%fragments%nbody) :: vsign - real(DP), dimension(collider%fragments%nbody) :: vscale + real(DP), dimension(collider%fragments%nbody) :: vscale, mass_vscale associate(fragments => collider%fragments, impactors => collider%impactors, nfrag => collider%fragments%nbody) lhitandrun = (impactors%regime == COLLRESOLVE_REGIME_HIT_AND_RUN) @@ -554,7 +558,6 @@ module subroutine collision_generate_simple_vel_vec(collider) vdisp = 2 * sqrt(2 * impactors%Gmass(2) / impactors%radius(2)) else vdisp = 2 * sqrt(2 * sum(impactors%Gmass(:)) / sum(impactors%radius(:))) - !vmag = abs(dot_product(impactors%vb(:,2) - impactors%vb(:,1), impactors%y_unit(:))) end if vimp(:) = .mag.impactors%vc(:,:) @@ -566,13 +569,18 @@ module subroutine collision_generate_simple_vel_vec(collider) end do vscale(:) = vscale(:)/maxval(vscale(:)) + ! Give the fragment velocities a random value that is somewhat scaled with fragment mass + call random_number(mass_vscale) + mass_vscale(:) = (mass_vscale(:) + 1.0_DP) / 2 + mass_vscale(:) = mass_vscale(:) * (fragments%mtot / fragments%mass(:))**(0.125_DP) + mass_vscale(:) = sqrt(2*mass_vscale(:) / maxval(mass_vscale(:))) fragments%vc(:,1) = .mag.impactors%vc(:,1) * impactors%bounce_unit(:) do concurrent(i = 2:nfrag) j = fragments%origin_body(i) vrot(:) = impactors%rot(:,j) .cross. (fragments%rc(:,i) - impactors%rb(:,j) + impactors%rbcom(:)) - vmag = .mag.impactors%vc(:,j) * vscale(i) + vmag = .mag.impactors%vc(:,j) * vscale(i) * mass_vscale(i) if (lhitandrun) then fragments%vc(:,i) = vmag * 0.5_DP * impactors%bounce_unit(:) * vsign(i) + vrot(:) diff --git a/src/collision/collision_util.f90 b/src/collision/collision_util.f90 index f182b6dfb..94dce4f6d 100644 --- a/src/collision/collision_util.f90 +++ b/src/collision/collision_util.f90 @@ -216,7 +216,7 @@ module subroutine collision_util_get_kinetic_energy(self) do i = 1, nfrag fragments%ke_orbit = fragments%ke_orbit + fragments%mass(i) * dot_product(fragments%vc(:,i), fragments%vc(:,i)) - fragments%ke_spin = fragments%ke_spin + fragments%mass(i) * fragments%Ip(3,i) * dot_product(fragments%rot(:,i),fragments%rot(:,i) ) + fragments%ke_spin = fragments%ke_spin + fragments%mass(i) * fragments%radius(i)**2 * fragments%Ip(3,i) * dot_product(fragments%rot(:,i),fragments%rot(:,i) ) end do fragments%ke_orbit = fragments%ke_orbit / 2 @@ -263,6 +263,8 @@ module subroutine collision_util_get_energy_momentum(self, nbody_system, param, ke_orbit = ke_orbit + impactors%mass(i) * dot_product(impactors%vc(:,i), impactors%vc(:,i)) ke_spin = ke_spin + impactors%mass(i) * impactors%radius(i)**2 * impactors%Ip(3,i) * dot_product(impactors%rot(:,i), impactors%rot(:,i)) end do + ke_orbit = ke_orbit / 2 + ke_spin = ke_spin / 2 else call fragments%get_angular_momentum() Lorbit(:) = fragments%Lorbit(:) diff --git a/src/fraggle/fraggle_generate.f90 b/src/fraggle/fraggle_generate.f90 index 2738039e3..8a22b41e4 100644 --- a/src/fraggle/fraggle_generate.f90 +++ b/src/fraggle/fraggle_generate.f90 @@ -99,12 +99,12 @@ module subroutine fraggle_generate_disrupt(self, nbody_system, param, t, lfailur dEtot = self%Etot(2) - self%Etot(1) dLmag = .mag. (self%Ltot(:,2) - self%Ltot(:,1)) - lfailure_local = ((abs(dEtot + impactors%Qloss) > FRAGGLE_ETOL) .or. (dEtot > 0.0_DP)) + lfailure_local = (dEtot > 0.0_DP) if (lfailure_local) then write(message, *) dEtot, abs(dEtot + impactors%Qloss) / FRAGGLE_ETOL - call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Fraggle failed due to high energy error: " // & + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Fraggle failed due to energy gain: " // & trim(adjustl(message))) - cycle + !cycle lfailure_local = .false. exit end if @@ -160,8 +160,8 @@ subroutine fraggle_generate_minimize(collider, lfailure) class(collision_fraggle), intent(inout) :: collider !! Fraggle collision system object logical, intent(out) :: lfailure !! Logical flag indicating whether this step fails or succeeds ! Internals - real(DP), parameter :: TOL_MIN = 1.0e-6_DP - real(DP), parameter :: TOL_INIT = 1e-8_DP + real(DP), parameter :: TOL_MIN = 1.0e-5_DP + real(DP), parameter :: TOL_INIT = 1e-6_DP integer(I4B), parameter :: MAXLOOP = 50 real(DP), dimension(collider%fragments%nbody) :: input_v real(DP), dimension(:), allocatable :: output_v @@ -179,11 +179,11 @@ subroutine fraggle_generate_minimize(collider, lfailure) Efunc = lambda_obj(E_objective_function) tol = TOL_INIT + fragments%v_r_unit(:,:) = .unit. fragments%vc(:,:) + fragments%vmag(:) = .mag. fragments%vc(:,1:nfrag) + fragments%rot(:,1:nfrag) = fragments%rot(:,1:nfrag) * 1e-12_DP do while(tol < TOL_MIN) - fragments%v_r_unit(:,:) = .unit. fragments%vc(:,:) - fragments%vmag(:) = .mag. fragments%vc(:,:) - input_v(:) = fragments%vmag(1:nfrag) fval = E_objective_function(input_v) call minimize_bfgs(Efunc, nelem, input_v, tol, MAXLOOP, lfailure, output_v) @@ -196,13 +196,15 @@ subroutine fraggle_generate_minimize(collider, lfailure) fragments%vc(:,i) = abs(fragments%vmag(i)) * fragments%v_r_unit(:,i) end do - call collision_util_shift_vector_to_origin(fragments%mass, fragments%vc) ! Set spins in order to conserve angular momentum call fraggle_generate_set_spins(fragments) if (.not.lfailure) exit tol = tol * 2 ! Keep increasing the tolerance until we converge on a solution end do + + + call collision_util_shift_vector_to_origin(fragments%mass, fragments%vc) end select end associate @@ -244,10 +246,11 @@ function E_objective_function(val_input) result(fval) ! Use the deltaE as the basis of our objective function, with a higher penalty for having excess kinetic energy compared with having a deficit if (deltaE < 0.0_DP) then - fval = deltaE**4 + fval = deltaE**8 else fval = deltaE**2 end if + deallocate(tmp_frag) end select end associate diff --git a/src/misc/minimizer_module.f90 b/src/misc/minimizer_module.f90 index 8beab3879..e17cee3e9 100644 --- a/src/misc/minimizer_module.f90 +++ b/src/misc/minimizer_module.f90 @@ -128,7 +128,7 @@ module subroutine minimize_bfgs(f, N, x0, eps, maxloop, lerr, x1) real(DP), dimension(:), intent(out), allocatable :: x1 ! Internals integer(I4B) :: i, j, k, l, conv - real(DP), parameter :: graddelta = 1e-4_DP !! Delta x for gradient calculations + real(DP), parameter :: graddelta = 1e-2_DP !! Delta x for gradient calculations real(DP), dimension(N) :: S !! Direction vectors real(DP), dimension(N,N) :: H !! Approximated inverse Hessian matrix real(DP), dimension(N) :: grad1 !! gradient of f From 8bb85e39f8c1605c32ed35e094e25681902885ec Mon Sep 17 00:00:00 2001 From: David A Minton Date: Tue, 27 Dec 2022 21:52:34 -0500 Subject: [PATCH 531/569] Rearranged some of the methods in the collision system to keep consistency when computing spins --- src/collision/collision_generate.f90 | 19 ++--------- src/collision/collision_module.f90 | 34 +++++++++++++------ src/collision/collision_util.f90 | 51 +++++++++++++++++++++++++++- src/fraggle/fraggle_generate.f90 | 34 ++----------------- src/fraggle/fraggle_module.f90 | 8 ----- src/fraggle/fraggle_util.f90 | 28 --------------- 6 files changed, 78 insertions(+), 96 deletions(-) diff --git a/src/collision/collision_generate.f90 b/src/collision/collision_generate.f90 index 165ee42a8..684970bef 100644 --- a/src/collision/collision_generate.f90 +++ b/src/collision/collision_generate.f90 @@ -382,6 +382,7 @@ module subroutine collision_generate_disrupt(self, nbody_system, param, t, lfail logical, optional, intent(out) :: lfailure ! Internals + call self%set_budgets() call collision_generate_simple_pos_vec(self) call self%set_coordinate_system() call collision_generate_simple_vel_vec(self) @@ -487,9 +488,7 @@ module subroutine collision_generate_simple_rot_vec(collider) class(collision_basic), intent(inout) :: collider !! Fraggle collision system object ! Internals real(DP), dimension(NDIM) :: Lresidual, Lbefore, Lafter, Lspin, rot - real(DP) :: ke_residual, rotmag_old, rotmag_new, vmag_old, vmag_new integer(I4B) :: i, loop - integer(I4B) :: MAXLOOP = 10 associate(fragments => collider%fragments, impactors => collider%impactors, nfrag => collider%fragments%nbody) @@ -505,19 +504,10 @@ module subroutine collision_generate_simple_rot_vec(collider) fragments%rot(:,1) = Lspin(:) / (fragments%mass(1) * fragments%radius(1)**2 * fragments%Ip(3,1)) - Lresidual(:) = sum(impactors%Lspin(:,:) + impactors%Lorbit(:,:), dim=2) - Lspin(:) - ! Randomize the rotational vector direction of the n>1 fragments and distribute the residual momentum amongst them call random_number(fragments%rot(:,2:nfrag)) - rot(:) = Lresidual(:) / sum(fragments%mass(2:nfrag) * fragments%radius(2:nfrag)**2 * fragments%Ip(3,2:nfrag)) - - fragments%rot(:,2:nfrag) = .unit. fragments%rot(:,2:nfrag) * .mag. rot(:) - - if (.mag.(Lresidual(:)) > tiny(1.0_DP)) then - do i = 2,nfrag - fragments%rot(:,i) = fragments%rot(:,i) + Lresidual(:) / ((nfrag - 1) * fragments%mass(i) * fragments%radius(i)**2 * fragments%Ip(3,i)) - end do - end if + fragments%rot(:,2:nfrag) = .unit. fragments%rot(:,2:nfrag) * .mag. fragments%rot(:,1) + call fragments%set_spins() end associate @@ -576,12 +566,9 @@ module subroutine collision_generate_simple_vel_vec(collider) mass_vscale(:) = sqrt(2*mass_vscale(:) / maxval(mass_vscale(:))) fragments%vc(:,1) = .mag.impactors%vc(:,1) * impactors%bounce_unit(:) do concurrent(i = 2:nfrag) - j = fragments%origin_body(i) vrot(:) = impactors%rot(:,j) .cross. (fragments%rc(:,i) - impactors%rb(:,j) + impactors%rbcom(:)) - vmag = .mag.impactors%vc(:,j) * vscale(i) * mass_vscale(i) - if (lhitandrun) then fragments%vc(:,i) = vmag * 0.5_DP * impactors%bounce_unit(:) * vsign(i) + vrot(:) else diff --git a/src/collision/collision_module.f90 b/src/collision/collision_module.f90 index ed94b6be1..4e33889c9 100644 --- a/src/collision/collision_module.f90 +++ b/src/collision/collision_module.f90 @@ -114,10 +114,13 @@ module collision real(DP), dimension(NDIM) :: Lspin !! Spin angular momentum vector of all fragments real(DP) :: ke_orbit !! Orbital kinetic energy of all fragments real(DP) :: ke_spin !! Spin kinetic energy of all fragments + real(DP) :: ke_budget !! Kinetic energy budget for computing fragment trajectories + real(DP), dimension(NDIM) :: L_budget !! Angular momentum budget for computing fragment trajectories contains procedure :: reset => collision_util_reset_fragments !! Deallocates all allocatable arrays and sets everything else to 0 procedure :: get_angular_momentum => collision_util_get_angular_momentum !! Calcualtes the current angular momentum of the fragments procedure :: get_kinetic_energy => collision_util_get_kinetic_energy !! Calcualtes the current kinetic energy of the fragments + procedure :: set_spins => collision_util_set_spins !! Calcualtes the spins of all fragments from the angular momentum budget and residual final :: collision_final_fragments !! Finalizer deallocates all allocatables end type collision_fragments @@ -149,6 +152,7 @@ module collision procedure :: construct_temporary_system => collision_util_construct_temporary_system !! Constructs temporary n-body nbody_system in order to compute pre- and post-impact energy and momentum procedure :: get_energy_and_momentum => collision_util_get_energy_momentum !! Calculates total nbody_system energy in either the pre-collision outcome state (lbefore = .true.) or the post-collision outcome state (lbefore = .false.) procedure :: reset => collision_util_reset_system !! Deallocates all allocatables + procedure :: set_budgets => collision_util_set_budgets !! Sets the energy and momentum budgets of the fragments based on the collider value procedure :: set_coordinate_system => collision_util_set_coordinate_collider !! Sets the coordinate system of the collisional system procedure :: generate => collision_generate_basic !! Merges the impactors to make a single final body procedure :: hitandrun => collision_generate_hitandrun !! Merges the impactors to make a single final body @@ -393,7 +397,6 @@ module subroutine collision_resolve_pltp(self, nbody_system, param, t, dt, irec) integer(I4B), intent(in) :: irec !! Current recursion level end subroutine collision_resolve_pltp - module subroutine collision_util_add_fragments_to_collider(self, nbody_system, param) implicit none class(collision_basic), intent(in) :: self !! Collision system object @@ -410,15 +413,14 @@ module subroutine collision_util_construct_temporary_system(self, nbody_system, class(base_parameters), allocatable, intent(out) :: tmpparam !! Output temporary configuration run parameters end subroutine collision_util_construct_temporary_system - module subroutine collision_util_get_angular_momentum(self) implicit none - class(collision_fragments(*)), intent(inout) :: self !! Fraggle fragment system object + class(collision_fragments(*)), intent(inout) :: self !! Fragment system object end subroutine collision_util_get_angular_momentum module subroutine collision_util_get_kinetic_energy(self) implicit none - class(collision_fragments(*)), intent(inout) :: self !! Fraggle fragment system object + class(collision_fragments(*)), intent(inout) :: self !! Fragment system object end subroutine collision_util_get_kinetic_energy module subroutine collision_util_reset_fragments(self) @@ -426,11 +428,10 @@ module subroutine collision_util_reset_fragments(self) class(collision_fragments(*)), intent(inout) :: self end subroutine collision_util_reset_fragments - module subroutine collision_util_set_mass_dist(self, param) + module subroutine collision_util_set_budgets(self) implicit none - class(collision_simple_disruption), intent(inout) :: self !! Simple disruption collision object - class(base_parameters), intent(in) :: param !! Current Swiftest run configuration parameters - end subroutine collision_util_set_mass_dist + class(collision_basic), intent(inout) :: self !! Collision system object + end subroutine collision_util_set_budgets module subroutine collision_util_set_coordinate_collider(self) implicit none @@ -442,6 +443,17 @@ module subroutine collision_util_set_coordinate_impactors(self) class(collision_impactors), intent(inout) :: self !! collisional system end subroutine collision_util_set_coordinate_impactors + module subroutine collision_util_set_mass_dist(self, param) + implicit none + class(collision_simple_disruption), intent(inout) :: self !! Simple disruption collision object + class(base_parameters), intent(in) :: param !! Current Swiftest run configuration parameters + end subroutine collision_util_set_mass_dist + + module subroutine collision_util_set_spins(self) + implicit none + class(collision_fragments(*)), intent(inout) :: self !! Collision fragment system object + end subroutine collision_util_set_spins + module subroutine collision_util_setup_collider(self, nbody_system) implicit none class(collision_basic), intent(inout) :: self !! Encounter collision system object @@ -554,7 +566,7 @@ subroutine collision_final_plpl(self) !! Finalizer will deallocate all allocatables implicit none ! Arguments - type(collision_list_plpl), intent(inout) :: self !! Fraggle encountar storage object + type(collision_list_plpl), intent(inout) :: self !! PL-PL collision list object call self%dealloc() @@ -567,7 +579,7 @@ subroutine collision_final_pltp(self) !! Finalizer will deallocate all allocatables implicit none ! Arguments - type(collision_list_pltp), intent(inout) :: self !! Fraggle encountar storage object + type(collision_list_pltp), intent(inout) :: self !! PL-TP collision list object call self%dealloc() @@ -581,7 +593,7 @@ subroutine collision_final_snapshot(self) !! Finalizer will deallocate all allocatables implicit none ! Arguments - type(collision_snapshot), intent(inout) :: self !! Fraggle encountar storage object + type(collision_snapshot), intent(inout) :: self !! Collsion snapshot object call encounter_final_snapshot(self%encounter_snapshot) diff --git a/src/collision/collision_util.f90 b/src/collision/collision_util.f90 index 94dce4f6d..6deacbf3d 100644 --- a/src/collision/collision_util.f90 +++ b/src/collision/collision_util.f90 @@ -175,7 +175,6 @@ module subroutine collision_util_get_idvalues_snapshot(self, idvals) end subroutine collision_util_get_idvalues_snapshot - module subroutine collision_util_get_angular_momentum(self) !! Author: David A. Minton !! @@ -417,6 +416,31 @@ module subroutine collision_util_reset_system(self) end subroutine collision_util_reset_system + module subroutine collision_util_set_budgets(self) + !! author: David A. Minton + !! + !! Sets the energy and momentum budgets of the fragments based on the collider values and the before/after values of energy and momentum + implicit none + ! Arguments + class(collision_basic), intent(inout) :: self !! Fraggle collision system object + ! Internals + real(DP) :: dEtot + real(DP), dimension(NDIM) :: dL + + associate(impactors => self%impactors, fragments => self%fragments) + + dEtot = self%Etot(1) + dL(:) = self%Ltot(:,1) + + fragments%L_budget(:) = -dL(:) + fragments%ke_budget = -(dEtot - impactors%Qloss) + + end associate + + return + end subroutine collision_util_set_budgets + + module subroutine collision_util_set_coordinate_collider(self) !! author: David A. Minton !! @@ -675,6 +699,31 @@ module subroutine collision_util_set_mass_dist(self, param) end subroutine collision_util_set_mass_dist + module subroutine collision_util_set_spins(self) + !! Author: David A. Minton + !! + !! Distributes any residual angular momentum into the spins of the n>1 fragments + implicit none + ! Arguments + class(collision_fragments(*)), intent(inout) :: self !! Collision fragment system object + ! Internals + integer(I4B) :: i + real(DP), dimension(NDIM) :: Lresidual + + call self%get_angular_momentum() + Lresidual(:) = self%L_budget(:) - (self%Lorbit(:) + self%Lspin(:)) + + ! Distribute residual angular momentum amongst the fragments + if (.mag.(Lresidual(:)) > tiny(1.0_DP)) then + do i = 2,self%nbody + self%rot(:,i) = self%rot(:,i) + Lresidual(:) / ((self%nbody - 1) * self%mass(i) * self%radius(i)**2 * self%Ip(3,i)) + end do + end if + + return + end subroutine collision_util_set_spins + + module subroutine collision_util_setup_collider(self, nbody_system) !! author: David A. Minton !! diff --git a/src/fraggle/fraggle_generate.f90 b/src/fraggle/fraggle_generate.f90 index 8a22b41e4..958c1febf 100644 --- a/src/fraggle/fraggle_generate.f90 +++ b/src/fraggle/fraggle_generate.f90 @@ -197,7 +197,7 @@ subroutine fraggle_generate_minimize(collider, lfailure) end do ! Set spins in order to conserve angular momentum - call fraggle_generate_set_spins(fragments) + call collision_util_set_spins(fragments) if (.not.lfailure) exit tol = tol * 2 ! Keep increasing the tolerance until we converge on a solution @@ -238,7 +238,7 @@ function E_objective_function(val_input) result(fval) call collision_util_shift_vector_to_origin(tmp_frag%mass, tmp_frag%vc) ! Set spins in order to conserve angular momentum - call fraggle_generate_set_spins(tmp_frag) + call collision_util_set_spins(tmp_frag) ! Get the current kinetic energy of the system call tmp_frag%get_kinetic_energy() @@ -261,34 +261,4 @@ end function E_objective_function end subroutine fraggle_generate_minimize - - subroutine fraggle_generate_set_spins(fragments) - !! Author: David A. Minton - !! - !! Distributes any residual angular momentum into the spins of the n>1 fragments - implicit none - ! Arguments - class(fraggle_fragments(*)), intent(inout) :: fragments !! Fraggle fragment system object - ! Internals - integer(I4B) :: i - real(DP), dimension(NDIM) :: Lresidual - - call fragments%get_angular_momentum() - Lresidual(:) = fragments%L_budget(:) - (fragments%Lorbit(:) + fragments%Lspin(:)) - - ! Distribute residual angular momentum amongst the fragments - if (.mag.(Lresidual(:)) > tiny(1.0_DP)) then - do i = 2,fragments%nbody - fragments%rot(:,i) = fragments%rot(:,i) + Lresidual(:) / ((fragments%nbody - 1) * fragments%mass(i) * fragments%radius(i)**2 * fragments%Ip(3,i)) - end do - end if - - return - end subroutine fraggle_generate_set_spins - - - - - - end submodule s_fraggle_generate diff --git a/src/fraggle/fraggle_module.f90 b/src/fraggle/fraggle_module.f90 index a40e196b4..d54afa791 100644 --- a/src/fraggle/fraggle_module.f90 +++ b/src/fraggle/fraggle_module.f90 @@ -20,8 +20,6 @@ module fraggle real(DP), dimension(nbody) :: v_r_mag !! Array of radial direction velocity magnitudes of individual fragments real(DP), dimension(nbody) :: v_t_mag !! Array of tangential direction velocity magnitudes of individual fragments real(DP), dimension(nbody) :: v_n_mag !! Array of normal direction velocity magnitudes of individual fragments - real(DP) :: ke_budget !! Kinetic energy budget for computing fragment trajectories - real(DP), dimension(NDIM) :: L_budget !! Angular momentum budget for computing fragment trajectories contains procedure :: reset => fraggle_util_reset_fragments !! Resets all position and velocity-dependent fragment quantities in order to do a fresh calculation (does not reset mass, radius, or other values that get set prior to the call to fraggle_generate) @@ -39,7 +37,6 @@ module fraggle real(DP) :: Lscale = 1.0_DP !! Angular momentum scale factor (a convenience unit that is derived from dscale, tscale, and mscale) contains procedure :: disrupt => fraggle_generate_disrupt !! Generates a system of fragments in barycentric coordinates that conserves energy and momentum. - procedure :: set_budgets => fraggle_util_set_budgets !! Sets the energy and momentum budgets of the fragments based on the collider value procedure :: set_natural_scale => fraggle_util_set_natural_scale_factors !! Scales dimenional quantities to ~O(1) with respect to the collisional system. procedure :: set_original_scale => fraggle_util_set_original_scale_factors !! Restores dimenional quantities back to the original system units procedure :: setup_fragments => fraggle_util_setup_fragments_system !! Initializer for the fragments of the collision system. @@ -84,11 +81,6 @@ module subroutine fraggle_util_reset_system(self) class(collision_fraggle), intent(inout) :: self !! Collision system object end subroutine fraggle_util_reset_system - module subroutine fraggle_util_set_budgets(self) - implicit none - class(collision_fraggle), intent(inout) :: self !! Fraggle collision system object - end subroutine fraggle_util_set_budgets - module subroutine fraggle_util_set_natural_scale_factors(self) implicit none class(collision_fraggle), intent(inout) :: self !! Fraggle collision system object diff --git a/src/fraggle/fraggle_util.f90 b/src/fraggle/fraggle_util.f90 index f85eed056..94e245c0b 100644 --- a/src/fraggle/fraggle_util.f90 +++ b/src/fraggle/fraggle_util.f90 @@ -87,34 +87,6 @@ module subroutine fraggle_util_reset_system(self) end subroutine fraggle_util_reset_system - module subroutine fraggle_util_set_budgets(self) - !! author: David A. Minton - !! - !! Sets the energy and momentum budgets of the fragments based on the collider values and the before/after values of energy and momentum - implicit none - ! Arguments - class(collision_fraggle), intent(inout) :: self !! Fraggle collision system object - ! Internals - real(DP) :: dEtot - real(DP), dimension(NDIM) :: dL - - associate(impactors => self%impactors) - select type(fragments => self%fragments) - class is (fraggle_fragments(*)) - - dEtot = self%Etot(1) - dL(:) = self%Ltot(:,1) - - fragments%L_budget(:) = -dL(:) - fragments%ke_budget = -(dEtot - impactors%Qloss) - - end select - end associate - - return - end subroutine fraggle_util_set_budgets - - module subroutine fraggle_util_set_natural_scale_factors(self) !! author: David A. Minton !! From 73b45a46a289b110a5e8b4cdc96b59d56ab402b6 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Wed, 28 Dec 2022 08:49:28 -0500 Subject: [PATCH 532/569] Made more improvements to the "simple" model (now called "disruption") --- examples/Fragmentation/Fragmentation_Movie.py | 2 +- src/collision/collision_generate.f90 | 76 ++++++++++++------- src/collision/collision_module.f90 | 16 ++-- src/collision/collision_util.f90 | 53 ++++++++----- src/fraggle/fraggle_generate.f90 | 10 +-- src/fraggle/fraggle_module.f90 | 2 +- src/swiftest/swiftest_io.f90 | 6 +- src/swiftest/swiftest_util.f90 | 4 +- 8 files changed, 105 insertions(+), 64 deletions(-) diff --git a/examples/Fragmentation/Fragmentation_Movie.py b/examples/Fragmentation/Fragmentation_Movie.py index ebad58734..f216fc242 100644 --- a/examples/Fragmentation/Fragmentation_Movie.py +++ b/examples/Fragmentation/Fragmentation_Movie.py @@ -232,7 +232,7 @@ def data_stream(self, frame=0): # Set fragmentation parameters minimum_fragment_gmass = 0.2 * body_Gmass[style][1] # Make the minimum fragment mass a fraction of the smallest body gmtiny = 0.99 * body_Gmass[style][1] # Make GMTINY just smaller than the smallest original body. This will prevent runaway collisional cascades - sim.set_parameter(collision_model="fraggle", encounter_save="both", gmtiny=gmtiny, minimum_fragment_gmass=minimum_fragment_gmass, verbose=False) + sim.set_parameter(collision_model="disruption", encounter_save="both", gmtiny=gmtiny, minimum_fragment_gmass=minimum_fragment_gmass, verbose=False) sim.run(dt=1e-3, tstop=1.0e-3, istep_out=1, dump_cadence=0) print("Generating animation") diff --git a/src/collision/collision_generate.f90 b/src/collision/collision_generate.f90 index 684970bef..f9ce06541 100644 --- a/src/collision/collision_generate.f90 +++ b/src/collision/collision_generate.f90 @@ -131,7 +131,7 @@ module subroutine collision_generate_hitandrun(self, nbody_system, param, t) ! The simple disruption model (and its extended types allow for non-pure hit and run. !For the basic merge model, all hit and runs are pure select type(self) - class is (collision_simple_disruption) + class is (collision_disruption) if (impactors%mass_dist(2) > 0.9_DP * impactors%mass(jproj)) then ! Pure hit and run, so we'll just keep the two bodies untouched call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Pure hit and run. No new fragments generated.") nfrag = 0 @@ -198,7 +198,7 @@ module subroutine collision_generate_simple(self, nbody_system, param, t) !! implicit none ! Arguments - class(collision_simple_disruption), intent(inout) :: self + class(collision_disruption), intent(inout) :: self class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(base_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions real(DP), intent(in) :: t !! Time of collision @@ -230,6 +230,8 @@ module subroutine collision_generate_simple(self, nbody_system, param, t) end select call self%set_mass_dist(param) call self%get_energy_and_momentum(nbody_system, param, lbefore=.true.) + call self%set_budgets() + call self%set_coordinate_system() call self%disrupt(nbody_system, param, t) call self%get_energy_and_momentum(nbody_system, param, lbefore=.false.) @@ -372,21 +374,19 @@ module subroutine collision_generate_disrupt(self, nbody_system, param, t, lfail !! author: Jennifer L.L. Pouplin, Carlisle A. Wishard, and David A. Minton !! !! Generates a simple fragment position and velocity distribution based on the collision - !! regime. It makes no attempt to constrain the energy of the collision + !! regime. implicit none ! Arguments - class(collision_simple_disruption), intent(inout) :: self !! Simple fragment system object + class(collision_disruption), intent(inout) :: self !! Simple fragment system object class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(base_parameters), intent(inout) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! The time of the collision logical, optional, intent(out) :: lfailure ! Internals - call self%set_budgets() call collision_generate_simple_pos_vec(self) - call self%set_coordinate_system() - call collision_generate_simple_vel_vec(self) call collision_generate_simple_rot_vec(self) + call collision_generate_simple_vel_vec(self) return end subroutine collision_generate_disrupt @@ -401,7 +401,7 @@ module subroutine collision_generate_simple_pos_vec(collider) !! regenerated if they overlap. implicit none ! Arguments - class(collision_simple_disruption), intent(inout) :: collider !! Fraggle collision system object + class(collision_disruption), intent(inout) :: collider !! Fraggle collision system object ! Internals real(DP) :: dis real(DP), dimension(NDIM,2) :: fragment_cloud_center @@ -461,6 +461,7 @@ module subroutine collision_generate_simple_pos_vec(collider) rdistance = rdistance * fail_scale fragment_cloud_radius(:) = fragment_cloud_radius(:) * fail_scale end do + call collision_util_shift_vector_to_origin(fragments%mass, fragments%rc) call collider%set_coordinate_system() @@ -487,27 +488,33 @@ module subroutine collision_generate_simple_rot_vec(collider) ! Arguments class(collision_basic), intent(inout) :: collider !! Fraggle collision system object ! Internals - real(DP), dimension(NDIM) :: Lresidual, Lbefore, Lafter, Lspin, rot - integer(I4B) :: i, loop + real(DP), dimension(NDIM) :: Lbefore, Lafter, Lspin, rotdir + real(DP) :: v_init, v_final, mass_init, mass_final, rotmag + integer(I4B) :: i associate(fragments => collider%fragments, impactors => collider%impactors, nfrag => collider%fragments%nbody) - fragments%rot(:,:) = 0.0_DP - ! Torque the first body based on the change in angular momentum betwen the pre- and post-impact system - Lbefore(:) = impactors%mass(2) * (impactors%rb(:,2) - impactors%rb(:,1)) .cross. (impactors%vb(:,2) - impactors%vb(:,1)) + ! Torque the first body based on the change in angular momentum betwen the pre- and post-impact system assuming a simple bounce + mass_init = impactors%mass(2) + mass_final = sum(fragments%mass(2:nfrag)) + v_init = .mag.(impactors%vb(:,2) - impactors%vb(:,1)) + v_final = sqrt(mass_init / mass_final * v_init**2 - 2 * impactors%Qloss / mass_final) - Lafter(:) = 0.0_DP - do i = 2, nfrag - Lafter(:) = Lafter(:) + fragments%mass(i) * (fragments%rb(:,i) - fragments%rb(:,1)) .cross. (fragments%vb(:,i) - fragments%vb(:,1)) - end do + Lbefore(:) = mass_init * (impactors%rb(:,2) - impactors%rb(:,1)) .cross. (impactors%vb(:,2) - impactors%vb(:,1)) + + Lafter(:) = mass_final * (impactors%rb(:,2) - impactors%rb(:,1)) .cross. (v_final * impactors%bounce_unit(:)) Lspin(:) = impactors%Lspin(:,1) + (Lbefore(:) - Lafter(:)) - fragments%rot(:,1) = Lspin(:) / (fragments%mass(1) * fragments%radius(1)**2 * fragments%Ip(3,1)) - ! Randomize the rotational vector direction of the n>1 fragments and distribute the residual momentum amongst them - call random_number(fragments%rot(:,2:nfrag)) - fragments%rot(:,2:nfrag) = .unit. fragments%rot(:,2:nfrag) * .mag. fragments%rot(:,1) - call fragments%set_spins() + ! Add in some random spin noise. The magnitude will be scaled by the before-after amount and the direction will be random + do concurrent(i = 2:nfrag) + call random_number(rotdir) + rotdir = rotdir - 0.5_DP + rotdir = .unit. rotdir + call random_number(rotmag) + rotmag = rotmag * .mag. (Lbefore(:) - Lafter(:)) / ((nfrag - 1) * fragments%mass(i) * fragments%radius(i)**2 * fragments%Ip(3,i)) + fragments%rot(:,i) = rotmag * rotdir + end do end associate @@ -523,13 +530,13 @@ module subroutine collision_generate_simple_vel_vec(collider) !! 2x the escape velocity of the smallest of the two bodies. implicit none ! Arguments - class(collision_simple_disruption), intent(inout) :: collider !! Fraggle collision system object + class(collision_disruption), intent(inout) :: collider !! Fraggle collision system object ! Internals integer(I4B) :: i,j logical :: lhitandrun, lnoncat - real(DP), dimension(NDIM) :: vimp_unit, rimp, vrot + real(DP), dimension(NDIM) :: vimp_unit, rimp, vrot, Lresidual, vshear real(DP), dimension(2) :: vimp - real(DP) :: vmag, vdisp + real(DP) :: vmag, vdisp, Lmag integer(I4B), dimension(collider%fragments%nbody) :: vsign real(DP), dimension(collider%fragments%nbody) :: vscale, mass_vscale @@ -563,11 +570,11 @@ module subroutine collision_generate_simple_vel_vec(collider) call random_number(mass_vscale) mass_vscale(:) = (mass_vscale(:) + 1.0_DP) / 2 mass_vscale(:) = mass_vscale(:) * (fragments%mtot / fragments%mass(:))**(0.125_DP) - mass_vscale(:) = sqrt(2*mass_vscale(:) / maxval(mass_vscale(:))) + mass_vscale(:) = 2*mass_vscale(:) / maxval(mass_vscale(:)) fragments%vc(:,1) = .mag.impactors%vc(:,1) * impactors%bounce_unit(:) do concurrent(i = 2:nfrag) j = fragments%origin_body(i) - vrot(:) = impactors%rot(:,j) .cross. (fragments%rc(:,i) - impactors%rb(:,j) + impactors%rbcom(:)) + vrot(:) = impactors%rot(:,j) .cross. (fragments%rc(:,i) - impactors%rc(:,j)) vmag = .mag.impactors%vc(:,j) * vscale(i) * mass_vscale(i) if (lhitandrun) then fragments%vc(:,i) = vmag * 0.5_DP * impactors%bounce_unit(:) * vsign(i) + vrot(:) @@ -578,6 +585,18 @@ module subroutine collision_generate_simple_vel_vec(collider) fragments%vc(:,i) = vmag * 0.5_DP * (impactors%bounce_unit(:) + vimp_unit(:)) * vsign(i) + vrot(:) end if end do + call collider%set_coordinate_system() + ! Check for any residual angular momentum, and if there is any, put it into velocity shear of the fragments + call fragments%get_angular_momentum() + if (all(fragments%L_budget(:) / (fragments%Lorbit(:) + fragments%Lspin(:)) > epsilon(1.0_DP))) then + Lresidual(:) = fragments%L_budget(:) - (fragments%Lorbit(:) + fragments%Lspin(:)) + do concurrent(i = 3:nfrag) + vshear(:) = Lresidual(:) / (nfrag - 2) / (fragments%mass(i) * fragments%rc(:,i) .cross. fragments%v_t_unit(:,i)) + vshear(:) = .mag.vshear(:) * fragments%v_t_unit(:,i) + fragments%vc(:,i) = fragments%vc(:,i) + vshear(:) + end do + end if + do concurrent(i = 1:nfrag) fragments%vb(:,i) = fragments%vc(:,i) + impactors%vbcom(:) end do @@ -588,6 +607,9 @@ module subroutine collision_generate_simple_vel_vec(collider) end do impactors%vbcom(:) = impactors%vbcom(:) / fragments%mtot + ! Distribute any remaining angular momentum into fragments pin + call fragments%set_spins() + end associate return end subroutine collision_generate_simple_vel_vec diff --git a/src/collision/collision_module.f90 b/src/collision/collision_module.f90 index 4e33889c9..88698e360 100644 --- a/src/collision/collision_module.f90 +++ b/src/collision/collision_module.f90 @@ -165,13 +165,13 @@ module collision final :: collision_final_bounce !! Finalizer will deallocate all allocatables end type collision_bounce - type, extends(collision_basic) :: collision_simple_disruption + type, extends(collision_basic) :: collision_disruption contains procedure :: generate => collision_generate_simple !! A simple disruption models that does not constrain energy loss in collisions procedure :: disrupt => collision_generate_disrupt !! Disrupt the colliders into the fragments procedure :: set_mass_dist => collision_util_set_mass_dist !! Sets the distribution of mass among the fragments depending on the regime type final :: collision_final_simple !! Finalizer will deallocate all allocatables - end type collision_simple_disruption + end type collision_disruption !! NetCDF dimension and variable names for the enounter save object @@ -235,7 +235,7 @@ end subroutine collision_generate_bounce module subroutine collision_generate_disrupt(self, nbody_system, param, t, lfailure) implicit none - class(collision_simple_disruption), intent(inout) :: self + class(collision_disruption), intent(inout) :: self class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(base_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions real(DP), intent(in) :: t !! Time of collision @@ -260,7 +260,7 @@ end subroutine collision_generate_merge module subroutine collision_generate_simple(self, nbody_system, param, t) implicit none - class(collision_simple_disruption), intent(inout) :: self !! Simple fragment nbody_system object + class(collision_disruption), intent(inout) :: self !! Simple fragment nbody_system object class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(base_parameters), intent(inout) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! The time of the collision @@ -268,7 +268,7 @@ end subroutine collision_generate_simple module subroutine collision_generate_simple_pos_vec(collider) implicit none - class(collision_simple_disruption), intent(inout) :: collider !! Collision system object + class(collision_disruption), intent(inout) :: collider !! Collision system object end subroutine collision_generate_simple_pos_vec module subroutine collision_generate_simple_rot_vec(collider) @@ -278,7 +278,7 @@ end subroutine collision_generate_simple_rot_vec module subroutine collision_generate_simple_vel_vec(collider) implicit none - class(collision_simple_disruption), intent(inout) :: collider !! Collision system object + class(collision_disruption), intent(inout) :: collider !! Collision system object end subroutine collision_generate_simple_vel_vec module subroutine collision_io_collider_message(pl, collidx, collider_message) @@ -445,7 +445,7 @@ end subroutine collision_util_set_coordinate_impactors module subroutine collision_util_set_mass_dist(self, param) implicit none - class(collision_simple_disruption), intent(inout) :: self !! Simple disruption collision object + class(collision_disruption), intent(inout) :: self !! Simple disruption collision object class(base_parameters), intent(in) :: param !! Current Swiftest run configuration parameters end subroutine collision_util_set_mass_dist @@ -641,7 +641,7 @@ subroutine collision_final_simple(self) !! Finalizer will deallocate all allocatables implicit none ! Arguments - type(collision_simple_disruption), intent(inout) :: self !! Collision system object + type(collision_disruption), intent(inout) :: self !! Collision system object call self%reset() if (allocated(self%impactors)) deallocate(self%impactors) diff --git a/src/collision/collision_util.f90 b/src/collision/collision_util.f90 index 6deacbf3d..8151bdfa8 100644 --- a/src/collision/collision_util.f90 +++ b/src/collision/collision_util.f90 @@ -432,8 +432,8 @@ module subroutine collision_util_set_budgets(self) dEtot = self%Etot(1) dL(:) = self%Ltot(:,1) - fragments%L_budget(:) = -dL(:) - fragments%ke_budget = -(dEtot - impactors%Qloss) + fragments%L_budget(:) = dL(:) + fragments%ke_budget = (dEtot - impactors%Qloss) end associate @@ -448,28 +448,20 @@ module subroutine collision_util_set_coordinate_collider(self) implicit none ! Arguments class(collision_basic), intent(inout) :: self !! Collisional nbody_system - ! Internals - integer(I4B) :: i - real(DP), dimension(NDIM, self%fragments%nbody) :: L_sigma associate(fragments => self%fragments, impactors => self%impactors, nfrag => self%fragments%nbody) call impactors%set_coordinate_system() - if ((.not.allocated(self%fragments)) .or. (nfrag == 0) .or. (.not.any(fragments%rc(:,:) > 0.0_DP))) return + if (.not.allocated(self%fragments)) return + if ((nfrag == 0) .or. (.not.any(fragments%rc(:,:) > 0.0_DP))) return fragments%rmag(:) = .mag. fragments%rc(:,:) + fragments%vmag(:) = .mag. fragments%vc(:,:) - ! Randomize the tangential velocity direction. - ! This helps to ensure that the tangential velocity doesn't completely line up with the angular momentum vector, otherwise we can get an ill-conditioned nbody_system - call random_number(L_sigma(:,:)) - do concurrent(i = 1:nfrag, fragments%rmag(i) > 0.0_DP) - fragments%v_n_unit(:, i) = impactors%z_unit(:) + 2e-1_DP * (L_sigma(:,i) - 0.5_DP) - end do - ! Define the radial, normal, and tangential unit vectors for each individual fragment fragments%v_r_unit(:,:) = .unit. fragments%rc(:,:) - fragments%v_n_unit(:,:) = .unit. fragments%v_n_unit(:,:) - fragments%v_t_unit(:,:) = .unit. (fragments%v_n_unit(:,:) .cross. fragments%v_r_unit(:,:)) + fragments%v_t_unit(:,:) = .unit. fragments%vc(:,:) + fragments%v_n_unit(:,:) = .unit. (fragments%v_r_unit(:,:) .cross. fragments%v_t_unit(:,:)) end associate @@ -546,7 +538,7 @@ module subroutine collision_util_set_mass_dist(self, param) !! implicit none ! Arguments - class(collision_simple_disruption), intent(inout) :: self !! Fraggle collision system object + class(collision_disruption), intent(inout) :: self !! Fraggle collision system object class(base_parameters), intent(in) :: param !! Current Swiftest run configuration parameters ! Internals integer(I4B) :: i, j, jproj, jtarg, nfrag, istart @@ -712,7 +704,6 @@ module subroutine collision_util_set_spins(self) call self%get_angular_momentum() Lresidual(:) = self%L_budget(:) - (self%Lorbit(:) + self%Lspin(:)) - ! Distribute residual angular momentum amongst the fragments if (.mag.(Lresidual(:)) > tiny(1.0_DP)) then do i = 2,self%nbody @@ -720,6 +711,10 @@ module subroutine collision_util_set_spins(self) end do end if + ! Test to see if we were successful + call self%get_angular_momentum() + Lresidual(:) = self%L_budget(:) - (self%Lorbit(:) + self%Lspin(:)) + return end subroutine collision_util_set_spins @@ -772,6 +767,30 @@ module subroutine collision_util_setup_fragments_collider(self, nfrag) if (allocated(self%fragments)) deallocate(self%fragments) allocate(collision_fragments(nfrag) :: self%fragments) self%fragments%nbody = nfrag + self%fragments%nbody = nfrag + self%fragments%status(:) = ACTIVE + self%fragments%rh(:,:) = 0.0_DP + self%fragments%vh(:,:) = 0.0_DP + self%fragments%rb(:,:) = 0.0_DP + self%fragments%vb(:,:) = 0.0_DP + self%fragments%rc(:,:) = 0.0_DP + self%fragments%vc(:,:) = 0.0_DP + self%fragments%rot(:,:) = 0.0_DP + self%fragments%Ip(:,:) = 0.0_DP + self%fragments%v_r_unit(:,:) = 0.0_DP + self%fragments%v_t_unit(:,:) = 0.0_DP + self%fragments%v_n_unit(:,:) = 0.0_DP + self%fragments%mass(:) = 0.0_DP + self%fragments%radius(:) = 0.0_DP + self%fragments%density(:) = 0.0_DP + self%fragments%rmag(:) = 0.0_DP + self%fragments%vmag(:) = 0.0_DP + self%fragments%Lorbit(:) = 0.0_DP + self%fragments%Lspin(:) = 0.0_DP + self%fragments%L_budget(:) = 0.0_DP + self%fragments%ke_orbit = 0.0_DP + self%fragments%ke_spin = 0.0_DP + self%fragments%ke_budget = 0.0_DP return end subroutine collision_util_setup_fragments_collider diff --git a/src/fraggle/fraggle_generate.f90 b/src/fraggle/fraggle_generate.f90 index 958c1febf..4ccc9d12c 100644 --- a/src/fraggle/fraggle_generate.f90 +++ b/src/fraggle/fraggle_generate.f90 @@ -85,10 +85,10 @@ module subroutine fraggle_generate_disrupt(self, nbody_system, param, t, lfailur end if lfailure_local = .false. - ! Use the simple collision model to generate initial conditions + ! Use the disruption collision model to generate initial conditions ! Compute the "before" energy/momentum and the budgets call self%get_energy_and_momentum(nbody_system, param, lbefore=.true.) - call self%collision_simple_disruption%disrupt(nbody_system, param, t) + call self%collision_disruption%disrupt(nbody_system, param, t) call self%get_energy_and_momentum(nbody_system, param, lbefore=.false.) call self%set_budgets() @@ -167,7 +167,7 @@ subroutine fraggle_generate_minimize(collider, lfailure) real(DP), dimension(:), allocatable :: output_v type(lambda_obj) :: Efunc real(DP) :: tol, fval - integer(I4B) :: i, nelem + integer(I4B) :: loop,i, nelem associate(impactors => collider%impactors, nfrag => collider%fragments%nbody) select type(fragments => collider%fragments) @@ -182,7 +182,7 @@ subroutine fraggle_generate_minimize(collider, lfailure) fragments%v_r_unit(:,:) = .unit. fragments%vc(:,:) fragments%vmag(:) = .mag. fragments%vc(:,1:nfrag) fragments%rot(:,1:nfrag) = fragments%rot(:,1:nfrag) * 1e-12_DP - do while(tol < TOL_MIN) + do loop = 1, 3 !while(tol < TOL_MIN) input_v(:) = fragments%vmag(1:nfrag) fval = E_objective_function(input_v) @@ -197,7 +197,7 @@ subroutine fraggle_generate_minimize(collider, lfailure) end do ! Set spins in order to conserve angular momentum - call collision_util_set_spins(fragments) + call fragments%set_spins() if (.not.lfailure) exit tol = tol * 2 ! Keep increasing the tolerance until we converge on a solution diff --git a/src/fraggle/fraggle_module.f90 b/src/fraggle/fraggle_module.f90 index d54afa791..8d6964aa4 100644 --- a/src/fraggle/fraggle_module.f90 +++ b/src/fraggle/fraggle_module.f90 @@ -27,7 +27,7 @@ module fraggle end type fraggle_fragments - type, extends(collision_simple_disruption) :: collision_fraggle + type, extends(collision_disruption) :: collision_fraggle ! Scale factors used to scale dimensioned quantities to a more "natural" system where important quantities (like kinetic energy, momentum) are of order ~1 real(DP) :: dscale = 1.0_DP !! Distance dimension scale factor real(DP) :: mscale = 1.0_DP !! Mass scale factor diff --git a/src/swiftest/swiftest_io.f90 b/src/swiftest/swiftest_io.f90 index ca36846da..2ba53b5e5 100644 --- a/src/swiftest/swiftest_io.f90 +++ b/src/swiftest/swiftest_io.f90 @@ -2085,16 +2085,16 @@ module subroutine swiftest_io_param_reader(self, unit, iotype, v_list, iostat, i if ((param%collision_model /= "MERGE") .and. & - (param%collision_model /= "SIMPLE") .and. & (param%collision_model /= "BOUNCE") .and. & + (param%collision_model /= "DISRUPTION") .and. & (param%collision_model /= "FRAGGLE")) then write(iomsg,*) 'Invalid collision_model parameter: ',trim(adjustl(param%out_type)) - write(iomsg,*) 'Valid options are NONE, TRAJECTORY, CLOSEST, or BOTH' + write(iomsg,*) 'Valid options are MERGE, BOUNCE, DISRUPTION, or FRAGGLE' iostat = -1 return end if - if (param%collision_model == "FRAGGLE") then + if (param%collision_model == "FRAGGLE" .or. param%collision_model == "DISRUPTION") then if (seed_set) then call random_seed(put = param%seed) else diff --git a/src/swiftest/swiftest_util.f90 b/src/swiftest/swiftest_util.f90 index b17dce303..49c2d0362 100644 --- a/src/swiftest/swiftest_util.f90 +++ b/src/swiftest/swiftest_util.f90 @@ -2642,8 +2642,8 @@ module subroutine swiftest_util_setup_construct_system(nbody_system, param) allocate(collision_basic :: nbody_system%collider) case("BOUNCE") allocate(collision_bounce :: nbody_system%collider) - case("SIMPLE") - allocate(collision_simple_disruption :: nbody_system%collider) + case("DISRUPTION") + allocate(collision_disruption :: nbody_system%collider) case("FRAGGLE") allocate(collision_fraggle :: nbody_system%collider) end select From f4409b71f44ca9a8aa48834eaf16e39784db44f9 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Wed, 28 Dec 2022 12:45:27 -0500 Subject: [PATCH 533/569] More refinements to Fraggle attempting to get better success rate --- examples/Fragmentation/Fragmentation_Movie.py | 2 +- src/collision/collision_generate.f90 | 2 +- src/collision/collision_util.f90 | 10 ++-------- src/fraggle/fraggle_generate.f90 | 8 ++++---- src/misc/minimizer_module.f90 | 2 +- 5 files changed, 9 insertions(+), 15 deletions(-) diff --git a/examples/Fragmentation/Fragmentation_Movie.py b/examples/Fragmentation/Fragmentation_Movie.py index f216fc242..ebad58734 100644 --- a/examples/Fragmentation/Fragmentation_Movie.py +++ b/examples/Fragmentation/Fragmentation_Movie.py @@ -232,7 +232,7 @@ def data_stream(self, frame=0): # Set fragmentation parameters minimum_fragment_gmass = 0.2 * body_Gmass[style][1] # Make the minimum fragment mass a fraction of the smallest body gmtiny = 0.99 * body_Gmass[style][1] # Make GMTINY just smaller than the smallest original body. This will prevent runaway collisional cascades - sim.set_parameter(collision_model="disruption", encounter_save="both", gmtiny=gmtiny, minimum_fragment_gmass=minimum_fragment_gmass, verbose=False) + sim.set_parameter(collision_model="fraggle", encounter_save="both", gmtiny=gmtiny, minimum_fragment_gmass=minimum_fragment_gmass, verbose=False) sim.run(dt=1e-3, tstop=1.0e-3, istep_out=1, dump_cadence=0) print("Generating animation") diff --git a/src/collision/collision_generate.f90 b/src/collision/collision_generate.f90 index f9ce06541..eca87ed83 100644 --- a/src/collision/collision_generate.f90 +++ b/src/collision/collision_generate.f90 @@ -231,7 +231,7 @@ module subroutine collision_generate_simple(self, nbody_system, param, t) call self%set_mass_dist(param) call self%get_energy_and_momentum(nbody_system, param, lbefore=.true.) call self%set_budgets() - call self%set_coordinate_system() + call impactors%set_coordinate_system() call self%disrupt(nbody_system, param, t) call self%get_energy_and_momentum(nbody_system, param, lbefore=.false.) diff --git a/src/collision/collision_util.f90 b/src/collision/collision_util.f90 index 8151bdfa8..b4141185a 100644 --- a/src/collision/collision_util.f90 +++ b/src/collision/collision_util.f90 @@ -423,17 +423,11 @@ module subroutine collision_util_set_budgets(self) implicit none ! Arguments class(collision_basic), intent(inout) :: self !! Fraggle collision system object - ! Internals - real(DP) :: dEtot - real(DP), dimension(NDIM) :: dL associate(impactors => self%impactors, fragments => self%fragments) - dEtot = self%Etot(1) - dL(:) = self%Ltot(:,1) - - fragments%L_budget(:) = dL(:) - fragments%ke_budget = (dEtot - impactors%Qloss) + fragments%L_budget(:) = self%Ltot(:,1) + fragments%ke_budget = self%Etot(1) - impactors%Qloss end associate diff --git a/src/fraggle/fraggle_generate.f90 b/src/fraggle/fraggle_generate.f90 index 4ccc9d12c..5205335b5 100644 --- a/src/fraggle/fraggle_generate.f90 +++ b/src/fraggle/fraggle_generate.f90 @@ -101,7 +101,7 @@ module subroutine fraggle_generate_disrupt(self, nbody_system, param, t, lfailur lfailure_local = (dEtot > 0.0_DP) if (lfailure_local) then - write(message, *) dEtot, abs(dEtot + impactors%Qloss) / FRAGGLE_ETOL + write(message, *) "dEtot: ",dEtot, "dEtot/Qloss", dEtot / impactors%Qloss call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Fraggle failed due to energy gain: " // & trim(adjustl(message))) !cycle @@ -161,7 +161,7 @@ subroutine fraggle_generate_minimize(collider, lfailure) logical, intent(out) :: lfailure !! Logical flag indicating whether this step fails or succeeds ! Internals real(DP), parameter :: TOL_MIN = 1.0e-5_DP - real(DP), parameter :: TOL_INIT = 1e-6_DP + real(DP), parameter :: TOL_INIT = 1e-8_DP integer(I4B), parameter :: MAXLOOP = 50 real(DP), dimension(collider%fragments%nbody) :: input_v real(DP), dimension(:), allocatable :: output_v @@ -181,13 +181,13 @@ subroutine fraggle_generate_minimize(collider, lfailure) fragments%v_r_unit(:,:) = .unit. fragments%vc(:,:) fragments%vmag(:) = .mag. fragments%vc(:,1:nfrag) - fragments%rot(:,1:nfrag) = fragments%rot(:,1:nfrag) * 1e-12_DP do loop = 1, 3 !while(tol < TOL_MIN) input_v(:) = fragments%vmag(1:nfrag) fval = E_objective_function(input_v) call minimize_bfgs(Efunc, nelem, input_v, tol, MAXLOOP, lfailure, output_v) fval = E_objective_function(output_v) + lfailure = lfailure .and. (fval > tol) input_v(:) = output_v(:) fragments%vmag(1:nfrag) = output_v(1:nfrag) @@ -242,7 +242,7 @@ function E_objective_function(val_input) result(fval) ! Get the current kinetic energy of the system call tmp_frag%get_kinetic_energy() - deltaE = tmp_frag%ke_budget - (tmp_frag%ke_orbit + tmp_frag%ke_spin) + deltaE = (tmp_frag%ke_budget - (tmp_frag%ke_orbit + tmp_frag%ke_spin)) / (tmp_frag%ke_budget) ! Use the deltaE as the basis of our objective function, with a higher penalty for having excess kinetic energy compared with having a deficit if (deltaE < 0.0_DP) then diff --git a/src/misc/minimizer_module.f90 b/src/misc/minimizer_module.f90 index e17cee3e9..8beab3879 100644 --- a/src/misc/minimizer_module.f90 +++ b/src/misc/minimizer_module.f90 @@ -128,7 +128,7 @@ module subroutine minimize_bfgs(f, N, x0, eps, maxloop, lerr, x1) real(DP), dimension(:), intent(out), allocatable :: x1 ! Internals integer(I4B) :: i, j, k, l, conv - real(DP), parameter :: graddelta = 1e-2_DP !! Delta x for gradient calculations + real(DP), parameter :: graddelta = 1e-4_DP !! Delta x for gradient calculations real(DP), dimension(N) :: S !! Direction vectors real(DP), dimension(N,N) :: H !! Approximated inverse Hessian matrix real(DP), dimension(N) :: grad1 !! gradient of f From 5e98edd66384938015bfa2b82728930b5622d552 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Wed, 28 Dec 2022 13:09:41 -0500 Subject: [PATCH 534/569] More refinement aimed at improving stability of Fraggle --- src/collision/collision_util.f90 | 4 --- src/fraggle/fraggle_generate.f90 | 56 ++++++++++++++------------------ src/misc/minimizer_module.f90 | 2 +- 3 files changed, 26 insertions(+), 36 deletions(-) diff --git a/src/collision/collision_util.f90 b/src/collision/collision_util.f90 index b4141185a..13d97b4e1 100644 --- a/src/collision/collision_util.f90 +++ b/src/collision/collision_util.f90 @@ -705,10 +705,6 @@ module subroutine collision_util_set_spins(self) end do end if - ! Test to see if we were successful - call self%get_angular_momentum() - Lresidual(:) = self%L_budget(:) - (self%Lorbit(:) + self%Lspin(:)) - return end subroutine collision_util_set_spins diff --git a/src/fraggle/fraggle_generate.f90 b/src/fraggle/fraggle_generate.f90 index 5205335b5..4ed5efac1 100644 --- a/src/fraggle/fraggle_generate.f90 +++ b/src/fraggle/fraggle_generate.f90 @@ -160,14 +160,14 @@ subroutine fraggle_generate_minimize(collider, lfailure) class(collision_fraggle), intent(inout) :: collider !! Fraggle collision system object logical, intent(out) :: lfailure !! Logical flag indicating whether this step fails or succeeds ! Internals - real(DP), parameter :: TOL_MIN = 1.0e-5_DP - real(DP), parameter :: TOL_INIT = 1e-8_DP - integer(I4B), parameter :: MAXLOOP = 50 + real(DP), parameter :: TOL_INIT = 1e-5_DP + integer(I4B), parameter :: MAXLOOP = 100 real(DP), dimension(collider%fragments%nbody) :: input_v real(DP), dimension(:), allocatable :: output_v type(lambda_obj) :: Efunc real(DP) :: tol, fval integer(I4B) :: loop,i, nelem + logical :: lfirst_Efunc associate(impactors => collider%impactors, nfrag => collider%fragments%nbody) select type(fragments => collider%fragments) @@ -175,35 +175,24 @@ subroutine fraggle_generate_minimize(collider, lfailure) nelem = nfrag lfailure = .false. - ! Find the local kinetic energy minimum for the nbody_system that conserves linear and angular momentum + ! Find the local kinetic energy minimum for the nbody_system that conserves linear and angular momentum Efunc = lambda_obj(E_objective_function) tol = TOL_INIT fragments%v_r_unit(:,:) = .unit. fragments%vc(:,:) fragments%vmag(:) = .mag. fragments%vc(:,1:nfrag) - do loop = 1, 3 !while(tol < TOL_MIN) - - input_v(:) = fragments%vmag(1:nfrag) - fval = E_objective_function(input_v) - call minimize_bfgs(Efunc, nelem, input_v, tol, MAXLOOP, lfailure, output_v) - fval = E_objective_function(output_v) - lfailure = lfailure .and. (fval > tol) - input_v(:) = output_v(:) - - fragments%vmag(1:nfrag) = output_v(1:nfrag) - - do concurrent(i=1:nfrag) - fragments%vc(:,i) = abs(fragments%vmag(i)) * fragments%v_r_unit(:,i) - end do - - ! Set spins in order to conserve angular momentum - call fragments%set_spins() - - if (.not.lfailure) exit - tol = tol * 2 ! Keep increasing the tolerance until we converge on a solution + input_v(:) = fragments%vmag(1:nfrag) + lfirst_Efunc = .true. + fval = E_objective_function(input_v) + + call minimize_bfgs(Efunc, nelem, input_v, tol, MAXLOOP, lfailure, output_v) + fragments%vmag(1:nfrag) = output_v(1:nfrag) + do concurrent(i=1:nfrag) + fragments%vc(:,i) = abs(fragments%vmag(i)) * fragments%v_r_unit(:,i) end do - + ! Set spins in order to conserve angular momentum + call fragments%set_spins() call collision_util_shift_vector_to_origin(fragments%mass, fragments%vc) end select end associate @@ -226,7 +215,8 @@ function E_objective_function(val_input) result(fval) integer(I4B) :: i type(fraggle_fragments(:)), allocatable :: tmp_frag real(DP) :: deltaE - + real(DP), save :: deltaE_scale = 1.0_DP + associate(impactors => collider%impactors, nfrag => collider%fragments%nbody) select type(fragments => collider%fragments) class is (fraggle_fragments(*)) @@ -243,13 +233,17 @@ function E_objective_function(val_input) result(fval) ! Get the current kinetic energy of the system call tmp_frag%get_kinetic_energy() deltaE = (tmp_frag%ke_budget - (tmp_frag%ke_orbit + tmp_frag%ke_spin)) / (tmp_frag%ke_budget) - - ! Use the deltaE as the basis of our objective function, with a higher penalty for having excess kinetic energy compared with having a deficit - if (deltaE < 0.0_DP) then - fval = deltaE**8 + + ! The result will be scaled so such that the initial deltaE is 1.0. This helps improve the success of the + ! minimizer, by keeping values from getting to large + if (lfirst_Efunc) then + deltaE_scale = deltaE + deltaE = 1.0_DP + lfirst_Efunc = .false. else - fval = deltaE**2 + deltaE = deltaE/deltaE_scale end if + fval = deltaE**2 deallocate(tmp_frag) end select diff --git a/src/misc/minimizer_module.f90 b/src/misc/minimizer_module.f90 index 8beab3879..a0d56ae3a 100644 --- a/src/misc/minimizer_module.f90 +++ b/src/misc/minimizer_module.f90 @@ -128,7 +128,7 @@ module subroutine minimize_bfgs(f, N, x0, eps, maxloop, lerr, x1) real(DP), dimension(:), intent(out), allocatable :: x1 ! Internals integer(I4B) :: i, j, k, l, conv - real(DP), parameter :: graddelta = 1e-4_DP !! Delta x for gradient calculations + real(DP), parameter :: graddelta = 1e-8_DP !! Delta x for gradient calculations real(DP), dimension(N) :: S !! Direction vectors real(DP), dimension(N,N) :: H !! Approximated inverse Hessian matrix real(DP), dimension(N) :: grad1 !! gradient of f From 3015359e93e1db4bddc84af4388ea7a2a59c9950 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Wed, 28 Dec 2022 14:32:58 -0500 Subject: [PATCH 535/569] Put the spin/radial/tangential velocitiy solvers back into Fraggle. Now that I have a much better handle on the initial guess, I will attempt to resurrect these solvers to get better constraints on energy and momentum --- src/fraggle/fraggle_generate.f90 | 376 +++++++++++++++++++++++++++++++ 1 file changed, 376 insertions(+) diff --git a/src/fraggle/fraggle_generate.f90 b/src/fraggle/fraggle_generate.f90 index 4ed5efac1..98ac872b5 100644 --- a/src/fraggle/fraggle_generate.f90 +++ b/src/fraggle/fraggle_generate.f90 @@ -255,4 +255,380 @@ end function E_objective_function end subroutine fraggle_generate_minimize + + subroutine fraggle_generate_spins(collider, f_spin, lfailure) + !! Author: Jennifer L.L. Pouplin, Carlisle A. Wishard, and David A. Minton + !! + !! Calculates the spins of a collection of fragments such that they conserve angular momentum without blowing the fragment kinetic energy budget. + !! + !! A failure will trigger a restructuring of the fragments so we will try new values of the radial position distribution. + implicit none + ! Arguments + class(collision_fraggle), intent(inout) :: collider !! Fraggle collision system object + real(DP), intent(in) :: f_spin !! Fraction of energy or momentum that goes into spin (whichever gives the lowest kinetic energy) + logical, intent(out) :: lfailure !! Logical flag indicating whether this step fails or succeeds! + ! Internals + real(DP), dimension(NDIM) :: L_remainder, rot_L, rot_ke + integer(I4B) :: i + character(len=STRMAX) :: message + + associate(impactors => collider%impactors, nfrag => collider%fragments%nbody) + select type(fragments => collider%fragments) + class is (fraggle_fragments(*)) + lfailure = .false. + + ! Start the first two bodies with the same rotation as the original two impactors, then distribute the remaining angular momentum among the rest + L_remainder(:) = fragments%L_budget(:) + fragments%rot(:,:) = 0.0_DP + + fragments%ke_spin = 0.0_DP + if (norm2(L_remainder(:)) > FRAGGLE_LTOL) then + do i = 1, nfrag + ! Convert a fraction (f_spin) of either the remaining angular momentum or kinetic energy budget into spin, whichever gives the smaller rotation so as not to blow any budgets + rot_ke(:) = sqrt(2 * f_spin * fragments%ke_budget / (nfrag * fragments%mass(i) * fragments%radius(i)**2 * fragments%Ip(3, i))) & + * L_remainder(:) / norm2(L_remainder(:)) + rot_L(:) = f_spin * L_remainder(:) / (nfrag * fragments%mass(i) * fragments%radius(i)**2 * fragments%Ip(3, i)) + if (norm2(rot_ke) < norm2(rot_L)) then + fragments%rot(:,i) = rot_ke(:) + else + fragments%rot(:, i) = rot_L(:) + end if + fragments%ke_spin = fragments%ke_spin + fragments%mass(i) * fragments%Ip(3, i) * fragments%radius(i)**2 & + * dot_product(fragments%rot(:, i), fragments%rot(:, i)) + end do + end if + fragments%ke_spin = 0.5_DP * fragments%ke_spin + + lfailure = ((fragments%ke_budget - fragments%ke_spin - fragments%ke_orbit) < 0.0_DP) + + if (lfailure) then + call swiftest_io_log_one_message(COLLISION_LOG_OUT, " ") + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Spin failure diagnostics") + write(message, *) fragments%ke_budget + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "ke_budget : " // trim(adjustl(message))) + write(message, *) fragments%ke_spin + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "ke_spin : " // trim(adjustl(message))) + write(message, *) fragments%ke_orbit + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "ke_orbit : " // trim(adjustl(message))) + write(message, *) fragments%ke_budget - fragments%ke_spin - fragments%ke_orbit + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "ke_remainder : " // trim(adjustl(message))) + end if + + end select + end associate + + return + end subroutine fraggle_generate_spins + + + subroutine fraggle_generate_tan_vel(collider, lfailure) + !! Author: Jennifer L.L. Pouplin, Carlisle A. Wishard, and David A. Minton + !! + !! Adjusts the tangential velocities and spins of a collection of fragments such that they conserve angular momentum without blowing the fragment kinetic energy budget. + !! This procedure works in several stages, with a goal to solve the angular and linear momentum constraints on the fragments, while still leaving a positive balance of + !! our fragment kinetic energy (fragments%ke_budget) that we can put into the radial velocity distribution. + !! + !! The first thing we'll try to do is solve for the tangential velocities of the first 6 fragments, using angular and linear momentum as constraints and an initial + !! tangential velocity distribution for the remaining bodies (if there are any) that distributes their angular momentum equally between them. + !! If that doesn't work and we blow our kinetic energy budget, we will attempt to find a tangential velocity distribution that minimizes the kinetic energy while + !! conserving momentum. + !! + !! A failure will trigger a restructuring of the fragments so we will try new values of the radial position distribution. + implicit none + ! Arguments + class(collision_fraggle), intent(inout) :: collider !! Fraggle fragment system object + logical, intent(out) :: lfailure !! Logical flag indicating whether this step fails or succeeds + ! Internals + integer(I4B) :: i + real(DP), parameter :: TOL_MIN = 1e-1_DP ! This doesn't have to be very accurate, as we really just want a tangential velocity distribution with less kinetic energy than our initial guess. + real(DP), parameter :: TOL_INIT = 1e-14_DP + real(DP), parameter :: VNOISE_MAG = 1e-3_DP !! Magnitude of the noise to apply to initial conditions to help minimizer find a solution in case of failure + integer(I4B), parameter :: MAXLOOP = 10 + real(DP) :: tol + real(DP), dimension(:), allocatable :: v_t_initial + real(DP), dimension(collider%fragments%nbody) :: kefrag, vnoise + type(lambda_obj_err) :: objective_function + real(DP), dimension(NDIM) :: Li, L_remainder, L_frag_tot + character(len=STRMAX) :: message + real(DP), dimension(:), allocatable :: output_v + + associate(impactors => collider%impactors, nfrag => collider%fragments%nbody) + select type(fragments => collider%fragments) + class is (fraggle_fragments(*)) + lfailure = .false. + + allocate(v_t_initial, mold=fragments%v_t_mag) + v_t_initial(:) = 0.0_DP + fragments%v_t_unit(:,:) = 0.0_DP + + ! Next we will solve for the tangential component of the velocities that both conserves linear momentum and uses the remaining angular momentum not used in spin. + ! This will be done using a linear solver that solves for the tangential velocities of the first 6 fragments, constrained by the linear and angular momentum vectors, + ! which is embedded in a non-linear minimizer that will adjust the tangential velocities of the remaining i>6 fragments to minimize kinetic energy for a given momentum solution + ! The initial conditions fed to the minimizer for the fragments will be the remaining angular momentum distributed between the fragments. + call fragments%get_angular_momentum() + L_remainder(:) = fragments%L_budget(:) - fragments%Lspin(:) + do i = 1, nfrag + v_t_initial(i) = norm2(L_remainder(:)) / ((nfrag - i + 1) * fragments%mass(i) * norm2(fragments%v_r_unit(:,i))) + Li(:) = fragments%mass(i) * (fragments%v_r_unit(:,i) .cross. (v_t_initial(i) * fragments%v_t_unit(:, i))) + L_remainder(:) = L_remainder(:) - Li(:) + end do + + ! Find the local kinetic energy minimum for the system that conserves linear and angular momentum + objective_function = lambda_obj(tangential_objective_function, lfailure) + + tol = TOL_INIT + do while(tol < TOL_MIN) + call minimize_bfgs(objective_function, nfrag-6, v_t_initial(7:nfrag), tol, MAXLOOP, lfailure, output_v) + fragments%v_t_mag(7:nfrag) = output_v(:) + ! Now that the KE-minimized values of the i>6 fragments are found, calculate the momentum-conserving solution for tangential velociteis + v_t_initial(7:nfrag) = fragments%v_t_mag(7:nfrag) + if (.not.lfailure) exit + tol = tol * 2_DP ! Keep increasing the tolerance until we converge on a solution + call random_number(vnoise(1:nfrag)) ! Adding a bit of noise to the initial conditions helps it find a solution more often + vnoise(:) = 1.0_DP + VNOISE_MAG * (2 * vnoise(:) - 1._DP) + v_t_initial(:) = v_t_initial(:) * vnoise(:) + end do + fragments%v_t_mag(1:nfrag) = solve_fragment_tan_vel(v_t_mag_input=v_t_initial(7:nfrag), lfailure=lfailure) + + ! Perform one final shift of the radial velocity vectors to align with the center of mass of the collisional system (the origin) + fragments%vb(:,1:nfrag) = fraggle_util_vmag_to_vb(fragments%v_r_mag(1:nfrag), fragments%v_r_unit(:,1:nfrag), fragments%v_t_mag(1:nfrag), & + fragments%v_t_unit(:,1:nfrag), fragments%mass(1:nfrag), impactors%vbcom(:)) + do concurrent (i = 1:nfrag) + fragments%v_t_unit(:,i) = fragments%vb(:,i) - impactors%vbcom(:) + end do + + ! Now do a kinetic energy budget check to make sure we are still within the budget. + kefrag = 0.0_DP + do concurrent(i = 1:nfrag) + kefrag(i) = fragments%mass(i) * dot_product(fragments%vb(:, i), fragments%vb(:, i)) + end do + fragments%ke_orbit = 0.5_DP * sum(kefrag(:)) + + ! If we are over the energy budget, flag this as a failure so we can try again + lfailure = ((fragments%ke_budget - fragments%ke_spin - fragments%ke_orbit) < 0.0_DP) + if (lfailure) then + call swiftest_io_log_one_message(COLLISION_LOG_OUT, " ") + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Tangential velocity failure diagnostics") + call fragments%get_angular_momentum() + L_frag_tot = fragments%Lspin(:) + fragments%Lorbit(:) + write(message, *) .mag.(L_frag_tot(:)) / (.mag.fragments%L_budget(:)) + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "|L_remainder| : " // trim(adjustl(message))) + write(message, *) fragments%ke_budget + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "ke_budget : " // trim(adjustl(message))) + write(message, *) fragments%ke_spin + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "ke_spin : " // trim(adjustl(message))) + write(message, *) fragments%ke_orbit + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "ke_tangential : " // trim(adjustl(message))) + write(message, *) fragments%ke_budget - fragments%ke_spin - fragments%ke_orbit + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "ke_radial : " // trim(adjustl(message))) + end if + end select + end associate + + return + + contains + function solve_fragment_tan_vel(lfailure, v_t_mag_input) result(v_t_mag_output) + !! Author: Jennifer L.L. Pouplin, Carlisle A. Wishard, and David A. Minton + !! + !! Adjusts the positions, velocities, and spins of a collection of fragments such that they conserve angular momentum + implicit none + ! Arguments + logical, intent(out) :: lfailure !! Error flag + real(DP), dimension(:), optional, intent(in) :: v_t_mag_input !! Unknown tangential velocities for fragments 7:nfrag + ! Internals + integer(I4B) :: i + ! Result + real(DP), dimension(:), allocatable :: v_t_mag_output + + real(DP), dimension(2 * NDIM, 2 * NDIM) :: A ! LHS of linear equation used to solve for momentum constraint in Gauss elimination code + real(DP), dimension(2 * NDIM) :: b ! RHS of linear equation used to solve for momentum constraint in Gauss elimination code + real(DP), dimension(NDIM) :: L_lin_others, L_orb_others, L, vtmp + + associate(impactors => collider%impactors, nfrag => collider%fragments%nbody) + select type(fragments => collider%fragments) + class is (fraggle_fragments(*)) + lfailure = .false. + ! We have 6 constraint equations (2 vector constraints in 3 dimensions each) + ! The first 3 are that the linear momentum of the fragments is zero with respect to the collisional barycenter + ! The second 3 are that the sum of the angular momentum of the fragments is conserved from the pre-impact state + L_lin_others(:) = 0.0_DP + L_orb_others(:) = 0.0_DP + do i = 1, nfrag + if (i <= 2 * NDIM) then ! The tangential velocities of the first set of bodies will be the unknowns we will solve for to satisfy the constraints + A(1:3, i) = fragments%mass(i) * fragments%v_t_unit(:, i) + A(4:6, i) = fragments%mass(i) * fragments%rmag(i) * (fragments%v_r_unit(:, i) .cross. fragments%v_t_unit(:, i)) + else if (present(v_t_mag_input)) then + vtmp(:) = v_t_mag_input(i - 6) * fragments%v_t_unit(:, i) + L_lin_others(:) = L_lin_others(:) + fragments%mass(i) * vtmp(:) + L(:) = fragments%mass(i) * (fragments%v_r_unit(:, i) .cross. vtmp(:)) + L_orb_others(:) = L_orb_others(:) + L(:) + end if + end do + b(1:3) = -L_lin_others(:) + b(4:6) = fragments%L_budget(:) - fragments%Lspin(:) - L_orb_others(:) + allocate(v_t_mag_output(nfrag)) + v_t_mag_output(1:6) = solve_linear_system(A, b, 6, lfailure) + if (present(v_t_mag_input)) v_t_mag_output(7:nfrag) = v_t_mag_input(:) + end select + end associate + return + end function solve_fragment_tan_vel + + + function tangential_objective_function(v_t_mag_input, lfailure) result(fval) + !! Author: David A. Minton + !! + !! Objective function for evaluating how close our fragment velocities get to minimizing KE error from our required value + implicit none + ! Arguments + real(DP), dimension(:), intent(in) :: v_t_mag_input !! Unknown tangential component of velocity vector set previously by angular momentum constraint + logical, intent(out) :: lfailure !! Error flag + ! Result + real(DP) :: fval + ! Internals + integer(I4B) :: i + real(DP), dimension(NDIM,collider%fragments%nbody) :: v_shift + real(DP), dimension(collider%fragments%nbody) :: v_t_new, kearr + real(DP) :: keo + + associate(impactors => collider%impactors, nfrag => collider%fragments%nbody) + select type(fragments => collider%fragments) + class is (fraggle_fragments(*)) + lfailure = .false. + + v_t_new(:) = solve_fragment_tan_vel(v_t_mag_input=v_t_mag_input(:), lfailure=lfailure) + v_shift(:,:) = fraggle_util_vmag_to_vb(fragments%v_r_mag, fragments%v_r_unit, v_t_new, fragments%v_t_unit, fragments%mass, impactors%vbcom) + + kearr = 0.0_DP + do concurrent(i = 1:nfrag) + kearr(i) = fragments%mass(i) * dot_product(v_shift(:, i), v_shift(:, i)) + end do + keo = 0.5_DP * sum(kearr(:)) + fval = keo + lfailure = .false. + end select + end associate + + return + end function tangential_objective_function + + end subroutine fraggle_generate_tan_vel + + + subroutine fraggle_generate_rad_vel(collider, lfailure) + !! Author: Jennifer L.L. Pouplin, Carlisle A. Wishard, and David A. Minton + !! + !! + !! Adjust the fragment velocities to set the fragment orbital kinetic energy. This will minimize the difference between the fragment kinetic energy and the energy budget + implicit none + ! Arguments + class(collision_fraggle), intent(inout) :: collider !! Fraggle collision system object + logical, intent(out) :: lfailure !! Logical flag indicating whether this step fails or succeeds! + ! Internals + real(DP), parameter :: TOL_MIN = FRAGGLE_ETOL ! This needs to be more accurate than the tangential step, as we are trying to minimize the total residual energy + real(DP), parameter :: TOL_INIT = 1e-14_DP + real(DP), parameter :: VNOISE_MAG = 1e-10_DP !! Magnitude of the noise to apply to initial conditions to help minimizer find a solution in case of failure + integer(I4B), parameter :: MAXLOOP = 100 + real(DP) :: ke_radial, tol + integer(I4B) :: i + real(DP), dimension(:), allocatable :: v_r_initial + real(DP), dimension(collider%fragments%nbody) :: vnoise + type(lambda_obj) :: objective_function + character(len=STRMAX) :: message + real(DP), dimension(:), allocatable :: output_v + + associate(impactors => collider%impactors, nfrag => collider%fragments%nbody) + select type(fragments => collider%fragments) + class is (fraggle_fragments(*)) + ! Set the "target" ke for the radial component + ke_radial = fragments%ke_budget - fragments%ke_spin - fragments%ke_orbit + + allocate(v_r_initial, source=fragments%v_r_mag) + ! Initialize radial velocity magnitudes with a random value that related to equipartition of kinetic energy with some noise + call random_number(vnoise(1:nfrag)) + vnoise(:) = 1.0_DP + VNOISE_MAG * (2 * vnoise(:) - 1.0_DP) + v_r_initial(1:nfrag) = sqrt(abs(2 * ke_radial) / (fragments%mass(1:nfrag) * nfrag)) * vnoise(1:nfrag) + + ! Initialize the lambda function using a structure constructor that calls the init method + ! Minimize the ke objective function using the BFGS optimizer + objective_function = lambda_obj(radial_objective_function) + tol = TOL_INIT + do while(tol < TOL_MIN) + call minimize_bfgs(objective_function, nfrag, v_r_initial, tol, MAXLOOP, lfailure, output_v) + fragments%v_r_mag = output_v + if (.not.lfailure) exit + tol = tol * 2 ! Keep increasing the tolerance until we converge on a solution + v_r_initial(:) = fragments%v_r_mag(:) + call random_number(vnoise(1:nfrag)) ! Adding a bit of noise to the initial conditions helps it find a solution more often + vnoise(:) = 1.0_DP + VNOISE_MAG * (2 * vnoise(:) - 1._DP) + v_r_initial(:) = v_r_initial(:) * vnoise(:) + end do + + ! Shift the radial velocity vectors to align with the center of mass of the collisional system (the origin) + fragments%ke_orbit = 0.0_DP + fragments%vb(:,1:nfrag) = fraggle_util_vmag_to_vb(fragments%v_r_mag(1:nfrag), fragments%v_r_unit(:,1:nfrag), & + fragments%v_t_mag(1:nfrag), fragments%v_t_unit(:,1:nfrag), fragments%mass(1:nfrag), impactors%vbcom(:)) + do i = 1, nfrag + fragments%v_t_unit(:, i) = fragments%vb(:, i) - impactors%vbcom(:) + fragments%ke_orbit = fragments%ke_orbit + fragments%mass(i) * dot_product(fragments%vb(:, i), fragments%vb(:, i)) + end do + fragments%ke_orbit = 0.5_DP * fragments%ke_orbit + + lfailure = abs((fragments%ke_budget - (fragments%ke_orbit + fragments%ke_spin)) / fragments%ke_budget) > FRAGGLE_ETOL + if (lfailure) then + call swiftest_io_log_one_message(COLLISION_LOG_OUT, " ") + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Radial velocity failure diagnostics") + write(message, *) fragments%ke_budget + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "ke_budget : " // trim(adjustl(message))) + write(message, *) fragments%ke_spin + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "ke_spin : " // trim(adjustl(message))) + write(message, *) fragments%ke_orbit + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "ke_orbit : " // trim(adjustl(message))) + write(message, *) fragments%ke_budget - (fragments%ke_orbit + fragments%ke_spin) + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "ke_remainder : " // trim(adjustl(message))) + end if + end select + end associate + return + + contains + function radial_objective_function(v_r_mag_input) result(fval) + !! Author: David A. Minton + !! + !! Objective function for evaluating how close our fragment velocities get to minimizing KE error from our required value + implicit none + ! Arguments + real(DP), dimension(:), intent(in) :: v_r_mag_input !! Unknown radial component of fragment velocity vector + ! Result + real(DP) :: fval !! The objective function result, which is the square of the difference between the calculated fragment kinetic energy and our target + !! Minimizing this brings us closer to our objective + ! Internals + integer(I4B) :: i + real(DP), dimension(:,:), allocatable :: v_shift + real(DP), dimension(collider%fragments%nbody) :: kearr + real(DP) :: keo, ke_radial, rotmag2, vmag2 + + associate(impactors => collider%impactors, nfrag => collider%fragments%nbody) + select type(fragments => collider%fragments) + class is (fraggle_fragments(*)) + allocate(v_shift, mold=fragments%vb) + v_shift(:,:) = fraggle_util_vmag_to_vb(v_r_mag_input, fragments%v_r_unit, fragments%v_t_mag, fragments%v_t_unit, fragments%mass, impactors%vbcom) + do i = 1,fragments%nbody + rotmag2 = fragments%rot(1,i)**2 + fragments%rot(2,i)**2 + fragments%rot(3,i)**2 + vmag2 = v_shift(1,i)**2 + v_shift(2,i)**2 + v_shift(3,i)**2 + kearr(i) = fragments%mass(i) * (fragments%Ip(3, i) * fragments%radius(i)**2 * rotmag2 + vmag2) + end do + keo = 2 * fragments%ke_budget - sum(kearr(:)) + ke_radial = fragments%ke_budget - fragments%ke_orbit - fragments%ke_spin + ! The following ensures that fval = 0 is a local minimum, which is what the BFGS method is searching for + fval = (keo / (2 * ke_radial))**2 + end select + end associate + + return + end function radial_objective_function + + end subroutine fraggle_generate_rad_vel + end submodule s_fraggle_generate From 78d8ec16371c9acf222f0d6db5a2fae0ccbe37ff Mon Sep 17 00:00:00 2001 From: David A Minton Date: Thu, 29 Dec 2022 09:04:45 -0500 Subject: [PATCH 536/569] more experimentation with collisional system to refine the solutions that constrain energy and momentum --- src/collision/collision_generate.f90 | 68 +++++++++--- src/fraggle/fraggle_generate.f90 | 160 +++++++++------------------ src/misc/minimizer_module.f90 | 2 +- 3 files changed, 104 insertions(+), 126 deletions(-) diff --git a/src/collision/collision_generate.f90 b/src/collision/collision_generate.f90 index eca87ed83..1f588b4ad 100644 --- a/src/collision/collision_generate.f90 +++ b/src/collision/collision_generate.f90 @@ -532,18 +532,21 @@ module subroutine collision_generate_simple_vel_vec(collider) ! Arguments class(collision_disruption), intent(inout) :: collider !! Fraggle collision system object ! Internals - integer(I4B) :: i,j + integer(I4B) :: i,j, loop logical :: lhitandrun, lnoncat real(DP), dimension(NDIM) :: vimp_unit, rimp, vrot, Lresidual, vshear - real(DP), dimension(2) :: vimp - real(DP) :: vmag, vdisp, Lmag + real(DP), dimension(NDIM,2) :: vbounce, vcloud + real(DP), dimension(2) :: vimp, mcloud + real(DP) :: vmag, vdisp, Lmag, Lscale integer(I4B), dimension(collider%fragments%nbody) :: vsign real(DP), dimension(collider%fragments%nbody) :: vscale, mass_vscale associate(fragments => collider%fragments, impactors => collider%impactors, nfrag => collider%fragments%nbody) lhitandrun = (impactors%regime == COLLRESOLVE_REGIME_HIT_AND_RUN) lnoncat = (impactors%regime /= COLLRESOLVE_REGIME_SUPERCATASTROPHIC) ! For non-catastrophic impacts, make the fragments act like ejecta and point away from the impact point - ! "Bounce" the first two bodies + + ! The fragments will be divided into two "clouds" based on identified origin body. + ! These clouds will collectively travel like two impactors bouncing off of each other. where(fragments%origin_body(:) == 1) vsign(:) = -1 elsewhere @@ -557,20 +560,24 @@ module subroutine collision_generate_simple_vel_vec(collider) vdisp = 2 * sqrt(2 * sum(impactors%Gmass(:)) / sum(impactors%radius(:))) end if - vimp(:) = .mag.impactors%vc(:,:) + ! The dominant velocities of the two clouds will be scaled by the CoM velocities of the two bodies + vimp(1:2) = .mag.impactors%vc(:,1:2) - ! Scale the magnitude of the velocity by the distance from the impact point and add a bit of shear + ! Scale the magnitude of the velocity by the distance from the impact point + ! This will reduce the chances of fragments colliding with each other immediately, and is more physically correct do concurrent(i = 1:nfrag) rimp(:) = fragments%rc(:,i) - impactors%rbimp(:) vscale(i) = .mag. rimp(:) / (.mag. (impactors%rb(:,2) - impactors%rb(:,1))) end do vscale(:) = vscale(:)/maxval(vscale(:)) - ! Give the fragment velocities a random value that is somewhat scaled with fragment mass + ! Give the fragment velocities a random value that is scaled with fragment mass call random_number(mass_vscale) mass_vscale(:) = (mass_vscale(:) + 1.0_DP) / 2 - mass_vscale(:) = mass_vscale(:) * (fragments%mtot / fragments%mass(:))**(0.125_DP) + mass_vscale(:) = mass_vscale(:) * (fragments%mtot / fragments%mass(:))**(0.125_DP) ! The 1/8 power is arbitrary. It just gives the velocity a small mass dependence mass_vscale(:) = 2*mass_vscale(:) / maxval(mass_vscale(:)) + + ! Set the velocities of all fragments using all of the scale factors determined above fragments%vc(:,1) = .mag.impactors%vc(:,1) * impactors%bounce_unit(:) do concurrent(i = 2:nfrag) j = fragments%origin_body(i) @@ -585,17 +592,44 @@ module subroutine collision_generate_simple_vel_vec(collider) fragments%vc(:,i) = vmag * 0.5_DP * (impactors%bounce_unit(:) + vimp_unit(:)) * vsign(i) + vrot(:) end if end do - call collider%set_coordinate_system() + + ! ! Now shift the CoM of each fragment cloud to what the origin body would have been in a bounce + ! vbounce(:,1) = -.mag.impactors%vc(:,1) * impactors%bounce_unit(:) + ! vbounce(:,2) = .mag.impactors%vc(:,2) * impactors%bounce_unit(:) + + ! ! ! Compute the current CoM of the fragment clouds + ! ! vcloud(:,:) = 0.0_DP + ! ! do concurrent(j = 1:2) + ! ! mcloud(j) = sum(fragments%mass(:), fragments%origin_body(:) == j) + ! ! do concurrent(i = 1:nfrag, fragments%origin_body(i) == j) + ! ! vcloud(:,j) = vcloud(:,j) + fragments%mass(i) * fragments%vc(:,i) + ! ! end do + ! ! vcloud(:,j) = vcloud(:,j) / mcloud(j) + ! ! end do + + ! ! ! Subtract off the difference between the cloud CoM velocity and the expected CoM velocity from bouncing + ! ! vcloud(:,:) = vcloud(:,:) - vbounce(:,:) + ! ! do concurrent(i = 1:nfrag) + ! ! j = fragments%origin_body(i) + ! ! fragments%vc(:,i) = fragments%vc(:,i) - vcloud(:,j) + ! ! end do + ! Check for any residual angular momentum, and if there is any, put it into velocity shear of the fragments + call collider%set_coordinate_system() call fragments%get_angular_momentum() - if (all(fragments%L_budget(:) / (fragments%Lorbit(:) + fragments%Lspin(:)) > epsilon(1.0_DP))) then - Lresidual(:) = fragments%L_budget(:) - (fragments%Lorbit(:) + fragments%Lspin(:)) - do concurrent(i = 3:nfrag) - vshear(:) = Lresidual(:) / (nfrag - 2) / (fragments%mass(i) * fragments%rc(:,i) .cross. fragments%v_t_unit(:,i)) - vshear(:) = .mag.vshear(:) * fragments%v_t_unit(:,i) - fragments%vc(:,i) = fragments%vc(:,i) + vshear(:) - end do - end if + + Lscale = fragments%mtot * sum(fragments%radius(:)) * sum(vimp(:)) + Lresidual(:) = fragments%L_budget(:) - (fragments%Lorbit(:) + fragments%Lspin(:)) + Lmag = .mag.Lresidual(:)/Lscale + do concurrent(i = 3:nfrag) + vshear(:) = (Lresidual(:) / (nfrag-2)) / (fragments%mass(i) * fragments%rmag(i)) + fragments%vc(:,i) = fragments%vc(:,i) + vshear(:) + end do + ! Recompute the collision system coordinates, which will also compute the unit basis vectors for each fragment + call collider%set_coordinate_system() + call fragments%get_angular_momentum() + Lresidual(:) = fragments%L_budget(:) - (fragments%Lorbit(:) + fragments%Lspin(:)) + Lmag = .mag.Lresidual(:)/Lscale do concurrent(i = 1:nfrag) fragments%vb(:,i) = fragments%vc(:,i) + impactors%vbcom(:) diff --git a/src/fraggle/fraggle_generate.f90 b/src/fraggle/fraggle_generate.f90 index 98ac872b5..f8718e25c 100644 --- a/src/fraggle/fraggle_generate.f90 +++ b/src/fraggle/fraggle_generate.f90 @@ -94,6 +94,8 @@ module subroutine fraggle_generate_disrupt(self, nbody_system, param, t, lfailur ! Minimize difference between energy/momentum and budgets call fraggle_generate_minimize(self, lfailure_local) + ! call fraggle_generate_tan_vel(self, lfailure_local) + ! call fraggle_generate_rad_vel(self, lfailure_local) call self%get_energy_and_momentum(nbody_system, param, lbefore=.false.) dEtot = self%Etot(2) - self%Etot(1) @@ -256,71 +258,6 @@ end function E_objective_function end subroutine fraggle_generate_minimize - subroutine fraggle_generate_spins(collider, f_spin, lfailure) - !! Author: Jennifer L.L. Pouplin, Carlisle A. Wishard, and David A. Minton - !! - !! Calculates the spins of a collection of fragments such that they conserve angular momentum without blowing the fragment kinetic energy budget. - !! - !! A failure will trigger a restructuring of the fragments so we will try new values of the radial position distribution. - implicit none - ! Arguments - class(collision_fraggle), intent(inout) :: collider !! Fraggle collision system object - real(DP), intent(in) :: f_spin !! Fraction of energy or momentum that goes into spin (whichever gives the lowest kinetic energy) - logical, intent(out) :: lfailure !! Logical flag indicating whether this step fails or succeeds! - ! Internals - real(DP), dimension(NDIM) :: L_remainder, rot_L, rot_ke - integer(I4B) :: i - character(len=STRMAX) :: message - - associate(impactors => collider%impactors, nfrag => collider%fragments%nbody) - select type(fragments => collider%fragments) - class is (fraggle_fragments(*)) - lfailure = .false. - - ! Start the first two bodies with the same rotation as the original two impactors, then distribute the remaining angular momentum among the rest - L_remainder(:) = fragments%L_budget(:) - fragments%rot(:,:) = 0.0_DP - - fragments%ke_spin = 0.0_DP - if (norm2(L_remainder(:)) > FRAGGLE_LTOL) then - do i = 1, nfrag - ! Convert a fraction (f_spin) of either the remaining angular momentum or kinetic energy budget into spin, whichever gives the smaller rotation so as not to blow any budgets - rot_ke(:) = sqrt(2 * f_spin * fragments%ke_budget / (nfrag * fragments%mass(i) * fragments%radius(i)**2 * fragments%Ip(3, i))) & - * L_remainder(:) / norm2(L_remainder(:)) - rot_L(:) = f_spin * L_remainder(:) / (nfrag * fragments%mass(i) * fragments%radius(i)**2 * fragments%Ip(3, i)) - if (norm2(rot_ke) < norm2(rot_L)) then - fragments%rot(:,i) = rot_ke(:) - else - fragments%rot(:, i) = rot_L(:) - end if - fragments%ke_spin = fragments%ke_spin + fragments%mass(i) * fragments%Ip(3, i) * fragments%radius(i)**2 & - * dot_product(fragments%rot(:, i), fragments%rot(:, i)) - end do - end if - fragments%ke_spin = 0.5_DP * fragments%ke_spin - - lfailure = ((fragments%ke_budget - fragments%ke_spin - fragments%ke_orbit) < 0.0_DP) - - if (lfailure) then - call swiftest_io_log_one_message(COLLISION_LOG_OUT, " ") - call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Spin failure diagnostics") - write(message, *) fragments%ke_budget - call swiftest_io_log_one_message(COLLISION_LOG_OUT, "ke_budget : " // trim(adjustl(message))) - write(message, *) fragments%ke_spin - call swiftest_io_log_one_message(COLLISION_LOG_OUT, "ke_spin : " // trim(adjustl(message))) - write(message, *) fragments%ke_orbit - call swiftest_io_log_one_message(COLLISION_LOG_OUT, "ke_orbit : " // trim(adjustl(message))) - write(message, *) fragments%ke_budget - fragments%ke_spin - fragments%ke_orbit - call swiftest_io_log_one_message(COLLISION_LOG_OUT, "ke_remainder : " // trim(adjustl(message))) - end if - - end select - end associate - - return - end subroutine fraggle_generate_spins - - subroutine fraggle_generate_tan_vel(collider, lfailure) !! Author: Jennifer L.L. Pouplin, Carlisle A. Wishard, and David A. Minton !! @@ -341,71 +278,69 @@ subroutine fraggle_generate_tan_vel(collider, lfailure) ! Internals integer(I4B) :: i real(DP), parameter :: TOL_MIN = 1e-1_DP ! This doesn't have to be very accurate, as we really just want a tangential velocity distribution with less kinetic energy than our initial guess. - real(DP), parameter :: TOL_INIT = 1e-14_DP + real(DP), parameter :: TOL_INIT = 1e-6_DP real(DP), parameter :: VNOISE_MAG = 1e-3_DP !! Magnitude of the noise to apply to initial conditions to help minimizer find a solution in case of failure integer(I4B), parameter :: MAXLOOP = 10 - real(DP) :: tol + real(DP) :: tol, fval real(DP), dimension(:), allocatable :: v_t_initial real(DP), dimension(collider%fragments%nbody) :: kefrag, vnoise type(lambda_obj_err) :: objective_function real(DP), dimension(NDIM) :: Li, L_remainder, L_frag_tot character(len=STRMAX) :: message real(DP), dimension(:), allocatable :: output_v + logical :: lfirst_func associate(impactors => collider%impactors, nfrag => collider%fragments%nbody) select type(fragments => collider%fragments) class is (fraggle_fragments(*)) lfailure = .false. - allocate(v_t_initial, mold=fragments%v_t_mag) - v_t_initial(:) = 0.0_DP - fragments%v_t_unit(:,:) = 0.0_DP - - ! Next we will solve for the tangential component of the velocities that both conserves linear momentum and uses the remaining angular momentum not used in spin. + ! Solve for the tangential component of the velocities that both conserves linear momentum and uses the remaining angular momentum not used in spin. ! This will be done using a linear solver that solves for the tangential velocities of the first 6 fragments, constrained by the linear and angular momentum vectors, ! which is embedded in a non-linear minimizer that will adjust the tangential velocities of the remaining i>6 fragments to minimize kinetic energy for a given momentum solution ! The initial conditions fed to the minimizer for the fragments will be the remaining angular momentum distributed between the fragments. - call fragments%get_angular_momentum() - L_remainder(:) = fragments%L_budget(:) - fragments%Lspin(:) + tol = TOL_INIT + lfirst_func = .true. do i = 1, nfrag - v_t_initial(i) = norm2(L_remainder(:)) / ((nfrag - i + 1) * fragments%mass(i) * norm2(fragments%v_r_unit(:,i))) - Li(:) = fragments%mass(i) * (fragments%v_r_unit(:,i) .cross. (v_t_initial(i) * fragments%v_t_unit(:, i))) - L_remainder(:) = L_remainder(:) - Li(:) + fragments%v_t_mag(i) = dot_product(fragments%vc(:,i), fragments%v_t_unit(:,i)) + fragments%v_r_mag(i) = dot_product(fragments%vc(:,i), fragments%v_r_unit(:,i)) end do + allocate(v_t_initial, source=fragments%v_t_mag) + do while(tol < TOL_MIN) - ! Find the local kinetic energy minimum for the system that conserves linear and angular momentum - objective_function = lambda_obj(tangential_objective_function, lfailure) + ! ! Find the local kinetic energy minimum for the system that conserves linear and angular momentum + objective_function = lambda_obj(tangential_objective_function, lfailure) - tol = TOL_INIT - do while(tol < TOL_MIN) call minimize_bfgs(objective_function, nfrag-6, v_t_initial(7:nfrag), tol, MAXLOOP, lfailure, output_v) + fval = tangential_objective_function(output_v(:), lfailure) fragments%v_t_mag(7:nfrag) = output_v(:) ! Now that the KE-minimized values of the i>6 fragments are found, calculate the momentum-conserving solution for tangential velociteis v_t_initial(7:nfrag) = fragments%v_t_mag(7:nfrag) - if (.not.lfailure) exit - tol = tol * 2_DP ! Keep increasing the tolerance until we converge on a solution - call random_number(vnoise(1:nfrag)) ! Adding a bit of noise to the initial conditions helps it find a solution more often - vnoise(:) = 1.0_DP + VNOISE_MAG * (2 * vnoise(:) - 1._DP) - v_t_initial(:) = v_t_initial(:) * vnoise(:) - end do - fragments%v_t_mag(1:nfrag) = solve_fragment_tan_vel(v_t_mag_input=v_t_initial(7:nfrag), lfailure=lfailure) - ! Perform one final shift of the radial velocity vectors to align with the center of mass of the collisional system (the origin) - fragments%vb(:,1:nfrag) = fraggle_util_vmag_to_vb(fragments%v_r_mag(1:nfrag), fragments%v_r_unit(:,1:nfrag), fragments%v_t_mag(1:nfrag), & - fragments%v_t_unit(:,1:nfrag), fragments%mass(1:nfrag), impactors%vbcom(:)) - do concurrent (i = 1:nfrag) - fragments%v_t_unit(:,i) = fragments%vb(:,i) - impactors%vbcom(:) - end do + fragments%v_t_mag(1:nfrag) = solve_fragment_tan_vel(v_t_mag_input=v_t_initial(7:nfrag), lfailure=lfailure) - ! Now do a kinetic energy budget check to make sure we are still within the budget. - kefrag = 0.0_DP - do concurrent(i = 1:nfrag) - kefrag(i) = fragments%mass(i) * dot_product(fragments%vb(:, i), fragments%vb(:, i)) - end do - fragments%ke_orbit = 0.5_DP * sum(kefrag(:)) + ! Perform one final shift of the radial velocity vectors to align with the center of mass of the collisional system (the origin) + fragments%vb(:,1:nfrag) = fraggle_util_vmag_to_vb(fragments%v_r_mag(1:nfrag), fragments%v_r_unit(:,1:nfrag), fragments%v_t_mag(1:nfrag), & + fragments%v_t_unit(:,1:nfrag), fragments%mass(1:nfrag), impactors%vbcom(:)) + do concurrent (i = 1:nfrag) + fragments%vc(:,i) = fragments%vb(:,i) - impactors%vbcom(:) + end do + + ! Now do a kinetic energy budget check to make sure we are still within the budget. + kefrag = 0.0_DP + do concurrent(i = 1:nfrag) + kefrag(i) = fragments%mass(i) * dot_product(fragments%vc(:,i), fragments%vc(:,i)) + end do + fragments%ke_orbit = 0.5_DP * sum(kefrag(:)) - ! If we are over the energy budget, flag this as a failure so we can try again - lfailure = ((fragments%ke_budget - fragments%ke_spin - fragments%ke_orbit) < 0.0_DP) + ! If we are over the energy budget, flag this as a failure so we can try again + call fragments%get_angular_momentum() + lfailure = ((fragments%ke_budget - fragments%ke_spin - fragments%ke_orbit) < 0.0_DP) + if (.not.lfailure) exit + tol = tol * 2_DP ! Keep increasing the tolerance until we converge on a solution + ! Reduce fragment spins to try to get a better solution + fragments%rot(:,2:nfrag) = fragments%rot(:,2:nfrag) * 0.9_DP + end do if (lfailure) then call swiftest_io_log_one_message(COLLISION_LOG_OUT, " ") call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Tangential velocity failure diagnostics") @@ -461,7 +396,7 @@ function solve_fragment_tan_vel(lfailure, v_t_mag_input) result(v_t_mag_output) else if (present(v_t_mag_input)) then vtmp(:) = v_t_mag_input(i - 6) * fragments%v_t_unit(:, i) L_lin_others(:) = L_lin_others(:) + fragments%mass(i) * vtmp(:) - L(:) = fragments%mass(i) * (fragments%v_r_unit(:, i) .cross. vtmp(:)) + L(:) = fragments%mass(i) * (fragments%rc(:, i) .cross. vtmp(:)) L_orb_others(:) = L_orb_others(:) + L(:) end if end do @@ -488,9 +423,10 @@ function tangential_objective_function(v_t_mag_input, lfailure) result(fval) real(DP) :: fval ! Internals integer(I4B) :: i - real(DP), dimension(NDIM,collider%fragments%nbody) :: v_shift + real(DP), dimension(NDIM,collider%fragments%nbody) :: vc, vb real(DP), dimension(collider%fragments%nbody) :: v_t_new, kearr real(DP) :: keo + real(DP), save :: fval_scale = 1.0_DP associate(impactors => collider%impactors, nfrag => collider%fragments%nbody) select type(fragments => collider%fragments) @@ -498,14 +434,22 @@ function tangential_objective_function(v_t_mag_input, lfailure) result(fval) lfailure = .false. v_t_new(:) = solve_fragment_tan_vel(v_t_mag_input=v_t_mag_input(:), lfailure=lfailure) - v_shift(:,:) = fraggle_util_vmag_to_vb(fragments%v_r_mag, fragments%v_r_unit, v_t_new, fragments%v_t_unit, fragments%mass, impactors%vbcom) - + vb(:,1:nfrag) = fraggle_util_vmag_to_vb(fragments%v_r_mag(1:nfrag), fragments%v_r_unit(:,1:nfrag), v_t_new(1:nfrag), & + fragments%v_t_unit(:,1:nfrag), fragments%mass(1:nfrag), impactors%vbcom(:)) + do concurrent (i = 1:nfrag) + vc(:,i) = vb(:,i) - impactors%vbcom(:) + end do kearr = 0.0_DP do concurrent(i = 1:nfrag) - kearr(i) = fragments%mass(i) * dot_product(v_shift(:, i), v_shift(:, i)) + kearr(i) = fragments%mass(i) * dot_product(vc(:,i), vc(:,i)) end do keo = 0.5_DP * sum(kearr(:)) fval = keo + if (lfirst_func) then + fval_scale = keo + lfirst_func = .false. + end if + fval = keo / fval_scale lfailure = .false. end select end associate @@ -570,7 +514,7 @@ subroutine fraggle_generate_rad_vel(collider, lfailure) fragments%vb(:,1:nfrag) = fraggle_util_vmag_to_vb(fragments%v_r_mag(1:nfrag), fragments%v_r_unit(:,1:nfrag), & fragments%v_t_mag(1:nfrag), fragments%v_t_unit(:,1:nfrag), fragments%mass(1:nfrag), impactors%vbcom(:)) do i = 1, nfrag - fragments%v_t_unit(:, i) = fragments%vb(:, i) - impactors%vbcom(:) + fragments%vc(:, i) = fragments%vb(:, i) - impactors%vbcom(:) fragments%ke_orbit = fragments%ke_orbit + fragments%mass(i) * dot_product(fragments%vb(:, i), fragments%vb(:, i)) end do fragments%ke_orbit = 0.5_DP * fragments%ke_orbit diff --git a/src/misc/minimizer_module.f90 b/src/misc/minimizer_module.f90 index a0d56ae3a..8beab3879 100644 --- a/src/misc/minimizer_module.f90 +++ b/src/misc/minimizer_module.f90 @@ -128,7 +128,7 @@ module subroutine minimize_bfgs(f, N, x0, eps, maxloop, lerr, x1) real(DP), dimension(:), intent(out), allocatable :: x1 ! Internals integer(I4B) :: i, j, k, l, conv - real(DP), parameter :: graddelta = 1e-8_DP !! Delta x for gradient calculations + real(DP), parameter :: graddelta = 1e-4_DP !! Delta x for gradient calculations real(DP), dimension(N) :: S !! Direction vectors real(DP), dimension(N,N) :: H !! Approximated inverse Hessian matrix real(DP), dimension(N) :: grad1 !! gradient of f From b0d38888190a056d25f02f8fa2c7d741c7282de5 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Thu, 29 Dec 2022 11:11:34 -0500 Subject: [PATCH 537/569] Better angular momentum control on the basic disruption model --- examples/Fragmentation/Fragmentation_Movie.py | 2 +- src/collision/collision_generate.f90 | 66 +++++++++---------- src/fraggle/fraggle_generate.f90 | 2 +- 3 files changed, 34 insertions(+), 36 deletions(-) diff --git a/examples/Fragmentation/Fragmentation_Movie.py b/examples/Fragmentation/Fragmentation_Movie.py index ebad58734..f216fc242 100644 --- a/examples/Fragmentation/Fragmentation_Movie.py +++ b/examples/Fragmentation/Fragmentation_Movie.py @@ -232,7 +232,7 @@ def data_stream(self, frame=0): # Set fragmentation parameters minimum_fragment_gmass = 0.2 * body_Gmass[style][1] # Make the minimum fragment mass a fraction of the smallest body gmtiny = 0.99 * body_Gmass[style][1] # Make GMTINY just smaller than the smallest original body. This will prevent runaway collisional cascades - sim.set_parameter(collision_model="fraggle", encounter_save="both", gmtiny=gmtiny, minimum_fragment_gmass=minimum_fragment_gmass, verbose=False) + sim.set_parameter(collision_model="disruption", encounter_save="both", gmtiny=gmtiny, minimum_fragment_gmass=minimum_fragment_gmass, verbose=False) sim.run(dt=1e-3, tstop=1.0e-3, istep_out=1, dump_cadence=0) print("Generating animation") diff --git a/src/collision/collision_generate.f90 b/src/collision/collision_generate.f90 index 1f588b4ad..c3348841d 100644 --- a/src/collision/collision_generate.f90 +++ b/src/collision/collision_generate.f90 @@ -534,10 +534,10 @@ module subroutine collision_generate_simple_vel_vec(collider) ! Internals integer(I4B) :: i,j, loop logical :: lhitandrun, lnoncat - real(DP), dimension(NDIM) :: vimp_unit, rimp, vrot, Lresidual, vshear + real(DP), dimension(NDIM) :: vimp_unit, rimp, vrot, Lresidual real(DP), dimension(NDIM,2) :: vbounce, vcloud real(DP), dimension(2) :: vimp, mcloud - real(DP) :: vmag, vdisp, Lmag, Lscale + real(DP) :: vmag, vdisp, Lmag, Lscale, rotmag integer(I4B), dimension(collider%fragments%nbody) :: vsign real(DP), dimension(collider%fragments%nbody) :: vscale, mass_vscale @@ -553,6 +553,30 @@ module subroutine collision_generate_simple_vel_vec(collider) vsign(:) = 1 end where + ! The dominant velocities of the two clouds will be scaled by the CoM velocities of the two bodies + vimp(1:2) = .mag.impactors%vc(:,1:2) + + ! Now shift the CoM of each fragment cloud to what the origin body would have been in a bounce + vbounce(:,1) = -.mag.impactors%vc(:,1) * impactors%bounce_unit(:) + vbounce(:,2) = .mag.impactors%vc(:,2) * impactors%bounce_unit(:) + + ! Compute the current CoM of the fragment clouds + vcloud(:,:) = 0.0_DP + do concurrent(j = 1:2) + mcloud(j) = sum(fragments%mass(:), fragments%origin_body(:) == j) + do concurrent(i = 1:nfrag, fragments%origin_body(i) == j) + vcloud(:,j) = vcloud(:,j) + fragments%mass(i) * fragments%vc(:,i) + end do + vcloud(:,j) = vcloud(:,j) / mcloud(j) + end do + + ! Subtract off the difference between the cloud CoM velocity and the expected CoM velocity from bouncing + vcloud(:,:) = vcloud(:,:) - vbounce(:,:) + do concurrent(i = 1:nfrag) + j = fragments%origin_body(i) + fragments%vc(:,i) = fragments%vc(:,i) - vcloud(:,j) + end do + ! Compute the velocity dispersion based on the escape velocity if (lhitandrun) then vdisp = 2 * sqrt(2 * impactors%Gmass(2) / impactors%radius(2)) @@ -560,9 +584,6 @@ module subroutine collision_generate_simple_vel_vec(collider) vdisp = 2 * sqrt(2 * sum(impactors%Gmass(:)) / sum(impactors%radius(:))) end if - ! The dominant velocities of the two clouds will be scaled by the CoM velocities of the two bodies - vimp(1:2) = .mag.impactors%vc(:,1:2) - ! Scale the magnitude of the velocity by the distance from the impact point ! This will reduce the chances of fragments colliding with each other immediately, and is more physically correct do concurrent(i = 1:nfrag) @@ -582,7 +603,7 @@ module subroutine collision_generate_simple_vel_vec(collider) do concurrent(i = 2:nfrag) j = fragments%origin_body(i) vrot(:) = impactors%rot(:,j) .cross. (fragments%rc(:,i) - impactors%rc(:,j)) - vmag = .mag.impactors%vc(:,j) * vscale(i) * mass_vscale(i) + vmag = .mag.fragments%vc(:,i) * vscale(i) * mass_vscale(i) if (lhitandrun) then fragments%vc(:,i) = vmag * 0.5_DP * impactors%bounce_unit(:) * vsign(i) + vrot(:) else @@ -593,40 +614,17 @@ module subroutine collision_generate_simple_vel_vec(collider) end if end do - ! ! Now shift the CoM of each fragment cloud to what the origin body would have been in a bounce - ! vbounce(:,1) = -.mag.impactors%vc(:,1) * impactors%bounce_unit(:) - ! vbounce(:,2) = .mag.impactors%vc(:,2) * impactors%bounce_unit(:) - - ! ! ! Compute the current CoM of the fragment clouds - ! ! vcloud(:,:) = 0.0_DP - ! ! do concurrent(j = 1:2) - ! ! mcloud(j) = sum(fragments%mass(:), fragments%origin_body(:) == j) - ! ! do concurrent(i = 1:nfrag, fragments%origin_body(i) == j) - ! ! vcloud(:,j) = vcloud(:,j) + fragments%mass(i) * fragments%vc(:,i) - ! ! end do - ! ! vcloud(:,j) = vcloud(:,j) / mcloud(j) - ! ! end do - - ! ! ! Subtract off the difference between the cloud CoM velocity and the expected CoM velocity from bouncing - ! ! vcloud(:,:) = vcloud(:,:) - vbounce(:,:) - ! ! do concurrent(i = 1:nfrag) - ! ! j = fragments%origin_body(i) - ! ! fragments%vc(:,i) = fragments%vc(:,i) - vcloud(:,j) - ! ! end do - - ! Check for any residual angular momentum, and if there is any, put it into velocity shear of the fragments + ! Check for any residual angular momentum, and if there is any, put it into spin of the biggest body call collider%set_coordinate_system() call fragments%get_angular_momentum() Lscale = fragments%mtot * sum(fragments%radius(:)) * sum(vimp(:)) Lresidual(:) = fragments%L_budget(:) - (fragments%Lorbit(:) + fragments%Lspin(:)) Lmag = .mag.Lresidual(:)/Lscale - do concurrent(i = 3:nfrag) - vshear(:) = (Lresidual(:) / (nfrag-2)) / (fragments%mass(i) * fragments%rmag(i)) - fragments%vc(:,i) = fragments%vc(:,i) + vshear(:) - end do - ! Recompute the collision system coordinates, which will also compute the unit basis vectors for each fragment - call collider%set_coordinate_system() + rotmag = .mag. fragments%rot(:,1) + fragments%rot(:,1) = fragments%rot(:,1) + Lresidual(:) / (fragments%mass(1) * fragments%radius(1)**2 * fragments%Ip(:,1)) + rotmag = .mag. fragments%rot(:,1) + call fragments%get_angular_momentum() Lresidual(:) = fragments%L_budget(:) - (fragments%Lorbit(:) + fragments%Lspin(:)) Lmag = .mag.Lresidual(:)/Lscale diff --git a/src/fraggle/fraggle_generate.f90 b/src/fraggle/fraggle_generate.f90 index f8718e25c..6fe15633b 100644 --- a/src/fraggle/fraggle_generate.f90 +++ b/src/fraggle/fraggle_generate.f90 @@ -94,7 +94,7 @@ module subroutine fraggle_generate_disrupt(self, nbody_system, param, t, lfailur ! Minimize difference between energy/momentum and budgets call fraggle_generate_minimize(self, lfailure_local) - ! call fraggle_generate_tan_vel(self, lfailure_local) + call fraggle_generate_tan_vel(self, lfailure_local) ! call fraggle_generate_rad_vel(self, lfailure_local) call self%get_energy_and_momentum(nbody_system, param, lbefore=.false.) From aeef4fe87c7d220c38ca1272d5f9febb75d3f1e0 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Thu, 29 Dec 2022 11:42:42 -0500 Subject: [PATCH 538/569] Refactored name of disruption model --- src/collision/collision_generate.f90 | 22 ++++++++--------- src/collision/collision_module.f90 | 18 +++++++------- src/collision/collision_util.f90 | 7 ++++-- src/fraggle/fraggle_generate.f90 | 37 ++++++++++++++++------------ 4 files changed, 46 insertions(+), 38 deletions(-) diff --git a/src/collision/collision_generate.f90 b/src/collision/collision_generate.f90 index c3348841d..e91a19b7a 100644 --- a/src/collision/collision_generate.f90 +++ b/src/collision/collision_generate.f90 @@ -191,7 +191,7 @@ module subroutine collision_generate_hitandrun(self, nbody_system, param, t) end subroutine collision_generate_hitandrun - module subroutine collision_generate_simple(self, nbody_system, param, t) + module subroutine collision_generate_disruption(self, nbody_system, param, t) !! author: Jennifer L.L. Pouplin, Carlisle A. Wishard, and David A. Minton !! !! Create the fragments resulting from a non-catastrophic disruption collision @@ -263,7 +263,7 @@ module subroutine collision_generate_simple(self, nbody_system, param, t) end select end select return - end subroutine collision_generate_simple + end subroutine collision_generate_disruption module subroutine collision_generate_merge(self, nbody_system, param, t) @@ -384,15 +384,15 @@ module subroutine collision_generate_disrupt(self, nbody_system, param, t, lfail logical, optional, intent(out) :: lfailure ! Internals - call collision_generate_simple_pos_vec(self) - call collision_generate_simple_rot_vec(self) - call collision_generate_simple_vel_vec(self) + call collision_generate_disruption_pos_vec(self) + call collision_generate_disruption_rot_vec(self) + call collision_generate_disruption_vel_vec(self) return end subroutine collision_generate_disrupt - module subroutine collision_generate_simple_pos_vec(collider) + module subroutine collision_generate_disruption_pos_vec(collider) !! Author: Jennifer L.L. Pouplin, Carlisle A. Wishard, and David A. Minton !! !! Initializes the position vectors of the fragments around the center of mass based on the collision style. @@ -477,10 +477,10 @@ module subroutine collision_generate_simple_pos_vec(collider) end associate return - end subroutine collision_generate_simple_pos_vec + end subroutine collision_generate_disruption_pos_vec - module subroutine collision_generate_simple_rot_vec(collider) + module subroutine collision_generate_disruption_rot_vec(collider) !! Author: Jennifer L.L. Pouplin, Carlisle A. Wishard, and David A. Minton !! !! Calculates the spins of a collection of fragments such that they conserve angular momentum @@ -519,10 +519,10 @@ module subroutine collision_generate_simple_rot_vec(collider) end associate return - end subroutine collision_generate_simple_rot_vec + end subroutine collision_generate_disruption_rot_vec - module subroutine collision_generate_simple_vel_vec(collider) + module subroutine collision_generate_disruption_vel_vec(collider) !! Author: David A. Minton !! !! Generates an initial velocity distribution. For disruptions, the velocity magnitude is set to be @@ -644,7 +644,7 @@ module subroutine collision_generate_simple_vel_vec(collider) end associate return - end subroutine collision_generate_simple_vel_vec + end subroutine collision_generate_disruption_vel_vec end submodule s_collision_generate \ No newline at end of file diff --git a/src/collision/collision_module.f90 b/src/collision/collision_module.f90 index 88698e360..217e9a74e 100644 --- a/src/collision/collision_module.f90 +++ b/src/collision/collision_module.f90 @@ -167,7 +167,7 @@ module collision type, extends(collision_basic) :: collision_disruption contains - procedure :: generate => collision_generate_simple !! A simple disruption models that does not constrain energy loss in collisions + procedure :: generate => collision_generate_disruption !! A simple disruption models that does not constrain energy loss in collisions procedure :: disrupt => collision_generate_disrupt !! Disrupt the colliders into the fragments procedure :: set_mass_dist => collision_util_set_mass_dist !! Sets the distribution of mass among the fragments depending on the regime type final :: collision_final_simple !! Finalizer will deallocate all allocatables @@ -258,28 +258,28 @@ module subroutine collision_generate_merge(self, nbody_system, param, t) real(DP), intent(in) :: t !! The time of the collision end subroutine collision_generate_merge - module subroutine collision_generate_simple(self, nbody_system, param, t) + module subroutine collision_generate_disruption(self, nbody_system, param, t) implicit none class(collision_disruption), intent(inout) :: self !! Simple fragment nbody_system object class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object class(base_parameters), intent(inout) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! The time of the collision - end subroutine collision_generate_simple + end subroutine collision_generate_disruption - module subroutine collision_generate_simple_pos_vec(collider) + module subroutine collision_generate_disruption_pos_vec(collider) implicit none class(collision_disruption), intent(inout) :: collider !! Collision system object - end subroutine collision_generate_simple_pos_vec + end subroutine collision_generate_disruption_pos_vec - module subroutine collision_generate_simple_rot_vec(collider) + module subroutine collision_generate_disruption_rot_vec(collider) implicit none class(collision_basic), intent(inout) :: collider !! Collision system object - end subroutine collision_generate_simple_rot_vec + end subroutine collision_generate_disruption_rot_vec - module subroutine collision_generate_simple_vel_vec(collider) + module subroutine collision_generate_disruption_vel_vec(collider) implicit none class(collision_disruption), intent(inout) :: collider !! Collision system object - end subroutine collision_generate_simple_vel_vec + end subroutine collision_generate_disruption_vel_vec module subroutine collision_io_collider_message(pl, collidx, collider_message) implicit none diff --git a/src/collision/collision_util.f90 b/src/collision/collision_util.f90 index 13d97b4e1..d7ae591f1 100644 --- a/src/collision/collision_util.f90 +++ b/src/collision/collision_util.f90 @@ -700,11 +700,14 @@ module subroutine collision_util_set_spins(self) Lresidual(:) = self%L_budget(:) - (self%Lorbit(:) + self%Lspin(:)) ! Distribute residual angular momentum amongst the fragments if (.mag.(Lresidual(:)) > tiny(1.0_DP)) then - do i = 2,self%nbody - self%rot(:,i) = self%rot(:,i) + Lresidual(:) / ((self%nbody - 1) * self%mass(i) * self%radius(i)**2 * self%Ip(3,i)) + do i = 1,self%nbody + self%rot(:,i) = self%rot(:,i) + Lresidual(:) / (self%nbody * self%mass(i) * self%radius(i)**2 * self%Ip(3,i)) end do end if + call self%get_angular_momentum() + Lresidual(:) = self%L_budget(:) - (self%Lorbit(:) + self%Lspin(:)) + return end subroutine collision_util_set_spins diff --git a/src/fraggle/fraggle_generate.f90 b/src/fraggle/fraggle_generate.f90 index 6fe15633b..cff097b4b 100644 --- a/src/fraggle/fraggle_generate.f90 +++ b/src/fraggle/fraggle_generate.f90 @@ -93,9 +93,9 @@ module subroutine fraggle_generate_disrupt(self, nbody_system, param, t, lfailur call self%set_budgets() ! Minimize difference between energy/momentum and budgets - call fraggle_generate_minimize(self, lfailure_local) - call fraggle_generate_tan_vel(self, lfailure_local) - ! call fraggle_generate_rad_vel(self, lfailure_local) + ! call fraggle_generate_minimize(self, lfailure_local) + ! call fraggle_generate_tan_vel(self, lfailure_local) + call fraggle_generate_rad_vel(self, lfailure_local) call self%get_energy_and_momentum(nbody_system, param, lbefore=.false.) dEtot = self%Etot(2) - self%Etot(1) @@ -188,6 +188,7 @@ subroutine fraggle_generate_minimize(collider, lfailure) fval = E_objective_function(input_v) call minimize_bfgs(Efunc, nelem, input_v, tol, MAXLOOP, lfailure, output_v) + fval = E_objective_function(output_v) fragments%vmag(1:nfrag) = output_v(1:nfrag) do concurrent(i=1:nfrag) fragments%vc(:,i) = abs(fragments%vmag(i)) * fragments%v_r_unit(:,i) @@ -287,7 +288,7 @@ subroutine fraggle_generate_tan_vel(collider, lfailure) type(lambda_obj_err) :: objective_function real(DP), dimension(NDIM) :: Li, L_remainder, L_frag_tot character(len=STRMAX) :: message - real(DP), dimension(:), allocatable :: output_v + real(DP), dimension(:), allocatable :: v_t_output logical :: lfirst_func associate(impactors => collider%impactors, nfrag => collider%fragments%nbody) @@ -310,10 +311,11 @@ subroutine fraggle_generate_tan_vel(collider, lfailure) ! ! Find the local kinetic energy minimum for the system that conserves linear and angular momentum objective_function = lambda_obj(tangential_objective_function, lfailure) + fval = tangential_objective_function(v_t_output(:), lfailure) - call minimize_bfgs(objective_function, nfrag-6, v_t_initial(7:nfrag), tol, MAXLOOP, lfailure, output_v) - fval = tangential_objective_function(output_v(:), lfailure) - fragments%v_t_mag(7:nfrag) = output_v(:) + call minimize_bfgs(objective_function, nfrag-6, v_t_initial(7:nfrag), tol, MAXLOOP, lfailure, v_t_output) + fval = tangential_objective_function(v_t_initial(:), lfailure) + fragments%v_t_mag(7:nfrag) = v_t_output(:) ! Now that the KE-minimized values of the i>6 fragments are found, calculate the momentum-conserving solution for tangential velociteis v_t_initial(7:nfrag) = fragments%v_t_mag(7:nfrag) @@ -474,33 +476,35 @@ subroutine fraggle_generate_rad_vel(collider, lfailure) real(DP), parameter :: TOL_INIT = 1e-14_DP real(DP), parameter :: VNOISE_MAG = 1e-10_DP !! Magnitude of the noise to apply to initial conditions to help minimizer find a solution in case of failure integer(I4B), parameter :: MAXLOOP = 100 - real(DP) :: ke_radial, tol + real(DP) :: ke_radial, tol, fval integer(I4B) :: i real(DP), dimension(:), allocatable :: v_r_initial real(DP), dimension(collider%fragments%nbody) :: vnoise type(lambda_obj) :: objective_function character(len=STRMAX) :: message - real(DP), dimension(:), allocatable :: output_v + real(DP), dimension(:), allocatable :: v_r_output associate(impactors => collider%impactors, nfrag => collider%fragments%nbody) select type(fragments => collider%fragments) class is (fraggle_fragments(*)) ! Set the "target" ke for the radial component ke_radial = fragments%ke_budget - fragments%ke_spin - fragments%ke_orbit + + do i = 1, nfrag + fragments%v_t_mag(i) = dot_product(fragments%vc(:,i), fragments%v_t_unit(:,i)) + fragments%v_r_mag(i) = dot_product(fragments%vc(:,i), fragments%v_r_unit(:,i)) + end do allocate(v_r_initial, source=fragments%v_r_mag) - ! Initialize radial velocity magnitudes with a random value that related to equipartition of kinetic energy with some noise - call random_number(vnoise(1:nfrag)) - vnoise(:) = 1.0_DP + VNOISE_MAG * (2 * vnoise(:) - 1.0_DP) - v_r_initial(1:nfrag) = sqrt(abs(2 * ke_radial) / (fragments%mass(1:nfrag) * nfrag)) * vnoise(1:nfrag) ! Initialize the lambda function using a structure constructor that calls the init method ! Minimize the ke objective function using the BFGS optimizer objective_function = lambda_obj(radial_objective_function) tol = TOL_INIT do while(tol < TOL_MIN) - call minimize_bfgs(objective_function, nfrag, v_r_initial, tol, MAXLOOP, lfailure, output_v) - fragments%v_r_mag = output_v + fval = radial_objective_function(v_r_initial) + call minimize_bfgs(objective_function, nfrag, v_r_initial, tol, MAXLOOP, lfailure, v_r_output) + fragments%v_r_mag = v_r_output if (.not.lfailure) exit tol = tol * 2 ! Keep increasing the tolerance until we converge on a solution v_r_initial(:) = fragments%v_r_mag(:) @@ -515,7 +519,7 @@ subroutine fraggle_generate_rad_vel(collider, lfailure) fragments%v_t_mag(1:nfrag), fragments%v_t_unit(:,1:nfrag), fragments%mass(1:nfrag), impactors%vbcom(:)) do i = 1, nfrag fragments%vc(:, i) = fragments%vb(:, i) - impactors%vbcom(:) - fragments%ke_orbit = fragments%ke_orbit + fragments%mass(i) * dot_product(fragments%vb(:, i), fragments%vb(:, i)) + fragments%ke_orbit = fragments%ke_orbit + fragments%mass(i) * dot_product(fragments%vc(:, i), fragments%vc(:, i)) end do fragments%ke_orbit = 0.5_DP * fragments%ke_orbit @@ -559,6 +563,7 @@ function radial_objective_function(v_r_mag_input) result(fval) allocate(v_shift, mold=fragments%vb) v_shift(:,:) = fraggle_util_vmag_to_vb(v_r_mag_input, fragments%v_r_unit, fragments%v_t_mag, fragments%v_t_unit, fragments%mass, impactors%vbcom) do i = 1,fragments%nbody + v_shift(:,i) = v_shift(:,i) - impactors%vbcom(:) rotmag2 = fragments%rot(1,i)**2 + fragments%rot(2,i)**2 + fragments%rot(3,i)**2 vmag2 = v_shift(1,i)**2 + v_shift(2,i)**2 + v_shift(3,i)**2 kearr(i) = fragments%mass(i) * (fragments%Ip(3, i) * fragments%radius(i)**2 * rotmag2 + vmag2) From 963bd11a2ead18f5d487e20c8eff320c4ae732bd Mon Sep 17 00:00:00 2001 From: David A Minton Date: Thu, 29 Dec 2022 18:06:07 -0500 Subject: [PATCH 539/569] Finally worked out a scheme that might yield good constraints without needing the BFGS minimizer --- src/collision/collision_generate.f90 | 90 +++++++++++----------------- src/collision/collision_module.f90 | 21 ++++--- src/collision/collision_util.f90 | 37 ++++++------ src/fraggle/fraggle_generate.f90 | 34 +++++------ src/fraggle/fraggle_module.f90 | 4 +- src/fraggle/fraggle_util.f90 | 16 ++--- 6 files changed, 95 insertions(+), 107 deletions(-) diff --git a/src/collision/collision_generate.f90 b/src/collision/collision_generate.f90 index e91a19b7a..1e992b5f5 100644 --- a/src/collision/collision_generate.f90 +++ b/src/collision/collision_generate.f90 @@ -535,11 +535,10 @@ module subroutine collision_generate_disruption_vel_vec(collider) integer(I4B) :: i,j, loop logical :: lhitandrun, lnoncat real(DP), dimension(NDIM) :: vimp_unit, rimp, vrot, Lresidual - real(DP), dimension(NDIM,2) :: vbounce, vcloud - real(DP), dimension(2) :: vimp, mcloud - real(DP) :: vmag, vdisp, Lmag, Lscale, rotmag + real(DP) :: vmag, vesc, rotmag, ke_residual, ke_per_dof integer(I4B), dimension(collider%fragments%nbody) :: vsign - real(DP), dimension(collider%fragments%nbody) :: vscale, mass_vscale + real(DP), dimension(collider%fragments%nbody) :: vscale, mass_vscale, ke_avail + integer(I4B), parameter :: MAXLOOP = 100 associate(fragments => collider%fragments, impactors => collider%impactors, nfrag => collider%fragments%nbody) lhitandrun = (impactors%regime == COLLRESOLVE_REGIME_HIT_AND_RUN) @@ -553,35 +552,11 @@ module subroutine collision_generate_disruption_vel_vec(collider) vsign(:) = 1 end where - ! The dominant velocities of the two clouds will be scaled by the CoM velocities of the two bodies - vimp(1:2) = .mag.impactors%vc(:,1:2) - - ! Now shift the CoM of each fragment cloud to what the origin body would have been in a bounce - vbounce(:,1) = -.mag.impactors%vc(:,1) * impactors%bounce_unit(:) - vbounce(:,2) = .mag.impactors%vc(:,2) * impactors%bounce_unit(:) - - ! Compute the current CoM of the fragment clouds - vcloud(:,:) = 0.0_DP - do concurrent(j = 1:2) - mcloud(j) = sum(fragments%mass(:), fragments%origin_body(:) == j) - do concurrent(i = 1:nfrag, fragments%origin_body(i) == j) - vcloud(:,j) = vcloud(:,j) + fragments%mass(i) * fragments%vc(:,i) - end do - vcloud(:,j) = vcloud(:,j) / mcloud(j) - end do - - ! Subtract off the difference between the cloud CoM velocity and the expected CoM velocity from bouncing - vcloud(:,:) = vcloud(:,:) - vbounce(:,:) - do concurrent(i = 1:nfrag) - j = fragments%origin_body(i) - fragments%vc(:,i) = fragments%vc(:,i) - vcloud(:,j) - end do - - ! Compute the velocity dispersion based on the escape velocity + ! The minimum fragment velocity will be set by the escape velocity if (lhitandrun) then - vdisp = 2 * sqrt(2 * impactors%Gmass(2) / impactors%radius(2)) + vesc = sqrt(2 * impactors%Gmass(2) / impactors%radius(2)) else - vdisp = 2 * sqrt(2 * sum(impactors%Gmass(:)) / sum(impactors%radius(:))) + vesc = sqrt(2 * sum(impactors%Gmass(:)) / sum(impactors%radius(:))) end if ! Scale the magnitude of the velocity by the distance from the impact point @@ -590,44 +565,54 @@ module subroutine collision_generate_disruption_vel_vec(collider) rimp(:) = fragments%rc(:,i) - impactors%rbimp(:) vscale(i) = .mag. rimp(:) / (.mag. (impactors%rb(:,2) - impactors%rb(:,1))) end do - vscale(:) = vscale(:)/maxval(vscale(:)) + vscale(:) = vscale(:)/minval(vscale(:)) ! Give the fragment velocities a random value that is scaled with fragment mass call random_number(mass_vscale) mass_vscale(:) = (mass_vscale(:) + 1.0_DP) / 2 mass_vscale(:) = mass_vscale(:) * (fragments%mtot / fragments%mass(:))**(0.125_DP) ! The 1/8 power is arbitrary. It just gives the velocity a small mass dependence - mass_vscale(:) = 2*mass_vscale(:) / maxval(mass_vscale(:)) + mass_vscale(:) = mass_vscale(:) / minval(mass_vscale(:)) ! Set the velocities of all fragments using all of the scale factors determined above - fragments%vc(:,1) = .mag.impactors%vc(:,1) * impactors%bounce_unit(:) - do concurrent(i = 2:nfrag) + do concurrent(i = 1:nfrag) j = fragments%origin_body(i) vrot(:) = impactors%rot(:,j) .cross. (fragments%rc(:,i) - impactors%rc(:,j)) - vmag = .mag.fragments%vc(:,i) * vscale(i) * mass_vscale(i) + vmag = vesc * vscale(i) * mass_vscale(i) if (lhitandrun) then - fragments%vc(:,i) = vmag * 0.5_DP * impactors%bounce_unit(:) * vsign(i) + vrot(:) + fragments%vc(:,i) = vmag * impactors%bounce_unit(:) * vsign(i) + vrot(:) else ! Add more velocity dispersion to disruptions vs hit and runs. rimp(:) = fragments%rc(:,i) - impactors%rbimp(:) vimp_unit(:) = .unit. rimp(:) - fragments%vc(:,i) = vmag * 0.5_DP * (impactors%bounce_unit(:) + vimp_unit(:)) * vsign(i) + vrot(:) + fragments%vc(:,i) = vmag * (impactors%bounce_unit(:) + vimp_unit(:)) * vsign(i) + vrot(:) end if end do - ! Check for any residual angular momentum, and if there is any, put it into spin of the biggest body - call collider%set_coordinate_system() - call fragments%get_angular_momentum() + do loop = 1, MAXLOOP + call collider%set_coordinate_system() + call fragments%get_kinetic_energy() + ke_residual = fragments%ke_budget - (fragments%ke_orbit + fragments%ke_spin) + ! Make sure we don't take away too much orbital kinetic energy, otherwise the fragment can't escape + ke_avail(:) = fragments%ke_orbit_frag(:) - impactors%Gmass(1)*impactors%mass(2)/fragments%vmag(:) + ke_per_dof = -ke_residual/nfrag + do concurrent(i = 1:nfrag, ke_avail(i) > ke_per_dof) + fragments%vmag(i) = sqrt(2 * (fragments%ke_orbit_frag(i) - ke_per_dof)/fragments%mass(i)) + fragments%vc(:,i) = fragments%vmag(i) * fragments%v_unit(:,i) + end do + call fragments%get_kinetic_energy() + ke_residual = fragments%ke_budget - (fragments%ke_orbit + fragments%ke_spin) + + ! Check for any residual angular momentum, and if there is any, put it into spin of the biggest body + call collider%set_coordinate_system() + call fragments%get_angular_momentum() + Lresidual(:) = fragments%L_budget(:) - (fragments%Lorbit(:) + fragments%Lspin(:)) + rotmag = .mag. fragments%rot(:,1) + fragments%rot(:,1) = fragments%rot(:,1) + Lresidual(:) / (fragments%mass(1) * fragments%radius(1)**2 * fragments%Ip(:,1)) + rotmag = .mag. fragments%rot(:,1) - Lscale = fragments%mtot * sum(fragments%radius(:)) * sum(vimp(:)) - Lresidual(:) = fragments%L_budget(:) - (fragments%Lorbit(:) + fragments%Lspin(:)) - Lmag = .mag.Lresidual(:)/Lscale - rotmag = .mag. fragments%rot(:,1) - fragments%rot(:,1) = fragments%rot(:,1) + Lresidual(:) / (fragments%mass(1) * fragments%radius(1)**2 * fragments%Ip(:,1)) - rotmag = .mag. fragments%rot(:,1) + if (ke_residual >= 0.0_DP) exit - call fragments%get_angular_momentum() - Lresidual(:) = fragments%L_budget(:) - (fragments%Lorbit(:) + fragments%Lspin(:)) - Lmag = .mag.Lresidual(:)/Lscale + end do do concurrent(i = 1:nfrag) fragments%vb(:,i) = fragments%vc(:,i) + impactors%vbcom(:) @@ -639,12 +624,9 @@ module subroutine collision_generate_disruption_vel_vec(collider) end do impactors%vbcom(:) = impactors%vbcom(:) / fragments%mtot - ! Distribute any remaining angular momentum into fragments pin - call fragments%set_spins() - end associate return end subroutine collision_generate_disruption_vel_vec -end submodule s_collision_generate \ No newline at end of file +end submodule s_collision_generate diff --git a/src/collision/collision_module.f90 b/src/collision/collision_module.f90 index 217e9a74e..c9d81322f 100644 --- a/src/collision/collision_module.f90 +++ b/src/collision/collision_module.f90 @@ -106,16 +106,19 @@ module collision real(DP), dimension(nbody) :: rmag !! Array of radial distance magnitudes of individual fragments in the collisional coordinate frame real(DP), dimension(nbody) :: vmag !! Array of radial distance magnitudes of individual fragments in the collisional coordinate frame real(DP), dimension(nbody) :: rotmag !! Array of rotation magnitudes of individual fragments - real(DP), dimension(NDIM,nbody) :: v_r_unit !! Array of radial direction unit vectors of individual fragments in the collisional coordinate frame - real(DP), dimension(NDIM,nbody) :: v_t_unit !! Array of tangential direction unit vectors of individual fragments in the collisional coordinate frame - real(DP), dimension(NDIM,nbody) :: v_n_unit !! Array of normal direction unit vectors of individual fragments in the collisional coordinate frame + real(DP), dimension(NDIM,nbody) :: r_unit !! Array of radial direction unit vectors of individual fragments in the collisional coordinate frame + real(DP), dimension(NDIM,nbody) :: v_unit !! Array of velocity direction unit vectors of individual fragments in the collisional coordinate frame + real(DP), dimension(NDIM,nbody) :: t_unit !! Array of tangential direction unit vectors of individual fragments in the collisional coordinate frame + real(DP), dimension(NDIM,nbody) :: n_unit !! Array of normal direction unit vectors of individual fragments in the collisional coordinate frame integer(I1B), dimension(nbody) :: origin_body !! Array of indices indicating which impactor body (1 or 2) the fragment originates from - real(DP), dimension(NDIM) :: Lorbit !! Orbital angular momentum vector of all fragments - real(DP), dimension(NDIM) :: Lspin !! Spin angular momentum vector of all fragments - real(DP) :: ke_orbit !! Orbital kinetic energy of all fragments - real(DP) :: ke_spin !! Spin kinetic energy of all fragments - real(DP) :: ke_budget !! Kinetic energy budget for computing fragment trajectories - real(DP), dimension(NDIM) :: L_budget !! Angular momentum budget for computing fragment trajectories + real(DP), dimension(NDIM) :: Lorbit !! Orbital angular momentum vector of all fragments + real(DP), dimension(NDIM) :: Lspin !! Spin angular momentum vector of all fragments + real(DP) :: ke_orbit !! Orbital kinetic energy of all fragments + real(DP) :: ke_spin !! Spin kinetic energy of all fragments + real(DP) :: ke_budget !! Kinetic energy budget for computing fragment trajectories + real(DP), dimension(NDIM) :: L_budget !! Angular momentum budget for computing fragment trajectories + real(DP), dimension(nbody) :: ke_orbit_frag !! Orbital kinetic energy of each individual fragment + real(DP), dimension(nbody) :: ke_spin_frag !! Spin kinetic energy of each individual fragment contains procedure :: reset => collision_util_reset_fragments !! Deallocates all allocatable arrays and sets everything else to 0 procedure :: get_angular_momentum => collision_util_get_angular_momentum !! Calcualtes the current angular momentum of the fragments diff --git a/src/collision/collision_util.f90 b/src/collision/collision_util.f90 index d7ae591f1..0d76af301 100644 --- a/src/collision/collision_util.f90 +++ b/src/collision/collision_util.f90 @@ -205,21 +205,23 @@ module subroutine collision_util_get_kinetic_energy(self) !! Calculates the current kinetic energy of the fragments implicit none ! Argument - class(collision_fragments(*)), intent(inout) :: self !! Fraggle fragment system object + class(collision_fragments(*)), intent(inout) :: self !! Fragment system object ! Internals integer(I4B) :: i associate(fragments => self, nfrag => self%nbody) - fragments%ke_orbit = 0.0_DP - fragments%ke_spin = 0.0_DP + fragments%ke_orbit_frag(:) = 0.0_DP + fragments%ke_spin_frag(:) = 0.0_DP - do i = 1, nfrag - fragments%ke_orbit = fragments%ke_orbit + fragments%mass(i) * dot_product(fragments%vc(:,i), fragments%vc(:,i)) - fragments%ke_spin = fragments%ke_spin + fragments%mass(i) * fragments%radius(i)**2 * fragments%Ip(3,i) * dot_product(fragments%rot(:,i),fragments%rot(:,i) ) + do concurrent(i = 1:nfrag) + fragments%ke_orbit_frag(i) = fragments%mass(i) * dot_product(fragments%vc(:,i), fragments%vc(:,i)) + fragments%ke_spin_frag(i) = fragments%mass(i) * fragments%radius(i)**2 * fragments%Ip(3,i) * dot_product(fragments%rot(:,i),fragments%rot(:,i) ) end do - fragments%ke_orbit = fragments%ke_orbit / 2 - fragments%ke_spin = fragments%ke_spin / 2 + fragments%ke_orbit_frag(:) = fragments%ke_orbit_frag(:) / 2 + fragments%ke_spin_frag(:) = fragments%ke_spin_frag(:) / 2 + fragments%ke_orbit = sum(fragments%ke_orbit_frag(:)) + fragments%ke_spin = sum(fragments%ke_spin_frag(:)) end associate @@ -374,9 +376,9 @@ module subroutine collision_util_reset_fragments(self) self%density(:) = 0.0_DP self%rc(:,:) = 0.0_DP self%vc(:,:) = 0.0_DP - self%v_r_unit(:,:) = 0.0_DP - self%v_t_unit(:,:) = 0.0_DP - self%v_n_unit(:,:) = 0.0_DP + self%r_unit(:,:) = 0.0_DP + self%t_unit(:,:) = 0.0_DP + self%n_unit(:,:) = 0.0_DP return end subroutine collision_util_reset_fragments @@ -453,9 +455,10 @@ module subroutine collision_util_set_coordinate_collider(self) fragments%vmag(:) = .mag. fragments%vc(:,:) ! Define the radial, normal, and tangential unit vectors for each individual fragment - fragments%v_r_unit(:,:) = .unit. fragments%rc(:,:) - fragments%v_t_unit(:,:) = .unit. fragments%vc(:,:) - fragments%v_n_unit(:,:) = .unit. (fragments%v_r_unit(:,:) .cross. fragments%v_t_unit(:,:)) + fragments%r_unit(:,:) = .unit. fragments%rc(:,:) + fragments%v_unit(:,:) = .unit. fragments%vc(:,:) + fragments%n_unit(:,:) = .unit. (fragments%rc(:,:) .cross. fragments%vc(:,:)) + fragments%t_unit(:,:) = .unit. (fragments%r_unit(:,:) .cross. fragments%r_unit(:,:)) end associate @@ -770,9 +773,9 @@ module subroutine collision_util_setup_fragments_collider(self, nfrag) self%fragments%vc(:,:) = 0.0_DP self%fragments%rot(:,:) = 0.0_DP self%fragments%Ip(:,:) = 0.0_DP - self%fragments%v_r_unit(:,:) = 0.0_DP - self%fragments%v_t_unit(:,:) = 0.0_DP - self%fragments%v_n_unit(:,:) = 0.0_DP + self%fragments%r_unit(:,:) = 0.0_DP + self%fragments%t_unit(:,:) = 0.0_DP + self%fragments%n_unit(:,:) = 0.0_DP self%fragments%mass(:) = 0.0_DP self%fragments%radius(:) = 0.0_DP self%fragments%density(:) = 0.0_DP diff --git a/src/fraggle/fraggle_generate.f90 b/src/fraggle/fraggle_generate.f90 index cff097b4b..f8361be19 100644 --- a/src/fraggle/fraggle_generate.f90 +++ b/src/fraggle/fraggle_generate.f90 @@ -181,7 +181,7 @@ subroutine fraggle_generate_minimize(collider, lfailure) Efunc = lambda_obj(E_objective_function) tol = TOL_INIT - fragments%v_r_unit(:,:) = .unit. fragments%vc(:,:) + fragments%r_unit(:,:) = .unit. fragments%vc(:,:) fragments%vmag(:) = .mag. fragments%vc(:,1:nfrag) input_v(:) = fragments%vmag(1:nfrag) lfirst_Efunc = .true. @@ -191,7 +191,7 @@ subroutine fraggle_generate_minimize(collider, lfailure) fval = E_objective_function(output_v) fragments%vmag(1:nfrag) = output_v(1:nfrag) do concurrent(i=1:nfrag) - fragments%vc(:,i) = abs(fragments%vmag(i)) * fragments%v_r_unit(:,i) + fragments%vc(:,i) = abs(fragments%vmag(i)) * fragments%r_unit(:,i) end do ! Set spins in order to conserve angular momentum @@ -226,7 +226,7 @@ function E_objective_function(val_input) result(fval) allocate(tmp_frag, source=fragments) tmp_frag%vmag(1:nfrag) = val_input(1:nfrag) do concurrent(i=1:nfrag) - tmp_frag%vc(:,i) = abs(tmp_frag%vmag(i)) * tmp_frag%v_r_unit(:,i) + tmp_frag%vc(:,i) = abs(tmp_frag%vmag(i)) * tmp_frag%r_unit(:,i) end do call collision_util_shift_vector_to_origin(tmp_frag%mass, tmp_frag%vc) @@ -303,8 +303,8 @@ subroutine fraggle_generate_tan_vel(collider, lfailure) tol = TOL_INIT lfirst_func = .true. do i = 1, nfrag - fragments%v_t_mag(i) = dot_product(fragments%vc(:,i), fragments%v_t_unit(:,i)) - fragments%v_r_mag(i) = dot_product(fragments%vc(:,i), fragments%v_r_unit(:,i)) + fragments%v_t_mag(i) = dot_product(fragments%vc(:,i), fragments%t_unit(:,i)) + fragments%v_r_mag(i) = dot_product(fragments%vc(:,i), fragments%r_unit(:,i)) end do allocate(v_t_initial, source=fragments%v_t_mag) do while(tol < TOL_MIN) @@ -322,8 +322,8 @@ subroutine fraggle_generate_tan_vel(collider, lfailure) fragments%v_t_mag(1:nfrag) = solve_fragment_tan_vel(v_t_mag_input=v_t_initial(7:nfrag), lfailure=lfailure) ! Perform one final shift of the radial velocity vectors to align with the center of mass of the collisional system (the origin) - fragments%vb(:,1:nfrag) = fraggle_util_vmag_to_vb(fragments%v_r_mag(1:nfrag), fragments%v_r_unit(:,1:nfrag), fragments%v_t_mag(1:nfrag), & - fragments%v_t_unit(:,1:nfrag), fragments%mass(1:nfrag), impactors%vbcom(:)) + fragments%vb(:,1:nfrag) = fraggle_util_vmag_to_vb(fragments%v_r_mag(1:nfrag), fragments%r_unit(:,1:nfrag), fragments%v_t_mag(1:nfrag), & + fragments%t_unit(:,1:nfrag), fragments%mass(1:nfrag), impactors%vbcom(:)) do concurrent (i = 1:nfrag) fragments%vc(:,i) = fragments%vb(:,i) - impactors%vbcom(:) end do @@ -393,10 +393,10 @@ function solve_fragment_tan_vel(lfailure, v_t_mag_input) result(v_t_mag_output) L_orb_others(:) = 0.0_DP do i = 1, nfrag if (i <= 2 * NDIM) then ! The tangential velocities of the first set of bodies will be the unknowns we will solve for to satisfy the constraints - A(1:3, i) = fragments%mass(i) * fragments%v_t_unit(:, i) - A(4:6, i) = fragments%mass(i) * fragments%rmag(i) * (fragments%v_r_unit(:, i) .cross. fragments%v_t_unit(:, i)) + A(1:3, i) = fragments%mass(i) * fragments%t_unit(:, i) + A(4:6, i) = fragments%mass(i) * fragments%rmag(i) * (fragments%r_unit(:, i) .cross. fragments%t_unit(:, i)) else if (present(v_t_mag_input)) then - vtmp(:) = v_t_mag_input(i - 6) * fragments%v_t_unit(:, i) + vtmp(:) = v_t_mag_input(i - 6) * fragments%t_unit(:, i) L_lin_others(:) = L_lin_others(:) + fragments%mass(i) * vtmp(:) L(:) = fragments%mass(i) * (fragments%rc(:, i) .cross. vtmp(:)) L_orb_others(:) = L_orb_others(:) + L(:) @@ -436,8 +436,8 @@ function tangential_objective_function(v_t_mag_input, lfailure) result(fval) lfailure = .false. v_t_new(:) = solve_fragment_tan_vel(v_t_mag_input=v_t_mag_input(:), lfailure=lfailure) - vb(:,1:nfrag) = fraggle_util_vmag_to_vb(fragments%v_r_mag(1:nfrag), fragments%v_r_unit(:,1:nfrag), v_t_new(1:nfrag), & - fragments%v_t_unit(:,1:nfrag), fragments%mass(1:nfrag), impactors%vbcom(:)) + vb(:,1:nfrag) = fraggle_util_vmag_to_vb(fragments%v_r_mag(1:nfrag), fragments%r_unit(:,1:nfrag), v_t_new(1:nfrag), & + fragments%t_unit(:,1:nfrag), fragments%mass(1:nfrag), impactors%vbcom(:)) do concurrent (i = 1:nfrag) vc(:,i) = vb(:,i) - impactors%vbcom(:) end do @@ -491,8 +491,8 @@ subroutine fraggle_generate_rad_vel(collider, lfailure) ke_radial = fragments%ke_budget - fragments%ke_spin - fragments%ke_orbit do i = 1, nfrag - fragments%v_t_mag(i) = dot_product(fragments%vc(:,i), fragments%v_t_unit(:,i)) - fragments%v_r_mag(i) = dot_product(fragments%vc(:,i), fragments%v_r_unit(:,i)) + fragments%v_t_mag(i) = dot_product(fragments%vc(:,i), fragments%t_unit(:,i)) + fragments%v_r_mag(i) = dot_product(fragments%vc(:,i), fragments%r_unit(:,i)) end do allocate(v_r_initial, source=fragments%v_r_mag) @@ -515,8 +515,8 @@ subroutine fraggle_generate_rad_vel(collider, lfailure) ! Shift the radial velocity vectors to align with the center of mass of the collisional system (the origin) fragments%ke_orbit = 0.0_DP - fragments%vb(:,1:nfrag) = fraggle_util_vmag_to_vb(fragments%v_r_mag(1:nfrag), fragments%v_r_unit(:,1:nfrag), & - fragments%v_t_mag(1:nfrag), fragments%v_t_unit(:,1:nfrag), fragments%mass(1:nfrag), impactors%vbcom(:)) + fragments%vb(:,1:nfrag) = fraggle_util_vmag_to_vb(fragments%v_r_mag(1:nfrag), fragments%r_unit(:,1:nfrag), & + fragments%v_t_mag(1:nfrag), fragments%t_unit(:,1:nfrag), fragments%mass(1:nfrag), impactors%vbcom(:)) do i = 1, nfrag fragments%vc(:, i) = fragments%vb(:, i) - impactors%vbcom(:) fragments%ke_orbit = fragments%ke_orbit + fragments%mass(i) * dot_product(fragments%vc(:, i), fragments%vc(:, i)) @@ -561,7 +561,7 @@ function radial_objective_function(v_r_mag_input) result(fval) select type(fragments => collider%fragments) class is (fraggle_fragments(*)) allocate(v_shift, mold=fragments%vb) - v_shift(:,:) = fraggle_util_vmag_to_vb(v_r_mag_input, fragments%v_r_unit, fragments%v_t_mag, fragments%v_t_unit, fragments%mass, impactors%vbcom) + v_shift(:,:) = fraggle_util_vmag_to_vb(v_r_mag_input, fragments%r_unit, fragments%v_t_mag, fragments%t_unit, fragments%mass, impactors%vbcom) do i = 1,fragments%nbody v_shift(:,i) = v_shift(:,i) - impactors%vbcom(:) rotmag2 = fragments%rot(1,i)**2 + fragments%rot(2,i)**2 + fragments%rot(3,i)**2 diff --git a/src/fraggle/fraggle_module.f90 b/src/fraggle/fraggle_module.f90 index 8d6964aa4..2c5ee9672 100644 --- a/src/fraggle/fraggle_module.f90 +++ b/src/fraggle/fraggle_module.f90 @@ -91,11 +91,11 @@ module subroutine fraggle_util_set_original_scale_factors(self) class(collision_fraggle), intent(inout) :: self !! Fraggle collision system object end subroutine fraggle_util_set_original_scale_factors - module function fraggle_util_vmag_to_vb(v_r_mag, v_r_unit, v_t_mag, v_t_unit, m_frag, vcom) result(vb) + module function fraggle_util_vmag_to_vb(v_r_mag, r_unit, v_t_mag, t_unit, m_frag, vcom) result(vb) implicit none real(DP), dimension(:), intent(in) :: v_r_mag !! Unknown radial component of fragment velocity vector real(DP), dimension(:), intent(in) :: v_t_mag !! Tangential component of velocity vector set previously by angular momentum constraint - real(DP), dimension(:,:), intent(in) :: v_r_unit, v_t_unit !! Radial and tangential unit vectors for each fragment + real(DP), dimension(:,:), intent(in) :: r_unit, t_unit !! Radial and tangential unit vectors for each fragment real(DP), dimension(:), intent(in) :: m_frag !! Fragment masses real(DP), dimension(:), intent(in) :: vcom !! Barycentric velocity of collisional system center of mass real(DP), dimension(:,:), allocatable :: vb diff --git a/src/fraggle/fraggle_util.f90 b/src/fraggle/fraggle_util.f90 index 94e245c0b..cff4fd832 100644 --- a/src/fraggle/fraggle_util.f90 +++ b/src/fraggle/fraggle_util.f90 @@ -52,9 +52,9 @@ module subroutine fraggle_util_reset_fragments(self) self%rb(:,:) = 0.0_DP self%vb(:,:) = 0.0_DP self%rot(:,:) = 0.0_DP - self%v_r_unit(:,:) = 0.0_DP - self%v_t_unit(:,:) = 0.0_DP - self%v_n_unit(:,:) = 0.0_DP + self%r_unit(:,:) = 0.0_DP + self%t_unit(:,:) = 0.0_DP + self%n_unit(:,:) = 0.0_DP self%rmag(:) = 0.0_DP self%rotmag(:) = 0.0_DP @@ -226,7 +226,7 @@ module subroutine fraggle_util_setup_fragments_system(self, nfrag) end subroutine fraggle_util_setup_fragments_system - module function fraggle_util_vmag_to_vb(v_r_mag, v_r_unit, v_t_mag, v_t_unit, m_frag, vcom) result(vb) + module function fraggle_util_vmag_to_vb(v_r_mag, r_unit, v_t_mag, t_unit, m_frag, vcom) result(vb) !! Author: David A. Minton !! !! Converts radial and tangential velocity magnitudes into barycentric velocity @@ -234,7 +234,7 @@ module function fraggle_util_vmag_to_vb(v_r_mag, v_r_unit, v_t_mag, v_t_unit, m_ ! Arguments real(DP), dimension(:), intent(in) :: v_r_mag !! Unknown radial component of fragment velocity vector real(DP), dimension(:), intent(in) :: v_t_mag !! Tangential component of velocity vector set previously by angular momentum constraint - real(DP), dimension(:,:), intent(in) :: v_r_unit, v_t_unit !! Radial and tangential unit vectors for each fragment + real(DP), dimension(:,:), intent(in) :: r_unit, t_unit !! Radial and tangential unit vectors for each fragment real(DP), dimension(:), intent(in) :: m_frag !! Fragment masses real(DP), dimension(:), intent(in) :: vcom !! Barycentric velocity of collisional system center of mass ! Result @@ -242,17 +242,17 @@ module function fraggle_util_vmag_to_vb(v_r_mag, v_r_unit, v_t_mag, v_t_unit, m_ ! Internals integer(I4B) :: i, nfrag - allocate(vb, mold=v_r_unit) + allocate(vb, mold=r_unit) ! Make sure the velocity magnitude stays positive nfrag = size(m_frag) do i = 1, nfrag - vb(:,i) = abs(v_r_mag(i)) * v_r_unit(:, i) + vb(:,i) = abs(v_r_mag(i)) * r_unit(:, i) end do ! In order to keep satisfying the kinetic energy constraint, we must shift the origin of the radial component of the velocities to the center of mass call collision_util_shift_vector_to_origin(m_frag, vb) do i = 1, nfrag - vb(:, i) = vb(:, i) + v_t_mag(i) * v_t_unit(:, i) + vcom(:) + vb(:, i) = vb(:, i) + v_t_mag(i) * t_unit(:, i) + vcom(:) end do return From 48821cd6f91d560b7cb2a385a743016ad4415de9 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Thu, 29 Dec 2022 18:14:46 -0500 Subject: [PATCH 540/569] Fixed hit and run disruption case --- src/collision/collision_generate.f90 | 13 +++++++++---- 1 file changed, 9 insertions(+), 4 deletions(-) diff --git a/src/collision/collision_generate.f90 b/src/collision/collision_generate.f90 index 1e992b5f5..44918b005 100644 --- a/src/collision/collision_generate.f90 +++ b/src/collision/collision_generate.f90 @@ -577,11 +577,16 @@ module subroutine collision_generate_disruption_vel_vec(collider) do concurrent(i = 1:nfrag) j = fragments%origin_body(i) vrot(:) = impactors%rot(:,j) .cross. (fragments%rc(:,i) - impactors%rc(:,j)) - vmag = vesc * vscale(i) * mass_vscale(i) if (lhitandrun) then - fragments%vc(:,i) = vmag * impactors%bounce_unit(:) * vsign(i) + vrot(:) + if (i == 1) then + fragments%vc(:,1) = impactors%vc(:,1) + else + vmag = .mag.impactors%vc(:,2) / (maxval(mass_vscale(:) * maxval(vscale(:)))) + fragments%vc(:,i) = vmag * mass_vscale(i) * vscale(i) * impactors%bounce_unit(:) * vsign(i) + vrot(:) + end if else ! Add more velocity dispersion to disruptions vs hit and runs. + vmag = vesc * vscale(i) * mass_vscale(i) rimp(:) = fragments%rc(:,i) - impactors%rbimp(:) vimp_unit(:) = .unit. rimp(:) fragments%vc(:,i) = vmag * (impactors%bounce_unit(:) + vimp_unit(:)) * vsign(i) + vrot(:) @@ -594,8 +599,8 @@ module subroutine collision_generate_disruption_vel_vec(collider) ke_residual = fragments%ke_budget - (fragments%ke_orbit + fragments%ke_spin) ! Make sure we don't take away too much orbital kinetic energy, otherwise the fragment can't escape ke_avail(:) = fragments%ke_orbit_frag(:) - impactors%Gmass(1)*impactors%mass(2)/fragments%vmag(:) - ke_per_dof = -ke_residual/nfrag - do concurrent(i = 1:nfrag, ke_avail(i) > ke_per_dof) + ke_per_dof = -ke_residual/(nfrag - 1) + do concurrent(i = 2:nfrag, ke_avail(i) > ke_per_dof) fragments%vmag(i) = sqrt(2 * (fragments%ke_orbit_frag(i) - ke_per_dof)/fragments%mass(i)) fragments%vc(:,i) = fragments%vmag(i) * fragments%v_unit(:,i) end do From 016ef73d9918052fbe659f295e9ff6e955bd5cbe Mon Sep 17 00:00:00 2001 From: David A Minton Date: Thu, 29 Dec 2022 18:16:11 -0500 Subject: [PATCH 541/569] Fixed non-hit and run cases --- src/collision/collision_generate.f90 | 11 ++++++++--- 1 file changed, 8 insertions(+), 3 deletions(-) diff --git a/src/collision/collision_generate.f90 b/src/collision/collision_generate.f90 index 44918b005..007ac8d0c 100644 --- a/src/collision/collision_generate.f90 +++ b/src/collision/collision_generate.f90 @@ -532,7 +532,7 @@ module subroutine collision_generate_disruption_vel_vec(collider) ! Arguments class(collision_disruption), intent(inout) :: collider !! Fraggle collision system object ! Internals - integer(I4B) :: i,j, loop + integer(I4B) :: i,j, loop, istart logical :: lhitandrun, lnoncat real(DP), dimension(NDIM) :: vimp_unit, rimp, vrot, Lresidual real(DP) :: vmag, vesc, rotmag, ke_residual, ke_per_dof @@ -593,14 +593,19 @@ module subroutine collision_generate_disruption_vel_vec(collider) end if end do + if (lhitandrun) then + istart = 2 + else + istart = 1 + end if do loop = 1, MAXLOOP call collider%set_coordinate_system() call fragments%get_kinetic_energy() ke_residual = fragments%ke_budget - (fragments%ke_orbit + fragments%ke_spin) ! Make sure we don't take away too much orbital kinetic energy, otherwise the fragment can't escape ke_avail(:) = fragments%ke_orbit_frag(:) - impactors%Gmass(1)*impactors%mass(2)/fragments%vmag(:) - ke_per_dof = -ke_residual/(nfrag - 1) - do concurrent(i = 2:nfrag, ke_avail(i) > ke_per_dof) + ke_per_dof = -ke_residual/(nfrag - istart + 1) + do concurrent(i = istart:nfrag, ke_avail(i) > ke_per_dof) fragments%vmag(i) = sqrt(2 * (fragments%ke_orbit_frag(i) - ke_per_dof)/fragments%mass(i)) fragments%vc(:,i) = fragments%vmag(i) * fragments%v_unit(:,i) end do From 32e2fc21a9627f9bdc713fbe950a6520ea035cbb Mon Sep 17 00:00:00 2001 From: David A Minton Date: Thu, 29 Dec 2022 18:44:19 -0500 Subject: [PATCH 542/569] Made time constant in the movie animation script --- examples/Fragmentation/Fragmentation_Movie.py | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/examples/Fragmentation/Fragmentation_Movie.py b/examples/Fragmentation/Fragmentation_Movie.py index f216fc242..8f0d7d22b 100644 --- a/examples/Fragmentation/Fragmentation_Movie.py +++ b/examples/Fragmentation/Fragmentation_Movie.py @@ -125,6 +125,10 @@ def encounter_combiner(sim): # The following will combine the two datasets along the time dimension, sort the time dimension, and then fill in any time gaps with interpolation ds = xr.combine_nested([data,enc],concat_dim='time').sortby("time").interpolate_na(dim="time") + + # Interpolate in time to make a smooth, constant time step dataset + smooth_time = np.linspace(start=tgood.isel(time=0), stop=tgood.isel(time=-1), num=2400) + ds = ds.interp(time=smooth_time) return ds From 4eecf3483e8e4bdf8fb4691fded0dc55179342db Mon Sep 17 00:00:00 2001 From: David A Minton Date: Thu, 29 Dec 2022 21:03:47 -0500 Subject: [PATCH 543/569] Started the processes of moving what used to be the simple disruption model into Fraggle. Success criteria not being evaluated properly yet --- examples/Fragmentation/Fragmentation_Movie.py | 4 +- python/swiftest/swiftest/simulation_class.py | 8 +- src/collision/collision_generate.f90 | 421 +--------- src/collision/collision_module.f90 | 72 +- src/collision/collision_util.f90 | 188 ----- src/fraggle/fraggle_generate.f90 | 775 +++++++++--------- src/fraggle/fraggle_module.f90 | 67 +- src/fraggle/fraggle_util.f90 | 223 +++-- src/swiftest/swiftest_io.f90 | 5 +- src/swiftest/swiftest_util.f90 | 2 - 10 files changed, 595 insertions(+), 1170 deletions(-) diff --git a/examples/Fragmentation/Fragmentation_Movie.py b/examples/Fragmentation/Fragmentation_Movie.py index 8f0d7d22b..d17191912 100644 --- a/examples/Fragmentation/Fragmentation_Movie.py +++ b/examples/Fragmentation/Fragmentation_Movie.py @@ -86,7 +86,7 @@ body_Gmass = {"disruption_headon" : [1e-7, 1e-10], "disruption_off_axis" : [1e-7, 1e-10], - "supercatastrophic_headon": [1e-7, 1e-8], + "supercatastrophic_headon" : [1e-7, 1e-8], "supercatastrophic_off_axis": [1e-7, 1e-8], "hitandrun_disrupt" : [1e-7, 7e-10], "hitandrun_pure" : [1e-7, 7e-10] @@ -236,7 +236,7 @@ def data_stream(self, frame=0): # Set fragmentation parameters minimum_fragment_gmass = 0.2 * body_Gmass[style][1] # Make the minimum fragment mass a fraction of the smallest body gmtiny = 0.99 * body_Gmass[style][1] # Make GMTINY just smaller than the smallest original body. This will prevent runaway collisional cascades - sim.set_parameter(collision_model="disruption", encounter_save="both", gmtiny=gmtiny, minimum_fragment_gmass=minimum_fragment_gmass, verbose=False) + sim.set_parameter(collision_model="fraggle", encounter_save="both", gmtiny=gmtiny, minimum_fragment_gmass=minimum_fragment_gmass, verbose=False) sim.run(dt=1e-3, tstop=1.0e-3, istep_out=1, dump_cadence=0) print("Generating animation") diff --git a/python/swiftest/swiftest/simulation_class.py b/python/swiftest/swiftest/simulation_class.py index 530d8b034..e66848183 100644 --- a/python/swiftest/swiftest/simulation_class.py +++ b/python/swiftest/swiftest/simulation_class.py @@ -224,7 +224,7 @@ def __init__(self,read_param: bool = False, read_old_output: bool = False, simdi general_relativity : bool, default True Include the post-Newtonian correction in acceleration calculations. Parameter input file equivalent: `GR` - collision_model: {"MERGE","BOUNCE","SIMPLE","FRAGGLE"}, default "MERGE" + collision_model: {"MERGE","BOUNCE","FRAGGLE"}, default "MERGE" This is used to set the collision/fragmentation model. [TODO: DESCRIBE THESE] This argument only applies to Swiftest-SyMBA simulations. It will be ignored otherwise. Parameter input file equivalent: `COLLISION_MODEL` @@ -1015,7 +1015,7 @@ def get_integrator(self,arg_list: str | List[str] | None = None, verbose: bool | def set_feature(self, close_encounter_check: bool | None = None, general_relativity: bool | None = None, - collision_model: Literal["MERGE","BOUNCE","SIMPLE","FRAGGLE"] | None = None, + collision_model: Literal["MERGE","BOUNCE","FRAGGLE"] | None = None, minimum_fragment_gmass: float | None = None, minimum_fragment_mass: float | None = None, rotation: bool | None = None, @@ -1048,7 +1048,7 @@ def set_feature(self, *WARNING*: Enabling this feature could lead to very large files. general_relativity : bool, optional Include the post-Newtonian correction in acceleration calculations. - collision_model: {"MERGE","BOUNCE","SIMPLE","FRAGGLE"}, default "MERGE" + collision_model: {"MERGE","BOUNCE","FRAGGLE"}, default "MERGE" This is used to set the collision/fragmentation model. [TODO: DESCRIBE THESE] This argument only applies to Swiftest-SyMBA simulations. It will be ignored otherwise. Parameter input file equivalent: `COLLISION_MODEL` @@ -1129,7 +1129,7 @@ def set_feature(self, self.param["GR"] = general_relativity update_list.append("general_relativity") - fragmentation_models = ["FRAGGLE", "SIMPLE"] + fragmentation_models = ["FRAGGLE"] if collision_model is not None: collision_model = collision_model.upper() fragmentation = collision_model in fragmentation_models diff --git a/src/collision/collision_generate.f90 b/src/collision/collision_generate.f90 index 007ac8d0c..53900f353 100644 --- a/src/collision/collision_generate.f90 +++ b/src/collision/collision_generate.f90 @@ -105,10 +105,7 @@ module subroutine collision_generate_hitandrun(self, nbody_system, param, t) ! Result integer(I4B) :: status !! Status flag assigned to this outcome ! Internals - integer(I4B) :: i, ibiggest, nfrag, jtarg, jproj - logical :: lpure character(len=STRMAX) :: message - real(DP) :: dpe select type(nbody_system) @@ -120,69 +117,19 @@ module subroutine collision_generate_hitandrun(self, nbody_system, param, t) call collision_io_collider_message(nbody_system%pl, impactors%id, message) call swiftest_io_log_one_message(COLLISION_LOG_OUT, trim(adjustl(message))) - if (impactors%mass(1) > impactors%mass(2)) then - jtarg = 1 - jproj = 2 - else - jtarg = 2 - jproj = 1 - end if - - ! The simple disruption model (and its extended types allow for non-pure hit and run. - !For the basic merge model, all hit and runs are pure - select type(self) - class is (collision_disruption) - if (impactors%mass_dist(2) > 0.9_DP * impactors%mass(jproj)) then ! Pure hit and run, so we'll just keep the two bodies untouched - call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Pure hit and run. No new fragments generated.") - nfrag = 0 - lpure = .true. - else ! Imperfect hit and run, so we'll keep the largest body and destroy the other - lpure = .false. - call self%set_mass_dist(param) - - ! Generate the position and velocity distributions of the fragments - call self%get_energy_and_momentum(nbody_system, param, lbefore=.true.) - call self%disrupt(nbody_system, param, t, lpure) - call self%get_energy_and_momentum(nbody_system, param, lbefore=.false.) - - dpe = self%pe(2) - self%pe(1) - nbody_system%Ecollisions = nbody_system%Ecollisions - dpe - nbody_system%Euntracked = nbody_system%Euntracked + dpe - - if (lpure) then - call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Should have been a pure hit and run instead") - nfrag = 0 - else - nfrag = self%fragments%nbody - write(message, *) nfrag - call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Generating " // trim(adjustl(message)) // " fragments") - end if - end if - class default - lpure = .true. - end select + status = HIT_AND_RUN_PURE + pl%status(impactors%id(:)) = ACTIVE + pl%ldiscard(impactors%id(:)) = .false. + pl%lcollision(impactors%id(:)) = .false. + ! Be sure to save the pl so that snapshots still work + select type(before => self%before) + class is (swiftest_nbody_system) + select type(after => self%after) + class is (swiftest_nbody_system) + allocate(after%pl, source=before%pl) + end select + end select - if (lpure) then ! Reset these bodies back to being active so that nothing further is done to them - status = HIT_AND_RUN_PURE - pl%status(impactors%id(:)) = ACTIVE - pl%ldiscard(impactors%id(:)) = .false. - pl%lcollision(impactors%id(:)) = .false. - ! Be sure to save the pl so that snapshots still work - select type(before => self%before) - class is (swiftest_nbody_system) - select type(after => self%after) - class is (swiftest_nbody_system) - allocate(after%pl, source=before%pl) - end select - end select - else - ibiggest = impactors%id(maxloc(pl%Gmass(impactors%id(:)), dim=1)) - self%fragments%id(1) = pl%id(ibiggest) - self%fragments%id(2:nfrag) = [(i, i = param%maxid + 1, param%maxid + nfrag - 1)] - param%maxid = self%fragments%id(nfrag) - status = HIT_AND_RUN_DISRUPT - call collision_resolve_mergeaddsub(nbody_system, param, t, status) - end if end associate end select end select @@ -191,81 +138,6 @@ module subroutine collision_generate_hitandrun(self, nbody_system, param, t) end subroutine collision_generate_hitandrun - module subroutine collision_generate_disruption(self, nbody_system, param, t) - !! author: Jennifer L.L. Pouplin, Carlisle A. Wishard, and David A. Minton - !! - !! Create the fragments resulting from a non-catastrophic disruption collision - !! - implicit none - ! Arguments - class(collision_disruption), intent(inout) :: self - class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object - class(base_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions - real(DP), intent(in) :: t !! Time of collision - ! Internals - integer(I4B) :: i, ibiggest, nfrag - character(len=STRMAX) :: message - real(DP) :: dpe - - select type(nbody_system) - class is (swiftest_nbody_system) - select type(pl => nbody_system%pl) - class is (swiftest_pl) - associate(impactors => self%impactors, status => self%status) - - select case (impactors%regime) - case (COLLRESOLVE_REGIME_HIT_AND_RUN) - call self%hitandrun(nbody_system, param, t) - return - case (COLLRESOLVE_REGIME_MERGE, COLLRESOLVE_REGIME_GRAZE_AND_MERGE) - call self%merge(nbody_system, param, t) ! Use the default collision model, which is merge - return - case(COLLRESOLVE_REGIME_DISRUPTION) - message = "Disruption between" - case(COLLRESOLVE_REGIME_SUPERCATASTROPHIC) - message = "Supercatastrophic disruption between" - case default - write(*,*) "Error in swiftest_collision, unrecognized collision regime" - call util_exit(FAILURE) - end select - call self%set_mass_dist(param) - call self%get_energy_and_momentum(nbody_system, param, lbefore=.true.) - call self%set_budgets() - call impactors%set_coordinate_system() - call self%disrupt(nbody_system, param, t) - call self%get_energy_and_momentum(nbody_system, param, lbefore=.false.) - - dpe = self%pe(2) - self%pe(1) - nbody_system%Ecollisions = nbody_system%Ecollisions - dpe - nbody_system%Euntracked = nbody_system%Euntracked + dpe - - associate (fragments => self%fragments) - ! Populate the list of new bodies - nfrag = fragments%nbody - write(message, *) nfrag - call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Generating " // trim(adjustl(message)) // " fragments") - select case(impactors%regime) - case(COLLRESOLVE_REGIME_DISRUPTION) - status = DISRUPTED - ibiggest = impactors%id(maxloc(pl%Gmass(impactors%id(:)), dim=1)) - fragments%id(1) = pl%id(ibiggest) - fragments%id(2:nfrag) = [(i, i = param%maxid + 1, param%maxid + nfrag - 1)] - param%maxid = fragments%id(nfrag) - case(COLLRESOLVE_REGIME_SUPERCATASTROPHIC) - status = SUPERCATASTROPHIC - fragments%id(1:nfrag) = [(i, i = param%maxid + 1, param%maxid + nfrag)] - param%maxid = fragments%id(nfrag) - end select - - call collision_resolve_mergeaddsub(nbody_system, param, t, status) - end associate - end associate - end select - end select - return - end subroutine collision_generate_disruption - - module subroutine collision_generate_merge(self, nbody_system, param, t) !! author: Jennifer L.L. Pouplin, Carlisle A. Wishard, and David A. Minton !! @@ -370,273 +242,4 @@ module subroutine collision_generate_merge(self, nbody_system, param, t) end subroutine collision_generate_merge - module subroutine collision_generate_disrupt(self, nbody_system, param, t, lfailure) - !! author: Jennifer L.L. Pouplin, Carlisle A. Wishard, and David A. Minton - !! - !! Generates a simple fragment position and velocity distribution based on the collision - !! regime. - implicit none - ! Arguments - class(collision_disruption), intent(inout) :: self !! Simple fragment system object - class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object - class(base_parameters), intent(inout) :: param !! Current run configuration parameters - real(DP), intent(in) :: t !! The time of the collision - logical, optional, intent(out) :: lfailure - ! Internals - - call collision_generate_disruption_pos_vec(self) - call collision_generate_disruption_rot_vec(self) - call collision_generate_disruption_vel_vec(self) - - return - end subroutine collision_generate_disrupt - - - module subroutine collision_generate_disruption_pos_vec(collider) - !! Author: Jennifer L.L. Pouplin, Carlisle A. Wishard, and David A. Minton - !! - !! Initializes the position vectors of the fragments around the center of mass based on the collision style. - !! For hit and run with disruption, the fragments are generated in a random cloud around the smallest of the two colliders (body 2) - !! For disruptive collisions, the fragments are generated in a random cloud around the impact point. Bodies are checked for overlap and - !! regenerated if they overlap. - implicit none - ! Arguments - class(collision_disruption), intent(inout) :: collider !! Fraggle collision system object - ! Internals - real(DP) :: dis - real(DP), dimension(NDIM,2) :: fragment_cloud_center - real(DP), dimension(2) :: fragment_cloud_radius - logical, dimension(collider%fragments%nbody) :: loverlap - integer(I4B) :: i, j, loop - logical :: lcat, lhitandrun - integer(I4B), parameter :: MAXLOOP = 10000 - real(DP) :: rdistance - real(DP), parameter :: fail_scale = 1.1_DP ! Scale factor to apply to cloud radius and distance if cloud generation fails - - - associate(fragments => collider%fragments, impactors => collider%impactors, nfrag => collider%fragments%nbody) - lcat = (impactors%regime == COLLRESOLVE_REGIME_SUPERCATASTROPHIC) - lhitandrun = (impactors%regime == COLLRESOLVE_REGIME_HIT_AND_RUN) - - ! We will treat the first two fragments of the list as special cases. - ! Place the first two bodies at the centers of the two fragment clouds, but be sure they are sufficiently far apart to avoid overlap - rdistance = .mag. (impactors%rc(:,2) - impactors%rc(:,1)) - sum(fragments%radius(1:2)) - rdistance = min(0.5_DP*rdistance, 1e-6_DP*impactors%radius(2)) - - fragment_cloud_radius(:) = impactors%radius(:) - - loverlap(:) = .true. - do loop = 1, MAXLOOP - if (.not.any(loverlap(:))) exit - fragment_cloud_center(:,1) = impactors%rc(:,1) + rdistance * impactors%bounce_unit(:) - fragment_cloud_center(:,2) = impactors%rc(:,2) - rdistance * impactors%bounce_unit(:) - do concurrent(i = 1:nfrag, loverlap(i)) - if (i < 3) then - fragments%rc(:,i) = fragment_cloud_center(:,i) - else - ! Make a random cloud - call random_number(fragments%rc(:,i)) - - ! Make the fragment cloud symmertic about 0 - fragments%rc(:,i) = 2 *(fragments%rc(:,i) - 0.5_DP) - - j = fragments%origin_body(i) - - ! Scale the cloud size - fragments%rc(:,i) = fragment_cloud_radius(j) * fragments%rc(:,i) - - ! Shift to the cloud center coordinates - fragments%rc(:,i) = fragments%rc(:,i) + fragment_cloud_center(:,j) - end if - end do - - ! Check for any overlapping bodies. - loverlap(:) = .false. - do j = 1, nfrag - do i = j + 1, nfrag - dis = .mag.(fragments%rc(:,j) - fragments%rc(:,i)) - loverlap(i) = loverlap(i) .or. (dis <= (fragments%radius(i) + fragments%radius(j))) - end do - end do - rdistance = rdistance * fail_scale - fragment_cloud_radius(:) = fragment_cloud_radius(:) * fail_scale - end do - - call collision_util_shift_vector_to_origin(fragments%mass, fragments%rc) - call collider%set_coordinate_system() - - do concurrent(i = 1:nfrag) - fragments%rb(:,i) = fragments%rc(:,i) + impactors%rbcom(:) - end do - - impactors%rbcom(:) = 0.0_DP - do concurrent(i = 1:nfrag) - impactors%rbcom(:) = impactors%rbcom(:) + fragments%mass(i) * fragments%rb(:,i) - end do - impactors%rbcom(:) = impactors%rbcom(:) / fragments%mtot - end associate - - return - end subroutine collision_generate_disruption_pos_vec - - - module subroutine collision_generate_disruption_rot_vec(collider) - !! Author: Jennifer L.L. Pouplin, Carlisle A. Wishard, and David A. Minton - !! - !! Calculates the spins of a collection of fragments such that they conserve angular momentum - implicit none - ! Arguments - class(collision_basic), intent(inout) :: collider !! Fraggle collision system object - ! Internals - real(DP), dimension(NDIM) :: Lbefore, Lafter, Lspin, rotdir - real(DP) :: v_init, v_final, mass_init, mass_final, rotmag - integer(I4B) :: i - - associate(fragments => collider%fragments, impactors => collider%impactors, nfrag => collider%fragments%nbody) - - ! Torque the first body based on the change in angular momentum betwen the pre- and post-impact system assuming a simple bounce - mass_init = impactors%mass(2) - mass_final = sum(fragments%mass(2:nfrag)) - v_init = .mag.(impactors%vb(:,2) - impactors%vb(:,1)) - v_final = sqrt(mass_init / mass_final * v_init**2 - 2 * impactors%Qloss / mass_final) - - Lbefore(:) = mass_init * (impactors%rb(:,2) - impactors%rb(:,1)) .cross. (impactors%vb(:,2) - impactors%vb(:,1)) - - Lafter(:) = mass_final * (impactors%rb(:,2) - impactors%rb(:,1)) .cross. (v_final * impactors%bounce_unit(:)) - Lspin(:) = impactors%Lspin(:,1) + (Lbefore(:) - Lafter(:)) - fragments%rot(:,1) = Lspin(:) / (fragments%mass(1) * fragments%radius(1)**2 * fragments%Ip(3,1)) - - ! Add in some random spin noise. The magnitude will be scaled by the before-after amount and the direction will be random - do concurrent(i = 2:nfrag) - call random_number(rotdir) - rotdir = rotdir - 0.5_DP - rotdir = .unit. rotdir - call random_number(rotmag) - rotmag = rotmag * .mag. (Lbefore(:) - Lafter(:)) / ((nfrag - 1) * fragments%mass(i) * fragments%radius(i)**2 * fragments%Ip(3,i)) - fragments%rot(:,i) = rotmag * rotdir - end do - - end associate - - return - end subroutine collision_generate_disruption_rot_vec - - - module subroutine collision_generate_disruption_vel_vec(collider) - !! Author: David A. Minton - !! - !! Generates an initial velocity distribution. For disruptions, the velocity magnitude is set to be - !! 2x the escape velocity of the colliding pair. For hit and runs the velocity magnitude is set to be - !! 2x the escape velocity of the smallest of the two bodies. - implicit none - ! Arguments - class(collision_disruption), intent(inout) :: collider !! Fraggle collision system object - ! Internals - integer(I4B) :: i,j, loop, istart - logical :: lhitandrun, lnoncat - real(DP), dimension(NDIM) :: vimp_unit, rimp, vrot, Lresidual - real(DP) :: vmag, vesc, rotmag, ke_residual, ke_per_dof - integer(I4B), dimension(collider%fragments%nbody) :: vsign - real(DP), dimension(collider%fragments%nbody) :: vscale, mass_vscale, ke_avail - integer(I4B), parameter :: MAXLOOP = 100 - - associate(fragments => collider%fragments, impactors => collider%impactors, nfrag => collider%fragments%nbody) - lhitandrun = (impactors%regime == COLLRESOLVE_REGIME_HIT_AND_RUN) - lnoncat = (impactors%regime /= COLLRESOLVE_REGIME_SUPERCATASTROPHIC) ! For non-catastrophic impacts, make the fragments act like ejecta and point away from the impact point - - ! The fragments will be divided into two "clouds" based on identified origin body. - ! These clouds will collectively travel like two impactors bouncing off of each other. - where(fragments%origin_body(:) == 1) - vsign(:) = -1 - elsewhere - vsign(:) = 1 - end where - - ! The minimum fragment velocity will be set by the escape velocity - if (lhitandrun) then - vesc = sqrt(2 * impactors%Gmass(2) / impactors%radius(2)) - else - vesc = sqrt(2 * sum(impactors%Gmass(:)) / sum(impactors%radius(:))) - end if - - ! Scale the magnitude of the velocity by the distance from the impact point - ! This will reduce the chances of fragments colliding with each other immediately, and is more physically correct - do concurrent(i = 1:nfrag) - rimp(:) = fragments%rc(:,i) - impactors%rbimp(:) - vscale(i) = .mag. rimp(:) / (.mag. (impactors%rb(:,2) - impactors%rb(:,1))) - end do - vscale(:) = vscale(:)/minval(vscale(:)) - - ! Give the fragment velocities a random value that is scaled with fragment mass - call random_number(mass_vscale) - mass_vscale(:) = (mass_vscale(:) + 1.0_DP) / 2 - mass_vscale(:) = mass_vscale(:) * (fragments%mtot / fragments%mass(:))**(0.125_DP) ! The 1/8 power is arbitrary. It just gives the velocity a small mass dependence - mass_vscale(:) = mass_vscale(:) / minval(mass_vscale(:)) - - ! Set the velocities of all fragments using all of the scale factors determined above - do concurrent(i = 1:nfrag) - j = fragments%origin_body(i) - vrot(:) = impactors%rot(:,j) .cross. (fragments%rc(:,i) - impactors%rc(:,j)) - if (lhitandrun) then - if (i == 1) then - fragments%vc(:,1) = impactors%vc(:,1) - else - vmag = .mag.impactors%vc(:,2) / (maxval(mass_vscale(:) * maxval(vscale(:)))) - fragments%vc(:,i) = vmag * mass_vscale(i) * vscale(i) * impactors%bounce_unit(:) * vsign(i) + vrot(:) - end if - else - ! Add more velocity dispersion to disruptions vs hit and runs. - vmag = vesc * vscale(i) * mass_vscale(i) - rimp(:) = fragments%rc(:,i) - impactors%rbimp(:) - vimp_unit(:) = .unit. rimp(:) - fragments%vc(:,i) = vmag * (impactors%bounce_unit(:) + vimp_unit(:)) * vsign(i) + vrot(:) - end if - end do - - if (lhitandrun) then - istart = 2 - else - istart = 1 - end if - do loop = 1, MAXLOOP - call collider%set_coordinate_system() - call fragments%get_kinetic_energy() - ke_residual = fragments%ke_budget - (fragments%ke_orbit + fragments%ke_spin) - ! Make sure we don't take away too much orbital kinetic energy, otherwise the fragment can't escape - ke_avail(:) = fragments%ke_orbit_frag(:) - impactors%Gmass(1)*impactors%mass(2)/fragments%vmag(:) - ke_per_dof = -ke_residual/(nfrag - istart + 1) - do concurrent(i = istart:nfrag, ke_avail(i) > ke_per_dof) - fragments%vmag(i) = sqrt(2 * (fragments%ke_orbit_frag(i) - ke_per_dof)/fragments%mass(i)) - fragments%vc(:,i) = fragments%vmag(i) * fragments%v_unit(:,i) - end do - call fragments%get_kinetic_energy() - ke_residual = fragments%ke_budget - (fragments%ke_orbit + fragments%ke_spin) - - ! Check for any residual angular momentum, and if there is any, put it into spin of the biggest body - call collider%set_coordinate_system() - call fragments%get_angular_momentum() - Lresidual(:) = fragments%L_budget(:) - (fragments%Lorbit(:) + fragments%Lspin(:)) - rotmag = .mag. fragments%rot(:,1) - fragments%rot(:,1) = fragments%rot(:,1) + Lresidual(:) / (fragments%mass(1) * fragments%radius(1)**2 * fragments%Ip(:,1)) - rotmag = .mag. fragments%rot(:,1) - - if (ke_residual >= 0.0_DP) exit - - end do - - do concurrent(i = 1:nfrag) - fragments%vb(:,i) = fragments%vc(:,i) + impactors%vbcom(:) - end do - - impactors%vbcom(:) = 0.0_DP - do concurrent(i = 1:nfrag) - impactors%vbcom(:) = impactors%vbcom(:) + fragments%mass(i) * fragments%vb(:,i) - end do - impactors%vbcom(:) = impactors%vbcom(:) / fragments%mtot - - end associate - return - end subroutine collision_generate_disruption_vel_vec - - end submodule s_collision_generate diff --git a/src/collision/collision_module.f90 b/src/collision/collision_module.f90 index c9d81322f..5fe3893cb 100644 --- a/src/collision/collision_module.f90 +++ b/src/collision/collision_module.f90 @@ -123,7 +123,6 @@ module collision procedure :: reset => collision_util_reset_fragments !! Deallocates all allocatable arrays and sets everything else to 0 procedure :: get_angular_momentum => collision_util_get_angular_momentum !! Calcualtes the current angular momentum of the fragments procedure :: get_kinetic_energy => collision_util_get_kinetic_energy !! Calcualtes the current kinetic energy of the fragments - procedure :: set_spins => collision_util_set_spins !! Calcualtes the spins of all fragments from the angular momentum budget and residual final :: collision_final_fragments !! Finalizer deallocates all allocatables end type collision_fragments @@ -168,13 +167,7 @@ module collision final :: collision_final_bounce !! Finalizer will deallocate all allocatables end type collision_bounce - type, extends(collision_basic) :: collision_disruption - contains - procedure :: generate => collision_generate_disruption !! A simple disruption models that does not constrain energy loss in collisions - procedure :: disrupt => collision_generate_disrupt !! Disrupt the colliders into the fragments - procedure :: set_mass_dist => collision_util_set_mass_dist !! Sets the distribution of mass among the fragments depending on the regime type - final :: collision_final_simple !! Finalizer will deallocate all allocatables - end type collision_disruption + !! NetCDF dimension and variable names for the enounter save object @@ -236,14 +229,6 @@ module subroutine collision_generate_bounce(self, nbody_system, param, t) real(DP), intent(in) :: t !! The time of the collision end subroutine collision_generate_bounce - module subroutine collision_generate_disrupt(self, nbody_system, param, t, lfailure) - implicit none - class(collision_disruption), intent(inout) :: self - class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object - class(base_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions - real(DP), intent(in) :: t !! Time of collision - logical, optional, intent(out) :: lfailure !! Disruption failed - end subroutine collision_generate_disrupt module subroutine collision_generate_hitandrun(self, nbody_system, param, t) implicit none @@ -261,28 +246,6 @@ module subroutine collision_generate_merge(self, nbody_system, param, t) real(DP), intent(in) :: t !! The time of the collision end subroutine collision_generate_merge - module subroutine collision_generate_disruption(self, nbody_system, param, t) - implicit none - class(collision_disruption), intent(inout) :: self !! Simple fragment nbody_system object - class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object - class(base_parameters), intent(inout) :: param !! Current run configuration parameters - real(DP), intent(in) :: t !! The time of the collision - end subroutine collision_generate_disruption - - module subroutine collision_generate_disruption_pos_vec(collider) - implicit none - class(collision_disruption), intent(inout) :: collider !! Collision system object - end subroutine collision_generate_disruption_pos_vec - - module subroutine collision_generate_disruption_rot_vec(collider) - implicit none - class(collision_basic), intent(inout) :: collider !! Collision system object - end subroutine collision_generate_disruption_rot_vec - - module subroutine collision_generate_disruption_vel_vec(collider) - implicit none - class(collision_disruption), intent(inout) :: collider !! Collision system object - end subroutine collision_generate_disruption_vel_vec module subroutine collision_io_collider_message(pl, collidx, collider_message) implicit none @@ -446,17 +409,6 @@ module subroutine collision_util_set_coordinate_impactors(self) class(collision_impactors), intent(inout) :: self !! collisional system end subroutine collision_util_set_coordinate_impactors - module subroutine collision_util_set_mass_dist(self, param) - implicit none - class(collision_disruption), intent(inout) :: self !! Simple disruption collision object - class(base_parameters), intent(in) :: param !! Current Swiftest run configuration parameters - end subroutine collision_util_set_mass_dist - - module subroutine collision_util_set_spins(self) - implicit none - class(collision_fragments(*)), intent(inout) :: self !! Collision fragment system object - end subroutine collision_util_set_spins - module subroutine collision_util_setup_collider(self, nbody_system) implicit none class(collision_basic), intent(inout) :: self !! Encounter collision system object @@ -534,7 +486,6 @@ subroutine collision_final_fragments(self) return end subroutine collision_final_fragments - subroutine collision_final_impactors(self) !! author: David A. Minton !! @@ -548,7 +499,6 @@ subroutine collision_final_impactors(self) return end subroutine collision_final_impactors - subroutine collision_final_netcdf_parameters(self) !! author: David A. Minton !! @@ -562,7 +512,6 @@ subroutine collision_final_netcdf_parameters(self) return end subroutine collision_final_netcdf_parameters - subroutine collision_final_plpl(self) !! author: David A. Minton !! @@ -589,7 +538,6 @@ subroutine collision_final_pltp(self) return end subroutine collision_final_pltp - subroutine collision_final_snapshot(self) !! author: David A. Minton !! @@ -603,7 +551,6 @@ subroutine collision_final_snapshot(self) return end subroutine collision_final_snapshot - subroutine collision_final_storage(self) !! author: David A. Minton !! @@ -621,7 +568,6 @@ subroutine collision_final_storage(self) return end subroutine collision_final_storage - subroutine collision_final_bounce(self) !! author: David A. Minton !! @@ -637,21 +583,5 @@ subroutine collision_final_bounce(self) return end subroutine collision_final_bounce - - subroutine collision_final_simple(self) - !! author: David A. Minton - !! - !! Finalizer will deallocate all allocatables - implicit none - ! Arguments - type(collision_disruption), intent(inout) :: self !! Collision system object - - call self%reset() - if (allocated(self%impactors)) deallocate(self%impactors) - if (allocated(self%fragments)) deallocate(self%fragments) - - return - end subroutine collision_final_simple - end module collision diff --git a/src/collision/collision_util.f90 b/src/collision/collision_util.f90 index 0d76af301..ef582ee10 100644 --- a/src/collision/collision_util.f90 +++ b/src/collision/collision_util.f90 @@ -527,194 +527,6 @@ module subroutine collision_util_set_coordinate_impactors(self) end subroutine collision_util_set_coordinate_impactors - module subroutine collision_util_set_mass_dist(self, param) - !! author: David A. Minton - !! - !! Sets the mass of fragments based on the mass distribution returned by the regime calculation. - !! This subroutine must be run after the the setup routine has been run on the fragments - !! - implicit none - ! Arguments - class(collision_disruption), intent(inout) :: self !! Fraggle collision system object - class(base_parameters), intent(in) :: param !! Current Swiftest run configuration parameters - ! Internals - integer(I4B) :: i, j, jproj, jtarg, nfrag, istart - real(DP), dimension(2) :: volume - real(DP), dimension(NDIM) :: Ip_avg - real(DP) :: mfrag, mremaining, min_mfrag, mtot, mcumul - real(DP), parameter :: BETA = 2.85_DP - integer(I4B), parameter :: NFRAGMAX = 100 !! Maximum number of fragments that can be generated - integer(I4B), parameter :: NFRAGMIN = 7 !! Minimum number of fragments that can be generated (set by the fraggle_generate algorithm for constraining momentum and energy) - integer(I4B), parameter :: NFRAG_SIZE_MULTIPLIER = 3 !! Log-space scale factor that scales the number of fragments by the collisional system mass - integer(I4B), parameter :: iMlr = 1 - integer(I4B), parameter :: iMslr = 2 - integer(I4B), parameter :: iMrem = 3 - logical :: flipper - - associate(impactors => self%impactors) - ! Get mass weighted mean of Ip and density - volume(1:2) = 4._DP / 3._DP * PI * impactors%radius(1:2)**3 - mtot = sum(impactors%mass(:)) - Ip_avg(:) = (impactors%mass(1) * impactors%Ip(:,1) + impactors%mass(2) * impactors%Ip(:,2)) / mtot - - if (impactors%mass(1) > impactors%mass(2)) then - jtarg = 1 - jproj = 2 - else - jtarg = 2 - jproj = 1 - end if - - select case(impactors%regime) - case(COLLRESOLVE_REGIME_DISRUPTION, COLLRESOLVE_REGIME_SUPERCATASTROPHIC, COLLRESOLVE_REGIME_HIT_AND_RUN) - ! The first two bins of the mass_dist are the largest and second-largest fragments that came out of collision_regime. - ! The remainder from the third bin will be distributed among nfrag-2 bodies. The following code will determine nfrag based on - ! the limits bracketed above and the model size distribution of fragments. - ! Check to see if our size distribution would give us a smaller number of fragments than the maximum number - - select type(param) - class is (swiftest_parameters) - min_mfrag = (param%min_GMfrag / param%GU) - ! The number of fragments we generate is bracked by the minimum required by fraggle_generate (7) and the - ! maximum set by the NFRAG_SIZE_MULTIPLIER which limits the total number of fragments to prevent the nbody - ! code from getting an overwhelmingly large number of fragments - nfrag = ceiling(NFRAG_SIZE_MULTIPLIER * log(mtot / min_mfrag)) - nfrag = max(min(nfrag, NFRAGMAX), NFRAGMIN) - class default - min_mfrag = 0.0_DP - nfrag = NFRAGMAX - end select - - i = iMrem - mremaining = impactors%mass_dist(iMrem) - do while (i <= nfrag) - mfrag = (1 + i - iMslr)**(-3._DP / BETA) * impactors%mass_dist(iMslr) - if (mremaining - mfrag < 0.0_DP) exit - mremaining = mremaining - mfrag - i = i + 1 - end do - if (i < nfrag) nfrag = max(i, NFRAGMIN) ! The sfd would actually give us fewer fragments than our maximum - call self%setup_fragments(nfrag) - - case (COLLRESOLVE_REGIME_MERGE, COLLRESOLVE_REGIME_GRAZE_AND_MERGE) - - call self%setup_fragments(1) - select type(fragments => self%fragments) - class is (collision_fragments(*)) - fragments%mass(1) = impactors%mass_dist(1) - fragments%radius(1) = impactors%radius(jtarg) - fragments%density(1) = impactors%mass_dist(1) / volume(jtarg) - if (param%lrotation) fragments%Ip(:, 1) = impactors%Ip(:,1) - end select - return - case default - write(*,*) "collision_util_set_mass_dist_fragments error: Unrecognized regime code",impactors%regime - end select - - select type(fragments => self%fragments) - class is (collision_fragments(*)) - fragments%mtot = mtot - - ! Make the first two bins the same as the Mlr and Mslr values that came from collision_regime - fragments%mass(1) = impactors%mass_dist(iMlr) - fragments%mass(2) = impactors%mass_dist(iMslr) - - ! Distribute the remaining mass the 3:nfrag bodies following the model SFD given by slope BETA - mremaining = impactors%mass_dist(iMrem) - do i = iMrem, nfrag - mfrag = (1 + i - iMslr)**(-3._DP / BETA) * impactors%mass_dist(iMslr) - fragments%mass(i) = mfrag - mremaining = mremaining - mfrag - end do - - ! If there is any residual mass (either positive or negative) we will distribute remaining mass proportionally among the the fragments - if (mremaining < 0.0_DP) then ! If the remainder is negative, this means that that the number of fragments required by the SFD is smaller than our lower limit set by fraggle_generate. - istart = iMrem ! We will reduce the mass of the 3:nfrag bodies to prevent the second-largest fragment from going smaller - else ! If the remainder is postiive, this means that the number of fragments required by the SFD is larger than our upper limit set by computational expediency. - istart = iMslr ! We will increase the mass of the 2:nfrag bodies to compensate, which ensures that the second largest fragment remains the second largest - end if - mfrag = 1._DP + mremaining / sum(fragments%mass(istart:nfrag)) - fragments%mass(istart:nfrag) = fragments%mass(istart:nfrag) * mfrag - - ! There may still be some small residual due to round-off error. If so, simply add it to the last bin of the mass distribution. - mremaining = fragments%mtot - sum(fragments%mass(1:nfrag)) - fragments%mass(nfrag) = fragments%mass(nfrag) + mremaining - - ! Compute physical properties of the new fragments - select case(impactors%regime) - case(COLLRESOLVE_REGIME_HIT_AND_RUN) ! The hit and run case always preserves the largest body intact, so there is no need to recompute the physical properties of the first fragment - fragments%radius(1) = impactors%radius(jtarg) - fragments%density(1) = impactors%mass_dist(iMlr) / volume(jtarg) - fragments%Ip(:, 1) = impactors%Ip(:,1) - istart = 2 - case default - istart = 1 - end select - - fragments%density(istart:nfrag) = fragments%mtot / sum(volume(:)) - fragments%radius(istart:nfrag) = (3 * fragments%mass(istart:nfrag) / (4 * PI * fragments%density(istart:nfrag)))**(1.0_DP / 3.0_DP) - do i = istart, nfrag - fragments%Ip(:, i) = Ip_avg(:) - end do - - ! For catastrophic impacts, we will assign each of the n>2 fragments to one of the two original bodies so that the fragment cloud occupies - ! roughly the same space as both original bodies. For all other disruption cases, we use body 2 as the center of the cloud. - fragments%origin_body(1) = 1 - fragments%origin_body(2) = 2 - if (impactors%regime == COLLRESOLVE_REGIME_SUPERCATASTROPHIC) then - mcumul = fragments%mass(1) - flipper = .true. - j = 2 - do i = 1, nfrag - if (flipper .and. (mcumul < impactors%mass(1))) then - flipper = .false. - j = 1 - else - j = 2 - flipper = .true. - end if - fragments%origin_body(i) = j - end do - else - fragments%origin_body(3:nfrag) = 2 - end if - - end select - - - end associate - - return - end subroutine collision_util_set_mass_dist - - - module subroutine collision_util_set_spins(self) - !! Author: David A. Minton - !! - !! Distributes any residual angular momentum into the spins of the n>1 fragments - implicit none - ! Arguments - class(collision_fragments(*)), intent(inout) :: self !! Collision fragment system object - ! Internals - integer(I4B) :: i - real(DP), dimension(NDIM) :: Lresidual - - call self%get_angular_momentum() - Lresidual(:) = self%L_budget(:) - (self%Lorbit(:) + self%Lspin(:)) - ! Distribute residual angular momentum amongst the fragments - if (.mag.(Lresidual(:)) > tiny(1.0_DP)) then - do i = 1,self%nbody - self%rot(:,i) = self%rot(:,i) + Lresidual(:) / (self%nbody * self%mass(i) * self%radius(i)**2 * self%Ip(3,i)) - end do - end if - - call self%get_angular_momentum() - Lresidual(:) = self%L_budget(:) - (self%Lorbit(:) + self%Lspin(:)) - - return - end subroutine collision_util_set_spins - - module subroutine collision_util_setup_collider(self, nbody_system) !! author: David A. Minton !! diff --git a/src/fraggle/fraggle_generate.f90 b/src/fraggle/fraggle_generate.f90 index f8361be19..08c184ab0 100644 --- a/src/fraggle/fraggle_generate.f90 +++ b/src/fraggle/fraggle_generate.f90 @@ -11,12 +11,86 @@ use swiftest use symba - integer(I4B), parameter :: NFRAG_MIN = 7 !! The minimum allowable number of fragments (set to 6 because that's how many unknowns are needed in the tangential velocity calculation) real(DP), parameter :: FRAGGLE_LTOL = 1e-4_DP !10 * epsilon(1.0_DP) real(DP), parameter :: FRAGGLE_ETOL = 1e-1_DP contains + module subroutine fraggle_generate(self, nbody_system, param, t) + !! author: Jennifer L.L. Pouplin, Carlisle A. Wishard, and David A. Minton + !! + !! Create the fragments resulting from a non-catastrophic disruption collision + !! + implicit none + ! Arguments + class(collision_fraggle), intent(inout) :: self + class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object + class(base_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions + real(DP), intent(in) :: t !! Time of collision + ! Internals + integer(I4B) :: i, ibiggest, nfrag + character(len=STRMAX) :: message + real(DP) :: dpe + + select type(nbody_system) + class is (swiftest_nbody_system) + select type(pl => nbody_system%pl) + class is (swiftest_pl) + associate(impactors => self%impactors, status => self%status) + + select case (impactors%regime) + case (COLLRESOLVE_REGIME_HIT_AND_RUN) + call self%hitandrun(nbody_system, param, t) + return + case (COLLRESOLVE_REGIME_MERGE, COLLRESOLVE_REGIME_GRAZE_AND_MERGE) + call self%merge(nbody_system, param, t) ! Use the default collision model, which is merge + return + case(COLLRESOLVE_REGIME_DISRUPTION) + message = "Disruption between" + case(COLLRESOLVE_REGIME_SUPERCATASTROPHIC) + message = "Supercatastrophic disruption between" + case default + write(*,*) "Error in swiftest_collision, unrecognized collision regime" + call util_exit(FAILURE) + end select + call self%set_mass_dist(param) + call self%get_energy_and_momentum(nbody_system, param, lbefore=.true.) + call self%set_budgets() + call impactors%set_coordinate_system() + call self%disrupt(nbody_system, param, t) + call self%get_energy_and_momentum(nbody_system, param, lbefore=.false.) + + dpe = self%pe(2) - self%pe(1) + nbody_system%Ecollisions = nbody_system%Ecollisions - dpe + nbody_system%Euntracked = nbody_system%Euntracked + dpe + + associate (fragments => self%fragments) + ! Populate the list of new bodies + nfrag = fragments%nbody + write(message, *) nfrag + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Generating " // trim(adjustl(message)) // " fragments") + select case(impactors%regime) + case(COLLRESOLVE_REGIME_DISRUPTION) + status = DISRUPTED + ibiggest = impactors%id(maxloc(pl%Gmass(impactors%id(:)), dim=1)) + fragments%id(1) = pl%id(ibiggest) + fragments%id(2:nfrag) = [(i, i = param%maxid + 1, param%maxid + nfrag - 1)] + param%maxid = fragments%id(nfrag) + case(COLLRESOLVE_REGIME_SUPERCATASTROPHIC) + status = SUPERCATASTROPHIC + fragments%id(1:nfrag) = [(i, i = param%maxid + 1, param%maxid + nfrag)] + param%maxid = fragments%id(nfrag) + end select + + call collision_resolve_mergeaddsub(nbody_system, param, t, status) + end associate + end associate + end select + end select + return + end subroutine fraggle_generate + + module subroutine fraggle_generate_disrupt(self, nbody_system, param, t, lfailure) !! Author: Jennifer L.L. Pouplin, Carlisle A. Wishard, and David A. Minton !! @@ -54,12 +128,6 @@ module subroutine fraggle_generate_disrupt(self, nbody_system, param, t, lfailur write(message,*) nfrag call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Fraggle generating " // trim(adjustl(message)) // " fragments.") - if (nfrag < NFRAG_MIN) then - write(message,*) "Fraggle needs at least ",NFRAG_MIN," fragments, but only ",nfrag," were given." - call swiftest_io_log_one_message(COLLISION_LOG_OUT, message) - lfailure_local = .true. - return - end if if (param%lflatten_interactions) then lk_plpl = allocated(pl%k_plpl) @@ -88,14 +156,10 @@ module subroutine fraggle_generate_disrupt(self, nbody_system, param, t, lfailur ! Use the disruption collision model to generate initial conditions ! Compute the "before" energy/momentum and the budgets call self%get_energy_and_momentum(nbody_system, param, lbefore=.true.) - call self%collision_disruption%disrupt(nbody_system, param, t) + call fraggle_generate_pos_vec(self) + call fraggle_generate_rot_vec(self) + call fraggle_generate_vel_vec(self) call self%get_energy_and_momentum(nbody_system, param, lbefore=.false.) - call self%set_budgets() - - ! Minimize difference between energy/momentum and budgets - ! call fraggle_generate_minimize(self, lfailure_local) - ! call fraggle_generate_tan_vel(self, lfailure_local) - call fraggle_generate_rad_vel(self, lfailure_local) call self%get_energy_and_momentum(nbody_system, param, lbefore=.false.) dEtot = self%Etot(2) - self%Etot(1) @@ -151,433 +215,334 @@ module subroutine fraggle_generate_disrupt(self, nbody_system, param, t, lfailur end subroutine fraggle_generate_disrupt - subroutine fraggle_generate_minimize(collider, lfailure) - !! Author: Jennifer L.L. Pouplin, Carlisle A. Wishard, and David A. Minton - !! - !! Minimizes the differences between the energy and momentum and the budget + module subroutine fraggle_generate_hitandrun(self, nbody_system, param, t) + !! author: Jennifer L.L. Pouplin, Carlisle A. Wishard, and David A. Minton !! - !! A failure will trigger a restructuring of the fragments so we will try a new random distribution + !! Create the fragments resulting from a non-catastrophic hit-and-run collision + !! implicit none ! Arguments - class(collision_fraggle), intent(inout) :: collider !! Fraggle collision system object - logical, intent(out) :: lfailure !! Logical flag indicating whether this step fails or succeeds + class(collision_fraggle), intent(inout) :: self !! Collision system object + class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object + class(base_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions + real(DP), intent(in) :: t !! Time of collision + ! Result + integer(I4B) :: status !! Status flag assigned to this outcome ! Internals - real(DP), parameter :: TOL_INIT = 1e-5_DP - integer(I4B), parameter :: MAXLOOP = 100 - real(DP), dimension(collider%fragments%nbody) :: input_v - real(DP), dimension(:), allocatable :: output_v - type(lambda_obj) :: Efunc - real(DP) :: tol, fval - integer(I4B) :: loop,i, nelem - logical :: lfirst_Efunc - - associate(impactors => collider%impactors, nfrag => collider%fragments%nbody) - select type(fragments => collider%fragments) - class is (fraggle_fragments(*)) - - nelem = nfrag - lfailure = .false. - ! Find the local kinetic energy minimum for the nbody_system that conserves linear and angular momentum - Efunc = lambda_obj(E_objective_function) - tol = TOL_INIT - - fragments%r_unit(:,:) = .unit. fragments%vc(:,:) - fragments%vmag(:) = .mag. fragments%vc(:,1:nfrag) - input_v(:) = fragments%vmag(1:nfrag) - lfirst_Efunc = .true. - fval = E_objective_function(input_v) - - call minimize_bfgs(Efunc, nelem, input_v, tol, MAXLOOP, lfailure, output_v) - fval = E_objective_function(output_v) - fragments%vmag(1:nfrag) = output_v(1:nfrag) - do concurrent(i=1:nfrag) - fragments%vc(:,i) = abs(fragments%vmag(i)) * fragments%r_unit(:,i) - end do + integer(I4B) :: i, ibiggest, nfrag, jtarg, jproj + logical :: lpure + character(len=STRMAX) :: message + real(DP) :: dpe - ! Set spins in order to conserve angular momentum - call fragments%set_spins() - call collision_util_shift_vector_to_origin(fragments%mass, fragments%vc) - end select - end associate - return + select type(nbody_system) + class is (swiftest_nbody_system) + select type(pl => nbody_system%pl) + class is (swiftest_pl) + associate(impactors => self%impactors) + message = "Hit and run between" + call collision_io_collider_message(nbody_system%pl, impactors%id, message) + call swiftest_io_log_one_message(COLLISION_LOG_OUT, trim(adjustl(message))) + + if (impactors%mass(1) > impactors%mass(2)) then + jtarg = 1 + jproj = 2 + else + jtarg = 2 + jproj = 1 + end if - contains - - function E_objective_function(val_input) result(fval) - !! Author: David A. Minton - !! - !! Objective function for evaluating how close our fragment trajectories are to the energy budget - implicit none - ! Arguments - real(DP), dimension(:), intent(in) :: val_input !! Flattened velocity and rotation arrays - ! Result - real(DP) :: fval !! The objective function result, which is the sum of the squares of the difference between the calculated fragment kinetic energy and the components of angular and linear momentum - !! Minimizing this brings us closer to our objective - ! Internals - integer(I4B) :: i - type(fraggle_fragments(:)), allocatable :: tmp_frag - real(DP) :: deltaE - real(DP), save :: deltaE_scale = 1.0_DP - - associate(impactors => collider%impactors, nfrag => collider%fragments%nbody) - select type(fragments => collider%fragments) - class is (fraggle_fragments(*)) - allocate(tmp_frag, source=fragments) - tmp_frag%vmag(1:nfrag) = val_input(1:nfrag) - do concurrent(i=1:nfrag) - tmp_frag%vc(:,i) = abs(tmp_frag%vmag(i)) * tmp_frag%r_unit(:,i) - end do - - call collision_util_shift_vector_to_origin(tmp_frag%mass, tmp_frag%vc) - ! Set spins in order to conserve angular momentum - call collision_util_set_spins(tmp_frag) - - ! Get the current kinetic energy of the system - call tmp_frag%get_kinetic_energy() - deltaE = (tmp_frag%ke_budget - (tmp_frag%ke_orbit + tmp_frag%ke_spin)) / (tmp_frag%ke_budget) - - ! The result will be scaled so such that the initial deltaE is 1.0. This helps improve the success of the - ! minimizer, by keeping values from getting to large - if (lfirst_Efunc) then - deltaE_scale = deltaE - deltaE = 1.0_DP - lfirst_Efunc = .false. - else - deltaE = deltaE/deltaE_scale - end if - fval = deltaE**2 - deallocate(tmp_frag) - - end select - end associate - - return - end function E_objective_function + ! The frag disruption model (and its extended types allow for non-pure hit and run. + if (impactors%mass_dist(2) > 0.9_DP * impactors%mass(jproj)) then ! Pure hit and run, so we'll just keep the two bodies untouched + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Pure hit and run. No new fragments generated.") + nfrag = 0 + call self%collision_basic%hitandrun(nbody_system, param, t) + lpure = .true. + return + else ! Imperfect hit and run, so we'll keep the largest body and destroy the other + lpure = .false. + call self%set_mass_dist(param) + + ! Generate the position and velocity distributions of the fragments + call self%get_energy_and_momentum(nbody_system, param, lbefore=.true.) + call self%disrupt(nbody_system, param, t, lpure) + call self%get_energy_and_momentum(nbody_system, param, lbefore=.false.) + + dpe = self%pe(2) - self%pe(1) + nbody_system%Ecollisions = nbody_system%Ecollisions - dpe + nbody_system%Euntracked = nbody_system%Euntracked + dpe + + if (lpure) then + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Should have been a pure hit and run instead") + nfrag = 0 + else + nfrag = self%fragments%nbody + write(message, *) nfrag + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Generating " // trim(adjustl(message)) // " fragments") + end if + end if + + ibiggest = impactors%id(maxloc(pl%Gmass(impactors%id(:)), dim=1)) + self%fragments%id(1) = pl%id(ibiggest) + self%fragments%id(2:nfrag) = [(i, i = param%maxid + 1, param%maxid + nfrag - 1)] + param%maxid = self%fragments%id(nfrag) + status = HIT_AND_RUN_DISRUPT + call collision_resolve_mergeaddsub(nbody_system, param, t, status) + end associate + end select + end select + + return + end subroutine fraggle_generate_hitandrun - end subroutine fraggle_generate_minimize - subroutine fraggle_generate_tan_vel(collider, lfailure) + module subroutine fraggle_generate_pos_vec(collider) !! Author: Jennifer L.L. Pouplin, Carlisle A. Wishard, and David A. Minton !! - !! Adjusts the tangential velocities and spins of a collection of fragments such that they conserve angular momentum without blowing the fragment kinetic energy budget. - !! This procedure works in several stages, with a goal to solve the angular and linear momentum constraints on the fragments, while still leaving a positive balance of - !! our fragment kinetic energy (fragments%ke_budget) that we can put into the radial velocity distribution. - !! - !! The first thing we'll try to do is solve for the tangential velocities of the first 6 fragments, using angular and linear momentum as constraints and an initial - !! tangential velocity distribution for the remaining bodies (if there are any) that distributes their angular momentum equally between them. - !! If that doesn't work and we blow our kinetic energy budget, we will attempt to find a tangential velocity distribution that minimizes the kinetic energy while - !! conserving momentum. - !! - !! A failure will trigger a restructuring of the fragments so we will try new values of the radial position distribution. + !! Initializes the position vectors of the fragments around the center of mass based on the collision style. + !! For hit and run with disruption, the fragments are generated in a random cloud around the smallest of the two colliders (body 2) + !! For disruptive collisions, the fragments are generated in a random cloud around the impact point. Bodies are checked for overlap and + !! regenerated if they overlap. implicit none ! Arguments - class(collision_fraggle), intent(inout) :: collider !! Fraggle fragment system object - logical, intent(out) :: lfailure !! Logical flag indicating whether this step fails or succeeds + class(collision_fraggle), intent(inout) :: collider !! Fraggle collision system object ! Internals - integer(I4B) :: i - real(DP), parameter :: TOL_MIN = 1e-1_DP ! This doesn't have to be very accurate, as we really just want a tangential velocity distribution with less kinetic energy than our initial guess. - real(DP), parameter :: TOL_INIT = 1e-6_DP - real(DP), parameter :: VNOISE_MAG = 1e-3_DP !! Magnitude of the noise to apply to initial conditions to help minimizer find a solution in case of failure - integer(I4B), parameter :: MAXLOOP = 10 - real(DP) :: tol, fval - real(DP), dimension(:), allocatable :: v_t_initial - real(DP), dimension(collider%fragments%nbody) :: kefrag, vnoise - type(lambda_obj_err) :: objective_function - real(DP), dimension(NDIM) :: Li, L_remainder, L_frag_tot - character(len=STRMAX) :: message - real(DP), dimension(:), allocatable :: v_t_output - logical :: lfirst_func - - associate(impactors => collider%impactors, nfrag => collider%fragments%nbody) - select type(fragments => collider%fragments) - class is (fraggle_fragments(*)) - lfailure = .false. - - ! Solve for the tangential component of the velocities that both conserves linear momentum and uses the remaining angular momentum not used in spin. - ! This will be done using a linear solver that solves for the tangential velocities of the first 6 fragments, constrained by the linear and angular momentum vectors, - ! which is embedded in a non-linear minimizer that will adjust the tangential velocities of the remaining i>6 fragments to minimize kinetic energy for a given momentum solution - ! The initial conditions fed to the minimizer for the fragments will be the remaining angular momentum distributed between the fragments. - tol = TOL_INIT - lfirst_func = .true. - do i = 1, nfrag - fragments%v_t_mag(i) = dot_product(fragments%vc(:,i), fragments%t_unit(:,i)) - fragments%v_r_mag(i) = dot_product(fragments%vc(:,i), fragments%r_unit(:,i)) + real(DP) :: dis + real(DP), dimension(NDIM,2) :: fragment_cloud_center + real(DP), dimension(2) :: fragment_cloud_radius + logical, dimension(collider%fragments%nbody) :: loverlap + integer(I4B) :: i, j, loop + logical :: lcat, lhitandrun + integer(I4B), parameter :: MAXLOOP = 10000 + real(DP) :: rdistance + real(DP), parameter :: fail_scale = 1.1_DP ! Scale factor to apply to cloud radius and distance if cloud generation fails + + + associate(fragments => collider%fragments, impactors => collider%impactors, nfrag => collider%fragments%nbody) + lcat = (impactors%regime == COLLRESOLVE_REGIME_SUPERCATASTROPHIC) + lhitandrun = (impactors%regime == COLLRESOLVE_REGIME_HIT_AND_RUN) + + ! We will treat the first two fragments of the list as special cases. + ! Place the first two bodies at the centers of the two fragment clouds, but be sure they are sufficiently far apart to avoid overlap + rdistance = .mag. (impactors%rc(:,2) - impactors%rc(:,1)) - sum(fragments%radius(1:2)) + rdistance = min(0.5_DP*rdistance, 1e-6_DP*impactors%radius(2)) + + fragment_cloud_radius(:) = impactors%radius(:) + + loverlap(:) = .true. + do loop = 1, MAXLOOP + if (.not.any(loverlap(:))) exit + fragment_cloud_center(:,1) = impactors%rc(:,1) + rdistance * impactors%bounce_unit(:) + fragment_cloud_center(:,2) = impactors%rc(:,2) - rdistance * impactors%bounce_unit(:) + do concurrent(i = 1:nfrag, loverlap(i)) + if (i < 3) then + fragments%rc(:,i) = fragment_cloud_center(:,i) + else + ! Make a random cloud + call random_number(fragments%rc(:,i)) + + ! Make the fragment cloud symmertic about 0 + fragments%rc(:,i) = 2 *(fragments%rc(:,i) - 0.5_DP) + + j = fragments%origin_body(i) + + ! Scale the cloud size + fragments%rc(:,i) = fragment_cloud_radius(j) * fragments%rc(:,i) + + ! Shift to the cloud center coordinates + fragments%rc(:,i) = fragments%rc(:,i) + fragment_cloud_center(:,j) + end if end do - allocate(v_t_initial, source=fragments%v_t_mag) - do while(tol < TOL_MIN) - - ! ! Find the local kinetic energy minimum for the system that conserves linear and angular momentum - objective_function = lambda_obj(tangential_objective_function, lfailure) - fval = tangential_objective_function(v_t_output(:), lfailure) - - call minimize_bfgs(objective_function, nfrag-6, v_t_initial(7:nfrag), tol, MAXLOOP, lfailure, v_t_output) - fval = tangential_objective_function(v_t_initial(:), lfailure) - fragments%v_t_mag(7:nfrag) = v_t_output(:) - ! Now that the KE-minimized values of the i>6 fragments are found, calculate the momentum-conserving solution for tangential velociteis - v_t_initial(7:nfrag) = fragments%v_t_mag(7:nfrag) - - fragments%v_t_mag(1:nfrag) = solve_fragment_tan_vel(v_t_mag_input=v_t_initial(7:nfrag), lfailure=lfailure) - - ! Perform one final shift of the radial velocity vectors to align with the center of mass of the collisional system (the origin) - fragments%vb(:,1:nfrag) = fraggle_util_vmag_to_vb(fragments%v_r_mag(1:nfrag), fragments%r_unit(:,1:nfrag), fragments%v_t_mag(1:nfrag), & - fragments%t_unit(:,1:nfrag), fragments%mass(1:nfrag), impactors%vbcom(:)) - do concurrent (i = 1:nfrag) - fragments%vc(:,i) = fragments%vb(:,i) - impactors%vbcom(:) - end do - ! Now do a kinetic energy budget check to make sure we are still within the budget. - kefrag = 0.0_DP - do concurrent(i = 1:nfrag) - kefrag(i) = fragments%mass(i) * dot_product(fragments%vc(:,i), fragments%vc(:,i)) + ! Check for any overlapping bodies. + loverlap(:) = .false. + do j = 1, nfrag + do i = j + 1, nfrag + dis = .mag.(fragments%rc(:,j) - fragments%rc(:,i)) + loverlap(i) = loverlap(i) .or. (dis <= (fragments%radius(i) + fragments%radius(j))) end do - fragments%ke_orbit = 0.5_DP * sum(kefrag(:)) - - ! If we are over the energy budget, flag this as a failure so we can try again - call fragments%get_angular_momentum() - lfailure = ((fragments%ke_budget - fragments%ke_spin - fragments%ke_orbit) < 0.0_DP) - if (.not.lfailure) exit - tol = tol * 2_DP ! Keep increasing the tolerance until we converge on a solution - ! Reduce fragment spins to try to get a better solution - fragments%rot(:,2:nfrag) = fragments%rot(:,2:nfrag) * 0.9_DP end do - if (lfailure) then - call swiftest_io_log_one_message(COLLISION_LOG_OUT, " ") - call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Tangential velocity failure diagnostics") - call fragments%get_angular_momentum() - L_frag_tot = fragments%Lspin(:) + fragments%Lorbit(:) - write(message, *) .mag.(L_frag_tot(:)) / (.mag.fragments%L_budget(:)) - call swiftest_io_log_one_message(COLLISION_LOG_OUT, "|L_remainder| : " // trim(adjustl(message))) - write(message, *) fragments%ke_budget - call swiftest_io_log_one_message(COLLISION_LOG_OUT, "ke_budget : " // trim(adjustl(message))) - write(message, *) fragments%ke_spin - call swiftest_io_log_one_message(COLLISION_LOG_OUT, "ke_spin : " // trim(adjustl(message))) - write(message, *) fragments%ke_orbit - call swiftest_io_log_one_message(COLLISION_LOG_OUT, "ke_tangential : " // trim(adjustl(message))) - write(message, *) fragments%ke_budget - fragments%ke_spin - fragments%ke_orbit - call swiftest_io_log_one_message(COLLISION_LOG_OUT, "ke_radial : " // trim(adjustl(message))) - end if - end select + rdistance = rdistance * fail_scale + fragment_cloud_radius(:) = fragment_cloud_radius(:) * fail_scale + end do + + call collision_util_shift_vector_to_origin(fragments%mass, fragments%rc) + call collider%set_coordinate_system() + + do concurrent(i = 1:nfrag) + fragments%rb(:,i) = fragments%rc(:,i) + impactors%rbcom(:) + end do + + impactors%rbcom(:) = 0.0_DP + do concurrent(i = 1:nfrag) + impactors%rbcom(:) = impactors%rbcom(:) + fragments%mass(i) * fragments%rb(:,i) + end do + impactors%rbcom(:) = impactors%rbcom(:) / fragments%mtot end associate return + end subroutine fraggle_generate_pos_vec - contains - function solve_fragment_tan_vel(lfailure, v_t_mag_input) result(v_t_mag_output) - !! Author: Jennifer L.L. Pouplin, Carlisle A. Wishard, and David A. Minton - !! - !! Adjusts the positions, velocities, and spins of a collection of fragments such that they conserve angular momentum - implicit none - ! Arguments - logical, intent(out) :: lfailure !! Error flag - real(DP), dimension(:), optional, intent(in) :: v_t_mag_input !! Unknown tangential velocities for fragments 7:nfrag - ! Internals - integer(I4B) :: i - ! Result - real(DP), dimension(:), allocatable :: v_t_mag_output - - real(DP), dimension(2 * NDIM, 2 * NDIM) :: A ! LHS of linear equation used to solve for momentum constraint in Gauss elimination code - real(DP), dimension(2 * NDIM) :: b ! RHS of linear equation used to solve for momentum constraint in Gauss elimination code - real(DP), dimension(NDIM) :: L_lin_others, L_orb_others, L, vtmp - - associate(impactors => collider%impactors, nfrag => collider%fragments%nbody) - select type(fragments => collider%fragments) - class is (fraggle_fragments(*)) - lfailure = .false. - ! We have 6 constraint equations (2 vector constraints in 3 dimensions each) - ! The first 3 are that the linear momentum of the fragments is zero with respect to the collisional barycenter - ! The second 3 are that the sum of the angular momentum of the fragments is conserved from the pre-impact state - L_lin_others(:) = 0.0_DP - L_orb_others(:) = 0.0_DP - do i = 1, nfrag - if (i <= 2 * NDIM) then ! The tangential velocities of the first set of bodies will be the unknowns we will solve for to satisfy the constraints - A(1:3, i) = fragments%mass(i) * fragments%t_unit(:, i) - A(4:6, i) = fragments%mass(i) * fragments%rmag(i) * (fragments%r_unit(:, i) .cross. fragments%t_unit(:, i)) - else if (present(v_t_mag_input)) then - vtmp(:) = v_t_mag_input(i - 6) * fragments%t_unit(:, i) - L_lin_others(:) = L_lin_others(:) + fragments%mass(i) * vtmp(:) - L(:) = fragments%mass(i) * (fragments%rc(:, i) .cross. vtmp(:)) - L_orb_others(:) = L_orb_others(:) + L(:) - end if - end do - b(1:3) = -L_lin_others(:) - b(4:6) = fragments%L_budget(:) - fragments%Lspin(:) - L_orb_others(:) - allocate(v_t_mag_output(nfrag)) - v_t_mag_output(1:6) = solve_linear_system(A, b, 6, lfailure) - if (present(v_t_mag_input)) v_t_mag_output(7:nfrag) = v_t_mag_input(:) - end select - end associate - return - end function solve_fragment_tan_vel - - - function tangential_objective_function(v_t_mag_input, lfailure) result(fval) - !! Author: David A. Minton - !! - !! Objective function for evaluating how close our fragment velocities get to minimizing KE error from our required value - implicit none - ! Arguments - real(DP), dimension(:), intent(in) :: v_t_mag_input !! Unknown tangential component of velocity vector set previously by angular momentum constraint - logical, intent(out) :: lfailure !! Error flag - ! Result - real(DP) :: fval - ! Internals - integer(I4B) :: i - real(DP), dimension(NDIM,collider%fragments%nbody) :: vc, vb - real(DP), dimension(collider%fragments%nbody) :: v_t_new, kearr - real(DP) :: keo - real(DP), save :: fval_scale = 1.0_DP - - associate(impactors => collider%impactors, nfrag => collider%fragments%nbody) - select type(fragments => collider%fragments) - class is (fraggle_fragments(*)) - lfailure = .false. - - v_t_new(:) = solve_fragment_tan_vel(v_t_mag_input=v_t_mag_input(:), lfailure=lfailure) - vb(:,1:nfrag) = fraggle_util_vmag_to_vb(fragments%v_r_mag(1:nfrag), fragments%r_unit(:,1:nfrag), v_t_new(1:nfrag), & - fragments%t_unit(:,1:nfrag), fragments%mass(1:nfrag), impactors%vbcom(:)) - do concurrent (i = 1:nfrag) - vc(:,i) = vb(:,i) - impactors%vbcom(:) - end do - kearr = 0.0_DP - do concurrent(i = 1:nfrag) - kearr(i) = fragments%mass(i) * dot_product(vc(:,i), vc(:,i)) - end do - keo = 0.5_DP * sum(kearr(:)) - fval = keo - if (lfirst_func) then - fval_scale = keo - lfirst_func = .false. - end if - fval = keo / fval_scale - lfailure = .false. - end select - end associate - return - end function tangential_objective_function + module subroutine fraggle_generate_rot_vec(collider) + !! Author: Jennifer L.L. Pouplin, Carlisle A. Wishard, and David A. Minton + !! + !! Calculates the spins of a collection of fragments such that they conserve angular momentum + implicit none + ! Arguments + class(collision_fraggle), intent(inout) :: collider !! Fraggle collision system object + ! Internals + real(DP), dimension(NDIM) :: Lbefore, Lafter, Lspin, rotdir + real(DP) :: v_init, v_final, mass_init, mass_final, rotmag + integer(I4B) :: i + + associate(fragments => collider%fragments, impactors => collider%impactors, nfrag => collider%fragments%nbody) + + ! Torque the first body based on the change in angular momentum betwen the pre- and post-impact system assuming a simple bounce + mass_init = impactors%mass(2) + mass_final = sum(fragments%mass(2:nfrag)) + v_init = .mag.(impactors%vb(:,2) - impactors%vb(:,1)) + v_final = sqrt(mass_init / mass_final * v_init**2 - 2 * impactors%Qloss / mass_final) + + Lbefore(:) = mass_init * (impactors%rb(:,2) - impactors%rb(:,1)) .cross. (impactors%vb(:,2) - impactors%vb(:,1)) + + Lafter(:) = mass_final * (impactors%rb(:,2) - impactors%rb(:,1)) .cross. (v_final * impactors%bounce_unit(:)) + Lspin(:) = impactors%Lspin(:,1) + (Lbefore(:) - Lafter(:)) + fragments%rot(:,1) = Lspin(:) / (fragments%mass(1) * fragments%radius(1)**2 * fragments%Ip(3,1)) + + ! Add in some random spin noise. The magnitude will be scaled by the before-after amount and the direction will be random + do concurrent(i = 2:nfrag) + call random_number(rotdir) + rotdir = rotdir - 0.5_DP + rotdir = .unit. rotdir + call random_number(rotmag) + rotmag = rotmag * .mag. (Lbefore(:) - Lafter(:)) / ((nfrag - 1) * fragments%mass(i) * fragments%radius(i)**2 * fragments%Ip(3,i)) + fragments%rot(:,i) = rotmag * rotdir + end do - end subroutine fraggle_generate_tan_vel + end associate + return + end subroutine fraggle_generate_rot_vec - subroutine fraggle_generate_rad_vel(collider, lfailure) - !! Author: Jennifer L.L. Pouplin, Carlisle A. Wishard, and David A. Minton + + module subroutine fraggle_generate_vel_vec(collider) + !! Author: David A. Minton !! - !! - !! Adjust the fragment velocities to set the fragment orbital kinetic energy. This will minimize the difference between the fragment kinetic energy and the energy budget + !! Generates an initial velocity distribution. For disruptions, the velocity magnitude is set to be + !! 2x the escape velocity of the colliding pair. For hit and runs the velocity magnitude is set to be + !! 2x the escape velocity of the smallest of the two bodies. implicit none ! Arguments class(collision_fraggle), intent(inout) :: collider !! Fraggle collision system object - logical, intent(out) :: lfailure !! Logical flag indicating whether this step fails or succeeds! ! Internals - real(DP), parameter :: TOL_MIN = FRAGGLE_ETOL ! This needs to be more accurate than the tangential step, as we are trying to minimize the total residual energy - real(DP), parameter :: TOL_INIT = 1e-14_DP - real(DP), parameter :: VNOISE_MAG = 1e-10_DP !! Magnitude of the noise to apply to initial conditions to help minimizer find a solution in case of failure - integer(I4B), parameter :: MAXLOOP = 100 - real(DP) :: ke_radial, tol, fval - integer(I4B) :: i - real(DP), dimension(:), allocatable :: v_r_initial - real(DP), dimension(collider%fragments%nbody) :: vnoise - type(lambda_obj) :: objective_function - character(len=STRMAX) :: message - real(DP), dimension(:), allocatable :: v_r_output - - associate(impactors => collider%impactors, nfrag => collider%fragments%nbody) - select type(fragments => collider%fragments) - class is (fraggle_fragments(*)) - ! Set the "target" ke for the radial component - ke_radial = fragments%ke_budget - fragments%ke_spin - fragments%ke_orbit - - do i = 1, nfrag - fragments%v_t_mag(i) = dot_product(fragments%vc(:,i), fragments%t_unit(:,i)) - fragments%v_r_mag(i) = dot_product(fragments%vc(:,i), fragments%r_unit(:,i)) - end do - - allocate(v_r_initial, source=fragments%v_r_mag) - - ! Initialize the lambda function using a structure constructor that calls the init method - ! Minimize the ke objective function using the BFGS optimizer - objective_function = lambda_obj(radial_objective_function) - tol = TOL_INIT - do while(tol < TOL_MIN) - fval = radial_objective_function(v_r_initial) - call minimize_bfgs(objective_function, nfrag, v_r_initial, tol, MAXLOOP, lfailure, v_r_output) - fragments%v_r_mag = v_r_output - if (.not.lfailure) exit - tol = tol * 2 ! Keep increasing the tolerance until we converge on a solution - v_r_initial(:) = fragments%v_r_mag(:) - call random_number(vnoise(1:nfrag)) ! Adding a bit of noise to the initial conditions helps it find a solution more often - vnoise(:) = 1.0_DP + VNOISE_MAG * (2 * vnoise(:) - 1._DP) - v_r_initial(:) = v_r_initial(:) * vnoise(:) - end do - - ! Shift the radial velocity vectors to align with the center of mass of the collisional system (the origin) - fragments%ke_orbit = 0.0_DP - fragments%vb(:,1:nfrag) = fraggle_util_vmag_to_vb(fragments%v_r_mag(1:nfrag), fragments%r_unit(:,1:nfrag), & - fragments%v_t_mag(1:nfrag), fragments%t_unit(:,1:nfrag), fragments%mass(1:nfrag), impactors%vbcom(:)) - do i = 1, nfrag - fragments%vc(:, i) = fragments%vb(:, i) - impactors%vbcom(:) - fragments%ke_orbit = fragments%ke_orbit + fragments%mass(i) * dot_product(fragments%vc(:, i), fragments%vc(:, i)) - end do - fragments%ke_orbit = 0.5_DP * fragments%ke_orbit - - lfailure = abs((fragments%ke_budget - (fragments%ke_orbit + fragments%ke_spin)) / fragments%ke_budget) > FRAGGLE_ETOL - if (lfailure) then - call swiftest_io_log_one_message(COLLISION_LOG_OUT, " ") - call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Radial velocity failure diagnostics") - write(message, *) fragments%ke_budget - call swiftest_io_log_one_message(COLLISION_LOG_OUT, "ke_budget : " // trim(adjustl(message))) - write(message, *) fragments%ke_spin - call swiftest_io_log_one_message(COLLISION_LOG_OUT, "ke_spin : " // trim(adjustl(message))) - write(message, *) fragments%ke_orbit - call swiftest_io_log_one_message(COLLISION_LOG_OUT, "ke_orbit : " // trim(adjustl(message))) - write(message, *) fragments%ke_budget - (fragments%ke_orbit + fragments%ke_spin) - call swiftest_io_log_one_message(COLLISION_LOG_OUT, "ke_remainder : " // trim(adjustl(message))) + integer(I4B) :: i,j, loop, istart + logical :: lhitandrun, lnoncat + real(DP), dimension(NDIM) :: vimp_unit, rimp, vrot, Lresidual + real(DP) :: vmag, vesc, rotmag, ke_residual, ke_per_dof + integer(I4B), dimension(collider%fragments%nbody) :: vsign + real(DP), dimension(collider%fragments%nbody) :: vscale, mass_vscale, ke_avail + integer(I4B), parameter :: MAXLOOP = 100 + + associate(fragments => collider%fragments, impactors => collider%impactors, nfrag => collider%fragments%nbody) + lhitandrun = (impactors%regime == COLLRESOLVE_REGIME_HIT_AND_RUN) + lnoncat = (impactors%regime /= COLLRESOLVE_REGIME_SUPERCATASTROPHIC) ! For non-catastrophic impacts, make the fragments act like ejecta and point away from the impact point + + ! The fragments will be divided into two "clouds" based on identified origin body. + ! These clouds will collectively travel like two impactors bouncing off of each other. + where(fragments%origin_body(:) == 1) + vsign(:) = -1 + elsewhere + vsign(:) = 1 + end where + + ! The minimum fragment velocity will be set by the escape velocity + if (lhitandrun) then + vesc = sqrt(2 * impactors%Gmass(2) / impactors%radius(2)) + else + vesc = sqrt(2 * sum(impactors%Gmass(:)) / sum(impactors%radius(:))) + end if + + ! Scale the magnitude of the velocity by the distance from the impact point + ! This will reduce the chances of fragments colliding with each other immediately, and is more physically correct + do concurrent(i = 1:nfrag) + rimp(:) = fragments%rc(:,i) - impactors%rbimp(:) + vscale(i) = .mag. rimp(:) / (.mag. (impactors%rb(:,2) - impactors%rb(:,1))) + end do + vscale(:) = vscale(:)/minval(vscale(:)) + + ! Give the fragment velocities a random value that is scaled with fragment mass + call random_number(mass_vscale) + mass_vscale(:) = (mass_vscale(:) + 1.0_DP) / 2 + mass_vscale(:) = mass_vscale(:) * (fragments%mtot / fragments%mass(:))**(0.125_DP) ! The 1/8 power is arbitrary. It just gives the velocity a small mass dependence + mass_vscale(:) = mass_vscale(:) / minval(mass_vscale(:)) + + ! Set the velocities of all fragments using all of the scale factors determined above + do concurrent(i = 1:nfrag) + j = fragments%origin_body(i) + vrot(:) = impactors%rot(:,j) .cross. (fragments%rc(:,i) - impactors%rc(:,j)) + if (lhitandrun) then + if (i == 1) then + fragments%vc(:,1) = impactors%vc(:,1) + else + vmag = .mag.impactors%vc(:,2) / (maxval(mass_vscale(:) * maxval(vscale(:)))) + fragments%vc(:,i) = vmag * mass_vscale(i) * vscale(i) * impactors%bounce_unit(:) * vsign(i) + vrot(:) + end if + else + ! Add more velocity dispersion to disruptions vs hit and runs. + vmag = vesc * vscale(i) * mass_vscale(i) + rimp(:) = fragments%rc(:,i) - impactors%rbimp(:) + vimp_unit(:) = .unit. rimp(:) + fragments%vc(:,i) = vmag * (impactors%bounce_unit(:) + vimp_unit(:)) * vsign(i) + vrot(:) end if - end select + end do + + if (lhitandrun) then + istart = 2 + else + istart = 1 + end if + do loop = 1, MAXLOOP + call collider%set_coordinate_system() + call fragments%get_kinetic_energy() + ke_residual = fragments%ke_budget - (fragments%ke_orbit + fragments%ke_spin) + ! Make sure we don't take away too much orbital kinetic energy, otherwise the fragment can't escape + ke_avail(:) = fragments%ke_orbit_frag(:) - impactors%Gmass(1)*impactors%mass(2)/fragments%vmag(:) + ke_per_dof = -ke_residual/(nfrag - istart + 1) + do concurrent(i = istart:nfrag, ke_avail(i) > ke_per_dof) + fragments%vmag(i) = sqrt(2 * (fragments%ke_orbit_frag(i) - ke_per_dof)/fragments%mass(i)) + fragments%vc(:,i) = fragments%vmag(i) * fragments%v_unit(:,i) + end do + call fragments%get_kinetic_energy() + ke_residual = fragments%ke_budget - (fragments%ke_orbit + fragments%ke_spin) + + ! Check for any residual angular momentum, and if there is any, put it into spin of the biggest body + call collider%set_coordinate_system() + call fragments%get_angular_momentum() + Lresidual(:) = fragments%L_budget(:) - (fragments%Lorbit(:) + fragments%Lspin(:)) + rotmag = .mag. fragments%rot(:,1) + fragments%rot(:,1) = fragments%rot(:,1) + Lresidual(:) / (fragments%mass(1) * fragments%radius(1)**2 * fragments%Ip(:,1)) + rotmag = .mag. fragments%rot(:,1) + + if (ke_residual >= 0.0_DP) exit + + end do + + do concurrent(i = 1:nfrag) + fragments%vb(:,i) = fragments%vc(:,i) + impactors%vbcom(:) + end do + + impactors%vbcom(:) = 0.0_DP + do concurrent(i = 1:nfrag) + impactors%vbcom(:) = impactors%vbcom(:) + fragments%mass(i) * fragments%vb(:,i) + end do + impactors%vbcom(:) = impactors%vbcom(:) / fragments%mtot + end associate return + end subroutine fraggle_generate_vel_vec - contains - function radial_objective_function(v_r_mag_input) result(fval) - !! Author: David A. Minton - !! - !! Objective function for evaluating how close our fragment velocities get to minimizing KE error from our required value - implicit none - ! Arguments - real(DP), dimension(:), intent(in) :: v_r_mag_input !! Unknown radial component of fragment velocity vector - ! Result - real(DP) :: fval !! The objective function result, which is the square of the difference between the calculated fragment kinetic energy and our target - !! Minimizing this brings us closer to our objective - ! Internals - integer(I4B) :: i - real(DP), dimension(:,:), allocatable :: v_shift - real(DP), dimension(collider%fragments%nbody) :: kearr - real(DP) :: keo, ke_radial, rotmag2, vmag2 - - associate(impactors => collider%impactors, nfrag => collider%fragments%nbody) - select type(fragments => collider%fragments) - class is (fraggle_fragments(*)) - allocate(v_shift, mold=fragments%vb) - v_shift(:,:) = fraggle_util_vmag_to_vb(v_r_mag_input, fragments%r_unit, fragments%v_t_mag, fragments%t_unit, fragments%mass, impactors%vbcom) - do i = 1,fragments%nbody - v_shift(:,i) = v_shift(:,i) - impactors%vbcom(:) - rotmag2 = fragments%rot(1,i)**2 + fragments%rot(2,i)**2 + fragments%rot(3,i)**2 - vmag2 = v_shift(1,i)**2 + v_shift(2,i)**2 + v_shift(3,i)**2 - kearr(i) = fragments%mass(i) * (fragments%Ip(3, i) * fragments%radius(i)**2 * rotmag2 + vmag2) - end do - keo = 2 * fragments%ke_budget - sum(kearr(:)) - ke_radial = fragments%ke_budget - fragments%ke_orbit - fragments%ke_spin - ! The following ensures that fval = 0 is a local minimum, which is what the BFGS method is searching for - fval = (keo / (2 * ke_radial))**2 - end select - end associate - - return - end function radial_objective_function - - end subroutine fraggle_generate_rad_vel end submodule s_fraggle_generate diff --git a/src/fraggle/fraggle_module.f90 b/src/fraggle/fraggle_module.f90 index 2c5ee9672..130b3af5c 100644 --- a/src/fraggle/fraggle_module.f90 +++ b/src/fraggle/fraggle_module.f90 @@ -17,9 +17,6 @@ module fraggle !> Class definition for the variables that describe a collection of fragments by Fraggle barycentric coordinates type, extends(collision_fragments) :: fraggle_fragments - real(DP), dimension(nbody) :: v_r_mag !! Array of radial direction velocity magnitudes of individual fragments - real(DP), dimension(nbody) :: v_t_mag !! Array of tangential direction velocity magnitudes of individual fragments - real(DP), dimension(nbody) :: v_n_mag !! Array of normal direction velocity magnitudes of individual fragments contains procedure :: reset => fraggle_util_reset_fragments !! Resets all position and velocity-dependent fragment quantities in order to do a fresh calculation (does not reset mass, radius, or other values that get set prior to the call to fraggle_generate) @@ -27,7 +24,7 @@ module fraggle end type fraggle_fragments - type, extends(collision_disruption) :: collision_fraggle + type, extends(collision_basic) :: collision_fraggle ! Scale factors used to scale dimensioned quantities to a more "natural" system where important quantities (like kinetic energy, momentum) are of order ~1 real(DP) :: dscale = 1.0_DP !! Distance dimension scale factor real(DP) :: mscale = 1.0_DP !! Mass scale factor @@ -37,16 +34,27 @@ module fraggle real(DP) :: Lscale = 1.0_DP !! Angular momentum scale factor (a convenience unit that is derived from dscale, tscale, and mscale) contains procedure :: disrupt => fraggle_generate_disrupt !! Generates a system of fragments in barycentric coordinates that conserves energy and momentum. + procedure :: generate => fraggle_generate !! A simple disruption models that does not constrain energy loss in collisions + procedure :: hitandrun => fraggle_generate_hitandrun + procedure :: set_mass_dist => fraggle_util_set_mass_dist !! Sets the distribution of mass among the fragments depending on the regime type procedure :: set_natural_scale => fraggle_util_set_natural_scale_factors !! Scales dimenional quantities to ~O(1) with respect to the collisional system. procedure :: set_original_scale => fraggle_util_set_original_scale_factors !! Restores dimenional quantities back to the original system units procedure :: setup_fragments => fraggle_util_setup_fragments_system !! Initializer for the fragments of the collision system. - procedure :: construct_temporary_system => fraggle_util_construct_temporary_system !! Constructs temporary n-body system in order to compute pre- and post-impact energy and momentum procedure :: reset => fraggle_util_reset_system !! Deallocates all allocatables final :: fraggle_final_system !! Finalizer will deallocate all allocatables end type collision_fraggle - interface + + + module subroutine fraggle_generate(self, nbody_system, param, t) + implicit none + class(collision_fraggle), intent(inout) :: self !! Fraggle fragment system object + class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object + class(base_parameters), intent(inout) :: param !! Current run configuration parameters + real(DP), intent(in) :: t !! The time of the collision + end subroutine fraggle_generate + module subroutine fraggle_generate_disrupt(self, nbody_system, param, t, lfailure) implicit none class(collision_fraggle), intent(inout) :: self !! Fraggle system object the outputs will be the fragmentation @@ -56,21 +64,35 @@ module subroutine fraggle_generate_disrupt(self, nbody_system, param, t, lfailur logical, optional, intent(out) :: lfailure !! Answers the question: Should this have been a merger instead? end subroutine fraggle_generate_disrupt + module subroutine fraggle_generate_hitandrun(self, nbody_system, param, t) + implicit none + class(collision_fraggle), intent(inout) :: self !! Collision system object + class(base_nbody_system), intent(inout) :: nbody_system !! Swiftest nbody system object + class(base_parameters), intent(inout) :: param !! Current run configuration parameters with SyMBA additions + real(DP), intent(in) :: t !! Time of collision + end subroutine fraggle_generate_hitandrun + + module subroutine fraggle_generate_pos_vec(collider) + implicit none + class(collision_fraggle), intent(inout) :: collider !! Fraggle ollision system object + end subroutine fraggle_generate_pos_vec + + module subroutine fraggle_generate_rot_vec(collider) + implicit none + class(collision_fraggle), intent(inout) :: collider !! Collision system object + end subroutine fraggle_generate_rot_vec + + module subroutine fraggle_generate_vel_vec(collider) + implicit none + class(collision_fraggle), intent(inout) :: collider !! Collision system object + end subroutine fraggle_generate_vel_vec + module subroutine fraggle_util_setup_fragments_system(self, nfrag) implicit none class(collision_fraggle), intent(inout) :: self !! Encounter collision system object integer(I4B), intent(in) :: nfrag !! Number of fragments to create end subroutine fraggle_util_setup_fragments_system - module subroutine fraggle_util_construct_temporary_system(self, nbody_system, param, tmpsys, tmpparam) - implicit none - class(collision_fraggle), intent(inout) :: self !! Fraggle collision system object - class(base_nbody_system), intent(in) :: nbody_system !! Original swiftest nbody system object - class(base_parameters), intent(in) :: param !! Current swiftest run configuration parameters - class(base_nbody_system), allocatable, intent(out) :: tmpsys !! Output temporary swiftest nbody system object - class(base_parameters), allocatable, intent(out) :: tmpparam !! Output temporary configuration run parameters - end subroutine fraggle_util_construct_temporary_system - module subroutine fraggle_util_reset_fragments(self) implicit none class(fraggle_fragments(*)), intent(inout) :: self @@ -81,6 +103,12 @@ module subroutine fraggle_util_reset_system(self) class(collision_fraggle), intent(inout) :: self !! Collision system object end subroutine fraggle_util_reset_system + module subroutine fraggle_util_set_mass_dist(self, param) + implicit none + class(collision_fraggle), intent(inout) :: self !! Fraggle collision object + class(base_parameters), intent(in) :: param !! Current Swiftest run configuration parameters + end subroutine fraggle_util_set_mass_dist + module subroutine fraggle_util_set_natural_scale_factors(self) implicit none class(collision_fraggle), intent(inout) :: self !! Fraggle collision system object @@ -91,15 +119,6 @@ module subroutine fraggle_util_set_original_scale_factors(self) class(collision_fraggle), intent(inout) :: self !! Fraggle collision system object end subroutine fraggle_util_set_original_scale_factors - module function fraggle_util_vmag_to_vb(v_r_mag, r_unit, v_t_mag, t_unit, m_frag, vcom) result(vb) - implicit none - real(DP), dimension(:), intent(in) :: v_r_mag !! Unknown radial component of fragment velocity vector - real(DP), dimension(:), intent(in) :: v_t_mag !! Tangential component of velocity vector set previously by angular momentum constraint - real(DP), dimension(:,:), intent(in) :: r_unit, t_unit !! Radial and tangential unit vectors for each fragment - real(DP), dimension(:), intent(in) :: m_frag !! Fragment masses - real(DP), dimension(:), intent(in) :: vcom !! Barycentric velocity of collisional system center of mass - real(DP), dimension(:,:), allocatable :: vb - end function fraggle_util_vmag_to_vb end interface contains diff --git a/src/fraggle/fraggle_util.f90 b/src/fraggle/fraggle_util.f90 index cff4fd832..e5cdaa20d 100644 --- a/src/fraggle/fraggle_util.f90 +++ b/src/fraggle/fraggle_util.f90 @@ -11,32 +11,6 @@ use swiftest contains - module subroutine fraggle_util_construct_temporary_system(self, nbody_system, param, tmpsys, tmpparam) - !! Author: David A. Minton - !! - !! Constructs a temporary internal system consisting of active bodies and additional fragments. This internal temporary system is used to calculate system energy with and without fragments - implicit none - ! Arguments - class(collision_fraggle), intent(inout) :: self !! Fraggle collision system object - class(base_nbody_system), intent(in) :: nbody_system !! Original swiftest nbody system object - class(base_parameters), intent(in) :: param !! Current swiftest run configuration parameters - class(base_nbody_system), allocatable, intent(out) :: tmpsys !! Output temporary swiftest nbody system object - class(base_parameters), allocatable, intent(out) :: tmpparam !! Output temporary configuration run parameters - - call collision_util_construct_temporary_system(self, nbody_system, param, tmpsys, tmpparam) - - select type(tmpsys) - class is (swiftest_nbody_system) - select type(tmpparam) - class is (swiftest_parameters) - call tmpsys%rescale(tmpparam, self%mscale, self%dscale, self%tscale) - end select - end select - - return - end subroutine fraggle_util_construct_temporary_system - - module subroutine fraggle_util_reset_fragments(self) !! author: David A. Minton !! @@ -58,9 +32,6 @@ module subroutine fraggle_util_reset_fragments(self) self%rmag(:) = 0.0_DP self%rotmag(:) = 0.0_DP - self%v_r_mag(:) = 0.0_DP - self%v_t_mag(:) = 0.0_DP - self%v_n_mag(:) = 0.0_DP return end subroutine fraggle_util_reset_fragments @@ -87,6 +58,167 @@ module subroutine fraggle_util_reset_system(self) end subroutine fraggle_util_reset_system + module subroutine fraggle_util_set_mass_dist(self, param) + !! author: David A. Minton + !! + !! Sets the mass of fragments based on the mass distribution returned by the regime calculation. + !! This subroutine must be run after the the setup routine has been run on the fragments + !! + implicit none + ! Arguments + class(collision_fraggle), intent(inout) :: self !! Fraggle collision system object + class(base_parameters), intent(in) :: param !! Current Swiftest run configuration parameters + ! Internals + integer(I4B) :: i, j, jproj, jtarg, nfrag, istart + real(DP), dimension(2) :: volume + real(DP), dimension(NDIM) :: Ip_avg + real(DP) :: mfrag, mremaining, min_mfrag, mtot, mcumul + real(DP), parameter :: BETA = 2.85_DP + integer(I4B), parameter :: NFRAGMAX = 100 !! Maximum number of fragments that can be generated + integer(I4B), parameter :: NFRAGMIN = 7 !! Minimum number of fragments that can be generated (set by the fraggle_generate algorithm for constraining momentum and energy) + integer(I4B), parameter :: NFRAG_SIZE_MULTIPLIER = 3 !! Log-space scale factor that scales the number of fragments by the collisional system mass + integer(I4B), parameter :: iMlr = 1 + integer(I4B), parameter :: iMslr = 2 + integer(I4B), parameter :: iMrem = 3 + logical :: flipper + + associate(impactors => self%impactors) + ! Get mass weighted mean of Ip and density + volume(1:2) = 4._DP / 3._DP * PI * impactors%radius(1:2)**3 + mtot = sum(impactors%mass(:)) + Ip_avg(:) = (impactors%mass(1) * impactors%Ip(:,1) + impactors%mass(2) * impactors%Ip(:,2)) / mtot + + if (impactors%mass(1) > impactors%mass(2)) then + jtarg = 1 + jproj = 2 + else + jtarg = 2 + jproj = 1 + end if + + select case(impactors%regime) + case(COLLRESOLVE_REGIME_DISRUPTION, COLLRESOLVE_REGIME_SUPERCATASTROPHIC, COLLRESOLVE_REGIME_HIT_AND_RUN) + ! The first two bins of the mass_dist are the largest and second-largest fragments that came out of collision_regime. + ! The remainder from the third bin will be distributed among nfrag-2 bodies. The following code will determine nfrag based on + ! the limits bracketed above and the model size distribution of fragments. + ! Check to see if our size distribution would give us a smaller number of fragments than the maximum number + + select type(param) + class is (swiftest_parameters) + min_mfrag = (param%min_GMfrag / param%GU) + ! The number of fragments we generate is bracked by the minimum required by fraggle_generate (7) and the + ! maximum set by the NFRAG_SIZE_MULTIPLIER which limits the total number of fragments to prevent the nbody + ! code from getting an overwhelmingly large number of fragments + nfrag = ceiling(NFRAG_SIZE_MULTIPLIER * log(mtot / min_mfrag)) + nfrag = max(min(nfrag, NFRAGMAX), NFRAGMIN) + class default + min_mfrag = 0.0_DP + nfrag = NFRAGMAX + end select + + i = iMrem + mremaining = impactors%mass_dist(iMrem) + do while (i <= nfrag) + mfrag = (1 + i - iMslr)**(-3._DP / BETA) * impactors%mass_dist(iMslr) + if (mremaining - mfrag < 0.0_DP) exit + mremaining = mremaining - mfrag + i = i + 1 + end do + if (i < nfrag) nfrag = max(i, NFRAGMIN) ! The sfd would actually give us fewer fragments than our maximum + call self%setup_fragments(nfrag) + + case (COLLRESOLVE_REGIME_MERGE, COLLRESOLVE_REGIME_GRAZE_AND_MERGE) + + call self%setup_fragments(1) + select type(fragments => self%fragments) + class is (collision_fragments(*)) + fragments%mass(1) = impactors%mass_dist(1) + fragments%radius(1) = impactors%radius(jtarg) + fragments%density(1) = impactors%mass_dist(1) / volume(jtarg) + if (param%lrotation) fragments%Ip(:, 1) = impactors%Ip(:,1) + end select + return + case default + write(*,*) "collision_util_set_mass_dist_fragments error: Unrecognized regime code",impactors%regime + end select + + select type(fragments => self%fragments) + class is (collision_fragments(*)) + fragments%mtot = mtot + + ! Make the first two bins the same as the Mlr and Mslr values that came from collision_regime + fragments%mass(1) = impactors%mass_dist(iMlr) + fragments%mass(2) = impactors%mass_dist(iMslr) + + ! Distribute the remaining mass the 3:nfrag bodies following the model SFD given by slope BETA + mremaining = impactors%mass_dist(iMrem) + do i = iMrem, nfrag + mfrag = (1 + i - iMslr)**(-3._DP / BETA) * impactors%mass_dist(iMslr) + fragments%mass(i) = mfrag + mremaining = mremaining - mfrag + end do + + ! If there is any residual mass (either positive or negative) we will distribute remaining mass proportionally among the the fragments + if (mremaining < 0.0_DP) then ! If the remainder is negative, this means that that the number of fragments required by the SFD is smaller than our lower limit set by fraggle_generate. + istart = iMrem ! We will reduce the mass of the 3:nfrag bodies to prevent the second-largest fragment from going smaller + else ! If the remainder is postiive, this means that the number of fragments required by the SFD is larger than our upper limit set by computational expediency. + istart = iMslr ! We will increase the mass of the 2:nfrag bodies to compensate, which ensures that the second largest fragment remains the second largest + end if + mfrag = 1._DP + mremaining / sum(fragments%mass(istart:nfrag)) + fragments%mass(istart:nfrag) = fragments%mass(istart:nfrag) * mfrag + + ! There may still be some small residual due to round-off error. If so, simply add it to the last bin of the mass distribution. + mremaining = fragments%mtot - sum(fragments%mass(1:nfrag)) + fragments%mass(nfrag) = fragments%mass(nfrag) + mremaining + + ! Compute physical properties of the new fragments + select case(impactors%regime) + case(COLLRESOLVE_REGIME_HIT_AND_RUN) ! The hit and run case always preserves the largest body intact, so there is no need to recompute the physical properties of the first fragment + fragments%radius(1) = impactors%radius(jtarg) + fragments%density(1) = impactors%mass_dist(iMlr) / volume(jtarg) + fragments%Ip(:, 1) = impactors%Ip(:,1) + istart = 2 + case default + istart = 1 + end select + + fragments%density(istart:nfrag) = fragments%mtot / sum(volume(:)) + fragments%radius(istart:nfrag) = (3 * fragments%mass(istart:nfrag) / (4 * PI * fragments%density(istart:nfrag)))**(1.0_DP / 3.0_DP) + do i = istart, nfrag + fragments%Ip(:, i) = Ip_avg(:) + end do + + ! For catastrophic impacts, we will assign each of the n>2 fragments to one of the two original bodies so that the fragment cloud occupies + ! roughly the same space as both original bodies. For all other disruption cases, we use body 2 as the center of the cloud. + fragments%origin_body(1) = 1 + fragments%origin_body(2) = 2 + if (impactors%regime == COLLRESOLVE_REGIME_SUPERCATASTROPHIC) then + mcumul = fragments%mass(1) + flipper = .true. + j = 2 + do i = 1, nfrag + if (flipper .and. (mcumul < impactors%mass(1))) then + flipper = .false. + j = 1 + else + j = 2 + flipper = .true. + end if + fragments%origin_body(i) = j + end do + else + fragments%origin_body(3:nfrag) = 2 + end if + + end select + + + end associate + + return + end subroutine fraggle_util_set_mass_dist + + module subroutine fraggle_util_set_natural_scale_factors(self) !! author: David A. Minton !! @@ -226,37 +358,4 @@ module subroutine fraggle_util_setup_fragments_system(self, nfrag) end subroutine fraggle_util_setup_fragments_system - module function fraggle_util_vmag_to_vb(v_r_mag, r_unit, v_t_mag, t_unit, m_frag, vcom) result(vb) - !! Author: David A. Minton - !! - !! Converts radial and tangential velocity magnitudes into barycentric velocity - implicit none - ! Arguments - real(DP), dimension(:), intent(in) :: v_r_mag !! Unknown radial component of fragment velocity vector - real(DP), dimension(:), intent(in) :: v_t_mag !! Tangential component of velocity vector set previously by angular momentum constraint - real(DP), dimension(:,:), intent(in) :: r_unit, t_unit !! Radial and tangential unit vectors for each fragment - real(DP), dimension(:), intent(in) :: m_frag !! Fragment masses - real(DP), dimension(:), intent(in) :: vcom !! Barycentric velocity of collisional system center of mass - ! Result - real(DP), dimension(:,:), allocatable :: vb - ! Internals - integer(I4B) :: i, nfrag - - allocate(vb, mold=r_unit) - ! Make sure the velocity magnitude stays positive - nfrag = size(m_frag) - do i = 1, nfrag - vb(:,i) = abs(v_r_mag(i)) * r_unit(:, i) - end do - ! In order to keep satisfying the kinetic energy constraint, we must shift the origin of the radial component of the velocities to the center of mass - call collision_util_shift_vector_to_origin(m_frag, vb) - - do i = 1, nfrag - vb(:, i) = vb(:, i) + v_t_mag(i) * t_unit(:, i) + vcom(:) - end do - - return - end function fraggle_util_vmag_to_vb - - end submodule s_fraggle_util diff --git a/src/swiftest/swiftest_io.f90 b/src/swiftest/swiftest_io.f90 index 2ba53b5e5..5f1a90276 100644 --- a/src/swiftest/swiftest_io.f90 +++ b/src/swiftest/swiftest_io.f90 @@ -2086,15 +2086,14 @@ module subroutine swiftest_io_param_reader(self, unit, iotype, v_list, iostat, i if ((param%collision_model /= "MERGE") .and. & (param%collision_model /= "BOUNCE") .and. & - (param%collision_model /= "DISRUPTION") .and. & (param%collision_model /= "FRAGGLE")) then write(iomsg,*) 'Invalid collision_model parameter: ',trim(adjustl(param%out_type)) - write(iomsg,*) 'Valid options are MERGE, BOUNCE, DISRUPTION, or FRAGGLE' + write(iomsg,*) 'Valid options are MERGE, BOUNCE, or FRAGGLE' iostat = -1 return end if - if (param%collision_model == "FRAGGLE" .or. param%collision_model == "DISRUPTION") then + if (param%collision_model == "FRAGGLE" ) then if (seed_set) then call random_seed(put = param%seed) else diff --git a/src/swiftest/swiftest_util.f90 b/src/swiftest/swiftest_util.f90 index 49c2d0362..e3e0fccee 100644 --- a/src/swiftest/swiftest_util.f90 +++ b/src/swiftest/swiftest_util.f90 @@ -2642,8 +2642,6 @@ module subroutine swiftest_util_setup_construct_system(nbody_system, param) allocate(collision_basic :: nbody_system%collider) case("BOUNCE") allocate(collision_bounce :: nbody_system%collider) - case("DISRUPTION") - allocate(collision_disruption :: nbody_system%collider) case("FRAGGLE") allocate(collision_fraggle :: nbody_system%collider) end select From 44f066da70316ab605bf1ab4cf94ec4be532869e Mon Sep 17 00:00:00 2001 From: David A Minton Date: Fri, 30 Dec 2022 00:35:20 -0500 Subject: [PATCH 544/569] Renabled most of the Fraggle success criteria. I think there is an issue with the units that still needs to be resolved, because the results look weird --- src/fraggle/fraggle_generate.f90 | 23 ++++++++++------------- src/fraggle/fraggle_util.f90 | 2 ++ 2 files changed, 12 insertions(+), 13 deletions(-) diff --git a/src/fraggle/fraggle_generate.f90 b/src/fraggle/fraggle_generate.f90 index 08c184ab0..3a8e3b09e 100644 --- a/src/fraggle/fraggle_generate.f90 +++ b/src/fraggle/fraggle_generate.f90 @@ -12,7 +12,7 @@ use symba real(DP), parameter :: FRAGGLE_LTOL = 1e-4_DP !10 * epsilon(1.0_DP) - real(DP), parameter :: FRAGGLE_ETOL = 1e-1_DP + real(DP), parameter :: FRAGGLE_ETOL = 1e-12_DP contains @@ -54,11 +54,7 @@ module subroutine fraggle_generate(self, nbody_system, param, t) call util_exit(FAILURE) end select call self%set_mass_dist(param) - call self%get_energy_and_momentum(nbody_system, param, lbefore=.true.) - call self%set_budgets() - call impactors%set_coordinate_system() call self%disrupt(nbody_system, param, t) - call self%get_energy_and_momentum(nbody_system, param, lbefore=.false.) dpe = self%pe(2) - self%pe(1) nbody_system%Ecollisions = nbody_system%Ecollisions - dpe @@ -106,7 +102,7 @@ module subroutine fraggle_generate_disrupt(self, nbody_system, param, t, lfailur ! Internals integer(I4B) :: try real(DP) :: dEtot, dLmag - integer(I4B), parameter :: MAXTRY = 10 + integer(I4B), parameter :: MAXTRY = 100 logical :: lk_plpl, lfailure_local logical, dimension(size(IEEE_ALL)) :: fpe_halting_modes, fpe_quiet_modes logical, dimension(size(IEEE_USUAL)) :: fpe_flag @@ -156,23 +152,22 @@ module subroutine fraggle_generate_disrupt(self, nbody_system, param, t, lfailur ! Use the disruption collision model to generate initial conditions ! Compute the "before" energy/momentum and the budgets call self%get_energy_and_momentum(nbody_system, param, lbefore=.true.) + call self%set_budgets() call fraggle_generate_pos_vec(self) call fraggle_generate_rot_vec(self) call fraggle_generate_vel_vec(self) call self%get_energy_and_momentum(nbody_system, param, lbefore=.false.) - call self%get_energy_and_momentum(nbody_system, param, lbefore=.false.) dEtot = self%Etot(2) - self%Etot(1) dLmag = .mag. (self%Ltot(:,2) - self%Ltot(:,1)) - lfailure_local = (dEtot > 0.0_DP) + lfailure_local = (dEtot > FRAGGLE_ETOL) if (lfailure_local) then write(message, *) "dEtot: ",dEtot, "dEtot/Qloss", dEtot / impactors%Qloss call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Fraggle failed due to energy gain: " // & trim(adjustl(message))) - !cycle + cycle lfailure_local = .false. - exit end if lfailure_local = ((abs(dLmag) / (.mag.self%Ltot(:,1))) > FRAGGLE_LTOL) @@ -296,8 +291,6 @@ module subroutine fraggle_generate_hitandrun(self, nbody_system, param, t) end subroutine fraggle_generate_hitandrun - - module subroutine fraggle_generate_pos_vec(collider) !! Author: Jennifer L.L. Pouplin, Carlisle A. Wishard, and David A. Minton !! @@ -510,11 +503,15 @@ module subroutine fraggle_generate_vel_vec(collider) ke_residual = fragments%ke_budget - (fragments%ke_orbit + fragments%ke_spin) ! Make sure we don't take away too much orbital kinetic energy, otherwise the fragment can't escape ke_avail(:) = fragments%ke_orbit_frag(:) - impactors%Gmass(1)*impactors%mass(2)/fragments%vmag(:) - ke_per_dof = -ke_residual/(nfrag - istart + 1) + ke_per_dof = -ke_residual/(2 * (nfrag - istart + 1)) do concurrent(i = istart:nfrag, ke_avail(i) > ke_per_dof) fragments%vmag(i) = sqrt(2 * (fragments%ke_orbit_frag(i) - ke_per_dof)/fragments%mass(i)) fragments%vc(:,i) = fragments%vmag(i) * fragments%v_unit(:,i) end do + do concurrent(i = istart:nfrag, fragments%ke_spin_frag(i) > ke_per_dof) + fragments%rotmag(i) = sqrt(2 * (fragments%ke_spin_frag(i) - ke_per_dof)/(fragments%mass(i) * fragments%radius(i)**2 * fragments%Ip(3,i))) + fragments%rot(:,i) = fragments%rotmag(i) * .unit.fragments%rot(:,i) + end do call fragments%get_kinetic_energy() ke_residual = fragments%ke_budget - (fragments%ke_orbit + fragments%ke_spin) diff --git a/src/fraggle/fraggle_util.f90 b/src/fraggle/fraggle_util.f90 index e5cdaa20d..9e519584c 100644 --- a/src/fraggle/fraggle_util.f90 +++ b/src/fraggle/fraggle_util.f90 @@ -250,6 +250,7 @@ module subroutine fraggle_util_set_natural_scale_factors(self) impactors%rc(:,:) = impactors%rc(:,:) / collider%dscale impactors%vc(:,:) = impactors%vc(:,:) / collider%vscale impactors%mass(:) = impactors%mass(:) / collider%mscale + impactors%Gmass(:) = impactors%Gmass(:) / 0.5_DP * collider%vscale**2 * collider%dscale impactors%Mcb = impactors%Mcb / collider%mscale impactors%radius(:) = impactors%radius(:) / collider%dscale impactors%Lspin(:,:) = impactors%Lspin(:,:) / collider%Lscale @@ -293,6 +294,7 @@ module subroutine fraggle_util_set_original_scale_factors(self) impactors%bounce_unit(:) = impactors%bounce_unit(:) * collider%vscale impactors%mass = impactors%mass * collider%mscale + impactors%Gmass(:) = impactors%Gmass(:) * 0.5_DP * collider%vscale**2 * collider%dscale impactors%Mcb = impactors%Mcb * collider%mscale impactors%mass_dist = impactors%mass_dist * collider%mscale impactors%radius = impactors%radius * collider%dscale From 7b1b9cd6fa700dd7d0d5d83ece05b2a0a9a0a1fb Mon Sep 17 00:00:00 2001 From: David A Minton Date: Fri, 30 Dec 2022 00:41:05 -0500 Subject: [PATCH 545/569] Disabled the rotation change for energy conservation. Disabled the natural scale factor --- src/fraggle/fraggle_generate.f90 | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/src/fraggle/fraggle_generate.f90 b/src/fraggle/fraggle_generate.f90 index 3a8e3b09e..8c025f026 100644 --- a/src/fraggle/fraggle_generate.f90 +++ b/src/fraggle/fraggle_generate.f90 @@ -133,7 +133,7 @@ module subroutine fraggle_generate_disrupt(self, nbody_system, param, t, lfailur end if call ieee_set_flag(ieee_all, .false.) ! Set all fpe flags to quiet - call self%set_natural_scale() + !call self%set_natural_scale() call fragments%reset() @@ -157,7 +157,7 @@ module subroutine fraggle_generate_disrupt(self, nbody_system, param, t, lfailur call fraggle_generate_rot_vec(self) call fraggle_generate_vel_vec(self) call self%get_energy_and_momentum(nbody_system, param, lbefore=.false.) - + exit dEtot = self%Etot(2) - self%Etot(1) dLmag = .mag. (self%Ltot(:,2) - self%Ltot(:,1)) @@ -195,7 +195,7 @@ module subroutine fraggle_generate_disrupt(self, nbody_system, param, t, lfailur trim(adjustl(message)) // " tries") end if - call self%set_original_scale() + !call self%set_original_scale() ! Restore the big array if (lk_plpl) call pl%flatten(param) @@ -503,15 +503,15 @@ module subroutine fraggle_generate_vel_vec(collider) ke_residual = fragments%ke_budget - (fragments%ke_orbit + fragments%ke_spin) ! Make sure we don't take away too much orbital kinetic energy, otherwise the fragment can't escape ke_avail(:) = fragments%ke_orbit_frag(:) - impactors%Gmass(1)*impactors%mass(2)/fragments%vmag(:) - ke_per_dof = -ke_residual/(2 * (nfrag - istart + 1)) + ke_per_dof = -ke_residual/((nfrag - istart + 1)) do concurrent(i = istart:nfrag, ke_avail(i) > ke_per_dof) fragments%vmag(i) = sqrt(2 * (fragments%ke_orbit_frag(i) - ke_per_dof)/fragments%mass(i)) fragments%vc(:,i) = fragments%vmag(i) * fragments%v_unit(:,i) end do - do concurrent(i = istart:nfrag, fragments%ke_spin_frag(i) > ke_per_dof) - fragments%rotmag(i) = sqrt(2 * (fragments%ke_spin_frag(i) - ke_per_dof)/(fragments%mass(i) * fragments%radius(i)**2 * fragments%Ip(3,i))) - fragments%rot(:,i) = fragments%rotmag(i) * .unit.fragments%rot(:,i) - end do + ! do concurrent(i = istart:nfrag, fragments%ke_spin_frag(i) > ke_per_dof) + ! fragments%rotmag(i) = sqrt(2 * (fragments%ke_spin_frag(i) - ke_per_dof)/(fragments%mass(i) * fragments%radius(i)**2 * fragments%Ip(3,i))) + ! fragments%rot(:,i) = fragments%rotmag(i) * .unit.fragments%rot(:,i) + ! end do call fragments%get_kinetic_energy() ke_residual = fragments%ke_budget - (fragments%ke_orbit + fragments%ke_spin) From 83d5490dd3d66a7473814c292c518f764fee78d4 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Fri, 30 Dec 2022 09:17:04 -0500 Subject: [PATCH 546/569] Fixed a whole mess of bugs and improved Fraggle's ability to converge on the energy constraint --- examples/Fragmentation/Fragmentation_Movie.py | 3 +- src/fraggle/fraggle_generate.f90 | 64 +++++++++++-------- src/fraggle/fraggle_util.f90 | 63 +++++++++--------- 3 files changed, 72 insertions(+), 58 deletions(-) diff --git a/examples/Fragmentation/Fragmentation_Movie.py b/examples/Fragmentation/Fragmentation_Movie.py index d17191912..84f8936f0 100644 --- a/examples/Fragmentation/Fragmentation_Movie.py +++ b/examples/Fragmentation/Fragmentation_Movie.py @@ -152,8 +152,7 @@ def __init__(self, sim, animfile, title, style, nskip=1): self.fig, self.ax = self.setup_plot() # Then setup FuncAnimation. - self.ani = animation.FuncAnimation(self.fig, self.update_plot, interval=1, frames=range(0,nframes,nskip), - blit=True) + self.ani = animation.FuncAnimation(self.fig, self.update_plot, interval=1, frames=range(0,nframes,nskip), blit=True) self.ani.save(animfile, fps=60, dpi=300, extra_args=['-vcodec', 'libx264']) print(f"Finished writing {animfile}") diff --git a/src/fraggle/fraggle_generate.f90 b/src/fraggle/fraggle_generate.f90 index 8c025f026..c5b435fb5 100644 --- a/src/fraggle/fraggle_generate.f90 +++ b/src/fraggle/fraggle_generate.f90 @@ -133,7 +133,7 @@ module subroutine fraggle_generate_disrupt(self, nbody_system, param, t, lfailur end if call ieee_set_flag(ieee_all, .false.) ! Set all fpe flags to quiet - !call self%set_natural_scale() + call self%set_natural_scale() call fragments%reset() @@ -157,11 +157,10 @@ module subroutine fraggle_generate_disrupt(self, nbody_system, param, t, lfailur call fraggle_generate_rot_vec(self) call fraggle_generate_vel_vec(self) call self%get_energy_and_momentum(nbody_system, param, lbefore=.false.) - exit dEtot = self%Etot(2) - self%Etot(1) dLmag = .mag. (self%Ltot(:,2) - self%Ltot(:,1)) - lfailure_local = (dEtot > FRAGGLE_ETOL) + lfailure_local = (dEtot > -impactors%Qloss) if (lfailure_local) then write(message, *) "dEtot: ",dEtot, "dEtot/Qloss", dEtot / impactors%Qloss call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Fraggle failed due to energy gain: " // & @@ -195,7 +194,7 @@ module subroutine fraggle_generate_disrupt(self, nbody_system, param, t, lfailur trim(adjustl(message)) // " tries") end if - !call self%set_original_scale() + call self%set_original_scale() ! Restore the big array if (lk_plpl) call pl%flatten(param) @@ -234,7 +233,7 @@ module subroutine fraggle_generate_hitandrun(self, nbody_system, param, t) class is (swiftest_nbody_system) select type(pl => nbody_system%pl) class is (swiftest_pl) - associate(impactors => self%impactors) + associate(impactors => self%impactors, nfrag => self%fragments%nbody) message = "Hit and run between" call collision_io_collider_message(nbody_system%pl, impactors%id, message) call swiftest_io_log_one_message(COLLISION_LOG_OUT, trim(adjustl(message))) @@ -310,7 +309,7 @@ module subroutine fraggle_generate_pos_vec(collider) logical :: lcat, lhitandrun integer(I4B), parameter :: MAXLOOP = 10000 real(DP) :: rdistance - real(DP), parameter :: fail_scale = 1.1_DP ! Scale factor to apply to cloud radius and distance if cloud generation fails + real(DP), parameter :: fail_scale = 1.01_DP ! Scale factor to apply to cloud radius and distance if cloud generation fails associate(fragments => collider%fragments, impactors => collider%impactors, nfrag => collider%fragments%nbody) @@ -431,13 +430,14 @@ module subroutine fraggle_generate_vel_vec(collider) ! Arguments class(collision_fraggle), intent(inout) :: collider !! Fraggle collision system object ! Internals - integer(I4B) :: i,j, loop, istart + integer(I4B) :: i, j, loop, istart, n, ndof logical :: lhitandrun, lnoncat real(DP), dimension(NDIM) :: vimp_unit, rimp, vrot, Lresidual - real(DP) :: vmag, vesc, rotmag, ke_residual, ke_per_dof + real(DP) :: vmag, vesc, rotmag, ke_residual, ke_per_dof, ke_tot integer(I4B), dimension(collider%fragments%nbody) :: vsign real(DP), dimension(collider%fragments%nbody) :: vscale, mass_vscale, ke_avail integer(I4B), parameter :: MAXLOOP = 100 + real(DP), parameter :: TOL = 1e-4 associate(fragments => collider%fragments, impactors => collider%impactors, nfrag => collider%fragments%nbody) lhitandrun = (impactors%regime == COLLRESOLVE_REGIME_HIT_AND_RUN) @@ -501,30 +501,44 @@ module subroutine fraggle_generate_vel_vec(collider) call collider%set_coordinate_system() call fragments%get_kinetic_energy() ke_residual = fragments%ke_budget - (fragments%ke_orbit + fragments%ke_spin) + if (abs(ke_residual) <= fragments%ke_budget * TOL) exit ! Make sure we don't take away too much orbital kinetic energy, otherwise the fragment can't escape - ke_avail(:) = fragments%ke_orbit_frag(:) - impactors%Gmass(1)*impactors%mass(2)/fragments%vmag(:) - ke_per_dof = -ke_residual/((nfrag - istart + 1)) + ke_avail(:) = fragments%ke_orbit_frag(:) - impactors%Gmass(1)*impactors%mass(2)/fragments%rmag(:) + ke_tot = 0.0_DP + ke_per_dof = -ke_residual + do i = 1, 2*(nfrag - istart + 1) + n = count(ke_avail(istart:nfrag) > -ke_residual/i) + count(fragments%ke_spin_frag(istart:nfrag) > -ke_residual/i) + if (abs(n * ke_per_dof) > ke_tot) then + ke_per_dof = -ke_residual/i + ke_tot = n * ke_per_dof + ndof = i + if (abs(ke_tot) > abs(ke_residual)) then + ke_tot = -ke_residual + ke_per_dof = ke_tot/n + exit + end if + end if + end do do concurrent(i = istart:nfrag, ke_avail(i) > ke_per_dof) - fragments%vmag(i) = sqrt(2 * (fragments%ke_orbit_frag(i) - ke_per_dof)/fragments%mass(i)) - fragments%vc(:,i) = fragments%vmag(i) * fragments%v_unit(:,i) + vmag = max(fragments%vmag(i)**2 - 2*ke_per_dof/fragments%mass(i),vesc**2) + fragments%vmag(i) = sqrt(vmag) + fragments%vc(:,i) = fragments%vmag(i) * .unit.fragments%vc(:,i) + end do + do concurrent(i = istart:nfrag, fragments%ke_spin_frag(i) > ke_per_dof) + rotmag = fragments%rotmag(i)**2 - 2*ke_per_dof/(fragments%mass(i) * fragments%radius(i)**2 * fragments%Ip(3,i)) + rotmag = max(rotmag, 0.0_DP) + fragments%rotmag(i) = sqrt(rotmag) + fragments%rot(:,i) = rotmag * .unit.fragments%rot(:,i) end do - ! do concurrent(i = istart:nfrag, fragments%ke_spin_frag(i) > ke_per_dof) - ! fragments%rotmag(i) = sqrt(2 * (fragments%ke_spin_frag(i) - ke_per_dof)/(fragments%mass(i) * fragments%radius(i)**2 * fragments%Ip(3,i))) - ! fragments%rot(:,i) = fragments%rotmag(i) * .unit.fragments%rot(:,i) - ! end do - call fragments%get_kinetic_energy() - ke_residual = fragments%ke_budget - (fragments%ke_orbit + fragments%ke_spin) - ! Check for any residual angular momentum, and if there is any, put it into spin of the biggest body + ! Check for any residual angular momentum, and if there is any, put it into spin call collider%set_coordinate_system() call fragments%get_angular_momentum() Lresidual(:) = fragments%L_budget(:) - (fragments%Lorbit(:) + fragments%Lspin(:)) - rotmag = .mag. fragments%rot(:,1) - fragments%rot(:,1) = fragments%rot(:,1) + Lresidual(:) / (fragments%mass(1) * fragments%radius(1)**2 * fragments%Ip(:,1)) - rotmag = .mag. fragments%rot(:,1) - - if (ke_residual >= 0.0_DP) exit - + do concurrent(i = 1:nfrag) + rotmag = .mag. fragments%rot(:,i) + fragments%rot(:,i) = fragments%rot(:,i) + Lresidual(:) / (nfrag*fragments%mass(i) * fragments%radius(i)**2 * fragments%Ip(:,i)) + end do end do do concurrent(i = 1:nfrag) diff --git a/src/fraggle/fraggle_util.f90 b/src/fraggle/fraggle_util.f90 index 9e519584c..5e3997ab7 100644 --- a/src/fraggle/fraggle_util.f90 +++ b/src/fraggle/fraggle_util.f90 @@ -231,39 +231,40 @@ module subroutine fraggle_util_set_natural_scale_factors(self) integer(I4B) :: i associate(collider => self, fragments => self%fragments, impactors => self%impactors) - ! Set scale factors - collider%Escale = 0.5_DP * ( impactors%mass(1) * dot_product(impactors%vb(:,1), impactors%vb(:,1)) & - + impactors%mass(2) * dot_product(impactors%vb(:,2), impactors%vb(:,2))) - collider%dscale = sum(impactors%radius(:)) + ! Set primary scale factors (mass, length, and time) based on the impactor properties at the time of collision collider%mscale = fragments%mtot - collider%vscale = sqrt(collider%Escale / collider%mscale) - collider%tscale = collider%dscale / collider%vscale + collider%dscale = sum(impactors%radius(:)) + collider%tscale = collider%dscale / (.mag.(impactors%vc(:,2) - impactors%vc(:,1))) + + ! Set secondary scale factors for convenience + collider%vscale = collider%dscale / collider%tscale + collider%Escale = collider%mscale * collider%vscale**2 collider%Lscale = collider%mscale * collider%dscale * collider%vscale ! Scale all dimensioned quantities of impactors and fragments - impactors%rbcom(:) = impactors%rbcom(:) / collider%dscale - impactors%vbcom(:) = impactors%vbcom(:) / collider%vscale - impactors%rbimp(:) = impactors%rbimp(:) / collider%dscale - impactors%bounce_unit(:) = impactors%bounce_unit(:) / collider%vscale - impactors%rb(:,:) = impactors%rb(:,:) / collider%dscale - impactors%vb(:,:) = impactors%vb(:,:) / collider%vscale - impactors%rc(:,:) = impactors%rc(:,:) / collider%dscale - impactors%vc(:,:) = impactors%vc(:,:) / collider%vscale - impactors%mass(:) = impactors%mass(:) / collider%mscale - impactors%Gmass(:) = impactors%Gmass(:) / 0.5_DP * collider%vscale**2 * collider%dscale - impactors%Mcb = impactors%Mcb / collider%mscale - impactors%radius(:) = impactors%radius(:) / collider%dscale - impactors%Lspin(:,:) = impactors%Lspin(:,:) / collider%Lscale - impactors%Lorbit(:,:) = impactors%Lorbit(:,:) / collider%Lscale + impactors%rbcom(:) = impactors%rbcom(:) / collider%dscale + impactors%vbcom(:) = impactors%vbcom(:) / collider%vscale + impactors%rbimp(:) = impactors%rbimp(:) / collider%dscale + impactors%rb(:,:) = impactors%rb(:,:) / collider%dscale + impactors%vb(:,:) = impactors%vb(:,:) / collider%vscale + impactors%rc(:,:) = impactors%rc(:,:) / collider%dscale + impactors%vc(:,:) = impactors%vc(:,:) / collider%vscale + impactors%mass(:) = impactors%mass(:) / collider%mscale + impactors%Gmass(:) = impactors%Gmass(:) / (collider%dscale**3/collider%tscale**2) + impactors%Mcb = impactors%Mcb / collider%mscale + impactors%radius(:) = impactors%radius(:) / collider%dscale + impactors%Lspin(:,:) = impactors%Lspin(:,:) / collider%Lscale + impactors%Lorbit(:,:) = impactors%Lorbit(:,:) / collider%Lscale + impactors%bounce_unit(:) = impactors%bounce_unit(:) / collider%vscale do i = 1, 2 - impactors%rot(:,i) = impactors%Lspin(:,i) / (impactors%mass(i) * impactors%radius(i)**2 * impactors%Ip(3, i)) + impactors%rot(:,i) = impactors%Lspin(:,i) / (impactors%mass(i) * impactors%radius(i)**2 * impactors%Ip(3,i)) end do - fragments%mtot = fragments%mtot / collider%mscale - fragments%mass = fragments%mass / collider%mscale - fragments%radius = fragments%radius / collider%dscale - impactors%Qloss = impactors%Qloss / collider%Escale + fragments%mtot = fragments%mtot / collider%mscale + fragments%mass = fragments%mass / collider%mscale + fragments%radius = fragments%radius / collider%dscale + impactors%Qloss = impactors%Qloss / collider%Escale end associate return @@ -288,13 +289,13 @@ module subroutine fraggle_util_set_original_scale_factors(self) associate(collider => self, fragments => self%fragments, impactors => self%impactors) ! Restore scale factors - impactors%rbcom(:) = impactors%rbcom(:) * collider%dscale - impactors%vbcom(:) = impactors%vbcom(:) * collider%vscale - impactors%rbimp(:) = impactors%rbimp(:) * collider%dscale + impactors%rbcom(:) = impactors%rbcom(:) * collider%dscale + impactors%vbcom(:) = impactors%vbcom(:) * collider%vscale + impactors%rbimp(:) = impactors%rbimp(:) * collider%dscale impactors%bounce_unit(:) = impactors%bounce_unit(:) * collider%vscale - + impactors%mass = impactors%mass * collider%mscale - impactors%Gmass(:) = impactors%Gmass(:) * 0.5_DP * collider%vscale**2 * collider%dscale + impactors%Gmass(:) = impactors%Gmass(:) * (collider%dscale**3/collider%tscale**2) impactors%Mcb = impactors%Mcb * collider%mscale impactors%mass_dist = impactors%mass_dist * collider%mscale impactors%radius = impactors%radius * collider%dscale @@ -305,7 +306,7 @@ module subroutine fraggle_util_set_original_scale_factors(self) impactors%Lspin = impactors%Lspin * collider%Lscale impactors%Lorbit = impactors%Lorbit * collider%Lscale do i = 1, 2 - impactors%rot(:,i) = impactors%Lspin(:,i) * (impactors%mass(i) * impactors%radius(i)**2 * impactors%Ip(3, i)) + impactors%rot(:,i) = impactors%Lspin(:,i) * (impactors%mass(i) * impactors%radius(i)**2 * impactors%Ip(3,i)) end do fragments%mtot = fragments%mtot * collider%mscale From 1a674466788cfb34493fe6e6902e0f90efd5eb95 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Fri, 30 Dec 2022 13:05:19 -0500 Subject: [PATCH 547/569] Fixed some bugs and relaxed the energy constraint so that it only has to lose some energy, not the exact amount --- src/collision/collision_util.f90 | 3 ++- src/fraggle/fraggle_generate.f90 | 11 ++++++----- 2 files changed, 8 insertions(+), 6 deletions(-) diff --git a/src/collision/collision_util.f90 b/src/collision/collision_util.f90 index ef582ee10..9573c1452 100644 --- a/src/collision/collision_util.f90 +++ b/src/collision/collision_util.f90 @@ -453,12 +453,13 @@ module subroutine collision_util_set_coordinate_collider(self) fragments%rmag(:) = .mag. fragments%rc(:,:) fragments%vmag(:) = .mag. fragments%vc(:,:) + fragments%rotmag(:) = .mag. fragments%rot(:,:) ! Define the radial, normal, and tangential unit vectors for each individual fragment fragments%r_unit(:,:) = .unit. fragments%rc(:,:) fragments%v_unit(:,:) = .unit. fragments%vc(:,:) fragments%n_unit(:,:) = .unit. (fragments%rc(:,:) .cross. fragments%vc(:,:)) - fragments%t_unit(:,:) = .unit. (fragments%r_unit(:,:) .cross. fragments%r_unit(:,:)) + fragments%t_unit(:,:) = .unit. (fragments%r_unit(:,:) .cross. fragments%n_unit(:,:)) end associate diff --git a/src/fraggle/fraggle_generate.f90 b/src/fraggle/fraggle_generate.f90 index c5b435fb5..6baa4b3fa 100644 --- a/src/fraggle/fraggle_generate.f90 +++ b/src/fraggle/fraggle_generate.f90 @@ -430,14 +430,14 @@ module subroutine fraggle_generate_vel_vec(collider) ! Arguments class(collision_fraggle), intent(inout) :: collider !! Fraggle collision system object ! Internals - integer(I4B) :: i, j, loop, istart, n, ndof + integer(I4B) :: i, j, loop, istart, iend, n, ndof logical :: lhitandrun, lnoncat real(DP), dimension(NDIM) :: vimp_unit, rimp, vrot, Lresidual real(DP) :: vmag, vesc, rotmag, ke_residual, ke_per_dof, ke_tot integer(I4B), dimension(collider%fragments%nbody) :: vsign real(DP), dimension(collider%fragments%nbody) :: vscale, mass_vscale, ke_avail integer(I4B), parameter :: MAXLOOP = 100 - real(DP), parameter :: TOL = 1e-4 + real(DP), parameter :: TOL = 1e-1 associate(fragments => collider%fragments, impactors => collider%impactors, nfrag => collider%fragments%nbody) lhitandrun = (impactors%regime == COLLRESOLVE_REGIME_HIT_AND_RUN) @@ -501,13 +501,14 @@ module subroutine fraggle_generate_vel_vec(collider) call collider%set_coordinate_system() call fragments%get_kinetic_energy() ke_residual = fragments%ke_budget - (fragments%ke_orbit + fragments%ke_spin) - if (abs(ke_residual) <= fragments%ke_budget * TOL) exit + if (ke_residual > 0.0_DP) exit ! Make sure we don't take away too much orbital kinetic energy, otherwise the fragment can't escape ke_avail(:) = fragments%ke_orbit_frag(:) - impactors%Gmass(1)*impactors%mass(2)/fragments%rmag(:) ke_tot = 0.0_DP ke_per_dof = -ke_residual do i = 1, 2*(nfrag - istart + 1) - n = count(ke_avail(istart:nfrag) > -ke_residual/i) + count(fragments%ke_spin_frag(istart:nfrag) > -ke_residual/i) + n = count(ke_avail(istart:nfrag) > -ke_residual/i) + if (ke_residual < 0.0_DP) n = n + count(fragments%ke_spin_frag(istart:nfrag) > -ke_residual/i) if (abs(n * ke_per_dof) > ke_tot) then ke_per_dof = -ke_residual/i ke_tot = n * ke_per_dof @@ -528,7 +529,7 @@ module subroutine fraggle_generate_vel_vec(collider) rotmag = fragments%rotmag(i)**2 - 2*ke_per_dof/(fragments%mass(i) * fragments%radius(i)**2 * fragments%Ip(3,i)) rotmag = max(rotmag, 0.0_DP) fragments%rotmag(i) = sqrt(rotmag) - fragments%rot(:,i) = rotmag * .unit.fragments%rot(:,i) + fragments%rot(:,i) = fragments%rotmag(i) * .unit.fragments%rot(:,i) end do ! Check for any residual angular momentum, and if there is any, put it into spin From 33819dbffc286765f63ad0520a5a441e8b8eb8b0 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Fri, 30 Dec 2022 13:16:10 -0500 Subject: [PATCH 548/569] Tweaked initial position calc to get better convergence in some circumstances. It still fails with the off-axis disruption case --- src/fraggle/fraggle_generate.f90 | 23 ++++++++++++++--------- src/fraggle/fraggle_module.f90 | 3 ++- 2 files changed, 16 insertions(+), 10 deletions(-) diff --git a/src/fraggle/fraggle_generate.f90 b/src/fraggle/fraggle_generate.f90 index 6baa4b3fa..c3dda504c 100644 --- a/src/fraggle/fraggle_generate.f90 +++ b/src/fraggle/fraggle_generate.f90 @@ -100,7 +100,7 @@ module subroutine fraggle_generate_disrupt(self, nbody_system, param, t, lfailur real(DP), intent(in) :: t !! Time of collision logical, optional, intent(out) :: lfailure !! Answers the question: Should this have been a merger instead? ! Internals - integer(I4B) :: try + integer(I4B) :: try, subtry real(DP) :: dEtot, dLmag integer(I4B), parameter :: MAXTRY = 100 logical :: lk_plpl, lfailure_local @@ -153,9 +153,13 @@ module subroutine fraggle_generate_disrupt(self, nbody_system, param, t, lfailur ! Compute the "before" energy/momentum and the budgets call self%get_energy_and_momentum(nbody_system, param, lbefore=.true.) call self%set_budgets() - call fraggle_generate_pos_vec(self) - call fraggle_generate_rot_vec(self) - call fraggle_generate_vel_vec(self) + do subtry = 1, MAXTRY + call fraggle_generate_pos_vec(self) + call fraggle_generate_rot_vec(self) + call fraggle_generate_vel_vec(self,lfailure_local) + if (.not.lfailure_local) exit + end do + call self%get_energy_and_momentum(nbody_system, param, lbefore=.false.) dEtot = self%Etot(2) - self%Etot(1) dLmag = .mag. (self%Ltot(:,2) - self%Ltot(:,1)) @@ -309,7 +313,7 @@ module subroutine fraggle_generate_pos_vec(collider) logical :: lcat, lhitandrun integer(I4B), parameter :: MAXLOOP = 10000 real(DP) :: rdistance - real(DP), parameter :: fail_scale = 1.01_DP ! Scale factor to apply to cloud radius and distance if cloud generation fails + real(DP), parameter :: fail_scale = 1.001_DP ! Scale factor to apply to cloud radius and distance if cloud generation fails associate(fragments => collider%fragments, impactors => collider%impactors, nfrag => collider%fragments%nbody) @@ -319,7 +323,7 @@ module subroutine fraggle_generate_pos_vec(collider) ! We will treat the first two fragments of the list as special cases. ! Place the first two bodies at the centers of the two fragment clouds, but be sure they are sufficiently far apart to avoid overlap rdistance = .mag. (impactors%rc(:,2) - impactors%rc(:,1)) - sum(fragments%radius(1:2)) - rdistance = min(0.5_DP*rdistance, 1e-6_DP*impactors%radius(2)) + rdistance = 0.5_DP*rdistance fragment_cloud_radius(:) = impactors%radius(:) @@ -420,7 +424,7 @@ module subroutine fraggle_generate_rot_vec(collider) end subroutine fraggle_generate_rot_vec - module subroutine fraggle_generate_vel_vec(collider) + module subroutine fraggle_generate_vel_vec(collider, lfailure) !! Author: David A. Minton !! !! Generates an initial velocity distribution. For disruptions, the velocity magnitude is set to be @@ -429,15 +433,15 @@ module subroutine fraggle_generate_vel_vec(collider) implicit none ! Arguments class(collision_fraggle), intent(inout) :: collider !! Fraggle collision system object + logical, intent(out) :: lfailure !! Did the velocity computation fail? ! Internals - integer(I4B) :: i, j, loop, istart, iend, n, ndof + integer(I4B) :: i, j, loop, istart, n, ndof logical :: lhitandrun, lnoncat real(DP), dimension(NDIM) :: vimp_unit, rimp, vrot, Lresidual real(DP) :: vmag, vesc, rotmag, ke_residual, ke_per_dof, ke_tot integer(I4B), dimension(collider%fragments%nbody) :: vsign real(DP), dimension(collider%fragments%nbody) :: vscale, mass_vscale, ke_avail integer(I4B), parameter :: MAXLOOP = 100 - real(DP), parameter :: TOL = 1e-1 associate(fragments => collider%fragments, impactors => collider%impactors, nfrag => collider%fragments%nbody) lhitandrun = (impactors%regime == COLLRESOLVE_REGIME_HIT_AND_RUN) @@ -541,6 +545,7 @@ module subroutine fraggle_generate_vel_vec(collider) fragments%rot(:,i) = fragments%rot(:,i) + Lresidual(:) / (nfrag*fragments%mass(i) * fragments%radius(i)**2 * fragments%Ip(:,i)) end do end do + lfailure = ke_residual < 0.0_DP do concurrent(i = 1:nfrag) fragments%vb(:,i) = fragments%vc(:,i) + impactors%vbcom(:) diff --git a/src/fraggle/fraggle_module.f90 b/src/fraggle/fraggle_module.f90 index 130b3af5c..9022a0a0c 100644 --- a/src/fraggle/fraggle_module.f90 +++ b/src/fraggle/fraggle_module.f90 @@ -82,9 +82,10 @@ module subroutine fraggle_generate_rot_vec(collider) class(collision_fraggle), intent(inout) :: collider !! Collision system object end subroutine fraggle_generate_rot_vec - module subroutine fraggle_generate_vel_vec(collider) + module subroutine fraggle_generate_vel_vec(collider, lfailure) implicit none class(collision_fraggle), intent(inout) :: collider !! Collision system object + logical, intent(out) :: lfailure !! Did the velocity computation fail? end subroutine fraggle_generate_vel_vec module subroutine fraggle_util_setup_fragments_system(self, nfrag) From c6c76d6cd6b112266cbd01eac879a1c1e5865bfc Mon Sep 17 00:00:00 2001 From: David A Minton Date: Fri, 30 Dec 2022 13:36:31 -0500 Subject: [PATCH 549/569] Giving up on trying to get the off-axis disruption cases to succeed. Letting it just continue even if it fails --- src/fraggle/fraggle_generate.f90 | 88 +++++++++++++++----------------- 1 file changed, 41 insertions(+), 47 deletions(-) diff --git a/src/fraggle/fraggle_generate.f90 b/src/fraggle/fraggle_generate.f90 index c3dda504c..7e72c8f90 100644 --- a/src/fraggle/fraggle_generate.f90 +++ b/src/fraggle/fraggle_generate.f90 @@ -100,7 +100,7 @@ module subroutine fraggle_generate_disrupt(self, nbody_system, param, t, lfailur real(DP), intent(in) :: t !! Time of collision logical, optional, intent(out) :: lfailure !! Answers the question: Should this have been a merger instead? ! Internals - integer(I4B) :: try, subtry + integer(I4B) :: try real(DP) :: dEtot, dLmag integer(I4B), parameter :: MAXTRY = 100 logical :: lk_plpl, lfailure_local @@ -140,55 +140,49 @@ module subroutine fraggle_generate_disrupt(self, nbody_system, param, t, lfailur lfailure_local = .false. try = 1 - do while (try < MAXTRY) - write(message,*) try - call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Fraggle try " // trim(adjustl(message))) - if (lfailure_local) then - call fragments%reset() - try = try + 1 - end if - lfailure_local = .false. - - ! Use the disruption collision model to generate initial conditions - ! Compute the "before" energy/momentum and the budgets - call self%get_energy_and_momentum(nbody_system, param, lbefore=.true.) - call self%set_budgets() - do subtry = 1, MAXTRY - call fraggle_generate_pos_vec(self) - call fraggle_generate_rot_vec(self) - call fraggle_generate_vel_vec(self,lfailure_local) - if (.not.lfailure_local) exit - end do + write(message,*) try + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Fraggle try " // trim(adjustl(message))) + if (lfailure_local) then + call fragments%reset() + try = try + 1 + end if + lfailure_local = .false. - call self%get_energy_and_momentum(nbody_system, param, lbefore=.false.) - dEtot = self%Etot(2) - self%Etot(1) - dLmag = .mag. (self%Ltot(:,2) - self%Ltot(:,1)) - - lfailure_local = (dEtot > -impactors%Qloss) - if (lfailure_local) then - write(message, *) "dEtot: ",dEtot, "dEtot/Qloss", dEtot / impactors%Qloss - call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Fraggle failed due to energy gain: " // & - trim(adjustl(message))) - cycle - lfailure_local = .false. - end if + ! Use the disruption collision model to generate initial conditions + ! Compute the "before" energy/momentum and the budgets + call self%get_energy_and_momentum(nbody_system, param, lbefore=.true.) + call self%set_budgets() + do try = 1, MAXTRY + call fraggle_generate_pos_vec(self) + call fraggle_generate_rot_vec(self) + call fraggle_generate_vel_vec(self,lfailure_local) + if (.not.lfailure_local) exit + end do - lfailure_local = ((abs(dLmag) / (.mag.self%Ltot(:,1))) > FRAGGLE_LTOL) - if (lfailure_local) then - write(message,*) dLmag / (.mag.self%Ltot(:,1)) - call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Fraggle failed due to high angular momentum error: " // & - trim(adjustl(message))) - cycle - end if + call self%get_energy_and_momentum(nbody_system, param, lbefore=.false.) + dEtot = self%Etot(2) - self%Etot(1) + dLmag = .mag. (self%Ltot(:,2) - self%Ltot(:,1)) - ! Check if any of the usual floating point exceptions happened, and fail the try if so - call ieee_get_flag(ieee_usual, fpe_flag) - lfailure_local = any(fpe_flag) - if (.not.lfailure_local) exit - write(message,*) "Fraggle failed due to a floating point exception: ", fpe_flag - call swiftest_io_log_one_message(COLLISION_LOG_OUT, message) + lfailure_local = (dEtot > -impactors%Qloss) + if (lfailure_local) then + write(message, *) "dEtot: ",dEtot, "dEtot/Qloss", dEtot / impactors%Qloss + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Fraggle failed due to energy gain: " // & + trim(adjustl(message))) + end if + + lfailure_local = ((abs(dLmag) / (.mag.self%Ltot(:,1))) > FRAGGLE_LTOL) + if (lfailure_local) then + write(message,*) dLmag / (.mag.self%Ltot(:,1)) + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Fraggle failed due to high angular momentum error: " // & + trim(adjustl(message))) + end if + + ! Check if any of the usual floating point exceptions happened, and fail the try if so + call ieee_get_flag(ieee_usual, fpe_flag) + lfailure_local = any(fpe_flag) + write(message,*) "Fraggle failed due to a floating point exception: ", fpe_flag + call swiftest_io_log_one_message(COLLISION_LOG_OUT, message) - end do write(message,*) try if (lfailure_local) then call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Fraggle fragment generation failed after " // & @@ -530,7 +524,7 @@ module subroutine fraggle_generate_vel_vec(collider, lfailure) fragments%vc(:,i) = fragments%vmag(i) * .unit.fragments%vc(:,i) end do do concurrent(i = istart:nfrag, fragments%ke_spin_frag(i) > ke_per_dof) - rotmag = fragments%rotmag(i)**2 - 2*ke_per_dof/(fragments%mass(i) * fragments%radius(i)**2 * fragments%Ip(3,i)) + rotmag = fragments%rotmag(i)**2 - ke_per_dof/(fragments%mass(i) * fragments%radius(i)**2 * fragments%Ip(3,i)) rotmag = max(rotmag, 0.0_DP) fragments%rotmag(i) = sqrt(rotmag) fragments%rot(:,i) = fragments%rotmag(i) * .unit.fragments%rot(:,i) From fd89184d26a56505dca8192ac4d0b187b28b63dc Mon Sep 17 00:00:00 2001 From: David A Minton Date: Fri, 30 Dec 2022 20:43:33 -0500 Subject: [PATCH 550/569] More bug fixes and improvements to all models except the off-axis disruption --- examples/Fragmentation/Fragmentation_Movie.py | 2 +- src/collision/collision_generate.f90 | 7 +- src/collision/collision_module.f90 | 62 +++++++------- src/collision/collision_resolve.f90 | 15 +++- src/collision/collision_util.f90 | 42 +++++----- src/fraggle/fraggle_generate.f90 | 81 +++++++++---------- src/fraggle/fraggle_util.f90 | 9 ++- src/swiftest/swiftest_module.f90 | 2 +- 8 files changed, 115 insertions(+), 105 deletions(-) diff --git a/examples/Fragmentation/Fragmentation_Movie.py b/examples/Fragmentation/Fragmentation_Movie.py index 84f8936f0..807f22419 100644 --- a/examples/Fragmentation/Fragmentation_Movie.py +++ b/examples/Fragmentation/Fragmentation_Movie.py @@ -72,7 +72,7 @@ rot_vectors = {"disruption_headon" : [np.array([0.0, 0.0, 0.0]), np.array([0.0, 0.0, 0.0])], - "disruption_off_axis": [np.array([0.0, 0.0, 6.0e4]), + "disruption_off_axis": [np.array([0.0, 0.0, -6.0e4]), np.array([0.0, 0.0, 1.0e5])], "supercatastrophic_headon": [np.array([0.0, 0.0, 0.0]), np.array([0.0, 0.0, 0.0])], diff --git a/src/collision/collision_generate.f90 b/src/collision/collision_generate.f90 index 53900f353..202cc5297 100644 --- a/src/collision/collision_generate.f90 +++ b/src/collision/collision_generate.f90 @@ -155,7 +155,7 @@ module subroutine collision_generate_merge(self, nbody_system, param, t) ! Internals integer(I4B) :: i, j, k, ibiggest real(DP), dimension(NDIM) :: Lspin_new - real(DP) :: volume, dpe + real(DP) :: volume character(len=STRMAX) :: message select type(nbody_system) @@ -208,11 +208,6 @@ module subroutine collision_generate_merge(self, nbody_system, param, t) ! Get the energy of the system after the collision call self%get_energy_and_momentum(nbody_system, param, lbefore=.false.) - ! Keep track of the component of potential energy that is now not considered because two bodies became one - dpe = self%pe(2) - self%pe(1) - nbody_system%Ecollisions = nbody_system%Ecollisions - dpe - nbody_system%Euntracked = nbody_system%Euntracked + dpe - ! Update any encounter lists that have the removed bodies in them so that they instead point to the new body do k = 1, nbody_system%plpl_encounter%nenc do j = 1, impactors%ncoll diff --git a/src/collision/collision_module.f90 b/src/collision/collision_module.f90 index 5fe3893cb..23a0d20b4 100644 --- a/src/collision/collision_module.f90 +++ b/src/collision/collision_module.f90 @@ -89,36 +89,38 @@ module collision !> Class definition for the variables that describe a collection of fragments in barycentric coordinates type, extends(base_multibody) :: collision_fragments - real(DP) :: mtot !! Total mass of fragments - class(base_particle_info), dimension(:), allocatable :: info !! Particle metadata information - integer(I4B), dimension(nbody) :: status !! An integrator-specific status indicator - real(DP), dimension(NDIM,nbody) :: rh !! Heliocentric position - real(DP), dimension(NDIM,nbody) :: vh !! Heliocentric velocity - real(DP), dimension(NDIM,nbody) :: rb !! Barycentric position - real(DP), dimension(NDIM,nbody) :: vb !! Barycentric velocity - real(DP), dimension(NDIM,nbody) :: rot !! rotation vectors of fragments - real(DP), dimension(NDIM,nbody) :: Ip !! Principal axes moment of inertia for fragments - real(DP), dimension(nbody) :: mass !! masses of fragments - real(DP), dimension(nbody) :: radius !! Radii of fragments - real(DP), dimension(nbody) :: density !! Radii of fragments - real(DP), dimension(NDIM,nbody) :: rc !! Position vectors in the collision coordinate frame - real(DP), dimension(NDIM,nbody) :: vc !! Velocity vectors in the collision coordinate frame - real(DP), dimension(nbody) :: rmag !! Array of radial distance magnitudes of individual fragments in the collisional coordinate frame - real(DP), dimension(nbody) :: vmag !! Array of radial distance magnitudes of individual fragments in the collisional coordinate frame - real(DP), dimension(nbody) :: rotmag !! Array of rotation magnitudes of individual fragments - real(DP), dimension(NDIM,nbody) :: r_unit !! Array of radial direction unit vectors of individual fragments in the collisional coordinate frame - real(DP), dimension(NDIM,nbody) :: v_unit !! Array of velocity direction unit vectors of individual fragments in the collisional coordinate frame - real(DP), dimension(NDIM,nbody) :: t_unit !! Array of tangential direction unit vectors of individual fragments in the collisional coordinate frame - real(DP), dimension(NDIM,nbody) :: n_unit !! Array of normal direction unit vectors of individual fragments in the collisional coordinate frame - integer(I1B), dimension(nbody) :: origin_body !! Array of indices indicating which impactor body (1 or 2) the fragment originates from - real(DP), dimension(NDIM) :: Lorbit !! Orbital angular momentum vector of all fragments - real(DP), dimension(NDIM) :: Lspin !! Spin angular momentum vector of all fragments - real(DP) :: ke_orbit !! Orbital kinetic energy of all fragments - real(DP) :: ke_spin !! Spin kinetic energy of all fragments - real(DP) :: ke_budget !! Kinetic energy budget for computing fragment trajectories - real(DP), dimension(NDIM) :: L_budget !! Angular momentum budget for computing fragment trajectories - real(DP), dimension(nbody) :: ke_orbit_frag !! Orbital kinetic energy of each individual fragment - real(DP), dimension(nbody) :: ke_spin_frag !! Spin kinetic energy of each individual fragment + real(DP) :: mtot !! Total mass of fragments + class(base_particle_info), dimension(:), allocatable :: info !! Particle metadata information + integer(I4B), dimension(nbody) :: status !! An integrator-specific status indicator + real(DP), dimension(NDIM,nbody) :: rh !! Heliocentric position + real(DP), dimension(NDIM,nbody) :: vh !! Heliocentric velocity + real(DP), dimension(NDIM,nbody) :: rb !! Barycentric position + real(DP), dimension(NDIM,nbody) :: vb !! Barycentric velocity + real(DP), dimension(NDIM,nbody) :: rot !! rotation vectors of fragments + real(DP), dimension(NDIM,nbody) :: Ip !! Principal axes moment of inertia for fragments + real(DP), dimension(nbody) :: mass !! masses of fragments + real(DP), dimension(nbody) :: radius !! Radii of fragments + real(DP), dimension(nbody) :: density !! Radii of fragments + real(DP), dimension(NDIM,nbody) :: rc !! Position vectors in the collision coordinate frame + real(DP), dimension(NDIM,nbody) :: vc !! Velocity vectors in the collision coordinate frame + real(DP), dimension(nbody) :: rmag !! Array of radial distance magnitudes of individual fragments in the collisional coordinate frame + real(DP), dimension(nbody) :: vmag !! Array of radial distance magnitudes of individual fragments in the collisional coordinate frame + real(DP), dimension(nbody) :: rotmag !! Array of rotation magnitudes of individual fragments + real(DP), dimension(NDIM,nbody) :: r_unit !! Array of radial direction unit vectors of individual fragments in the collisional coordinate frame + real(DP), dimension(NDIM,nbody) :: v_unit !! Array of velocity direction unit vectors of individual fragments in the collisional coordinate frame + real(DP), dimension(NDIM,nbody) :: t_unit !! Array of tangential direction unit vectors of individual fragments in the collisional coordinate frame + real(DP), dimension(NDIM,nbody) :: n_unit !! Array of normal direction unit vectors of individual fragments in the collisional coordinate frame + integer(I1B), dimension(nbody) :: origin_body !! Array of indices indicating which impactor body (1 or 2) the fragment originates from + real(DP), dimension(NDIM) :: Lorbit_tot !! Orbital angular momentum vector of all fragments + real(DP), dimension(NDIM) :: Lspin_tot !! Spin angular momentum vector of all fragments + real(DP), dimension(NDIM,nbody) :: Lorbit !! Orbital angular momentum vector of each individual fragment + real(DP), dimension(NDIM,nbody) :: Lspin !! Spin angular momentum vector of each individual fragment + real(DP) :: ke_orbit_tot !! Orbital kinetic energy of all fragments + real(DP) :: ke_spin_tot !! Spin kinetic energy of all fragments + real(DP) :: ke_budget !! Kinetic energy budget for computing fragment trajectories + real(DP), dimension(NDIM) :: L_budget !! Angular momentum budget for computing fragment trajectories + real(DP), dimension(nbody) :: ke_orbit !! Orbital kinetic energy of each individual fragment + real(DP), dimension(nbody) :: ke_spin !! Spin kinetic energy of each individual fragment contains procedure :: reset => collision_util_reset_fragments !! Deallocates all allocatable arrays and sets everything else to 0 procedure :: get_angular_momentum => collision_util_get_angular_momentum !! Calcualtes the current angular momentum of the fragments diff --git a/src/collision/collision_resolve.f90 b/src/collision/collision_resolve.f90 index 9e7e1e468..b0fff79dd 100644 --- a/src/collision/collision_resolve.f90 +++ b/src/collision/collision_resolve.f90 @@ -497,6 +497,7 @@ module subroutine collision_resolve_plpl(self, nbody_system, param, t, dt, irec) logical :: lgoodcollision integer(I4B) :: i, loop, ncollisions integer(I4B), parameter :: MAXCASCADE = 1000 + real(DP) :: dpe select type (nbody_system) class is (swiftest_nbody_system) @@ -537,11 +538,23 @@ module subroutine collision_resolve_plpl(self, nbody_system, param, t, dt, irec) idx_parent(2) = pl%kin(idx2(i))%parent call impactors%consolidate(nbody_system, param, idx_parent, lgoodcollision) if ((.not. lgoodcollision) .or. any(pl%status(idx_parent(:)) /= COLLIDED)) cycle - call impactors%get_regime(nbody_system, param) + call collision_history%take_snapshot(param,nbody_system, t, "before") + + call nbody_system%get_energy_and_momentum(param) + collider%pe(1) = nbody_system%pe + call collider%generate(nbody_system, param, t) + + call nbody_system%get_energy_and_momentum(param) + collider%pe(2) = nbody_system%pe + dpe = collider%pe(2) - collider%pe(1) + nbody_system%Ecollisions = nbody_system%Ecollisions - dpe + nbody_system%Euntracked = nbody_system%Euntracked + dpe + call collision_history%take_snapshot(param,nbody_system, t, "after") + plpl_collision%status(i) = collider%status call impactors%reset() end do diff --git a/src/collision/collision_util.f90 b/src/collision/collision_util.f90 index 9573c1452..2878f95ec 100644 --- a/src/collision/collision_util.f90 +++ b/src/collision/collision_util.f90 @@ -186,13 +186,14 @@ module subroutine collision_util_get_angular_momentum(self) integer(I4B) :: i associate(fragments => self, nfrag => self%nbody) - fragments%Lorbit(:) = 0.0_DP - fragments%Lspin(:) = 0.0_DP do i = 1, nfrag - fragments%Lorbit(:) = fragments%Lorbit(:) + fragments%mass(i) * (fragments%rc(:, i) .cross. fragments%vc(:, i)) - fragments%Lspin(:) = fragments%Lspin(:) + fragments%mass(i) * fragments%radius(i)**2 * fragments%Ip(:, i) * fragments%rot(:, i) + fragments%Lorbit(:,i) = fragments%mass(i) * (fragments%rc(:,i) .cross. fragments%vc(:, i)) + fragments%Lspin(:,i) = fragments%mass(i) * fragments%radius(i)**2 * fragments%Ip(:,i) * fragments%rot(:,i) end do + + fragments%Lorbit_tot(:) = sum(fragments%Lorbit, dim=2) + fragments%Lspin_tot(:) = sum(fragments%Lspin, dim=2) end associate return @@ -210,18 +211,16 @@ module subroutine collision_util_get_kinetic_energy(self) integer(I4B) :: i associate(fragments => self, nfrag => self%nbody) - fragments%ke_orbit_frag(:) = 0.0_DP - fragments%ke_spin_frag(:) = 0.0_DP do concurrent(i = 1:nfrag) - fragments%ke_orbit_frag(i) = fragments%mass(i) * dot_product(fragments%vc(:,i), fragments%vc(:,i)) - fragments%ke_spin_frag(i) = fragments%mass(i) * fragments%radius(i)**2 * fragments%Ip(3,i) * dot_product(fragments%rot(:,i),fragments%rot(:,i) ) + fragments%ke_orbit(i) = fragments%mass(i) * dot_product(fragments%vc(:,i), fragments%vc(:,i)) + fragments%ke_spin(i) = fragments%mass(i) * fragments%radius(i)**2 * fragments%Ip(3,i) * dot_product(fragments%rot(:,i),fragments%rot(:,i) ) end do - fragments%ke_orbit_frag(:) = fragments%ke_orbit_frag(:) / 2 - fragments%ke_spin_frag(:) = fragments%ke_spin_frag(:) / 2 - fragments%ke_orbit = sum(fragments%ke_orbit_frag(:)) - fragments%ke_spin = sum(fragments%ke_spin_frag(:)) + fragments%ke_orbit(:) = fragments%ke_orbit(:) / 2 + fragments%ke_spin(:) = fragments%ke_spin(:) / 2 + fragments%ke_orbit_tot = sum(fragments%ke_orbit(:)) + fragments%ke_spin_tot = sum(fragments%ke_spin(:)) end associate @@ -266,14 +265,15 @@ module subroutine collision_util_get_energy_momentum(self, nbody_system, param, end do ke_orbit = ke_orbit / 2 ke_spin = ke_spin / 2 + else call fragments%get_angular_momentum() - Lorbit(:) = fragments%Lorbit(:) - Lspin(:) = fragments%Lspin(:) + Lorbit(:) = fragments%Lorbit_tot(:) + Lspin(:) = fragments%Lspin_tot(:) call fragments%get_kinetic_energy() - ke_orbit = fragments%ke_orbit - ke_spin = fragments%ke_spin + ke_orbit = fragments%ke_orbit_tot + ke_spin = fragments%ke_spin_tot end if ! Calculate the current fragment energy and momentum balances @@ -459,7 +459,7 @@ module subroutine collision_util_set_coordinate_collider(self) fragments%r_unit(:,:) = .unit. fragments%rc(:,:) fragments%v_unit(:,:) = .unit. fragments%vc(:,:) fragments%n_unit(:,:) = .unit. (fragments%rc(:,:) .cross. fragments%vc(:,:)) - fragments%t_unit(:,:) = .unit. (fragments%r_unit(:,:) .cross. fragments%n_unit(:,:)) + fragments%t_unit(:,:) = -.unit. (fragments%r_unit(:,:) .cross. fragments%n_unit(:,:)) end associate @@ -594,11 +594,11 @@ module subroutine collision_util_setup_fragments_collider(self, nfrag) self%fragments%density(:) = 0.0_DP self%fragments%rmag(:) = 0.0_DP self%fragments%vmag(:) = 0.0_DP - self%fragments%Lorbit(:) = 0.0_DP - self%fragments%Lspin(:) = 0.0_DP + self%fragments%Lorbit_tot(:) = 0.0_DP + self%fragments%Lspin_tot(:) = 0.0_DP self%fragments%L_budget(:) = 0.0_DP - self%fragments%ke_orbit = 0.0_DP - self%fragments%ke_spin = 0.0_DP + self%fragments%ke_orbit_tot = 0.0_DP + self%fragments%ke_spin_tot = 0.0_DP self%fragments%ke_budget = 0.0_DP return diff --git a/src/fraggle/fraggle_generate.f90 b/src/fraggle/fraggle_generate.f90 index 7e72c8f90..6b93500a5 100644 --- a/src/fraggle/fraggle_generate.f90 +++ b/src/fraggle/fraggle_generate.f90 @@ -30,7 +30,6 @@ module subroutine fraggle_generate(self, nbody_system, param, t) ! Internals integer(I4B) :: i, ibiggest, nfrag character(len=STRMAX) :: message - real(DP) :: dpe select type(nbody_system) class is (swiftest_nbody_system) @@ -38,6 +37,7 @@ module subroutine fraggle_generate(self, nbody_system, param, t) class is (swiftest_pl) associate(impactors => self%impactors, status => self%status) + select case (impactors%regime) case (COLLRESOLVE_REGIME_HIT_AND_RUN) call self%hitandrun(nbody_system, param, t) @@ -56,9 +56,6 @@ module subroutine fraggle_generate(self, nbody_system, param, t) call self%set_mass_dist(param) call self%disrupt(nbody_system, param, t) - dpe = self%pe(2) - self%pe(1) - nbody_system%Ecollisions = nbody_system%Ecollisions - dpe - nbody_system%Euntracked = nbody_system%Euntracked + dpe associate (fragments => self%fragments) ! Populate the list of new bodies @@ -79,6 +76,7 @@ module subroutine fraggle_generate(self, nbody_system, param, t) end select call collision_resolve_mergeaddsub(nbody_system, param, t, status) + end associate end associate end select @@ -221,17 +219,16 @@ module subroutine fraggle_generate_hitandrun(self, nbody_system, param, t) ! Result integer(I4B) :: status !! Status flag assigned to this outcome ! Internals - integer(I4B) :: i, ibiggest, nfrag, jtarg, jproj + integer(I4B) :: i, ibiggest, jtarg, jproj, nfrag logical :: lpure character(len=STRMAX) :: message - real(DP) :: dpe select type(nbody_system) class is (swiftest_nbody_system) select type(pl => nbody_system%pl) class is (swiftest_pl) - associate(impactors => self%impactors, nfrag => self%fragments%nbody) + associate(impactors => self%impactors) message = "Hit and run between" call collision_io_collider_message(nbody_system%pl, impactors%id, message) call swiftest_io_log_one_message(COLLISION_LOG_OUT, trim(adjustl(message))) @@ -244,35 +241,23 @@ module subroutine fraggle_generate_hitandrun(self, nbody_system, param, t) jproj = 1 end if - ! The frag disruption model (and its extended types allow for non-pure hit and run. + ! The Fraggle disruption model (and its extended types allow for non-pure hit and run. if (impactors%mass_dist(2) > 0.9_DP * impactors%mass(jproj)) then ! Pure hit and run, so we'll just keep the two bodies untouched call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Pure hit and run. No new fragments generated.") nfrag = 0 call self%collision_basic%hitandrun(nbody_system, param, t) lpure = .true. return - else ! Imperfect hit and run, so we'll keep the largest body and destroy the other - lpure = .false. - call self%set_mass_dist(param) - - ! Generate the position and velocity distributions of the fragments - call self%get_energy_and_momentum(nbody_system, param, lbefore=.true.) - call self%disrupt(nbody_system, param, t, lpure) - call self%get_energy_and_momentum(nbody_system, param, lbefore=.false.) - - dpe = self%pe(2) - self%pe(1) - nbody_system%Ecollisions = nbody_system%Ecollisions - dpe - nbody_system%Euntracked = nbody_system%Euntracked + dpe - - if (lpure) then - call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Should have been a pure hit and run instead") - nfrag = 0 - else - nfrag = self%fragments%nbody - write(message, *) nfrag - call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Generating " // trim(adjustl(message)) // " fragments") - end if end if + lpure = .false. + call self%set_mass_dist(param) + + ! Generate the position and velocity distributions of the fragments + call self%disrupt(nbody_system, param, t, lpure) + nfrag = self%fragments%nbody + + write(message, *) nfrag + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Generating " // trim(adjustl(message)) // " fragments") ibiggest = impactors%id(maxloc(pl%Gmass(impactors%id(:)), dim=1)) self%fragments%id(1) = pl%id(ibiggest) @@ -431,11 +416,12 @@ module subroutine fraggle_generate_vel_vec(collider, lfailure) ! Internals integer(I4B) :: i, j, loop, istart, n, ndof logical :: lhitandrun, lnoncat - real(DP), dimension(NDIM) :: vimp_unit, rimp, vrot, Lresidual + real(DP), dimension(NDIM) :: vimp_unit, rimp, vrot, Lresidual, vshear, vunit real(DP) :: vmag, vesc, rotmag, ke_residual, ke_per_dof, ke_tot integer(I4B), dimension(collider%fragments%nbody) :: vsign real(DP), dimension(collider%fragments%nbody) :: vscale, mass_vscale, ke_avail - integer(I4B), parameter :: MAXLOOP = 100 + integer(I4B), parameter :: MAXLOOP = 1000 + real(DP), parameter :: TOL = 1e-4 associate(fragments => collider%fragments, impactors => collider%impactors, nfrag => collider%fragments%nbody) lhitandrun = (impactors%regime == COLLRESOLVE_REGIME_HIT_AND_RUN) @@ -467,7 +453,7 @@ module subroutine fraggle_generate_vel_vec(collider, lfailure) ! Give the fragment velocities a random value that is scaled with fragment mass call random_number(mass_vscale) mass_vscale(:) = (mass_vscale(:) + 1.0_DP) / 2 - mass_vscale(:) = mass_vscale(:) * (fragments%mtot / fragments%mass(:))**(0.125_DP) ! The 1/8 power is arbitrary. It just gives the velocity a small mass dependence + mass_vscale(:) = mass_vscale(:) * (fragments%mtot / fragments%mass(:))**(0.125_DP) ! The power is arbitrary. It just gives the velocity a small mass dependence mass_vscale(:) = mass_vscale(:) / minval(mass_vscale(:)) ! Set the velocities of all fragments using all of the scale factors determined above @@ -498,15 +484,15 @@ module subroutine fraggle_generate_vel_vec(collider, lfailure) do loop = 1, MAXLOOP call collider%set_coordinate_system() call fragments%get_kinetic_energy() - ke_residual = fragments%ke_budget - (fragments%ke_orbit + fragments%ke_spin) - if (ke_residual > 0.0_DP) exit + ke_residual = fragments%ke_budget - (fragments%ke_orbit_tot + fragments%ke_spin_tot) + if ((ke_residual > 0.0_DP).and.(ke_residual <= fragments%ke_budget * TOL)) exit ! Make sure we don't take away too much orbital kinetic energy, otherwise the fragment can't escape - ke_avail(:) = fragments%ke_orbit_frag(:) - impactors%Gmass(1)*impactors%mass(2)/fragments%rmag(:) + ke_avail(:) = fragments%ke_orbit(:) - impactors%Gmass(1)*impactors%mass(2)/fragments%rmag(:) ke_tot = 0.0_DP ke_per_dof = -ke_residual do i = 1, 2*(nfrag - istart + 1) n = count(ke_avail(istart:nfrag) > -ke_residual/i) - if (ke_residual < 0.0_DP) n = n + count(fragments%ke_spin_frag(istart:nfrag) > -ke_residual/i) + if (ke_residual < 0.0_DP) n = n + count(fragments%ke_spin(istart:nfrag) > -ke_residual/i) if (abs(n * ke_per_dof) > ke_tot) then ke_per_dof = -ke_residual/i ke_tot = n * ke_per_dof @@ -523,8 +509,8 @@ module subroutine fraggle_generate_vel_vec(collider, lfailure) fragments%vmag(i) = sqrt(vmag) fragments%vc(:,i) = fragments%vmag(i) * .unit.fragments%vc(:,i) end do - do concurrent(i = istart:nfrag, fragments%ke_spin_frag(i) > ke_per_dof) - rotmag = fragments%rotmag(i)**2 - ke_per_dof/(fragments%mass(i) * fragments%radius(i)**2 * fragments%Ip(3,i)) + do concurrent(i = istart:nfrag, fragments%ke_spin(i) > ke_per_dof) + rotmag = fragments%rotmag(i)**2 - 2*ke_per_dof/(fragments%mass(i) * fragments%radius(i)**2 * fragments%Ip(3,i)) rotmag = max(rotmag, 0.0_DP) fragments%rotmag(i) = sqrt(rotmag) fragments%rot(:,i) = fragments%rotmag(i) * .unit.fragments%rot(:,i) @@ -533,11 +519,22 @@ module subroutine fraggle_generate_vel_vec(collider, lfailure) ! Check for any residual angular momentum, and if there is any, put it into spin call collider%set_coordinate_system() call fragments%get_angular_momentum() - Lresidual(:) = fragments%L_budget(:) - (fragments%Lorbit(:) + fragments%Lspin(:)) - do concurrent(i = 1:nfrag) - rotmag = .mag. fragments%rot(:,i) - fragments%rot(:,i) = fragments%rot(:,i) + Lresidual(:) / (nfrag*fragments%mass(i) * fragments%radius(i)**2 * fragments%Ip(:,i)) + Lresidual(:) = fragments%L_budget(:) - (fragments%Lorbit_tot(:) + fragments%Lspin_tot(:)) + do concurrent(i = istart:nfrag) + vunit(:) = .unit. (Lresidual(:) .cross. fragments%r_unit(:,i)) + vshear(:) = vunit(:) * (.mag.Lresidual(:) / ((nfrag-istart+1)*fragments%mass(i) * fragments%rmag(i))) + fragments%vc(:,i) = fragments%vc(:,i) + vshear(:) end do + call fragments%get_angular_momentum() + Lresidual(:) = fragments%L_budget(:) - (fragments%Lorbit_tot(:) + fragments%Lspin_tot(:)) + do concurrent(i = istart:nfrag) + fragments%Lspin(:,i) = fragments%Lspin(:,i) + Lresidual(:) / (nfrag-istart+1) + fragments%rot(:,i) = fragments%Lspin(:,i) / (fragments%mass(i) * fragments%radius(i)**2 * fragments%Ip(:,i)) + end do + + call fragments%get_angular_momentum() + Lresidual(:) = fragments%L_budget(:) - (fragments%Lorbit_tot(:) + fragments%Lspin_tot(:)) + end do lfailure = ke_residual < 0.0_DP diff --git a/src/fraggle/fraggle_util.f90 b/src/fraggle/fraggle_util.f90 index 5e3997ab7..e59ed130b 100644 --- a/src/fraggle/fraggle_util.f90 +++ b/src/fraggle/fraggle_util.f90 @@ -229,12 +229,15 @@ module subroutine fraggle_util_set_natural_scale_factors(self) class(collision_fraggle), intent(inout) :: self !! Fraggle collision system object ! Internals integer(I4B) :: i + real(DP) :: vesc associate(collider => self, fragments => self%fragments, impactors => self%impactors) ! Set primary scale factors (mass, length, and time) based on the impactor properties at the time of collision - collider%mscale = fragments%mtot - collider%dscale = sum(impactors%radius(:)) - collider%tscale = collider%dscale / (.mag.(impactors%vc(:,2) - impactors%vc(:,1))) + collider%mscale = minval(fragments%mass(:)) + collider%dscale = minval(fragments%radius(:)) + + vesc = sqrt(2 * sum(impactors%Gmass(:)) / sum(impactors%radius(:))) + collider%tscale = collider%dscale / vesc ! Set secondary scale factors for convenience collider%vscale = collider%dscale / collider%tscale diff --git a/src/swiftest/swiftest_module.f90 b/src/swiftest/swiftest_module.f90 index a0ac7bc85..a492bdda6 100644 --- a/src/swiftest/swiftest_module.f90 +++ b/src/swiftest/swiftest_module.f90 @@ -211,7 +211,7 @@ module swiftest real(DP) :: dR = 0.0_DP !! Change in the radius of the central body contains procedure :: read_in => swiftest_io_read_in_cb !! Read in central body initial conditions from an ASCII file - procedure :: write_frame => swiftest_io_netcdf_write_frame_cb !! I/O routine for writing out a single frame of time-series data for all bodies in the nbody_system in NetCDF format + procedure :: write_frame => swiftest_io_netcdf_write_frame_cb !! I/O routine for writing out a single frame of time-series data for all bodies in the system in NetCDF format procedure :: write_info => swiftest_io_netcdf_write_info_cb !! Dump contents of particle information metadata to file end type swiftest_cb From 169a1b8fb377db0269f293880a5d2e8d74f93b6f Mon Sep 17 00:00:00 2001 From: David A Minton Date: Fri, 30 Dec 2022 23:29:55 -0500 Subject: [PATCH 551/569] Cleanup --- src/fraggle/fraggle_generate.f90 | 51 +++++++------------------------- 1 file changed, 10 insertions(+), 41 deletions(-) diff --git a/src/fraggle/fraggle_generate.f90 b/src/fraggle/fraggle_generate.f90 index 6b93500a5..987a07169 100644 --- a/src/fraggle/fraggle_generate.f90 +++ b/src/fraggle/fraggle_generate.f90 @@ -136,61 +136,30 @@ module subroutine fraggle_generate_disrupt(self, nbody_system, param, t, lfailur call fragments%reset() lfailure_local = .false. - try = 1 - write(message,*) try call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Fraggle try " // trim(adjustl(message))) - if (lfailure_local) then - call fragments%reset() - try = try + 1 - end if - lfailure_local = .false. ! Use the disruption collision model to generate initial conditions ! Compute the "before" energy/momentum and the budgets call self%get_energy_and_momentum(nbody_system, param, lbefore=.true.) call self%set_budgets() do try = 1, MAXTRY + write(message,*) try call fraggle_generate_pos_vec(self) call fraggle_generate_rot_vec(self) call fraggle_generate_vel_vec(self,lfailure_local) if (.not.lfailure_local) exit end do + call self%set_original_scale() - call self%get_energy_and_momentum(nbody_system, param, lbefore=.false.) - dEtot = self%Etot(2) - self%Etot(1) - dLmag = .mag. (self%Ltot(:,2) - self%Ltot(:,1)) - - lfailure_local = (dEtot > -impactors%Qloss) - if (lfailure_local) then - write(message, *) "dEtot: ",dEtot, "dEtot/Qloss", dEtot / impactors%Qloss - call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Fraggle failed due to energy gain: " // & - trim(adjustl(message))) - end if - - lfailure_local = ((abs(dLmag) / (.mag.self%Ltot(:,1))) > FRAGGLE_LTOL) - if (lfailure_local) then - write(message,*) dLmag / (.mag.self%Ltot(:,1)) - call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Fraggle failed due to high angular momentum error: " // & - trim(adjustl(message))) - end if - - ! Check if any of the usual floating point exceptions happened, and fail the try if so - call ieee_get_flag(ieee_usual, fpe_flag) - lfailure_local = any(fpe_flag) - write(message,*) "Fraggle failed due to a floating point exception: ", fpe_flag - call swiftest_io_log_one_message(COLLISION_LOG_OUT, message) - - write(message,*) try if (lfailure_local) then call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Fraggle fragment generation failed after " // & - trim(adjustl(message)) // " tries") + trim(adjustl(message)) // " tries. This collision may have gained energy.") else call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Fraggle fragment generation succeeded after " // & trim(adjustl(message)) // " tries") end if - call self%set_original_scale() ! Restore the big array if (lk_plpl) call pl%flatten(param) @@ -309,8 +278,8 @@ module subroutine fraggle_generate_pos_vec(collider) loverlap(:) = .true. do loop = 1, MAXLOOP if (.not.any(loverlap(:))) exit - fragment_cloud_center(:,1) = impactors%rc(:,1) + rdistance * impactors%bounce_unit(:) - fragment_cloud_center(:,2) = impactors%rc(:,2) - rdistance * impactors%bounce_unit(:) + fragment_cloud_center(:,1) = impactors%rc(:,1) !+ rdistance * impactors%bounce_unit(:) + fragment_cloud_center(:,2) = impactors%rc(:,2) !- rdistance * impactors%bounce_unit(:) do concurrent(i = 1:nfrag, loverlap(i)) if (i < 3) then fragments%rc(:,i) = fragment_cloud_center(:,i) @@ -420,8 +389,8 @@ module subroutine fraggle_generate_vel_vec(collider, lfailure) real(DP) :: vmag, vesc, rotmag, ke_residual, ke_per_dof, ke_tot integer(I4B), dimension(collider%fragments%nbody) :: vsign real(DP), dimension(collider%fragments%nbody) :: vscale, mass_vscale, ke_avail - integer(I4B), parameter :: MAXLOOP = 1000 - real(DP), parameter :: TOL = 1e-4 + integer(I4B), parameter :: MAXLOOP = 100 + real(DP), parameter :: TOL = 1e-2 associate(fragments => collider%fragments, impactors => collider%impactors, nfrag => collider%fragments%nbody) lhitandrun = (impactors%regime == COLLRESOLVE_REGIME_HIT_AND_RUN) @@ -485,7 +454,7 @@ module subroutine fraggle_generate_vel_vec(collider, lfailure) call collider%set_coordinate_system() call fragments%get_kinetic_energy() ke_residual = fragments%ke_budget - (fragments%ke_orbit_tot + fragments%ke_spin_tot) - if ((ke_residual > 0.0_DP).and.(ke_residual <= fragments%ke_budget * TOL)) exit + if (ke_residual > 0.0_DP) exit ! Make sure we don't take away too much orbital kinetic energy, otherwise the fragment can't escape ke_avail(:) = fragments%ke_orbit(:) - impactors%Gmass(1)*impactors%mass(2)/fragments%rmag(:) ke_tot = 0.0_DP @@ -527,8 +496,8 @@ module subroutine fraggle_generate_vel_vec(collider, lfailure) end do call fragments%get_angular_momentum() Lresidual(:) = fragments%L_budget(:) - (fragments%Lorbit_tot(:) + fragments%Lspin_tot(:)) - do concurrent(i = istart:nfrag) - fragments%Lspin(:,i) = fragments%Lspin(:,i) + Lresidual(:) / (nfrag-istart+1) + do concurrent(i = 1:nfrag) + fragments%Lspin(:,i) = fragments%Lspin(:,i) + Lresidual(:) / nfrag fragments%rot(:,i) = fragments%Lspin(:,i) / (fragments%mass(i) * fragments%radius(i)**2 * fragments%Ip(:,i)) end do From 5c521838141717c0aa852336a5e74233f5e08995 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Fri, 30 Dec 2022 23:46:49 -0500 Subject: [PATCH 552/569] Trying a new technique to achieve better convergence on tricky off-axis cases --- src/fraggle/fraggle_generate.f90 | 18 ++++++++---------- src/fraggle/fraggle_module.f90 | 1 + 2 files changed, 9 insertions(+), 10 deletions(-) diff --git a/src/fraggle/fraggle_generate.f90 b/src/fraggle/fraggle_generate.f90 index 987a07169..8203ee543 100644 --- a/src/fraggle/fraggle_generate.f90 +++ b/src/fraggle/fraggle_generate.f90 @@ -11,8 +11,6 @@ use swiftest use symba - real(DP), parameter :: FRAGGLE_LTOL = 1e-4_DP !10 * epsilon(1.0_DP) - real(DP), parameter :: FRAGGLE_ETOL = 1e-12_DP contains @@ -99,12 +97,11 @@ module subroutine fraggle_generate_disrupt(self, nbody_system, param, t, lfailur logical, optional, intent(out) :: lfailure !! Answers the question: Should this have been a merger instead? ! Internals integer(I4B) :: try - real(DP) :: dEtot, dLmag integer(I4B), parameter :: MAXTRY = 100 logical :: lk_plpl, lfailure_local logical, dimension(size(IEEE_ALL)) :: fpe_halting_modes, fpe_quiet_modes - logical, dimension(size(IEEE_USUAL)) :: fpe_flag character(len=STRMAX) :: message + real(DP), parameter :: fail_scale_start = 1.0001_DP ! The minimization and linear solvers can sometimes lead to floating point exceptions. Rather than halting the code entirely if this occurs, we ! can simply fail the attempt and try again. So we need to turn off any floating point exception halting modes temporarily @@ -143,12 +140,14 @@ module subroutine fraggle_generate_disrupt(self, nbody_system, param, t, lfailur ! Compute the "before" energy/momentum and the budgets call self%get_energy_and_momentum(nbody_system, param, lbefore=.true.) call self%set_budgets() + self%fail_scale = fail_scale_start do try = 1, MAXTRY write(message,*) try call fraggle_generate_pos_vec(self) call fraggle_generate_rot_vec(self) call fraggle_generate_vel_vec(self,lfailure_local) if (.not.lfailure_local) exit + self%fail_scale = self%fail_scale**2 end do call self%set_original_scale() @@ -261,7 +260,6 @@ module subroutine fraggle_generate_pos_vec(collider) logical :: lcat, lhitandrun integer(I4B), parameter :: MAXLOOP = 10000 real(DP) :: rdistance - real(DP), parameter :: fail_scale = 1.001_DP ! Scale factor to apply to cloud radius and distance if cloud generation fails associate(fragments => collider%fragments, impactors => collider%impactors, nfrag => collider%fragments%nbody) @@ -278,8 +276,8 @@ module subroutine fraggle_generate_pos_vec(collider) loverlap(:) = .true. do loop = 1, MAXLOOP if (.not.any(loverlap(:))) exit - fragment_cloud_center(:,1) = impactors%rc(:,1) !+ rdistance * impactors%bounce_unit(:) - fragment_cloud_center(:,2) = impactors%rc(:,2) !- rdistance * impactors%bounce_unit(:) + fragment_cloud_center(:,1) = impactors%rc(:,1) + rdistance * impactors%bounce_unit(:) + fragment_cloud_center(:,2) = impactors%rc(:,2) - rdistance * impactors%bounce_unit(:) do concurrent(i = 1:nfrag, loverlap(i)) if (i < 3) then fragments%rc(:,i) = fragment_cloud_center(:,i) @@ -308,8 +306,8 @@ module subroutine fraggle_generate_pos_vec(collider) loverlap(i) = loverlap(i) .or. (dis <= (fragments%radius(i) + fragments%radius(j))) end do end do - rdistance = rdistance * fail_scale - fragment_cloud_radius(:) = fragment_cloud_radius(:) * fail_scale + rdistance = rdistance * collider%fail_scale + fragment_cloud_radius(:) = fragment_cloud_radius(:) * collider%fail_scale end do call collision_util_shift_vector_to_origin(fragments%mass, fragments%rc) @@ -389,7 +387,7 @@ module subroutine fraggle_generate_vel_vec(collider, lfailure) real(DP) :: vmag, vesc, rotmag, ke_residual, ke_per_dof, ke_tot integer(I4B), dimension(collider%fragments%nbody) :: vsign real(DP), dimension(collider%fragments%nbody) :: vscale, mass_vscale, ke_avail - integer(I4B), parameter :: MAXLOOP = 100 + integer(I4B), parameter :: MAXLOOP = 1000 real(DP), parameter :: TOL = 1e-2 associate(fragments => collider%fragments, impactors => collider%impactors, nfrag => collider%fragments%nbody) diff --git a/src/fraggle/fraggle_module.f90 b/src/fraggle/fraggle_module.f90 index 9022a0a0c..01014fff5 100644 --- a/src/fraggle/fraggle_module.f90 +++ b/src/fraggle/fraggle_module.f90 @@ -32,6 +32,7 @@ module fraggle real(DP) :: vscale = 1.0_DP !! Velocity scale factor (a convenience unit that is derived from dscale and tscale) real(DP) :: Escale = 1.0_DP !! Energy scale factor (a convenience unit that is derived from dscale, tscale, and mscale) real(DP) :: Lscale = 1.0_DP !! Angular momentum scale factor (a convenience unit that is derived from dscale, tscale, and mscale) + real(DP) :: fail_scale = 1.0001_DP !! A multiplier on the position vector function that gets larger every time there is a failure. This can help get the energy & momentum constraints solved on tricky off-axis cases contains procedure :: disrupt => fraggle_generate_disrupt !! Generates a system of fragments in barycentric coordinates that conserves energy and momentum. procedure :: generate => fraggle_generate !! A simple disruption models that does not constrain energy loss in collisions From 6605eb55a32aee1f3b3e661542a81bc7abff2c87 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Sat, 31 Dec 2022 06:41:03 -0500 Subject: [PATCH 553/569] Revert "Trying a new technique to achieve better convergence on tricky off-axis cases" This reverts commit 5c521838141717c0aa852336a5e74233f5e08995. --- src/fraggle/fraggle_generate.f90 | 18 ++++++++++-------- src/fraggle/fraggle_module.f90 | 1 - 2 files changed, 10 insertions(+), 9 deletions(-) diff --git a/src/fraggle/fraggle_generate.f90 b/src/fraggle/fraggle_generate.f90 index 8203ee543..987a07169 100644 --- a/src/fraggle/fraggle_generate.f90 +++ b/src/fraggle/fraggle_generate.f90 @@ -11,6 +11,8 @@ use swiftest use symba + real(DP), parameter :: FRAGGLE_LTOL = 1e-4_DP !10 * epsilon(1.0_DP) + real(DP), parameter :: FRAGGLE_ETOL = 1e-12_DP contains @@ -97,11 +99,12 @@ module subroutine fraggle_generate_disrupt(self, nbody_system, param, t, lfailur logical, optional, intent(out) :: lfailure !! Answers the question: Should this have been a merger instead? ! Internals integer(I4B) :: try + real(DP) :: dEtot, dLmag integer(I4B), parameter :: MAXTRY = 100 logical :: lk_plpl, lfailure_local logical, dimension(size(IEEE_ALL)) :: fpe_halting_modes, fpe_quiet_modes + logical, dimension(size(IEEE_USUAL)) :: fpe_flag character(len=STRMAX) :: message - real(DP), parameter :: fail_scale_start = 1.0001_DP ! The minimization and linear solvers can sometimes lead to floating point exceptions. Rather than halting the code entirely if this occurs, we ! can simply fail the attempt and try again. So we need to turn off any floating point exception halting modes temporarily @@ -140,14 +143,12 @@ module subroutine fraggle_generate_disrupt(self, nbody_system, param, t, lfailur ! Compute the "before" energy/momentum and the budgets call self%get_energy_and_momentum(nbody_system, param, lbefore=.true.) call self%set_budgets() - self%fail_scale = fail_scale_start do try = 1, MAXTRY write(message,*) try call fraggle_generate_pos_vec(self) call fraggle_generate_rot_vec(self) call fraggle_generate_vel_vec(self,lfailure_local) if (.not.lfailure_local) exit - self%fail_scale = self%fail_scale**2 end do call self%set_original_scale() @@ -260,6 +261,7 @@ module subroutine fraggle_generate_pos_vec(collider) logical :: lcat, lhitandrun integer(I4B), parameter :: MAXLOOP = 10000 real(DP) :: rdistance + real(DP), parameter :: fail_scale = 1.001_DP ! Scale factor to apply to cloud radius and distance if cloud generation fails associate(fragments => collider%fragments, impactors => collider%impactors, nfrag => collider%fragments%nbody) @@ -276,8 +278,8 @@ module subroutine fraggle_generate_pos_vec(collider) loverlap(:) = .true. do loop = 1, MAXLOOP if (.not.any(loverlap(:))) exit - fragment_cloud_center(:,1) = impactors%rc(:,1) + rdistance * impactors%bounce_unit(:) - fragment_cloud_center(:,2) = impactors%rc(:,2) - rdistance * impactors%bounce_unit(:) + fragment_cloud_center(:,1) = impactors%rc(:,1) !+ rdistance * impactors%bounce_unit(:) + fragment_cloud_center(:,2) = impactors%rc(:,2) !- rdistance * impactors%bounce_unit(:) do concurrent(i = 1:nfrag, loverlap(i)) if (i < 3) then fragments%rc(:,i) = fragment_cloud_center(:,i) @@ -306,8 +308,8 @@ module subroutine fraggle_generate_pos_vec(collider) loverlap(i) = loverlap(i) .or. (dis <= (fragments%radius(i) + fragments%radius(j))) end do end do - rdistance = rdistance * collider%fail_scale - fragment_cloud_radius(:) = fragment_cloud_radius(:) * collider%fail_scale + rdistance = rdistance * fail_scale + fragment_cloud_radius(:) = fragment_cloud_radius(:) * fail_scale end do call collision_util_shift_vector_to_origin(fragments%mass, fragments%rc) @@ -387,7 +389,7 @@ module subroutine fraggle_generate_vel_vec(collider, lfailure) real(DP) :: vmag, vesc, rotmag, ke_residual, ke_per_dof, ke_tot integer(I4B), dimension(collider%fragments%nbody) :: vsign real(DP), dimension(collider%fragments%nbody) :: vscale, mass_vscale, ke_avail - integer(I4B), parameter :: MAXLOOP = 1000 + integer(I4B), parameter :: MAXLOOP = 100 real(DP), parameter :: TOL = 1e-2 associate(fragments => collider%fragments, impactors => collider%impactors, nfrag => collider%fragments%nbody) diff --git a/src/fraggle/fraggle_module.f90 b/src/fraggle/fraggle_module.f90 index 01014fff5..9022a0a0c 100644 --- a/src/fraggle/fraggle_module.f90 +++ b/src/fraggle/fraggle_module.f90 @@ -32,7 +32,6 @@ module fraggle real(DP) :: vscale = 1.0_DP !! Velocity scale factor (a convenience unit that is derived from dscale and tscale) real(DP) :: Escale = 1.0_DP !! Energy scale factor (a convenience unit that is derived from dscale, tscale, and mscale) real(DP) :: Lscale = 1.0_DP !! Angular momentum scale factor (a convenience unit that is derived from dscale, tscale, and mscale) - real(DP) :: fail_scale = 1.0001_DP !! A multiplier on the position vector function that gets larger every time there is a failure. This can help get the energy & momentum constraints solved on tricky off-axis cases contains procedure :: disrupt => fraggle_generate_disrupt !! Generates a system of fragments in barycentric coordinates that conserves energy and momentum. procedure :: generate => fraggle_generate !! A simple disruption models that does not constrain energy loss in collisions From f281125eeaa08b76dae8f6167df3ab2c471da2ab Mon Sep 17 00:00:00 2001 From: David A Minton Date: Sat, 31 Dec 2022 06:43:59 -0500 Subject: [PATCH 554/569] Cleaned up some cruft --- src/fraggle/fraggle_generate.f90 | 7 ------- 1 file changed, 7 deletions(-) diff --git a/src/fraggle/fraggle_generate.f90 b/src/fraggle/fraggle_generate.f90 index 987a07169..a534b988f 100644 --- a/src/fraggle/fraggle_generate.f90 +++ b/src/fraggle/fraggle_generate.f90 @@ -11,9 +11,6 @@ use swiftest use symba - real(DP), parameter :: FRAGGLE_LTOL = 1e-4_DP !10 * epsilon(1.0_DP) - real(DP), parameter :: FRAGGLE_ETOL = 1e-12_DP - contains module subroutine fraggle_generate(self, nbody_system, param, t) @@ -36,8 +33,6 @@ module subroutine fraggle_generate(self, nbody_system, param, t) select type(pl => nbody_system%pl) class is (swiftest_pl) associate(impactors => self%impactors, status => self%status) - - select case (impactors%regime) case (COLLRESOLVE_REGIME_HIT_AND_RUN) call self%hitandrun(nbody_system, param, t) @@ -99,11 +94,9 @@ module subroutine fraggle_generate_disrupt(self, nbody_system, param, t, lfailur logical, optional, intent(out) :: lfailure !! Answers the question: Should this have been a merger instead? ! Internals integer(I4B) :: try - real(DP) :: dEtot, dLmag integer(I4B), parameter :: MAXTRY = 100 logical :: lk_plpl, lfailure_local logical, dimension(size(IEEE_ALL)) :: fpe_halting_modes, fpe_quiet_modes - logical, dimension(size(IEEE_USUAL)) :: fpe_flag character(len=STRMAX) :: message ! The minimization and linear solvers can sometimes lead to floating point exceptions. Rather than halting the code entirely if this occurs, we From 6adca2b93acfafb1092b61760c3af73b3120afb2 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Sat, 31 Dec 2022 06:51:14 -0500 Subject: [PATCH 555/569] Improved the fail_scale method --- src/fraggle/fraggle_generate.f90 | 8 ++++---- src/fraggle/fraggle_module.f90 | 7 ++++--- 2 files changed, 8 insertions(+), 7 deletions(-) diff --git a/src/fraggle/fraggle_generate.f90 b/src/fraggle/fraggle_generate.f90 index a534b988f..aa14c8bd2 100644 --- a/src/fraggle/fraggle_generate.f90 +++ b/src/fraggle/fraggle_generate.f90 @@ -98,6 +98,7 @@ module subroutine fraggle_generate_disrupt(self, nbody_system, param, t, lfailur logical :: lk_plpl, lfailure_local logical, dimension(size(IEEE_ALL)) :: fpe_halting_modes, fpe_quiet_modes character(len=STRMAX) :: message + real(DP), parameter :: fail_scale_initial = 1.001_DP ! The minimization and linear solvers can sometimes lead to floating point exceptions. Rather than halting the code entirely if this occurs, we ! can simply fail the attempt and try again. So we need to turn off any floating point exception halting modes temporarily @@ -137,6 +138,7 @@ module subroutine fraggle_generate_disrupt(self, nbody_system, param, t, lfailur call self%get_energy_and_momentum(nbody_system, param, lbefore=.true.) call self%set_budgets() do try = 1, MAXTRY + self%fail_scale = (fail_scale_initial)**try write(message,*) try call fraggle_generate_pos_vec(self) call fraggle_generate_rot_vec(self) @@ -254,8 +256,6 @@ module subroutine fraggle_generate_pos_vec(collider) logical :: lcat, lhitandrun integer(I4B), parameter :: MAXLOOP = 10000 real(DP) :: rdistance - real(DP), parameter :: fail_scale = 1.001_DP ! Scale factor to apply to cloud radius and distance if cloud generation fails - associate(fragments => collider%fragments, impactors => collider%impactors, nfrag => collider%fragments%nbody) lcat = (impactors%regime == COLLRESOLVE_REGIME_SUPERCATASTROPHIC) @@ -301,8 +301,8 @@ module subroutine fraggle_generate_pos_vec(collider) loverlap(i) = loverlap(i) .or. (dis <= (fragments%radius(i) + fragments%radius(j))) end do end do - rdistance = rdistance * fail_scale - fragment_cloud_radius(:) = fragment_cloud_radius(:) * fail_scale + rdistance = rdistance * collider%fail_scale + fragment_cloud_radius(:) = fragment_cloud_radius(:) * collider%fail_scale end do call collision_util_shift_vector_to_origin(fragments%mass, fragments%rc) diff --git a/src/fraggle/fraggle_module.f90 b/src/fraggle/fraggle_module.f90 index 9022a0a0c..b50aa3ac3 100644 --- a/src/fraggle/fraggle_module.f90 +++ b/src/fraggle/fraggle_module.f90 @@ -19,8 +19,8 @@ module fraggle type, extends(collision_fragments) :: fraggle_fragments contains - procedure :: reset => fraggle_util_reset_fragments !! Resets all position and velocity-dependent fragment quantities in order to do a fresh calculation (does not reset mass, radius, or other values that get set prior to the call to fraggle_generate) - final :: fraggle_final_fragments !! Finalizer will deallocate all allocatables + procedure :: reset => fraggle_util_reset_fragments !! Resets all position and velocity-dependent fragment quantities in order to do a fresh calculation (does not reset mass, radius, or other values that get set prior to the call to fraggle_generate) + final :: fraggle_final_fragments !! Finalizer will deallocate all allocatables end type fraggle_fragments @@ -31,7 +31,8 @@ module fraggle real(DP) :: tscale = 1.0_DP !! Time scale factor real(DP) :: vscale = 1.0_DP !! Velocity scale factor (a convenience unit that is derived from dscale and tscale) real(DP) :: Escale = 1.0_DP !! Energy scale factor (a convenience unit that is derived from dscale, tscale, and mscale) - real(DP) :: Lscale = 1.0_DP !! Angular momentum scale factor (a convenience unit that is derived from dscale, tscale, and mscale) + real(DP) :: Lscale = 1.0_DP !! Angular momentum scale factor (a convenience unit that is derived from dscale, tscale, and mscale) + real(DP) :: fail_scale !! Scale factor to apply to distance values in the position model when overlaps occur. contains procedure :: disrupt => fraggle_generate_disrupt !! Generates a system of fragments in barycentric coordinates that conserves energy and momentum. procedure :: generate => fraggle_generate !! A simple disruption models that does not constrain energy loss in collisions From af0a15ee9f7440f77b4a65eddca89b60ea5f0593 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Sat, 31 Dec 2022 08:39:57 -0500 Subject: [PATCH 556/569] Fixed bug causing encounter history frames to not be stored properly --- examples/Fragmentation/Fragmentation_Movie.py | 2 +- python/swiftest/swiftest/simulation_class.py | 3 ++ src/collision/collision_check.f90 | 4 +-- src/encounter/encounter_io.f90 | 6 ++-- src/encounter/encounter_util.f90 | 3 -- src/fraggle/fraggle_generate.f90 | 18 +++++------- src/symba/symba_step.f90 | 28 +++++++++---------- 7 files changed, 28 insertions(+), 36 deletions(-) diff --git a/examples/Fragmentation/Fragmentation_Movie.py b/examples/Fragmentation/Fragmentation_Movie.py index 807f22419..6932223a8 100644 --- a/examples/Fragmentation/Fragmentation_Movie.py +++ b/examples/Fragmentation/Fragmentation_Movie.py @@ -127,7 +127,7 @@ def encounter_combiner(sim): ds = xr.combine_nested([data,enc],concat_dim='time').sortby("time").interpolate_na(dim="time") # Interpolate in time to make a smooth, constant time step dataset - smooth_time = np.linspace(start=tgood.isel(time=0), stop=tgood.isel(time=-1), num=2400) + smooth_time = np.linspace(start=tgood.isel(time=0), stop=ds.time[-1], num=2400) ds = ds.interp(time=smooth_time) return ds diff --git a/python/swiftest/swiftest/simulation_class.py b/python/swiftest/swiftest/simulation_class.py index e66848183..e4fa80049 100644 --- a/python/swiftest/swiftest/simulation_class.py +++ b/python/swiftest/swiftest/simulation_class.py @@ -2775,6 +2775,9 @@ def _preprocess(ds, param): # Remove any overlapping time values tgood,tid = np.unique(self.encounters.time,return_index=True) self.encounters = self.encounters.isel(time=tid) + # Remove any NaN values + tgood=self.encounters.time.where(~np.isnan(self.encounters.time),drop=True) + self.encounters = self.encounters.sel(time=tgood) return diff --git a/src/collision/collision_check.f90 b/src/collision/collision_check.f90 index eb5c26f8d..1f88c98aa 100644 --- a/src/collision/collision_check.f90 +++ b/src/collision/collision_check.f90 @@ -79,9 +79,7 @@ module subroutine collision_check_plpl(self, nbody_system, param, t, dt, irec, l real(DP), dimension(NDIM) :: xr, vr integer(I4B) :: i, j, k, nenc real(DP) :: rlim, Gmtot - logical :: isplpl, lany_closest - character(len=STRMAX) :: timestr, idstri, idstrj, message - class(collision_list_plpl), allocatable :: tmp + logical :: lany_closest lany_collision = .false. if (self%nenc == 0) return diff --git a/src/encounter/encounter_io.f90 b/src/encounter/encounter_io.f90 index ce49e0cbd..cba31cfb8 100644 --- a/src/encounter/encounter_io.f90 +++ b/src/encounter/encounter_io.f90 @@ -17,8 +17,8 @@ module subroutine encounter_io_netcdf_dump(self, param) !! Dumps the time history of an encounter to file. implicit none ! Arguments - class(encounter_storage(*)), intent(inout) :: self !! Encounter storage object - class(base_parameters), intent(inout) :: param !! Current run configuration parameters + class(encounter_storage(*)), intent(inout) :: self !! Encounter storage object + class(base_parameters), intent(inout) :: param !! Current run configuration parameters ! Internals integer(I4B) :: i @@ -33,7 +33,7 @@ module subroutine encounter_io_netcdf_dump(self, param) write(nc%file_name, '("encounter_",I0.6,".nc")') nc%file_number call nc%initialize(param) - do i = 1, self%nframes + do i = 1, self%iframe if (allocated(self%frame(i)%item)) then select type(snapshot => self%frame(i)%item) class is (encounter_snapshot) diff --git a/src/encounter/encounter_util.f90 b/src/encounter/encounter_util.f90 index 45e6f48fb..0377c290c 100644 --- a/src/encounter/encounter_util.f90 +++ b/src/encounter/encounter_util.f90 @@ -332,8 +332,6 @@ module subroutine encounter_util_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 call self%dealloc() @@ -450,7 +448,6 @@ subroutine encounter_util_save_snapshot(encounter_history, snapshot) end do deallocate(encounter_history) call move_alloc(tmp,encounter_history) - nnew = nbig end if ! Find out which time slot this belongs in by searching for an existing slot diff --git a/src/fraggle/fraggle_generate.f90 b/src/fraggle/fraggle_generate.f90 index aa14c8bd2..f00080f6b 100644 --- a/src/fraggle/fraggle_generate.f90 +++ b/src/fraggle/fraggle_generate.f90 @@ -131,7 +131,6 @@ module subroutine fraggle_generate_disrupt(self, nbody_system, param, t, lfailur lfailure_local = .false. - call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Fraggle try " // trim(adjustl(message))) ! Use the disruption collision model to generate initial conditions ! Compute the "before" energy/momentum and the budgets @@ -140,6 +139,7 @@ module subroutine fraggle_generate_disrupt(self, nbody_system, param, t, lfailur do try = 1, MAXTRY self%fail_scale = (fail_scale_initial)**try write(message,*) try + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Fraggle try " // trim(adjustl(message))) call fraggle_generate_pos_vec(self) call fraggle_generate_rot_vec(self) call fraggle_generate_vel_vec(self,lfailure_local) @@ -187,7 +187,6 @@ module subroutine fraggle_generate_hitandrun(self, nbody_system, param, t) logical :: lpure character(len=STRMAX) :: message - select type(nbody_system) class is (swiftest_nbody_system) select type(pl => nbody_system%pl) @@ -250,12 +249,12 @@ module subroutine fraggle_generate_pos_vec(collider) ! Internals real(DP) :: dis real(DP), dimension(NDIM,2) :: fragment_cloud_center - real(DP), dimension(2) :: fragment_cloud_radius + real(DP), dimension(2) :: fragment_cloud_radius, rdistance logical, dimension(collider%fragments%nbody) :: loverlap integer(I4B) :: i, j, loop logical :: lcat, lhitandrun integer(I4B), parameter :: MAXLOOP = 10000 - real(DP) :: rdistance + real(DP), parameter :: rdistance_scale_factor = 0.01_DP ! Scale factor to apply to distance scaling in the event of a fail associate(fragments => collider%fragments, impactors => collider%impactors, nfrag => collider%fragments%nbody) lcat = (impactors%regime == COLLRESOLVE_REGIME_SUPERCATASTROPHIC) @@ -263,16 +262,13 @@ module subroutine fraggle_generate_pos_vec(collider) ! We will treat the first two fragments of the list as special cases. ! Place the first two bodies at the centers of the two fragment clouds, but be sure they are sufficiently far apart to avoid overlap - rdistance = .mag. (impactors%rc(:,2) - impactors%rc(:,1)) - sum(fragments%radius(1:2)) - rdistance = 0.5_DP*rdistance - fragment_cloud_radius(:) = impactors%radius(:) - loverlap(:) = .true. + rdistance(:) = rdistance_scale_factor * .mag.impactors%vc(:,:) do loop = 1, MAXLOOP if (.not.any(loverlap(:))) exit - fragment_cloud_center(:,1) = impactors%rc(:,1) !+ rdistance * impactors%bounce_unit(:) - fragment_cloud_center(:,2) = impactors%rc(:,2) !- rdistance * impactors%bounce_unit(:) + fragment_cloud_center(:,1) = impactors%rc(:,1) - rdistance(1) * impactors%bounce_unit(:) + fragment_cloud_center(:,2) = impactors%rc(:,2) + rdistance(2) * impactors%bounce_unit(:) do concurrent(i = 1:nfrag, loverlap(i)) if (i < 3) then fragments%rc(:,i) = fragment_cloud_center(:,i) @@ -301,7 +297,7 @@ module subroutine fraggle_generate_pos_vec(collider) loverlap(i) = loverlap(i) .or. (dis <= (fragments%radius(i) + fragments%radius(j))) end do end do - rdistance = rdistance * collider%fail_scale + rdistance(:) = rdistance(:) * collider%fail_scale fragment_cloud_radius(:) = fragment_cloud_radius(:) * collider%fail_scale end do diff --git a/src/symba/symba_step.f90 b/src/symba/symba_step.f90 index 8d641485e..fcbb734fd 100644 --- a/src/symba/symba_step.f90 +++ b/src/symba/symba_step.f90 @@ -34,19 +34,17 @@ module subroutine symba_step_system(self, param, t, dt) class is (symba_tp) select type(param) class is (swiftest_parameters) - associate(encounter_history => self%encounter_history) - call self%reset(param) - lencounter = pl%encounter_check(param, self, dt, 0) .or. tp%encounter_check(param, self, dt, 0) - if (lencounter) then - if (param%lenc_save_trajectory) call encounter_history%take_snapshot(param, self, t, "trajectory") - call self%interp(param, t, dt) - if (param%lenc_save_trajectory) call encounter_history%take_snapshot(param, self, t+dt, "trajectory") - else - self%irec = -1 - call helio_step_system(self, param, t, dt) - end if - param%lfirstkick = pl%lfirst - end associate + call self%reset(param) + lencounter = pl%encounter_check(param, self, dt, 0) .or. tp%encounter_check(param, self, dt, 0) + if (lencounter) then + if (param%lenc_save_trajectory) call self%encounter_history%take_snapshot(param, self, t, "trajectory") + call self%interp(param, t, dt) + if (param%lenc_save_trajectory) call self%encounter_history%take_snapshot(param, self, t+dt, "trajectory") + else + self%irec = -1 + call helio_step_system(self, param, t, dt) + end if + param%lfirstkick = pl%lfirst end select end select end select @@ -192,7 +190,7 @@ recursive module subroutine symba_step_recur_system(self, param, t, ireci) class is (symba_list_plpl) select type(pltp_encounter => self%pltp_encounter) class is (symba_list_pltp) - associate(nbody_system => self, lplpl_collision => plpl_encounter%lcollision, lpltp_collision => pltp_encounter%lcollision, encounter_history => self%encounter_history) + associate(nbody_system => self, lplpl_collision => plpl_encounter%lcollision, lpltp_collision => pltp_encounter%lcollision) nbody_system%irec = ireci dtl = param%dt / (NTENC**ireci) dth = 0.5_DP * dtl @@ -249,7 +247,7 @@ recursive module subroutine symba_step_recur_system(self, param, t, ireci) if (lplpl_collision) call plpl_encounter%resolve_collision(nbody_system, param, t+j*dtl, dtl, ireci) if (lpltp_collision) call pltp_encounter%resolve_collision(nbody_system, param, t+j*dtl, dtl, ireci) end if - if (param%lenc_save_trajectory) call encounter_history%take_snapshot(param, self, t+j*dtl, "trajectory") + if (param%lenc_save_trajectory) call self%encounter_history%take_snapshot(param, self, t+j*dtl, "trajectory") call self%set_recur_levels(ireci) From f1fa891bc4c38d02f00c8158d2572d3158d50e1c Mon Sep 17 00:00:00 2001 From: David A Minton Date: Sat, 31 Dec 2022 09:31:02 -0500 Subject: [PATCH 557/569] Made a number of changes to improve the robustness of Fraggle --- src/collision/collision_module.f90 | 16 ++++++---- src/collision/collision_util.f90 | 23 ++++++++++++-- src/fraggle/fraggle_generate.f90 | 49 ++++++++++++++++-------------- 3 files changed, 57 insertions(+), 31 deletions(-) diff --git a/src/collision/collision_module.f90 b/src/collision/collision_module.f90 index 23a0d20b4..fed0191b4 100644 --- a/src/collision/collision_module.f90 +++ b/src/collision/collision_module.f90 @@ -122,10 +122,11 @@ module collision real(DP), dimension(nbody) :: ke_orbit !! Orbital kinetic energy of each individual fragment real(DP), dimension(nbody) :: ke_spin !! Spin kinetic energy of each individual fragment contains - procedure :: reset => collision_util_reset_fragments !! Deallocates all allocatable arrays and sets everything else to 0 - procedure :: get_angular_momentum => collision_util_get_angular_momentum !! Calcualtes the current angular momentum of the fragments - procedure :: get_kinetic_energy => collision_util_get_kinetic_energy !! Calcualtes the current kinetic energy of the fragments - final :: collision_final_fragments !! Finalizer deallocates all allocatables + procedure :: reset => collision_util_reset_fragments !! Deallocates all allocatable arrays and sets everything else to 0 + procedure :: get_angular_momentum => collision_util_get_angular_momentum !! Calcualtes the current angular momentum of the fragments + procedure :: get_kinetic_energy => collision_util_get_kinetic_energy !! Calcualtes the current kinetic energy of the fragments + procedure :: set_coordinate_system => collision_util_set_coordinate_fragments !! Sets the coordinate system of the fragments + final :: collision_final_fragments !! Finalizer deallocates all allocatables end type collision_fragments @@ -231,7 +232,6 @@ module subroutine collision_generate_bounce(self, nbody_system, param, t) real(DP), intent(in) :: t !! The time of the collision end subroutine collision_generate_bounce - module subroutine collision_generate_hitandrun(self, nbody_system, param, t) implicit none class(collision_basic), intent(inout) :: self @@ -247,7 +247,6 @@ module subroutine collision_generate_merge(self, nbody_system, param, t) class(base_parameters), intent(inout) :: param !! Current run configuration parameters real(DP), intent(in) :: t !! The time of the collision end subroutine collision_generate_merge - module subroutine collision_io_collider_message(pl, collidx, collider_message) implicit none @@ -406,6 +405,11 @@ module subroutine collision_util_set_coordinate_collider(self) class(collision_basic), intent(inout) :: self !! collisional system end subroutine collision_util_set_coordinate_collider + module subroutine collision_util_set_coordinate_fragments(self) + implicit none + class(collision_fragments(*)), intent(inout) :: self !! Collisional nbody_system + end subroutine collision_util_set_coordinate_fragments + module subroutine collision_util_set_coordinate_impactors(self) implicit none class(collision_impactors), intent(inout) :: self !! collisional system diff --git a/src/collision/collision_util.f90 b/src/collision/collision_util.f90 index 2878f95ec..3659bbc63 100644 --- a/src/collision/collision_util.f90 +++ b/src/collision/collision_util.f90 @@ -449,22 +449,39 @@ module subroutine collision_util_set_coordinate_collider(self) call impactors%set_coordinate_system() if (.not.allocated(self%fragments)) return + call fragments%set_coordinate_system() + + + end associate + + return + end subroutine collision_util_set_coordinate_collider + + + module subroutine collision_util_set_coordinate_fragments(self) + !! author: David A. Minton + !! + !! Defines the collisional coordinate nbody_system, including the unit vectors of both the nbody_system and individual fragments. + implicit none + ! Arguments + class(collision_fragments(*)), intent(inout) :: self !! Collisional nbody_system + + associate(fragments => self, nfrag => self%nbody) if ((nfrag == 0) .or. (.not.any(fragments%rc(:,:) > 0.0_DP))) return fragments%rmag(:) = .mag. fragments%rc(:,:) fragments%vmag(:) = .mag. fragments%vc(:,:) fragments%rotmag(:) = .mag. fragments%rot(:,:) - + ! Define the radial, normal, and tangential unit vectors for each individual fragment fragments%r_unit(:,:) = .unit. fragments%rc(:,:) fragments%v_unit(:,:) = .unit. fragments%vc(:,:) fragments%n_unit(:,:) = .unit. (fragments%rc(:,:) .cross. fragments%vc(:,:)) fragments%t_unit(:,:) = -.unit. (fragments%r_unit(:,:) .cross. fragments%n_unit(:,:)) - end associate return - end subroutine collision_util_set_coordinate_collider + end subroutine collision_util_set_coordinate_fragments module subroutine collision_util_set_coordinate_impactors(self) diff --git a/src/fraggle/fraggle_generate.f90 b/src/fraggle/fraggle_generate.f90 index f00080f6b..925b04620 100644 --- a/src/fraggle/fraggle_generate.f90 +++ b/src/fraggle/fraggle_generate.f90 @@ -98,7 +98,7 @@ module subroutine fraggle_generate_disrupt(self, nbody_system, param, t, lfailur logical :: lk_plpl, lfailure_local logical, dimension(size(IEEE_ALL)) :: fpe_halting_modes, fpe_quiet_modes character(len=STRMAX) :: message - real(DP), parameter :: fail_scale_initial = 1.001_DP + real(DP), parameter :: fail_scale_initial = 1.01_DP ! The minimization and linear solvers can sometimes lead to floating point exceptions. Rather than halting the code entirely if this occurs, we ! can simply fail the attempt and try again. So we need to turn off any floating point exception halting modes temporarily @@ -136,23 +136,16 @@ module subroutine fraggle_generate_disrupt(self, nbody_system, param, t, lfailur ! Compute the "before" energy/momentum and the budgets call self%get_energy_and_momentum(nbody_system, param, lbefore=.true.) call self%set_budgets() - do try = 1, MAXTRY - self%fail_scale = (fail_scale_initial)**try - write(message,*) try - call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Fraggle try " // trim(adjustl(message))) - call fraggle_generate_pos_vec(self) - call fraggle_generate_rot_vec(self) - call fraggle_generate_vel_vec(self,lfailure_local) - if (.not.lfailure_local) exit - end do + self%fail_scale = fail_scale_initial + call fraggle_generate_pos_vec(self) + call fraggle_generate_rot_vec(self) + call fraggle_generate_vel_vec(self,lfailure_local) call self%set_original_scale() if (lfailure_local) then - call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Fraggle fragment generation failed after " // & - trim(adjustl(message)) // " tries. This collision may have gained energy.") + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "This collision may have gained energy.") else - call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Fraggle fragment generation succeeded after " // & - trim(adjustl(message)) // " tries") + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Fraggle fragment generation succeeded.") end if @@ -253,8 +246,8 @@ module subroutine fraggle_generate_pos_vec(collider) logical, dimension(collider%fragments%nbody) :: loverlap integer(I4B) :: i, j, loop logical :: lcat, lhitandrun - integer(I4B), parameter :: MAXLOOP = 10000 - real(DP), parameter :: rdistance_scale_factor = 0.01_DP ! Scale factor to apply to distance scaling in the event of a fail + integer(I4B), parameter :: MAXLOOP = 20000 + real(DP), parameter :: rdistance_scale_factor = 0.1_DP ! Scale factor to apply to distance scaling in the event of a fail associate(fragments => collider%fragments, impactors => collider%impactors, nfrag => collider%fragments%nbody) lcat = (impactors%regime == COLLRESOLVE_REGIME_SUPERCATASTROPHIC) @@ -269,6 +262,8 @@ module subroutine fraggle_generate_pos_vec(collider) if (.not.any(loverlap(:))) exit fragment_cloud_center(:,1) = impactors%rc(:,1) - rdistance(1) * impactors%bounce_unit(:) fragment_cloud_center(:,2) = impactors%rc(:,2) + rdistance(2) * impactors%bounce_unit(:) + fragment_cloud_radius(1) = .mag.(fragment_cloud_center(:,1) - impactors%rbimp(:)) + fragment_cloud_radius(2) = .mag.(fragment_cloud_center(:,2) - impactors%rbimp(:)) do concurrent(i = 1:nfrag, loverlap(i)) if (i < 3) then fragments%rc(:,i) = fragment_cloud_center(:,i) @@ -298,7 +293,6 @@ module subroutine fraggle_generate_pos_vec(collider) end do end do rdistance(:) = rdistance(:) * collider%fail_scale - fragment_cloud_radius(:) = fragment_cloud_radius(:) * collider%fail_scale end do call collision_util_shift_vector_to_origin(fragments%mass, fragments%rc) @@ -375,16 +369,19 @@ module subroutine fraggle_generate_vel_vec(collider, lfailure) integer(I4B) :: i, j, loop, istart, n, ndof logical :: lhitandrun, lnoncat real(DP), dimension(NDIM) :: vimp_unit, rimp, vrot, Lresidual, vshear, vunit - real(DP) :: vmag, vesc, rotmag, ke_residual, ke_per_dof, ke_tot + real(DP) :: vmag, vesc, rotmag, ke_residual, ke_per_dof, ke_tot, ke_residual_min integer(I4B), dimension(collider%fragments%nbody) :: vsign real(DP), dimension(collider%fragments%nbody) :: vscale, mass_vscale, ke_avail - integer(I4B), parameter :: MAXLOOP = 100 + integer(I4B), parameter :: MAXLOOP = 2000 real(DP), parameter :: TOL = 1e-2 + class(collision_fragments(:)), allocatable :: fragments - associate(fragments => collider%fragments, impactors => collider%impactors, nfrag => collider%fragments%nbody) + associate(impactors => collider%impactors, nfrag => collider%fragments%nbody) lhitandrun = (impactors%regime == COLLRESOLVE_REGIME_HIT_AND_RUN) lnoncat = (impactors%regime /= COLLRESOLVE_REGIME_SUPERCATASTROPHIC) ! For non-catastrophic impacts, make the fragments act like ejecta and point away from the impact point + allocate(fragments, source=collider%fragments) + ! The fragments will be divided into two "clouds" based on identified origin body. ! These clouds will collectively travel like two impactors bouncing off of each other. where(fragments%origin_body(:) == 1) @@ -414,6 +411,7 @@ module subroutine fraggle_generate_vel_vec(collider, lfailure) mass_vscale(:) = mass_vscale(:) * (fragments%mtot / fragments%mass(:))**(0.125_DP) ! The power is arbitrary. It just gives the velocity a small mass dependence mass_vscale(:) = mass_vscale(:) / minval(mass_vscale(:)) + ! Set the velocities of all fragments using all of the scale factors determined above do concurrent(i = 1:nfrag) j = fragments%origin_body(i) @@ -439,10 +437,17 @@ module subroutine fraggle_generate_vel_vec(collider, lfailure) else istart = 1 end if + ke_residual_min = huge(1.0_DP) do loop = 1, MAXLOOP - call collider%set_coordinate_system() + call fragments%set_coordinate_system() call fragments%get_kinetic_energy() ke_residual = fragments%ke_budget - (fragments%ke_orbit_tot + fragments%ke_spin_tot) + if (abs(ke_residual) < abs(ke_residual_min)) then ! This is our best case so far. Save it for posterity + if (allocated(collider%fragments)) deallocate(collider%fragments) + allocate(collider%fragments, source=fragments) + ke_residual_min = ke_residual + end if + ke_residual_min = max(ke_residual_min,ke_residual) if (ke_residual > 0.0_DP) exit ! Make sure we don't take away too much orbital kinetic energy, otherwise the fragment can't escape ke_avail(:) = fragments%ke_orbit(:) - impactors%Gmass(1)*impactors%mass(2)/fragments%rmag(:) @@ -475,7 +480,7 @@ module subroutine fraggle_generate_vel_vec(collider, lfailure) end do ! Check for any residual angular momentum, and if there is any, put it into spin - call collider%set_coordinate_system() + call fragments%set_coordinate_system() call fragments%get_angular_momentum() Lresidual(:) = fragments%L_budget(:) - (fragments%Lorbit_tot(:) + fragments%Lspin_tot(:)) do concurrent(i = istart:nfrag) From f5724733764944ff4bef66a2c01be3dbb8e34079 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Sat, 31 Dec 2022 10:17:40 -0500 Subject: [PATCH 558/569] Made a number of improvements to find the best fragment velocity distributions --- src/fraggle/fraggle_generate.f90 | 13 +++++-------- 1 file changed, 5 insertions(+), 8 deletions(-) diff --git a/src/fraggle/fraggle_generate.f90 b/src/fraggle/fraggle_generate.f90 index 925b04620..af389b1e0 100644 --- a/src/fraggle/fraggle_generate.f90 +++ b/src/fraggle/fraggle_generate.f90 @@ -247,7 +247,7 @@ module subroutine fraggle_generate_pos_vec(collider) integer(I4B) :: i, j, loop logical :: lcat, lhitandrun integer(I4B), parameter :: MAXLOOP = 20000 - real(DP), parameter :: rdistance_scale_factor = 0.1_DP ! Scale factor to apply to distance scaling in the event of a fail + real(DP), parameter :: rdistance_scale_factor = 0.01_DP ! Scale factor to apply to distance scaling in the event of overlap associate(fragments => collider%fragments, impactors => collider%impactors, nfrag => collider%fragments%nbody) lcat = (impactors%regime == COLLRESOLVE_REGIME_SUPERCATASTROPHIC) @@ -372,7 +372,7 @@ module subroutine fraggle_generate_vel_vec(collider, lfailure) real(DP) :: vmag, vesc, rotmag, ke_residual, ke_per_dof, ke_tot, ke_residual_min integer(I4B), dimension(collider%fragments%nbody) :: vsign real(DP), dimension(collider%fragments%nbody) :: vscale, mass_vscale, ke_avail - integer(I4B), parameter :: MAXLOOP = 2000 + integer(I4B), parameter :: MAXLOOP = 1000 real(DP), parameter :: TOL = 1e-2 class(collision_fragments(:)), allocatable :: fragments @@ -437,18 +437,16 @@ module subroutine fraggle_generate_vel_vec(collider, lfailure) else istart = 1 end if - ke_residual_min = huge(1.0_DP) + call fragments%set_coordinate_system() + ke_residual_min = -huge(1.0_DP) do loop = 1, MAXLOOP - call fragments%set_coordinate_system() call fragments%get_kinetic_energy() ke_residual = fragments%ke_budget - (fragments%ke_orbit_tot + fragments%ke_spin_tot) - if (abs(ke_residual) < abs(ke_residual_min)) then ! This is our best case so far. Save it for posterity + if ((abs(ke_residual) < abs(ke_residual_min)) .or. ((ke_residual >= 0.0_DP) .and. (ke_residual_min < 0.0_DP))) then ! This is our best case so far. Save it for posterity if (allocated(collider%fragments)) deallocate(collider%fragments) allocate(collider%fragments, source=fragments) ke_residual_min = ke_residual end if - ke_residual_min = max(ke_residual_min,ke_residual) - if (ke_residual > 0.0_DP) exit ! Make sure we don't take away too much orbital kinetic energy, otherwise the fragment can't escape ke_avail(:) = fragments%ke_orbit(:) - impactors%Gmass(1)*impactors%mass(2)/fragments%rmag(:) ke_tot = 0.0_DP @@ -480,7 +478,6 @@ module subroutine fraggle_generate_vel_vec(collider, lfailure) end do ! Check for any residual angular momentum, and if there is any, put it into spin - call fragments%set_coordinate_system() call fragments%get_angular_momentum() Lresidual(:) = fragments%L_budget(:) - (fragments%Lorbit_tot(:) + fragments%Lspin_tot(:)) do concurrent(i = istart:nfrag) From 48d7c40e6e6bb3c7c4f6257ed3612e5b25a6a26d Mon Sep 17 00:00:00 2001 From: David A Minton Date: Sat, 31 Dec 2022 10:39:45 -0500 Subject: [PATCH 559/569] More improvements to the robustness of the --- src/fraggle/fraggle_generate.f90 | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/src/fraggle/fraggle_generate.f90 b/src/fraggle/fraggle_generate.f90 index af389b1e0..a89e1935c 100644 --- a/src/fraggle/fraggle_generate.f90 +++ b/src/fraggle/fraggle_generate.f90 @@ -373,7 +373,7 @@ module subroutine fraggle_generate_vel_vec(collider, lfailure) integer(I4B), dimension(collider%fragments%nbody) :: vsign real(DP), dimension(collider%fragments%nbody) :: vscale, mass_vscale, ke_avail integer(I4B), parameter :: MAXLOOP = 1000 - real(DP), parameter :: TOL = 1e-2 + real(DP), parameter :: TOL = 1e-6 class(collision_fragments(:)), allocatable :: fragments associate(impactors => collider%impactors, nfrag => collider%fragments%nbody) @@ -411,7 +411,6 @@ module subroutine fraggle_generate_vel_vec(collider, lfailure) mass_vscale(:) = mass_vscale(:) * (fragments%mtot / fragments%mass(:))**(0.125_DP) ! The power is arbitrary. It just gives the velocity a small mass dependence mass_vscale(:) = mass_vscale(:) / minval(mass_vscale(:)) - ! Set the velocities of all fragments using all of the scale factors determined above do concurrent(i = 1:nfrag) j = fragments%origin_body(i) @@ -446,6 +445,7 @@ module subroutine fraggle_generate_vel_vec(collider, lfailure) if (allocated(collider%fragments)) deallocate(collider%fragments) allocate(collider%fragments, source=fragments) ke_residual_min = ke_residual + if ((ke_residual > 0.0_DP) .and. (ke_residual < TOL * fragments%ke_budget)) exit end if ! Make sure we don't take away too much orbital kinetic energy, otherwise the fragment can't escape ke_avail(:) = fragments%ke_orbit(:) - impactors%Gmass(1)*impactors%mass(2)/fragments%rmag(:) @@ -478,6 +478,7 @@ module subroutine fraggle_generate_vel_vec(collider, lfailure) end do ! Check for any residual angular momentum, and if there is any, put it into spin + call fragments%set_coordinate_system() call fragments%get_angular_momentum() Lresidual(:) = fragments%L_budget(:) - (fragments%Lorbit_tot(:) + fragments%Lspin_tot(:)) do concurrent(i = istart:nfrag) From 3bcd7143be37e4006bed14108ca83ce96bc17580 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Sat, 31 Dec 2022 10:55:18 -0500 Subject: [PATCH 560/569] More tweaks. Cut down on the simulation time so there is less dead space in the movies --- examples/Fragmentation/Fragmentation_Movie.py | 5 +++-- src/fraggle/fraggle_generate.f90 | 4 +++- 2 files changed, 6 insertions(+), 3 deletions(-) diff --git a/examples/Fragmentation/Fragmentation_Movie.py b/examples/Fragmentation/Fragmentation_Movie.py index 6932223a8..dab940b79 100644 --- a/examples/Fragmentation/Fragmentation_Movie.py +++ b/examples/Fragmentation/Fragmentation_Movie.py @@ -39,6 +39,7 @@ available_movie_styles = ["disruption_headon", "disruption_off_axis", "supercatastrophic_headon", "supercatastrophic_off_axis","hitandrun_disrupt", "hitandrun_pure"] movie_title_list = ["Head-on Disruption", "Off-axis Disruption", "Head-on Supercatastrophic", "Off-axis Supercatastrophic", "Hit and Run w/ Runner Disruption", "Pure Hit and Run"] movie_titles = dict(zip(available_movie_styles, movie_title_list)) +num_movie_frames = 1200 # These initial conditions were generated by trial and error names = ["Target","Projectile"] @@ -127,7 +128,7 @@ def encounter_combiner(sim): ds = xr.combine_nested([data,enc],concat_dim='time').sortby("time").interpolate_na(dim="time") # Interpolate in time to make a smooth, constant time step dataset - smooth_time = np.linspace(start=tgood.isel(time=0), stop=ds.time[-1], num=2400) + smooth_time = np.linspace(start=tgood.isel(time=0), stop=ds.time[-1], num=num_movie_frames) ds = ds.interp(time=smooth_time) return ds @@ -236,7 +237,7 @@ def data_stream(self, frame=0): minimum_fragment_gmass = 0.2 * body_Gmass[style][1] # Make the minimum fragment mass a fraction of the smallest body gmtiny = 0.99 * body_Gmass[style][1] # Make GMTINY just smaller than the smallest original body. This will prevent runaway collisional cascades sim.set_parameter(collision_model="fraggle", encounter_save="both", gmtiny=gmtiny, minimum_fragment_gmass=minimum_fragment_gmass, verbose=False) - sim.run(dt=1e-3, tstop=1.0e-3, istep_out=1, dump_cadence=0) + sim.run(dt=5e-4, tstop=5.0e-4, istep_out=1, dump_cadence=0) print("Generating animation") anim = AnimatedScatter(sim,movie_filename,movie_titles[style],style,nskip=1) diff --git a/src/fraggle/fraggle_generate.f90 b/src/fraggle/fraggle_generate.f90 index a89e1935c..6d77a0dc2 100644 --- a/src/fraggle/fraggle_generate.f90 +++ b/src/fraggle/fraggle_generate.f90 @@ -247,7 +247,9 @@ module subroutine fraggle_generate_pos_vec(collider) integer(I4B) :: i, j, loop logical :: lcat, lhitandrun integer(I4B), parameter :: MAXLOOP = 20000 - real(DP), parameter :: rdistance_scale_factor = 0.01_DP ! Scale factor to apply to distance scaling in the event of overlap + real(DP), parameter :: rdistance_scale_factor = 0.05_DP ! Scale factor to apply to distance scaling of cloud centers in the event of overlap + ! The distance is chosen to be close to the original locations of the impactors + ! but far enough apart to prevent a collisional cascade between fragments associate(fragments => collider%fragments, impactors => collider%impactors, nfrag => collider%fragments%nbody) lcat = (impactors%regime == COLLRESOLVE_REGIME_SUPERCATASTROPHIC) From f7ae4dbffb64e838c47eb6900e431e41bb5b9534 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Sat, 31 Dec 2022 11:53:53 -0500 Subject: [PATCH 561/569] More tweaks. Improvements to the robustness of each kind of collisional outcome model --- src/collision/collision_io.f90 | 2 +- src/fraggle/fraggle_generate.f90 | 62 +++++++++++++++++--------------- src/fraggle/fraggle_util.f90 | 2 -- 3 files changed, 35 insertions(+), 31 deletions(-) diff --git a/src/collision/collision_io.f90 b/src/collision/collision_io.f90 index d5eaa3f8a..3cf031b22 100644 --- a/src/collision/collision_io.f90 +++ b/src/collision/collision_io.f90 @@ -74,7 +74,7 @@ module subroutine collision_io_log_regime(impactors) case(COLLRESOLVE_REGIME_HIT_AND_RUN) write(LUN, *) "Regime: Hit and run" end select - write(LUN, *) "Energy loss : ", impactors%Qloss + write(LUN, *) "Expected energy change : ", -impactors%Qloss write(LUN, *) "--------------------------------------------------------------------" close(LUN) diff --git a/src/fraggle/fraggle_generate.f90 b/src/fraggle/fraggle_generate.f90 index 6d77a0dc2..0711ab001 100644 --- a/src/fraggle/fraggle_generate.f90 +++ b/src/fraggle/fraggle_generate.f90 @@ -93,12 +93,11 @@ module subroutine fraggle_generate_disrupt(self, nbody_system, param, t, lfailur real(DP), intent(in) :: t !! Time of collision logical, optional, intent(out) :: lfailure !! Answers the question: Should this have been a merger instead? ! Internals - integer(I4B) :: try - integer(I4B), parameter :: MAXTRY = 100 logical :: lk_plpl, lfailure_local logical, dimension(size(IEEE_ALL)) :: fpe_halting_modes, fpe_quiet_modes + real(DP) :: dE, dL character(len=STRMAX) :: message - real(DP), parameter :: fail_scale_initial = 1.01_DP + real(DP), parameter :: fail_scale_initial = 1.001_DP ! The minimization and linear solvers can sometimes lead to floating point exceptions. Rather than halting the code entirely if this occurs, we ! can simply fail the attempt and try again. So we need to turn off any floating point exception halting modes temporarily @@ -126,27 +125,23 @@ module subroutine fraggle_generate_disrupt(self, nbody_system, param, t, lfailur call ieee_set_flag(ieee_all, .false.) ! Set all fpe flags to quiet call self%set_natural_scale() - call fragments%reset() - lfailure_local = .false. - - - ! Use the disruption collision model to generate initial conditions - ! Compute the "before" energy/momentum and the budgets call self%get_energy_and_momentum(nbody_system, param, lbefore=.true.) call self%set_budgets() self%fail_scale = fail_scale_initial call fraggle_generate_pos_vec(self) call fraggle_generate_rot_vec(self) call fraggle_generate_vel_vec(self,lfailure_local) + call self%get_energy_and_momentum(nbody_system, param, lbefore=.false.) call self%set_original_scale() + dE = self%Etot(2) - self%Etot(1) + dL = .mag.(self%Ltot(:,2) - self%Ltot(:,1)) - if (lfailure_local) then - call swiftest_io_log_one_message(COLLISION_LOG_OUT, "This collision may have gained energy.") - else - call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Fraggle fragment generation succeeded.") - end if + write(message,*) dE + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Estimated energy change: " // trim(adjustl(message))) + write(message,*) dL + call swiftest_io_log_one_message(COLLISION_LOG_OUT, "Estimated angular momentum change: " // trim(adjustl(message))) ! Restore the big array @@ -247,7 +242,7 @@ module subroutine fraggle_generate_pos_vec(collider) integer(I4B) :: i, j, loop logical :: lcat, lhitandrun integer(I4B), parameter :: MAXLOOP = 20000 - real(DP), parameter :: rdistance_scale_factor = 0.05_DP ! Scale factor to apply to distance scaling of cloud centers in the event of overlap + real(DP), parameter :: rdistance_scale_factor = 0.20_DP ! Scale factor to apply to distance scaling of cloud centers in the event of overlap ! The distance is chosen to be close to the original locations of the impactors ! but far enough apart to prevent a collisional cascade between fragments @@ -257,15 +252,23 @@ module subroutine fraggle_generate_pos_vec(collider) ! We will treat the first two fragments of the list as special cases. ! Place the first two bodies at the centers of the two fragment clouds, but be sure they are sufficiently far apart to avoid overlap - fragment_cloud_radius(:) = impactors%radius(:) loverlap(:) = .true. rdistance(:) = rdistance_scale_factor * .mag.impactors%vc(:,:) do loop = 1, MAXLOOP if (.not.any(loverlap(:))) exit fragment_cloud_center(:,1) = impactors%rc(:,1) - rdistance(1) * impactors%bounce_unit(:) + if (lcat) then + fragment_cloud_center(:,1) = impactors%rc(:,1) - rdistance(1) * impactors%bounce_unit(:) + else + fragment_cloud_center(:,1) = impactors%rc(:,1) + end if fragment_cloud_center(:,2) = impactors%rc(:,2) + rdistance(2) * impactors%bounce_unit(:) - fragment_cloud_radius(1) = .mag.(fragment_cloud_center(:,1) - impactors%rbimp(:)) - fragment_cloud_radius(2) = .mag.(fragment_cloud_center(:,2) - impactors%rbimp(:)) + if (lhitandrun) then + fragment_cloud_radius(:) = impactors%radius(:) + else + fragment_cloud_radius(1) = .mag.(fragment_cloud_center(:,1) - impactors%rbimp(:)) + fragment_cloud_radius(2) = .mag.(fragment_cloud_center(:,2) - impactors%rbimp(:)) + end if do concurrent(i = 1:nfrag, loverlap(i)) if (i < 3) then fragments%rc(:,i) = fragment_cloud_center(:,i) @@ -369,7 +372,7 @@ module subroutine fraggle_generate_vel_vec(collider, lfailure) logical, intent(out) :: lfailure !! Did the velocity computation fail? ! Internals integer(I4B) :: i, j, loop, istart, n, ndof - logical :: lhitandrun, lnoncat + logical :: lhitandrun, lsupercat real(DP), dimension(NDIM) :: vimp_unit, rimp, vrot, Lresidual, vshear, vunit real(DP) :: vmag, vesc, rotmag, ke_residual, ke_per_dof, ke_tot, ke_residual_min integer(I4B), dimension(collider%fragments%nbody) :: vsign @@ -380,7 +383,7 @@ module subroutine fraggle_generate_vel_vec(collider, lfailure) associate(impactors => collider%impactors, nfrag => collider%fragments%nbody) lhitandrun = (impactors%regime == COLLRESOLVE_REGIME_HIT_AND_RUN) - lnoncat = (impactors%regime /= COLLRESOLVE_REGIME_SUPERCATASTROPHIC) ! For non-catastrophic impacts, make the fragments act like ejecta and point away from the impact point + lsupercat = (impactors%regime == COLLRESOLVE_REGIME_SUPERCATASTROPHIC) allocate(fragments, source=collider%fragments) @@ -479,15 +482,18 @@ module subroutine fraggle_generate_vel_vec(collider, lfailure) fragments%rot(:,i) = fragments%rotmag(i) * .unit.fragments%rot(:,i) end do - ! Check for any residual angular momentum, and if there is any, put it into spin call fragments%set_coordinate_system() - call fragments%get_angular_momentum() - Lresidual(:) = fragments%L_budget(:) - (fragments%Lorbit_tot(:) + fragments%Lspin_tot(:)) - do concurrent(i = istart:nfrag) - vunit(:) = .unit. (Lresidual(:) .cross. fragments%r_unit(:,i)) - vshear(:) = vunit(:) * (.mag.Lresidual(:) / ((nfrag-istart+1)*fragments%mass(i) * fragments%rmag(i))) - fragments%vc(:,i) = fragments%vc(:,i) + vshear(:) - end do + if (lsupercat) then + ! Put some of the residual angular momentum into velocity shear. Not too much, or we get some weird trajectories + call fragments%get_angular_momentum() + Lresidual(:) = fragments%L_budget(:) - (fragments%Lorbit_tot(:) + fragments%Lspin_tot(:)) + do concurrent(i = istart:nfrag) + vunit(:) = .unit. (Lresidual(:) .cross. fragments%r_unit(:,i)) + vshear(:) = vunit(:) * (.mag.Lresidual(:) / ((nfrag-istart+1)*fragments%mass(i) * fragments%rmag(i))) + fragments%vc(:,i) = fragments%vc(:,i) + vshear(:) + end do + end if + ! Check for any residual angular momentum, and if there is any, put it into spin call fragments%get_angular_momentum() Lresidual(:) = fragments%L_budget(:) - (fragments%Lorbit_tot(:) + fragments%Lspin_tot(:)) do concurrent(i = 1:nfrag) diff --git a/src/fraggle/fraggle_util.f90 b/src/fraggle/fraggle_util.f90 index e59ed130b..d405fc2b5 100644 --- a/src/fraggle/fraggle_util.f90 +++ b/src/fraggle/fraggle_util.f90 @@ -258,7 +258,6 @@ module subroutine fraggle_util_set_natural_scale_factors(self) impactors%radius(:) = impactors%radius(:) / collider%dscale impactors%Lspin(:,:) = impactors%Lspin(:,:) / collider%Lscale impactors%Lorbit(:,:) = impactors%Lorbit(:,:) / collider%Lscale - impactors%bounce_unit(:) = impactors%bounce_unit(:) / collider%vscale do i = 1, 2 impactors%rot(:,i) = impactors%Lspin(:,i) / (impactors%mass(i) * impactors%radius(i)**2 * impactors%Ip(3,i)) @@ -295,7 +294,6 @@ module subroutine fraggle_util_set_original_scale_factors(self) impactors%rbcom(:) = impactors%rbcom(:) * collider%dscale impactors%vbcom(:) = impactors%vbcom(:) * collider%vscale impactors%rbimp(:) = impactors%rbimp(:) * collider%dscale - impactors%bounce_unit(:) = impactors%bounce_unit(:) * collider%vscale impactors%mass = impactors%mass * collider%mscale impactors%Gmass(:) = impactors%Gmass(:) * (collider%dscale**3/collider%tscale**2) From cf7f9f6b0f80c864303ffbe64a441e5a47906f54 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Sat, 31 Dec 2022 12:02:44 -0500 Subject: [PATCH 562/569] Tweaks and improvements to log files. Also made sure pure hit and run is actually pure --- examples/Fragmentation/Fragmentation_Movie.py | 2 +- src/fraggle/fraggle_generate.f90 | 5 ++--- 2 files changed, 3 insertions(+), 4 deletions(-) diff --git a/examples/Fragmentation/Fragmentation_Movie.py b/examples/Fragmentation/Fragmentation_Movie.py index dab940b79..fafe319f8 100644 --- a/examples/Fragmentation/Fragmentation_Movie.py +++ b/examples/Fragmentation/Fragmentation_Movie.py @@ -68,7 +68,7 @@ "hitandrun_disrupt" : [np.array([ 0.00, 6.28, 0.0]), np.array([-1.45, -6.28, 0.0])], "hitandrun_pure" : [np.array([ 0.00, 6.28, 0.0]), - np.array([-1.50, -6.28, 0.0])] + np.array([-1.51, -6.28, 0.0])] } rot_vectors = {"disruption_headon" : [np.array([0.0, 0.0, 0.0]), diff --git a/src/fraggle/fraggle_generate.f90 b/src/fraggle/fraggle_generate.f90 index 0711ab001..c0afb2393 100644 --- a/src/fraggle/fraggle_generate.f90 +++ b/src/fraggle/fraggle_generate.f90 @@ -180,10 +180,7 @@ module subroutine fraggle_generate_hitandrun(self, nbody_system, param, t) select type(pl => nbody_system%pl) class is (swiftest_pl) associate(impactors => self%impactors) - message = "Hit and run between" call collision_io_collider_message(nbody_system%pl, impactors%id, message) - call swiftest_io_log_one_message(COLLISION_LOG_OUT, trim(adjustl(message))) - if (impactors%mass(1) > impactors%mass(2)) then jtarg = 1 jproj = 2 @@ -202,6 +199,8 @@ module subroutine fraggle_generate_hitandrun(self, nbody_system, param, t) end if lpure = .false. call self%set_mass_dist(param) + message = "Hit and run between" + call swiftest_io_log_one_message(COLLISION_LOG_OUT, trim(adjustl(message))) ! Generate the position and velocity distributions of the fragments call self%disrupt(nbody_system, param, t, lpure) From 28e5cde369f9653c67ab19a5c646a37dc5b13535 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Sat, 31 Dec 2022 12:23:19 -0500 Subject: [PATCH 563/569] More tweaks to find the best fragment distribution for the tricky cases --- src/fraggle/fraggle_generate.f90 | 121 ++++++++++++++++--------------- 1 file changed, 64 insertions(+), 57 deletions(-) diff --git a/src/fraggle/fraggle_generate.f90 b/src/fraggle/fraggle_generate.f90 index c0afb2393..8e434ed6a 100644 --- a/src/fraggle/fraggle_generate.f90 +++ b/src/fraggle/fraggle_generate.f90 @@ -370,13 +370,14 @@ module subroutine fraggle_generate_vel_vec(collider, lfailure) class(collision_fraggle), intent(inout) :: collider !! Fraggle collision system object logical, intent(out) :: lfailure !! Did the velocity computation fail? ! Internals - integer(I4B) :: i, j, loop, istart, n, ndof + integer(I4B) :: i, j, loop, try, istart, n, ndof logical :: lhitandrun, lsupercat real(DP), dimension(NDIM) :: vimp_unit, rimp, vrot, Lresidual, vshear, vunit real(DP) :: vmag, vesc, rotmag, ke_residual, ke_per_dof, ke_tot, ke_residual_min integer(I4B), dimension(collider%fragments%nbody) :: vsign real(DP), dimension(collider%fragments%nbody) :: vscale, mass_vscale, ke_avail - integer(I4B), parameter :: MAXLOOP = 1000 + integer(I4B), parameter :: MAXLOOP = 100 + integer(I4B), parameter :: MAXTRY = 100 real(DP), parameter :: TOL = 1e-6 class(collision_fragments(:)), allocatable :: fragments @@ -442,68 +443,74 @@ module subroutine fraggle_generate_vel_vec(collider, lfailure) end if call fragments%set_coordinate_system() ke_residual_min = -huge(1.0_DP) - do loop = 1, MAXLOOP - call fragments%get_kinetic_energy() - ke_residual = fragments%ke_budget - (fragments%ke_orbit_tot + fragments%ke_spin_tot) - if ((abs(ke_residual) < abs(ke_residual_min)) .or. ((ke_residual >= 0.0_DP) .and. (ke_residual_min < 0.0_DP))) then ! This is our best case so far. Save it for posterity - if (allocated(collider%fragments)) deallocate(collider%fragments) - allocate(collider%fragments, source=fragments) - ke_residual_min = ke_residual - if ((ke_residual > 0.0_DP) .and. (ke_residual < TOL * fragments%ke_budget)) exit - end if - ! Make sure we don't take away too much orbital kinetic energy, otherwise the fragment can't escape - ke_avail(:) = fragments%ke_orbit(:) - impactors%Gmass(1)*impactors%mass(2)/fragments%rmag(:) - ke_tot = 0.0_DP - ke_per_dof = -ke_residual - do i = 1, 2*(nfrag - istart + 1) - n = count(ke_avail(istart:nfrag) > -ke_residual/i) - if (ke_residual < 0.0_DP) n = n + count(fragments%ke_spin(istart:nfrag) > -ke_residual/i) - if (abs(n * ke_per_dof) > ke_tot) then - ke_per_dof = -ke_residual/i - ke_tot = n * ke_per_dof - ndof = i - if (abs(ke_tot) > abs(ke_residual)) then - ke_tot = -ke_residual - ke_per_dof = ke_tot/n - exit - end if + outer: do try = 1, MAXTRY + do loop = 1, MAXLOOP + call fragments%get_kinetic_energy() + ke_residual = fragments%ke_budget - (fragments%ke_orbit_tot + fragments%ke_spin_tot) + if ((abs(ke_residual) < abs(ke_residual_min)) .or. ((ke_residual >= 0.0_DP) .and. (ke_residual_min < 0.0_DP))) then ! This is our best case so far. Save it for posterity + if (allocated(collider%fragments)) deallocate(collider%fragments) + allocate(collider%fragments, source=fragments) + ke_residual_min = ke_residual + if ((ke_residual > 0.0_DP) .and. (ke_residual < TOL * fragments%ke_budget)) exit outer end if - end do - do concurrent(i = istart:nfrag, ke_avail(i) > ke_per_dof) - vmag = max(fragments%vmag(i)**2 - 2*ke_per_dof/fragments%mass(i),vesc**2) - fragments%vmag(i) = sqrt(vmag) - fragments%vc(:,i) = fragments%vmag(i) * .unit.fragments%vc(:,i) - end do - do concurrent(i = istart:nfrag, fragments%ke_spin(i) > ke_per_dof) - rotmag = fragments%rotmag(i)**2 - 2*ke_per_dof/(fragments%mass(i) * fragments%radius(i)**2 * fragments%Ip(3,i)) - rotmag = max(rotmag, 0.0_DP) - fragments%rotmag(i) = sqrt(rotmag) - fragments%rot(:,i) = fragments%rotmag(i) * .unit.fragments%rot(:,i) - end do + ! Make sure we don't take away too much orbital kinetic energy, otherwise the fragment can't escape + ke_avail(:) = fragments%ke_orbit(:) - impactors%Gmass(1)*impactors%mass(2)/fragments%rmag(:) + ke_tot = 0.0_DP + ke_per_dof = -ke_residual + do i = 1, 2*(nfrag - istart + 1) + n = count(ke_avail(istart:nfrag) > -ke_residual/i) + if (ke_residual < 0.0_DP) n = n + count(fragments%ke_spin(istart:nfrag) > -ke_residual/i) + if (abs(n * ke_per_dof) > ke_tot) then + ke_per_dof = -ke_residual/i + ke_tot = n * ke_per_dof + ndof = i + if (abs(ke_tot) > abs(ke_residual)) then + ke_tot = -ke_residual + ke_per_dof = ke_tot/n + exit + end if + end if + end do + do concurrent(i = istart:nfrag, ke_avail(i) > ke_per_dof) + vmag = max(fragments%vmag(i)**2 - 2*ke_per_dof/fragments%mass(i),vesc**2) + fragments%vmag(i) = sqrt(vmag) + fragments%vc(:,i) = fragments%vmag(i) * .unit.fragments%vc(:,i) + end do + do concurrent(i = istart:nfrag, fragments%ke_spin(i) > ke_per_dof) + rotmag = fragments%rotmag(i)**2 - 2*ke_per_dof/(fragments%mass(i) * fragments%radius(i)**2 * fragments%Ip(3,i)) + rotmag = max(rotmag, 0.0_DP) + fragments%rotmag(i) = sqrt(rotmag) + fragments%rot(:,i) = fragments%rotmag(i) * .unit.fragments%rot(:,i) + end do - call fragments%set_coordinate_system() - if (lsupercat) then - ! Put some of the residual angular momentum into velocity shear. Not too much, or we get some weird trajectories + call fragments%set_coordinate_system() + if (lsupercat) then + ! Put some of the residual angular momentum into velocity shear. Not too much, or we get some weird trajectories + call fragments%get_angular_momentum() + Lresidual(:) = fragments%L_budget(:) - (fragments%Lorbit_tot(:) + fragments%Lspin_tot(:)) + do concurrent(i = istart:nfrag) + vunit(:) = .unit. (Lresidual(:) .cross. fragments%r_unit(:,i)) + vshear(:) = vunit(:) * (.mag.Lresidual(:) / ((nfrag-istart+1)*fragments%mass(i) * fragments%rmag(i))) + fragments%vc(:,i) = fragments%vc(:,i) + vshear(:) + end do + end if + ! Check for any residual angular momentum, and if there is any, put it into spin call fragments%get_angular_momentum() Lresidual(:) = fragments%L_budget(:) - (fragments%Lorbit_tot(:) + fragments%Lspin_tot(:)) - do concurrent(i = istart:nfrag) - vunit(:) = .unit. (Lresidual(:) .cross. fragments%r_unit(:,i)) - vshear(:) = vunit(:) * (.mag.Lresidual(:) / ((nfrag-istart+1)*fragments%mass(i) * fragments%rmag(i))) - fragments%vc(:,i) = fragments%vc(:,i) + vshear(:) + do concurrent(i = 1:nfrag) + fragments%Lspin(:,i) = fragments%Lspin(:,i) + Lresidual(:) / nfrag + fragments%rot(:,i) = fragments%Lspin(:,i) / (fragments%mass(i) * fragments%radius(i)**2 * fragments%Ip(:,i)) end do - end if - ! Check for any residual angular momentum, and if there is any, put it into spin - call fragments%get_angular_momentum() - Lresidual(:) = fragments%L_budget(:) - (fragments%Lorbit_tot(:) + fragments%Lspin_tot(:)) - do concurrent(i = 1:nfrag) - fragments%Lspin(:,i) = fragments%Lspin(:,i) + Lresidual(:) / nfrag - fragments%rot(:,i) = fragments%Lspin(:,i) / (fragments%mass(i) * fragments%radius(i)**2 * fragments%Ip(:,i)) - end do - call fragments%get_angular_momentum() - Lresidual(:) = fragments%L_budget(:) - (fragments%Lorbit_tot(:) + fragments%Lspin_tot(:)) + call fragments%get_angular_momentum() + Lresidual(:) = fragments%L_budget(:) - (fragments%Lorbit_tot(:) + fragments%Lspin_tot(:)) - end do + end do + ! We didn't converge. Try another configuration and see if we get a better result + call fraggle_generate_pos_vec(collider) + call fraggle_generate_rot_vec(collider) + collider%fail_scale = collider%fail_scale*1.01_DP + end do outer lfailure = ke_residual < 0.0_DP do concurrent(i = 1:nfrag) From 0362ad0d3d4b130cfa651a1cab04cba04539ec28 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Sat, 31 Dec 2022 13:24:30 -0500 Subject: [PATCH 564/569] Made a small tweak to rotations to help with energy balance in spin --- src/fraggle/fraggle_generate.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/fraggle/fraggle_generate.f90 b/src/fraggle/fraggle_generate.f90 index 8e434ed6a..a68cf7e4f 100644 --- a/src/fraggle/fraggle_generate.f90 +++ b/src/fraggle/fraggle_generate.f90 @@ -349,7 +349,7 @@ module subroutine fraggle_generate_rot_vec(collider) rotdir = rotdir - 0.5_DP rotdir = .unit. rotdir call random_number(rotmag) - rotmag = rotmag * .mag. (Lbefore(:) - Lafter(:)) / ((nfrag - 1) * fragments%mass(i) * fragments%radius(i)**2 * fragments%Ip(3,i)) + rotmag = 0.01_DP * rotmag * .mag. (Lbefore(:) - Lafter(:)) / ((nfrag - 1) * fragments%mass(i) * fragments%radius(i)**2 * fragments%Ip(3,i)) fragments%rot(:,i) = rotmag * rotdir end do From 613e5d4996dcbdbe6ae9f2d93f6db28e465be73d Mon Sep 17 00:00:00 2001 From: David A Minton Date: Sat, 31 Dec 2022 21:08:06 -0500 Subject: [PATCH 565/569] Added gravitational binding energy to the energy bookeeping. --- src/collision/collision_generate.f90 | 4 +- src/collision/collision_io.f90 | 4 ++ src/collision/collision_module.f90 | 12 +++-- src/collision/collision_resolve.f90 | 4 -- src/collision/collision_util.f90 | 39 +++++++++++----- src/fraggle/fraggle_generate.f90 | 28 ++++++------ src/fraggle/fraggle_util.f90 | 67 +++++++++++++++------------- src/netcdf_io/netcdf_io_module.f90 | 22 ++++----- src/swiftest/swiftest_io.f90 | 19 ++++++-- src/swiftest/swiftest_module.f90 | 3 ++ src/swiftest/swiftest_util.f90 | 4 +- src/symba/symba_discard.f90 | 12 +++-- 12 files changed, 132 insertions(+), 86 deletions(-) diff --git a/src/collision/collision_generate.f90 b/src/collision/collision_generate.f90 index 202cc5297..b946a387e 100644 --- a/src/collision/collision_generate.f90 +++ b/src/collision/collision_generate.f90 @@ -155,7 +155,7 @@ module subroutine collision_generate_merge(self, nbody_system, param, t) ! Internals integer(I4B) :: i, j, k, ibiggest real(DP), dimension(NDIM) :: Lspin_new - real(DP) :: volume + real(DP) :: volume, G character(len=STRMAX) :: message select type(nbody_system) @@ -185,7 +185,9 @@ module subroutine collision_generate_merge(self, nbody_system, param, t) ! Compute the physical properties of the new body after the merge. volume = 4._DP / 3._DP * PI * sum(impactors%radius(:)**3) + G = nbody_system%collider%impactors%Gmass(1) / nbody_system%collider%impactors%mass(1) fragments%mass(1) = impactors%mass_dist(1) + fragments%Gmass(1) = G * fragments%mass(1) fragments%density(1) = fragments%mass(1) / volume fragments%radius(1) = (3._DP * volume / (4._DP * PI))**(THIRD) if (param%lrotation) then diff --git a/src/collision/collision_io.f90 b/src/collision/collision_io.f90 index 3cf031b22..a798004d1 100644 --- a/src/collision/collision_io.f90 +++ b/src/collision/collision_io.f90 @@ -231,6 +231,9 @@ module subroutine collision_io_netcdf_initialize_output(self, param) call netcdf_io_check( nf90_def_var(nc%id, nc%pe_varname, nc%out_type,& [ nc%stage_dimid, nc%event_dimid], nc%PE_varid), "collision_io_netcdf_initialize_output nf90_def_var PE_varid" ) + call netcdf_io_check( nf90_def_var(nc%id, nc%be_varname, nc%out_type,& + [ nc%stage_dimid, nc%event_dimid], nc%BE_varid), "collision_io_netcdf_initialize_output nf90_def_var BE_varid" ) + call netcdf_io_check( nf90_def_var(nc%id, nc%L_orb_varname, nc%out_type, & [ nc%space_dimid, nc%stage_dimid, nc%event_dimid], nc%L_orb_varid), "collision_io_netcdf_initialize_output nf90_def_var L_orb_varid" ) @@ -332,6 +335,7 @@ module subroutine collision_io_netcdf_write_frame_snapshot(self, history, param) call netcdf_io_check( nf90_put_var(nc%id, nc%ke_orb_varid, collider%ke_orbit(:), start=[ 1, eslot], count=[ 2, 1]), "collision_io_netcdf_write_frame_snapshot nf90_put_var ke_orb_varid before" ) call netcdf_io_check( nf90_put_var(nc%id, nc%ke_spin_varid, collider%ke_spin(:), start=[ 1, eslot], count=[ 2, 1]), "collision_io_netcdf_write_frame_snapshot nf90_put_var ke_spin_varid before" ) call netcdf_io_check( nf90_put_var(nc%id, nc%pe_varid, collider%pe(:), start=[ 1, eslot], count=[ 2, 1]), "collision_io_netcdf_write_frame_snapshot nf90_put_var pe_varid before" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%be_varid, collider%be(:), start=[ 1, eslot], count=[ 2, 1]), "collision_io_netcdf_write_frame_snapshot nf90_put_var pe_varid before" ) call netcdf_io_check( nf90_put_var(nc%id, nc%L_orb_varid, collider%Lorbit(:,:), start=[1, 1, eslot], count=[NDIM, 2, 1]), "collision_io_netcdf_write_frame_snapshot nf90_put_var L_orb_varid before" ) call netcdf_io_check( nf90_put_var(nc%id, nc%Lspin_varid, collider%Lspin(:,:), start=[1, 1, eslot], count=[NDIM, 2, 1]), "collision_io_netcdf_write_frame_snapshot nf90_put_var Lspin_varid before" ) end if diff --git a/src/collision/collision_module.f90 b/src/collision/collision_module.f90 index fed0191b4..3fa91a220 100644 --- a/src/collision/collision_module.f90 +++ b/src/collision/collision_module.f90 @@ -98,6 +98,7 @@ module collision real(DP), dimension(NDIM,nbody) :: vb !! Barycentric velocity real(DP), dimension(NDIM,nbody) :: rot !! rotation vectors of fragments real(DP), dimension(NDIM,nbody) :: Ip !! Principal axes moment of inertia for fragments + real(DP), dimension(nbody) :: Gmass !! G*mass of fragments real(DP), dimension(nbody) :: mass !! masses of fragments real(DP), dimension(nbody) :: radius !! Radii of fragments real(DP), dimension(nbody) :: density !! Radii of fragments @@ -117,14 +118,16 @@ module collision real(DP), dimension(NDIM,nbody) :: Lspin !! Spin angular momentum vector of each individual fragment real(DP) :: ke_orbit_tot !! Orbital kinetic energy of all fragments real(DP) :: ke_spin_tot !! Spin kinetic energy of all fragments - real(DP) :: ke_budget !! Kinetic energy budget for computing fragment trajectories + real(DP) :: pe !! Potential energy of all fragments + real(DP) :: be !! Binding energy of all fragments + real(DP) :: E_budget !! Kinetic energy budget for computing fragment trajectories real(DP), dimension(NDIM) :: L_budget !! Angular momentum budget for computing fragment trajectories real(DP), dimension(nbody) :: ke_orbit !! Orbital kinetic energy of each individual fragment real(DP), dimension(nbody) :: ke_spin !! Spin kinetic energy of each individual fragment contains procedure :: reset => collision_util_reset_fragments !! Deallocates all allocatable arrays and sets everything else to 0 procedure :: get_angular_momentum => collision_util_get_angular_momentum !! Calcualtes the current angular momentum of the fragments - procedure :: get_kinetic_energy => collision_util_get_kinetic_energy !! Calcualtes the current kinetic energy of the fragments + procedure :: get_energy => collision_util_get_energy !! Calcualtes the current kinetic energy of the fragments procedure :: set_coordinate_system => collision_util_set_coordinate_fragments !! Sets the coordinate system of the fragments final :: collision_final_fragments !! Finalizer deallocates all allocatables end type collision_fragments @@ -148,6 +151,7 @@ module collision real(DP), dimension(2) :: ke_orbit !! Before/after orbital kinetic energy real(DP), dimension(2) :: ke_spin !! Before/after spin kinetic energy real(DP), dimension(2) :: pe !! Before/after potential energy + real(DP), dimension(2) :: be !! Before/after binding energy real(DP), dimension(2) :: Etot !! Before/after total nbody_system energy contains procedure :: setup => collision_util_setup_collider !! Initializer for the encounter collision system and the before/after snapshots @@ -385,10 +389,10 @@ module subroutine collision_util_get_angular_momentum(self) class(collision_fragments(*)), intent(inout) :: self !! Fragment system object end subroutine collision_util_get_angular_momentum - module subroutine collision_util_get_kinetic_energy(self) + module subroutine collision_util_get_energy(self) implicit none class(collision_fragments(*)), intent(inout) :: self !! Fragment system object - end subroutine collision_util_get_kinetic_energy + end subroutine collision_util_get_energy module subroutine collision_util_reset_fragments(self) implicit none diff --git a/src/collision/collision_resolve.f90 b/src/collision/collision_resolve.f90 index b0fff79dd..0036a8a00 100644 --- a/src/collision/collision_resolve.f90 +++ b/src/collision/collision_resolve.f90 @@ -548,10 +548,6 @@ module subroutine collision_resolve_plpl(self, nbody_system, param, t, dt, irec) call collider%generate(nbody_system, param, t) call nbody_system%get_energy_and_momentum(param) - collider%pe(2) = nbody_system%pe - dpe = collider%pe(2) - collider%pe(1) - nbody_system%Ecollisions = nbody_system%Ecollisions - dpe - nbody_system%Euntracked = nbody_system%Euntracked + dpe call collision_history%take_snapshot(param,nbody_system, t, "after") diff --git a/src/collision/collision_util.f90 b/src/collision/collision_util.f90 index 3659bbc63..7f073eecf 100644 --- a/src/collision/collision_util.f90 +++ b/src/collision/collision_util.f90 @@ -200,15 +200,16 @@ module subroutine collision_util_get_angular_momentum(self) end subroutine collision_util_get_angular_momentum - module subroutine collision_util_get_kinetic_energy(self) + module subroutine collision_util_get_energy(self) !! Author: David A. Minton !! - !! Calculates the current kinetic energy of the fragments + !! Calculates the current energy of the fragments implicit none ! Argument class(collision_fragments(*)), intent(inout) :: self !! Fragment system object ! Internals - integer(I4B) :: i + integer(I4B) :: i,j + real(DP), dimension(self%nbody) :: pepl associate(fragments => self, nfrag => self%nbody) @@ -222,10 +223,19 @@ module subroutine collision_util_get_kinetic_energy(self) fragments%ke_orbit_tot = sum(fragments%ke_orbit(:)) fragments%ke_spin_tot = sum(fragments%ke_spin(:)) + fragments%pe = 0.0_DP + do i = 1, nfrag + do concurrent(j = i+1:nfrag) + pepl(j) = - (fragments%Gmass(i) * fragments%mass(j)) / .mag.(fragments%rc(:,i) - fragments%rc(:,j)) + end do + fragments%pe = fragments%pe + sum(pepl(i+1:nfrag)) + end do + fragments%be = -sum(3*fragments%Gmass(:)*fragments%mass(:)/(5*fragments%radius(:))) + end associate return - end subroutine collision_util_get_kinetic_energy + end subroutine collision_util_get_energy module subroutine collision_util_get_energy_momentum(self, nbody_system, param, lbefore) @@ -242,9 +252,10 @@ module subroutine collision_util_get_energy_momentum(self, nbody_system, param, class(base_parameters), intent(inout) :: param !! Current swiftest run configuration parameters logical, intent(in) :: lbefore !! Flag indicating that this the "before" state of the nbody_system, with impactors included and fragments excluded or vice versa ! Internals - integer(I4B) :: stage,i + integer(I4B) :: stage,i,j real(DP), dimension(NDIM) :: Lorbit, Lspin - real(DP) :: ke_orbit, ke_spin + real(DP) :: ke_orbit, ke_spin, pe, be + real(DP), dimension(self%fragments%nbody) :: pepl select type(nbody_system) class is (swiftest_nbody_system) @@ -254,7 +265,6 @@ module subroutine collision_util_get_energy_momentum(self, nbody_system, param, if (lbefore) then - Lorbit(:) = sum(impactors%Lorbit(:,:), dim=2) Lspin(:) = sum(impactors%Lspin(:,:), dim=2) ke_orbit = 0.0_DP @@ -265,15 +275,20 @@ module subroutine collision_util_get_energy_momentum(self, nbody_system, param, end do ke_orbit = ke_orbit / 2 ke_spin = ke_spin / 2 + + pe = -(impactors%Gmass(1) * impactors%mass(2)) / .mag.(impactors%rc(:,2) - impactors%rc(:,1)) + be = -sum(3*impactors%Gmass(:)*impactors%mass(:)/(5*impactors%radius(:))) else call fragments%get_angular_momentum() Lorbit(:) = fragments%Lorbit_tot(:) Lspin(:) = fragments%Lspin_tot(:) - call fragments%get_kinetic_energy() + call fragments%get_energy() ke_orbit = fragments%ke_orbit_tot ke_spin = fragments%ke_spin_tot + pe = fragments%pe + be = fragments%be end if ! Calculate the current fragment energy and momentum balances @@ -287,7 +302,9 @@ module subroutine collision_util_get_energy_momentum(self, nbody_system, param, self%Ltot(:,stage) = Lorbit(:) + Lspin(:) self%ke_orbit(stage) = ke_orbit self%ke_spin(stage) = ke_spin - self%Etot(stage) = ke_orbit + ke_spin + self%pe(stage) = pe + self%be(stage) = be + self%Etot(stage) = ke_orbit + ke_spin + pe + be end associate end select end select @@ -429,7 +446,7 @@ module subroutine collision_util_set_budgets(self) associate(impactors => self%impactors, fragments => self%fragments) fragments%L_budget(:) = self%Ltot(:,1) - fragments%ke_budget = self%Etot(1) - impactors%Qloss + fragments%E_budget = self%Etot(1) - impactors%Qloss end associate @@ -616,7 +633,7 @@ module subroutine collision_util_setup_fragments_collider(self, nfrag) self%fragments%L_budget(:) = 0.0_DP self%fragments%ke_orbit_tot = 0.0_DP self%fragments%ke_spin_tot = 0.0_DP - self%fragments%ke_budget = 0.0_DP + self%fragments%E_budget = 0.0_DP return end subroutine collision_util_setup_fragments_collider diff --git a/src/fraggle/fraggle_generate.f90 b/src/fraggle/fraggle_generate.f90 index a68cf7e4f..cce8f2af1 100644 --- a/src/fraggle/fraggle_generate.f90 +++ b/src/fraggle/fraggle_generate.f90 @@ -373,7 +373,7 @@ module subroutine fraggle_generate_vel_vec(collider, lfailure) integer(I4B) :: i, j, loop, try, istart, n, ndof logical :: lhitandrun, lsupercat real(DP), dimension(NDIM) :: vimp_unit, rimp, vrot, Lresidual, vshear, vunit - real(DP) :: vmag, vesc, rotmag, ke_residual, ke_per_dof, ke_tot, ke_residual_min + real(DP) :: vmag, vesc, rotmag, E_residual, ke_per_dof, ke_tot, E_residual_min integer(I4B), dimension(collider%fragments%nbody) :: vsign real(DP), dimension(collider%fragments%nbody) :: vscale, mass_vscale, ke_avail integer(I4B), parameter :: MAXLOOP = 100 @@ -442,30 +442,30 @@ module subroutine fraggle_generate_vel_vec(collider, lfailure) istart = 1 end if call fragments%set_coordinate_system() - ke_residual_min = -huge(1.0_DP) + E_residual_min = -huge(1.0_DP) outer: do try = 1, MAXTRY do loop = 1, MAXLOOP - call fragments%get_kinetic_energy() - ke_residual = fragments%ke_budget - (fragments%ke_orbit_tot + fragments%ke_spin_tot) - if ((abs(ke_residual) < abs(ke_residual_min)) .or. ((ke_residual >= 0.0_DP) .and. (ke_residual_min < 0.0_DP))) then ! This is our best case so far. Save it for posterity + call fragments%get_energy() + E_residual = fragments%E_budget - (fragments%ke_orbit_tot + fragments%ke_spin_tot + fragments%pe + fragments%be) + if ((abs(E_residual) < abs(E_residual_min)) .or. ((E_residual >= 0.0_DP) .and. (E_residual_min < 0.0_DP))) then ! This is our best case so far. Save it for posterity if (allocated(collider%fragments)) deallocate(collider%fragments) allocate(collider%fragments, source=fragments) - ke_residual_min = ke_residual - if ((ke_residual > 0.0_DP) .and. (ke_residual < TOL * fragments%ke_budget)) exit outer + E_residual_min = E_residual + if ((E_residual > 0.0_DP) .and. (E_residual < TOL * fragments%E_budget)) exit outer end if ! Make sure we don't take away too much orbital kinetic energy, otherwise the fragment can't escape ke_avail(:) = fragments%ke_orbit(:) - impactors%Gmass(1)*impactors%mass(2)/fragments%rmag(:) ke_tot = 0.0_DP - ke_per_dof = -ke_residual + ke_per_dof = -E_residual do i = 1, 2*(nfrag - istart + 1) - n = count(ke_avail(istart:nfrag) > -ke_residual/i) - if (ke_residual < 0.0_DP) n = n + count(fragments%ke_spin(istart:nfrag) > -ke_residual/i) + n = count(ke_avail(istart:nfrag) > -E_residual/i) + if (E_residual < 0.0_DP) n = n + count(fragments%ke_spin(istart:nfrag) > -E_residual/i) if (abs(n * ke_per_dof) > ke_tot) then - ke_per_dof = -ke_residual/i + ke_per_dof = -E_residual/i ke_tot = n * ke_per_dof ndof = i - if (abs(ke_tot) > abs(ke_residual)) then - ke_tot = -ke_residual + if (abs(ke_tot) > abs(E_residual)) then + ke_tot = -E_residual ke_per_dof = ke_tot/n exit end if @@ -511,7 +511,7 @@ module subroutine fraggle_generate_vel_vec(collider, lfailure) call fraggle_generate_rot_vec(collider) collider%fail_scale = collider%fail_scale*1.01_DP end do outer - lfailure = ke_residual < 0.0_DP + lfailure = E_residual < 0.0_DP do concurrent(i = 1:nfrag) fragments%vb(:,i) = fragments%vc(:,i) + impactors%vbcom(:) diff --git a/src/fraggle/fraggle_util.f90 b/src/fraggle/fraggle_util.f90 index d405fc2b5..057dfe2b7 100644 --- a/src/fraggle/fraggle_util.f90 +++ b/src/fraggle/fraggle_util.f90 @@ -72,7 +72,7 @@ module subroutine fraggle_util_set_mass_dist(self, param) integer(I4B) :: i, j, jproj, jtarg, nfrag, istart real(DP), dimension(2) :: volume real(DP), dimension(NDIM) :: Ip_avg - real(DP) :: mfrag, mremaining, min_mfrag, mtot, mcumul + real(DP) :: mfrag, mremaining, min_mfrag, mtot, mcumul, G real(DP), parameter :: BETA = 2.85_DP integer(I4B), parameter :: NFRAGMAX = 100 !! Maximum number of fragments that can be generated integer(I4B), parameter :: NFRAGMIN = 7 !! Minimum number of fragments that can be generated (set by the fraggle_generate algorithm for constraining momentum and energy) @@ -86,6 +86,7 @@ module subroutine fraggle_util_set_mass_dist(self, param) ! Get mass weighted mean of Ip and density volume(1:2) = 4._DP / 3._DP * PI * impactors%radius(1:2)**3 mtot = sum(impactors%mass(:)) + G = impactors%Gmass(1) / impactors%mass(1) Ip_avg(:) = (impactors%mass(1) * impactors%Ip(:,1) + impactors%mass(2) * impactors%Ip(:,2)) / mtot if (impactors%mass(1) > impactors%mass(2)) then @@ -133,6 +134,7 @@ module subroutine fraggle_util_set_mass_dist(self, param) select type(fragments => self%fragments) class is (collision_fragments(*)) fragments%mass(1) = impactors%mass_dist(1) + fragments%Gmass(1) = G * impactors%mass_dist(1) fragments%radius(1) = impactors%radius(jtarg) fragments%density(1) = impactors%mass_dist(1) / volume(jtarg) if (param%lrotation) fragments%Ip(:, 1) = impactors%Ip(:,1) @@ -171,6 +173,8 @@ module subroutine fraggle_util_set_mass_dist(self, param) mremaining = fragments%mtot - sum(fragments%mass(1:nfrag)) fragments%mass(nfrag) = fragments%mass(nfrag) + mremaining + fragments%Gmass(:) = G * fragments%mass(:) + ! Compute physical properties of the new fragments select case(impactors%regime) case(COLLRESOLVE_REGIME_HIT_AND_RUN) ! The hit and run case always preserves the largest body intact, so there is no need to recompute the physical properties of the first fragment @@ -190,25 +194,25 @@ module subroutine fraggle_util_set_mass_dist(self, param) ! For catastrophic impacts, we will assign each of the n>2 fragments to one of the two original bodies so that the fragment cloud occupies ! roughly the same space as both original bodies. For all other disruption cases, we use body 2 as the center of the cloud. - fragments%origin_body(1) = 1 - fragments%origin_body(2) = 2 - if (impactors%regime == COLLRESOLVE_REGIME_SUPERCATASTROPHIC) then - mcumul = fragments%mass(1) - flipper = .true. - j = 2 - do i = 1, nfrag - if (flipper .and. (mcumul < impactors%mass(1))) then - flipper = .false. - j = 1 - else - j = 2 - flipper = .true. - end if - fragments%origin_body(i) = j - end do - else - fragments%origin_body(3:nfrag) = 2 - end if + fragments%origin_body(1) = 1 + fragments%origin_body(2) = 2 + if (impactors%regime == COLLRESOLVE_REGIME_SUPERCATASTROPHIC) then + mcumul = fragments%mass(1) + flipper = .true. + j = 2 + do i = 1, nfrag + if (flipper .and. (mcumul < impactors%mass(1))) then + flipper = .false. + j = 1 + else + j = 2 + flipper = .true. + end if + fragments%origin_body(i) = j + end do + else + fragments%origin_body(3:nfrag) = 2 + end if end select @@ -263,10 +267,11 @@ module subroutine fraggle_util_set_natural_scale_factors(self) impactors%rot(:,i) = impactors%Lspin(:,i) / (impactors%mass(i) * impactors%radius(i)**2 * impactors%Ip(3,i)) end do - fragments%mtot = fragments%mtot / collider%mscale - fragments%mass = fragments%mass / collider%mscale - fragments%radius = fragments%radius / collider%dscale - impactors%Qloss = impactors%Qloss / collider%Escale + fragments%mtot = fragments%mtot / collider%mscale + fragments%mass(:) = fragments%mass(:) / collider%mscale + fragments%Gmass(:) = fragments%Gmass(:) / (collider%dscale**3/collider%tscale**2) + fragments%radius(:) = fragments%radius(:) / collider%dscale + impactors%Qloss = impactors%Qloss / collider%Escale end associate return @@ -310,12 +315,13 @@ module subroutine fraggle_util_set_original_scale_factors(self) impactors%rot(:,i) = impactors%Lspin(:,i) * (impactors%mass(i) * impactors%radius(i)**2 * impactors%Ip(3,i)) end do - fragments%mtot = fragments%mtot * collider%mscale - fragments%mass = fragments%mass * collider%mscale - fragments%radius = fragments%radius * collider%dscale - fragments%rot = fragments%rot / collider%tscale - fragments%rc = fragments%rc * collider%dscale - fragments%vc = fragments%vc * collider%vscale + fragments%mtot = fragments%mtot * collider%mscale + fragments%mass(:) = fragments%mass(:) * collider%mscale + fragments%Gmass(:) = fragments%Gmass(:) * (collider%dscale**3/collider%tscale**2) + fragments%radius(:) = fragments%radius(:) * collider%dscale + fragments%rot(:,:) = fragments%rot(:,:) / collider%tscale + fragments%rc(:,:) = fragments%rc(:,:) * collider%dscale + fragments%vc(:,:) = fragments%vc(:,:) * collider%vscale do i = 1, fragments%nbody fragments%rb(:, i) = fragments%rc(:, i) + impactors%rbcom(:) @@ -330,6 +336,7 @@ module subroutine fraggle_util_set_original_scale_factors(self) collider%ke_orbit(:) = collider%ke_orbit(:) * collider%Escale collider%ke_spin(:) = collider%ke_spin(:) * collider%Escale collider%pe(:) = collider%pe(:) * collider%Escale + collider%be(:) = collider%be(:) * collider%Escale collider%Etot(:) = collider%Etot(:) * collider%Escale collider%mscale = 1.0_DP diff --git a/src/netcdf_io/netcdf_io_module.f90 b/src/netcdf_io/netcdf_io_module.f90 index 7199451b0..3926d2eea 100644 --- a/src/netcdf_io/netcdf_io_module.f90 +++ b/src/netcdf_io/netcdf_io_module.f90 @@ -96,24 +96,26 @@ module netcdf_io 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 nbody_system orbital kinetic energy variable - integer(I4B) :: KE_orb_varid !! ID for the nbody_system orbital kinetic energy variable - character(NAMELEN) :: ke_spin_varname = "KE_spin" !! name of the nbody_system spin kinetic energy variable - integer(I4B) :: KE_spin_varid !! ID for the nbody_system spin kinetic energy variable - character(NAMELEN) :: pe_varname = "PE" !! name of the nbody_system potential energy variable - integer(I4B) :: PE_varid !! ID for the nbody_system potential energy variable + character(NAMELEN) :: ke_orb_varname = "KE_orb" !! name of the system orbital kinetic energy variable + integer(I4B) :: KE_orb_varid !! ID for the system orbital kinetic energy variable + character(NAMELEN) :: ke_spin_varname = "KE_spin" !! name of the system spin kinetic energy variable + integer(I4B) :: KE_spin_varid !! ID for the system spin kinetic energy variable + character(NAMELEN) :: pe_varname = "PE" !! name of the system potential energy variable + integer(I4B) :: PE_varid !! ID for the system potential energy variable + character(NAMELEN) :: be_varname = "BE" !! name of the system binding energy variable + integer(I4B) :: BE_varid !! ID for the system binding energy variable character(NAMELEN) :: L_orb_varname = "L_orb" !! name of the orbital angular momentum vector variable - integer(I4B) :: L_orb_varid !! ID for the nbody_system orbital angular momentum vector variable + integer(I4B) :: L_orb_varid !! ID for the system orbital angular momentum vector variable character(NAMELEN) :: Lspin_varname = "Lspin" !! name of the spin angular momentum vector variable - integer(I4B) :: Lspin_varid !! ID for the nbody_system spin angular momentum vector variable + integer(I4B) :: Lspin_varid !! ID for the system spin angular momentum vector variable character(NAMELEN) :: L_escape_varname = "L_escape" !! name of the escaped angular momentum vector variable integer(I4B) :: L_escape_varid !! ID for the escaped angular momentum vector variable character(NAMELEN) :: Ecollisions_varname = "Ecollisions" !! name of the escaped angular momentum y variable integer(I4B) :: Ecollisions_varid !! ID for the energy lost in collisions variable character(NAMELEN) :: Euntracked_varname = "Euntracked" !! name of the energy that is untracked due to loss (untracked potential energy due to mergers and body energy for escaped bodies) integer(I4B) :: Euntracked_varid !! ID for the energy that is untracked due to loss (untracked potential energy due to mergers and body energy for escaped bodies) - character(NAMELEN) :: GMescape_varname = "GMescape" !! name of the G*Mass of bodies that escape the nbody_system - integer(I4B) :: GMescape_varid !! ID for the G*Mass of bodies that escape the nbody_system + character(NAMELEN) :: GMescape_varname = "GMescape" !! name of the G*Mass of bodies that escape the system + integer(I4B) :: GMescape_varid !! ID for the G*Mass of bodies that escape the system character(NAMELEN) :: origin_type_varname = "origin_type" !! name of the origin type variable (Initial Conditions, Disruption, etc.) integer(I4B) :: origin_type_varid !! ID for the origin type character(NAMELEN) :: origin_time_varname = "origin_time" !! name of the time of origin variable diff --git a/src/swiftest/swiftest_io.f90 b/src/swiftest/swiftest_io.f90 index 5f1a90276..fe4ecba18 100644 --- a/src/swiftest/swiftest_io.f90 +++ b/src/swiftest/swiftest_io.f90 @@ -121,7 +121,7 @@ module subroutine swiftest_io_conservation_report(self, param, lterminal) logical, intent(in) :: lterminal !! Indicates whether to output information to the terminal screen ! Internals real(DP), dimension(NDIM) :: Ltot_now, Lorbit_now, Lspin_now - real(DP) :: ke_orbit_now, ke_spin_now, pe_now, Eorbit_now + real(DP) :: ke_orbit_now, ke_spin_now, pe_now, Eorbit_now, be_now real(DP) :: GMtot_now character(len=STRMAX) :: errmsg integer(I4B), parameter :: EGYIU = 72 @@ -139,9 +139,10 @@ module subroutine swiftest_io_conservation_report(self, param, lterminal) ke_orbit_now = nbody_system%ke_orbit ke_spin_now = nbody_system%ke_spin pe_now = nbody_system%pe + be_now = nbody_system%be Lorbit_now(:) = nbody_system%Lorbit(:) Lspin_now(:) = nbody_system%Lspin(:) - Eorbit_now = ke_orbit_now + ke_spin_now + pe_now + Eorbit_now = ke_orbit_now + ke_spin_now + pe_now + be_now Ltot_now(:) = nbody_system%Ltot(:) + nbody_system%Lescape(:) GMtot_now = nbody_system%GMtot + nbody_system%GMescape @@ -149,6 +150,7 @@ module subroutine swiftest_io_conservation_report(self, param, lterminal) nbody_system%ke_orbit_orig = ke_orbit_now nbody_system%ke_spin_orig = ke_spin_now nbody_system%pe_orig = pe_now + nbody_system%be_orig = be_now nbody_system%Eorbit_orig = Eorbit_now nbody_system%GMtot_orig = GMtot_now nbody_system%Lorbit_orig(:) = Lorbit_now(:) @@ -161,6 +163,7 @@ module subroutine swiftest_io_conservation_report(self, param, lterminal) nbody_system%ke_orbit_error = (ke_orbit_now - nbody_system%ke_orbit_orig) / abs(nbody_system%Eorbit_orig) nbody_system%ke_spin_error = (ke_spin_now - nbody_system%ke_spin_orig) / abs(nbody_system%Eorbit_orig) nbody_system%pe_error = (pe_now - nbody_system%pe_orig) / abs(nbody_system%Eorbit_orig) + nbody_system%be_error = (be_now - nbody_system%be_orig) / abs(nbody_system%Eorbit_orig) nbody_system%Eorbit_error = (Eorbit_now - nbody_system%Eorbit_orig) / abs(nbody_system%Eorbit_orig) nbody_system%Ecoll_error = nbody_system%Ecollisions / abs(nbody_system%Eorbit_orig) nbody_system%Euntracked_error = nbody_system%Euntracked / abs(nbody_system%Eorbit_orig) @@ -512,7 +515,7 @@ module function swiftest_io_netcdf_get_old_t_final_system(self, param) result(ol real(DP), dimension(:), allocatable :: vals real(DP), dimension(1) :: rtemp real(DP), dimension(NDIM) :: rot0, Ip0, Lnow - real(DP) :: KE_orb_orig, KE_spin_orig, PE_orig + real(DP) :: KE_orb_orig, KE_spin_orig, PE_orig, BE_orig associate (nc => param%system_history%nc, cb => self%cb) call nc%open(param) @@ -534,10 +537,13 @@ module function swiftest_io_netcdf_get_old_t_final_system(self, param) result(ol call netcdf_io_check( nf90_get_var(nc%id, nc%PE_varid, rtemp, start=[1], count=[1]), "netcdf_io_get_old_t_final_system PE_varid" ) PE_orig = rtemp(1) + call netcdf_io_check( nf90_get_var(nc%id, nc%BE_varid, rtemp, start=[1], count=[1]), "netcdf_io_get_old_t_final_system BE_varid" ) + BE_orig = rtemp(1) + call netcdf_io_check( nf90_get_var(nc%id, nc%Ecollisions_varid, self%Ecollisions, start=[1]), "netcdf_io_get_old_t_final_system Ecollisions_varid" ) call netcdf_io_check( nf90_get_var(nc%id, nc%Euntracked_varid, self%Euntracked, start=[1]), "netcdf_io_get_old_t_final_system Euntracked_varid" ) - self%Eorbit_orig = KE_orb_orig + KE_spin_orig + PE_orig + self%Ecollisions + self%Euntracked + self%Eorbit_orig = KE_orb_orig + KE_spin_orig + PE_orig + BE_orig + self%Ecollisions + self%Euntracked call netcdf_io_check( nf90_get_var(nc%id, nc%L_orb_varid, self%Lorbit_orig(:), start=[1,1], count=[NDIM,1]), "netcdf_io_get_old_t_final_system L_orb_varid" ) call netcdf_io_check( nf90_get_var(nc%id, nc%Lspin_varid, self%Lspin_orig(:), start=[1,1], count=[NDIM,1]), "netcdf_io_get_old_t_final_system Lspin_varid" ) @@ -698,6 +704,7 @@ module subroutine swiftest_io_netcdf_initialize_output(self, param) call netcdf_io_check( nf90_def_var(nc%id, nc%ke_orb_varname, nc%out_type, nc%time_dimid, nc%KE_orb_varid), "netcdf_io_initialize_output nf90_def_var KE_orb_varid" ) call netcdf_io_check( nf90_def_var(nc%id, nc%ke_spin_varname, nc%out_type, nc%time_dimid, nc%KE_spin_varid), "netcdf_io_initialize_output nf90_def_var KE_spin_varid" ) call netcdf_io_check( nf90_def_var(nc%id, nc%pe_varname, nc%out_type, nc%time_dimid, nc%PE_varid), "netcdf_io_initialize_output nf90_def_var PE_varid" ) + call netcdf_io_check( nf90_def_var(nc%id, nc%be_varname, nc%out_type, nc%time_dimid, nc%BE_varid), "netcdf_io_initialize_output nf90_def_var PE_varid" ) call netcdf_io_check( nf90_def_var(nc%id, nc%L_orb_varname, nc%out_type, [nc%space_dimid, nc%time_dimid], nc%L_orb_varid), "netcdf_io_initialize_output nf90_def_var L_orb_varid" ) call netcdf_io_check( nf90_def_var(nc%id, nc%Lspin_varname, nc%out_type, [nc%space_dimid, nc%time_dimid], nc%Lspin_varid), "netcdf_io_initialize_output nf90_def_var Lspin_varid" ) call netcdf_io_check( nf90_def_var(nc%id, nc%L_escape_varname, nc%out_type, [nc%space_dimid, nc%time_dimid], nc%L_escape_varid), "netcdf_io_initialize_output nf90_def_var L_escape_varid" ) @@ -861,6 +868,7 @@ module subroutine swiftest_io_netcdf_open(self, param, readonly) status = nf90_inq_varid(nc%id, nc%ke_orb_varname, nc%KE_orb_varid) status = nf90_inq_varid(nc%id, nc%ke_spin_varname, nc%KE_spin_varid) status = nf90_inq_varid(nc%id, nc%pe_varname, nc%PE_varid) + status = nf90_inq_varid(nc%id, nc%be_varname, nc%BE_varid) status = nf90_inq_varid(nc%id, nc%L_orb_varname, nc%L_orb_varid) status = nf90_inq_varid(nc%id, nc%Lspin_varname, nc%Lspin_varid) status = nf90_inq_varid(nc%id, nc%L_escape_varname, nc%L_escape_varid) @@ -1182,6 +1190,8 @@ module subroutine swiftest_io_netcdf_read_hdr_system(self, nc, param) if (status == nf90_noerr) call netcdf_io_check( nf90_get_var(nc%id, nc%KE_spin_varid, self%ke_spin, start=[tslot]), "netcdf_io_read_hdr_system nf90_getvar KE_spin_varid" ) status = nf90_inq_varid(nc%id, nc%pe_varname, nc%PE_varid) if (status == nf90_noerr) call netcdf_io_check( nf90_get_var(nc%id, nc%PE_varid, self%pe, start=[tslot]), "netcdf_io_read_hdr_system nf90_getvar PE_varid" ) + status = nf90_inq_varid(nc%id, nc%be_varname, nc%BE_varid) + if (status == nf90_noerr) call netcdf_io_check( nf90_get_var(nc%id, nc%BE_varid, self%be, start=[tslot]), "netcdf_io_read_hdr_system nf90_getvar BE_varid" ) status = nf90_inq_varid(nc%id, nc%L_orb_varname, nc%L_orb_varid) if (status == nf90_noerr) call netcdf_io_check( nf90_get_var(nc%id, nc%L_orb_varid, self%Lorbit(:), start=[1,tslot], count=[NDIM,1]), "netcdf_io_read_hdr_system nf90_getvar L_orb_varid" ) status = nf90_inq_varid(nc%id, nc%Lspin_varname, nc%Lspin_varid) @@ -1606,6 +1616,7 @@ module subroutine swiftest_io_netcdf_write_hdr_system(self, nc, param) call netcdf_io_check( nf90_put_var(nc%id, nc%KE_orb_varid, self%ke_orbit, start=[tslot]), "netcdf_io_write_hdr_system nf90_put_var KE_orb_varid" ) call netcdf_io_check( nf90_put_var(nc%id, nc%KE_spin_varid, self%ke_spin, start=[tslot]), "netcdf_io_write_hdr_system nf90_put_var KE_spin_varid" ) call netcdf_io_check( nf90_put_var(nc%id, nc%PE_varid, self%pe, start=[tslot]), "netcdf_io_write_hdr_system nf90_put_var PE_varid" ) + call netcdf_io_check( nf90_put_var(nc%id, nc%BE_varid, self%be, start=[tslot]), "netcdf_io_write_hdr_system nf90_put_var BE_varid" ) call netcdf_io_check( nf90_put_var(nc%id, nc%L_orb_varid, self%Lorbit(:), start=[1,tslot], count=[NDIM,1]), "netcdf_io_write_hdr_system nf90_put_var L_orb_varid" ) call netcdf_io_check( nf90_put_var(nc%id, nc%Lspin_varid, self%Lspin(:), start=[1,tslot], count=[NDIM,1]), "netcdf_io_write_hdr_system nf90_put_var Lspin_varid" ) call netcdf_io_check( nf90_put_var(nc%id, nc%L_escape_varid, self%Lescape(:), start=[1,tslot], count=[NDIM,1]), "netcdf_io_write_hdr_system nf90_put_var L_escape_varid" ) diff --git a/src/swiftest/swiftest_module.f90 b/src/swiftest/swiftest_module.f90 index a492bdda6..39a6b65e5 100644 --- a/src/swiftest/swiftest_module.f90 +++ b/src/swiftest/swiftest_module.f90 @@ -331,6 +331,7 @@ module swiftest real(DP) :: ke_orbit = 0.0_DP !! nbody_system orbital kinetic energy real(DP) :: ke_spin = 0.0_DP !! nbody_system spin kinetic energy real(DP) :: pe = 0.0_DP !! nbody_system potential energy + real(DP) :: be = 0.0_DP !! nbody_system binding energy of all bodies real(DP) :: te = 0.0_DP !! nbody_system total energy real(DP) :: oblpot = 0.0_DP !! nbody_system potential energy due to oblateness of the central body real(DP), dimension(NDIM) :: Lorbit = 0.0_DP !! nbody_system orbital angular momentum vector @@ -339,6 +340,7 @@ module swiftest real(DP) :: ke_orbit_orig = 0.0_DP !! Initial orbital kinetic energy real(DP) :: ke_spin_orig = 0.0_DP !! Initial spin kinetic energy real(DP) :: pe_orig = 0.0_DP !! Initial potential energy + real(DP) :: be_orig = 0.0_DP !! Initial binding energy real(DP) :: Eorbit_orig = 0.0_DP !! Initial orbital energy real(DP) :: GMtot_orig = 0.0_DP !! Initial nbody_system mass real(DP), dimension(NDIM) :: Ltot_orig = 0.0_DP !! Initial total angular momentum vector @@ -353,6 +355,7 @@ module swiftest real(DP) :: ke_orbit_error = 0.0_DP real(DP) :: ke_spin_error = 0.0_DP real(DP) :: pe_error = 0.0_DP + real(DP) :: be_error = 0.0_DP real(DP) :: Eorbit_error = 0.0_DP real(DP) :: Ecoll_error = 0.0_DP real(DP) :: Euntracked_error = 0.0_DP diff --git a/src/swiftest/swiftest_util.f90 b/src/swiftest/swiftest_util.f90 index e3e0fccee..45b91aa73 100644 --- a/src/swiftest/swiftest_util.f90 +++ b/src/swiftest/swiftest_util.f90 @@ -1322,7 +1322,9 @@ module subroutine swiftest_util_get_energy_momentum_system(self, param) nbody_system%Lspin(3) = Lcbspin(3) + sum(Lplspinz(1:npl), pl%lmask(1:npl)) end if - nbody_system%te = nbody_system%ke_orbit + nbody_system%ke_spin + nbody_system%pe + nbody_system%be = sum(-3*pl%Gmass(1:npl)*pl%mass(1:npl)/(5*pl%radius(1:npl)), pl%lmask(1:npl)) + + nbody_system%te = nbody_system%ke_orbit + nbody_system%ke_spin + nbody_system%pe + nbody_system%be nbody_system%Ltot(:) = nbody_system%Lorbit(:) + nbody_system%Lspin(:) end associate diff --git a/src/symba/symba_discard.f90 b/src/symba/symba_discard.f90 index cdeeeb0fe..216ab5f28 100644 --- a/src/symba/symba_discard.f90 +++ b/src/symba/symba_discard.f90 @@ -117,14 +117,15 @@ subroutine symba_discard_conserve_mtm(pl, nbody_system, param, ipl, lescape_body logical, intent(in) :: lescape_body ! Internals real(DP), dimension(NDIM) :: Lpl, Ltot, Lcb, xcom, vcom - real(DP) :: pe, ke_orbit, ke_spin + real(DP) :: pe, be, ke_orbit, ke_spin integer(I4B) :: i, oldstat select type(cb => nbody_system%cb) class is (symba_cb) - ! Add the potential and kinetic energy of the lost body to the records + ! Add the potential, binding, and kinetic energy of the lost body to the records pe = -cb%Gmass * pl%mass(ipl) / norm2(pl%rb(:, ipl) - cb%rb(:)) + be = -3*pl%Gmass(ipl) * pl%mass(ipl) / (5 * pl%radius(ipl)) ke_orbit = 0.5_DP * pl%mass(ipl) * dot_product(pl%vb(:, ipl), pl%vb(:, ipl)) if (param%lrotation) then ke_spin = 0.5_DP * pl%mass(ipl) * pl%radius(ipl)**2 * pl%Ip(3, ipl) * dot_product(pl%rot(:, ipl), pl%rot(:, ipl)) @@ -194,11 +195,8 @@ subroutine symba_discard_conserve_mtm(pl, nbody_system, param, ipl, lescape_body ! We must do this for proper book-keeping, since we can no longer track this body's contribution to energy directly if (lescape_body) then - nbody_system%Ecollisions = nbody_system%Ecollisions + ke_orbit + ke_spin + pe - nbody_system%Euntracked = nbody_system%Euntracked - (ke_orbit + ke_spin + pe) - else - nbody_system%Ecollisions = nbody_system%Ecollisions + pe - nbody_system%Euntracked = nbody_system%Euntracked - pe + nbody_system%Ecollisions = nbody_system%Ecollisions + ke_orbit + ke_spin + pe + be + nbody_system%Euntracked = nbody_system%Euntracked - (ke_orbit + ke_spin + pe + be) end if end select From 642c64622889ce90342a97a7d0c41408e739b98a Mon Sep 17 00:00:00 2001 From: David A Minton Date: Sun, 1 Jan 2023 16:02:51 -0500 Subject: [PATCH 566/569] Fixed Python driver bugs --- python/swiftest/swiftest/simulation_class.py | 18 +++++++----------- 1 file changed, 7 insertions(+), 11 deletions(-) diff --git a/python/swiftest/swiftest/simulation_class.py b/python/swiftest/swiftest/simulation_class.py index e4fa80049..612aeb4b0 100644 --- a/python/swiftest/swiftest/simulation_class.py +++ b/python/swiftest/swiftest/simulation_class.py @@ -328,8 +328,6 @@ def __init__(self,read_param: bool = False, read_old_output: bool = False, simdi else: if read_old_output or read_param: raise NotADirectoryError(f"Cannot find directory {self.simdir.resolve()} ") - else: - self.simdir.mkdir(parents=True, exist_ok=False) # Set the location of the parameter input file, choosing the default if it isn't specified. param_file = kwargs.pop("param_file",Path.cwd() / self.simdir / "param.in") @@ -1279,9 +1277,8 @@ def get_feature(self, arg_list: str | List[str] | None = None, verbose: bool | N key = valid_var[arg] if key in feature_dict: if arg == "minimum_fragment_gmass": - if self.param['FRAGMENTATION']: - print(f"{arg:<{self._getter_column_width}} {feature_dict[key]} {self.DU_name}^3 / {self.TU_name}^2 ") - print(f"{'minimum_fragment_mass':<{self._getter_column_width}} {feature_dict[key] / self.GU} {self.MU_name}") + print(f"{arg:<{self._getter_column_width}} {feature_dict[key]} {self.DU_name}^3 / {self.TU_name}^2 ") + print(f"{'minimum_fragment_mass':<{self._getter_column_width}} {feature_dict[key] / self.GU} {self.MU_name}") else: print(f"{arg:<{self._getter_column_width}} {feature_dict[key]}") else: @@ -2174,7 +2171,6 @@ def add_solar_system_body(self, return - def set_ephemeris_date(self, ephemeris_date: str | None = None, verbose: bool | None = None, @@ -2638,7 +2634,8 @@ def write_param(self, if verbose: print(f"Writing parameter inputs to file {param_file}") param['! VERSION'] = f"{codename} input file" - + + self.simdir.mkdir(parents=True, exist_ok=True) # Check to see if the parameter type matches the output type. If not, we need to convert if codename == "Swifter" or codename == "Swiftest": if param['IN_TYPE'] == "ASCII": @@ -2781,7 +2778,6 @@ def _preprocess(ds, param): return - def read_collisions(self): col_files = glob(f"{self.simdir}{os.path.sep}collision_*.nc") if len(col_files) == 0: @@ -2801,7 +2797,6 @@ def _preprocess(ds, param): return - def follow(self, codestyle="Swifter"): """ An implementation of the Swift tool_follow algorithm. Under development. Currently only for Swift simulations. @@ -2871,8 +2866,8 @@ def save(self, if "verbose" in kwargs: verbose = kwargs['verbose'] else: - verbose = self%verbose - + verbose = self.verbose + if codename is None: codename = self.codename if param_file is None: @@ -2880,6 +2875,7 @@ def save(self, if param is None: param = self.param + self.simdir.mkdir(parents=True, exist_ok=True) if codename == "Swiftest": 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) From b63ca31aa8421e0a4ae99201d7479a2b2e337efe Mon Sep 17 00:00:00 2001 From: David A Minton Date: Sun, 1 Jan 2023 17:26:39 -0500 Subject: [PATCH 567/569] Fixed bug that was throwing a segfault when not in debug mode --- src/swiftest/swiftest_util.f90 | 179 ++++++++++++++++----------------- 1 file changed, 88 insertions(+), 91 deletions(-) diff --git a/src/swiftest/swiftest_util.f90 b/src/swiftest/swiftest_util.f90 index 45b91aa73..73b4ef5b6 100644 --- a/src/swiftest/swiftest_util.f90 +++ b/src/swiftest/swiftest_util.f90 @@ -2552,104 +2552,101 @@ module subroutine swiftest_util_setup_construct_system(nbody_system, param) type(encounter_storage) :: encounter_history type(collision_storage) :: collision_history - select type(param) - class is (swiftest_parameters) - allocate(swiftest_storage(param%dump_cadence) :: param%system_history) - allocate(swiftest_netcdf_parameters :: param%system_history%nc) - call param%system_history%reset() - - select case(param%integrator) - case (INT_BS) - write(*,*) 'Bulirsch-Stoer integrator not yet enabled' - case (INT_HELIO) - allocate(helio_nbody_system :: nbody_system) - select type(nbody_system) - class is (helio_nbody_system) - allocate(helio_cb :: nbody_system%cb) - allocate(helio_pl :: nbody_system%pl) - allocate(helio_tp :: nbody_system%tp) - allocate(helio_tp :: nbody_system%tp_discards) - end select - param%collision_model = "MERGE" - case (INT_RA15) - write(*,*) 'Radau integrator not yet enabled' - case (INT_TU4) - write(*,*) 'INT_TU4 integrator not yet enabled' - case (INT_WHM) - allocate(whm_nbody_system :: nbody_system) - select type(nbody_system) - class is (whm_nbody_system) - allocate(whm_cb :: nbody_system%cb) - allocate(whm_pl :: nbody_system%pl) - allocate(whm_tp :: nbody_system%tp) - allocate(whm_tp :: nbody_system%tp_discards) - end select - param%collision_model = "MERGE" - case (INT_RMVS) - allocate(rmvs_nbody_system :: nbody_system) - select type(nbody_system) - class is (rmvs_nbody_system) - allocate(rmvs_cb :: nbody_system%cb) - allocate(rmvs_pl :: nbody_system%pl) - allocate(rmvs_tp :: nbody_system%tp) - allocate(rmvs_tp :: nbody_system%tp_discards) - end select - param%collision_model = "MERGE" - case (INT_SYMBA) - allocate(symba_nbody_system :: nbody_system) - select type(nbody_system) - class is (symba_nbody_system) - allocate(symba_cb :: nbody_system%cb) - allocate(symba_pl :: nbody_system%pl) - allocate(symba_tp :: nbody_system%tp) - - allocate(symba_tp :: nbody_system%tp_discards) - allocate(symba_pl :: nbody_system%pl_adds) - allocate(symba_pl :: nbody_system%pl_discards) - - allocate(symba_list_pltp :: nbody_system%pltp_encounter) - allocate(symba_list_plpl :: nbody_system%plpl_encounter) - allocate(collision_list_plpl :: nbody_system%plpl_collision) - - if (param%lenc_save_trajectory .or. param%lenc_save_closest) then - allocate(encounter_netcdf_parameters :: encounter_history%nc) - call encounter_history%reset() - select type(nc => encounter_history%nc) - class is (encounter_netcdf_parameters) - nc%file_number = param%iloop / param%dump_cadence - end select - allocate(nbody_system%encounter_history, source=encounter_history) - end if - - allocate(collision_netcdf_parameters :: collision_history%nc) - call collision_history%reset() - select type(nc => collision_history%nc) - class is (collision_netcdf_parameters) + allocate(swiftest_storage(param%dump_cadence) :: param%system_history) + allocate(swiftest_netcdf_parameters :: param%system_history%nc) + call param%system_history%reset() + + select case(param%integrator) + case (INT_BS) + write(*,*) 'Bulirsch-Stoer integrator not yet enabled' + case (INT_HELIO) + allocate(helio_nbody_system :: nbody_system) + select type(nbody_system) + class is (helio_nbody_system) + allocate(helio_cb :: nbody_system%cb) + allocate(helio_pl :: nbody_system%pl) + allocate(helio_tp :: nbody_system%tp) + allocate(helio_tp :: nbody_system%tp_discards) + end select + param%collision_model = "MERGE" + case (INT_RA15) + write(*,*) 'Radau integrator not yet enabled' + case (INT_TU4) + write(*,*) 'INT_TU4 integrator not yet enabled' + case (INT_WHM) + allocate(whm_nbody_system :: nbody_system) + select type(nbody_system) + class is (whm_nbody_system) + allocate(whm_cb :: nbody_system%cb) + allocate(whm_pl :: nbody_system%pl) + allocate(whm_tp :: nbody_system%tp) + allocate(whm_tp :: nbody_system%tp_discards) + end select + param%collision_model = "MERGE" + case (INT_RMVS) + allocate(rmvs_nbody_system :: nbody_system) + select type(nbody_system) + class is (rmvs_nbody_system) + allocate(rmvs_cb :: nbody_system%cb) + allocate(rmvs_pl :: nbody_system%pl) + allocate(rmvs_tp :: nbody_system%tp) + allocate(rmvs_tp :: nbody_system%tp_discards) + end select + param%collision_model = "MERGE" + case (INT_SYMBA) + allocate(symba_nbody_system :: nbody_system) + select type(nbody_system) + class is (symba_nbody_system) + allocate(symba_cb :: nbody_system%cb) + allocate(symba_pl :: nbody_system%pl) + allocate(symba_tp :: nbody_system%tp) + + allocate(symba_tp :: nbody_system%tp_discards) + allocate(symba_pl :: nbody_system%pl_adds) + allocate(symba_pl :: nbody_system%pl_discards) + + allocate(symba_list_pltp :: nbody_system%pltp_encounter) + allocate(symba_list_plpl :: nbody_system%plpl_encounter) + allocate(collision_list_plpl :: nbody_system%plpl_collision) + + if (param%lenc_save_trajectory .or. param%lenc_save_closest) then + allocate(encounter_netcdf_parameters :: encounter_history%nc) + call encounter_history%reset() + select type(nc => encounter_history%nc) + class is (encounter_netcdf_parameters) nc%file_number = param%iloop / param%dump_cadence end select - allocate(nbody_system%collision_history, source=collision_history) - + allocate(nbody_system%encounter_history, source=encounter_history) + end if + + allocate(collision_netcdf_parameters :: collision_history%nc) + call collision_history%reset() + select type(nc => collision_history%nc) + class is (collision_netcdf_parameters) + nc%file_number = param%iloop / param%dump_cadence end select - case (INT_RINGMOONS) - write(*,*) 'RINGMOONS-SyMBA integrator not yet enabled' - case default - write(*,*) 'Unkown integrator',param%integrator - call util_exit(FAILURE) - end select + allocate(nbody_system%collision_history, source=collision_history) - allocate(swiftest_particle_info :: nbody_system%cb%info) - - select case(param%collision_model) - case("MERGE") - allocate(collision_basic :: nbody_system%collider) - case("BOUNCE") - allocate(collision_bounce :: nbody_system%collider) - case("FRAGGLE") - allocate(collision_fraggle :: nbody_system%collider) end select - call nbody_system%collider%setup(nbody_system) + case (INT_RINGMOONS) + write(*,*) 'RINGMOONS-SyMBA integrator not yet enabled' + case default + write(*,*) 'Unkown integrator',param%integrator + call util_exit(FAILURE) + end select + allocate(swiftest_particle_info :: nbody_system%cb%info) + + select case(param%collision_model) + case("MERGE") + allocate(collision_basic :: nbody_system%collider) + case("BOUNCE") + allocate(collision_bounce :: nbody_system%collider) + case("FRAGGLE") + allocate(collision_fraggle :: nbody_system%collider) end select + call nbody_system%collider%setup(nbody_system) + return end subroutine swiftest_util_setup_construct_system From 86a707f99edff45c25617da9c8e21745ea262aca Mon Sep 17 00:00:00 2001 From: David A Minton Date: Mon, 2 Jan 2023 11:02:15 -0500 Subject: [PATCH 568/569] Fixed bugs prevening SyMBA variables from being written to dump parameter file --- python/swiftest/swiftest/init_cond.py | 4 ++-- src/swiftest/swiftest_io.f90 | 13 ++++++++++--- 2 files changed, 12 insertions(+), 5 deletions(-) diff --git a/python/swiftest/swiftest/init_cond.py b/python/swiftest/swiftest/init_cond.py index 8dcf08cf2..02ff6f8e1 100644 --- a/python/swiftest/swiftest/init_cond.py +++ b/python/swiftest/swiftest/init_cond.py @@ -285,8 +285,8 @@ def vec2xr(param: Dict, **kwargs: Any): if param['ROTATION']: if "rot" not in kwargs and "Gmass" in kwargs: kwargs['rot'] = np.zeros((len(kwargs['Gmass']),3)) - if "Ip" not in kwargs and "rot" in kwargs: - kwargs['Ip'] = np.full_like(kwargs['rot'], 0.4) + if "Ip" not in kwargs and "Gmass" in kwargs: + kwargs['Ip'] = np.full_like(kwargs['Gmass'], 0.4) if "time" not in kwargs: kwargs["time"] = np.array([0.0]) diff --git a/src/swiftest/swiftest_io.f90 b/src/swiftest/swiftest_io.f90 index fe4ecba18..8ae50ba2d 100644 --- a/src/swiftest/swiftest_io.f90 +++ b/src/swiftest/swiftest_io.f90 @@ -2094,7 +2094,6 @@ module subroutine swiftest_io_param_reader(self, unit, iotype, v_list, iostat, i return end if - if ((param%collision_model /= "MERGE") .and. & (param%collision_model /= "BOUNCE") .and. & (param%collision_model /= "FRAGGLE")) then @@ -2127,7 +2126,6 @@ module subroutine swiftest_io_param_reader(self, unit, iotype, v_list, iostat, i param%inv_c2 = (param%inv_c2)**(-2) end if - select case(trim(adjustl(param%interaction_loops))) case("ADAPTIVE") param%ladaptive_interactions = .true. @@ -2230,6 +2228,7 @@ module subroutine swiftest_io_param_writer(self, unit, iotype, v_list, iostat, i character(*),parameter :: Ifmt = '(I0)' !! Format label for integer values character(*),parameter :: Rfmt = '(ES25.17)' !! Format label for real values character(*),parameter :: Lfmt = '(L1)' !! Format label for logical values + integer(I4B) :: nseeds associate(param => self) call io_param_writer_one("T0", param%t0, unit) @@ -2275,6 +2274,7 @@ module subroutine swiftest_io_param_writer(self, unit, iotype, v_list, iostat, i call io_param_writer_one("INTERACTION_LOOPS", param%interaction_loops, unit) call io_param_writer_one("ENCOUNTER_CHECK_PLPL", param%encounter_check_plpl, unit) call io_param_writer_one("ENCOUNTER_CHECK_PLTP", param%encounter_check_pltp, unit) + call io_param_writer_one("ENCOUNTER_SAVE", param%encounter_save, unit) if (param%lenergy) then call io_param_writer_one("FIRSTENERGY", param%lfirstenergy, unit) @@ -2282,6 +2282,14 @@ module subroutine swiftest_io_param_writer(self, unit, iotype, v_list, iostat, i call io_param_writer_one("FIRSTKICK",param%lfirstkick, unit) call io_param_writer_one("MAXID",param%maxid, unit) call io_param_writer_one("MAXID_COLLISION",param%maxid_collision, unit) + + if (param%GMTINY > 0.0_DP) call io_param_writer_one("GMTINY",param%GMTINY, unit) + if (param%min_GMfrag > 0.0_DP) call io_param_writer_one("MIN_GMFRAG",param%min_GMfrag, unit) + call io_param_writer_one("COLLISION_MODEL",param%collision_model, unit) + if (param%collision_model == "FRAGGLE" ) then + nseeds = size(param%seed) + call io_param_writer_one("SEED", [nseeds, param%seed(:)], unit) + end if iostat = 0 iomsg = "UDIO not implemented" @@ -2837,7 +2845,6 @@ module subroutine swiftest_io_toupper(string) end subroutine swiftest_io_toupper - module subroutine swiftest_io_write_discard(self, param) !! author: David A. Minton !! From 9aabc27f73a3a687fb9273ebe0f506823bab1469 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Mon, 2 Jan 2023 12:26:08 -0500 Subject: [PATCH 569/569] Removed the defunct BFGS minimizer as it is no longer needed by the current implementation of Fraggle --- src/CMakeLists.txt | 1 - src/misc/minimizer_module.f90 | 684 ------------------------------- src/misc/solver_module.f90 | 2 +- src/swiftest/swiftest_module.f90 | 1 - 4 files changed, 1 insertion(+), 687 deletions(-) delete mode 100644 src/misc/minimizer_module.f90 diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index adfde33c7..ef6b91f5e 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -28,7 +28,6 @@ SET(FAST_MATH_FILES ${SRC}/misc/lambda_function_module.f90 ${SRC}/misc/io_progress_bar_module.f90 ${SRC}/misc/solver_module.f90 - ${SRC}/misc/minimizer_module.f90 ${SRC}/encounter/encounter_module.f90 ${SRC}/collision/collision_module.f90 ${SRC}/operator/operator_module.f90 diff --git a/src/misc/minimizer_module.f90 b/src/misc/minimizer_module.f90 deleted file mode 100644 index 8beab3879..000000000 --- a/src/misc/minimizer_module.f90 +++ /dev/null @@ -1,684 +0,0 @@ -!! Copyright 2022 - David Minton, Carlisle Wishard, Jennifer Pouplin, Jake Elliott, & Dana Singh -!! This file is part of Swiftest. -!! Swiftest is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License -!! as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. -!! Swiftest is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty -!! of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. -!! You should have received a copy of the GNU General Public License along with Swiftest. -!! If not, see: https://www.gnu.org/licenses. - -module minimizer - !! author: David A. Minton - !! - !! Includes the Broyden-Fletcher-Goldfarb-Shanno minimizer used by Fraggle - use globals - use lambda_function - use solver - use, intrinsic :: ieee_exceptions - private - public :: minimize_bfgs - - type(ieee_status_type) :: original_fpe_status - logical, dimension(:), allocatable :: fpe_flag - - interface - module subroutine minimize_bfgs(f, N, x0, eps, maxloop, lerr, x1) - implicit none - integer(I4B), intent(in) :: N - class(lambda_obj), intent(inout) :: f - real(DP), dimension(:), intent(in) :: x0 - real(DP), intent(in) :: eps - integer(I4B), intent(in) :: maxloop - logical, intent(out) :: lerr - real(DP), dimension(:), intent(out), allocatable :: x1 - end subroutine minimize_bfgs - - module function gradf(f, N, x1, dx, lerr) result(grad) - implicit none - integer(I4B), intent(in) :: N - class(lambda_obj), intent(inout) :: f - real(DP), dimension(:), intent(in) :: x1 - real(DP), intent(in) :: dx - logical, intent(out) :: lerr - real(DP), dimension(N) :: grad - end function gradf - - module function minimize1D(f, x0, S, N, eps, lerr) result(astar) - implicit none - integer(I4B), intent(in) :: N - class(lambda_obj), intent(inout) :: f - real(DP), dimension(:), intent(in) :: x0, S - real(DP), intent(in) :: eps - logical, intent(out) :: lerr - real(DP) :: astar - end function minimize1D - - module function n2one(f, x0, S, N, a, lerr) result(fnew) - implicit none - integer(I4B), intent(in) :: N - class(lambda_obj), intent(inout) :: f - real(DP), dimension(:), intent(in) :: x0, S - real(DP), intent(in) :: a - logical, intent(out) :: lerr - real(DP) :: fnew - end function n2one - - module subroutine bracket(f, x0, S, N, gam, step, lo, hi, lerr) - implicit none - integer(I4B), intent(in) :: N - class(lambda_obj), intent(inout) :: f - real(DP), dimension(:), intent(in) :: x0, S - real(DP), intent(in) :: gam, step - real(DP), intent(inout) :: lo - real(DP), intent(out) :: hi - logical, intent(out) :: lerr - end subroutine bracket - - module subroutine golden(f, x0, S, N, eps, lo, hi, lerr) - implicit none - integer(I4B), intent(in) :: N - class(lambda_obj), intent(inout) :: f - real(DP), dimension(:), intent(in) :: x0, S - real(DP), intent(in) :: eps - real(DP), intent(inout) :: lo - real(DP), intent(out) :: hi - logical, intent(out) :: lerr - end subroutine golden - - module subroutine quadfit(f, x0, S, N, eps, lo, hi, lerr) - implicit none - ! Arguments - integer(I4B), intent(in) :: N - class(lambda_obj), intent(inout) :: f - real(DP), dimension(:), intent(in) :: x0, S - real(DP), intent(in) :: eps - real(DP), intent(inout) :: lo - real(DP), intent(out) :: hi - logical, intent(out) :: lerr - end subroutine quadfit - end interface - - contains - - module subroutine minimize_bfgs(f, N, x0, eps, maxloop, lerr, x1) - !! author: David A. Minton - !! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - !! This function implements the Broyden-Fletcher-Goldfarb-Shanno method to determine the minimum of a function of N variables. - !! It recieves as input: - !! f%eval(x) : lambda function object containing the objective function as the eval metho - !! N : Number of variables of function f - !! x0 : Initial starting value of x - !! eps : Accuracy of 1 - dimensional minimization at each step - !! maxloop : Maximum number of loops to attempt to find a solution - !! The outputs include - !! lerr : Returns .true. if it could not find the minimum - !! Returns - !! x1 : Final minimum (all 0 if none found) - !! 0 = No miniumum found - !! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - implicit none - ! Arguments - integer(I4B), intent(in) :: N - class(lambda_obj), intent(inout) :: f - real(DP), dimension(:), intent(in) :: x0 - real(DP), intent(in) :: eps - integer(I4B), intent(in) :: maxloop - logical, intent(out) :: lerr - ! Result - real(DP), dimension(:), intent(out), allocatable :: x1 - ! Internals - integer(I4B) :: i, j, k, l, conv - real(DP), parameter :: graddelta = 1e-4_DP !! Delta x for gradient calculations - real(DP), dimension(N) :: S !! Direction vectors - real(DP), dimension(N,N) :: H !! Approximated inverse Hessian matrix - real(DP), dimension(N) :: grad1 !! gradient of f - real(DP), dimension(N) :: grad0 !! old value of gradient - real(DP) :: astar !! 1D minimized value - real(DP), dimension(N) :: y, P - real(DP), dimension(N,N) :: PP, PyH, HyP - real(DP), save :: yHy, Py - real(DP) :: Hnorm - - call ieee_get_status(original_fpe_status) ! Save the original floating point exception status - call ieee_set_flag(ieee_all, .false.) ! Set all flags to quiet - if (.not.allocated(fpe_flag)) allocate(fpe_flag(size(ieee_usual))) - - lerr = .false. - if (allocated(x1)) deallocate(x1) - allocate(x1, source=x0) - ! Initialize approximate Hessian with the identity matrix (i.e. begin with method of steepest descent) - ! Get initial gradient and initialize arrays for updated values of gradient and x - H(:,:) = reshape([((0._DP, i=1, j-1), 1._DP, (0._DP, i=j+1, N), j=1, N)], [N,N]) - grad0 = gradf(f, N, x0(:), graddelta, lerr) - if (lerr) then - call ieee_set_status(original_fpe_status) - return - end if - grad1(:) = grad0(:) - do i = 1, maxloop - !check for convergence - conv = count(abs(grad1(:)) > eps) - if (conv == 0) exit - S(:) = -matmul(H(:,:), grad1(:)) - astar = minimize1D(f, x1, S, N, graddelta, lerr) - if (lerr) exit - ! Get new x values - P(:) = astar * S(:) - x1(:) = x1(:) + P(:) - ! Calculate new gradient - grad0(:) = grad1(:) - grad1 = gradf(f, N, x1, graddelta, lerr) - y(:) = grad1(:) - grad0(:) - Py = sum(P(:) * y(:)) - ! set up factors for H matrix update - yHy = 0._DP - !$omp do simd schedule(static)& - !$omp firstprivate(N, y, H) & - !$omp reduction(+:yHy) - do k = 1, N - do j = 1, N - yHy = yHy + y(j) * H(j,k) * y(k) - end do - end do - !$omp end do simd - ! prevent divide by zero (convergence) - if (abs(Py) < N**2 * tiny(Py)) exit - ! set up update - PyH(:,:) = 0._DP - HyP(:,:) = 0._DP - !$omp parallel do default(private) schedule(static)& - !$omp shared(N, PP, P, y, H) & - !$omp reduction(+:PyH, HyP) - do k = 1, N - do j = 1, N - PP(j, k) = P(j) * P(k) - do l = 1, N - PyH(j, k) = PyH(j, k) + P(j) * y(l) * H(l,k) - HyP(j, k) = HyP(j, k) + P(k) * y(l) * H(j,l) - end do - end do - end do - !$omp end parallel do - ! update H matrix - H(:,:) = H(:,:) + ((1._DP - yHy / Py) * PP(:,:) - PyH(:,:) - HyP(:,:)) / Py - ! Normalize to prevent it from blowing up if it takes many iterations to find a solution - Hnorm = 0.0_DP - do concurrent (j = 1:N,k=1:N,abs(H(j,k))>sqrt(10*tiny(1.0_DP))) - Hnorm = Hnorm + H(j,k)**2 - end do - Hnorm = sqrt(Hnorm) - ! Stop everything if there are any exceptions to allow the routine to fail gracefully - call ieee_get_flag(ieee_usual, fpe_flag) - if (any(fpe_flag)) exit - if (i == maxloop) then - lerr = .true. - end if - where(abs(H(:,:)) < sqrt(10*tiny(1.0_DP)) ) - H(:,:) = 0.0_DP - endwhere - H(:,:) = H(:,:) / Hnorm - end do - call ieee_get_flag(ieee_usual, fpe_flag) - lerr = lerr .or. any(fpe_flag) - call ieee_set_status(original_fpe_status) - - return - - end subroutine minimize_bfgs - - - module function gradf(f, N, x1, dx, lerr) result(grad) - !! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - !! Purpose: Estimates the gradient of a function using a central difference - !! approximation - !! Inputs: - !! f%eval(x) : lambda function object containing the objective function as the eval metho - !! N : number of variables N - !! x1 : x value array - !! dx : step size to use when calculating derivatives - !! Outputs: - !! lerr : .true. if an error occurred. Otherwise returns .false. - !! Returns - !! grad : N sized array containing estimated gradient of f at x1 - !! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - implicit none - ! Arguments - integer(I4B), intent(in) :: N - class(lambda_obj), intent(inout) :: f - real(DP), dimension(:), intent(in) :: x1 - real(DP), intent(in) :: dx - logical, intent(out) :: lerr - ! Result - real(DP), dimension(N) :: grad - ! Internals - integer(I4B) :: i, j - real(DP), dimension(N) :: xp, xm - real(DP) :: fp, fm - logical :: lerrp, lerrm - - do i = 1, N - do j = 1, N - if (j == i) then - xp(j) = x1(j) + dx - xm(j) = x1(j) - dx - else - xp(j) = x1(j) - xm(j) = x1(j) - end if - end do - select type (f) - class is (lambda_obj_err) - fp = f%eval(xp) - lerrp = f%lerr - fm = f%eval(xm) - lerrm = f%lerr - lerr = lerrp .or. lerrm - class is (lambda_obj) - fp = f%eval(xp) - fm = f%eval(xm) - lerr = .false. - end select - grad(i) = (fp - fm) / (2 * dx) - if (lerr) return - end do - return - end function gradf - - - module function minimize1D(f, x0, S, N, eps, lerr) result(astar) - !! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - !! This program find the minimum of a function of N variables in a single direction - !! S using in sequence: - !! 1. A Bracketing method - !! 2. The golden section method - !! 3. A quadratic polynomial fit - !! Inputs - !! f%eval(x) : lambda function object containing the objective function as the eval metho - !! x0 : Array of size N of initial x values - !! S : Array of size N that determines the direction of minimization - !! N : Number of variables of function f - !! eps : Accuracy of 1 - dimensional minimization at each step - !! Output - !! lerr : .true. if an error occurred. Otherwise returns .false. - !! Returns - !! astar : Final minimum along direction S - !! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - implicit none - ! Arguments - integer(I4B), intent(in) :: N - class(lambda_obj), intent(inout) :: f - real(DP), dimension(:), intent(in) :: x0, S - real(DP), intent(in) :: eps - logical, intent(out) :: lerr - ! Result - real(DP) :: astar - ! Internals - integer(I4B) :: num = 0 - real(DP), parameter :: step = 0.7_DP !! Bracketing method step size - real(DP), parameter :: gam = 1.2_DP !! Bracketing method expansion parameter - real(DP), parameter :: greduce = 0.2_DP !! Golden section method reduction factor - real(DP), parameter :: greduce2 = 0.1_DP ! Secondary golden section method reduction factor - real(DP) :: alo, ahi !! High and low values for 1 - D minimization routines - real(DP), parameter :: a0 = epsilon(1.0_DP) !! Initial guess of alpha - - alo = a0 - call bracket(f, x0, S, N, gam, step, alo, ahi, lerr) - if (lerr) then - !write(*,*) "BFGS bracketing step failed!" - !write(*,*) "alo: ",alo, "ahi: ", ahi - return - end if - if (abs(alo - ahi) < eps) then - astar = alo - lerr = .false. - return - end if - call golden(f, x0, S, N, greduce, alo, ahi, lerr) - if (lerr) then - !write(*,*) "BFGS golden section step failed!" - return - end if - if (abs(alo - ahi) < eps) then - astar = alo - lerr = .false. - return - end if - call quadfit(f, x0, S, N, eps, alo, ahi, lerr) - if (lerr) then - !write(*,*) "BFGS quadfit failed!" - return - end if - if (abs(alo - ahi) < eps) then - astar = alo - lerr = .false. - return - end if - ! Quadratic fit method won't converge, so finish off with another golden section - call golden(f, x0, S, N, greduce2, alo, ahi, lerr) - if (.not. lerr) astar = (alo + ahi) / 2.0_DP - return - end function minimize1D - - - module function n2one(f, x0, S, N, a, lerr) result(fnew) - implicit none - ! Arguments - integer(I4B), intent(in) :: N - class(lambda_obj), intent(inout) :: f - real(DP), dimension(:), intent(in) :: x0, S - real(DP), intent(in) :: a - logical, intent(out) :: lerr - ! Return - real(DP) :: fnew - ! Internals - real(DP), dimension(N) :: xnew - integer(I4B) :: i - - xnew(:) = x0(:) + a * S(:) - fnew = f%eval(xnew(:)) - select type(f) - class is (lambda_obj_err) - lerr = f%lerr - class is (lambda_obj) - lerr = .false. - end select - return - end function n2one - - - module subroutine bracket(f, x0, S, N, gam, step, lo, hi, lerr) - ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - !! This subroutine brackets the minimum. It recieves as input: - !! f%eval(x) : lambda function object containing the objective function as the eval metho - !! x0 : Array of size N of initial x values - !! S : Array of size N that determines the direction of minimization - !! gam : expansion parameter - !! step : step size - !! lo : initial guess of lo bracket value - !! The outputs include - !! lo : lo bracket - !! hi : hi bracket - !! lerr : .true. if an error occurred. Otherwise returns .false. - !! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - implicit none - ! Arguments - integer(I4B), intent(in) :: N - class(lambda_obj), intent(inout) :: f - real(DP), dimension(:), intent(in) :: x0, S - real(DP), intent(in) :: gam, step - real(DP), intent(inout) :: lo - real(DP), intent(out) :: hi - logical, intent(out) :: lerr - ! Internals - real(DP) :: a0, a1, a2, atmp, da - real(DP) :: f0, f1, f2 - integer(I4B) :: i, j - integer(I4B), parameter :: MAXLOOP = 100 ! maximum number of loops before method is determined to have failed - real(DP), parameter :: eps = epsilon(lo) ! small number precision to test floating point equality - - ! set up initial bracket points - a0 = lo - da = step - a1 = a0 + da - a2 = a0 + 2 * da - f0 = n2one(f, x0, S, N, a0, lerr) - if (lerr) return - f1 = n2one(f, x0, S, N, a1, lerr) - if (lerr) return - f2 = n2one(f, x0, S, N, a2, lerr) - if (lerr) return - ! loop over bracket method until either min is bracketed method fails - do i = 1, MAXLOOP - if ((f0 > f1) .and. (f1 < f2)) then ! Minimum was found - lo = a0 - hi = a2 - return - else if ((f0 >= f1) .and. (f1 > f2)) then ! Function appears to decrease - da = da * gam - atmp = a2 + da - a0 = a1 - a1 = a2 - a2 = atmp - f0 = f1 - f1 = f2 - f2 = n2one(f, x0, S, N, a2, lerr) - else if ((f0 < f1) .and. (f1 <= f2)) then ! Function appears to increase - da = da * gam - atmp = a0 - da - a2 = a1 - a1 = a0 - a0 = atmp - f2 = f1 - f0 = n2one(f, x0, S, N, a0, lerr) - else if ((f0 < f1) .and. (f1 > f2)) then ! We are at a peak. Pick the direction that descends the fastest - da = da * gam - if (f2 > f0) then ! LHS is lower than RHS - atmp = a2 + da - a0 = a1 - a1 = a2 - a2 = atmp - f0 = f1 - f1 = f2 - f2 = n2one(f, x0, S, N, a2, lerr) - else ! RHS is lower than LHS - atmp = a0 - da - a2 = a1 - a1 = a0 - a0 = atmp - f2 = f1 - f1 = f2 - f0 = n2one(f, x0, S, N, a0, lerr) - end if - else if ((f0 > f1) .and. (abs(f2 - f1) <= eps)) then ! Decrasging but RHS equal - da = da * gam - atmp = a2 + da - a2 = atmp - f2 = n2one(f, x0, S, N, a2, lerr) - else if ((abs(f0 - f1) < eps) .and. (f1 < f2)) then ! Increasing but LHS equal - da = da * gam - atmp = a0 - da - a0 = atmp - f0 = n2one(f, x0, S, N, a0, lerr) - else ! all values equal. Expand in either direction and try again - a0 = a0 - da - a2 = a2 + da - f0 = n2one(f, x0, S, N, a0, lerr) - if (lerr) exit ! An error occurred while evaluating the function - f2 = n2one(f, x0, S, N, a2, lerr) - end if - if (lerr) exit ! An error occurred while evaluating the function - end do - lerr = .true. - return ! no minimum found - end subroutine bracket - - - module subroutine golden(f, x0, S, N, eps, lo, hi, lerr) - ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - !! This function uses the golden section method to reduce the starting interval lo, hi by some amount sigma. - !! It recieves as input: - !! f%eval(x) : lambda function object containing the objective function as the eval metho - !! x0 : Array of size N of initial x values - !! S : Array of size N that determines the direction of minimization - !! gam : expansion parameter - !! eps : reduction interval in range (0 < sigma < 1) such that: - !! hi(new) - lo(new) = eps * (hi(old) - lo(old)) - !! lo : initial guess of lo bracket value - !! The outputs include - !! lo : lo bracket - !! hi : hi bracket - !! lerr : .true. if an error occurred. Otherwise returns .false. - !! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - implicit none - ! Arguments - integer(I4B), intent(in) :: N - class(lambda_obj), intent(inout) :: f - real(DP), dimension(:), intent(in) :: x0, S - real(DP), intent(in) :: eps - real(DP), intent(inout) :: lo - real(DP), intent(out) :: hi - logical, intent(out) :: lerr - ! Internals - real(DP), parameter :: tau = 0.5_DP * (sqrt(5.0_DP) - 1.0_DP) ! Golden section constant - integer(I4B), parameter :: MAXLOOP = 40 ! maximum number of loops before method is determined to have failed (unlikely, but could occur if no minimum exists between lo and hi) - real(DP) :: i0 ! Initial interval value - real(DP) :: a1, a2 - real(DP) :: f1, f2 - integer(I4B) :: i, j - - i0 = hi - lo - a1 = hi - tau * i0 - a2 = lo + tau * i0 - f1 = n2one(f, x0, S, N, a1, lerr) - if (lerr) return - f2 = n2one(f, x0, S, N, a2, lerr) - if (lerr) return - do i = 1, MAXLOOP - if (abs((hi - lo) / i0) <= eps) return ! interval reduced to input amount - if (f2 > f1) then - hi = a2 - a2 = a1 - f2 = f1 - a1 = hi - tau * (hi - lo) - f1 = n2one(f, x0, S, N, a1, lerr) - else - lo = a1 - a1 = a2 - f2 = f1 - a2 = hi - (1.0_DP - tau) * (hi - lo) - f2 = n2one(f, x0, S, N, a2, lerr) - end if - if (lerr) exit - end do - lerr = .true. - return ! search took too many iterations - no minimum found - end subroutine golden - - - module subroutine quadfit(f, x0, S, N, eps, lo, hi, lerr) - ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - !! This function uses a quadratic polynomial fit to locate the minimum of a function - !! to some accuracy eps. It recieves as input: - !! f%eval(x) : lambda function object containing the objective function as the eval metho - !! lo : low bracket value - !! hi : high bracket value - !! eps : desired accuracy of final minimum location - !! The outputs include - !! lo : final minimum location - !! hi : final minimum location - !! Notes: Uses the ieee_exceptions intrinsic module to allow for graceful failure due to floating point exceptions, which won't terminate the run. - !! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - implicit none - ! Arguments - integer(I4B), intent(in) :: N - class(lambda_obj), intent(inout) :: f - real(DP), dimension(:), intent(in) :: x0, S - real(DP), intent(in) :: eps - real(DP), intent(inout) :: lo - real(DP), intent(out) :: hi - logical, intent(out) :: lerr - ! Internals - integer(I4B), parameter :: MAXLOOP = 20 ! maximum number of loops before method is determined to have failed. - real(DP) :: a1, a2, a3, astar ! three points for the polynomial fit and polynomial minimum - real(DP) :: f1, f2, f3, fstar ! three function values for the polynomial and polynomial minimum - real(DP), dimension(3) :: row_1, row_2, row_3, rhs, soln ! matrix for 3 equation solver (gaussian elimination) - real(DP), dimension(3,3) :: lhs - real(DP) :: d1, d2, d3, aold, denom, errval - integer(I4B) :: i - - lerr = .false. - ! Get initial a1, a2, a3 values - a1 = lo - a2 = lo + 0.5_DP * (hi - lo) - a3 = hi - aold = a1 - astar = a2 - f1 = n2one(f, x0, S, N, a1, lerr) - if (lerr) return - f2 = n2one(f, x0, S, N, a2, lerr) - if (lerr) return - f3 = n2one(f, x0, S, N, a3, lerr) - if (lerr) return - do i = 1, MAXLOOP - ! check to see if convergence is reached and exit - errval = abs((astar - aold) / astar) - call ieee_get_flag(ieee_usual, fpe_flag) - if (any(fpe_flag)) then - !write(*,*) 'quadfit fpe' - !write(*,*) 'aold : ',aold - !write(*,*) 'astar: ',astar - lerr = .true. - exit - end if - if (errval < eps) then - lo = astar - hi = astar - exit - end if - ! Set up nbody_system for gaussian elimination equation solver - row_1 = [1.0_DP, a1, a1**2] - row_2 = [1.0_DP, a2, a2**2] - row_3 = [1.0_DP, a3, a3**2] - rhs = [f1, f2, f3] - lhs(1, :) = row_1 - lhs(2, :) = row_2 - lhs(3, :) = row_3 - ! Solve nbody_system of equations - soln(:) = solve_linear_system(lhs, rhs, 3, lerr) - call ieee_set_flag(ieee_all, .false.) ! Set all flags back to quiet - call ieee_set_halting_mode(ieee_divide_by_zero, .false.) - if (lerr) then - !write(*,*) 'quadfit fpe:' - !write(*,*) 'util_solve_linear_system failed' - exit - end if - aold = astar - if (soln(2) == soln(3)) then ! Handles the case where they are both 0. 0/0 is an unhandled exception - astar = -0.5_DP - else - astar = -soln(2) / (2 * soln(3)) - end if - call ieee_get_flag(ieee_usual, fpe_flag) - if (any(fpe_flag)) then - !write(*,*) 'quadfit fpe' - !write(*,*) 'soln(2:3): ',soln(2:3) - !write(*,*) 'a1, a2, a3' - !write(*,*) a1, a2, a3 - !write(*,*) 'f1, f2, f3' - !write(*,*) f1, f2, f3 - lerr = .true. - exit - end if - fstar = n2one(f, x0, S, N, astar, lerr) - if (lerr) exit - ! keep the three closest a values to astar and discard the fourth - d1 = abs(a1 - astar) - d2 = abs(a2 - astar) - d3 = abs(a3 - astar) - - if (d1 > d2) then - if (d1 > d3) then - f1 = fstar - a1 = astar - else if (d3 > d2) then - f3 = fstar - a3 = astar - end if - else - if (d2 > d3) then - f2 = fstar - a2 = astar - else if (d3 > d1) then - f3 = fstar - a3 = astar - end if - end if - end do - if (lerr) return - lo = a1 - hi = a3 - return - end subroutine quadfit - - -end module minimizer \ No newline at end of file diff --git a/src/misc/solver_module.f90 b/src/misc/solver_module.f90 index 6462fa57c..4fbf7b7b3 100644 --- a/src/misc/solver_module.f90 +++ b/src/misc/solver_module.f90 @@ -10,7 +10,7 @@ module solver !! author: David A. Minton !! - !! Contains the Broyden-Fletcher-Goldfarb-Shanno minimizer used by Fraggle + !! Contains a 4th order Runge-Kutta-Fehlberg ODE solver and a linear system of equations solver use globals use base use lambda_function diff --git a/src/swiftest/swiftest_module.f90 b/src/swiftest/swiftest_module.f90 index 39a6b65e5..4d08eddf8 100644 --- a/src/swiftest/swiftest_module.f90 +++ b/src/swiftest/swiftest_module.f90 @@ -43,7 +43,6 @@ module swiftest use io_progress_bar use netcdf_io use solver - use minimizer !use advisor_annotate !$ use omp_lib implicit none